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

 
Output of file : L3DMENU.PAS contained in archive : 3DLAB110.ZIP
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
{ÄÄÄ( C ) Copyright 1994 By Kimmo Fredriksson.ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
{ÄÄÄYou may use this unit freely in your programs, and distribute them,ÄÄÄÄÄÄ}
{ÄÄÄbut you are *NOT* allowed to distribute any modified form of thisÄÄÄÄÄÄÄÄ}
{ÄÄÄunit, not source, nor the compiled TPU, TPP or whatsoever, *without*ÄÄÄÄÄ}
{ÄÄÄmy permission! In it's original form, this source is freeware.ÄÄÄÄÄÄÄÄÄÄÄ}
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
{ÄÄÄ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ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}

{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
{ÄÄÄ( C ) Copyright 1994 By Kimmo Fredriksson.ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
{ÄÄÄLabyrinth-3D Menus UnitÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}

{$A+,B-,D-,E-,F-,G+,I-,L-,N-,O-,P+,Q-,R-,S-,T-,V-,X+}

UNIT L3DMenu;

INTERFACE

PROCEDURE StartInfo;
PROCEDURE ReportSpeed;
PROCEDURE DebugInfo;
PROCEDURE ShowMap( KeyCode : Byte );
PROCEDURE Menu;
FUNCTION Sure( CONST s : STRING ) : Boolean;

IMPLEMENTATION

USES TxtMap,
L3DData,
L3DWorld,
VGAWin,
Controls,
Mouse,
VGA256;
{
ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
º FUNCTION Yes º
ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
}
FUNCTION Yes : Boolean;
BEGIN
Yes := Key[ Controls.Y ]
END;
{
ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
º FUNCTION No º
ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
}
FUNCTION No : Boolean;
BEGIN
No := Key[ Controls.N ]
END;
{
ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
º PROCEDURE WaitYesOrNo º
ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
}
PROCEDURE WaitYesOrNo;
BEGIN
REPEAT UNTIL Yes OR No
END;
{
ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
º FUNCTION IntToStr º
ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
}
FUNCTION IntToStr( a : LongInt ) : STRING;
VAR s : STRING[ 11 ];
BEGIN
Str( a, s );
IntToStr := ' ' + s
END;
{
ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
º PROCEDURE MessageBox º
ÇÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄĶ
º Input : message; text, bg and border colors, border type and scan-code º
º of the to wait (zero, if not any) º
ÇÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄĶ
º Open window, and show the desired message, and wait for key... º
ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
}
PROCEDURE MessageBox( CONST s : STRING; Txt, Bac, Bor, Fr : Byte; WaitKey : Byte );
BEGIN
IF NOT OpenWinCenter( Length( s ), 1, Bac, Bor, Fr ) THEN Exit;
WriteWin( 0, 0, Txt, s );
IF WaitKey = 0 THEN Exit;
WaitForKey( WaitKey );
CloseWin;
END;
{
ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
º FUNCTION AskQuestion º
ÇÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄĶ
º Input : question-string º
º Output : answer-boolean (TRUE, if user pressed Y, and FALSE if N) º
ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
}
FUNCTION AskQuestion( CONST Message : STRING ) : Boolean;
BEGIN
MessageBox( Message, DialogTxt, DialogBac, DialogBor, DoubleFr, 0 );
WaitYesOrNo;
AskQuestion := Yes;
WHILE KeyHitC DO;
CloseWin;
END;
{
ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
º FUNCTION Sure º
ÇÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄĶ
º Input : message (question) to user to apply º
º Output : TRUE, if Y pressed, and FALSE if N pressed º
ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
}
FUNCTION Sure( CONST s : STRING ) : Boolean;
BEGIN
MessageBox( s, DialogTxt, DialogBac, DialogBor, DoubleFr, 0 );
WaitYesOrNo;
Sure := Yes;
CloseWin;
END;
{
ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
º PROCEDURE KeyInfo º
ÇÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄĶ
º Show key-instructions in window, and wait for ESC º
ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
}
PROCEDURE KeyInfo;
BEGIN
IF NOT OpenWinCenter( 26, 16, HelpBac, HelpBor, SingleFr ) THEN Exit;
WriteWin( 1, 0, HelpTxt, #24' : Move forwards' );
WriteWin( 1, 1, HelpTxt, #25' : Move backwards' );
WriteWin( 1, 2, HelpTxt, #27' : Turnt to left' );
WriteWin( 1, 3, HelpTxt, #26' : Turn to right' );
WriteWin( 1, 4, HelpTxt, #27' & ALT : Move to left' );
WriteWin( 1, 5, HelpTxt, #26' & ALT : Move to right' );
WriteWin( 1, 6, HelpTxt, '+ : Move faster' );
WriteWin( 1, 7, HelpTxt, '- : Move slower' );
WriteWin( 1, 8, HelpTxt, '+ & ALT : Turn faster' );
WriteWin( 1, 9, HelpTxt, '- & ALT : Turn slower' );
WriteWin( 1, 10, HelpTxt, 'SPACE : Show map' );
WriteWin( 1, 11, HelpTxt, 'P : Pause' );
WriteWin( 1, 12, HelpTxt, 'ESC : Exit to DOS' );
WriteWin( 1, 14, HelpTxt, 'You may use the mouse' );
WriteWin( 1, 15, HelpTxt, 'instead of the arrows.' );
WaitForKey( ESC );
CloseWin
END;
{
ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
º PROCEDURE L3DInfo º
ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
}
PROCEDURE L3DInfo;
BEGIN
IF NOT OpenWinCenter( 33, 7, HelpBac, HelpBor, SingleFr ) THEN Exit;
WriteWin( 1, 0, HelpTxt, 'You are in 3-D labyrinth, where' );
WriteWin( 1, 1, HelpTxt, 'you can move by using the arrow' );
WriteWin( 1, 2, HelpTxt, 'keys or mouse.' );
WriteWin( 1, 3, HelpTxt, 'If you get lost, you may check' );
WriteWin( 1, 4, HelpTxt, 'your position in the map.' );
WriteWin( 1, 5, HelpTxt, 'If you need help at any time' );
WriteWin( 1, 6, HelpTxt, 'press F1.' );
WaitForKey( ESC );
CloseWin
END;
{
ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
º PROCEDURE AboutL3D º
ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
}
PROCEDURE AboutL3D;
BEGIN
IF NOT OpenWinCenter( 33, 7, HelpBac, HelpBor, SingleFr ) THEN Exit;
WriteWin( 1, 0, HelpTxt, ' Labyrinth-3D, register to get' );
WriteWin( 1, 1, HelpTxt, ' the Turbo Pascal & assembler' );
WriteWin( 1, 2, HelpTxt, ' source of the TxtMap-unit! ' );
WriteWin( 1, 4, HelpTxt, 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ' );
WriteWin( 1, 5, HelpTxt, ' (C) 1994 By Kimmo Fredriksson' );
WriteWin( 1, 6, HelpTxt, 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ' );
WaitForKey( ESC );
CloseWin
END;
{
ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
º PROCEDURE Instructions º
ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
}
PROCEDURE Instructions;
BEGIN
IF NOT OpenWinCenter( 16, 5, MenuBac, MenuBor, DoubleFr ) THEN Exit;
WriteWin( 1, 0, MenuSta, 'Instructions...' );
WriteWin( 1, 2, MenuTxt, 'F1 - Controls' );
WriteWin( 1, 3, MenuTxt, 'F2 - Something' );
WriteWin( 1, 4, MenuTxt, 'F3 - About' );
WHILE Key[ F1 ] DO;
REPEAT
IF Key[ F1 ] THEN KeyInfo;
IF Key[ F2 ] THEN L3DInfo;
IF Key[ F3 ] THEN AboutL3D;
UNTIL Key[ ESC ];
WHILE Key[ ESC ] DO;
CloseWin
END;
{
ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
º PROCEDURE ShowMap º
ÇÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄĶ
º Input : If ESC, wait for ESC. If SPACE, wait for SPACE to released º
ÇÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄĶ
º Player is the white point in the map, creatures are red, and worms blue.º
ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
}
PROCEDURE ShowMap( KeyCode : Byte );
VAR i, j, x, y, xc, yc, xd, yd, IP : Integer;
BEGIN
WITH WallData DO
BEGIN
xd := MaxWX - MinWX;
yd := MaxWZ - MinWZ;
xc := PXCent - xd DIV 2 - MinWX;
yc := PYCent + yd DIV 2 + MinWZ;
DefineScr( PScrXMax, PScrYMAx, Ptr( SegA000, 0 ));
IF NOT OpenWinCenter( xd DIV 8 + 1, yd DIV 8, MessageBac, MessageBac, DoubleFr ) THEN Exit;
FOR y := MinWZ TO MaxWZ DO FOR x := MinWX TO MaxWX DO
IF GetOneWall( x, y ) THEN PutPixel( xc + x, yc - y, MessageTxt );
FOR i := 0 TO Pred( NumOfCreats ) DO WITH Creatures[ i ]^.TxtRecPtr^ DO
PutPixel( xc + 2 * Points[ LPInd ].X DIV WorldXZ,
yc - 2 * Points[ LPInd ].Z DIV WorldXZ, RB + 31 );
FOR i := 0 TO Pred( NumOfWorms ) DO WITH Worms[ i ]^ DO
FOR j := 0 TO Pred( Len ) DO WITH TxtRecPtr[ j ]^ DO
PutPixel( xc + 2 * Points[ LPInd ].X DIV WorldXZ,
yc - 2 * Points[ LPInd ].Z DIV WorldXZ, BB + 63 );
PutPixel( xc + 2 * EyePA.X DIV WorldXZ, yc - 2 * EyePA.Z DIV WorldXZ, WB + 63 );
CASE KeyCode OF
SPACE : WHILE Key[ SPACE ] OR ( MouseInstalled AND RightButton ) DO;
ESC : WaitForKey( ESC );
END;
CloseWin
END
END;
{
ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
º PROCEDURE ShowVersion º
ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
}
PROCEDURE ShowVersion;
BEGIN
MessageBox( Version, MessageTxt, MessageBac, MessageBor, SingleFr, ESC )
END;
{
ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
º PROCEDURE DebugInfo º
ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
}
PROCEDURE DebugInfo;
BEGIN
IF NOT OpenWinCenter( 25, 15, MessageBac, MessageBor, SingleFr ) THEN Exit;
WriteWin( 1, 0, MessageTxt, 'MemAvail: ' + IntToStr( MemAvail ));
WriteWin( 1, 1, MessageTxt, 'MaxAvail: ' + IntToStr( MaxAvail ));
WriteWin( 1, 2, MessageTxt, 'NumOfTxtObjs: ' + IntToStr( NumOfTxtObjs ));
WriteWin( 1, 3, MessageTxt, 'NumOfPoints: ' + IntToStr( NumOfPoints ));
WriteWin( 1, 4, MessageTxt, 'NumOfTxts: ' + IntToStr( NumOfTxts ));
WriteWin( 1, 5, MessageTxt, 'NumOfWalls: ' + IntToStr( NumOfWalls ));
WriteWin( 1, 6, MessageTxt, 'NumOfVisTxtObjs:' + IntToStr( NumOfVisTxtObjs ));
WriteWin( 1, 7, MessageTxt, 'NumOfVisWalls ' + IntToStr( NumOfVisWalls ));
WriteWin( 1, 8, MessageTxt, 'NumOfCreats: ' + IntToStr( NumOfCreats ));
WriteWin( 1, 9, MessageTxt, 'NumOfWorms: ' + IntToStr( NumOfWorms ));
WriteWin( 1, 10, MessageTxt, 'EyeX: ' + IntToStr( EyePA.X ));
WriteWin( 1, 11, MessageTxt, 'EyeZ: ' + IntToStr( EyePA.Z ));
WriteWin( 1, 12, MessageTxt, 'EyeAngle: ' + IntToStr( EyePA.YAng ));
WriteWin( 1, 13, MessageTxt, 'MoveSpeed ' + IntToStr( MoveSpeed ));
WriteWin( 1, 14, MessageTxt, 'TurnSpeed ' + IntToStr( TurnSpeed ));
WaitForKey( ESC );
CloseWin
END;
{
ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
º PROCEDURE AskChkHit º
ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
}
PROCEDURE AskChkHit;
BEGIN
ChkHit := NOT AskQuestion('Go throught the walls (Y/N)?' )
END;
{
ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
º PROCEDURE AskWaitVRT º
ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
}
PROCEDURE AskWaitVRT;
BEGIN
WaitVRT := AskQuestion('Wait Vertical Retrace (Y/N)?' )
END;
{
ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
º PROCEDURE AskRemoveHFF º
ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
}
PROCEDURE AskRemoveHFF;
BEGIN
RemoveHFF := AskQuestion('Hidden face removal (Y/N)?' )
END;
{
ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
º PROCEDURE ReportSpeed º
ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
}
PROCEDURE ReportSpeed;
VAR s : STRING[ 40 ];
BEGIN
Str( 10 * FrameCnt DIV ( 65536 * OTime DIV 1193180 ), s );
Insert( '.', s, Length( s ));
MessageBox( s + ' frames / second!', MessageTxt, MessageBac, MessageBor, SingleFr, 0 );
WHILE Key[ F5 ] DO;
CloseWin
END;
{
ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
º PROCEDURE Debug º
ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
}
PROCEDURE Debug;
BEGIN
IF NOT OpenWinCenter( 25, 8, MenuBac, MenuBor, DoubleFr ) THEN Exit;
WriteWin( 1, 0, MenuSta, 'Labyrinth-3D, (C) By KF' );
WriteWin( 1, 1, MenuSta, 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ' );
WriteWin( 1, 3, MenuTxt, 'F1 - Debug Information' );
WriteWin( 1, 4, MenuTxt, 'F2 - Throught walls...' );
WriteWin( 1, 5, MenuTxt, 'F3 - Wait VRT' );
WriteWin( 1, 6, MenuTxt, 'F4 - Hidden Face Remove' );
WriteWin( 1, 7, MenuTxt, 'F5 - Report Speed' );
WHILE Key[ F1 ] DO;
REPEAT
IF Key[ F1 ] THEN DebugInfo;
IF Key[ F2 ] THEN AskChkHit;
IF Key[ F3 ] THEN AskWaitVRT;
IF Key[ F4 ] THEN AskRemoveHFF;
IF Key[ F5 ] THEN ReportSpeed;
UNTIL Key[ ESC ];
WHILE Key[ ESC ] DO;
CloseWin
END;
{
ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
º PROCEDURE Menu º
ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
}
PROCEDURE Menu;
BEGIN
IF NOT OpenWinCenter( 25, 8, MenuBac, MenuBor, DoubleFr ) THEN Exit;
WriteWin( 1, 0, MenuSta, 'Labyrinth-3D, (C) By KF' );
WriteWin( 1, 1, MenuSta, 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ' );
WriteWin( 1, 3, MenuTxt, 'F1 - Instructions' );
WriteWin( 1, 4, MenuTxt, 'F2 - Map' );
WriteWin( 1, 5, MenuTxt, 'F9 - Version' );
WriteWin( 1, 7, MenuTxt, 'D - Debug' );
WHILE Key[ F1 ] DO;
REPEAT
IF Key[ F1 ] THEN Instructions;
IF Key[ F2 ] THEN ShowMap( ESC );
IF Key[ F9 ] THEN ShowVersion;
IF Key[ D ] THEN Debug;
UNTIL Key[ ESC ];
WHILE Key[ ESC ] DO;
CloseWin
END;
{
ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
º PROCEDURE StartInfo º
ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
}
PROCEDURE StartInfo;
BEGIN
IF NOT OpenWinCenter( 25, 5, MenuBac, MenuBor, DoubleFr ) THEN Exit;
WriteWin( 1, 0, MenuSta, 'Labyrinth-3D, (C) By KF' );
WriteWin( 1, 1, MenuSta, 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ' );
WriteWin( 1, 3, MenuTxt, 'F1 - Instructions' );
WriteWin( 1, 4, MenuTxt, 'SPACE - Start' );
WHILE KeyHitC DO;
REPEAT
IF Key[ F1 ] THEN Instructions
UNTIL Key[ SPACE ];
WHILE Key[ SPACE ] DO;
CloseWin
END;

END.


  3 Responses to “Category : Pascal Source Code
Archive   : 3DLAB110.ZIP
Filename : L3DMENU.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/