unit pillua;

interface

uses routines,playmods,map;

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

      sinsize = 360;

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

      freimit = 640;

      gap = 25;
      size = 20;
      skip = 4;
      ambient = 32;
      shine = 2;

      cpoints = 8;
      faces = 6;
      points = 8;
      point : array[1..points,1..3] of integer =
        ((-size,-size,-size),(size,-size,-size),
         (size,size,-size),(-size,size,-size),
         (-size,-size,size),(size,-size,size),
         (size,size,size),(-size,size,size));
      face : array[1..faces,1..4] of byte =
       ((1,2,3,4),(5,6,7,8),(1,5,6,2),(2,6,7,3),
        (3,7,8,4),(4,1,5,8));
      cpoint : array[1..cpoints,1..3] of integer =
        ((-gap,-gap,-gap),(gap,-gap,-gap),
         (gap,gap,-gap),(-gap,gap,-gap),
         (-gap,-gap,gap),(gap,-gap,gap),
         (gap,gap,gap),(-gap,gap,gap));

var picseg,virseg : word;
    picscr,virscr : pointer;
    loop : word;
    xphi,yphi,zphi,
    xphi2,yphi2,zphi2 : integer;
    ox,oy,oz : integer;
    stab,ctab : array[0..sinsize] of real;
    trans : array[1..points,1..3] of integer;
    ctrans : array[1..cpoints,1..3] of integer;
    pal : array[0..255,1..3] of byte;
    palOK : boolean;
    frames : word;
    loppu : boolean;
    trackstatus : miscdata;
    status : miscdata;

procedure do_pillua(nosound:boolean);

implementation

procedure do_pillua(nosound:boolean);

procedure dline (x1,y1,x2,y2:word ; col:byte); assembler;
var ddx,ddy : word;
    sx,sy : word;                {  This procedure has not been  }
asm                              {  made by me... It came from   }
        mov     ax,virseg        {  some nameless source.        }
        mov     es,ax
        mov     ax,[y1]
        mov     bx,320
        imul    bx
        mov     di,[x1]
        add     di,ax
        mov     ax,[x2]
        clc
        mov     bx,1
        sub     ax,[x1]
        jnc     @@1
        neg     ax
        mov     bx,0ffffh
@@1:    mov     [ddx],ax
        mov     [sx],bx
        mov     ax,[y2]
        clc
        mov     bx,320
        sub     ax,[y1]
        jnc     @@2
        neg     ax
        mov     bx,-320
@@2:    mov     [ddy],ax
        mov     [sy],bx

        cmp     ax,[ddx]
        ja      @@yGrtr
        mov     cx,[ddx]
        inc     cx
        mov     bx,[ddx]
        shr     bx,1
        mov     al,[col]
@@x1:
        cmp     byte ptr [es:di],al
        ja @nodraw
        mov     byte ptr [es:di],al
@nodraw:
        add     di,[sx]
        clc
        sub     bx,[ddy]
        jnc     @@xg
        add     di,[sy]
        add     bx,[ddx]
@@xg:   loop    @@x1
        jmp     @@ret
@@yGrtr:mov     cx,[ddy]
        inc     cx
        mov     bx,[ddy]
        shr     bx,1
        mov     al,[col]
@@y1:
        cmp     byte ptr [es:di],al
        ja @nodraw2
        mov     byte ptr [es:di],al
@nodraw2:
        add     di,[sy]
        clc
        sub     bx,[ddx]
        jnc     @@yg
        add     di,[sx]
        add     bx,[ddy]
@@yg:   loop    @@y1
@@ret:
end;

procedure rotateisovehje;

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 := cpoint[loop,1];
    y := cpoint[loop,2];
    z := cpoint[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 ³
                   À                                      Ù
}
    ctrans[loop,1]:=round((kosiy*kosiz*x)+((sinix*siniy*kosiz*y)-(kosix*siniz*y))+
                         ((kosix*siniy*kosiz*z)+(sinix*siniz*z)));
    ctrans[loop,2]:=round((kosiy*siniz*x)+((sinix*siniy*siniz*y)+(kosix*kosiz*y))+
                         ((kosix*siniy*siniz*z)-(sinix*kosiz*z)));
    ctrans[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 rotatecubet;

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

begin
  sinix := stab[xphi2];
  kosix := ctab[xphi2];
  siniy := stab[yphi2];
  kosiy := ctab[yphi2];
  siniz := stab[zphi2];
  kosiz := ctab[zphi2];
  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;
  xphi2:=xphi2-xinc;
  yphi2:=yphi2-yinc;
  zphi2:=zphi2-zinc;
  if xphi2>sinsize then xphi2:=0;
  if yphi2>sinsize then yphi2:=0;
  if zphi2>sinsize then zphi2:=0;
  if xphi2<0 then xphi2:=sinsize;
  if yphi2<0 then yphi2:=sinsize;
  if zphi2<0 then zphi2:=sinsize;
end;

procedure DrawObj;
var cp,f,p : word;
    vx,vy,vz : integer;
    dist : longint;
    dx,dy,dz : integer;
    sx,sy,c : array[1..4] of integer;

function inrange(value:integer):byte;
begin
  inrange:=value;
  if value<0 then inrange:=0;
  if value>255 then inrange:=255;
end;

begin
  { ei tartte sorttia }
  for cp:=1 to cpoints do
  for f:=1 to faces do begin
    for p:=1 to 4 do begin
{      gx = x * 256 / z + 160 ; keskipiste = ruudun keskipiste
       gy = y * 256 / z + 100 ; (320x200-tila) }
      dx:=ctrans[cp,1]+ox+trans[face[f,p],1];
      dy:=ctrans[cp,2]+oy+trans[face[f,p],2];
      dz:=ctrans[cp,3]+oz-trans[face[f,p],3];
      sx[p]:=round(dx shl 8 / (zc+dz)) + xc;
      sy[p]:=round(dy shl 8 / (zc+dz)) + yc;
{       __
       |AB| = sqrt( X^2 + Y^2 + Z^2 ).

      vx:=dx-lx;
      vy:=dy-ly;
      dist:=round(sqrt(abs((vx*vx)+(vy*vy)+(vz*vz))));
      c[p]:=inrange(256-dist);
    }
      c[p]:=inrange(ambient-(dz div shine));
    end;
    if c[1]+c[2]+c[3]>0 then
{    gouraud_poly_real(virseg,sx[1],sy[1],
                             sx[2],sy[2],
                             sx[3],sy[3],
                             c[1],c[2],c[3]); }
    dline(sx[1],sy[1],sx[2],sy[2],(c[1]+c[2] shr 1));
    dline(sx[2],sy[2],sx[3],sy[3],(c[2]+c[3] shr 1));
    dline(sx[3],sy[3],sx[4],sy[4],(c[3]+c[4] shr 1));
    dline(sx[4],sy[4],sx[1],sy[1],(c[4]+c[1] shr 1));
  end;
end;

begin
  cls(vidseg);
  randomize;
  getmem(virscr,320*200);
  virseg:=seg(virscr^);
  cls(virseg);
  getmem(picscr,320*200);
  picseg:=seg(picscr^);
  loadmap(picseg,'pillua.map');

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

  loppu:=false;
  frames:=0;
  loadPAL('pal1.pal');
  repeat
    inc(frames);
    if frames=skip then begin
      frames:=0;
      get_module_status(trackstatus);
      if trackstatus[0]=$20 then loppu:=true;
    end;
    flip(picseg,virseg);
    rotateIsoVehje;
    rotateCubet;
    drawObj;
    retrace;
    flip(virseg,vidseg);
  until (keypressed)or(loppu);
  flushKB;
  freemem(virscr,320*200);
  freemem(picscr,320*200);
end;

end.

