unit Sea6;

Interface

procedure init;
procedure NextFrame;
Procedure DeInit;

Implementation

uses gfx3;


function malloc (s : word):Word;
var
ptemp:pointer;

Begin
Getmem (Ptemp,s);
malloc:=Seg(Ptemp^);
End;



var
i,q : word;
x,y,dx,dy : integer;

helix,image,back,back2 : word;

lookup : array [0..200] of longint;
counter,look,w,e : longint;
q1,q2,q3 : integer;




procedure fire(Video : Word);assembler;
asm
  mov ax,Video
  mov es,ax
  mov di,1*320
  mov cx,320*198
    @fl1:
    xor bx,bx
    mov bl,byte ptr es:[di]
    mov ax,bx
    mov bl,byte ptr es:[di-1]
    add ax,bx
    mov bl,byte ptr es:[di+1]
    add ax,bx
    mov bl,byte ptr es:[di+320]
    add ax,bx
    shr ax,2
    jz @fl2
    dec al
    @fl2:
    stosb
    dec cx
  jnz @fl1
end;

procedure firelineupleft(Video,a,s : word);assembler;
asm
  mov ax,Video
  mov es,ax
  mov di,a
  mov cx,s
    @fl1:
    xor bx,bx
    mov bl,byte ptr es:[di]
    mov ax,bx
    mov bl,byte ptr es:[di-1]
    add ax,bx
    mov bl,byte ptr es:[di+1]
    add ax,bx
    mov bl,byte ptr es:[di+320]
    add ax,bx
    shr ax,2
    jz @fl2
    dec al
    @fl2:
    stosb
    dec cx
  jnz @fl1
end;

procedure firelineupright(Video,a,s : word);assembler;
asm
  mov ax,Video
  mov es,ax
  mov di,a
  mov cx,s
    @fl1:
    xor bx,bx
    mov bl,byte ptr es:[di]
    mov ax,bx
    mov bl,byte ptr es:[di-1]
    add ax,bx
    mov bl,byte ptr es:[di  ]
    add ax,bx
    mov bl,byte ptr es:[di+320]
    add ax,bx
    shr ax,2
    jz @fl2
    dec al
    @fl2:
    stosb
    dec cx
  jnz @fl1
end;


procedure firelinedownright(Video,a,s : word);assembler;
asm
  mov ax,Video
  mov es,ax
  mov di,a
  mov cx,s
    @fl1:
    xor bx,bx
    mov bl,byte ptr es:[di]
    mov ax,bx
    mov bl,byte ptr es:[di-1]
    add ax,bx
    mov bl,byte ptr es:[di ]
    add ax,bx
    mov bl,byte ptr es:[di-320]
    add ax,bx
    shr ax,2
    jz @fl2
    dec al
    @fl2:
    stosb
    dec cx
  jnz @fl1
end;

procedure firelinedownleft(Video,a,s : word);assembler;
asm
  mov ax,Video
  mov es,ax
  mov di,a
  mov cx,s
    @fl1:
    xor bx,bx
    mov bl,byte ptr es:[di]
    mov ax,bx
    mov bl,byte ptr es:[di]
    add ax,bx
    mov bl,byte ptr es:[di+1]
    add ax,bx
    mov bl,byte ptr es:[di-320]
    add ax,bx
    shr ax,2
    jz @fl2
    dec al
    @fl2:
    stosb
    dec cx
  jnz @fl1
end;

Procedure hboxclipasm(x,y,s,ys,xd,yd : integer;source,dest : word);
var
rSI,rDI         : word;
i,i2,size,Xoffs : integer;

Begin
Xoffs:=0;
size:=s;

if (xd<320) and ((xd+s)>0) then Begin

if xd<0 then Begin
             XOffs:=-xd;
             size:=s-Xoffs;
            End;

if xd+s>320 then Begin
                 Xoffs:=0;
                 Size:=320-xd;
                End;

{for i2:=0 to ys-1 do begin
rsi:=(y+i2)*320+x+Xoffs;
rdi:=(yd+i2)*320+xd+xoffs;

for i:=0 to size-1 do mem [dest:rdi+i]:=mem[source:rsi+i];
end;}
asm
push ds

mov ds,source
mov es,dest

mov cx,ys
mov bx,y
mov dx,yd

@loopa:
  mov si,bx
  add si,x
  add si,xoffs

  mov di,dx
  add di,xd
  add di,xoffs

  push cx
  mov cx,size

@loopb:
  {mov es,source}
  mov al,ds:[si]

  cmp al,0
  je @skip

  {mov es,dest}
  mov es:[di],al

  @skip:
  inc si
  inc di
loop @loopb
  pop cx

  add bx,320
  add dx,320
loop @loopa
pop ds
end;
end;
End;



Procedure hboxclipasmshadeadd(base : byte;x,y,s,ys,xd,yd : integer;source,dest : word);
var
rSI,rDI         : word;
i,i2,size,Xoffs : integer;

Begin
Xoffs:=0;
size:=s;

if (xd<320) and ((xd+s)>0) then Begin

if xd<0 then Begin
             XOffs:=-xd;
             size:=s-Xoffs;
            End;

if xd+s>320 then Begin
                 Xoffs:=0;
                 Size:=320-xd;
                End;

{for i2:=0 to ys-1 do begin
rsi:=(y+i2)*320+x+Xoffs;
rdi:=(yd+i2)*320+xd+xoffs;

for i:=0 to size-1 do mem [dest:rdi+i]:=mem[source:rsi+i];
end;}
asm
push ds

mov ds,source
mov es,dest

mov cx,ys
mov bx,y
mov dx,yd

@loopa:
  mov si,bx
  add si,x
  add si,xoffs

  mov di,dx
  add di,xd
  add di,xoffs

  push cx
  mov cx,size

@loopb:
  {mov es,source}
  mov al,ds:[si]

  cmp al,0
  je @skip

  {mov es,dest}
  add al,base
  add es:[di],al

  @skip:
  inc si
  inc di
loop @loopb
  pop cx

  add bx,320
  add dx,320
loop @loopa
pop ds
end;
end;
End;

Procedure hboxclipasmshadesub (x,y,s,ys,xd,yd : integer;source,dest : word);
var
rSI,rDI         : word;
i,i2,size,Xoffs : integer;

Begin
Xoffs:=0;
size:=s;

if (xd<320) and ((xd+s)>0) then Begin

if xd<0 then Begin
             XOffs:=-xd;
             size:=s-Xoffs;
            End;

if xd+s>320 then Begin
                 Xoffs:=0;
                 Size:=320-xd;
                End;

{for i2:=0 to ys-1 do begin
rsi:=(y+i2)*320+x+Xoffs;
rdi:=(yd+i2)*320+xd+xoffs;

for i:=0 to size-1 do mem [dest:rdi+i]:=mem[source:rsi+i];
end;}
asm
push ds

mov ds,source
mov es,dest

mov cx,ys
mov bx,y
mov dx,yd

@loopa:
  mov si,bx
  add si,x
  add si,xoffs

  mov di,dx
  add di,xd
  add di,xoffs

  push cx
  mov cx,size

@loopb:
  {mov es,source}
  mov al,ds:[si]

  cmp al,0
  je @skip

  {mov es,dest}
  sub es:[di],al

  @skip:
  inc si
  inc di
loop @loopb
  pop cx

  add bx,320
  add dx,320
loop @loopa
pop ds
end;
end;
End;


procedure ShLine (displacement : word; rolling,strech, center : longint; source, dest : word);
var
wpos : longint;

Begin
        wpos:=0;
        displacement:=y*320;
       asm
        mov cx,320
        mov di,displacement

        @Loopa:
        db $66;mov bx,word(wpos)
        db $66;mov ax,word(center)
        db $66;sub ax,bx
        db $66;add ax,word(rolling);
        db $66;sar ax,8
        {db $66;mov bx,word(rolling)
        db $66;add ax,bx}
        xor ah,ah                               {mod 256}

        mov si,ax
        add si,displacement

        mov es,source
        mov al,es:[si]

        mov es,dest
        mov es:[di],al

        db $66;mov ax,word(wpos)
        db $66;mov bx,word(strech)
        db $66;add ax,bx
        db $66;mov word(wpos),ax
        inc (di)

        loop @Loopa
      end;
end;

Procedure Init;
Begin
for q:=0 to 50 do lookup[q]:=round((1-199/(149-q))*256);
for q:=50 to 199 do lookup[q]:=round((1-199/q)*256);

back :=malloc ($ffff);
back2:=malloc ($ffff);
helix:=malloc ($ffff);
image:=malloc ($ffff);

lpcx ('helix.pcx',helix);
lpcx ('bmap2.pcx',image);
cls (back2,0);

for i:=1 to 64 do pal (i,0,0,i);
for i:=1 to 64 do pal (64+i,0,0,i);
for i:=1 to 64 do pal (128+i,i,64-i,0);
for i:=1 to 64 do pal (192+i,64-i,0,0);
pal (0,0,0,0);

for i:=0 to 63999 do mem[image:i]:=mem[image:i] div 4;
flip32 (image,back);

q:=1;
counter:=0;
q1:=0;
q2:=0;
q3:=320;
end;


procedure nextframe;
begin
inc (counter);
inc (q,255);
inc (q2,1);

case counter of

0..200 :
 Begin

  for y:=20 to 49   do shline (y*320,q,lookup[y],160*lookup[y],image,back2);
  for y:=50 to 149  do shline (y*320,q,lookup[100],160*lookup[100],image,back2);
  for y:=150 to 180 do shline (y*320,q,lookup[y-50],160*lookup[y-50],image,back2);

  hboxclipasmshadeadd (64,q2 shr 1 mod 320,0,320,161,0,20*320,image,back2);
  flip32 (back2,sega000);
 end;

201..241 :
 Begin
  inc (q1);
  for y:=20 to 49   do shline (y*320,q,lookup[y],160*lookup[y],image,back2);
  for y:=50 to 149  do shline (y*320,q,lookup[100],160*lookup[100],image,back2);
  for y:=150 to 180 do shline (y*320,q,lookup[y-50],160*lookup[y-50],image,back2);

  hboxclipasmshadeadd (64,q2 shr 1 mod 320,0,320-2*q1,161-2*q1,q1,(q1+20)*320,image,back2);
  {hboxclipasmshadeadd (64,0,100*320,260,80,q1,70*320,helix,back2);}

  flip32 (back2,sega000);
 end;

242 : for i:=1 to 64 do pal (64+i,32,i,i);

 243..1000 :
 Begin

 dec (q3,3);

  for y:=20 to 49   do shline (y*320,q,lookup[y],160*lookup[y],image,back2);
  for y:=50 to 149  do shline (y*320,q,lookup[100],160*lookup[100],image,back2);
  for y:=150 to 180 do shline (y*320,q,lookup[y-50],160*lookup[y-50],image,back2);


  hboxclipasmshadeadd (64,q2 shr 1 mod 320,0,240,80,40,19200,image,back2);
  hboxclipasmshadeadd (64,0,100*320,260,80,q3,70*320,helix,back2);

flip32 (back2,sega000);
end;
end;

waitretrace;
end;


procedure deinit;
begin
freemem (ptr(back,0),$ffff);
freemem (ptr(back2,0),$ffff);
freemem (ptr(helix,0),$ffff);
freemem (ptr(image,0),$ffff);
end;

Begin
End.

