unit xfade;
interface

uses routines,playmods,map;

const vidseg = $a000;
      zc = 256;
      xc = 160;
      yc = 100;

      xsize = 32;
      ysize = 32;

      xrange = 140;
      yrange = 140;
      zrange = 140;

      xinc = 1;
      yinc = 1;
      zinc = 0;

      points = 16;
      sinsize = 360;

      fadetime = 400;
      skip = 4;
      fades = 5;
      fadet : array[1..fades,1..2] of string=
        (('vitukov1.map','vitukov1.map'),('vitukov1.map','vitukov2.map'),
         ('vitukov2.map','cfade21.map'),('cfade21.map','cfade22.map'),
         ('cfade22.map','cfade22.map'));

var flareseg,seg1,seg2,virseg : word;
    flarescr,scr1,scr2,virscr : pointer;
    loop : word;
    xphi,yphi,zphi : integer;
    ox,oy,oz : integer;
    stab,ctab : array[0..sinsize] of real;
    point : array[1..points,1..3] of integer;
    trans : array[1..points,1..3] of integer;
    p : word;
    frames : word;
    loppu : boolean;
    trackstatus : miscdata;
    fade : byte;
    fpixels : word;
    orderi : word;

procedure do_xfade(nosound:boolean);

implementation

procedure do_xfade(nosound:boolean);

procedure crossfade(src,dest:word); assembler;
asm
  push ds          { ds talteen }
  mov ds,[src]
  mov es,[dest]
  xor di,di        { di & si = 0 }
  mov cx,64000     { 320 * 200 / 2 }
@loop1:
  mov al,[ds:di]
  mov bl,[es:di]
  cmp al,bl
  jz @over3
  jb @over1
  dec al
@over1:
  cmp al,bl
  ja @over2
  inc al
@over2:
  jmp @over4
@over3:
@over4:
  mov [ds:di],al
  inc di
  dec cx
  jne @loop1
  pop ds           { palautetaan ds }
end;

procedure loadxfade;
begin
  inc(fade);
  if fade<=fades then begin
    loadMAP(seg1,fadet[fade,1]);
    loadMAP(seg2,fadet[fade,2]);
  end else if nosound then loppu:=true;
end;

procedure sprite(x,y:integer;col:word); assembler;
var sy,sx:integer;
asm
  push ds

  mov cx,[x] { ds:si = piste flaressa }
  mov dx,[y]
  sub cx,16
  sub dx,16 { flaren keskipiste = x,y }
  mov [sx],cx
  mov [sy],dx { es:di (sx,sy) = piste virsegiss„ }

  mov ax,[virseg]
  mov es,ax
  mov ax,[flareseg]
  mov ds,ax

  mov ax,dx { di = sy*320+sx }
  shl ax,6
  mov di,ax
  shl ax,2
  add di,ax
  add di,cx
  xor si,si { si = 0 }
  xor dx,dx { dx pit„„ kirjaa flare X:st„ }

@inner:
  cmp [sy],199 { inscreen check (sx,sy) }
  jg @noPixel
  cmp [sy],0
  jl @noPixel
  cmp [sx],319
  jg @noPixel
  cmp [sx],0
  jl @noPixel

  xor bx,bx      { ynn„t„„n ruutu, flareseg ja col }
  mov bl,[ds:si] { flareseg pixel }
  mov ax,[col]
  sub bx,ax
  cmp bx,0
  jg @positive
  xor bx,bx
@positive:
  mov al,[es:di] { virseg pixel }
  add ax,bx      { ax = v„ri }

  cmp ax,256     { v„rin byte-chekki }
  jl @skip1
  mov ax,255
@skip1:
  mov [es:di],al { ...ja piirret„„n al }

@noPixel:
  inc si { p„ivitet„„n indexit sun muut muuttujat }
  inc di
  inc dx
  inc [sx]
  cmp dx,32
  jnz @skip3 { jos rivi ei lopu viel„, hypp„„ @skip3 }

  xor dx,dx { jos dx = 32 (rivin loppu) niin... }
  mov ax,[x] { sx = x-16 }
  sub ax,16
  mov [sx],ax
  inc [sy]
  add di,320-32 { di hypp„„ rivin alasp„in }

@skip3:
  cmp si,32*32 { jos flaren offsetti on 32*32, lopeta }
  jnz @inner

  pop ds
end;

procedure rotatePallot;

var x,y,z : integer;
    sinix,kosix,
    siniy,kosiy,
    siniz,kosiz : real;

begin
  sinix := stab[xphi];
  kosix := ctab[xphi];
  siniy := stab[yphi];
  kosiy := ctab[yphi];
  siniz := stab[zphi];
  kosiz := ctab[zphi];
  for loop:=1 to points do begin
    x := point[loop,1];
    y := point[loop,2];
    z := point[loop,3];
{
                   Ú                                      ¿
                   ³ cy*cz          cy*sz          -sy    ³
     [X]*[Y]*[Z] = ³ sx*sy*cz-cx*sz sx*sy*sz+cx*cz  sx*cy ³
                   ³ cx*sy*cz+sx*sz cx*sy*sz-sx*cz  cx*cy ³
                   À                                      Ù
}
    trans[loop,1]:=round((kosiy*kosiz*x)+((sinix*siniy*kosiz*y)-(kosix*siniz*y))+
                         ((kosix*siniy*kosiz*z)+(sinix*siniz*z)));
    trans[loop,2]:=round((kosiy*siniz*x)+((sinix*siniy*siniz*y)+(kosix*kosiz*y))+
                         ((kosix*siniy*siniz*z)-(sinix*kosiz*z)));
    trans[loop,3]:=round((-siniy*x)+(sinix*kosiy*y)+(kosix*kosiy*z));

  end;
  xphi:=xphi+xinc;
  yphi:=yphi+yinc;
  zphi:=zphi+zinc;
  if xphi>sinsize then xphi:=0;
  if yphi>sinsize then yphi:=0;
  if zphi>sinsize then zphi:=0;
  if xphi<0 then xphi:=sinsize;
  if yphi<0 then yphi:=sinsize;
  if zphi<0 then zphi:=sinsize;
end;

procedure drawPallot;
var dx,dy,dz : integer;
    col : integer;
    sx,sy : integer;
    p : word;

begin
  for p:=1 to points do begin
    dx:=(ox+trans[p,1]) shl 8;
    dy:=(oy+trans[p,2]) shl 8;
    dz:=oz-trans[p,3];
    sx:=round(dx / (zc+dz)) + xc;
    sy:=round(dy / (zc+dz)) + yc;
    if (sx>-xsize)and(sx<320+xsize)and
       (sy>-ysize)and(sy<200+ysize)then begin
      col:=dz;
      if col<0 then col:=0;
      sprite(sx,sy,col);
    end;
  end;
end;

begin
  randomize;
  for p:=1 to points do begin
    point[p,1]:=random(xrange)-(xrange div 2);
    point[p,2]:=random(yrange)-(yrange div 2);
    point[p,3]:=random(zrange)-(zrange div 2);
{    point[p,1]:=0;
    point[p,2]:=0;
    point[p,3]:=0; }
  end;
  fade:=0;
  cls(vidseg);
  randomize;
  getmem(virscr,64000);
  virseg:=seg(virscr^);
  getmem(scr1,64000);
  seg1:=seg(scr1^);
  getmem(scr2,64000);
  seg2:=seg(scr2^);

  for loop:=0 to sinsize do ctab[loop]:=cos(loop*pi/(sinsize div 2));
  for loop:=0 to sinsize do stab[loop]:=sin(loop*pi/(sinsize div 2));
  getmem(flarescr,32*32);
  flareseg:=Seg(flarescr^);
  loadMAPe(flareseg,'flare.map',32*32);
  loadxfade;
  loppu:=false;
  loadPAL('pal1.pal');
  fpixels:=0;
  orderi:=$D;
  repeat
    crossfade(seg1,seg2);
    flip(seg1,virseg);
    rotatePallot;
    drawPallot;
    if nosound then
      inc(fpixels);
      if fpixels>fadetime then begin
        loadxfade;
        fpixels:=0;
      end
    else begin
      get_module_status(trackstatus);
      if trackstatus[0]=orderi then begin
        inc(orderi);
        if orderi<$12 then loadxfade else loppu:=true;
      end;
    end;
    retrace;
    flip(virseg,vidseg);
  until (keypressed)or(loppu);
  flushKB;
  freemem(scr1,320*200);
  freemem(scr2,320*200);
  freemem(virscr,320*200);
  freemem(flarescr,32*32);
end;

end.

