home *** CD-ROM | disk | FTP | other *** search
/ Play and Learn 2 / 19941.ZIP / 19941 / EDUCICAL / MMBIOTUT / MMPLAYL.BAS (.txt) < prev    next >
Encoding:
GW-BASIC  |  1994-02-04  |  4.7 KB  |  115 lines
  1. 1000  ON ERROR GOTO 9000
  2. 1001  COMMON UMSEG%()
  3. 1005  DEFINT A-Z
  4. 1020  DIM ANS$(51),QU$(51)
  5. 1030  CL=3:CO=6:INV=30:PC=39:RS=42:SP=45:SY=48:TX=57
  6. 1080  OPEN "MMHOME.dir" AS #1 LEN = 95
  7. 1085  FIELD #1, 8 AS F1$, 2 AS F2$,2 AS F3$,2 AS F4$,2 AS F5$, 2 AS F6$,15 AS F7$,30 AS F8$,32 AS F9$
  8. 2020  GET #1,LESN
  9. 2021  GN=CVI(F2$):PCT=CVI(F3$):QN=CVI(F4$):QU=CVI(F5$):WTL$=F7$:TTL$=F8$:HINT$=F9$
  10. 2022  IF RIGHT$(WTL$,1)=" " THEN WTL$=LEFT$(WTL$,LEN(WTL$)-1):GOTO 2022
  11. 2023  IF RIGHT$(TTL$,1)=" " THEN TTL$=LEFT$(TTL$,LEN(TTL$)-1):GOTO 2023
  12. 2025  LSN$=F1$:CLOSE:OPEN LSN$+".LES" AS #1 LEN=144
  13. 2028  FIELD #1, 20 AS LF1$, 124 AS LF2$
  14. 2030  FOR I=1 TO QN
  15. 2037    GET #1,I:ANS$(I)=LF1$:QU$(I)=LF2$
  16. 2048  NEXT
  17. 2050  FOR I=1 TO QU
  18. 2060    RANDOMIZE(I):X=VAL(RIGHT$(TIME$,2))
  19. 2070    Y=I+INT(RND(X)*(QN-I+1))
  20. 2071    SWAP QU$(I),QU$(Y):SWAP ANS$(I),ANS$(Y)
  21. 2072    IF LEFT$(ANS$(I),1)=" " THEN ANS$(I)=MID$(ANS$(I),2):GOTO 2071
  22. 2073    L=LEN(ANS$(I)):IF L>0 THEN IF RIGHT$(ANS$(I),1)=" " THEN ANS$(I)=LEFT$(ANS$(I),L-1):GOTO 2072
  23. 2074    FOR J=1 TO LEN(ANS$(I)):A$=MID$(ANS$(I),J,1):IF A$>="a" AND A$<="z" THEN MID$(ANS$(I),J,1)=CHR$(ASC(A$)-32)
  24. 2075    NEXT J
  25. 2090  NEXT I
  26. 2200  CLS:SCREEN 1,0:DEF SEG=UMSEG%(3)
  27. 2220  LOCATE 1,12:COLOR 0,0:PRINT "ITEMS REMAINING: "
  28. 2230  Z=255:CALL SP(Z):Z=0:CALL CL(Z):B=0:P=0:F=3:CALL CO(B,P,F):X=1:Y=2:CALL PC(X,Y)
  29. 2240  Z=1:CALL SY(Z):T$="CHOICE:   GUESSES:":CALL TX(T$)
  30. 2250  LOCATE 8,11:COLOR 0,0:PRINT STRING$(20,45)
  31. 2260  CALL INV:Z=2:CALL SY(Z):X=(40-LEN(WTL$))\2:Y=9:CALL PC(X,Y):T$=" "+WTL$+" ":CALL TX(T$)
  32. 2270  X=1:Y=12:CALL PC(X,Y):T$=" "+TTL$+":":CALL TX(T$)
  33. 2290  X=1:Y=20:CALL PC(X,Y):T$=" "+HINT$:CALL TX(T$)
  34. 2295  CALL INV
  35. 2300  XL=304:XR=319:YT=48:YB=189:H=(YB-YT-1)\QU:R=(YB-YT-1) MOD QU
  36. 2310  LINE (XL,YT)-(XR,YB),3,B:LINE (XL-1,YT-1)-(XR-1,YB-1),3,B
  37. 2312  S!=QU*PCT/100:IF INT(S!)<S! THEN MS=INT(S!+1) ELSE MS=S!
  38. 2315  FOR I=1 TO QU-1
  39. 2320    IF I<=R THEN Y=YB-(H+1)*I ELSE Y=YB-(H+1)*R-(I-R)*H
  40. 2330    LINE (XL-1,Y)-(XR-1,Y),3
  41. 2335    IF I=MS THEN LINE (XL-8,Y)-(XL-1,Y),2
  42. 2340  NEXT
  43. 2341  IF MS=QU THEN LINE (296,47)-(303,47),2
  44. 2500  DEF SEG=UMSEG%(3):F=1:CALL CO(B,P,F)
  45. 2503  IREM=QU:NW=0
  46. 2505  FOR CQ=1 TO QU
  47. 2506    L=LEN(ANS$(CQ)):ANSWER$=SPACE$(L)
  48. 2508    A$=INKEY$:IF A$<>"" GOTO 2508
  49. 2510    NQ=1:WIN=0:GU=GN:GOSUB 5000:NQ=0
  50. 2520    A$=INKEY$:IF A$="" OR A$=" " GOTO 2520
  51. 2530    IF A$=CHR$(27) GOTO 6000
  52. 2531    IF LEN(A$)=2 OR A$<" " THEN BEEP:GOTO 2520 ELSE CHOICE$=A$:IF CHOICE$>="a" AND CHOICE$<="z" THEN CHOICE$=CHR$(ASC(CHOICE$)-32)
  53. 2535    Z=110:CALL CL(Z):X=8:Y=2:CALL PC(X,Y):Z=1:CALL SY(Z):CALL TX(CHOICE$):FOUND=0
  54. 2536    Z=2:CALL SY(Z):F=1:CALL CO(B,P,F)
  55. 2540    FOR J=1 TO L
  56. 2545      T$=MID$(ANS$(CQ),J,1)
  57. 2550      IF CHOICE$=T$ THEN Y=7:X=10+J:CALL PC(X,Y):CALL TX(CHOICE$):FOUND=1:MID$(ANSWER$,J,1)=CHOICE$
  58. 2560    NEXT J
  59. 2570    IF FOUND=0 THEN BEEP:GU=GU-1:GOSUB 5000:IF GU=0 THEN GOSUB 3000:GOTO 2600 ELSE GOTO 2520
  60. 2580    IF ANSWER$=ANS$(CQ) THEN NW=NW+1:WIN=1:GOSUB 3500:GOTO 2600 ELSE GOTO 2520
  61. 2600    IREM=IREM-1
  62. 2610  NEXT CQ
  63. 2620  GOSUB 4000
  64. 2630  IF NCWIN>=2 THEN CLOSE:COMMON TSC,PN$:CHAIN "MMPLAYG",1000
  65. 2640  IF PT<PCT THEN NCWIN=0:GOTO 2050 ELSE GOTO 6000
  66. 3000  B=0:P=0:F=2:CALL CO(B,P,F)
  67. 3020  MSG$="SORRY, "+PN$+"!":Z=1:CALL SY(Z)
  68. 3030  X1=(19-LEN(MSG$))\2+1:Y1=12:CALL PC(X1,Y1):BEEP:CALL TX(MSG$)
  69. 3040  COLOR 0,0:DEF SEG:POKE &H4E,2
  70. 3055  FOR J=1 TO 10:V=J MOD 2:IF V=1 THEN LOCATE 7,11:PRINT ANS$(CQ):FOR U=1 TO 200:NEXT U ELSE LOCATE 7,11:PRINT SPACE$(20):FOR U=1 TO 150:NEXT U
  71. 3070  NEXT J:POKE &H4E,3:DEF SEG=UMSEG%(3)
  72. 3075  Z=0:CALL CL(Z)
  73. 3080  F=1:CALL CO(B,P,F):X1=1:Y1=12:T$="  (PRESS  RETURN) ":CALL PC(X1,Y1):CALL TX(T$)
  74. 3084  A$=INKEY$:IF A$<>"" GOTO 3084
  75. 3085  A$=INKEY$:IF A$<>CHR$(13) GOTO 3085 ELSE CALL PC(X1,Y1):T$=SPACE$(18):CALL TX(T$)
  76. 3086  Z=110:CALL CL(Z)
  77. 3090  RETURN
  78. 3500  B=0:P=0:F=1:CALL CO(B,P,F)
  79. 3520  MSG$="GOOD, "+PN$+"!":Z=0:CALL CL(Z):Z=1:CALL SY(Z)
  80. 3530  X1=(19-LEN(MSG$))\2+1:Y1=12:CALL PC(X1,Y1):CALL TX(MSG$)
  81. 3540  GOSUB 5000
  82. 3550  LOCATE 7,11:COLOR 0:PRINT SPACE$(20)
  83. 3560  T$=SPACE$(LEN(MSG$)):CALL PC(X1,Y1):CALL TX(T$)
  84. 3590  RETURN
  85. 4000  SCR=NW*100:TSC=TSC+SCR:PT=NW/QU*100:IF PT>=PCT THEN NCWIN=NCWIN+1
  86. 4005  T1$=STR$(NW):IF LEN(T1$)>2 THEN T1$=RIGHT$(T1$,2)
  87. 4006  T2$=STR$(TSC):IF LEN(T2$)>4 THEN T2$=RIGHT$(T2$,4)
  88. 4007  T3$=STR$(QU):IF LEN(T3$)>2 THEN T3$=RIGHT$(T3$,2)
  89. 4008  T4$=STR$(PT):IF LEN(T4$)>3 THEN T4$=RIGHT$(T4$,3)
  90. 4010  IF PT<=20 THEN MSG$="GET HELP !!!" ELSE IF NW<MS THEN MSG$="PRACTICE !!!" ELSE IF PT<90 THEN MSG$="GOOD !!!" ELSE GOTO 4020
  91. 4011  GOTO 4100
  92. 4020  IF PT<100 AND PT>=90 THEN MSG$="EXCELLENT !!!" ELSE IF PT=100 THEN MSG$="PERFECT !!!"
  93. 4100  CALL RS:Z=255:CALL SP(Z):Z=0:CALL CL(Z):B=0:P=0:F=3:CALL CO(B,P,F)
  94. 4110  X=2:Y=1:CALL PC(X,Y):T$="WINS:":CALL TX(T$):F=1:CALL CO(B,P,F):X=7:CALL PC(X,Y):CALL TX(T1$)
  95. 4121  F=3:CALL CO(B,P,F):X=11:CALL PC(X,Y):T$="SCORE:":CALL TX(T$):F=1:CALL CO(B,P,F):X=17:CALL PC(X,Y):CALL TX(T2$)
  96. 4132  X=3:Y=3:CALL PC(X,Y):CALL TX(T1$):F=3:CALL CO(B,P,F):X=5:CALL PC(X,Y):T$=" CORRECT OF ":CALL TX(T$):F=1:CALL CO(B,P,F):X=17:CALL PC(X,Y):CALL TX(T3$)
  97. 4143  F=2:CALL CO(B,P,F):X=8:Y=6:CALL PC(X,Y):T$=T4$+" %":CALL TX(T$)
  98. 4154  X=(20-LEN(MSG$))\2+1:Y=8:CALL PC(X,Y):CALL TX(MSG$)
  99. 4165  F=3:CALL CO(B,P,F):X=2:Y=12:CALL PC(X,Y):T$="** PRESS RETURN **":CALL TX(T$):BEEP
  100. 4180  IF PT<PCT THEN TSC=0
  101. 4200  A$=INKEY$:IF A$="" GOTO 4200
  102. 4500  IF A$=CHR$(13) THEN RETURN ELSE GOTO 4200
  103. 5000  IF WIN=1 THEN WIN=0:BEEP:GOTO 5005 ELSE GOTO 5010
  104. 5005  IF NW<=R THEN Y=YB-(H+1)*NW:H1=H ELSE Y=YB-(H+1)*R-(NW-R)*H:H1=H-1
  105. 5006  IF NW=QU THEN Y=Y-1:H1=H1+1
  106. 5007  LINE (XL+1,Y+1)-(XR-2,Y+H1),2,BF
  107. 5010  COLOR 0,0:LOCATE 1,29:DEF SEG:POKE &H4E,1:PRINT USING "##";IREM:POKE &H4E,3:DEF SEG=UMSEG%(3)
  108. 5040  T$=STR$(GU):IF LEN(T$)>2 THEN T$=RIGHT$(T$,2)
  109. 5050  F=1:CALL CO(B,P,F):Z=1:CALL SY(Z):X=19:Y=2:CALL PC(X,Y):CALL TX(T$)
  110. 5055  T$=" ":X=8:Y=2:CALL PC(X,Y):CALL TX(T$)
  111. 5060  IF NQ=1 THEN COLOR 0,0:FOR I=1 TO 4:LOCATE 13+I,3:PRINT MID$(QU$(CQ),(I-1)*30+I,30):NEXT:BEEP
  112. 5065  Z!=FRE(W$):RETURN
  113. 6000  CLOSE:COMMON PN$,NCWIN,TSC:CHAIN "MMldir",1000
  114. 9000  CLOSE:CHAIN "MMPLAY",1000
  115.