home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / mbug / mbug055.arc / ANIMAL.BAS < prev    next >
BASIC Source File  |  1979-12-31  |  4KB  |  103 lines
  1. 10 REM    *** ANIMAL ***
  2. 20 PRINT CHR$(12):PRINT
  3. 30 PRINT TAB(20)"-- ANIMAL --":PRINT:PRINT
  4. 40 PRINT "YOU THINK OF AN ANIMAL AND THE";
  5. 50 PRINT " COMPUTER WILL TRY TO GUESS IT."
  6. 60 PRINT:PRINT
  7. 70 PRINT TAB(10)"Type 'L' to see what animals I know":PRINT
  8. 80 PRINT TAB(10)"Type 'E' to end the animal game":PRINT
  9. 90 PRINT TAB(10)"Type 'Y' to play the animal game":PRINT:PRINT
  10. 100 PRINT TAB(10)"********************************"
  11. 110 PRINT TAB(10)"*                              *"
  12. 120 PRINT TAB(10)"*  PLEASE USE ONLY UPPER CASE  *"
  13. 130 PRINT TAB(10)"*                              *"
  14. 140 PRINT TAB(10)"********************************"
  15. 150 PRINT:PRINT
  16. 160 OPEN "R",1,"B:ANIMAL.DAT"
  17. 170 FIELD #1,124 AS DQ$,2 AS DY$,2 AS DN$
  18. 180 N=LOF(1)
  19. 190 PRINT:PRINT:PRINT:PRINT
  20. 200 PRINT:PRINT CHR$(7)
  21. 210 PRINT TAB(6)"Are you thinking of an animal .. (L,E or Y) ";
  22. 220 A$=INPUT$(1)
  23. 230 IF A$="L" THEN 830
  24. 240 IF A$="E" THEN CLOSE:PRINT CHR$(12):END
  25. 250 IF A$="Y" THEN 290
  26. 260 PRINT CHR$(12)
  27. 270 PRINT TAB(8)"** ERROR ** Type L,E or Y in UPPER CASE only"
  28. 280 GOTO 200
  29. 290 PRINT CHR$(12):PRINT"  Question"TAB(29)"Answer":K=1
  30. 300 GET #1,K
  31. 310 GOSUB 670 : REM ASK QUESTION
  32. 320 IF CVI(DY$) <> 0 THEN 300 : REM ASK ANOTHER QUESTION
  33. 330 GOSUB 770 : REM STRIP OFF SPACES FROM FIELDED STRING
  34. 340 PRINT CHR$(12):PRINT:PRINT:PRINT
  35. 350 PRINT CHR$(7):PRINT TAB(12) "Is it a   >>>  ";LEFT$(DQ$,C);
  36. 355 PRINT" ? ";
  37. 360 A$=INPUT$(1)
  38. 370 IF A$="N" THEN PRINT"  No":GOTO 970
  39. 380 IF A$="Y" THEN PRINT"  Yes":GOTO 980
  40. 390 PRINT:PRINT"** ERROR ** Type 'Y' or 'N' only":PRINT:GOTO 350
  41. 400 PRINT CHR$(12):FOR B=1 TO 4:PRINT "# I GIVE UP #  ";
  42. 410 PRINT CHR$(7);:FOR Z=1 TO 300:NEXT Z:NEXT B
  43. 420 PRINT:PRINT:INPUT "Tell me the animal >>> ";AN$
  44. 430 PRINT
  45. 440 PRINT "Please type in a question that would distinguish a"
  46. 450 PRINT:PRINT TAB(8) AN$;" from a ";
  47. 460 GOSUB 770
  48. 470 PRINT LEFT$(DQ$,C);
  49. 480 INPUT QU$
  50. 490 PRINT:PRINT "For a ";AN$;" the answer would be >> ";
  51. 500 A$=INPUT$(1)
  52. 510 IF A$="Y" THEN PRINT"  Yes":GOTO 540
  53. 520 IF A$="N" THEN PRINT"  No":GOTO 540
  54. 530 IF A$<>"Y" AND A$<>"N" THEN PRINT" ** ERROR **":GOTO 490
  55. 540 FOR D=1 TO 200:NEXT D
  56. 550 GOSUB 770
  57. 560 D$ = LEFT$(DQ$,C) : REM SAVE ANIMAL NAME
  58. 570 LSET DQ$ = QU$ : REM MOVE QUESTION INTO RECORD
  59. 580 X1 = N + 2: X2 = N + 1: IF A$ = "N" THEN SWAP X1,X2
  60. 590 LSET DY$ = MKI$(X1):LSET DN$ = MKI$(X2)
  61. 600 PUT #1,K : REM WRITE QUESTION RECORD
  62. 610 LSET DQ$ = D$:LSET DY$ = MKI$(0): LSET DN$ = MKI$(0)
  63. 620 PUT #1,N+1 : REM WRITE FIRST ANIMAL RECORD
  64. 630 LSET DQ$ = AN$
  65. 640 PUT #1,N+2 : REM WRITE SECOND ANIMAL RECORD
  66. 650 N = N + 2
  67. 660 PRINT CHR$(12):GOTO 200
  68. 670 REM   SUBROUTINE TO PRINT QUESTIONS
  69. 680 GOSUB 770 : REM STRIP SPACES
  70. 690 PRINT:PRINT LEFT$(DQ$,C);:PRINT" ? ";
  71. 700 C$=INPUT$(1)
  72. 710 IF C$<>"Y" AND C$<>"N" THEN PRINT" ** ERROR **":GOTO 690
  73. 720 IF C$="Y" THEN PRINT TAB(30)"Yes":LET K=CVI(DY$)
  74. 730 IF C$="N" THEN PRINT TAB(30)"No":LET K=CVI(DN$)
  75. 740 GET #1,K : REM GET IT
  76. 750 RETURN
  77. 760 REM SUBROUTINE TO ELIMINATE PADDING SPACES
  78. 770 C = LEN(DQ$)
  79. 780 WHILE MID$(DQ$,C,1) = " "
  80. 790   C = C - 1
  81. 800 WEND
  82. 810 RETURN
  83. 820 REM   *** ROUTINE TO LIST ANIMALS
  84. 830 PRINT CHR$(12):PRINT "Animals that I know are .....":PRINT
  85. 840 J=0: I=1
  86. 850 WHILE I <= LOF(1)
  87. 860   GET #1,I:I = I + 1
  88. 870   IF CVI(DY$) <> 0 THEN 860
  89. 880   PRINT TAB(16*J);
  90. 890   GOSUB 770
  91. 900   PRINT LEFT$(DQ$,C);
  92. 910   J=J+1: IF J>3 THEN J=0: PRINT
  93. 920 WEND
  94. 930 PRINT
  95. 940 PRINT
  96. 950 GOTO 200
  97. 960 END
  98. 970 FOR D=1 TO 500:NEXT D:GOTO 400
  99. 980 PRINT:PRINT:PRINT:PRINT:FOR D=1 TO 6:PRINT CHR$(7)
  100. 990 PRINT TAB(12)"#####  I GOT IT RIGHT  #####"
  101. 1000 FOR X=1 TO 50:NEXT X:NEXT D
  102. 1010 FOR Z=1 TO 500:NEXT Z:PRINT CHR$(12):GOTO 200
  103. T TA