home *** CD-ROM | disk | FTP | other *** search
/ Media Share 9 / MEDIASHARE_09.ISO / pascal / rmdoor30.zip / TESTDOOR.PAS < prev   
Pascal/Delphi Source File  |  1992-08-18  |  3KB  |  104 lines
  1. { TestDoor - Copyright (c) 1991 by Randy Hunt and Mark Goodwin }
  2. {            A sample door showing some routines from RMDoor   }
  3.  
  4. {$M $4000,0,0}                     (* Necessary for Drop to DOS *)
  5. uses rmdoor;                       (* Use the RMDOOR.TPU file! *)
  6.  
  7. var
  8.   wannaquit:boolean;      (* Checks if users wants to quit the door *)
  9.  
  10. (***************************************)
  11. (*   This door will allow the user to  *)
  12. (*   try to guess the number that the  *)
  13. (*   computer is "thinking" of.        *)
  14. (***************************************)
  15.  
  16. procedure displaywelcome;
  17. begin
  18.   rmsetcolor(15,0);     (* Set color to white on blue *)
  19.   rmclrscr;             (* Clear screen *)
  20.   rmwriteln('TestDoor 1.0');
  21.   rmsetcolor(14,0);     (* Set color to yellow on black *)
  22.   rmwriteln('Copyright (c) 1991 by Randy Hunt and Mark Goodwin');
  23.   rmwriteln('');        (* Enter a blank line *)
  24. end;
  25.  
  26.  
  27. procedure playgame;
  28. var
  29.   computernum:integer;               (* Number the computer chooses *)
  30.   usernum:integer;                    (* Number the user chooses *)
  31.   win:boolean;
  32.   numguesses:integer;
  33.   input:char;
  34. begin
  35.   rmsetcolor(3,0);    (* Set color to cyan on black *)
  36.   computernum:=random(1000);  (* Get a random number 1-1000 *)
  37.   win:=false;
  38.   numguesses:=0;
  39.   rmsetcolor(13,0);
  40.   rmwriteln('The computer is thinking of a number from 1-1000!');
  41.   repeat
  42.     inc(numguesses);
  43.     rmsetcolor(10,0);
  44.     rmwrite('Enter a number from 1-1000 (0 to quit): ');
  45.     rmsetcolor(12,0);
  46.     usernum:=rmreadi;
  47.     if ((usernum<1) or (usernum>1000)) and (usernum<>0) then
  48.       begin
  49.         rmsetcolor(14,0);
  50.         rmwriteln('Number must be between 1 and 1000!!');
  51.       end
  52.     else
  53.      if usernum<>0 then
  54.       begin
  55.         if computernum=usernum then
  56.           win:=true
  57.         else
  58.           begin
  59.             rmsetcolor(14,0);
  60.             if usernum>computernum then
  61.               rmwriteln('   Too high!');
  62.             if usernum<computernum then
  63.               rmwriteln('   Too low!');
  64.           end;
  65.       end;
  66.   until win or (usernum=0);
  67.   if win then
  68.     begin
  69.       rmsetcolor(14,0);
  70.       rmwrite('You got it in ');
  71.       rmwritei(numguesses);
  72.       rmwriteln(' guesses');
  73.     end;
  74.   rmsetcolor(14,0);
  75.   rmwrite('Play again (y/n)? ');
  76.   repeat
  77.     input:=rmreadkey;
  78.   until (input='Y') or (input='y') or (input='N') or (input='n');
  79.   if (input='N') or (input='n') then
  80.    begin
  81.     wannaquit:=true;
  82.     rmsetcolor(3,0);
  83.     rmwriteln('No');
  84.    end
  85.   else
  86.     begin
  87.       rmsetcolor(3,0);
  88.       rmwriteln('Yes');
  89.       rmwriteln('');
  90.       rmwriteln('');
  91.     end;
  92. end;
  93.  
  94.  
  95. begin
  96.   doorname:='TestDoor 1.0';   (* Tell RMDoor what your program name is *)
  97.   randomize;            (* Initialize random generator (Turbo Pascal) *)
  98.   displaywelcome;
  99.   wannaquit:=false;
  100.   repeat
  101.     playgame;
  102.   until wannaquit;
  103. end.
  104.