home *** CD-ROM | disk | FTP | other *** search
/ Source Code 1994 March / Source_Code_CD-ROM_Walnut_Creek_March_1994.iso / compsrcs / games / vmsnet / plenty / part01 < prev    next >
Internet Message Format  |  1992-08-02  |  6KB
  1. Path: uunet!stanford.edu!rutgers!jvnc.net!yale.edu!think.com!sdd.hp.com!swrinde!elroy.jpl.nasa.gov!nntp-server.caltech.edu!erin.caltech.edu!shoppa
  2. From: shoppa@erin.caltech.edu (TIM SHOPPA)
  3. Newsgroups: vmsnet.sources.games
  4. Subject: Plenty Questions (1/1) Game!
  5. Keywords: game vms plenty questions
  6. Message-ID: <4JUN199210143337@erin.caltech.edu>
  7. Date: 4 Jun 92 18:14:00 GMT
  8. Sender: news@cco.caltech.edu
  9. Organization: California Institute of Technology
  10. Lines: 193
  11. News-Software: VAX/VMS VNEWS 1.41
  12. Nntp-Posting-Host: erin.caltech.edu
  13.  
  14. Hello!
  15.     This is a short little game that I wrote several years ago, patterned
  16. upon an ancient game in Beagle Bros' Magic Pack on their Game Disk.  It is
  17. a version of "20 questions", where the computer asks the questions, and
  18. then gives an answer.  It's written in uncommented Fortran, and uses the
  19. Vax SMG package to do some of the screen and keyboard manipulation.  It needs
  20. a VT-100 compatible terminal to work at present, but with proper use of SMG
  21. it could probably be modified to work with any SMG-supported terminal.
  22.     Of course, looking at the possible answers in the list below, something
  23. suspicious must be going on if this program is to do anything interesting.
  24. Note that if you type Control-A at the prompt "Press any key to continue..."
  25. then the logical flag CHEAT is set to .TRUE.  When this flag is set, the
  26. first key typed in response to the questions the comptuer asks is not displayed,
  27. but is instead stored.  When the computer gets to the twentieth question
  28. (or a period is typed as the "unprinted response"), it will then make its
  29. guess, displaying the stored keystrokes instead of an answer from the list
  30. below.  (The list below is used to display a dummy answer if control-A
  31. wasn't typed.)
  32.     Not much of a game, but good for amazing your friends a few times.
  33. (As long as you are sitting at the keyboard, that is.)
  34. To comple use:$FORT PLENTY
  35.           $LINK PLENTY
  36. Then run with:$RUN PLENTY
  37.  
  38.                         Tim
  39.                         (Shoppa@erin.caltech.edu)
  40.  
  41.  
  42.  
  43.     program plenty
  44. c Plenty Questions, patterned after Beagle Bros' Magic Pack.
  45. c Feel free to modify and improve this game as you wish, and maybe
  46. c even send me your improved versions!  Certainly the question list can
  47. c be improved (the "no" to "yes" ratio of answers is way to high).
  48. c Also, the control sequences are currently VT-100 dependent, a better
  49. c written program would use SMG to do all the screen manipulation.
  50. c Note: if the game doesn't seem to be working, look closely at the use
  51. c of the logical variable CHEAT.
  52. c Original concept: Beagle Bros., early 80's, on Apple II Game Disk.
  53. c This version: Tim Shoppa (shoppa@erin.caltech.edu), 1987 or so.
  54.     logical cheat
  55.     parameter nq=32
  56.     character*40 question(nq)
  57.     logical used(100)
  58.     logical done
  59.     character*20 answer
  60.     parameter na=20
  61.     character*20 ansf(na)
  62.     character*1 let
  63.     parameter esc=27
  64.     data question/
  65.      !      'Is it bigger than a breadbox?',
  66.      !      'Does it have legs?',
  67.      !        'Is it orange?',
  68.      !        'Can it fly?',
  69.      !        'Can you eat it?',
  70.      !        'Can you hold it?',
  71.      !        'Does it go ''moo''?',
  72.      !        'Is it older than you?',
  73.      !        'Does it cost more that $500?',
  74.      !        'Does it weigh more than an elephant?',
  75.      !        'Is it part of a bigger thing?',
  76.      !        'Can it bark?',
  77.      !        'Does it need water?',
  78.      !        'Is it brown?',
  79.      !        'Is it shiny?',
  80.      !         'Can it be bent easily?',
  81.      !        'Can you buy it in a supermarket?',
  82.      !        'Is it transparent?',
  83.      !        'Is it round?',
  84.      !        'Can it bounce?',
  85.      !        'Does it melt?',
  86.      !        'Do you find it outside?',
  87.      !        'Is it skinny?',
  88.      !        'Is it underground?',
  89.      !        'Can you wear it?',
  90.      !        'Does it have holes?',
  91.      !        'Is there one in this room?',
  92.      !        'Does it make any noise?',
  93.      !        'Is it electric?',
  94.      !        'Is it flat?',
  95.      !        'Is it a liquid?',
  96.      !        'Does it have eyes?'/
  97.     data ansf/
  98.      !        'coffee cup',
  99.      !        'volkswagon',
  100.      !        'volleyball',
  101.      !        'snow shovel',
  102.      !        'jumbo jet',
  103.      !        'chair',
  104.      !        'elephant',
  105.      !        'radio',
  106.      !        'desk',
  107.      !        'orange',
  108.      !        'toothbrush',
  109.      !        'pogo stick',
  110.      !        'screwdriver',
  111.      !        'elevator',
  112.      !        'party',
  113.      !        'president',
  114.      !        'eraser',
  115.      !        'bumper sticker',
  116.      !        'bottle',
  117.      !        'driveway'/
  118.     OPEN(UNIT=10,NAME='TT:',STATUS='UNKNOWN',CARRIAGECONTROL='NONE')
  119.     cheat=.false.
  120.     CALL SMG$CREATE_VIRTUAL_KEYBOARD(ID)
  121.     call home
  122.     type *,'Welcome to the game of plenty questions.'
  123.     type *,'You think of an object, and I''ll ask the questions.'
  124.     type *,'(Follow the instructions in the manual exactly, or else the'
  125.     type *,' program will not work correctly, even though it may appear'
  126.     type *,' to be working.)'
  127.     type *,'Press any key to continue ...'
  128. 10    CALL SMG$READ_KEYSTROKE(ID,N)
  129.     if (n.eq.1) cheat=.true.
  130.     answer='.'
  131.     done=.false.
  132.     do 20 i=1,100
  133. 20    used(i)=.false.
  134.     call home
  135.     write(10,98)
  136. 98    format('*****************  Plenty Questions *******************')
  137.     type *
  138.     do 200 i=1,20
  139. 99    n=nq*ran(nseed)+1
  140. 96    if (used(n)) then
  141.       n=n+1
  142.       if (n.le.nq) go to 96
  143.       n=1
  144.       go to 96
  145.     end if
  146.     used(n)=.true.
  147.     write (10,101) i,question(n)
  148. 101    format(i2,'. ',a40,$)
  149. 102    if (cheat) then
  150.       if (.not.done) then
  151.         call smg$read_keystroke(id,n)
  152.         write (let,138) n
  153. 138        format(a1,$)
  154.         if (let.eq.'.') then
  155.           done=.true.
  156.         else
  157.           answer(i:i)=let
  158.         end if
  159.       end if
  160.     end if
  161.     j=1
  162.     iseed=0
  163. 140    call smg$read_keystroke(id,n)
  164.     if (n.eq.13) then
  165.       if (j.gt.1) then
  166.         nseed=nseed+iseed*41
  167.         go to 200
  168.       else
  169.         go to 140
  170.       end if
  171.     end if
  172.     if (n.eq.127) then
  173.       if (j.eq.1) then
  174.         if (cheat) go to 102
  175.       else
  176.         write(10,142) esc,esc
  177. 142        format(a1,'[D ',a1,'[D')
  178.         j=j-1
  179.       end if
  180.     else
  181.       write(10,110) n
  182. 110      format(a1,$)
  183.       if (j.eq.1) iseed=n
  184.       j=j+1
  185.     end if
  186.     go to 140
  187. 200    type *
  188. 300    write (10,301),7
  189. 301    format(a1,'I''ve got it! Its a ')
  190.     do 310 i=1,100
  191.     n=na*ran(nseed)+1
  192.     write (10,302) ansf(n),esc
  193. 302    format(a20,a1,'[20D')
  194. 310    call lib$wait(0.1)    
  195.     if (cheat) then
  196.       write (10,201)answer
  197. 201      format(a20)
  198.     end if
  199.     END
  200.  
  201.     subroutine home
  202.     parameter esc=27
  203.     write(10,1) esc,esc
  204. 1    format(a1,'[2J',a1,'[1;1H',$)
  205.     return
  206.     end
  207.