home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 16 / CD_ASCQ_16_0994.iso / news / 573 / 3dlab101 / l3dmenu.pas < prev    next >
Pascal/Delphi Source File  |  1994-05-26  |  17KB  |  403 lines
  1. {────────────────────────────────────────────────────────────────────────────}
  2. {───( C ) Copyright 1994 By Kimmo Fredriksson.───────────────────────────────}
  3. {────────────────────────────────────────────────────────────────────────────}
  4. {───You may use this unit freely in your programs, and distribute them,──────}
  5. {───but you are *NOT* allowed to distribute any modified form of this────────}
  6. {───unit, not source, nor the compiled TPU, TPP or whatsoever, *without*─────}
  7. {───my permission! In it's original form, this source is freeware.───────────}
  8. {────────────────────────────────────────────────────────────────────────────}
  9. {───Internet email: Kimmo.Fredriksson@Helsinki.FI────────────────────────────}
  10. {────────────────────────────────────────────────────────────────────────────}
  11.  
  12. {────────────────────────────────────────────────────────────────────────────}
  13. {───If you want the Turbo Pascal and assembler source code for the TxtMap────}
  14. {───Unit, register today. Send $20 (or 100 Fmk) to me, and I'll send all─────}
  15. {───the source to you.───────────────────────────────────────────────────────}
  16. {────────────────────────────────────────────────────────────────────────────}
  17. {─────────Kimmo Fredriksson──────────────────────────────────────────────────}
  18. {─────────Silvontie 38───────────────────────────────────────────────────────}
  19. {─────────37740 Haukila──────────────────────────────────────────────────────}
  20. {─────────FINLAND────────────────────────────────────────────────────────────}
  21. {────────────────────────────────────────────────────────────────────────────}
  22.  
  23. {────────────────────────────────────────────────────────────────────────────}
  24. {───( C ) Copyright 1994 By Kimmo Fredriksson.───────────────────────────────}
  25. {────────────────────────────────────────────────────────────────────────────}
  26. {───Labyrinth-3D Menus Unit──────────────────────────────────────────────────}
  27. {────────────────────────────────────────────────────────────────────────────}
  28.  
  29. {$A+,B-,D-,E-,F-,G+,I-,L-,N-,O-,P+,Q-,R-,S-,T-,V-,X+}
  30.  
  31. UNIT    L3DMenu;
  32.  
  33.     INTERFACE
  34.  
  35. PROCEDURE StartInfo;
  36. PROCEDURE ReportSpeed;
  37. PROCEDURE DebugInfo;
  38. PROCEDURE ShowMap( KeyCode : Byte );
  39. PROCEDURE Menu;
  40. FUNCTION  Sure( CONST s : STRING ) : Boolean;
  41.  
  42.     IMPLEMENTATION
  43.  
  44. USES    TxtMap,
  45.     L3DData,
  46.     L3DWorld,
  47.     VGAWin,
  48.     Controls,
  49.     Mouse,
  50.     VGA256;
  51. {
  52.  ╔═════════════════════════════════════════════════════════════════════════╗
  53.  ║ FUNCTION Yes                                                            ║
  54.  ╚═════════════════════════════════════════════════════════════════════════╝
  55. }
  56. FUNCTION Yes : Boolean;
  57. BEGIN
  58.   Yes := Key[ Controls.Y ]
  59. END;
  60. {
  61.  ╔═════════════════════════════════════════════════════════════════════════╗
  62.  ║ FUNCTION No                                                             ║
  63.  ╚═════════════════════════════════════════════════════════════════════════╝
  64. }
  65. FUNCTION No : Boolean;
  66. BEGIN
  67.   No := Key[ Controls.N ]
  68. END;
  69. {
  70.  ╔═════════════════════════════════════════════════════════════════════════╗
  71.  ║ PROCEDURE WaitYesOrNo                                                   ║
  72.  ╚═════════════════════════════════════════════════════════════════════════╝
  73. }
  74. PROCEDURE WaitYesOrNo;
  75. BEGIN
  76.   REPEAT UNTIL Yes OR No
  77. END;
  78. {
  79.  ╔═════════════════════════════════════════════════════════════════════════╗
  80.  ║ FUNCTION IntToStr                                                       ║
  81.  ╚═════════════════════════════════════════════════════════════════════════╝
  82. }
  83. FUNCTION IntToStr( a : LongInt ) : STRING;
  84. VAR s : STRING[ 11 ];
  85. BEGIN
  86.   Str( a, s );
  87.   IntToStr := ' ' + s
  88. END;
  89. {
  90.  ╔═════════════════════════════════════════════════════════════════════════╗
  91.  ║ PROCEDURE MessageBox                                                    ║
  92.  ╟─────────────────────────────────────────────────────────────────────────╢
  93.  ║ Input  : message; text, bg and border colors, border type and scan-code ║
  94.  ║          of the to wait (zero, if not any)                              ║
  95.  ╟─────────────────────────────────────────────────────────────────────────╢
  96.  ║ Open window, and show the desired message, and wait for key...          ║
  97.  ╚═════════════════════════════════════════════════════════════════════════╝
  98. }
  99. PROCEDURE MessageBox( CONST s : STRING; Txt, Bac, Bor, Fr : Byte; WaitKey : Byte );
  100. BEGIN
  101.   IF NOT OpenWinCenter( Length( s ), 1, Bac, Bor, Fr ) THEN Exit;
  102.   WriteWin( 0, 0, Txt, s );
  103.   IF WaitKey = 0 THEN Exit;
  104.   WaitForKey( WaitKey );
  105.   CloseWin;
  106. END;
  107. {
  108.  ╔═════════════════════════════════════════════════════════════════════════╗
  109.  ║ FUNCTION AskQuestion                                                    ║
  110.  ╟─────────────────────────────────────────────────────────────────────────╢
  111.  ║ Input  : question-string                                                ║
  112.  ║ Output : answer-boolean (TRUE, if user pressed Y, and FALSE if N)       ║
  113.  ╚═════════════════════════════════════════════════════════════════════════╝
  114. }
  115. FUNCTION AskQuestion( CONST Message : STRING ) : Boolean;
  116. BEGIN
  117.   MessageBox( Message, DialogTxt, DialogBac, DialogBor, DoubleFr, 0 );
  118.   WaitYesOrNo;
  119.   AskQuestion := Yes;
  120.   WHILE KeyHitC DO;
  121.   CloseWin;
  122. END;
  123. {
  124.  ╔═════════════════════════════════════════════════════════════════════════╗
  125.  ║ FUNCTION Sure                                                           ║
  126.  ╟─────────────────────────────────────────────────────────────────────────╢
  127.  ║ Input  : message (question) to user to apply                            ║
  128.  ║ Output : TRUE, if Y pressed, and FALSE if N pressed                     ║
  129.  ╚═════════════════════════════════════════════════════════════════════════╝
  130. }
  131. FUNCTION Sure( CONST s : STRING ) : Boolean;
  132. BEGIN
  133.   MessageBox( s, DialogTxt, DialogBac, DialogBor, DoubleFr, 0 );
  134.   WaitYesOrNo;
  135.   Sure := Yes;
  136.   CloseWin;
  137. END;
  138. {
  139.  ╔═════════════════════════════════════════════════════════════════════════╗
  140.  ║ PROCEDURE KeyInfo                                                       ║
  141.  ╟─────────────────────────────────────────────────────────────────────────╢
  142.  ║ Show key-instructions in window, and wait for ESC                       ║
  143.  ╚═════════════════════════════════════════════════════════════════════════╝
  144. }
  145. PROCEDURE KeyInfo;
  146. BEGIN
  147.   IF NOT OpenWinCenter( 26, 16, HelpBac, HelpBor, SingleFr ) THEN Exit;
  148.   WriteWin( 1, 0,  HelpTxt, #24'       : Move forwards' );
  149.   WriteWin( 1, 1,  HelpTxt, #25'       : Move backwards' );
  150.   WriteWin( 1, 2,  HelpTxt, #27'       : Turnt to left' );
  151.   WriteWin( 1, 3,  HelpTxt, #26'       : Turn to right' );
  152.   WriteWin( 1, 4,  HelpTxt, #27' & ALT : Move to left' );
  153.   WriteWin( 1, 5,  HelpTxt, #26' & ALT : Move to right' );
  154.   WriteWin( 1, 6,  HelpTxt, '+       : Move faster' );
  155.   WriteWin( 1, 7,  HelpTxt, '-       : Move slower' );
  156.   WriteWin( 1, 8,  HelpTxt, '+ & ALT : Turn faster' );
  157.   WriteWin( 1, 9,  HelpTxt, '- & ALT : Turn slower' );
  158.   WriteWin( 1, 10, HelpTxt, 'SPACE   : Show map' );
  159.   WriteWin( 1, 11, HelpTxt, 'P       : Pause' );
  160.   WriteWin( 1, 12, HelpTxt, 'ESC     : Exit to DOS' );
  161.   WriteWin( 1, 14, HelpTxt, 'You may use the mouse' );
  162.   WriteWin( 1, 15, HelpTxt, 'instead of the arrows.' );
  163.   WaitForKey( ESC );
  164.   CloseWin
  165. END;
  166. {
  167.  ╔═════════════════════════════════════════════════════════════════════════╗
  168.  ║ PROCEDURE L3DInfo                                                       ║
  169.  ╚═════════════════════════════════════════════════════════════════════════╝
  170. }
  171. PROCEDURE L3DInfo;
  172. BEGIN
  173.   IF NOT OpenWinCenter( 33, 7, HelpBac, HelpBor, SingleFr ) THEN Exit;
  174.   WriteWin( 1, 0,  HelpTxt, 'You are in 3-D labyrinth, where' );
  175.   WriteWin( 1, 1,  HelpTxt, 'you can move by using the arrow' );
  176.   WriteWin( 1, 2,  HelpTxt, 'keys or mouse.' );
  177.   WriteWin( 1, 3,  HelpTxt, 'If you get lost, you may check' );
  178.   WriteWin( 1, 4,  HelpTxt, 'your position in the map.' );
  179.   WriteWin( 1, 5,  HelpTxt, 'If you need help at any time' );
  180.   WriteWin( 1, 6,  HelpTxt, 'press F1.' );
  181.   WaitForKey( ESC );
  182.   CloseWin
  183. END;
  184. {
  185.  ╔═════════════════════════════════════════════════════════════════════════╗
  186.  ║ PROCEDURE AboutL3D                                                      ║
  187.  ╚═════════════════════════════════════════════════════════════════════════╝
  188. }
  189. PROCEDURE AboutL3D;
  190. BEGIN
  191.   IF NOT OpenWinCenter( 33, 7, HelpBac, HelpBor, SingleFr ) THEN Exit;
  192.   WriteWin( 1, 0,  HelpTxt, ' Labyrinth-3D, register to get' );
  193.   WriteWin( 1, 1,  HelpTxt, ' the Turbo Pascal & assembler' );
  194.   WriteWin( 1, 2,  HelpTxt, ' source of the TxtMap-unit! ' );
  195.   WriteWin( 1, 4,  HelpTxt, '───────────────────────────────' );
  196.   WriteWin( 1, 5,  HelpTxt, ' (C) 1994 By Kimmo Fredriksson' );
  197.   WriteWin( 1, 6,  HelpTxt, '───────────────────────────────' );
  198.   WaitForKey( ESC );
  199.   CloseWin
  200. END;
  201. {
  202.  ╔═════════════════════════════════════════════════════════════════════════╗
  203.  ║ PROCEDURE Instructions                                                  ║
  204.  ╚═════════════════════════════════════════════════════════════════════════╝
  205. }
  206. PROCEDURE Instructions;
  207. BEGIN
  208.   IF NOT OpenWinCenter( 16, 5, MenuBac, MenuBor, DoubleFr ) THEN Exit;
  209.   WriteWin( 1, 0, MenuSta, 'Instructions...' );
  210.   WriteWin( 1, 2, MenuTxt, 'F1 - Controls' );
  211.   WriteWin( 1, 3, MenuTxt, 'F2 - Something' );
  212.   WriteWin( 1, 4, MenuTxt, 'F3 - About' );
  213.   WHILE Key[ F1 ] DO;
  214.   REPEAT
  215.     IF Key[ F1 ] THEN KeyInfo;
  216.     IF Key[ F2 ] THEN L3DInfo;
  217.     IF Key[ F3 ] THEN AboutL3D;
  218.   UNTIL Key[ ESC ];
  219.   WHILE Key[ ESC ] DO;
  220.   CloseWin
  221. END;
  222. {
  223.  ╔═════════════════════════════════════════════════════════════════════════╗
  224.  ║ PROCEDURE ShowMap                                                       ║
  225.  ╟─────────────────────────────────────────────────────────────────────────╢
  226.  ║ Input  : If ESC, wait for ESC. If SPACE, wait for SPACE to released     ║
  227.  ╟─────────────────────────────────────────────────────────────────────────╢
  228.  ║ Player is the white point in the map, creatures are red, and worms blue.║
  229.  ╚═════════════════════════════════════════════════════════════════════════╝
  230. }
  231. PROCEDURE ShowMap( KeyCode : Byte );
  232. VAR i, j, x, y, xc, yc, xd, yd, IP : Integer;
  233. BEGIN
  234.   xd := MaxWX - MinWX;
  235.   yd := MaxWZ - MinWZ;
  236.   xc := PXCent - xd DIV 2 - MinWX;
  237.   yc := PYCent + yd DIV 2 + MinWZ;
  238.   DefineScr( PScrXMax, PScrYMAx, Ptr( SegA000, 0 ));
  239.   IF NOT OpenWinCenter( xd DIV 8 + 1, yd DIV 8, MessageBac, MessageBac, DoubleFr ) THEN Exit;
  240.   FOR y := MinWZ TO MaxWZ DO FOR x := MinWX TO MaxWX DO
  241.     IF GetOneWall( x, y ) THEN PutPixel( xc + x, yc - y, MessageTxt );
  242.   FOR i := 0 TO Pred( NumOfCreats ) DO WITH Creatures[ i ]^.TxtRecPtr^ DO
  243.     PutPixel( xc + 2 * Points[ LPInd ].X DIV WorldXZ,
  244.           yc - 2 * Points[ LPInd ].Z DIV WorldXZ, RB + 31 );
  245.   FOR i := 0 TO Pred( NumOfWorms ) DO WITH Worms[ i ]^ DO
  246.     FOR j := 0 TO Pred( Len ) DO WITH TxtRecPtr[ j ]^ DO
  247.       PutPixel( xc + 2 * Points[ LPInd ].X DIV WorldXZ,
  248.         yc - 2 * Points[ LPInd ].Z DIV WorldXZ, BB + 63 );
  249.   PutPixel( xc + 2 * EyePA.X DIV WorldXZ, yc - 2 * EyePA.Z DIV WorldXZ, WB + 63 );
  250.   CASE KeyCode OF
  251.     SPACE : WHILE Key[ SPACE ] OR ( MouseInstalled AND RightButton ) DO;
  252.     ESC   : WaitForKey( ESC );
  253.   END;
  254.   CloseWin
  255. END;
  256. {
  257.  ╔═════════════════════════════════════════════════════════════════════════╗
  258.  ║ PROCEDURE ShowVersion                                                   ║
  259.  ╚═════════════════════════════════════════════════════════════════════════╝
  260. }
  261. PROCEDURE ShowVersion;
  262. BEGIN
  263.   MessageBox( Version, MessageTxt, MessageBac, MessageBor, SingleFr, ESC )
  264. END;
  265. {
  266.  ╔═════════════════════════════════════════════════════════════════════════╗
  267.  ║ PROCEDURE DebugInfo                                                     ║
  268.  ╚═════════════════════════════════════════════════════════════════════════╝
  269. }
  270. PROCEDURE DebugInfo;
  271. BEGIN
  272.   IF NOT OpenWinCenter( 25, 15, MessageBac, MessageBor, SingleFr ) THEN Exit;
  273.   WriteWin( 1, 0,  MessageTxt, 'MemAvail:       ' + IntToStr( MemAvail ));
  274.   WriteWin( 1, 1,  MessageTxt, 'MaxAvail:       ' + IntToStr( MaxAvail ));
  275.   WriteWin( 1, 2,  MessageTxt, 'NumOfTxtObjs:   ' + IntToStr( NumOfTxtObjs ));
  276.   WriteWin( 1, 3,  MessageTxt, 'NumOfPoints:    ' + IntToStr( NumOfPoints ));
  277.   WriteWin( 1, 4,  MessageTxt, 'NumOfTxts:      ' + IntToStr( NumOfTxts ));
  278.   WriteWin( 1, 5,  MessageTxt, 'NumOfWalls:     ' + IntToStr( NumOfWalls ));
  279.   WriteWin( 1, 6,  MessageTxt, 'NumOfVisTxtObjs:' + IntToStr( NumOfVisTxtObjs ));
  280.   WriteWin( 1, 7,  MessageTxt, 'NumOfVisWalls   ' + IntToStr( NumOfVisWalls ));
  281.   WriteWin( 1, 8,  MessageTxt, 'NumOfCreats:    ' + IntToStr( NumOfCreats ));
  282.   WriteWin( 1, 9,  MessageTxt, 'NumOfWorms:     ' + IntToStr( NumOfWorms ));
  283.   WriteWin( 1, 10, MessageTxt, 'EyeX:           ' + IntToStr( EyePA.X ));
  284.   WriteWin( 1, 11, MessageTxt, 'EyeZ:           ' + IntToStr( EyePA.Z ));
  285.   WriteWin( 1, 12, MessageTxt, 'EyeAngle:       ' + IntToStr( EyePA.YAng ));
  286.   WriteWin( 1, 13, MessageTxt, 'MoveSpeed       ' + IntToStr( MoveSpeed ));
  287.   WriteWin( 1, 14, MessageTxt, 'TurnSpeed       ' + IntToStr( TurnSpeed ));
  288.   WaitForKey( ESC );
  289.   CloseWin
  290. END;
  291. {
  292.  ╔═════════════════════════════════════════════════════════════════════════╗
  293.  ║ PROCEDURE AskChkHit                                                     ║
  294.  ╚═════════════════════════════════════════════════════════════════════════╝
  295. }
  296. PROCEDURE AskChkHit;
  297. BEGIN
  298.   ChkHit := AskQuestion('Go throught the walls (Y/N)?' )
  299. END;
  300. {
  301.  ╔═════════════════════════════════════════════════════════════════════════╗
  302.  ║ PROCEDURE AskWaitVRT                                                    ║
  303.  ╚═════════════════════════════════════════════════════════════════════════╝
  304. }
  305. PROCEDURE AskWaitVRT;
  306. BEGIN
  307.   WaitVRT := AskQuestion('Wait Vertical Retrace (Y/N)?' )
  308. END;
  309. {
  310.  ╔═════════════════════════════════════════════════════════════════════════╗
  311.  ║ PROCEDURE AskRemoveHFF                                                  ║
  312.  ╚═════════════════════════════════════════════════════════════════════════╝
  313. }
  314. PROCEDURE AskRemoveHFF;
  315. BEGIN
  316.   RemoveHFF := AskQuestion('Hidden face removal (Y/N)?' )
  317. END;
  318. {
  319.  ╔═════════════════════════════════════════════════════════════════════════╗
  320.  ║ PROCEDURE ReportSpeed                                                   ║
  321.  ╚═════════════════════════════════════════════════════════════════════════╝
  322. }
  323. PROCEDURE ReportSpeed;
  324. VAR s : STRING[ 40 ];
  325. BEGIN
  326.   Str( 10 * FrameCnt DIV ( 65536 * OTime DIV 1193180 ), s );
  327.   Insert( '.', s, Length( s ));
  328.   MessageBox( s + ' frames / second!', MessageTxt, MessageBac, MessageBor, SingleFr, 0 );
  329.   WHILE Key[ F5 ] DO;
  330.   CloseWin
  331. END;
  332. {
  333.  ╔═════════════════════════════════════════════════════════════════════════╗
  334.  ║ PROCEDURE Debug                                                         ║
  335.  ╚═════════════════════════════════════════════════════════════════════════╝
  336. }
  337. PROCEDURE Debug;
  338. BEGIN
  339.   IF NOT OpenWinCenter( 25, 8, MenuBac, MenuBor, DoubleFr ) THEN Exit;
  340.   WriteWin( 1, 0, MenuSta, 'Labyrinth-3D, (C) By KF' );
  341.   WriteWin( 1, 1, MenuSta, '───────────────────────' );
  342.   WriteWin( 1, 3, MenuTxt, 'F1 - Debug Information' );
  343.   WriteWin( 1, 4, MenuTxt, 'F2 - Throught walls...' );
  344.   WriteWin( 1, 5, MenuTxt, 'F3 - Wait VRT' );
  345.   WriteWin( 1, 6, MenuTxt, 'F4 - Hidden Face Remove' );
  346.   WriteWin( 1, 7, MenuTxt, 'F5 - Report Speed' );
  347.   WHILE Key[ F1 ] DO;
  348.   REPEAT
  349.     IF Key[ F1 ] THEN DebugInfo;
  350.     IF Key[ F2 ] THEN AskChkHit;
  351.     IF Key[ F3 ] THEN AskWaitVRT;
  352.     IF Key[ F4 ] THEN AskRemoveHFF;
  353.     IF Key[ F5 ] THEN ReportSpeed;
  354.   UNTIL Key[ ESC ];
  355.   WHILE Key[ ESC ] DO;
  356.   CloseWin
  357. END;
  358. {
  359.  ╔═════════════════════════════════════════════════════════════════════════╗
  360.  ║ PROCEDURE Menu                                                          ║
  361.  ╚═════════════════════════════════════════════════════════════════════════╝
  362. }
  363. PROCEDURE Menu;
  364. BEGIN
  365.   IF NOT OpenWinCenter( 25, 8, MenuBac, MenuBor, DoubleFr ) THEN Exit;
  366.   WriteWin( 1, 0, MenuSta, 'Labyrinth-3D, (C) By KF' );
  367.   WriteWin( 1, 1, MenuSta, '───────────────────────' );
  368.   WriteWin( 1, 3, MenuTxt, 'F1 - Instructions' );
  369.   WriteWin( 1, 4, MenuTxt, 'F2 - Map' );
  370.   WriteWin( 1, 5, MenuTxt, 'F9 - Version' );
  371.   WriteWin( 1, 7, MenuTxt, 'D  - Debug' );
  372.   WHILE Key[ F1 ] DO;
  373.   REPEAT
  374.     IF Key[ F1 ] THEN Instructions;
  375.     IF Key[ F2 ] THEN ShowMap( ESC );
  376.     IF Key[ F9 ] THEN ShowVersion;
  377.     IF Key[ D ] THEN Debug;
  378.   UNTIL Key[ ESC ];
  379.   WHILE Key[ ESC ] DO;
  380.   CloseWin
  381. END;
  382. {
  383.  ╔═════════════════════════════════════════════════════════════════════════╗
  384.  ║ PROCEDURE StartInfo                                                     ║
  385.  ╚═════════════════════════════════════════════════════════════════════════╝
  386. }
  387. PROCEDURE StartInfo;
  388. BEGIN
  389.   IF NOT OpenWinCenter( 25, 5, MenuBac, MenuBor, DoubleFr ) THEN Exit;
  390.   WriteWin( 1, 0, MenuSta, 'Labyrinth-3D, (C) By KF' );
  391.   WriteWin( 1, 1, MenuSta, '───────────────────────' );
  392.   WriteWin( 1, 3, MenuTxt, 'F1      - Instructions' );
  393.   WriteWin( 1, 4, MenuTxt, 'SPACE   - Start' );
  394.   WHILE KeyHitC DO;
  395.   REPEAT
  396.     IF Key[ F1 ] THEN Instructions
  397.   UNTIL Key[ SPACE ];
  398.   WHILE Key[ SPACE ] DO;
  399.   CloseWin
  400. END;
  401.  
  402. END.
  403.