unit hitler;

interface

uses routines,playmods,map;

const vidseg = $a000;
      points = 24;
      zc = 256;
      xc = 160;
      yc = 100;
      xsize = 32;
      ysize = 32;
      xrange = 140;
      yrange = 140;
      zrange = 140;

      xinc = 256;
      yinc = 0;
      zinc = 512;
      sinsize = 360;

      skip = 5;
      bframes = 5;
      pans = 9;
      gap = 45;

      maps : array[1..9] of string[13] =
        ('line1.map','line2.map','line3.map','line4.map','line5.map','line6.map','line7.map',
         'line8.map','line9.map');
      yo = 32;
      ygap = 16;

var parseg,panseg,panseg2,virseg,flareseg : word;
    parscr,panscr,panscr2,virscr,flarescr : pointer;
    loop : word;
    x,y,z : integer;
    p : word;
    stab,ctab : array[0..sinsize] of real;
    point : array[1..points,1..3] of integer;
    trans : array[1..points,1..3] of integer;
    frames : word;
    loppu : boolean;
    status : miscdata;
    xphi,yphi,zphi : longint;
    line : byte;
    delay : word;
    bframe : word;

procedure do_hitler(nosound:boolean);

implementation

procedure do_hitler(nosound:boolean);

procedure sprite(dest:word;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,[dest]
  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;

{ rotate object [XYZ], fixed point sinit }
procedure rotate;

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

begin
  sinix := stab[xphi shr 8];
  kosix := ctab[xphi shr 8];
  siniy := stab[yphi shr 8];
  kosiy := ctab[yphi shr 8];
  siniz := stab[zphi shr 8];
  kosiz := ctab[zphi shr 8];
  for loop:=1 to points do begin
    x := point[loop,1];
    y := point[loop,2];
    z := point[loop,3];
{ 3Dica:
                   Ú                                      ¿
                   ³ 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;
  if xphi shr 8<sinsize then xphi:=xphi+xinc else xphi:=0;
  if yphi shr 8<sinsize then yphi:=yphi+yinc else yphi:=0;
  if zphi shr 8<sinsize then zphi:=zphi+zinc else zphi:=0;
end;

{ x>128 x<-128 BUGI }
procedure drawPallot;
var dx,dy,dz : integer;
    col : integer;
    sx,sy : integer;

begin
  for p:=1 to points do begin
    dx:=(x+trans[p,1]) shl 8;
    dy:=(y+trans[p,2]) shl 8;
    dz:=z-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(parseg,sx,sy,col);
    end;
  end;
end;

procedure addfont2vir(source,dest,sOff,yOff,valo:word); assembler;
asm
  push ds          { ds talteen }
  mov ds,[source]
  mov es,[dest]
  mov ax,yOff
  sub ax,8         { menn„„n ihan keskelle }
  shl ax,6
  mov di,ax
  shl ax,2
  add di,ax
  mov ax,[soff] { si = sOff*16*320 }
  xor dx,dx
  shl ax,4
  mov cx,320
  mul cx
  mov si,ax
  mov cx,320*16
@inner:
  xor ax,ax
  xor bx,bx
  mov al,[ds:si]
  mov [es:di],al
  inc di
  inc si
  loop @inner
  pop ds           { palautetaan ds }
end;

procedure motionblur(scoff:word); assembler;
    asm
      mov es,[panseg2]
      mov di,[scoff]
      add di,4
      mov si,320*16-8
      @outer:

          xor ax,ax
          xor bx,bx
          mov al,[es:di+1]
          mov bl,[es:di+2]
          add ax,bx
          mov bl,[es:di+3]
          add ax,bx
          mov bl,[es:di+4]
          add ax,bx

          mov bl,[es:di-1]
          add ax,bx
          mov bl,[es:di-2]
          add ax,bx
          mov bl,[es:di-3]
          add ax,bx
          mov bl,[es:di-4]
          add ax,bx

          shr ax,3
          cmp ax,6
          jb @jump
          sub ax,6
          @jump:
          mov [es:di],al
          inc di

      dec si
      jne @outer
    end;

procedure flipe(src,dest,sOff,dOff:word); assembler;
asm
  push ds
  mov ax,[src]
  mov ds,ax
  mov ax,[dest]
  mov es,ax
  mov si,[soff]
  mov di,[doff]
  mov cx,320*8
  rep movsw
  pop ds
end;

procedure addflip(src,dest:word); assembler;
asm
  push ds
  mov ax,[src]
  mov ds,ax
  mov ax,[dest]
  mov es,ax
  xor si,si
  mov cx,64000
  @inner:
    xor ax,ax
    mov al,[ds:si]
    mov bl,[es:si]
    add ax,bx
    cmp ax,256
    jb @ok
    mov ax,255
    @ok:
    mov [es:si],al
    inc si
  loop @inner
  pop ds
end;

procedure LoadPAN;
var srcoff:word;
begin
  srcoff:=line*320*16;
  for loop:=0 to bframes-1 do begin
    flipe(panseg2,panseg,srcoff,loop*320*16);
    motionblur(srcoff);
  end;
end;

begin
  cls(vidseg);
  randomize;

  { getmems }
  getmem(virscr,320*200);
  virseg:=seg(virscr^);
  cls(virseg);
  getmem(flarescr,32*32);
  flareseg:=Seg(flarescr^);
  getmem(panscr,320*16*bframes); { blurred versions }
  panseg:=seg(panscr^);
  getmem(panscr2,320*16*pans); { lines }
  panseg2:=seg(panscr2^);
  getmem(parscr,320*200);
  parseg:=seg(parscr^);
  cls(parseg);

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

  loadMAPe(flareseg,'flare.map',32*32);

  { load all maps to panseg }
  for line:=1 to pans do
    loadMAPeo((line-1)*320*16,panseg2,maps[line],320*16);

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

  loadPAL('pal3.pal');

  x:=0;
  y:=0;
  z:=0;
  line:=0;
  frames:=0;
  bframe:=bframes+1;
  loppu:=false;
  delay:=0;
  loadpan;

  repeat
    if frames=skip then begin
      get_module_status(status);
      if status[0]=8 then loppu:=true;

      if bframe>0 then dec(bframe);
      addfont2vir(panseg,virseg,bframe,yo+(line*ygap),0);
      inc(delay);
      if (delay=gap)and(line<pans-1) then begin
        delay:=0;
        inc(line);
        bframe:=bframes+1;
        loadpan;
      end;
      frames:=0;
      if nosound then
        if line=pans then loppu:=true;
    end;
    inc(frames);
    rotate;
    cls(parseg);
    drawPallot;
    addflip(virseg,parseg);
    retrace;
    flip(parseg,vidseg);
  until (keypressed)or(loppu);
  flushKB;
  freemem(virscr,320*200);
  freemem(flarescr,32*32);
  freemem(panscr,320*16*bframes);
  freemem(panscr2,320*16*pans);
  freemem(parscr,320*200);
end;

end.