home *** CD-ROM | disk | FTP | other *** search
/ PC Plus 25 / BASIC2 / MATHS.BAS next >
Encoding:
BASIC Source File  |  1988-01-01  |  7.4 KB  |  210 lines
  1. ' ********************************************
  2. ' **         The Maths Test v4.3            **
  3. ' **  Written on :1/4/88 by Damian Wilson   **
  4. ' ********************************************
  5.  
  6. LABEL initialise
  7.  mouse_conv=YDEVICE/200
  8.  waitval= 12000
  9.  high = 0
  10.  di$=CHR$(246)
  11.  CLS
  12.  CLOSE WINDOW 2:CLOSE WINDOW 3:CLOSE WINDOW 4
  13.  SCREEN #1 GRAPHICS 8000 FIXED,5000 FIXED
  14.  USER #1 SPACE 8000,5000:GRAPHICS MODE 1:SET MODE 2
  15.  WINDOW #1 OPEN:WINDOW #1 FULL
  16.  WINDOW #1 MOUSE 3
  17.  GOSUB title_screen
  18.  WINDOW #1 TITLE"The Maths Test by Damian Wilson."
  19.  
  20. LABEL menu
  21.  correct = 0
  22.  CLS
  23.  SET FONT 1 POINTS 10 COLOUR 2 EFFECTS 5
  24.  BOX 0;0,8000,5000 COLOUR 8 FILL WITH 8
  25.  BOX 2500;500,3200,3900 COLOUR 1 FILL WITH 8
  26.  BOX 2300;700,3200,4000 COLOUR 0 FILL WITH 8
  27.  PRINT AT(25;4); " 1.       [Addition Test.]"
  28.  PRINT AT(25;6);" 2. [Multiplication Test.]"
  29.  PRINT AT(25;8);" 3.    [Subtraction Test.]"
  30.  PRINT AT(25;10);" 4.       [Division Test.] "
  31.  PRINT AT(25;12);" 5.     [Mixed Questions.]"
  32.  PRINT AT(25;14);" 6.         [Set Options.]"
  33.  PRINT AT(25;16);COLOUR(4) " Position the hand pointer &"
  34.  PRINT AT(25;17);COLOUR(4) " press the LEFT mouse button "
  35.  PRINT AT(25;18);COLOUR(3) " or press number keys (1-6)."
  36.   GOSUB get_mouse
  37.  ymus=YMOUSE*mouse_conv
  38.  IF mouse_but =-1 THEN ymus =0
  39.  IF ymus>140 OR k$="1" THEN opflag=1:col1=12:col2=5:GOSUB main_routine:GOTO menu
  40.  IF ymus>124 OR k$="2" THEN opflag=2:col1=10:col2=8:GOSUB main_routine:GOTO menu
  41.  IF ymus>108 OR k$="3" THEN opflag=3:col1=14:col2=8:GOSUB main_routine:GOTO menu
  42.  IF ymus>92 OR k$="4" THEN opflag=4:col1=8:col2=2:GOSUB main_routine:GOTO menu
  43.  IF ymus>76 OR k$="5" THEN opflag=5:col1=11:col2=13:GOSUB main_routine :GOTO menu
  44.  IF ymus>67 OR k$="6" THEN GOSUB options: GOTO menu
  45.  GOTO menu
  46.  
  47. LABEL main_routine
  48.  IF quesnum=0 THEN quesnum=20
  49.  IF difval=0 THEN difval=30
  50.  CLS
  51.  FOR testnum = 1 TO quesnum
  52.   LABEL start0
  53.    whichop=INT(RND*5)
  54.   LABEL start1
  55.    num1=INT(RND*(((difval*difval)/200)+7))
  56.    num2=INT(RND*(((difval*difval)/200)+7))
  57.    IF whichop=0 OR whichop=5 THEN GOTO start0
  58.    IF num1=0 OR num2=0 THEN GOTO start1
  59.    IF opflag=1 THEN corans=num1+num2 :prflag=1
  60.    IF opflag=2 THEN corans=num1*num2 :prflag=2
  61.    IF opflag=3 THEN corans=num1-num2 :prflag=3
  62.    IF opflag=4 THEN corans=num1/num2 :prflag=4
  63.    IF opflag=5 AND whichop=1 THEN corans=num1+num2:prflag=1
  64.    IF opflag=5 AND whichop=2 THEN corans=num1*num2:prflag=2
  65.    IF opflag=5 AND whichop=3 THEN corans=num1-num2:prflag=3
  66.    IF opflag=5 AND whichop=4 THEN corans=num1/num2:prflag=4
  67.    IF prflag=4 AND corans<>INT(corans) THEN GOTO start1
  68.    IF prflag=4 AND corans =1 THEN GOTO start1
  69.    IF corans=num1 OR corans=num2 THEN GOTO start1
  70.    IF corans <1 THEN GOTO start1
  71.    GOSUB screen1
  72.    GOSUB whichques
  73.    GOSUB user_input1
  74.    IF ans = corans THEN GOSUB correct ELSE GOSUB incorrect
  75.  NEXT testnum
  76.  GOSUB total
  77. RETURN
  78.  
  79. LABEL options
  80.  IF difval = 0 THEN difval = 30
  81.  IF quesnum = 0 THEN quesnum = 20
  82.  GOSUB screen2
  83.  PRINT AT(24;4) COLOUR(8);"Set Options."
  84.  SET FONT 2 POINTS 14 COLOUR 1 EFFECTS 0
  85.  PRINT AT(24;6) COLOUR(6);"Use +/- keys to change values."
  86.  PRINT AT(23;7) COLOUR(6);"Press ENTER to accept new value."
  87.  SET FONT 3 POINTS 18
  88.  PRINT AT(16;14) "Enter difficulty level (from 0-200) ";difval
  89.  
  90.  LABEL difval_get
  91.   GOSUB get_key
  92.   IF k$="+" OR k$="=" THEN difval = difval +1
  93.   IF k$="-" THEN difval = difval - 1
  94.   IF difval <1 OR difval >200 THEN difval=30
  95.   IF k$=CHR$(13) THEN GOTO quesnum_get
  96.   BOX 5550;1800,600,300 FILL ONLY WITH 8 COLOUR 6
  97.   PRINT AT(56;14) difval
  98.   GOTO difval_get
  99.  
  100.  LABEL quesnum_get
  101.   PRINT AT(16;16) "Enter amount of questions asked ";quesnum
  102.   LABEL get_input1
  103.   GOSUB get_key
  104.   IF k$="+" OR k$="=" THEN quesnum = quesnum +1
  105.   IF k$="-" THEN quesnum = quesnum -1
  106.   IF quesnum <1 OR quesnum >200 THEN quesnum = 20
  107.   IF k$=CHR$(13) THEN RETURN
  108.   BOX 5300;1350,600,300 FILL ONLY WITH 8 COLOUR 6
  109.   PRINT AT(54;16) quesnum
  110.   GOTO get_input1
  111. RETURN
  112.  
  113. LABEL get_key
  114.  k$=""
  115.  REPEAT
  116.   k$=INKEY$
  117.  UNTIL k$<>""
  118. RETURN
  119.  
  120. LABEL get_mouse
  121.  REPEAT
  122.    mouse_but= BUTTON(1)
  123.    k$=INKEY$
  124.  UNTIL mouse_but >-1 OR k$<>""
  125.  PRINT CHR$(7)
  126. RETURN
  127.  
  128. LABEL correct
  129.  PRINT AT(17;16) COLOUR(0) "CORRECT!! Well done....."
  130.  correct = correct +1
  131.  FOR wait = 1 TO waitval:NEXT wait
  132. RETURN
  133.  
  134. LABEL incorrect
  135.  PRINT AT(17;16)COLOUR (0) ;"Sorry, you gave the wrong answer."
  136.  PRINT AT(17;17) COLOUR (0);"The answer of course was ";corans
  137.  FOR wait= 1 TO waitval: NEXT wait
  138. RETURN
  139.  
  140. LABEL total
  141.  perc = INT(correct*(100/quesnum))
  142.  GOSUB screen1
  143.  PRINT AT(18;13) COLOUR(1) "You gave ";correct;" correct answers out of ";quesnum
  144.  PRINT AT(18;14) COLOUR(0) "Thats ";perc;"%"
  145.  IF perc> high THEN high = perc : PRINT AT(18;15) COLOUR(6) "A NEW HIGH SCORE!!"
  146.  PRINT AT(18;17) COLOUR(0) "Present High Score is :";high;"%"
  147.  FOR wait = 1 TO 30000: NEXT wait
  148. RETURN
  149.  
  150. LABEL user_input1
  151.  SET FONT 3 POINTS 18 COLOUR 1
  152.  PRINT AT(17;12) COLOUR(12); "Press ENTER to accept answer."
  153.  INPUT AT(17;14) "Please type in your answer : ",ans
  154. RETURN
  155.  
  156. LABEL whichques
  157.   SET FONT 3 POINTS 36 COLOUR 6 EFFECTS 0
  158.   BOX 1500;3700,5000,900 FILL ONLY WITH 4 COLOUR 1
  159.   qlength=LEN(STR$(num1)+"   "+STR$(num2)+" = ?" )
  160.   xpoint=36-qlength
  161.   IF qlength=15 THEN xpoint=20
  162.   IF prflag=1 THEN PRINT #1 AT(xpoint;5) num1;" + ";num2;" = ?"
  163.   IF prflag=2 THEN PRINT #1 AT(xpoint;5) num1;" x ";num2;" = ?"
  164.   IF prflag=3 THEN PRINT #1 AT(xpoint;5) num1;" - ";num2;" = ?"
  165.   IF prflag=4 THEN PRINT #1 AT(xpoint;5) num1;" ";di$;" ";num2;" = ?"
  166. RETURN
  167.  
  168. LABEL screen1
  169.  BOX 0;0,8000,5000 FILL ONLY WITH 8 COLOUR col1
  170.  BOX 1200;400,6100,2300 FILL ONLY WITH 8 COLOUR 1
  171.  BOX 1000;600,6100,2300 FILL ONLY WITH 8 COLOUR col2
  172. RETURN
  173.  
  174. LABEL screen2
  175.  CLS
  176.  BOX 0;0,8000,5000 FILL ONLY WITH 8 COLOUR 3
  177.  BOX 1700;3000,5000,1500 FILL ONLY WITH 8 COLOUR 1
  178.  BOX 1500;3200,5000,1500 FILL ONLY WITH 8 COLOUR 11
  179.  BOX 1000;600,6400,1600 FILL ONLY WITH 8 COLOUR 1
  180.  BOX 800;800,6400,1600 FILL ONLY WITH 8 COLOUR 6
  181.  SET FONT 2 POINTS 36 EFFECTS 5
  182. RETURN
  183.  
  184. LABEL title_screen
  185.  WINDOW #1 TITLE "<<Click Mouse Button Or Press Any Key To Continue>>"
  186.  BOX 0;0,8000,5000 FILL ONLY WITH 8 COLOUR 5
  187.  BOX 0;0,8000,3000 FILL ONLY WITH 8 COLOUR 11
  188.  BOX 0;0,8000,3000 FILL ONLY WITH 14 COLOUR 3
  189.  SHAPE 1133;1733,2400;667,2733;0,1467;0 FILL WITH 8 COLOUR 1
  190.  SHAPE 4467;667,5767;1333,6933;1067,7900;0,4600;0 FILL  WITH 8 COLOUR 1
  191.  SHAPE 6010;3260,6667;3667,6667;2900 FILL ONLY WITH 8 COLOUR 10
  192.  SHAPE 4866;3600,6667;2533,6667;667,5767;1333,4860;2933 FILL ONLY WITH 8 COLOUR 10
  193.  SHAPE 4866;3600,6667;2533,6667;667,5767;1333,4860;2933 FILL ONLY WITH 4 COLOUR 1
  194.  SHAPE 4733;2467,6667;3667,6400;3733,4467;2733 FILL ONLY WITH 8 COLOUR 2
  195.  SHAPE 6667;2533,4866;3600,5133;3667,6933;2800 FILL ONLY WITH 8 COLOUR 2
  196.  SHAPE 4467;2733,4733;2467,4733;367,4467;667 FILL ONLY WITH 8 COLOUR 1
  197.  SHAPE 4467;2733,4733;2467,4733;367,4467;667 FILL ONLY WITH 4 COLOUR 10
  198.  SHAPE 4733;367,5767;1333,5767;3095,4733;2467 FILL ONLY WITH 8 COLOUR 10
  199.  SHAPE 6667;2533,6667;667,6933;1067,6933;2800 FILL ONLY WITH 8 COLOUR 10
  200.  SHAPE 1133;3333,1500;3333,2400;2466,2000;2333 FILL ONLY WITH 8 COLOUR 7
  201.  SHAPE 2000;2333,2400;2466,2400;667,2000;400 FILL ONLY WITH 8 COLOUR 15
  202.  SHAPE 1133;3333,2000;2333,2000;400,1133;1733 FILL ONLY WITH 8 COLOUR 1
  203.  SHAPE 1133;3333,2000;2333,2000;400,1133;1733 FILL ONLY WITH 4 COLOUR 15
  204.  BOX 2350;4100,3600,700 FILL ONLY WITH 8 COLOUR 13
  205.  BOX 2250;4200,3600,700 FILL ONLY WITH 8 COLOUR 9
  206.  SET FONT 3 POINTS 36 COLOUR 0 EFFECTS 5
  207.  PRINT AT(25;3) "Maths Test !!"
  208.   GOSUB get_mouse
  209.  RETURN
  210.