{**********************************************************************
 *  3D Engine - Like Wolfenstien 3D
 *  This version was converted from BASIC code to Pascal by William Yu
 *  100% Public Domain - All Rights Relinquished.
 *
 *  Original BASIC Code by Peter Cooper
 *
 *  Graphics Routines courtesy of Sune Marcher (I think)
 *  Joystick Routines courtesy of Michael Genesis
 *
 *  Email: William Yu <voxel@freenet.edmonton.ab.ca>
 *  HPage: http://www.freenet.edmonton.ab.ca/~voxel/
 *
 *  Instructions:  <SPACE> or Button 1 on joystick to open door.
 *                 Door is identified by the colour yellow.
 **********************************************************************}
uses crt;

Const
  vidseg:word=$a000;
      Gameport=$201;
      Timer0=$40;
      TControl=$43;
      MaxLoops=5000;
      Button1=$10; Button2=$20; Button3=$40; Button5=$80;
      Xaxis1=$01; Yaxis1=$02; Xaxis2=$04; Yaxis2=$08;
  Page : Byte = 0;
  Grid : Array [1..24,1..24] of byte =
  ((9, 62, 63, 64, 65, 66, 67, 68, 69, 70, 71, 72,73, 74, 74,  1,  9,  1,  9,  1,  9,  1,  9,  1),
   (1,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0, 0,  0, 75,  2,  0,  0, 11,  3,  0,  0,  0,  9),
   (9,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0, 0,  0, 76, 10,  0,  0,  3, 11,  0, 12,  0,  1),
   (1,  0,  0, 31, 30, 29, 28, 27, 26, 25, 24, 23,22, 14, 27,  2,  0,  0,  0,  0,  0,  4,  0,  9),
   (9,  0,  0, 20,  0,  0,  0,  0,  0,  0,  0,  0, 0,  0, 28, 10,  0,  0,  0,  0,  0, 12,  0,  1),
   (1,  0, 21, 20,  0,  0,  0,  0,  0,  0,  0,  0, 0,  0, 29,  2,  0,  0,  0, 25,  0,  4,  0,  9),
   (9,  0, 22, 21, 22, 23, 24, 25, 26, 27, 28, 28,30, 14, 30, 10,  0,  0,  0, 26,  0, 12,  0,  1),
   (1,  0, 23,  0,  0,  0,  0,  0,  0,  0,  0,  9, 1,  0, 10,  2,  0,  0,  0, 27,  0,  4,  0,  9),
   (9,  0, 24,  0,  0,  0,  0,  0,  0,  0,  0,  1, 9,  0,  2, 10,  0, 43,  0, 28,  0, 12,  0,  1),
   (1,  0, 25,  0, 31, 30, 29, 28, 27, 26,  0,  9, 1,  0, 10,  2,  0, 39,  0, 29,  0,  4,  0,  9),
   (9,  0, 26,  0, 30,  0,  0,  0,  0, 25,  0,  1, 9,  0,  2, 10,  0, 43,  0, 30,  0, 12,  0,  1),
   (1,  0,  0,  0, 29,  0,  0,  0,  0, 24,  0,  0, 0,  0,  0,  0,  0,  0,  0, 31,  0,  0,  0,  9),
   (9,  0,  0,  0, 28,  0, 23,  0,  0, 23,  0, 10, 2,  0,  3, 11,  0,  0,  0, 30,  0,  0,  0,  1),
   (1,  9,  1,  0, 27,  0, 22,  0,  0, 22,  0,  2,10,  0, 11,  3,  0,  0,  0, 29,  0, 55,  0,  9),
   (9,  1,  9,  0, 26,  0, 21,  0,  0, 21, 10, 10, 2,  0,  3, 11,  0,  0,  0, 28,  0, 54,  0,  1),
   (1,  0,  0,  0,  0,  0, 22,  0,  0, 22,  0,  0, 0,  0, 11,  3,  0,  0,  0, 27,  0, 53,  0,  9),
   (9,  0,  0,  0,  0,  0, 23,  0,  0, 23,  0,  0, 0,  0,  0,  0,  0,  0,  0, 26,  0, 52,  0,  1),
   (1,  9,  1,  9,  1,  9, 24,  0,  0, 24,  0,  0, 2,  0,  0,  0,  0,  0,  0, 25,  0, 51,  0,  9),
   (9,  0,  0,  0,  0,  0,  0,  0,  0, 25,  0,  0,10,  0,  0,  4, 12,  4, 12, 24,  0, 50,  0,  1),
   (1,  0,  0,  0,  0,  0, 26,  0,  0, 26,  0,  0, 2,  0,  0, 12,  4, 12,  4, 23,  0, 49,  0,  9),
   (9,  0,  2, 10,  0,  0, 27,  0,  0, 27,  0,  0,11,  0,  0,  4, 12,  4, 12, 22,  0, 48,  0,  1),
   (1,  0,  0,  0,  5,  0, 28,  0,  0,  0,  0,  0, 3,  0,  0,  0,  0,  0,  0,  0,  0, 47,  0,  9),
   (9,  0,  0,  0, 13,  0, 29,  0,  0,  0,  0,  0,11,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  1),
   (1,  9,  1,  9,  1,  9,  1,  9,  1,  9,  1,  9, 1,  9,  1,  9,  1,  9,  1,  9,  1,  9,  1,  9));

Var
  vseg:word;
  virt:pointer;
  I,J,X,Y : Word;
  color : byte;
  STable : Array [-31..392] of Real;
  CTable : Array [-31..392] of Real;
  Factor,Angle,NewPX,PX,NewPY,PY,StepX,StepY,XX,YY : Real;
  A,Heading,Rand,Stride,Turn,X1,L,K,DT,H,DD,WY,WYY : Integer;
  Moved,Joy,Stop,RandSeed : Boolean;

var ky:char; done:boolean; MaxX,Minx,MaxY,MinY:word;
    MX,MY:byte;     {percent-adjusted centered joystick values}
    CX,CY,Dely:byte;   {Cursor positions and loop Delay}

Function JoyExist:boolean;
var
   temp:byte;
begin
   asm
      mov ah,84h
      mov dx,00h
      int 15h
      mov temp,al
   end;
   if temp=0 then JoyExist:=false
   else JoyExist:=true;
end;

Procedure GetJoy; assembler;
label loop1,loop2,axis1,loop3,axdone;
 
asm
    cli               {disable interrupts}
    mov  dx,Gameport;  {set port adress}
    mov  cx,MaxLoops;
    mov  al,0;
    out  TControl,al;  {latch count in timer0}
    in   al,Timer0;     {low byte of timer count}
    mov  ah,al;
    in   al,Timer0;     {high byte of timer count}
    xchg al,ah;
    mov  bx,ax;        {start count in BX}
    out  dx,al;        {trigger game port}
    in   al,dx
loop1:
    in   al,dx;        {Read Gameport}
    mov  ah,al;
    and  ax,$0201;      {X axis in al; Y axis in ah}
    test al,Xaxis1;      {is X axis done?}
    jz   axis1;
    test ah,Yaxis1;      {is Y axis done?}
    loopnz loop1;
                       {Y axis done first!}
    out  TControl,al;
    in   al,Timer0;     {low byte of Y axis count}
    mov  ah,al;
    in   al,Timer0;     {high byte of Y axis count}
    xchg al,ah
    push ax            {store Y axis count on the stack}
loop2:
    in   al,dx;
    and  al,Xaxis1;
    test al,Xaxis1;      {Test X axis}
    loopnz loop2;
                       {X axis done(after Y)}
    out  TControl,al;
    in   al,Timer0;
    mov  ah,al;
    in   al,Timer0;
    xchg al,ah         {X axis count}
    sub  ax,bx;        {find difference}
    neg  ax
    mov  X,ax;         {Save X axis time}
    pop  ax;           {Get Y axis count}
    sub  ax,bx
    neg  ax
    mov  Y,ax;         {Save Y axis time}
    jmp  axdone        {We're done.}
 
axis1:                 {X axis done first}
    out  TControl,al;
    in   al,Timer0
    mov  ah,al
    in   al,Timer0
    xchg al,ah
    push ax            {Store X axis count on the stack}
loop3:
    in   al,dx
    and  al,Yaxis1;
    test al,Yaxis1;
    loopnz loop3;
                        {Y is done}
    out  TControl,al;
    in   al,Timer0;
    mov  ah,al
    in   al,Timer0
    xchg al,ah
    sub  ax,bx
    neg  ax
    mov  Y,ax           {Save Y axis Time}
    pop  ax             {Get X axis count}
    sub  ax,bx
    neg  ax
    mov  X,ax           {Save X axis count}
axdone:
    sti
end;

var b1,b2,b3,b4:byte;
Procedure Getbutton; assembler;
label bt2,bt3,bt4,done;

asm
    mov b1,0
    mov b2,0
    mov b3,0
    mov b4,0
    mov dx,Gameport;
    in al,dx;
    test al,$10;
    jnz bt2             {there must be a better way to do this}
    mov b1,1
bt2:
    test al,$20;
    jnz bt3
    mov b2,1
bt3:
    test al,$40;
    jnz bt4;
    mov b3,1;
bt4:
    test al,$80;
    jnz done;
    mov b4,1
done:
end;

procedure setmode(const mode:word);assembler;
asm
  mov ax,mode
  int 10h
end;

procedure flip386(const a,b:word); assembler;
asm
  push ds
  mov ds,a
  mov es,b
  xor si,si
  xor di,di
  mov cx,16000
  db 66h; rep movsw
  pop ds
end;

procedure clear386(const where:word;const c:byte); assembler;
asm
  mov es,where
  xor ax,ax
  xor di,di
  mov al,[c]
  mov ah,al
  db 66h; shr ax,16
  mov al,[c]
  mov ah,al
  mov cx,16000
  db 66h; rep stosw
end;

procedure vline2(const x,y1,y2,where:word;const c:byte);assembler;
asm
  mov ax,where
  mov es,ax
  mov ax,[y1]
  mov bx,ax
  shl ax,8
  shl bx,6
  add ax,bx
  mov di,ax
  mov ax,[y2]
  mov bx,ax
  shl ax,8
  shl bx,6
  add bx,ax
  mov al,[c]
  mov cx,[x]
  add di,cx
  add bx,cx

  @@loop1:
    mov es:[di],al
    add di,320
    cmp di,bx
    jne @@loop1
end;

FUNCTION GetKey: CHAR;
INLINE($b4/$10/$cd/$16/$88/$e0);

Procedure ComputeView;
Begin
  X1 := 0;
  FOR A := (Heading + 32) Downto (Heading - 31) do
  Begin
    StepX := STable[A]; StepY := CTable[A];
    XX := PX; YY := PY;
    L := 0;
    Repeat
      XX := XX - StepX; YY := YY - StepY;
      L := L + 1;
      K := Grid[Round(XX), Round(YY)];
    Until K<>0;
    DD := 900 div L;
    H := DD + DD;
    DT := 100 - DD;
    For I:=0 to 4 do
    Begin
      WY:=DT+H;
      WYY:=DT;
      If WY>199 then WY:=199;
      If WYY<0 then WYY:=0;
      vLINE2 (X1+I, WYY-Rand, WY-Rand, Vseg, K);
    End;
    X1 := X1 + 5;
  End;
End;

Procedure UpdateScreen;
Begin
 clear386(vseg,0);
 ComputeView;
 flip386(vseg,vidseg);
End;

Procedure MoveRight;
Begin
  Heading := (Heading + Turn) MOD 360;
End;

Procedure MoveLeft;
Begin
  Heading := (Heading + (360 - Turn)) MOD 360;
End;

Procedure MoveUp;
Begin
  NewPX := PX - (STable[Heading] * Stride);
  NewPY := PY - (CTable[Heading] * Stride);
  IF Grid[Round(NewPX), Round(NewPY)] = 0 THEN
  Begin
    PX := NewPX; PY := NewPY;
    If RandSeed Then
       Rand:=Rand+1
    else
       Rand:=Rand-1;
    If (Rand = 3) or (Rand=0) then RandSeed:=NOT RandSeed;
  End
  ELSE {'tried to walk through a wall}
  Begin
    Sound(80);Delay(10);
  End;
End;

Procedure MoveDown;
Begin
  NewPX := PX + (STable[Heading] * Stride);
  NewPY := PY + (CTable[Heading] * Stride);
  IF Grid[Round(NewPX), Round(NewPY)] = 0 THEN
  Begin
    PX := NewPX; PY := NewPY;
    If RandSeed Then
       Rand:=Rand+1
    else
       Rand:=Rand-1;
    If (Rand = 3) or (Rand=0) then RandSeed:=NOT RandSeed;
  End
  ELSE {'tried to walk through a wall}
  Begin
    Sound(80);Delay(10);
  End;
End;

begin
 Joy:=False;
 If JoyExist Then Begin
   ClrScr;
   Write('Use joystick [Y/N]? ');
   Readln(ky);
   If Upcase(ky)='Y' Then Begin
     Joy:=True;
     done:=false;
     GetJoy;
     MaxX:=X; MinX:=X; MaxY:=Y; MinY:=Y;    {initial values}
     Writeln('Whip that joystick around until the 4 leftmost numbers stop changing,');
     writeln('then center the joystick and press button 1 or any key.');
     if KeyPressed then ky:=ReadKey;   {Clear KeyBuffer}
     while not done do begin
       GetJoy;
       if X>=MaxX then MaxX:=X;      {find the range of the joystick}
       if X<=MinX then MinX:=X;
       if Y>=MaxY then MaxY:=Y;
       if Y<=MinY then MinY:=Y;
       gotoxy(1,5);
       Writeln(MinX,'    ',MaxX,'    ',X,'      ');
       Writeln(MinY,'    ',MaxY,'    ',Y,'      ');
       GetButton;
       if B1=1 then Done:=true;
       if KeyPressed then Done:=true;
     end;
     if KeyPressed then ky:=ReadKey;
     X:=round(((X-MinX)/MaxX)*100);  {Percent-adjust:  this scales }
     Y:=round(((Y-MInY)/MaxY)*100);  { the number to between 1 and 100.}
     MX:=X; MY:=Y;
 End
 Else
   Joy:=False;
 End; {Joystick Exist check }

 SetMode($13);
 getmem(virt,64000);
 vseg:=seg(virt^);
 Factor := (ArcTan(1) * 8) / 360;
 FOR A := 0 TO 359 Do
 Begin
   Angle := A * Factor;
   STable[A] := Sin(Angle) * 0.1;
   CTable[A] := Cos(Angle) * 0.1;
 End;
 FOR A := -31 to -1 Do
 Begin
   STable[A] := STable[A + 360];
   CTable[A] := CTable[A + 360];
 End;
 FOR A := 360 to 392 Do
 Begin
   STable[A] := STable[A - 360];
   CTable[A] := CTable[A - 360];
 End;

 PX := 5; PY := 5;   { 'the starting coordinates of the player's location }
 Stride := 3;        { 'the distance covered in one "step" by the player  }
                     { '   by pressing the up or down arrow keys          }
 Heading := 180;     { 'the heading of the player (in degrees)            }
 Turn := 5;          { 'number of degrees of rotation produced by         }
                     { '   pressing the right or left arrow keys          }
 UpdateScreen;
 RandSeed := True;

Repeat
 If Joy Then Begin
  Dely:=1;         { Use this to slow joystick down }
  Done:=False;
  while not done do begin;
    GetJoy;
    X:=round(((X-MinX)/MaxX)*100);
    Y:=round(((Y-MInY)/MaxY)*100);
    Moved:=False;
    if X>MX+10 then Begin
      Moved:=True;
      MoveLeft;
      If Y<MY-10 then MoveUp;
      If Y>MY+10 then MoveDown;
      UpdateScreen;
    End;
    if X<MX-10 then Begin
      Moved:=True;
      MoveRight;
      If Y<MY-10 then MoveUp;
      If Y>MY+10 then MoveDown;
      UpdateScreen;
    End;
    if (Y>MY+10) AND (NOT Moved) then Begin
      MoveDown;
      If X<MX-10 then MoveRight;
      If X>MX+10 then MoveLeft;
      UpdateScreen;
    End;
    if (Y<MY-10) AND (NOT Moved) then Begin
      MoveUp;
      If X>MX+10 then MoveLeft;
      If X<MX-10 then MoveRight;
      UpdateScreen;
    End;
    GetButton;
    if b1=1 then
    Begin
       If K=14 Then Begin Grid[Round(XX), Round(YY)]:=0;UpdateScreen End;
    End;
    If b3=1 then Dely:=(Dely+1)mod 250;
    if b4=1 then Dely:=(Dely-1)mod 250;
    if Keypressed then done:=true;
    delay(Dely);
  end;
 End; { Joystick }
     Case GetKey of
         #71 : Begin MoveRight;MoveUp;UpdateScreen; End;  {PgUp}
         #72 : Begin MoveUp;UpdateScreen; End;            {Up}
         #73 : Begin MoveLeft;MoveUp;UpdateScreen; End;   {Home}
         #75 : Begin MoveRight;UpdateScreen; End;         {Right}
         #77 : Begin MoveLeft;UpdateScreen; End;          {Left}
         #79 : Begin MoveLeft;MoveDown;UpdateScreen; End; {End}
         #80 : Begin MoveDown;UpdateScreen; End;          {Down}
         #81 : Begin MoveRight;MoveDown;UpdateScreen; End;{PgDn}
         #57 : Begin
                 If K=14 Then Begin Grid[Round(XX), Round(YY)]:=0;UpdateScreen End;
               End;
         #01 : Stop := True;
     End;
Until Stop;
SetMode($03);
nOsOUND;
end.