unit god;

interface

uses polygons,routines,playmods,map;

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

      size = 20;
      gap = 25;
      sinsize = 255;

      xinc : integer = 1;
      yinc : integer = 1;
      zinc : integer = 0;

      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 godseg,flareseg,virseg : word;
    godscr,flarescr,virscr : pointer;
    loop : word;
    xphi,yphi,zphi,
    xphi2,yphi2,zphi2 : integer;
    ox,oy,oz : integer;
    stab,ctab : array[0..sinsize] of real;
    ctrans : array[1..cpoints,1..3] of integer;
    trans : array[1..points,1..3] of integer;
    frames : word;
    loppu : boolean;
    trackstatus : miscdata;

procedure do_god(nosound:boolean);

implementation

procedure do_god(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 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 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;

procedure DrawPallot;
var cp,f,p : word;
    vx,vy,vz : integer;
    dist : longint;
    dx,dy,dz : integer;
    sx,sy,c : 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 begin
{      gx = x * 256 / z + 160 ; keskipiste = ruudun keskipiste
       gy = y * 256 / z + 100 ; (320x200-tila) }
      dx:=ctrans[cp,1]+ox;
      dy:=ctrans[cp,2]+oy;
      dz:=ctrans[cp,3]+oz;
      sx:=round(dx shl 8 / (zc+dz)) + xc;
      sy:=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);
    }
      sprite(sx,sy,0);
    end;
end;


begin
  cls(vidseg);
  randomize;
  getmem(virscr,320*200);
  virseg:=seg(virscr^);
  cls(virseg);
  getmem(godscr,320*200);
  godseg:=seg(godscr^);
  loadMAP(godseg,'god.map');
  getmem(flarescr,32*32);
  flareseg:=Seg(flarescr^);
  loadMAPe(flareseg,'flare.map',32*32);

  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;
  ox:=-32;
  oy:=8;
  oz:=0;
  xphi:=0;
  yphi:=0;
  zphi:=0;
  xphi2:=0;
  yphi2:=0;
  zphi2:=0;
  loadpal('pal1.pal');

  repeat
    if nosound then begin
      inc(frames);
      if frames=gap then loppu:=true;
    end else begin
      get_module_status(trackstatus);
      if trackstatus[0]=$15 then loppu:=true;
    end;
    flip(godseg,virseg);
    rotateIsoVehje;
    rotateCubet;
    drawObj;
    retrace;
    flip(virseg,vidseg);
  until (keypressed)or(loppu);
  flushKB;
  freemem(virscr,320*200);
  freemem(flarescr,32*32);
end;

end.

