{$N+,A+,G+,F+,D-,E-,L-,R-,S-,Q-,Y-}
unit floor_m7;

interface

procedure init_floor;
procedure scene_floor;

implementation

uses global, math2, screen, resource, memory, palette;

var
Aantal, T1: word;
start_time, old_time:word;
elapsed_time:word;

q:word;
cx, z, sx, xt,n,x,y:integer;
pal_speed, i, col, xtr,ytr:word;
tcos, tsin:integer;
event, process_down, down_hor_byte, horizont:byte;
stage, w,h:byte;
w_add, rotation_add, add_q, down_hor, rotate:single;
jump_on:array[0..3] of word;


procedure precals; {precalc tables}
begin
{for y:=0 to 255 do
for x:=0 to 255 do begin
      z:=y shl 1 +1;
      xt:=((x-160)*128 div z);
      mem[vaddr3:word((x-160)*256+y)]:=byte(xt);
end;}

for n:=0 to 511 do begin
mem[vaddr+4000:n]:=round(abs(sin_(pi*2/512 *n)*20-25));
end;
end;


procedure fade_buffer_to_value(value,fade:byte; where:word);
var b:byte;
begin
     for n:=0 to 511 do begin
         b:=mem[where:n];
         if b>value then begin b:=b-fade; if b<value then b:=value; end
         else if b<value then begin b:=b+fade; if b>value then b:=value; end;
         mem[where:n]:=b;
     end;
end;


function jump1(var jump_this:word; d, speed:single):single;
var jump:single;
begin
  jump:= sin((q-jump_this)/speed)*d;
  if jump<0 then begin jump_this:=0; jump:=0;end;
  jump1:=jump;
end;


procedure go_event(e:word;name:string; param1:integer);
begin
  if (e=event) then begin

     if      name='jump1' then begin
                         jump_on[1]:=q;
             end
     else if name='jump2' then begin
                         jump_on[2]:=q;
             end
     else if name='jump3' then begin
                         jump_on[3]:=q;
             end;
  inc(event);
  end;
end;

procedure Load_gray;
begin
     LoadBin('hex_gray.pal',  seg_palitra,  ofs_palitra+palette2);
     init_pal2pal(seg_palitra,ofs_palitra);
     palette_process[0]:=1;
     pal_speed:=32;
end;
procedure Load_normal;
begin
     mem2mem(vaddr,0,  seg_palitra,ofs_palitra+palette2,   1536);
     init_pal2pal(seg_palitra,ofs_palitra);
     palette_process[0]:=1;
     pal_speed:=8;
end;

procedure Init_floor;
begin
if useXMS=1 then begin
    precals;
    LoadBufferToXMS('floor_1', 1536, vaddr+4000);
    {LoadBufferToXMS('floor_3', 65536, vaddr3);}
end else
    precals;
end;

procedure Scene_Floor;
begin
LoadBinUnpack('floor.bin', {load->}vaddr,{-unpack->}vaddr3,  0);
LoadBinUnpack('hex4.bin',  {load->}vaddr,{-unpack->}vaddr2,  0);
LoadBin('hex4.pal',  seg_palitra,  ofs_palitra+palette2);

Clear(0, 65535, vaddr);

if useXMS=1 then begin
   LoadBufferFromXMS('floor_1', vaddr+4000, 0);
   {LoadBufferFromXMS('floor_3', vaddr3, 0);}
end else init_floor;



w:=0;
for col:=0 to 63 do begin
if col>58 then w:=w+1;
setonecolor2memW(63-col, col shr 4+w , col shr 3+w, col shr 2+w, palette2, seg_palitra,ofs_palitra);
end;{}

mem2mem(seg_palitra,ofs_palitra+palette2,  vaddr,0, 1536); {save normal palette}


for n:=0 to 255 do setonecolor2memW(n, 63, 63, 63, palette1, seg_palitra,ofs_palitra); {1}

init_pal2pal(seg_palitra,ofs_palitra);
palette_process[0]:=1;

Midas_WaitVR;

setpalette_from_memW(palette1,seg_palitra,ofs_palitra);
set_border_color(62);

for n:=0 to 3 do jump_on[n]:=0;

stage:=0;
down_hor:=40;
pal_speed:=4;
process_down:=0;
event:=0;
add_q:=0;
rotation_add:=0;
w_add:=0;

Aantal:=0; T1:=mTimer;
old_time:=mtimer;
start_time:=mtimer;


repeat
q:=mtimer-start_time +260;
elapsed_time:=(mtimer-old_time);
old_time:=mtimer;

{---------------------------------------------------------------------------}
if (elapsed_time>0) or (aantal=0) then begin

   MP^.GetInformation(@info);


   if (stage=0) and (down_hor>0) then
   begin
     down_hor:=down_hor-elapsed_time/3;
     if down_hor<0 then down_hor:=0;
     down_hor_byte:=round(down_hor);
   end;

   if (stage=0) and (music_pos(46,60)) then
   begin
     stage:=1;
     Load_Gray;
   end;

   if (stage=1) and (music_pos(47,5)) then
   begin
     stage:=2;
     Load_normal;
   end;

   if (stage=2) and (music_pos(48,0)) then
   begin
     stage:=3;
     Load_Gray;
   end;

   if (stage=3) and (music_pos(48,5)) then
   begin
     stage:=4;
     Load_normal;
   end;

   if (stage=4) and (music_pos(49,0)) then
   begin
     stage:=5;
     Load_Gray;
   end;

   if (stage=5) and (music_pos(49,5)) then
   begin
     stage:=6;
     Load_normal;
   end;



   if (stage=6) and (music_pos(49,44)) then
   begin
     stage:=7;
     for n:=0 to 255 do setonecolor2memW(n, 23, 23, 33, palette2, seg_palitra,ofs_palitra); {}
     init_pal2pal(seg_palitra,ofs_palitra);
     palette_process[0]:=1;
     pal_speed:=5;
     process_down:=1;
   end;



   case event of

   0:  if music_pos(46,56) then go_event(0, 'jump1',0);
   1:  if music_pos(47,52) then go_event(1, 'jump2',0);
   2:  if music_pos(48,56) then go_event(2, 'jump3',0);

  end;


   if process_down=1 then fade_buffer_to_value(120, elapsed_time*2, vaddr+4000);

   if (jump_on[1]>0) then rotation_add:=rotation_add+(jump1(jump_on[1], 0.03, 15)*elapsed_time);{}
   if (jump_on[2]>0) then begin
                          add_q:=(jump1(jump_on[2], 0.04, 25)*elapsed_time);
                          rotation_add:=rotation_add+add_q;
                          w_add:=w_add-add_q*120;
                          end;
   if (jump_on[3]>0) then begin
                          add_q:=(jump1(jump_on[3], 0.04, 15)*elapsed_time);
                          rotation_add:=rotation_add+add_q;
                          w_add:=w_add+add_q*200;
                          end;

end;
{---------------------------------------------------------------------------}



w:=round(q+w_add) and 255;
h:=q and 255;

rotate:=cos_(q/150+rotation_add)*2;

Tcos := round(cos_(rotate)*120);
Tsin := round(sin_(rotate)*120);

for x:=0 to 319 do begin
  {horizont:=abs(round(sin(x/180+q/50)*20-25));}
  horizont:=mem[vaddr+4000: (x shr 1+q) and 511]+down_hor_byte;

  sx:=Tcos*(x-160);
  cx:=Tsin*(x-160);
  xtr:= word((sx - Tsin shl 7)) and 65280;
  ytr:= word((cx + Tcos shl 7)) and 65280;
  ytr:= ytr-xtr;

asm
  mov di, x
  mov si, xtr
  mov bx, ytr
  mov dl, w
  mov dh, h

  {------self-modify-------}
  mov cs:[offset @ytr+3], bx
  mov cs:[offset @wh1+1], dx
  mov cs:[offset @wh2+1], dx
  mov cs:[offset @wh3+1], dx
  mov cs:[offset @wh4+1], dx
  jmp @clear_prefetch; @clear_prefetch:
  {-------------------------}


  mov ax, 0a000h
  mov es, ax
  mov ax, vaddr2 {texture}
  db $8E,$E0 {mov fs, ax}

  xor ax, ax
  mov cx, 200
  mov al, horizont
  sub cl, al
  push cx

  shr cx, 2  {мы будем рисовать колонку по 4 пикселя за цикл}

  push bp
  push ds
  mov ds, vaddr3 {table}


  {draw sky column}
  cmp al, 64
  jb @sky

  {предотвращаем рисование неба цветами выше 63}
  @black:
    mov byte ptr es:[di], 63
    add di, 320
    dec al
    cmp al, 63
  ja @black

  @sky:
    mov byte ptr es:[di], al
    add di, 320
    dec al
  jnz @sky

  mov bp, cx
  @y:
      db $66; mov cx, ds:[si]
      @ytr: db $66; mov dx, ds:[si+1234h]

      @wh1: mov bx, 1234h
      add bl, cl
      add bh, dl
      db $64; mov al, [bx]

      test al, al
      jz @zero
      mov ah, al
      jmp @draw
          @zero:
          mov al, ah
      @draw:
      mov es:[di], al

      @wh2: mov bx, 1234h
      add bl, ch
      add bh, dh
      db $64; mov al, [bx]
      test al, al
      jz @zero2
      mov ah, al
      jmp @draw2
          @zero2:
          mov al, ah
          sub ah, 6
          sbb bl, bl
          not bl
          and ah, bl
      @draw2:
      mov es:[di+320], al

      db $66; shr cx, 16
      db $66; shr dx, 16

      @wh3: mov bx, 1234h
      add bl, cl
      add bh, dl
      db $64; mov al, [bx]
      test al, al
      jz @zero3
      mov ah, al
      jmp @draw3
          @zero3:
          mov al, ah
      @draw3:
      mov es:[di+320*2], al

      @wh4: mov bx, 1234h
      add bl, ch
      add bh, dh
      db $64; mov al, [bx]
      test al, al
      jz @zero4
      mov ah, al
      jmp @draw4
          @zero4:
          mov al, ah
          sub ah, 6
          sbb bl, bl
          not bl
          and ah, bl
      @draw4:
      mov es:[di+320*3], al

  add si, 4
  add di, 320*4
  dec bp
  jnz @y
  pop ds
  pop bp

  {draw bottom 1..3 pixels of column}
  pop cx
  and cx, 3
  jz @exit
  @sky1:
    mov byte ptr es:[di], al
    add di, 320
    dec cl
  jnz @sky1
  @exit:
end;
end;


if Vsync_mode=1 then Midas_WaitVR;

if palette_process[0]=1 then Pal2Pal_asm(palette_process[0], 0, 255, elapsed_time*pal_speed, seg_palitra,ofs_palitra);

Inc(Aantal);
if FPS_Mode=1 then WriteFps(254, mtimer, T1, Aantal, vga);

until (esc_test) or ((process_down=1) and (palette_process[0]=0));


end;


end.