unit Sea6;

Interface

procedure init;
procedure NextFrame;
Procedure DeInit;

Implementation

uses gfx3;

{$i tflip}

function malloc (w : word):word;
var p : pointer;
Begin
getmem (p,w);
malloc:=seg(p^);
end;

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

{video pages}
out                    : word;
helix,image : word;

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

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 : integer;y : word;s,ys : word;xd : integer;yd : word;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
  inc base

@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 hboxclipasmshadeadd2(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
  inc base

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

  cmp al,0
  je @skip

  {mov es,dest}
  shr al,1
  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 hboxclipasmshadeaddr(l,base : byte;x,y,s,ys,xd,yd : integer;source,dest : word);
var
rSI,rDI         : word;
i,i2,size,Xoffs : integer;
cou             : byte;

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
  inc base

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

  cmp al,0
  je @skip

  {mov es,dest}
  add es:[di],cx

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

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

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

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 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);

cr1:=malloc ($ffff);
cr2:=malloc ($ffff);
image:=malloc ($ffff);
out:=malloc ($ffff);

lpcx ('cr1.pcx',cr1);
lpcx ('cr2.pcx',cr2);
lpcx ('bmap1.pcx',image);
cls32 (out,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:=1 to 255 do pal (i,64-(i div 4),0,0);
{for i:=0 to 127 do pal (255-i,(i div 4),i div 4,40);}

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

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


procedure nextframe;
begin
cls32 (out,0);
inc (counter);
inc (q,255);
inc (q2,3);
dec (q3,2);

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

  {water}
  hboxclipasmshadeadd (0,q2 shr 1 mod 320,0,320,161,0,20*320,image,out);

  {greez to}
  hboxclipasmshadeadd (128,3,101*320,241,35,q3,320*90,cr2,out);

  {deus}
  hboxclipasmshadeadd (128,0,0,127,34,q3+280,320*90,cr1,out);

  {demaniacs}
  hboxclipasmshadeadd (128,0,320*53,286,36,q3+150+280,320*90,cr1,out);

  {arcadia}
  hboxclipasmshadeadd (128,0,108*320,218,35,q3+460+280,320*90,cr1,out);

  {asd}
  hboxclipasmshadeadd (128,0,163*320,97,36,q3+700+280,320*90,cr1,out);

  {debris}
  hboxclipasmshadeadd (128,0,0,175,36,q3+825+280,320*90,cr2,out);

  {red power}
  hboxclipasmshadeadd (128,0,55*320,292,36,q3+1030+280,320*90,cr2,out);

  {and otherz}
  hboxclipasmshadeadd (128,1,154*320,315,37,q3+1350+280,320*90,cr2,out);

  waitretrace;
  flip32 (out,sega000);
end;

procedure deinit;
begin
freemem (ptr(out,0),$ffff);
freemem (ptr(image,0),$ffff);
freemem (ptr(cr1,0),$ffff);
freemem (ptr(cr2,0),$ffff);
end;

Begin
End.

