home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 16 / CD_ASCQ_16_0994.iso / news / 573 / 3dlab101 / l3d.pas < prev    next >
Pascal/Delphi Source File  |  1994-05-26  |  27KB  |  673 lines
  1. {────────────────────────────────────────────────────────────────────────────}
  2. {───( C ) Copyright 1994 By Kimmo Fredriksson.───────────────────────────────}
  3. {────────────────────────────────────────────────────────────────────────────}
  4. {───Labyrinth-3D─────────────────────────────────────────────────────────────}
  5. {────────────────────────────────────────────────────────────────────────────}
  6. {────────────────────────────────────────────────────────────────────────────}
  7. {───Internet email: Kimmo.Fredriksson@Helsinki.FI────────────────────────────}
  8. {────────────────────────────────────────────────────────────────────────────}
  9. {────────────────────────────────────────────────────────────────────────────}
  10. {───If you want the Turbo Pascal and assembler source code for the TxtMap────}
  11. {───Unit, register today. Send $20 (or 100 Fmk) to me, and I'll send all─────}
  12. {───the source to you.───────────────────────────────────────────────────────}
  13. {────────────────────────────────────────────────────────────────────────────}
  14. {─────────Kimmo Fredriksson──────────────────────────────────────────────────}
  15. {─────────Silvontie 38───────────────────────────────────────────────────────}
  16. {─────────37740 Haukila──────────────────────────────────────────────────────}
  17. {─────────FINLAND────────────────────────────────────────────────────────────}
  18. {────────────────────────────────────────────────────────────────────────────}
  19.  
  20. {$A+   Word Alignment                              }
  21. {$B-   Short-circuit Boolean expression evaluation }
  22. {$D-   Debug information off                       }
  23. {$E-   Disable 80x87 run-time library              }
  24. {$F-   Force Far Calls off                         }
  25. {$G+   80286 instructions                          }
  26. {$I-   I/O checking off                            }
  27. {$L-   Local Symbols off                           }
  28. {$N-   Calc reals by software                      }
  29. {$O-   Overlays not allowed                        }
  30. {$P-   Open string parameters disabled             }
  31. {$Q-   Overflow Check off                          }
  32. {$R-   Range-checking off               }
  33. {$S-   Stack-checking off               }
  34. {$T-   Type-Check pointers off                     }
  35. {$V-   Strict Var-String off               }
  36. {$X+   Extended Syntax on               }
  37.  
  38. {$M    $1000, $00000, $A0000                       }
  39.  
  40. PROGRAM    Labyrinth3D;
  41.  
  42. USES    L3DData,
  43.     L3DMenu,
  44.     L3DWorld,
  45.     AsmSys,
  46.     Mouse,
  47.     Controls,
  48.     TxtMap,
  49.     VGAPal,
  50.     VGA256,
  51.     Error,
  52.     PCX,
  53.     DOS;
  54. {
  55.  ╔═════════════════════════════════════════════════════════════════════════╗
  56.  ║ PROCEDURE InitCreature                                                  ║
  57.  ╟─────────────────────────────────────────────────────────────────────────╢
  58.  ║ Input  : X, Z co'ordinates, desired index to TxtMap array (of pointers),║
  59.  ║          movement-strategy 0..2                                         ║
  60.  ╟─────────────────────────────────────────────────────────────────────────╢
  61.  ║ See the MoveCreatures-procedure for movement-strategy                   ║
  62.  ╚═════════════════════════════════════════════════════════════════════════╝
  63. }
  64. PROCEDURE InitCreature( X, Z : Integer; TI, MT : Byte );
  65. VAR IP : Integer;
  66. BEGIN
  67.   IF NumOfCreats = MaxCreatures THEN FatalError('"Creatures" array full!');
  68.   New( Creatures[ NumOfCreats ]);
  69.   WITH Creatures[ NumOfCreats ]^ DO
  70.     BEGIN { creature to Obj-array, and address of new object to TxtRecPtr -> }
  71.       TxtRecPtr := Obj[ InitAnimObj( X, Z, Creature, TI, 0 ) ];
  72.       IP := TxtRecPtr^.LPInd; { LPInd = RPInd }
  73.       XP := LongInt( Points[ IP ].X ) * 256; { 8-bit fixed point... }
  74.       ZP := LongInt( Points[ IP ].Z ) * 256;
  75.       MoveType := MT
  76.     END;
  77.   Inc( NumOfCreats )
  78. END;
  79. {
  80.  ╔═════════════════════════════════════════════════════════════════════════╗
  81.  ║ PROCEDURE InitWorm                                                      ║
  82.  ╟─────────────────────────────────────────────────────────────────────────╢
  83.  ║ Input : Worms head coordinates, length and color                        ║
  84.  ╟─────────────────────────────────────────────────────────────────────────╢
  85.  ║ Length means the num. of 'balls', which the worm consist. Every ball is ║
  86.  ║ animated separately. In here, the TI parameter in the InitAnimObj -call ║
  87.  ║ means the color of the ball.                                            ║
  88.  ╚═════════════════════════════════════════════════════════════════════════╝
  89. }
  90. PROCEDURE InitWorm( HeadX, HeadZ, WLen : Integer; c : Byte );
  91. VAR IP, i : Integer;
  92. BEGIN
  93.   IF NumOfWorms = MaxWorms THEN FatalError('"Worms" array full!');
  94.   IF WLen > MaxWormLen THEN FatalError('Too long Worm!');
  95.   New( Worms[ NumOfWorms ]);
  96.   WITH Worms[ NumOfWorms ]^ DO
  97.     BEGIN
  98.       Len := WLen;
  99.       YAng := 0;
  100.       YAngInc := 0; {ball to Obj array, and objects address to TxtRecPtr}
  101.       FOR i := 0 TO Len - 1 DO
  102.     TxtRecPtr[ i ] := Obj[ InitAnimObj( HeadX, HeadZ, Worm, c - i, i * 32 MOD 360 ) ];
  103.       IP := TxtRecPtr[ 0 ]^.LPInd;
  104.       XP := LongInt( Points[ IP ].X ) * 256; { 8-bit fixed point...}
  105.       ZP := LongInt( Points[ IP ].Z ) * 256;
  106.     END;
  107.   Inc( NumOfWorms )
  108. END;
  109. {
  110.  ╔═════════════════════════════════════════════════════════════════════════╗
  111.  ║ PROCEDURE MoveWorms                                                     ║
  112.  ╟─────────────────────────────────────────────────────────────────────────╢
  113.  ║ Move the worms one ball at a time. Fist ball moves in random direction, ║
  114.  ║ and the rest will follow the head.                                      ║
  115.  ╚═════════════════════════════════════════════════════════════════════════╝
  116. }
  117. PROCEDURE MoveWorms;
  118. VAR IP1, IP2, Xd, Zd, i, j : Integer;
  119. BEGIN
  120.   FOR i := 0 TO Pred( NumOfWorms ) DO WITH Worms[ i ]^ DO
  121.     BEGIN
  122.       FOR j := Pred( Len ) DOWNTO 1 DO
  123.     BEGIN
  124.       TxtRecPtr[ j ]^.Special := TxtRecPtr[ j - 1 ]^.Special;
  125.       IP1 := TxtRecPtr[ j ]^.LPInd;
  126.       IP2 := TxtRecPtr[ j - 1 ]^.LPInd;
  127.       Points[ IP1 ] := Points[ IP2 ]
  128.     END;
  129.       IF ( R16bIn AND 15 ) = 0 THEN YAngInc := R16bIn MOD 17 - 8;
  130.       YAng := ( YAng + YAngInc ) MOD 360;
  131.       IF YAng < 0 THEN Inc( YAng, 360 );
  132.       Xd := Integer( DSin[ YAng ] ) * WormSpeed; { try to move that much }
  133.       Zd := Integer( DCos[ YAng ] ) * WormSpeed;
  134.       IP1 := TxtRecPtr[ 0 ]^.LPInd; { move the head }
  135.       MovePoint( XP, ZP, Points[ IP1 ].X, Points[ IP1 ].Z, Xd, Zd, YAng );
  136.       TxtRecPtr[ 0 ]^.Special := ( TxtRecPtr[ 0 ]^.Special + 32 ) MOD 360
  137.     END
  138. END;
  139. {
  140.  ╔═════════════════════════════════════════════════════════════════════════╗
  141.  ║ FUNCTION GetSector                                                      ║
  142.  ╟─────────────────────────────────────────────────────────────────────────╢
  143.  ║ Input  : delat x, z                                                     ║
  144.  ║ Output : corresponding angle rounded to nearest 45 degrees              ║
  145.  ╟─────────────────────────────────────────────────────────────────────────╢
  146.  ║ This output angle is used in hit-the-wall check.                        ║
  147.  ╚═════════════════════════════════════════════════════════════════════════╝
  148. }
  149. FUNCTION GetSector( xd, zd : Integer ) : Integer;
  150. BEGIN
  151.   IF xd < 0 THEN                    { 0 -> 270 -> 180 }
  152.     IF zd >= 0 THEN GetSector := ( 360 + 270 ) DIV 2
  153.       ELSE GetSector := ( 270 + 180 ) DIV 2
  154.   ELSE                                      { 0 -> 90 -> 180 }
  155.     IF zd >= 0 THEN GetSector := ( 0 + 90 ) DIV 2
  156.       ELSE GetSector := ( 90 + 180 ) DIV 2;
  157. END;
  158. {
  159.  ╔═════════════════════════════════════════════════════════════════════════╗
  160.  ║ PROCEDURE MoveCreatures                                                 ║
  161.  ╟─────────────────────────────────────────────────────────────────────────╢
  162.  ║ Move the creatures. Try to get closer to the player, using one of the   ║
  163.  ║ following strategies:                                                   ║
  164.  ║    0. move equal speeds within x and z axes                             ║
  165.  ║    1. first close up within x-axis                                      ║
  166.  ║    2. first close up within z-axis                                      ║
  167.  ╚═════════════════════════════════════════════════════════════════════════╝
  168. }
  169. PROCEDURE MoveCreatures;
  170. VAR    i, IP, Angle        : Integer;
  171.     Xd, Zd, Xi, Zi, h    : LongInt;
  172.  
  173. PROCEDURE GetMove( Xs, Zs : Integer );
  174. BEGIN
  175.   Xd := Xi * ( 256 * Xs ) DIV h;
  176.   Zd := Zi * ( 256 * Zs ) DIV h
  177. END;
  178.  
  179. BEGIN
  180.   FOR i := 0 TO Pred( NumOfCreats ) DO WITH Creatures[ i ]^ DO
  181.     BEGIN
  182.       IP := TxtRecPtr^.LPInd;
  183.       Xi := EyePA.X - Points[ IP ].X; { X, Z distances to viewer }
  184.       Zi := EyePA.Z - Points[ IP ].Z;
  185.       Angle := GetSector( Xi, Zi ); { viewer is in about this direction }
  186.       h := MaxIn( MaxIn( Abs( Xi ), Abs( Zi )), 1 );
  187.       CASE MoveType OF  { move straight to the player }
  188.     0 : GetMove( CreatureSpeed, CreatureSpeed );
  189.     1 : IF Abs( Xi ) > 4 THEN  { move first by x-axis...}
  190.           GetMove( CreatureSpeed, 1 )
  191.         ELSE { ...and then by z-axis }
  192.           GetMove( 1, CreatureSpeed );
  193.     2 : IF Abs( Zi ) > 4 THEN { ...and contrary... }
  194.           GetMove( 1, CreatureSpeed )
  195.         ELSE
  196.           GetMove( CreatureSpeed, 1 );
  197.       END;
  198.       MovePoint( XP, ZP, Points[ IP ].X, Points[ IP ].Z, Xd, Zd, Angle )
  199.     END;
  200. END;
  201. {
  202.  ╔═════════════════════════════════════════════════════════════════════════╗
  203.  ║ PROCEDURE MoveClock                                                     ║
  204.  ╟─────────────────────────────────────────────────────────────────────────╢
  205.  ║ Animate clock-hands. Time is taken from system clock.                   ║
  206.  ╚═════════════════════════════════════════════════════════════════════════╝
  207. }
  208. PROCEDURE MoveClock;
  209.  
  210. PROCEDURE DrawHands( ch, cm, cs : Byte );
  211. BEGIN
  212.   WITH ClockHands DO
  213.     BEGIN
  214.       Thickness := ThickWidth;
  215.       Line( WW DIV 2, HW DIV 2, HX, HY, ch );
  216.       Line( WW DIV 2, HW DIV 2, MX, MY, cm );
  217.       Line( WW DIV 2, HW DIV 2, SX, SY, cs );
  218.       Thickness := NormWidth;
  219.     END;
  220. END;
  221.  
  222. VAR    H, M, S, S100 : Word;
  223.     Ha, Ma, Sa : Integer;
  224. BEGIN
  225.   GetTime( H, M, S, S100 );
  226.   IF ClockHands.Secs = S THEN Exit; { draw to clock-texture: }
  227.   DefineScr( WW, HW, BytePtr( TxtMaps[ CLOCKBG ] ));
  228.   DrawHands( 20, 20, 20 );
  229.   WITH ClockHands DO
  230.     BEGIN
  231.       Secs := S;
  232.       Ha := ( -( H MOD 12 ) * 30 - M DIV 12 * 6 + 90 ) MOD 360;
  233.       IF Ha < 0 THEN Inc( Ha, 360 ); { hours to angle }
  234.       HX := WW DIV 2 + WW DIV 4 * Integer( DCos[ Ha ] ) DIV 256;
  235.       HY := WW DIV 2 - HW DIV 4 * Integer( DSin[ Ha ] ) DIV 256;
  236.       Ma := ( -M * 6 + 90 ) MOD 360;
  237.       IF Ma < 0 THEN Inc( Ma, 360 ); { minutes to angle }
  238.       MX := WW DIV 2 + WW DIV 3 * Integer( DCos[ Ma ] ) DIV 256;
  239.       MY := WW DIV 2 - HW DIV 3 * Integer( DSin[ Ma ] ) DIV 256;
  240.       Sa := ( -S * 6 + 90 ) MOD 360;
  241.       IF Sa < 0 THEN Inc( Sa, 360 ); { seconds to angle }
  242.       SX := WW DIV 2 + WW DIV 3 * Integer( DCos[ Sa ] ) DIV 256;
  243.       SY := WW DIV 2 - HW DIV 3 * Integer( DSin[ Sa ] ) DIV 256;
  244.     END;
  245.   DrawHands( 63, 63, 64 + 63 );
  246.   DefineScr( 320, 200, Ptr( SegA000,0 ));
  247. END;
  248. {
  249.  ╔═════════════════════════════════════════════════════════════════════════╗
  250.  ║ FUNCTION MakePlasmaWall                                                 ║
  251.  ╟─────────────────────────────────────────────────────────────────────────╢
  252.  ║ Output : Index to new texture in TxtMaps-array                          ║
  253.  ╟─────────────────────────────────────────────────────────────────────────╢
  254.  ║ Make grey wall-texture (which is supposed to look stone)                ║
  255.  ╚═════════════════════════════════════════════════════════════════════════╝
  256. }
  257. TYPE    PlasmaScr      = ARRAY[ 0..16383 ] OF Byte;
  258. VAR    PP              : ^PlasmaScr;
  259.     PW, WD          : Word;
  260.  
  261. FUNCTION PickColor( x1, y1, x2, y2 : Word ) : Byte;
  262. VAR Variation : Integer;
  263. BEGIN
  264.   Variation := ( x2 - x1 + y2 - y1 ) DIV WD;
  265.   Variation := R16bIn MOD Succ( Variation * 2 ) - Variation;
  266.   PickColor := (( PP^[ y1 * PW + x1 ] + PP^[ y2 * PW + x2 ] ) DIV 2 + Variation ) AND 63 + WB;
  267. END;
  268.  
  269. PROCEDURE Subdivide( x1, y1, x2, y2 : Word );
  270. VAR xm, ym : Word;
  271. BEGIN
  272.   IF (( x2 - x1 ) >= 2 ) OR (( y2 - y1 ) >= 2 ) THEN
  273.     BEGIN
  274.       xm := ( x1 + x2 ) SHR 1;
  275.       ym := ( y1 + y2 ) SHR 1;
  276.       IF PP^[ ym * PW + xm ] = 0 THEN PP^[ ym * PW + xm ] :=
  277.                ( PP^[ y1 * PW + x1 ] + PP^[ y2 * PW + x2 ] +
  278.                  PP^[ y1 * PW + x2 ] + PP^[ y2 * PW + x1 ] ) SHR 2;
  279.       IF PP^[ y1 * PW + xm ] = 0 THEN PP^[ y1 * PW + xm ] := PickColor( x1, y1, x2, y1 );
  280.       IF PP^[ ym * PW + x2 ] = 0 THEN PP^[ ym * PW + x2 ] := PickColor( x2, y1, x2, y2 );
  281.       IF PP^[ y2 * PW + xm ] = 0 THEN PP^[ y2 * PW + xm ] := PickColor( x1, y2, x2, y2 );
  282.       IF PP^[ ym * PW + x1 ] = 0 THEN PP^[ ym * PW + x1 ] := PickColor( x1, y1, x1, y2 );
  283.       Subdivide( x1, y1, xm, ym );
  284.       Subdivide( xm, ym, x2, y2 );
  285.       Subdivide( xm, y1, x2, ym );
  286.       Subdivide( x1, ym, xm, y2 );
  287.     END;
  288. END;
  289.  
  290. FUNCTION MakePlasmaWall : Integer;
  291. VAR TI : Integer;
  292. BEGIN
  293.   TI := CreateNewTxt( TxtObj );
  294.   Pointer( PP ) := Pointer( TxtMaps[ TI ] );
  295.   FillChar( PP^, WW * HW, 0 );
  296.   PW := WW;
  297.   WD := 8;
  298.   PP^[ 0 * PW + 0 ]              := WB + 32;
  299.   PP^[ 0 * PW + WW - 1 ]         := WB + 32;
  300.   PP^[( HW - 1 ) * PW + 0 ]      := WB + 32;
  301.   PP^[( HW - 1 ) * PW + WW - 1 ] := WB + 32;
  302.   Subdivide( 0, 0, WW - 1, HW - 1 );
  303.   MakePlasmaWall := TI
  304. END;
  305.  
  306. PROCEDURE MakePlasmaBorder;
  307. CONST XA = XAdj - 2;
  308.       YA = YAdj - 2;
  309. BEGIN
  310.   Pointer( PP ) := Ptr( SegA000, 0 );
  311.   PW := 320;
  312.   WD := 4;
  313.   Subdivide( 0, 0, XA, YA );
  314.   Subdivide( 319 - XA, 0, 319, YA );
  315.   Subdivide( 0, 199 - YA, XA, 199 );
  316.   Subdivide( 319 - XA, 199 - YA, 319, 199 );
  317.   Subdivide( XA, 0, 319 - XA, YA );
  318.   Subdivide( XA, 199 - YA, 319 - XA, 199 );
  319.   Subdivide( 0, YA, XA, 199 - YA );
  320.   Subdivide( 319 - XA, YA, 319, 199 - YA );
  321. END;
  322. {
  323.  ╔═════════════════════════════════════════════════════════════════════════╗
  324.  ║ FUNCTION MakeDark                                                       ║
  325.  ╟─────────────────────────────────────────────────────────────────────────╢
  326.  ║ Input  : Index to TxtMaps-array                                         ║
  327.  ║ Output : Index to new texture                                           ║
  328.  ╟─────────────────────────────────────────────────────────────────────────╢
  329.  ║ Make dark copy of input texture                                         ║
  330.  ╚═════════════════════════════════════════════════════════════════════════╝
  331. }
  332. FUNCTION MakeDark( TIB : Integer ) : Integer;
  333. VAR    TID, i : Integer;
  334.     BPtr, DPtr : ^Byte;
  335. BEGIN
  336.   TID := CreateNewTxt( TxtObj );
  337.   Pointer( BPtr ) := Pointer( TxtMaps[ TIB ] );
  338.   Pointer( DPtr ) := Pointer( TxtMaps[ TID ] );
  339.   FOR i := 0 TO Pred( WW * HW ) DO
  340.     BEGIN
  341.       DPtr^ := Succ( 19 * BPtr^ DIV 20 );
  342.       Inc( Word( DPtr ));
  343.       Inc( Word( BPtr ));
  344.     END;
  345.   MakeDark := TID
  346. END;
  347. {
  348.  ╔═════════════════════════════════════════════════════════════════════════╗
  349.  ║ PROCEDURE AdjustSpeed                                                   ║
  350.  ╚═════════════════════════════════════════════════════════════════════════╝
  351. }
  352. PROCEDURE AdjustSpeed;
  353. BEGIN
  354.   WaitDisplay;
  355.   IF Key[ ALT ] THEN
  356.     BEGIN
  357.       IF Key[ PLUS  ] AND ( TurnSpeed < MaxTurn ) THEN Inc( TurnSpeed ) ELSE
  358.       IF Key[ MINUS ] AND ( TurnSpeed > MinTurn ) THEN Dec( TurnSpeed );
  359.       SBorderC( WB + TurnSpeed * WorldXZ DIV MaxTurn - 1 );
  360.     END
  361.   ELSE
  362.     BEGIN
  363.       IF Key[ PLUS  ] AND ( MoveSpeed < MaxMove ) THEN Inc( MoveSpeed ) ELSE
  364.       IF Key[ MINUS ] AND ( MoveSpeed > MinMove ) THEN Dec( MoveSpeed );
  365.       SBorderC( BB + MoveSpeed * WorldXZ DIV MaxMove - 1 );
  366.     END;
  367.   WaitDisplay;
  368. END;
  369. {
  370.  ╔═════════════════════════════════════════════════════════════════════════╗
  371.  ║ PROCEDURE MoveHero                                                      ║
  372.  ╟─────────────────────────────────────────────────────────────────────────╢
  373.  ║ Move the player with the keyboard or mouse. Note, that altought in      ║
  374.  ║ theory MoveEye( 0, -MoveSpeed ) is equal to MoveEye( 180, MoveSpeed ),  ║
  375.  ║ it is better to use the latter, because the hit-the-wall check is done  ║
  376.  ║ using the angle parameter.                                              ║
  377.  ╚═════════════════════════════════════════════════════════════════════════╝
  378. }
  379. PROCEDURE MoveHero; { because a documented bug is a feature (and not a bug),}
  380. VAR MDX, MDY : Integer;{ so, you can move same time by mouse and by keys, }
  381. BEGIN  { very fast... }
  382.   IF MouseInstalled THEN
  383.     BEGIN
  384.       MDX := ( Mouse.X - MaxTurn ) DIV 2;
  385.       MDY := ( MaxMove - Mouse.Y );
  386.       Mouse.SetPos( MaxTurn, MaxMove );
  387.       IF MDY < 0 THEN MoveEye( 180, -MDY ) ELSE MoveEye( 0, MDY );
  388.       IF Key[ ALT ] THEN MoveEye( Sgn( MDX ) * 90, Abs( MDX )) ELSE
  389.     TurnEye( MDX )
  390.     END;
  391.   IF Key[ PLUS ] OR Key[ MINUS ] THEN AdjustSpeed;
  392.   IF Key[ RightArrow ] THEN
  393.     IF Key[ ALT ] THEN MoveEye(  90, MoveSpeed ) ELSE TurnEye( TurnSpeed );
  394.   IF Key[ LeftArrow  ] THEN
  395.     IF Key[ ALT ] THEN MoveEye( -90, MoveSpeed ) ELSE TurnEye( -TurnSpeed );
  396.   IF Key[ UpArrow    ] THEN MoveEye( 0, MoveSpeed ) ELSE
  397.   IF Key[ DownArrow  ] THEN MoveEye( 180, MoveSpeed );
  398. END;
  399. {
  400.  ╔═════════════════════════════════════════════════════════════════════════╗
  401.  ║ PROCEDURE LoadData                                                      ║
  402.  ╟─────────────────────────────────────────────────────────────────────────╢
  403.  ║ Load some textures from disk, and make some plasma-textures.            ║
  404.  ╚═════════════════════════════════════════════════════════════════════════╝
  405. }
  406. PROCEDURE LoadData;
  407. BEGIN
  408.   BRICK0   := LoadTexture( 'BRICK0.PCX',   TxtObj, PCXData );
  409.   BRICK1   := LoadTexture( 'BRICK1.PCX',   TxtObj, PCXData );
  410.   MARBLE0  := LoadTexture( 'MARBLE0.DAT',  TxtObj, RawData );
  411.   MARBLE1  := LoadTexture( 'MARBLE1.DAT',  TxtObj, RawData );
  412.   PLASMA0  := MakePlasmaWall;
  413.   PLASMA1  := MakeDark( PLASMA0 );
  414.   MANDEL3D := LoadTexture( '3DMANDEL.DAT', TxtObj, RawData );
  415.   HAMILTON := LoadTexture( 'HAMILTON.PCX', TxtObj, PCXData );
  416.   CLOCKBG  := LoadTexture( 'CLOCK.PCX',    TxtObj, PCXData );
  417.   BRICK2   := LoadTexture( 'BRICK2.PCX',   TxtObj, PCXData );
  418.   BRICK3   := LoadTexture( 'BRICK3.PCX',   TxtObj, PCXData );
  419.   B3D      := LoadTexture( '3D.PCX',       TxtObj, PCXData );
  420.   GHOST    := LoadTexture( 'GHOST.PCX',    Creature, PCXData );
  421. END;
  422. {
  423.  ╔═════════════════════════════════════════════════════════════════════════╗
  424.  ║ PROCEDURE Lab3DColors                                                   ║
  425.  ╚═════════════════════════════════════════════════════════════════════════╝
  426. }
  427. PROCEDURE Lab3DColors( VAR Pal : VGAPalTYPE );
  428. VAR i, j, k : Integer;
  429. BEGIN
  430.   FOR i := 0 TO 3 DO FOR j := 0 TO 3 DO FOR k := 0 TO 3 DO
  431.     WITH Pal[ 16 * i + 4 * j + k ] DO
  432.       BEGIN R := k * 16; G := j * 16; B := i * 16; END;
  433.   FOR i := 64 TO 95 DO WITH Pal[ i ] DO
  434.     BEGIN R := ( i - 64 ) * 2; G := 0; B := 0; END;
  435.   FOR i := 96 TO 127 DO WITH Pal[ i ] DO
  436.     BEGIN R := 0; G := ( i - 96 ) * 2; B := 0; END;
  437.   FOR i := 128 TO 191 DO WITH Pal[ i ] DO
  438.     BEGIN R := 0; G := 0; B := i - 128; END;
  439.   FOR i := 192 TO 256 DO WITH Pal[ i ] DO
  440.     BEGIN R := i - 192; G := i - 192; B := i - 192; END;
  441. END;
  442. {
  443.  ╔═════════════════════════════════════════════════════════════════════════╗
  444.  ║ PROCEDURE InitLabyrinth                                                 ║
  445.  ╟─────────────────────────────────────────────────────────────────────────╢
  446.  ║ Create maze, few creatures and worms.                                   ║
  447.  ╚═════════════════════════════════════════════════════════════════════════╝
  448. }
  449. PROCEDURE InitLabyrinth;
  450. BEGIN
  451.   SetWallTxtObjPoly( @PolyWallX0, @PolyWallZ0, @PolyWallTI0, 82 );
  452.   SetWallTxtObjPoly( @PolyWallX1, @PolyWallZ1, @PolyWallTI1, 16 );
  453.   SetWallTxtObjPoly( @PolyWallX2, @PolyWallZ2, @PolyWallTI2, 6 );
  454.   SetWallTxtObjBoxOut( 8, 4, 14, 10, BRICK3, BRICK2, B3D, BRICK2 );
  455.   SetWallTxtObjBoxOut( 20, 4, 22, 16, HAMILTON, MANDEL3D, HAMILTON, MANDEL3D );
  456.   SetWallTxtObjBoxOut( 12, 34, 16, 38, BRICK3, BRICK2, BRICK3, BRICK2 );
  457.   SetWallTxtObjBoxOut( 16, 22, 20, 28, MARBLE0, CLOCKBG, MARBLE0, MARBLE1 );
  458.   InitCreature( 2, 14, GHOST, 0 );
  459.   InitCreature( 14, 2, GHOST, 1 );
  460.   InitCreature( 22, 2, GHOST, 2 );
  461.   InitWorm( 6, 14, 16, BB + 63 );
  462.   InitWorm( 24, 38, 16, RB + 31 );
  463.   InitWorm( 32, 8, 16, WB + 63 );
  464.   SetEyePos( 22, 28, 0 );
  465. END;
  466. {
  467.  ╔═════════════════════════════════════════════════════════════════════════╗
  468.  ║ PROCEDURE InitScr                                                       ║
  469.  ╟─────────────────────────────────────────────────────────────────────────╢
  470.  ║ Draws the border and loads the init screen                              ║
  471.  ╚═════════════════════════════════════════════════════════════════════════╝
  472. }
  473. PROCEDURE InitScr;
  474. CONST    BAdj = 2;
  475. VAR    i, x1, y1, x2, y2 : Word;
  476. BEGIN
  477.   InitPCX( VScrXMax, VirtScr );
  478.   LoadPCX('INITSCR.PCX', 0, 0, FALSE );
  479.   Lab3DColors( Pal );
  480.   SBorderC( BB + MoveSpeed * WorldXZ DIV MaxMove - 1 );
  481.   CeilC  := CeCo;
  482.   FloorC := FlCo;
  483.   x1 := 0;
  484.   y1 := 0;
  485.   x2 := 319;
  486.   y2 := 199;
  487.   FOR i := 0 TO BAdj DO
  488.     BEGIN
  489.       Line( x1 + i, y2 - i, x2 - i, y2 - i, BoCD );
  490.       Line( x2 - i, y1 + i, x2 - i, y2 - i, BoCD );
  491.       Line( x1 + i, y1 + i, x2 - i, y1 + i, BoCB );
  492.       Line( x1 + i, y1 + i, x1 + i, y2 - i, BoCB );
  493.     END;
  494.   x1 := XAdj - BAdj - 1;
  495.   y1 := YAdj - BAdj - 1;
  496.   x2 := XAdj + VScrXMax + BAdj;
  497.   y2 := YAdj + VScrYMax + BAdj;
  498.   FOR i := 0 TO BAdj DO
  499.     BEGIN
  500.       Line( x1 + i, y2 - i, x2 - i, y2 - i, BoCB );
  501.       Line( x2 - i, y1 + i, x2 - i, y2 - i, BoCB );
  502.       Line( x1 + i, y1 + i, x2 - i, y1 + i, BoCD );
  503.       Line( x1 + i, y1 + i, x1 + i, y2 - i, BoCD );
  504.     END;
  505.   MakePlasmaBorder;
  506.   ZeroDACs;
  507.   ShowWholeVirtScr;
  508.   BlackToColor( Pal, 256 )
  509. END;
  510. {
  511.  ╔═════════════════════════════════════════════════════════════════════════╗
  512.  ║ PROCEDURE ChkSystem                                                     ║
  513.  ╚═════════════════════════════════════════════════════════════════════════╝
  514. }
  515. PROCEDURE ChkSystem;
  516. BEGIN
  517.   IF Test8086 = 0 THEN FatalError('This program require at least i286 prosessor.');
  518. END;
  519. {
  520.  ╔═════════════════════════════════════════════════════════════════════════╗
  521.  ║ PROCEDURE InitClock                                                     ║
  522.  ╚═════════════════════════════════════════════════════════════════════════╝
  523. }
  524. PROCEDURE InitClock;
  525. BEGIN
  526.   WITH ClockHands DO
  527.     BEGIN
  528.       HX := WW DIV 2;
  529.       HY := HW DIV 4;
  530.       MX := WW DIV 2;
  531.       MY := HW DIV 3;
  532.       SX := WW DIV 2;
  533.       SY := HW DIV 3;
  534.     END;
  535. END;
  536. {
  537.  ╔═════════════════════════════════════════════════════════════════════════╗
  538.  ║ PROCEDURE InitL3D                                                       ║
  539.  ╚═════════════════════════════════════════════════════════════════════════╝
  540. }
  541. PROCEDURE InitL3D;
  542. BEGIN
  543.   ChkSystem;
  544.   InitR16b;
  545.   InitVGA256;
  546.   VGAPal.Hide;
  547.   DefineScr( 320, 200, Ptr( SegA000, 0 ));
  548.   InitPCX( 320, Ptr( SegA000, 0 ));
  549.   LoadPCX( 'WAIT.PCX', 160 - 64, 100 - 16, TRUE );
  550.   FillChar( Pal[ GB ], SizeOf( RGB ) * ( 256 - GB ), 0 );
  551.   SetDACs( GB, 256 - GB, @Pal );
  552.   VGAPal.Show;
  553.   MouseInstalled := Mouse.ChkAndReset;
  554.   IF MouseInstalled THEN
  555.     BEGIN
  556.       Mouse.Hide;
  557.       Mouse.SetRange( 0, 0, 2 * MaxTurn, 2 * MaxMove );
  558.       Mouse.SetPos( MaxTurn, MaxMove )
  559.     END;
  560.   LoadData;
  561.   InitLabyrinth;
  562.   InitNonBlankKey;
  563.   InitClock;
  564.   InitScr;
  565.   REPEAT UNTIL KeyHitC;
  566.   StartInfo;
  567. END;
  568.  
  569. PROCEDURE DebugL3D;
  570. VAR i : Integer;
  571. BEGIN
  572.   LoadData;
  573.   InitVGA256;
  574.   DefineScr( 320, 200, Ptr( SegA000, 0 ));
  575.   InitLabyrinth;
  576.   InitScr;
  577.   STime := Clock;
  578.   FOR i := 1 TO 180 DO
  579.     BEGIN
  580.       DoMove;
  581.       Dec( EyePA.YAng, 4 );
  582.     END;
  583.   ETime := Clock;
  584.   OTime := ETime - STime;
  585.   REPEAT UNTIL KeyHit;
  586.   CloseVGA256;
  587.   WriteLn( OTime );
  588. END;
  589. {
  590.  ╔═════════════════════════════════════════════════════════════════════════╗
  591.  ║ PROCEDURE Pause                                                         ║
  592.  ╚═════════════════════════════════════════════════════════════════════════╝
  593. }
  594. PROCEDURE Pause;
  595. BEGIN
  596.   WHILE Key[ P ] DO;
  597.   WHILE NOT KeyHitC DO;
  598. END;
  599. {
  600.  ╔═════════════════════════════════════════════════════════════════════════╗
  601.  ║ PROCEDURE HandleKey                                                     ║
  602.  ╚═════════════════════════════════════════════════════════════════════════╝
  603. }
  604. PROCEDURE HandleKey;
  605. BEGIN
  606.   ETime := Clock;
  607.   Inc( OTime, ETime - STime );
  608.   IF Key[ F1 ] THEN Menu;
  609.   IF Key[ SPACE ] OR RightButton THEN ShowMap( SPACE );
  610.   IF Key[ P ] THEN Pause;
  611.   IF Key[ D ] THEN DebugInfo;
  612.   IF Key[ F5 ] THEN ReportSpeed;
  613.   IF Key[ ESC ] THEN EndOfGame := Sure('Exit to DOS (Y/N)?');
  614.   STime := Clock
  615. END;
  616. {
  617.  ╔═════════════════════════════════════════════════════════════════════════╗
  618.  ║ PROCEDURE RunL3D                                                        ║
  619.  ╚═════════════════════════════════════════════════════════════════════════╝
  620. }
  621. PROCEDURE RunL3D;
  622. BEGIN
  623.   STIme := Clock;
  624.   REPEAT
  625.     MoveHero;
  626.     MoveCreatures;
  627.     MoveWorms;
  628.     MoveClock;
  629.     DoMove;
  630.     Inc( FrameCnt );
  631.     IF Key[ F1 ] OR Key[ SPACE ] OR RightButton OR Key[ P ] OR Key[ D ] OR
  632.       Key[ F5 ] OR Key[ ESC ] THEN HandleKey;
  633.     IF WaitVRT THEN WaitDisplay;
  634.   UNTIL EndOfGame
  635. END;
  636. {
  637.  ╔═════════════════════════════════════════════════════════════════════════╗
  638.  ║ PROCEDURE DoneL3D                                                       ║
  639.  ╚═════════════════════════════════════════════════════════════════════════╝
  640. }
  641. PROCEDURE DoneL3D;
  642. BEGIN
  643.   DisabKey;
  644.   CloseVGA256;
  645.   WriteLn;
  646.   WriteLn(' If you like this program, and wish you had the Turbo Pascal and ');
  647.   WriteLn(' assembler source code for the TxtMap Unit too, just register today! ');
  648.   WriteLn;
  649.   WriteLn(' Send $20 (or 100 Fmk) to me, and I`ll send the latest version of ');
  650.   WriteLn(' all the source code. ');
  651.   WriteLn;
  652.   WriteLn(' If you have any questions or comments, you can contact me ');
  653.   WriteLn(' via the internet email: Kimmo.Fredriksson@Helsinki.FI, ');
  654.   WriteLn(' or surface mail: Kimmo Fredriksson ');
  655.   WriteLn('                  Silvontie 38 ');
  656.   WriteLn('                  37740 Haukila ');
  657.   WriteLn('                  FINLAND ');
  658.   WriteLn;
  659.   WriteLn;
  660. END;
  661.  
  662. { $DEFINE DEBUG}
  663.  
  664. BEGIN
  665. {$IFDEF DEBUG}
  666.   DebugL3D
  667. {$ELSE}
  668.   InitL3D;
  669.   RunL3D;
  670.   DoneL3D
  671. {$ENDIF}
  672. END.
  673.