Category : Pascal Source Code
Archive   : 3DLAB110.ZIP
Filename : L3D.PAS

 
Output of file : L3D.PAS contained in archive : 3DLAB110.ZIP
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
{ÄÄÄ( C ) Copyright 1994 By Kimmo Fredriksson.ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
{ÄÄÄLabyrinth-3DÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
{ÄÄÄInternet email: [email protected]ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
{ÄÄÄIf you want the Turbo Pascal and assembler source code for the TxtMapÄÄÄÄ}
{ÄÄÄUnit, register today. Send $20 (or 100 Fmk) to me, and I'll send allÄÄÄÄÄ}
{ÄÄÄthe source to you.ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
{ÄÄÄÄÄÄÄÄÄKimmo FredrikssonÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
{ÄÄÄÄÄÄÄÄÄSilvontie 38ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
{ÄÄÄÄÄÄÄÄÄ37740 HaukilaÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
{ÄÄÄÄÄÄÄÄÄFINLANDÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}

{$A+ Word Alignment }
{$B- Short-circuit Boolean expression evaluation }
{$D- Debug information off }
{$E- Disable 80x87 run-time library }
{$F- Force Far Calls off }
{$G+ 80286 instructions }
{$I- I/O checking off }
{$L- Local Symbols off }
{$N- Calc reals by software }
{$O- Overlays not allowed }
{$P- Open string parameters disabled }
{$Q- Overflow Check off }
{$R- Range-checking off }
{$S- Stack-checking off }
{$T- Type-Check pointers off }
{$V- Strict Var-String off }
{$X+ Extended Syntax on }

{$M $1000, $00000, $A0000 }

PROGRAM Labyrinth3D;

USES L3DData,
L3DMenu,
L3DWorld,
AsmSys,
Mouse,
Controls,
TxtMap,
VGAPal,
VGA256,
Error,
Patch,
PCX,
DOS;
{
ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
º PROCEDURE InitCreature º
ÇÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄĶ
º Input : X, Z co'ordinates, desired index to TxtMap array (of pointers),º
º movement-strategy 0..2 º
ÇÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄĶ
º See the MoveCreatures-procedure for movement-strategy º
ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
}
PROCEDURE InitCreature( X, Z : Integer; TI, MT : Byte );
VAR IP : Integer;
BEGIN
IF NumOfCreats = MaxCreatures THEN FatalError('"Creatures" array full!');
New( Creatures[ NumOfCreats ]);
WITH Creatures[ NumOfCreats ]^ DO
BEGIN { creature to Obj-array, and address of new object to TxtRecPtr -> }
TxtRecPtr := Obj[ InitAnimObj( X, Z, Creature, TI, 0 ) ];
IP := TxtRecPtr^.LPInd; { LPInd = RPInd }
XP := LongInt( Points[ IP ].X ) * 256; { 8-bit fixed point... }
ZP := LongInt( Points[ IP ].Z ) * 256;
MoveType := MT
END;
Inc( NumOfCreats )
END;
{
ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
º PROCEDURE InitWorm º
ÇÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄĶ
º Input : Worms head coordinates, length and color º
ÇÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄĶ
º Length means the num. of 'balls', which the worm consist. Every ball is º
º animated separately. In here, the TI parameter in the InitAnimObj -call º
º means the color of the ball. º
ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
}
PROCEDURE InitWorm( HeadX, HeadZ, WLen : Integer; c : Byte );
VAR IP, i : Integer;
BEGIN
IF NumOfWorms = MaxWorms THEN FatalError('"Worms" array full!');
IF WLen > MaxWormLen THEN FatalError('Too long Worm!');
New( Worms[ NumOfWorms ]);
WITH Worms[ NumOfWorms ]^ DO
BEGIN
Len := WLen;
YAng := 0;
YAngInc := 0; {ball to Obj array, and objects address to TxtRecPtr}
FOR i := 0 TO Len - 1 DO
TxtRecPtr[ i ] := Obj[ InitAnimObj( HeadX, HeadZ, Worm, c - i, i * 32 MOD 360 ) ];
IP := TxtRecPtr[ 0 ]^.LPInd;
XP := LongInt( Points[ IP ].X ) * 256; { 8-bit fixed point...}
ZP := LongInt( Points[ IP ].Z ) * 256;
END;
Inc( NumOfWorms )
END;
{
ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
º PROCEDURE MoveWorms º
ÇÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄĶ
º Move the worms one ball at a time. Fist ball moves in random direction, º
º and the rest will follow the head. º
ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
}
PROCEDURE MoveWorms;
VAR IP1, IP2, Xd, Zd, i, j : Integer;
BEGIN
FOR i := 0 TO Pred( NumOfWorms ) DO WITH Worms[ i ]^ DO
BEGIN
FOR j := Pred( Len ) DOWNTO 1 DO
BEGIN
TxtRecPtr[ j ]^.Special := TxtRecPtr[ j - 1 ]^.Special;
IP1 := TxtRecPtr[ j ]^.LPInd;
IP2 := TxtRecPtr[ j - 1 ]^.LPInd;
Points[ IP1 ] := Points[ IP2 ]
END;
IF ( R16bIn AND 15 ) = 0 THEN YAngInc := R16bIn MOD 17 - 8;
YAng := ( YAng + YAngInc ) MOD 360;
IF YAng < 0 THEN Inc( YAng, 360 );
Xd := Integer( DSin[ YAng ] ) * WormSpeed; { try to move that much }
Zd := Integer( DCos[ YAng ] ) * WormSpeed;
IP1 := TxtRecPtr[ 0 ]^.LPInd; { move the head }
MovePoint( XP, ZP, Points[ IP1 ].X, Points[ IP1 ].Z, Xd, Zd, YAng );
TxtRecPtr[ 0 ]^.Special := ( TxtRecPtr[ 0 ]^.Special + 32 ) MOD 360
END
END;
{
ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
º FUNCTION GetSector º
ÇÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄĶ
º Input : delat x, z º
º Output : corresponding angle rounded to nearest 45 degrees º
ÇÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄĶ
º This output angle is used in hit-the-wall check. º
ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
}
FUNCTION GetSector( xd, zd : Integer ) : Integer;
BEGIN
IF xd < 0 THEN { 0 -> 270 -> 180 }
IF zd >= 0 THEN GetSector := ( 360 + 270 ) DIV 2
ELSE GetSector := ( 270 + 180 ) DIV 2
ELSE { 0 -> 90 -> 180 }
IF zd >= 0 THEN GetSector := ( 0 + 90 ) DIV 2
ELSE GetSector := ( 90 + 180 ) DIV 2;
END;
{
ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
º PROCEDURE MoveCreatures º
ÇÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄĶ
º Move the creatures. Try to get closer to the player, using one of the º
º following strategies: º
º 0. move equal speeds within x and z axes º
º 1. first close up within x-axis º
º 2. first close up within z-axis º
ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
}
PROCEDURE MoveCreatures;
VAR i, IP, Angle : Integer;
Xd, Zd, Xi, Zi, h : LongInt;

PROCEDURE GetMove( Xs, Zs : Integer );
BEGIN
Xd := Xi * ( 256 * Xs ) DIV h;
Zd := Zi * ( 256 * Zs ) DIV h
END;

BEGIN
FOR i := 0 TO Pred( NumOfCreats ) DO WITH Creatures[ i ]^ DO
BEGIN
IP := TxtRecPtr^.LPInd;
Xi := EyePA.X - Points[ IP ].X; { X, Z distances to viewer }
Zi := EyePA.Z - Points[ IP ].Z;
Angle := GetSector( Xi, Zi ); { viewer is in about this direction }
h := MaxIn( MaxIn( Abs( Xi ), Abs( Zi )), 1 );
CASE MoveType OF { move straight to the player }
0 : GetMove( CreatureSpeed, CreatureSpeed );
1 : IF Abs( Xi ) > 4 THEN { move first by x-axis...}
GetMove( CreatureSpeed, 1 )
ELSE { ...and then by z-axis }
GetMove( 1, CreatureSpeed );
2 : IF Abs( Zi ) > 4 THEN { ...and contrary... }
GetMove( 1, CreatureSpeed )
ELSE
GetMove( CreatureSpeed, 1 );
END;
MovePoint( XP, ZP, Points[ IP ].X, Points[ IP ].Z, Xd, Zd, Angle )
END;
END;
{
ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
º PROCEDURE MoveClock º
ÇÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄĶ
º Animate clock-hands. Time is taken from system clock. º
ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
}
PROCEDURE MoveClock;

PROCEDURE DrawHands( ch, cm, cs : Byte );
BEGIN
WITH ClockHands DO
BEGIN
Thickness := ThickWidth;
Line( WW DIV 2, HW DIV 2, HX, HY, ch );
Line( WW DIV 2, HW DIV 2, MX, MY, cm );
Line( WW DIV 2, HW DIV 2, SX, SY, cs );
Thickness := NormWidth;
END;
END;

VAR H, M, S, S100 : Word;
Ha, Ma, Sa : Integer;
BEGIN
GetTime( H, M, S, S100 );
IF ClockHands.Secs = S THEN Exit; { draw to clock-texture: }
DefineScr( WW, HW, BytePtr( TxtMaps[ CLOCKBG ] ));
DrawHands( 20, 20, 20 );
WITH ClockHands DO
BEGIN
Secs := S;
Ha := ( -( H MOD 12 ) * 30 - M DIV 12 * 6 + 90 ) MOD 360;
IF Ha < 0 THEN Inc( Ha, 360 ); { hours to angle }
HX := WW DIV 2 + WW DIV 4 * Integer( DCos[ Ha ] ) DIV 256;
HY := WW DIV 2 - HW DIV 4 * Integer( DSin[ Ha ] ) DIV 256;
Ma := ( -M * 6 + 90 ) MOD 360;
IF Ma < 0 THEN Inc( Ma, 360 ); { minutes to angle }
MX := WW DIV 2 + WW DIV 3 * Integer( DCos[ Ma ] ) DIV 256;
MY := WW DIV 2 - HW DIV 3 * Integer( DSin[ Ma ] ) DIV 256;
Sa := ( -S * 6 + 90 ) MOD 360;
IF Sa < 0 THEN Inc( Sa, 360 ); { seconds to angle }
SX := WW DIV 2 + WW DIV 3 * Integer( DCos[ Sa ] ) DIV 256;
SY := WW DIV 2 - HW DIV 3 * Integer( DSin[ Sa ] ) DIV 256;
END;
DrawHands( 63, 63, 64 + 63 );
DefineScr( 320, 200, Ptr( SegA000,0 ));
END;
{
ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
º FUNCTION MakePlasmaWall º
ÇÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄĶ
º Output : Index to new texture in TxtMaps-array º
ÇÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄĶ
º Make grey wall-texture (which is supposed to look stone) º
ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
}
TYPE PlasmaScr = ARRAY[ 0..16383 ] OF Byte;
VAR PP : ^PlasmaScr;
PW : Word;
WD : Byte;

FUNCTION PickColor( x1, y1, x2, y2 : Word ) : Byte;
VAR Variation : Integer;
BEGIN
Variation := ( x2 - x1 + y2 - y1 ) SHR WD;
Variation := R16bIn MOD Succ( Variation * 2 ) - Variation;
PickColor := (( PP^[ y1 * PW + x1 ] + PP^[ y2 * PW + x2 ] ) SHR 1 + Variation ) AND 63 + WB;
END;

PROCEDURE Subdivide( x1, y1, x2, y2 : Word );
VAR y1p, y2p, ymp, xm, ym : Word;
BEGIN
IF (( x2 - x1 ) >= 2 ) OR (( y2 - y1 ) >= 2 ) THEN
BEGIN
xm := ( x1 + x2 ) SHR 1;
ym := ( y1 + y2 ) SHR 1;
ymp := ym * PW;
y1p := y1 * PW;
y2p := y2 * PW;
IF PP^[ ymp + xm ] = 0 THEN PP^[ ymp + xm ] :=
( PP^[ y1p + x1 ] + PP^[ y2p + x2 ] +
PP^[ y1p + x2 ] + PP^[ y2p + x1 ] ) SHR 2;
IF PP^[ y1p + xm ] = 0 THEN PP^[ y1p + xm ] := PickColor( x1, y1, x2, y1 );
IF PP^[ ymp + x2 ] = 0 THEN PP^[ ymp + x2 ] := PickColor( x2, y1, x2, y2 );
IF PP^[ y2p + xm ] = 0 THEN PP^[ y2p + xm ] := PickColor( x1, y2, x2, y2 );
IF PP^[ ymp + x1 ] = 0 THEN PP^[ ymp + x1 ] := PickColor( x1, y1, x1, y2 );
Subdivide( x1, y1, xm, ym );
Subdivide( xm, ym, x2, y2 );
Subdivide( xm, y1, x2, ym );
Subdivide( x1, ym, xm, y2 );
END;
END;

FUNCTION MakePlasmaWall : Integer;
VAR TI : Integer;
BEGIN
TI := CreateNewTxt( TxtObj );
Pointer( PP ) := Pointer( TxtMaps[ TI ] );
FillChar( PP^, WW * HW, 0 );
PW := WW;
WD := 3;
PP^[ 0 * PW + 0 ] := WB + 32;
PP^[ 0 * PW + WW - 1 ] := WB + 32;
PP^[( HW - 1 ) * PW + 0 ] := WB + 32;
PP^[( HW - 1 ) * PW + WW - 1 ] := WB + 32;
Subdivide( 0, 0, WW - 1, HW - 1 );
MakePlasmaWall := TI
END;

PROCEDURE MakePlasmaBorder;
CONST XA = XAdj - 2;
YA = YAdj - 2;
BEGIN
Pointer( PP ) := Ptr( SegA000, 0 );
PW := 320;
WD := 2;
Subdivide( 0, 0, XA, YA );
Subdivide( 319 - XA, 0, 319, YA );
Subdivide( 0, 199 - YA, XA, 199 );
Subdivide( 319 - XA, 199 - YA, 319, 199 );
Subdivide( XA, 0, 319 - XA, YA );
Subdivide( XA, 199 - YA, 319 - XA, 199 );
Subdivide( 0, YA, XA, 199 - YA );
Subdivide( 319 - XA, YA, 319, 199 - YA );
END;
{
ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
º FUNCTION MakeDark º
ÇÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄĶ
º Input : Index to TxtMaps-array º
º Output : Index to new texture º
ÇÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄĶ
º Make dark copy of input texture º
ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
}
FUNCTION MakeDark( TIB : Integer ) : Integer;
VAR TID, i : Integer;
BPtr, DPtr : ^Byte;
BEGIN
TID := CreateNewTxt( TxtObj );
Pointer( BPtr ) := Pointer( TxtMaps[ TIB ] );
Pointer( DPtr ) := Pointer( TxtMaps[ TID ] );
FOR i := 0 TO Pred( WW * HW ) DO
BEGIN
DPtr^ := Succ( 19 * BPtr^ DIV 20 );
Inc( Word( DPtr ));
Inc( Word( BPtr ));
END;
MakeDark := TID
END;
{
ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
º PROCEDURE AdjustSpeed º
ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
}
PROCEDURE AdjustSpeed;
BEGIN
WaitDisplay;
IF Key[ ALT ] THEN
BEGIN
IF Key[ PLUS ] AND ( TurnSpeed < MaxTurn ) THEN Inc( TurnSpeed ) ELSE
IF Key[ MINUS ] AND ( TurnSpeed > MinTurn ) THEN Dec( TurnSpeed );
SBorderC( WB + TurnSpeed * WorldXZ DIV MaxTurn - 1 );
END
ELSE
BEGIN
IF Key[ PLUS ] AND ( MoveSpeed < MaxMove ) THEN Inc( MoveSpeed ) ELSE
IF Key[ MINUS ] AND ( MoveSpeed > MinMove ) THEN Dec( MoveSpeed );
SBorderC( BB + MoveSpeed * WorldXZ DIV MaxMove - 1 );
END;
WaitDisplay;
END;
{
ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
º PROCEDURE MoveHero º
ÇÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄĶ
º Move the player with the keyboard or mouse. Note, that altought in º
º theory MoveEye( 0, -MoveSpeed ) is equal to MoveEye( 180, MoveSpeed ), º
º it is better to use the latter, because the hit-the-wall check is done º
º using the angle parameter. º
ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
}
PROCEDURE MoveHero; { because a documented bug is a feature (and not a bug),}
VAR MDX, MDY : Integer;{ so, you can move same time by mouse and by keys, }
BEGIN { very fast... }
IF MouseInstalled THEN
BEGIN
MDX := ( Mouse.X - MaxTurn ) DIV 2;
MDY := ( MaxMove - Mouse.Y );
Mouse.SetPos( MaxTurn, MaxMove );
IF MDY < 0 THEN MoveEye( 180, -MDY ) ELSE MoveEye( 0, MDY );
IF Key[ ALT ] THEN MoveEye( Sgn( MDX ) * 90, Abs( MDX )) ELSE
TurnEye( MDX )
END;
IF Key[ PLUS ] OR Key[ MINUS ] THEN AdjustSpeed;
IF Key[ RightArrow ] THEN
IF Key[ ALT ] THEN MoveEye( 90, MoveSpeed ) ELSE TurnEye( TurnSpeed );
IF Key[ LeftArrow ] THEN
IF Key[ ALT ] THEN MoveEye( -90, MoveSpeed ) ELSE TurnEye( -TurnSpeed );
IF Key[ UpArrow ] THEN MoveEye( 0, MoveSpeed ) ELSE
IF Key[ DownArrow ] THEN MoveEye( 180, MoveSpeed );
END;
{
ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
º PROCEDURE LoadData º
ÇÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄĶ
º Load some textures from disk, and make some plasma-textures. º
ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
}
PROCEDURE LoadData;
BEGIN
BRICK0 := LoadTexture( 'BRICK0.PCX', TxtObj, PCXData );
BRICK1 := LoadTexture( 'BRICK1.PCX', TxtObj, PCXData );
MARBLE0 := LoadTexture( 'MARBLE0.DAT', TxtObj, RawData );
MARBLE1 := LoadTexture( 'MARBLE1.DAT', TxtObj, RawData );
PLASMA0 := MakePlasmaWall;
PLASMA1 := MakeDark( PLASMA0 );
MANDEL3D := LoadTexture( '3DMANDEL.DAT', TxtObj, RawData );
HAMILTON := LoadTexture( 'HAMILTON.PCX', TxtObj, PCXData );
CLOCKBG := LoadTexture( 'CLOCK.PCX', TxtObj, PCXData );
BRICK2 := LoadTexture( 'BRICK2.PCX', TxtObj, PCXData );
BRICK3 := LoadTexture( 'BRICK3.PCX', TxtObj, PCXData );
B3D := LoadTexture( '3D.PCX', TxtObj, PCXData );
GHOST := LoadTexture( 'GHOST.PCX', Creature, PCXData );
END;
{
ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
º PROCEDURE Lab3DColors º
ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
}
PROCEDURE Lab3DColors( VAR Pal : VGAPalTYPE );
VAR i, j, k : Integer;
BEGIN
FOR i := 0 TO 3 DO FOR j := 0 TO 3 DO FOR k := 0 TO 3 DO
WITH Pal[ 16 * i + 4 * j + k ] DO
BEGIN R := k * 16; G := j * 16; B := i * 16; END;
FOR i := 64 TO 95 DO WITH Pal[ i ] DO
BEGIN R := ( i - 64 ) * 2; G := 0; B := 0; END;
FOR i := 96 TO 127 DO WITH Pal[ i ] DO
BEGIN R := 0; G := ( i - 96 ) * 2; B := 0; END;
FOR i := 128 TO 191 DO WITH Pal[ i ] DO
BEGIN R := 0; G := 0; B := i - 128; END;
FOR i := 192 TO 256 DO WITH Pal[ i ] DO
BEGIN R := i - 192; G := i - 192; B := i - 192; END;
END;
{
ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
º PROCEDURE InitLabyrinth º
ÇÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄĶ
º Create maze, few creatures and worms. º
º The maze is loaded from disk now. If you want to save the maze to disk, º
º you _MUST_ do it before calls to InitCreature, InitWorm, etc. Textures º
º are not loaded or saved with Load/SaveWorld procedures, so you must do º
º it separately (see LoadData above). º
ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
}
PROCEDURE InitLabyrinth;
BEGIN {
SetWallTxtObjPoly( @PolyWallX0, @PolyWallZ0, @PolyWallTI0, 82 );
SetWallTxtObjPoly( @PolyWallX1, @PolyWallZ1, @PolyWallTI1, 16 );
SetWallTxtObjPoly( @PolyWallX2, @PolyWallZ2, @PolyWallTI2, 6 );
SetWallTxtObjBoxOut( 8, 4, 14, 10, BRICK3, BRICK2, B3D, BRICK2 );
SetWallTxtObjBoxOut( 20, 4, 22, 16, HAMILTON, MANDEL3D, HAMILTON, MANDEL3D );
SetWallTxtObjBoxOut( 12, 34, 16, 38, BRICK3, BRICK2, BRICK3, BRICK2 );
SetWallTxtObjBoxOut( 16, 22, 20, 28, MARBLE0, CLOCKBG, MARBLE0, MARBLE1 );
SaveWorld('L3D.MAP'); }
LoadWorld('L3D.MAP');
InitCreature( 2, 14, GHOST, 0 );
InitCreature( 14, 2, GHOST, 1 );
InitCreature( 22, 2, GHOST, 2 );
InitWorm( 6, 14, 16, BB + 63 );
InitWorm( 24, 38, 16, RB + 31 );
InitWorm( 32, 8, 16, WB + 63 );
SetEyePos( 22, 28, 0 );
END;
{
ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
º PROCEDURE InitScr º
ÇÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄĶ
º Draws the border and loads the init screen º
ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
}
PROCEDURE InitScr;
CONST BAdj = 2;
VAR i, x1, y1, x2, y2 : Word;
BEGIN
InitPCX( VScrXMax, VirtScr );
LoadPCX('INITSCR.PCX', 0, 0, FALSE );
Lab3DColors( Pal );
SBorderC( BB + MoveSpeed * WorldXZ DIV MaxMove - 1 );
CeilC := CeCo;
FloorC := FlCo;
x1 := 0;
y1 := 0;
x2 := 319;
y2 := 199;
FOR i := 0 TO BAdj DO
BEGIN
Line( x1 + i, y2 - i, x2 - i, y2 - i, BoCD );
Line( x2 - i, y1 + i, x2 - i, y2 - i, BoCD );
Line( x1 + i, y1 + i, x2 - i, y1 + i, BoCB );
Line( x1 + i, y1 + i, x1 + i, y2 - i, BoCB );
END;
x1 := XAdj - BAdj - 1;
y1 := YAdj - BAdj - 1;
x2 := XAdj + VScrXMax + BAdj;
y2 := YAdj + VScrYMax + BAdj;
FOR i := 0 TO BAdj DO
BEGIN
Line( x1 + i, y2 - i, x2 - i, y2 - i, BoCB );
Line( x2 - i, y1 + i, x2 - i, y2 - i, BoCB );
Line( x1 + i, y1 + i, x2 - i, y1 + i, BoCD );
Line( x1 + i, y1 + i, x1 + i, y2 - i, BoCD );
END;
MakePlasmaBorder;
ZeroDACs;
ShowWholeVirtScr;
BlackToColor( Pal, 256 )
END;
{
ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
º PROCEDURE ChkSystem º
ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
}
PROCEDURE ChkSystem;
BEGIN
IF Test8086 = 0 THEN FatalError('This program requires at least i286 prosessor.');
END;
{
ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
º PROCEDURE InitClock º
ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
}
PROCEDURE InitClock;
BEGIN
WITH ClockHands DO
BEGIN
HX := WW DIV 2;
HY := HW DIV 4;
MX := WW DIV 2;
MY := HW DIV 3;
SX := WW DIV 2;
SY := HW DIV 3;
END;
END;
{
ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
º PROCEDURE InitL3D º
ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
}
PROCEDURE InitL3D;
BEGIN
ChkSystem;
InitR16b;
InitVGA256;
VGAPal.Hide;
DefineScr( 320, 200, Ptr( SegA000, 0 ));
InitPCX( 320, Ptr( SegA000, 0 ));
LoadPCX( 'WAIT.PCX', 160 - 64, 100 - 16, TRUE );
FillChar( Pal[ GB ], SizeOf( RGB ) * ( 256 - GB ), 0 );
SetDACs( GB, 256 - GB, @Pal );
VGAPal.Show;
MouseInstalled := Mouse.ChkAndReset;
IF MouseInstalled THEN
BEGIN
Mouse.Hide;
Mouse.SetRange( 0, 0, 2 * MaxTurn, 2 * MaxMove );
Mouse.SetPos( MaxTurn, MaxMove )
END;
LoadData;
InitLabyrinth;
InitNonBlankKey;
InitClock;
InitScr;
REPEAT UNTIL KeyHitC;
StartInfo;
END;

PROCEDURE DebugL3D;
VAR i : Integer;
BEGIN
LoadData;
InitVGA256;
DefineScr( 320, 200, Ptr( SegA000, 0 ));
InitLabyrinth;
{ InitScr; }
STime := Clock;
FOR i := 1 TO 180 DO
BEGIN
DoMove;
Dec( EyePA.YAng, 4 );
END;
ETime := Clock;
OTime := ETime - STime;
REPEAT UNTIL KeyHit;
CloseVGA256;
WriteLn( OTime );
END;
{
ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
º PROCEDURE Pause º
ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
}
PROCEDURE Pause;
BEGIN
WHILE Key[ P ] DO;
WHILE NOT KeyHitC DO;
END;
{
ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
º PROCEDURE HandleKey º
ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
}
PROCEDURE HandleKey;
BEGIN
ETime := Clock;
Inc( OTime, ETime - STime );
IF Key[ F1 ] THEN Menu;
IF Key[ SPACE ] OR RightButton THEN ShowMap( SPACE );
IF Key[ P ] THEN Pause;
IF Key[ D ] THEN DebugInfo;
IF Key[ F5 ] THEN ReportSpeed;
IF Key[ ESC ] THEN EndOfGame := Sure('Exit to DOS (Y/N)?');
STime := Clock
END;
{
ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
º PROCEDURE RunL3D º
ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
}
PROCEDURE RunL3D;
BEGIN
STime := Clock;
REPEAT
MoveHero;
MoveCreatures;
MoveWorms;
MoveClock;
DoMove;
Inc( FrameCnt );
IF Key[ F1 ] OR Key[ SPACE ] OR RightButton OR Key[ P ] OR Key[ D ] OR
Key[ F5 ] OR Key[ ESC ] THEN HandleKey;
IF WaitVRT THEN WaitDisplay;
UNTIL EndOfGame
END;
{
ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
º PROCEDURE DoneL3D º
ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
}
PROCEDURE DoneL3D;
BEGIN
DisabKey;
CloseVGA256;
WriteLn;
WriteLn(' If you like this program, and wish you had the Turbo Pascal and ');
WriteLn(' assembler source code for the TxtMap Unit too, just register today! ');
WriteLn;
WriteLn(' Send $20 (or 100 Fmk) to me, and I`ll send the latest version of ');
WriteLn(' all the source code. ');
WriteLn;
WriteLn(' If you have any questions or comments, you can contact me ');
WriteLn(' via the internet email: [email protected] ');
WriteLn(' or "snail-mail": Kimmo Fredriksson ');
WriteLn(' Silvontie 38 ');
WriteLn(' 37740 Haukila ');
WriteLn(' FINLAND ');
WriteLn;
WriteLn;
END;

{ $DEFINE DEBUG}

BEGIN
{$IFDEF DEBUG}
DebugL3D
{$ELSE}
InitL3D;
RunL3D;
DoneL3D
{$ENDIF}
END.


  3 Responses to “Category : Pascal Source Code
Archive   : 3DLAB110.ZIP
Filename : L3D.PAS

  1. Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!

  2. This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.

  3. But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/