BASIC2\MATHS.BAS  ·  BAS  ·  7.4 KB  ·  1988-08-02  ·  from PCPlus_Issue-25_Oct-1988
' ********************************************
' **         The Maths Test v4.3            **
' **  Written on :1/4/88 by Damian Wilson   **
' ********************************************

LABEL initialise
 mouse_conv=YDEVICE/200
 waitval= 12000
 high = 0
 di$=CHR$(246)
 CLS
 CLOSE WINDOW 2:CLOSE WINDOW 3:CLOSE WINDOW 4
 SCREEN #1 GRAPHICS 8000 FIXED,5000 FIXED
 USER #1 SPACE 8000,5000:GRAPHICS MODE 1:SET MODE 2
 WINDOW #1 OPEN:WINDOW #1 FULL
 WINDOW #1 MOUSE 3
 GOSUB title_screen
 WINDOW #1 TITLE"The Maths Test by Damian Wilson."

LABEL menu
 correct = 0
 CLS
 SET FONT 1 POINTS 10 COLOUR 2 EFFECTS 5
 BOX 0;0,8000,5000 COLOUR 8 FILL WITH 8
 BOX 2500;500,3200,3900 COLOUR 1 FILL WITH 8
 BOX 2300;700,3200,4000 COLOUR 0 FILL WITH 8
 PRINT AT(25;4); " 1.       [Addition Test.]"
 PRINT AT(25;6);" 2. [Multiplication Test.]"
 PRINT AT(25;8);" 3.    [Subtraction Test.]"
 PRINT AT(25;10);" 4.       [Division Test.] "
 PRINT AT(25;12);" 5.     [Mixed Questions.]"
 PRINT AT(25;14);" 6.         [Set Options.]"
 PRINT AT(25;16);COLOUR(4) " Position the hand pointer &"
 PRINT AT(25;17);COLOUR(4) " press the LEFT mouse button "
 PRINT AT(25;18);COLOUR(3) " or press number keys (1-6)."
  GOSUB get_mouse
 ymus=YMOUSE*mouse_conv
 IF mouse_but =-1 THEN ymus =0
 IF ymus>140 OR k$="1" THEN opflag=1:col1=12:col2=5:GOSUB main_routine:GOTO menu
 IF ymus>124 OR k$="2" THEN opflag=2:col1=10:col2=8:GOSUB main_routine:GOTO menu
 IF ymus>108 OR k$="3" THEN opflag=3:col1=14:col2=8:GOSUB main_routine:GOTO menu
 IF ymus>92 OR k$="4" THEN opflag=4:col1=8:col2=2:GOSUB main_routine:GOTO menu
 IF ymus>76 OR k$="5" THEN opflag=5:col1=11:col2=13:GOSUB main_routine :GOTO menu
 IF ymus>67 OR k$="6" THEN GOSUB options: GOTO menu
 GOTO menu

LABEL main_routine
 IF quesnum=0 THEN quesnum=20
 IF difval=0 THEN difval=30
 CLS
 FOR testnum = 1 TO quesnum
  LABEL start0
   whichop=INT(RND*5)
  LABEL start1
   num1=INT(RND*(((difval*difval)/200)+7))
   num2=INT(RND*(((difval*difval)/200)+7))
   IF whichop=0 OR whichop=5 THEN GOTO start0
   IF num1=0 OR num2=0 THEN GOTO start1
   IF opflag=1 THEN corans=num1+num2 :prflag=1
   IF opflag=2 THEN corans=num1*num2 :prflag=2
   IF opflag=3 THEN corans=num1-num2 :prflag=3
   IF opflag=4 THEN corans=num1/num2 :prflag=4
   IF opflag=5 AND whichop=1 THEN corans=num1+num2:prflag=1
   IF opflag=5 AND whichop=2 THEN corans=num1*num2:prflag=2
   IF opflag=5 AND whichop=3 THEN corans=num1-num2:prflag=3
   IF opflag=5 AND whichop=4 THEN corans=num1/num2:prflag=4
   IF prflag=4 AND corans<>INT(corans) THEN GOTO start1
   IF prflag=4 AND corans =1 THEN GOTO start1
   IF corans=num1 OR corans=num2 THEN GOTO start1
   IF corans <1 THEN GOTO start1
   GOSUB screen1
   GOSUB whichques
   GOSUB user_input1
   IF ans = corans THEN GOSUB correct ELSE GOSUB incorrect
 NEXT testnum
 GOSUB total
RETURN

LABEL options
 IF difval = 0 THEN difval = 30
 IF quesnum = 0 THEN quesnum = 20
 GOSUB screen2
 PRINT AT(24;4) COLOUR(8);"Set Options."
 SET FONT 2 POINTS 14 COLOUR 1 EFFECTS 0
 PRINT AT(24;6) COLOUR(6);"Use +/- keys to change values."
 PRINT AT(23;7) COLOUR(6);"Press ENTER to accept new value."
 SET FONT 3 POINTS 18
 PRINT AT(16;14) "Enter difficulty level (from 0-200) ";difval

 LABEL difval_get
  GOSUB get_key
  IF k$="+" OR k$="=" THEN difval = difval +1
  IF k$="-" THEN difval = difval - 1
  IF difval <1 OR difval >200 THEN difval=30
  IF k$=CHR$(13) THEN GOTO quesnum_get
  BOX 5550;1800,600,300 FILL ONLY WITH 8 COLOUR 6
  PRINT AT(56;14) difval
  GOTO difval_get

 LABEL quesnum_get
  PRINT AT(16;16) "Enter amount of questions asked ";quesnum
  LABEL get_input1
  GOSUB get_key
  IF k$="+" OR k$="=" THEN quesnum = quesnum +1
  IF k$="-" THEN quesnum = quesnum -1
  IF quesnum <1 OR quesnum >200 THEN quesnum = 20
  IF k$=CHR$(13) THEN RETURN
  BOX 5300;1350,600,300 FILL ONLY WITH 8 COLOUR 6
  PRINT AT(54;16) quesnum
  GOTO get_input1
RETURN

LABEL get_key
 k$=""
 REPEAT
  k$=INKEY$
 UNTIL k$<>""
RETURN

LABEL get_mouse
 REPEAT
   mouse_but= BUTTON(1)
   k$=INKEY$
 UNTIL mouse_but >-1 OR k$<>""
 PRINT CHR$(7)
RETURN

LABEL correct
 PRINT AT(17;16) COLOUR(0) "CORRECT!! Well done....."
 correct = correct +1
 FOR wait = 1 TO waitval:NEXT wait
RETURN

LABEL incorrect
 PRINT AT(17;16)COLOUR (0) ;"Sorry, you gave the wrong answer."
 PRINT AT(17;17) COLOUR (0);"The answer of course was ";corans
 FOR wait= 1 TO waitval: NEXT wait
RETURN

LABEL total
 perc = INT(correct*(100/quesnum))
 GOSUB screen1
 PRINT AT(18;13) COLOUR(1) "You gave ";correct;" correct answers out of ";quesnum
 PRINT AT(18;14) COLOUR(0) "Thats ";perc;"%"
 IF perc> high THEN high = perc : PRINT AT(18;15) COLOUR(6) "A NEW HIGH SCORE!!"
 PRINT AT(18;17) COLOUR(0) "Present High Score is :";high;"%"
 FOR wait = 1 TO 30000: NEXT wait
RETURN

LABEL user_input1
 SET FONT 3 POINTS 18 COLOUR 1
 PRINT AT(17;12) COLOUR(12); "Press ENTER to accept answer."
 INPUT AT(17;14) "Please type in your answer : ",ans
RETURN

LABEL whichques
  SET FONT 3 POINTS 36 COLOUR 6 EFFECTS 0
  BOX 1500;3700,5000,900 FILL ONLY WITH 4 COLOUR 1
  qlength=LEN(STR$(num1)+"   "+STR$(num2)+" = ?" )
  xpoint=36-qlength
  IF qlength=15 THEN xpoint=20
  IF prflag=1 THEN PRINT #1 AT(xpoint;5) num1;" + ";num2;" = ?"
  IF prflag=2 THEN PRINT #1 AT(xpoint;5) num1;" x ";num2;" = ?"
  IF prflag=3 THEN PRINT #1 AT(xpoint;5) num1;" - ";num2;" = ?"
  IF prflag=4 THEN PRINT #1 AT(xpoint;5) num1;" ";di$;" ";num2;" = ?"
RETURN

LABEL screen1
 BOX 0;0,8000,5000 FILL ONLY WITH 8 COLOUR col1
 BOX 1200;400,6100,2300 FILL ONLY WITH 8 COLOUR 1
 BOX 1000;600,6100,2300 FILL ONLY WITH 8 COLOUR col2
RETURN

LABEL screen2
 CLS
 BOX 0;0,8000,5000 FILL ONLY WITH 8 COLOUR 3
 BOX 1700;3000,5000,1500 FILL ONLY WITH 8 COLOUR 1
 BOX 1500;3200,5000,1500 FILL ONLY WITH 8 COLOUR 11
 BOX 1000;600,6400,1600 FILL ONLY WITH 8 COLOUR 1
 BOX 800;800,6400,1600 FILL ONLY WITH 8 COLOUR 6
 SET FONT 2 POINTS 36 EFFECTS 5
RETURN

LABEL title_screen
 WINDOW #1 TITLE "<<Click Mouse Button Or Press Any Key To Continue>>"
 BOX 0;0,8000,5000 FILL ONLY WITH 8 COLOUR 5
 BOX 0;0,8000,3000 FILL ONLY WITH 8 COLOUR 11
 BOX 0;0,8000,3000 FILL ONLY WITH 14 COLOUR 3
 SHAPE 1133;1733,2400;667,2733;0,1467;0 FILL WITH 8 COLOUR 1
 SHAPE 4467;667,5767;1333,6933;1067,7900;0,4600;0 FILL  WITH 8 COLOUR 1
 SHAPE 6010;3260,6667;3667,6667;2900 FILL ONLY WITH 8 COLOUR 10
 SHAPE 4866;3600,6667;2533,6667;667,5767;1333,4860;2933 FILL ONLY WITH 8 COLOUR 10
 SHAPE 4866;3600,6667;2533,6667;667,5767;1333,4860;2933 FILL ONLY WITH 4 COLOUR 1
 SHAPE 4733;2467,6667;3667,6400;3733,4467;2733 FILL ONLY WITH 8 COLOUR 2
 SHAPE 6667;2533,4866;3600,5133;3667,6933;2800 FILL ONLY WITH 8 COLOUR 2
 SHAPE 4467;2733,4733;2467,4733;367,4467;667 FILL ONLY WITH 8 COLOUR 1
 SHAPE 4467;2733,4733;2467,4733;367,4467;667 FILL ONLY WITH 4 COLOUR 10
 SHAPE 4733;367,5767;1333,5767;3095,4733;2467 FILL ONLY WITH 8 COLOUR 10
 SHAPE 6667;2533,6667;667,6933;1067,6933;2800 FILL ONLY WITH 8 COLOUR 10
 SHAPE 1133;3333,1500;3333,2400;2466,2000;2333 FILL ONLY WITH 8 COLOUR 7
 SHAPE 2000;2333,2400;2466,2400;667,2000;400 FILL ONLY WITH 8 COLOUR 15
 SHAPE 1133;3333,2000;2333,2000;400,1133;1733 FILL ONLY WITH 8 COLOUR 1
 SHAPE 1133;3333,2000;2333,2000;400,1133;1733 FILL ONLY WITH 4 COLOUR 15
 BOX 2350;4100,3600,700 FILL ONLY WITH 8 COLOUR 13
 BOX 2250;4200,3600,700 FILL ONLY WITH 8 COLOUR 9
 SET FONT 3 POINTS 36 COLOUR 0 EFFECTS 5
 PRINT AT(25;3) "Maths Test !!"
  GOSUB get_mouse
 RETURN