home *** CD-ROM | disk | FTP | other *** search
/ PC Plus 31 / BASIC2 / ANGLES.BAS
Encoding:
BASIC Source File  |  1989-01-01  |  13.2 KB  |  376 lines
  1. '   Understanding angles program
  2. '   Author: Gill. Hayton, Date: November 1988
  3. '
  4. '   Main control routine
  5.     CLS
  6.     SCREEN #1 GRAPHICS 8000 FIXED, 5000 FIXED
  7.     USER #1 SPACE 8000,5000: GRAPHICS MODE 1
  8.     SET #1 MODE 2
  9.     WINDOW OPEN
  10.     WINDOW TITLE "Angles - by Gill Hayton (0628) 23769"
  11.     WINDOW FULL
  12.     OPTION DEGREES
  13.     GRAPHICS WIDTH 3
  14.     RANDOMIZE
  15.     DIM angval (4,2) WORD
  16.     DIM angnam$ (4) FIXED 9
  17.     DIM names$ (4) FIXED 6
  18.     deg$=CHR$(248)
  19.     doneflg=0
  20.     GOSUB initial
  21.     SET COLOUR(2)
  22. LABEL retry
  23.     GOSUB angles
  24.     IF endflag=1 THEN GOTO finish
  25.     GOTO retry
  26.  
  27. LABEL initial
  28.     SET COLOUR(7)
  29.     BOX 0;0, 8000, 5000 FILL ONLY COLOUR 13
  30.     SHAPE 500;4200, 4000;4800, 7500;4200, 4000;3600 COLOUR 8 FILL ONLY
  31.     PRINT AT (32;4); FONT(3) POINTS(36) COLOUR(1) EFFECTS(1);"ANGLES"
  32.     PRINT AT (30;5); FONT(3) POINTS(36) COLOUR(7) EFFECTS(1);"ANGLES"
  33.     SHAPE 500;2000, 4000;3500, 7500;2000, 4000;500 COLOUR 8 FILL ONLY
  34.     CIRCLE 4200;2200, 1000 FILL COLOUR 1
  35.     PIE 4000;2000, 1000, 0, 60 FILL COLOUR 2
  36.     PIE 4000;2000, 1000, 60, 160 FILL COLOUR 12
  37.     PIE 4000;2000, 1000, 160, 225 FILL COLOUR 14
  38.     PIE 4000;2000, 1000, 225, 315 FILL COLOUR 3
  39.     PIE 4000;2000, 1000, 315, 0 FILL COLOUR 6
  40.     SET COLOUR(15)
  41.     GOSUB wait_key
  42.     angval(1,1) = 0:angval(1,2) = 89
  43.     angval(2,1) = 90:angval(2,2) = 89
  44.     angval(3,1) = 180:angval(3,2) = 179
  45.     angval(4,1) = 89:angval(4,2) = 2
  46.     angnam$(1) = "an acute":angnam$(2) = "an obtuse"
  47.     angnam$(3) = "a reflex":angnam$(4) = "a right"
  48.     names$(1) = "acute":names$(2) = "obtuse"
  49.     names$(3) = "reflex":names$(4) = "right"
  50.     xconv = 8000/XDEVICE:yconv = 5000/YDEVICE
  51.     xconv = XPIXEL:yconv = YPIXEL
  52.     RETURN
  53.  
  54. LABEL angles
  55.     BOX 0;0,8000,5000 FILL ONLY WITH 8 COLOUR 8
  56.     PRINT AT (30;3) FONT(3) POINTS(24) COLOUR(15) EFFECTS(1);"ANGLES"
  57.     PRINT AT (5;5);"This program demonstrates the measurement of angles in Geometry"
  58.     SET COLOUR(7)
  59.     BOX 1400;2500, 5000, 1200 FILL ONLY COLOUR(15)
  60.     BOX 1200;2300, 5000, 1200 FILL ONLY COLOUR(0)
  61.     BOX 4900;2980,500,250 FILL ONLY COLOUR(6)
  62.     BOX 4900;2500,500,250 FILL ONLY COLOUR(6)
  63.     PRINT AT (14;9);"Do you want definitions?":PRINT AT (51;9);"Yes"
  64.     PRINT AT (14;10);"Click on option box or"
  65.     PRINT AT (14;11);"type Y or N":PRINT AT (51;11);"No"
  66. LABEL ang_def1
  67.     GOSUB wait_press
  68.     IF butt = -1 THEN GOTO ang_def2
  69.     GOSUB calcmse:IF k1=0 THEN GOTO ang_def1
  70.     GOTO ang_def3
  71. LABEL ang_def2
  72.     IF ky$ = "y" OR ky$ = "Y" THEN k1 = 1:GOTO ang_def3
  73.     IF ky$ = "n" OR ky$ = "N" THEN GOTO ang_def3
  74.     ALERT 1 TEXT "No, enter Y or N" BUTTON RETURN "Press return to continue"
  75.     GOTO ang_def1
  76. LABEL ang_def3
  77.     SET COLOUR(2)
  78.     IF k1=1 THEN GOSUB angle_def
  79.     WHILE doneflg = 0
  80.         BOX 0;0,8000,5000 FILL ONLY COLOUR(12)
  81.         BOX 2500;4250,3000,400 FILL ONLY COLOUR(5)
  82.         PRINT AT (30;3); FONT(3) POINTS(18);"Test Options"
  83.         BOX 1200;2300,5000,1400 FILL ONLY COLOUR(5)
  84.         BOX 5000;3430,200,250 FILL ONLY COLOUR(11)
  85.         BOX 5000;2980,200,250 FILL ONLY COLOUR(11)
  86.         BOX 5000;2500,200,250 FILL ONLY COLOUR(11)
  87.         BOX 350;660,6000,500 FILL ONLY COLOUR (5)
  88.         PRINT AT (14;7);"Angle types and sizes":PRINT AT (51;7);"1"
  89.         PRINT AT (14;9);"Make angles":PRINT AT (51;9);"2"
  90.         PRINT AT (14;11);"Quit":PRINT AT (51;11);"3"
  91.         PRINT AT (5;18);"Position the mouse pointer and press the left button"
  92.         PRINT AT (5;19);"or press a number key 1 - 3"
  93. LABEL angles_2
  94.         GOSUB wait_press
  95.         IF butt = -1 THEN GOTO angles_3
  96.         GOSUB calcmouse:IF k1=0 THEN GOTO angles_2
  97.         GOTO angles_4
  98. LABEL angles_3
  99.         k1 = ASC(ky$) - 48
  100.         IF k1 < 1 OR k1 > 3 THEN ALERT 1 TEXT "No, enter 1, 2, or 3" BUTTON RETURN "Press return to continue": GOTO angles_2
  101. LABEL angles_4
  102.         ON k1 GOSUB types,make,done
  103.     WEND
  104. LABEL finish
  105.     CLS
  106.     PRINT AT (5;5);"End of Geometry Program"
  107.     END
  108.  
  109. LABEL angle_def
  110.     BOX 0;0,8000,4100,FILL ONLY COLOUR 8
  111.     PRINT AT (5;5) COLOUR(12);"An angle is the difference between the directions of two lines"
  112.     GRAPHICS COLOUR 1 STYLE 1
  113.     st = 0
  114.     lnx1=2000:lny1=2000:lnx2=4000:lny2=2000
  115.     ang=45:bckgnd=8:n1=3:lngth=lnx2-lnx1
  116.     GOSUB draw_angle
  117.     PRINT AT (44;14);"Line 1"
  118.     PRINT AT (37;7);"Line 2"
  119.     PRINT AT (15;16);"Angle"
  120.     LINE 2000;1500, 2200;2100
  121.     GOSUB wait_key
  122.     BOX 0;0,8000,4100 FILL ONLY WITH 8 COLOUR 8
  123.     PRINT AT (5;5) COLOUR (12);"If the difference in direction is a complete circle the angle is 360";deg$
  124.     lnx1=3000:lny1=2000:lnx2=4500:lny2=2000
  125.     ang=361:n1=24:lngth=lnx2-lnx1
  126.     GOSUB draw_angle
  127.     PRINT AT (50;13);"Line 2"
  128.     PRINT AT (50;14);"Line 1"
  129.     PRINT AT (15;17);"Angle 360";deg$
  130.     LINE 2000;1400, 2900;1900
  131.     PRINT AT (5;18) COLOUR(12);"360 seems a strange number to choose but the Ancient Babylonians"
  132.     PRINT AT (5;19) COLOUR(12);"liked it because so many numbers can be divided into it"
  133.     GOSUB wait_key
  134.     BOX 0;0,8000,4100 FILL ONLY WITH 8 COLOUR 8
  135.     PRINT AT (5;5) COLOUR (12);"If the the angle is 180";deg$;" (half of 360";deg$;") you get a straight line"
  136.     lnx1=3000:lny1=2000:lnx2=4500:lny2=2000
  137.     ang=181:n1=12:lngth=lnx2-lnx1
  138.     GOSUB draw_angle
  139.     PRINT AT (10;13);"Line 2"
  140.     PRINT AT (50;14);"Line 1"
  141.     PRINT AT (15;17);"Angle 180";deg$
  142.     LINE 2000;1400, 2900;2100
  143.     GOSUB wait_key
  144.     BOX 0;0,8000,4100 FILL ONLY WITH 8 COLOUR 8
  145.     PRINT AT (5;5) COLOUR(12);"Special angle names:"
  146.     lnx1=1600:lny1=3000:lnx2=2300:lny2=3000
  147.     ang=91:n1=6:lngth=lnx2-lnx1
  148.     GOSUB draw_angle
  149.     PRINT AT (24;7);"Right Angle"
  150.     PRINT AT (7;11) COLOUR(12);"Angle = 90";deg$
  151.     lnx1=4360:lnx2=5060
  152.     ang=61:n1=4
  153.     GOSUB draw_angle
  154.     PRINT AT (52;7);"Acute Angle"
  155.     PRINT AT (40;11) COLOUR(12);"Angle less than 90";deg$
  156.     lnx1=1600:lny1=1750:lnx2=2300:lny2=1750
  157.     ang=136:n1=15
  158.     GOSUB draw_angle
  159.     PRINT AT (20;13);"Obtuse Angle"
  160.     PRINT AT (7;17) COLOUR(12);"Angle between 90";deg$;" and 180";deg$
  161.     lnx1=4360:lnx2=5060
  162.     ang=226:n1=15
  163.     GOSUB draw_angle
  164.     PRINT AT (52;13);"Reflex Angle"
  165.     PRINT AT (45;17) COLOUR(12);"Angle greater than 180";deg$
  166.     LINE 1500;2500, 1700;3100
  167.     LINE 4260;2500, 4460;3100
  168.     LINE 1500;1250, 1700;1850
  169.     LINE 4360;1250, 4460;1850
  170.     GOSUB wait_key
  171. LABEL angles2
  172.     RETURN
  173.  
  174. LABEL types
  175.     quest=0:corr=0:incorr=0
  176.     bckgnd=8
  177. LABEL types_1
  178.     BOX 0;0, 8000,5000 FILL ONLY COLOUR 8
  179.     PRINT AT (25;2) COLOUR(7) FONT(2) POINTS(16); "Angle types and sizes"
  180.     PRINT AT (5;4) COLOUR(12);"I shall draw an angle on the screen and then ask which type and"
  181.     PRINT AT (5;5) COLOUR(12);"how big it is. I shall accept answers that are correct to within 10";deg$
  182.     na = RND(4)
  183.     IF na=4 THEN testang = 90:GOTO types_2
  184.     numb = angval(na,2)
  185.     testang=RND(numb) + angval(na,1)
  186. LABEL types_2
  187.     maxang = 360 - testang
  188.     startang = RND(maxang)
  189.     lngth = RND(1000) + 500
  190.     lnx1=3000:lny1=2500
  191.     lnx2=INT(lngth*COS(startang))+3000:lny2=INT(lngth*SIN(startang))+2500
  192.     st = startang:ang=testang+1
  193.     n1 = INT(testang/15)
  194.     IF n1 < 1 THEN n1=1
  195.     GOSUB draw_angle
  196.     BOX 3100;940,690,250 FILL ONLY COLOUR(6)
  197.     SET COLOUR (12)
  198.     INPUT AT (5;18);"What type of angle is this";ans$
  199.     SET COLOUR (2)
  200.     ans$ = LOWER$(ans$)
  201.     IF ans$=names$(na) THEN corr=corr+1:PRINT AT (43;18);"That's right - good":GOTO types_3
  202.     incorr=incorr+1:PRINT AT (43;18);"No, it is ";angnam$(na);" angle"
  203. LABEL types_3
  204.     BOX 4000;720,350,260 FILL ONLY COLOUR(6)
  205.     SET COLOUR (12)
  206.     INPUT AT (5;19);"Can you guess the size of the angle";numb
  207.     SET COLOUR (2)
  208.     IF numb = testang THEN corr=corr+1:PRINT AT (5;20);"Well done - you are exactly right":GOTO types_5
  209.     IF testang-11<numb AND numb<testang+11 AND numb>angval(na,1) AND numb<(angval(na,1)+angval(na,2)) THEN GOTO types_4
  210.     incorr = incorr + 1:PRINT AT (5;20);"No - the angle is ";testang;deg$
  211.     GOTO types_5
  212. LABEL types_4
  213.     corr=corr+1:PRINT AT (5;20);"Near enough - the angle is actually ";testang;deg$
  214. LABEL types_5
  215.     GOSUB set_prompt
  216.     IF try_flag = 0 THEN GOTO types_1
  217.     IF try_flag = 1 THEN RETURN
  218.     RETURN
  219.  
  220. LABEL make
  221.     quest=0:corr=0:incorr=0
  222.     bckgnd=8
  223. LABEL make_1
  224.     BOX 0;0, 8000,5000 FILL ONLY COLOUR 8
  225.     PRINT AT (25;2) COLOUR(7) FONT(2) POINTS(16); "Make Angles"
  226.     n1 = 4: quest = quest + 1: IF quest  > 2 THEN GOTO make_1a
  227.     PRINT AT (5;n1) COLOUR(12);"I shall draw the first line of an angle and say what size angle I want"
  228.     PRINT AT (5;n1+1) COLOUR(12);"You must put in the 2nd line. Move the mouse pointer to a good"
  229.     PRINT AT (5;n1+2) COLOUR(12);"position on the screen and press the left button until the 2nd line"
  230.     PRINT AT (5;n1+3) COLOUR(12);"of the angle is drawn to that point. Move the mouse to adjust the"
  231.     PRINT AT (5;n1+4) COLOUR(12);"angle until you think it is right then press the left button again.":n1 = n1 + 5
  232. LABEL make_1a
  233.     na = RND(4)
  234.     IF na=4 THEN testang = 90:GOTO make_2
  235.     numb = angval(na,2)
  236.     testang=RND(numb) + angval(na,1)
  237. LABEL make_2
  238.     PRINT AT (5;n1);"Make an angle of";testang;deg$
  239.     lngth = RND(1000) + 500
  240.     lnx1=2000:lny1=1800
  241.     lnx2=lnx1+lngth:lny2=lny1
  242.     LINE lnx1;lny1, lnx2;lny2
  243. LABEL make_2a
  244.     REPEAT
  245.         butt = BUTTON(1)
  246.         ky2 = INKEY
  247.     UNTIL butt > -1 OR ky2 = 13
  248.     x1 = CINT(XMOUSE*xconv):y1 = CINT(YMOUSE*yconv)
  249.     IF x1 > 8000 OR y1 > 5000 OR x1 < 1 OR y1 < 1 THEN GOTO make_2a
  250.     LINE lnx1;lny1, x1;y1
  251.     butt = 0
  252.     x2 = x1:y2 = y1
  253.     FOR pause = 1 TO 2000:NEXT pause
  254.     REPEAT
  255.         FOR pause = 1 TO 500:NEXT pause
  256. LABEL make_2b
  257.         x1 = INT(XMOUSE*xconv):y1 = INT(YMOUSE*yconv)
  258.         IF x1 > 8000 OR y1 > 5000 OR x1 < 1 OR y1 < 1 THEN GOTO make_2b
  259.         LINE lnx1;lny1, x2;y2 COLOUR bckgnd
  260.         LINE lnx1;lny1, x1;y1
  261.         x2 = x1:y2 = y1
  262.         butt1 = BUTTON(1):IF butt1 > -1 THEN butt = 1
  263.         ky2 = INKEY: IF ky2 = 13 THEN butt = 1
  264.     UNTIL butt=1
  265.     deg1 = ATAN2((x1-lnx1),(y1-lny1))
  266.     deg1 = INT(deg1)
  267.     IF deg1 < 0 THEN deg1 = 360 + deg1
  268.     acrpt = INT(lngth/2)
  269.     st = 0: ang = deg1: n1 = INT(deg1/15)
  270.     IF n1 < 1 THEN n1 = 1
  271.     PIE lnx1;lny1,acrpt,0,deg1 FILL COLOUR 3
  272.     LINE lnx1;lny1, lnx2;lny2
  273.     LINE lnx1;lny1, x1;y1
  274.     CIRCLE lnx1;lny1,acrpt PART 0,deg1 END 1
  275.     a1 = MAX(testang,deg1):a2 = MIN(testang,deg1)
  276.     IF (a1-a2) < 11 THEN PRINT AT (5;20);"Well done, you have drawn an angle of";deg1;deg$:corr=corr+1:GOTO make_3
  277.     PRINT AT (5;20);"You have drawn an angle of";deg1;deg$:incorr=incorr+1
  278.     PRINT AT (40;20) COLOUR(12);"Here is what it should be"
  279. LABEL make_3
  280.     IF (a1-a2) < 6 THEN GOTO make_4
  281.     ang = testang+1
  282.     lnx1 = 5000: lnx2= 5000+lngth
  283.     n1 = testang
  284.     IF n1 < 1 THEN n1=1
  285.     GOSUB draw_angle
  286.     PRINT AT (65;14) COLOUR(12);"This is";testang;deg$
  287. LABEL make_4
  288.     GOSUB set_prompt
  289.     IF try_flag = 0 THEN GOTO make_1
  290.     IF try_flag = 1 THEN RETURN
  291.     RETURN
  292.  
  293. LABEL wait_press
  294.     REPEAT
  295.         butt = BUTTON(1)
  296.         ky$ = INKEY$
  297.     UNTIL butt > -1 OR ky$ <> ""
  298.     RETURN
  299.  
  300. LABEL done
  301. REM Set flag to show user wishes to quit
  302.     doneflg = 1
  303.     RETURN
  304.  
  305. LABEL draw_angle
  306.     LINE lnx1;lny1, lnx2;lny2
  307.     acrpt=INT((lngth)/2)
  308.     FOR i = 1 TO ang STEP n1
  309.         x1=CINT(lnx1+(lngth*COS(st+i)))
  310.         y1=CINT(lny1+(lngth*SIN(st+i)))
  311.         LINE lnx1;lny1, x1;y1 WIDTH 3
  312.         IF i > (n1+1) THEN LINE lnx1;lny1, x2;y2 COLOUR bckgnd
  313.         IF i < 3 THEN GOTO draw_1
  314.         CIRCLE lnx1;lny1, acrpt, PART st,st+i-1
  315. LABEL draw_1
  316.         IF i = ang THEN GOTO draw_2
  317.         x2=x1:y2=y1
  318.         CIRCLE lnx1;lny2, acrpt PART st,st+i-1 COLOUR bckgnd
  319. LABEL draw_2
  320.     NEXT i
  321.     x1=CINT(lnx1+(lngth*COS(st+ang)))
  322.     y1=CINT(lny1+(lngth*SIN(st+ang)))
  323.     LINE lnx1;lny1, x2;y2 COLOUR bckgnd
  324.     PIE lnx1;lny1,acrpt,st,st+ang-2 FILL COLOUR 3
  325.     LINE lnx1;lny1, lnx2;lny2
  326.     LINE lnx1;lny1, x1;y1
  327.     CIRCLE lnx1;lny1, acrpt, PART st,st+ang-2 END 1
  328.     RETURN
  329.  
  330. LABEL wait_key
  331.     PRINT AT (10;21);"Press any key to continue"
  332.     REPEAT
  333.         ky$=INKEY$
  334.         butt = BUTTON(1)
  335.     UNTIL ky$<>"" OR butt > -1
  336.     RETURN
  337.  
  338. LABEL set_prompt
  339.     PRINT AT (50;9);"Score:";corr;"right out of";(incorr+corr)
  340. LABEL set_pr2
  341.     PRINT AT (5;21);"Enter C to continue, E to end the test, or Q to quit the program"
  342.     REPEAT
  343.         ky$ = INKEY$
  344.     UNTIL ky$ <> ""
  345.     IF ky$ = "c" OR ky$ = "C" THEN try_flag = 0:GOTO set_pr3
  346.     IF ky$ = "e" OR ky$ = "E" THEN try_flag = 1:GOTO set_pr3
  347.     IF ky$ = "q" OR ky$ = "Q" THEN GOTO finish
  348.     ALERT 1 TEXT "No, enter C, E, or Q" BUTTON RETURN "Press return to continue"
  349.     GOTO set_pr2
  350. LABEL set_pr3
  351.     RETURN
  352.  
  353. LABEL calcmse
  354.     k1 = 0
  355.     x1 = INT(XMOUSE * xconv):y1 = INT(YMOUSE * yconv)
  356.     IF x1 < 4800 OR x1 > 5600 OR y1 < 2400 THEN GOTO calc_1
  357.     IF y1 < 2800 THEN k1 = 2:GOTO calc_1
  358.     IF y1 < 2900 THEN GOTO calc_1
  359.     IF y1 < 3290 THEN k1 = 1
  360. LABEL calc_1
  361.     RETURN
  362.  
  363.  
  364. LABEL calcmouse
  365.     k1 = 0
  366.     x1 = INT(XMOUSE * xconv):y1 = INT(YMOUSE * yconv)
  367.     IF x1 < 4900 OR x1 > 5300 OR y1 < 2400 THEN GOTO calc_2
  368.     IF y1 < 2800 THEN k1 = 3:GOTO calc_2
  369.     IF y1 < 2900 THEN GOTO calc_2
  370.     IF y1 < 3290 THEN k1 = 2:GOTO calc_2
  371.     IF y1 < 3380 THEN GOTO calc_2
  372.     IF y1 < 3730 THEN k1 = 1
  373. LABEL calc_2
  374.     RETURN
  375.  
  376.