home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / simtel / cpmug / cpmug003.ark / BAGELS2.BAS < prev    next >
Encoding:
BASIC Source File  |  1984-04-29  |  5.9 KB  |  199 lines
  1.     REM------------------------------------------------------
  2.     REM        B  A  G  E  L  S
  3.     REM------------------------------------------------------
  4.  
  5.     REM            JUNE 11, 1977
  6.  
  7.     DIM TARGET$(4)
  8.     DIM GUESS$(4)
  9.     NO.OF.GAMES=0
  10.     NO.OF.GUESSES=0
  11.     PRINT:PRINT:PRINT:PRINT
  12.     PRINT TAB(10);"HELLO, WE ARE GOING TO PLAY BAGELS!"
  13.     PRINT
  14.     PRINT TAB(10);"WHAT IS YOUR NAME  ";
  15.     INPUT NAME$
  16.     PRINT
  17.     PRINT
  18.     PRINT TAB(10);"THANKS, ";NAME$
  19.     PRINT:PRINT
  20. 10    REM----- ASK FOR INSTRUCTIONS-------------------
  21.     PRINT TAB(10);"WOULD YOU LIKE THE INSTRUCTIONS, ";NAME$;
  22.     PRINT " (Y OR N)  ";
  23.     INPUT ANS$
  24.     IF LEFT$(ANS$,1)="Y" THEN GOSUB 9000:GOTO 15
  25.     IF LEFT$(ANS$,1)<>"N" THEN \
  26.         PRINT TAB(10);"I DON'T UNDERSTAND" :\
  27.         GOTO 10
  28. 15    REM
  29.     PRINT : PRINT
  30.     PRINT TAB(10);"SHALL I ALLOW DUPLICATED DIGITS IN THE NUMBER(Y,N)";
  31.       INPUT ANS$
  32.       IF LEFT$(ANS$,1)="Y" THEN SKIP=0 : GOTO 17
  33.       IF LEFT$(ANS$,1)="N" THEN SKIP=1 : GOTO 17
  34.       PRINT TAB(10);"ANSWER YES OR NO, STUPID!" : GOTO 15
  35. 17    REM
  36.     PRINT:PRINT:PRINT
  37.     PRINT TAB(10);" OK, I HAVE A NUMBER."
  38.     PRINT:PRINT:PRINT
  39.     RANDOMIZE
  40. 20    REM------GET A NUMBER----------------------------
  41.     NUM=INT(RND*10000)
  42.     NUM$=RIGHT$("0000"+STR$(NUM),5)
  43.     NUM$=LEFT$(NUM$,4)
  44.     FOR I=1 TO 4
  45.         TARGET$(I)=MID$(NUM$,I,1)
  46.     NEXT I
  47.  
  48.     IF SKIP=0 THEN GOTO 30
  49.     REM    DONT TAKE THE NUMBER IF THERE ARE DUPLICATIONS
  50.     IF TARGET$(1) = TARGET$(2) OR TARGET$(1) = TARGET$(3) OR \
  51.            TARGET$(1) = TARGET$(4) THEN GOTO 20
  52.         IF TARGET$(2) = TARGET$(3) OR TARGET$(2) = TARGET$(4) \
  53.        THEN GOTO 20
  54.     IF TARGET$(3) = TARGET$(4) THEN GOTO 20
  55.     REM    THE ARRAY 'TARGET$' NOW HOLDS THE NUMBER TO BE
  56.     REM    GUESSED.  THE TARGET IS ALSO IN NUM$.
  57.  
  58. 30    REM-------ENTER A GUESS---------------------------
  59.     PICO=0            REM RESET COUNTERS
  60.     FERMI=0            REM RESET COUNTERS
  61.     PRINT:PRINT
  62.     PRINT TAB(10);"WHAT IS YOUR GUESS  ";
  63.     INPUT IN.GUESS$
  64.     IF LEN(IN.GUESS$)<>4 THEN :\
  65.         GOSUB 1000        REM PRINT WARNING AND ADJUST LEN
  66.     FOR I=1 TO 4
  67.         GUESS$(I)=MID$(IN.GUESS$,I,1)
  68.     NEXT I
  69.  
  70.     REM-----COMPARE GUESS WITH TARGET------------------
  71.     NO.OF.GUESSES=NO.OF.GUESSES+1
  72.     IF IN.GUESS$=NUM$ THEN \
  73.         GOTO 3000        REM GOT IT!
  74.     FOR I=1 TO 4
  75.         FOR J=1 TO 4
  76.             IF GUESS$(I)=TARGET$(J) THEN \
  77.                 GOSUB 2000    REM INCREMENT COUNT
  78.         NEXT J
  79.     NEXT I
  80.     PRINT
  81.     PRINT TAB(10);
  82.     IF PICO=0 AND FERMI=0 THEN \
  83.         PRINT TAB(POS+5);"BAGELS" :\
  84.         GOTO 60
  85.     IF PICO=0 THEN \
  86.         GOTO 50
  87.     FOR I=1 TO PICO
  88.         PRINT TAB(POS+5);"PICO";
  89.     NEXT I
  90. 50    REM-----FERMI LOOP----------------------------------
  91.     IF FERMI=0 THEN \
  92.         GOTO 60
  93.     FOR I=1 TO FERMI
  94.         PRINT TAB(POS+5);"FERMI";
  95.     NEXT I
  96. 60    REM-----AFTER LOOPS---------------------------------
  97.     GOTO 30            REM GET ANOTHER GUESS
  98.  
  99. 2000    REM------INCREMENT COUNT----------------------------
  100.     IF I=J THEN \
  101.         FERMI=FERMI+1 :\
  102.     ELSE \
  103.         PICO=PICO+1
  104.     RETURN
  105.  
  106. 1000    REM------IN.GUESS IS WRONG LENGTH-----------------
  107.     PRINT
  108.     PRINT TAB(10);"YOUR GUESS IS THE WRONG LENGTH!"
  109.     IF LEN(IN.GUESS$)<4 THEN \
  110.         PRINT TAB(10);"IT WILL BE PADDED ON THE LEFT WITH BLANKS" :\
  111.     ELSE \
  112.         PRINT TAB(10);"EXTRA DIGITS ON THE LEFT ARE TRUNCATED"
  113.     IN.GUESS$=RIGHT$("    "+IN.GUESS$,4)
  114.     RETURN
  115.  
  116. 3000    REM------WINNER ROUTINE------------------------------
  117.     NO.OF.GAMES=NO.OF.GAMES+1
  118.     PRINT:PRINT:PRINT
  119.     PRINT TAB(10);"YOU GOT THE NUMBER!!"
  120.     PRINT
  121.     PRINT TAB(10);"IT TOOK YOU ";NO.OF.GUESSES;"TRIES!"
  122.     PRINT
  123.     GOSUB 4000        REM PRINT FANCY RESPONSE
  124.     PRINT:PRINT
  125. 3010    REM-----WANT ANOTHER?----------------------------
  126.     PRINT TAB(10);"WOULD YOU LIKE TO HAVE ANOTHER GAME, ";NAME$;
  127.     PRINT " (Y OR N)  ";
  128.     INPUT ANS$
  129.     IF LEFT$(ANS$,1)="N" THEN \
  130.         GOTO 5000        REM E O J
  131.     IF LEFT$(ANS$,1)<>"Y" THEN \
  132.         PRINT TAB(10);"WHAT DO YOU MEAN BY THAT?!?!" :\
  133.         GOTO 3010
  134.     NO.OF.GUESSES=0
  135.     GOTO 20            REM PICK A NUMBER
  136.  
  137. 5000    REM------E  O  J-------------------------------------
  138.     PRINT:PRINT
  139.     PRINT TAB(15);"THANKS FOR PLAYING WITH ME, ";NAME$
  140.     PRINT
  141.     PRINT TAB(15);"COME BACK AGAIN, SOON!"
  142.     PRINT:PRINT
  143.     STOP
  144.  
  145. 4000    REM-----FANCY RESPONSES-------------------------------
  146.     MSG=INT((NO.OF.GUESSES+1)/2)
  147.     IF MSG>9 THEN MSG=9     REM PREVENT OVERFLOW ON VERY BAD GUESSING
  148.     PRINT TAB(12);
  149.     ON MSG GOSUB 4001,4002,4003,4004,4005,4006,4007,4008,4009
  150.     PRINT
  151.     RETURN
  152. 4001      IF NO.OF.GUESSES =1 THEN \
  153.         PRINT "THE ODDS ARE 10,000 TO 1 AGAINST"; :\
  154.                PRINT " GUESSING THE NUMBER IN ONE TRY." :\
  155.                PRINT TAB(12);"YOU MUST HAVE GOD ON YOUR SIDE." :\
  156.              ELSE PRINT "TWO TRYS!  URI GELLER WOULD BE IMPRESSED!"
  157.       RETURN
  158. 4002      PRINT "THAT'S OUTSTANDING!  YOU MUST BE AN EST GRADUATE!"
  159.       RETURN
  160. 4003      PRINT "THAT'S VERY GOOD!"
  161.       RETURN
  162. 4004      PRINT "GOOD, BUT I'VE SEEN BETTER."
  163.       RETURN
  164. 4005      PRINT "NOT BAD, NOT BAD AT ALL."
  165.       RETURN
  166. 4006      PRINT "I THINK YOU NEED PRACTICE."
  167.       RETURN
  168. 4007      SUBMSG=INT(RND*3)+1
  169.       PRINT "PRETTY GOOD....FOR";
  170.       ON SUBMSG GOSUB 4007.1,4007.2,4007.3
  171.       RETURN
  172. 4007.1        PRINT "A 5 YEAR OLD." : RETURN
  173. 4007.2        PRINT "A TURKEY." : RETURN
  174. 4007.3        PRINT "AN IDIOT." : RETURN
  175. 4008      SUBMSG=INT(RND*3)+1
  176.       ON SUBMSG GOSUB 4008.1,4008.2,4008.3
  177.       RETURN
  178. 4008.1        PRINT "MAYBE YOU SHOULD NOT CHEW GUM WHILE PLAYING BAGELS."
  179.           RETURN
  180. 4008.2        PRINT "ARE YOU SURE YOU NEVER PLAYED FOOTBALL WITHOUT A HELMET?"
  181.           RETURN
  182. 4008.3        PRINT "EVEN LENNY DID BETTER THAN THAT!"
  183.           RETURN
  184. 4009      PRINT "EVERYONE HAS BAD DAYS BUT THIS IS RIDICULOUS!!!"
  185.       RETURN
  186.  
  187. 9000    REM-------INSTRUCTIONS-------------------------------
  188.     PRINT:PRINT
  189.     PRINT "I AM THINKING OF A FOUR DIGIT NUMBER.  TRY TO GUESS THE"
  190.     PRINT " NUMBER.  AFTER EACH GUESS I WILL PRINT:"
  191.     PRINT "   'FERMI' FOR EACH CORRECT DIGIT IN THE CORRECT PLACE,"
  192.     PRINT "   'PICO'  FOR EACH CORRECT DIGIT IN THE WRONG PLACE, OR"
  193.     PRINT "   'BAGELS' IF NO DIGIT IS CORRECT."
  194.     PRINT " AT THE START OF THE GAME I WILL LET YOU SPECIFY WHETHER"
  195.     PRINT " YOU WANT DUPLICATED DIGITS TO BE ALLOWED IN THE NUMBER."
  196.     PRINT " FOR EXAMPLE IF NO DUPLICATED DIGITS ARE ALLOWED A NUMBER"
  197.     PRINT " SUCH AS 1145 WOULD NOT OCCUR."
  198.     RETURN
  199.