home *** CD-ROM | disk | FTP | other *** search
/ SPACE 1 / SPACE - Library 1 - Volume 1.iso / misc~1 / 195 / jeopardy / jeopardy.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1988-03-16  |  11.5 KB  |  474 lines
  1. PROGRAM Jeopardy;
  2.  
  3. {This program has been post-documented to the best of my abilities...
  4.  considering I started three other projects after this, I'm not sure
  5.  of everything; You programmers out there will probably understand
  6.  most of it anyhow! - June 15, 1987 by Vinny Salzillo}
  7.  
  8. LABEL 100;
  9.  
  10. CONST
  11.   {$I GEMCONST.PAS}
  12.  
  13. TYPE
  14.   {$I GEMTYPE.PAS}
  15.   Boardtype = ARRAY [1..6,1..6] OF Boolean; {Answer revealed yet?}
  16.   Anstype = ARRAY [1..6,1..6] OF String[224]; {Answer strings,formatted}
  17.   Ansfile = FILE OF String[224];              {by the Answer program}
  18.  
  19. VAR
  20.   Main_Screen:Window_Title;
  21.   xpos,ypos,x1,y1,game,Choice,Main:Integer;
  22.   Board:Boardtype;
  23.   first,good,xit,sd,fj:Boolean;
  24.   Answers:Anstype;
  25.   Ansvar:Ansfile;
  26.   def_path,filename:Path_Name;
  27.  
  28. {$I GEMSUBS.PAS}
  29.  
  30. PROCEDURE Text_Height (height:integer); {Obvious}
  31.  
  32.   TYPE
  33.     Ctrl_Parms = ARRAY [0..11] OF integer;
  34.     Int_In_Parms = ARRAY [0..15] OF integer;
  35.     Int_Out_Parms = ARRAY [0..45] OF integer;
  36.     Pts_In_Parms = ARRAY [0..11] OF integer;
  37.     Pts_Out_Parms = ARRAY [0..11] OF integer;
  38.  
  39.   VAR
  40.     control:Ctrl_Parms;
  41.     int_in:Int_In_Parms;
  42.     int_out:Int_Out_Parms;
  43.     pts_in:Pts_In_Parms;
  44.     pts_out:Pts_Out_Parms;
  45.  
  46.   PROCEDURE VDI_Call(cmd,sub_cmd,nints,npts:Integer;
  47.     VAR ctrl:Ctrl_Parms;
  48.     VAR int_in:Int_In_Parms;VAR int_out:Int_Out_Parms;
  49.     VAR pts_in:Pts_In_Parms;VAR pts_out:Pts_Out_Parms;
  50.     translate:Boolean);
  51.   EXTERNAL;
  52.  
  53.   BEGIN
  54.     pts_in[0]:=0;
  55.     pts_in[1]:=height;
  56.     VDI_Call(12,0,0,2,control,int_in,int_out,pts_in,pts_out,false);
  57.   END;
  58.  
  59. PROCEDURE Init_Board;
  60.  
  61.   VAR
  62.     x,y:Integer;
  63.  
  64.   BEGIN
  65.     FOR x:=1 TO 6 DO
  66.       BEGIN
  67.         Board[x,1]:=False;
  68.         FOR y:=2 TO 6 DO
  69.           Board[x,y]:=True; {The answer squares are formatted to true,}
  70.       END;                  {which means UNUSED}
  71.   END;
  72.  
  73. PROCEDURE Set_Screen;
  74.  
  75.   BEGIN
  76.     IF Init_Gem>=0 THEN
  77.       BEGIN
  78.         xit:=False;
  79.         Main:=New_Window(0,Main_Screen,0,0,0,0); {Only window needed, full scr}
  80.         Open_Window(Main,0,0,0,0)
  81.       END;
  82.   END;
  83.  
  84. PROCEDURE Draw_Board;
  85.  
  86.   VAR
  87.     a,b,x,y:Integer;
  88.  
  89.   BEGIN
  90.     Hide_Mouse;
  91.     Clear_Screen;
  92.     Draw_Mode(1);                     {Also obvious}
  93.     Line(0,0,0,397);
  94.     Line(2,0,2,397);
  95.     Line(638,0,638,397);
  96.     Line(2,397,638,397);
  97.     Line(0,399,639,399);
  98.     Line(2,79,638,79);
  99.     Line(2,80,638,80);
  100.     Line(2,81,638,81);
  101.     Line(2,82,638,82);
  102.     Line(2,144,638,144);
  103.     Line(2,146,638,146);
  104.     Line(2,207,638,207);
  105.     Line(2,209,638,209);
  106.     Line(2,270,638,270);
  107.     Line(2,272,638,272);
  108.     Line(2,333,638,333);
  109.     Line(2,335,638,335);
  110.     Line(107,0,107,397);
  111.     Line(109,0,109,397);
  112.     Line(213,0,213,397);
  113.     Line(215,0,215,397);
  114.     Line(319,0,319,397);
  115.     Line(321,0,321,397);
  116.     Line(425,0,425,397);
  117.     Line(427,0,427,397);
  118.     Line(531,0,531,397);
  119.     Line(533,0,533,397);
  120.     Draw_Mode(3);
  121.     FOR a:=0 TO 4 DO
  122.       BEGIN                                     {Rounding corners}
  123.         FOR b:=0 TO 3 DO
  124.           BEGIN
  125.             x:=((a+1)*108)-(2*a);
  126.             y:=(145+63*b);
  127.             PLOT(x-1,y);
  128.             PLOT(x+1,y);
  129.             PLOT(x,y-1);
  130.             PLOT(x,y+1)
  131.           END;
  132.       END;
  133.     Draw_Mode(1);
  134.     Show_Mouse;
  135.   END;
  136.  
  137. PROCEDURE Draw_Money (sd:Boolean);
  138.  
  139.   VAR
  140.     mon,x,y:Integer;
  141.  
  142.   PROCEDURE Do_Money(i,j:Integer;sd:Boolean);
  143.  
  144.     VAR
  145.       ds,Indent:Integer;         {Put the dollar amounts on the board,}
  146.       money:String[7];           {provided that the particular square}
  147.       a:String[2];               {reads false (unused)}
  148.  
  149.     BEGIN
  150.       IF sd THEN
  151.         ds:=2
  152.       ELSE
  153.         ds:=1;
  154.       mon:=j*ds;
  155.       IF mon=10 THEN
  156.         BEGIN
  157.           money:='$1000';      {I couldn't figure out any other way to do}
  158.           Indent:=17           {the $1000, any suggestions?}
  159.         END;
  160.       IF mon<10 THEN
  161.         BEGIN
  162.           mon:=mon+48;
  163.           money:=Concat('$',chr(mon),'00');
  164.           Indent:=25
  165.         END;
  166.       Draw_String((Indent+((i-1)*106)),(123+((j-1)*63)),money)
  167.     END;
  168.  
  169.   BEGIN
  170.     Text_Height(24);
  171.     Text_Style(Normal);
  172.     Hide_Mouse;
  173.     FOR x:=1 TO 6 DO
  174.       BEGIN
  175.         FOR y:=2 TO 6 DO
  176.           BEGIN
  177.             IF Board[x,y] THEN
  178.               Do_Money(x,y-1,sd)
  179.           END;
  180.       END;
  181.     Show_Mouse
  182.   END;
  183.  
  184. PROCEDURE Draw_Titles;
  185.  
  186.   VAR
  187.     x,y:Integer;
  188.     a:Boolean;
  189.     part:String[20];
  190.  
  191.   BEGIN
  192.     Text_Height(7);
  193.     Text_Style(Normal);
  194.     Hide_Mouse;
  195.     FOR x:=1 TO 6 DO
  196.       BEGIN                              {Put the titles at the top of the}
  197.         a:=False;                        {board, provided the category still}
  198.         FOR y:=2 TO 6 DO                 {has answers left}
  199.           IF Board[x,y] THEN
  200.             a:=True;
  201.         IF a THEN
  202.           BEGIN
  203.             part:=Copy(Answers[x,1],1,11);
  204.             Draw_String(4+(106*(x-1)),20,part);
  205.             part:=Copy(Answers[x,1],12,11);       {String manipulation which}
  206.             Draw_String(4+(106*(x-1)),38,part);   {will make lots more sense}
  207.             part:=Copy(Answers[x,1],23,11);       {when I release the}
  208.             Draw_String(4+(106*(x-1)),56,part);   {answer generator}
  209.             part:=Copy(Answers[x,1],34,11);
  210.             Draw_String(4+(106*(x-1)),74,part)
  211.           END;
  212.       END;
  213.     Show_Mouse;
  214.   END;
  215.  
  216. PROCEDURE Event_Loop;
  217.  
  218.   VAR
  219.     event,dummy:Integer;
  220.     msg:Message_Buffer;
  221.  
  222.   BEGIN
  223.     event:=0;
  224.     WHILE event<>E_Button DO
  225.       event:=Get_Event(E_Button,
  226.                        1,1,1,0,
  227.                        False,0,0,0,0,False,0,0,0,0,
  228.                        msg,dummy,
  229.                        dummy,dummy,
  230.                        xpos,ypos,
  231.                        dummy);
  232.     event:=0;                          {Wait for a left click only}
  233.     WHILE event<>E_Button DO
  234.       event:=Get_Event(E_Button,
  235.                        1,0,1,0,
  236.                        False,0,0,0,0,False,0,0,0,0,
  237.                        msg,dummy,
  238.                        dummy,dummy,
  239.                        dummy,dummy,
  240.                        dummy)
  241.   END;
  242.  
  243. PROCEDURE Interpret;
  244.  
  245.   VAR
  246.     b1:Integer;
  247.  
  248.  
  249.   PROCEDURE do_goodx(b1:Integer);
  250.  
  251.     BEGIN
  252.       good:=true;
  253.       x1:=b1
  254.     END;
  255.  
  256.   PROCEDURE do_goody(b1:Integer);
  257.  
  258.     BEGIN
  259.       good:=true;
  260.       y1:=b1
  261.     END;
  262.  
  263.   BEGIN
  264.     x1:=1;
  265.     y1:=1;
  266.     IF (xpos>2) AND (xpos<107) THEN
  267.       do_goodx(1);
  268.     IF (xpos>109) AND (xpos<213) THEN
  269.       do_goodx(2);                          {This routine finds the square}
  270.     IF (xpos>215) AND (xpos<319) THEN       {that the user clicked on...}
  271.       do_goodx(3);
  272.     IF (xpos>321) AND (xpos<425) THEN
  273.       do_goodx(4);
  274.     IF (xpos>427) AND (xpos<531) THEN
  275.       do_goodx(5);
  276.     IF (xpos>533) AND (xpos<638) THEN
  277.       do_goodx(6);
  278.     IF (ypos>82) AND (ypos<144) THEN           {The routine which follows}
  279.       do_goody(2);                             {one will determine whether}
  280.     IF (ypos>146) AND (ypos<207) THEN          {it was a legitimate choice!}
  281.       do_goody(3);
  282.     IF (ypos>209) AND (ypos<270) THEN
  283.       do_goody(4);
  284.     IF (ypos>272) AND (ypos<333) THEN
  285.       do_goody(5);
  286.     IF (ypos>335) AND (ypos<397) THEN
  287.       do_goody(6);
  288.     IF Board[x1,y1]=False THEN
  289.       good:=False
  290.   END;
  291.  
  292. PROCEDURE Daily_Double;
  293.  
  294.   BEGIN
  295.     Hide_Mouse;
  296.     Clear_Screen;
  297.     Draw_Mode(1);
  298.     Text_Style(Thickened|Shadowed);
  299.     Text_Height(50);
  300.     Paint_Style(17);
  301.     Paint_Oval(320,200,250,150);            {Simple enough}
  302.     Paint_Style(1);
  303.     Draw_Mode(2);
  304.     Draw_String(279,180,'DAILY');
  305.     Draw_String(271,250,'DOUBLE');
  306.     Delete(Answers[x1,y1],1,1);       {<-- This routine eliminates the}
  307.     Insert(' ',Answers[x1,y1],1);          {backslash, which is the signal}
  308.     Draw_Mode(1);                          {for a Daily Double}
  309.     Text_Style(Normal);
  310.     Show_Mouse;
  311.     Event_Loop
  312.   END;
  313.  
  314. PROCEDURE Show_Answer;
  315.  
  316.   VAR
  317.     a1:Integer;
  318.     part:String[30];
  319.     dd_test:String[5];
  320.  
  321.   BEGIN
  322.     dd_test:=Copy(Answers[x1,y1],1,1);
  323.     IF dd_test='\' THEN Daily_Double;       {See above}
  324.     Hide_Mouse;
  325.     Clear_Screen;
  326.     Draw_Mode(1);
  327.     Text_Height(50);
  328.     FOR a1:=1 TO 8 DO
  329.       BEGIN
  330.         part:=Copy(Answers[x1,y1],1+((a1-1)*28),28);    {Text is already}
  331.         Draw_String(97,(33+(a1*40)),part)               {formatted by the}
  332.       END;                                              {answer generator}
  333.     Board[x1,y1]:=False;                   {so all that's left is to show}
  334.     Show_Mouse;                            {all eight lines and set the}
  335.     Event_Loop                             {square to USED}
  336.   END;
  337.  
  338. PROCEDURE Load_file;
  339.  
  340.   VAR
  341.     fil:Boolean;
  342.     x,y:Integer;
  343.  
  344.   BEGIN
  345.     def_path:='a:\*.JPD';
  346.     fil:=Get_In_File(def_path,filename);
  347.     If NOT fil THEN
  348.       GOTO 100;
  349.     Reset (ansvar,filename);
  350.     FOR x:=1 TO 6 DO
  351.       FOR y:=1 TO 6 DO
  352.         BEGIN
  353.           Get(ansvar);
  354.           Answers[x,y]:=ansvar^
  355.         END;
  356.     Close(ansvar);
  357.     Hide_Mouse;
  358.     Clear_Screen;
  359.     Show_Mouse
  360.   END;
  361.  
  362. PROCEDURE Normal_Jeopardy;
  363.  
  364.   VAR
  365.     count:Integer;
  366.  
  367.   BEGIN
  368.     count:=1;
  369.     first:=True;
  370.     WHILE count<31 DO
  371.       BEGIN
  372.         Draw_Board;
  373.         Draw_Money(sd);
  374.         If first THEN Event_Loop;
  375.         first:=False;
  376.         Draw_Titles;
  377.         good:=False;
  378.         WHILE NOT good DO
  379.           BEGIN
  380.             Event_Loop;
  381.             Interpret
  382.           END;
  383.         Show_Answer;
  384.         count:=count+1
  385.       END;
  386.   END;
  387.  
  388. PROCEDURE Final_Jeopardy;
  389.  
  390.   VAR
  391.     part:String[20];
  392.  
  393.   BEGIN
  394.     Hide_Mouse;
  395.     Clear_Screen;
  396.     Text_Style(Thickened|Shadowed);
  397.     Text_Height(50);
  398.     Paint_Style(14);
  399.     Paint_Oval(320,200,250,150);
  400.     Paint_Style(1);
  401.     Draw_Mode(2);
  402.     Draw_String(279,180,'FINAL');
  403.     Draw_String(253,250,'JEOPARDY');
  404.     Show_Mouse;
  405.     Event_Loop;
  406.     Hide_Mouse;
  407.     Draw_Mode(1);
  408.     Text_Style(Normal);
  409.     Text_Height(16);
  410.     part:=Copy(Answers[1,1],1,11);
  411.     Draw_String(10,25,part);
  412.     part:=Copy(Answers[1,1],12,11);
  413.     Draw_String(10,50,part);
  414.     part:=Copy(Answers[1,1],23,11);
  415.     Draw_String(10,75,part);
  416.     part:=Copy(Answers[1,1],34,11);
  417.     Draw_String(10,100,part);
  418.     x1:=1;
  419.     y1:=2;
  420.     Show_Mouse;
  421.     Event_Loop;
  422.     Show_Answer
  423.   END;
  424.  
  425. PROCEDURE Start_Game;
  426.  
  427.   VAR
  428.     title:String[255];
  429.  
  430.   BEGIN
  431.     Load_File;
  432.     title:=Concat('[2][    JEOPARDY!    |',
  433.                       '  Revision  1.0  |',
  434.                       '(C) 1987 VDS Inc.|',
  435.                       '                 |',
  436.                       'Type of game?    ]',
  437.                       '[Single|Double|Final]');
  438.     game:=Do_Alert(title,0);
  439.     fj:=False;
  440.     CASE game OF
  441.       1:sd:=False;
  442.       2:sd:=True;
  443.       3:fj:=True
  444.     END;
  445.     Set_Mouse(M_Point_Hand);
  446.     IF fj THEN
  447.       Final_Jeopardy
  448.     ELSE
  449.       Normal_Jeopardy;
  450.     Set_Mouse(M_Arrow)
  451.   END;
  452.  
  453. BEGIN
  454.   Set_Screen;
  455.   LOOP
  456.     Init_Board;
  457.     Start_Game;
  458.     Choice:=Do_Alert('[2][     What Next?     ][Restart|Exit]',1);
  459.     IF Choice=2 THEN
  460.       xit:=True;
  461.   EXIT IF xit
  462.   END;
  463.   Exit_Gem;
  464. 100: END.
  465.  
  466. {The rest of this file is really self-explanatory...but if you have
  467.  questions, I'll do my best to help you. All I ask is that if you come
  468.  up with an improvement, let me know, and I will give you credit for it!
  469.  Contact: Vinny Salzillo (V.Salzillo on GEnie) 212-881-4575
  470.  2535 Matthews Ave. Bronx, NY 10467...Have fun with this program, and
  471.  let me know what you think!}
  472.  
  473.  
  474.