1 VER = 13.38: 'LENSVGA.BAS, simulation of ideal lens and mirror equation. 2 'By Donald E. Simanek, http://www.lhup.edu/~dsimanek 5 'Now returns to 440; where you left off, when you decline to exit. 6 'Construction rays shown dotted at 3501, 3701. Toggles DI, DE. 2/22/01 7 'Maximum number of rays is now 17 instead of 29. 8 'Rayburst for infinite object now works. 2/13/01 9 'Best rayburst routine 2/12/01, lines 3997-5000 10 'Changed 3830 VINF to VTOP to trap infinite image arrow, 2/2/01 11 'overflow in R bug fixed at 1718, 1719, 2/2/01 12 'p=f bug fixed at 3535-3580, 1/29/01 14 'Variable MIRROR changed to M 1/7/01. 15 'Computer-compatible Microsoft Basic version 1/5/01. 16 'Lens arc glitch fixed 1/5/01: IF F>5 GOTO 1735 17 'p=infinity glitch fixed, 1/5/01. Lines near 1500 18 'Finally enabled scrolling mirror, lines with '' and 3800 and 3580. 1/7/01. 20 'ASPECT now used in place of VCOMP for CIRCLE commands. 21 'Routine for SANYO555 native basic CIRCLE command syntax. 22 'Shape of lens shown as icon. Lines 92, 1721-1728. 4/10/91 23 'Rayburst routine works, logic not elegant. 25 'Variable horiz scale. Variable vertical size. 28 'For Tandy 2000, Sanyo 555, ATT 6300, Xerox 6064, IBM-PC, CGA, EGA, VGA. 30 'VGA suport in screen 12. VGA not supported by the Basic interpreter. 31 'Tandy 2000 will not run programs compiled with QuickBasic! 32 'Can be run or compiled with QuickBasic. Don't use Turbo Basic. 33 'Error trapping used; compile with BC /O /E /X and link with /E. 50 'Toggle text on/off. Select number of rays, 3, 5, 7 or 15. 70 'Switch for Cartesian or optical sign convention. 80 'Magnification = - (image size)/(object size) 85 'Future development: 90 'Traps are complete for off-screen graphic points, except for 91 'incident rays. These ought to be trapped at top/bottom of screen. 92 'This can cause problems on a very few computers. To test whether 93 'it does, enter a virtual object such that incident rays hit 94 'screen edges. If they are drawn improperly, activate 95 'line 3496 as a temporary "fix". 99 TWOPI = 6.283186: PI = TWOPI/2: 'Needed for lens icon, lines 1721-1728. 100 CLS : SCREEN 2: ASPECT = 1 101 'Default screen, recognized by all computers and display modes. 110 'To configure this program for a specific computer, remove line 150 120 'and the subroutine at lines 2400-2960. Replace line 150 with two lines 130 'from that subroutine: line 2510, and the line which has the screen code 140 'and vertical pixel height for your computer's screen display. 150 GOSUB 2400: 'DETERMINE COMPUTER TYPE 160 SCREEN SCRN: CLS : LOCATE 1, 1, 0: 'Clear screen, hide the cursor 170 H = 640: AXIS = V/2: 'Screen width in pixels and vertical position of axis. 180 SCT = 1: 'Sign convention toggle, -1 is Cartesian, +1 is 'optical' convention 185 TT = 1: 'Text toggle, +1 shows text on screen, -1 shows graphics only 187 IT = 1: 'Interrupted drawing toggle, 1 is normal, -1 is interrupted 190 DLY = 2000: 'For time-waster subroutine; used in opening help screen. 200 PMF = .000001: 'Minimum value for P-F; assume P=F and image at infinity. 210 VINF = 9E+33: VTOP = 9000: 'Assigned value and cut-off for infinity. 220 DIAM = V/8: HD = DIAM/2: 'Default lens diameter and half-diameter 230 OH = DIAM/2: 'Object height default 240 MARKS = 10: 'Number of axis divisions shown. 250 M = 1: '1 is lens, -1 is mirror 260 QUIET = 1: '1 shows on-screen menu items, -1 suppresses them. 270 VT = -1: HT = -1: 'Vertical & horiz size toggle code; 1 is enlarged, -1 is small. 280 VR = 1/4: 'Amount of vertical reduction toggle if VT=1. 285 RB = -1: 'Rayburst effect off, +1 is on. 290 N = 1: '2*N+1 is default number of rays drawn. Use 1, 2, 4 or 8 299 'Variable LENS is the anchor point for all graphics 300 LENS = H/2: 'Initial position of lens from left edge of screen 310 S$ = "####.###": 'For PRINT USING statements in data display. 311 IFULL=1 :'Rayburst cut-off toggle, 0 gives full 2 pi coverage 312 EF=-1 :'Freshman equation toggle off, uses "w". 313 DE=-1 : DI=-1 :'Dotted line toggles for incident/emergent rays. 320 ' 330 ' **** Initial explanation and help screen 340 ' 341 IF R$ = "g" GOTO 420: '[g]o right to program, bypass help screen 351 ' (inkey occured in subroutine to determine computer type) 352 ' **** Opening demo, for instructor only, if "i" was pressed above. 353 ' 354 IF R$ = "i" THEN 355 ELSE 365 : 'Press i for instructor's demo routine 355 N = 2: OH = 0: IJ = 1: MARKS = 10: TT = -1: QUIET = -1 : IFULL=0 356 RB = 1: P = 4: XP = LENS - H * P / MARKS: Y0 = AXIS: GOSUB 4000: 'Rayburst effect 357 R$ = INKEY$: IF R$ = "" THEN 357 358 IFULL=1 :'Reset rayburst cut-off toggle. 359 'Rest of opening routine goes here someday. 360 GOTO 430 363 ' 364 ' **** Show help screen. 365 F = 2: P = 4: Q = 4: SCALE = H / MARKS: 'Values for help screen drawing 370 IH = OH: XQ = LENS + SCALE * Q: XP = LENS - SCALE * P 380 GOSUB 2980: 'Help information 390 ' 400 ' **** Draw new screen 410 ' 420 M = 1: OH = DIAM/2: HD = DIAM/2: IJ = 1: VT = -1: MARKS = 10: N = 1: QUIET = 1: TT = 1: IT = 1: 'Reset ALL defaults 430 LENS = H/2: F = 2: P = 4: Q = 4: 'Reset default P,Q,F values, put lens in center screen 440 CLS : 'Return here each time a new screen is to be drawn. 450 SCALE = H/MARKS: 'pixel distance between marked units on horizontal axis 460 ''IF M=-1 THEN LENS=H/2:'No L/R shift allowed (yet) in mirror simulation. 470 ' 480 ' **** Print lens/mirror information text below graphic 490 ' 500 IF ABS(F) > VTOP THEN 510 ELSE 520 510 LOCATE 20 + IV, 36: PRINT " FLAT ": GOTO 550 520 IF F > 0 THEN 530 ELSE 540 530 LOCATE 20 + IV, 36: PRINT "CONVERGING": GOTO 550 540 LOCATE 20 + IV, 36: PRINT " DIVERGING" 550 IF M = -1 THEN 560 ELSE 570 560 LOCATE 21 + IV, 38: PRINT "MIRROR": GOTO 610 570 LOCATE 21 + IV, 39: PRINT "LENS" 580 ' 590 ' **** Print command menu lines, top and bottom of screen. 600 ' 610 IF TT = -1 GOTO 700: 'Suppress information text 615 IF QUIET = -1 GOTO 700 620 LOCATE 3, 1: PRINT "L and R cursor keys move object arrow. < and > scroll display"; 630 LOCATE 22 + IV, 1: PRINT ",

or to enter values, help, to DOS, exit. 640 LOCATE 23 + IV, 1: PRINT "<0> resets P and F defaults, resets all defaults."; 650 LOCATE 24 + IV, 1: PRINT "Toggles: lens/mirror, <-> sign of F, vertical size, horiz scale."; 660 LOCATE 25 + IV, 1: PRINT " no text, equation, clear prompts, <8> enter infinity. Ver."; VER; 670 ' 680 ' **** Lens equation calculations 690 ' 700 IF ABS(P) < .01 THEN P = 0: Q = 0: RP = VINF: RQ = VINF: MAG = 1: GOTO 790: 'P=0 exception 710 IF ABS(P) > VTOP THEN RP = 0 ELSE RP = 1 / P 720 IF ABS(F) > VTOP THEN RF = 0 ELSE RF = 1 / F 730 IF ABS(F) > VTOP THEN F = VINF: '''RF = 0 :'Needed? 740 RQ = RF - RP: IF ABS(RQ) < 1 / VTOP THEN 750 ELSE 770: 'Standard sign convention. 750 IF RP = 0 AND RF = 0 THEN Q = VINF: RQ = 0: MAG = -M: GOTO 790 760 Q = VINF: MAG = VINF: GOTO 790 770 Q = 1 / RQ: MAG = -RP / RQ: 'Calculate Q and magnification. 780 IF ABS(MAG) > VTOP THEN MAG = VINF 790 IF TT = -1 GOTO 810 795 GOSUB 1970: 'to print data lines at top of screen. 800 GOSUB 2180: 'to print information at left of screen. 810 ''''locate 4,1:print "F,P,Q,M are";f;p;q;mag :'for debugging 811 ''''locate 5,1:print "RF,RP,RQ are"; rf;rp;rq:'for debugging 820 ' 830 ' **** Calculate values needed for ray drawing on screen 840 ' 850 IH = -MAG * OH 860 XQ = LENS + SCALE * Q 870 XP = LENS - SCALE * P 880 ' 890 ' **** Draw graphic part of the display. 900 ' 910 GOSUB 1710: 'Draw the lens/mirror and the axis. 911 '''locate 6,1: PRINT " ":'suppresses overflow 915 IF RB = 1 THEN 916 ELSE 917 :' Was 920'Detect rayburst toggle. 916 IF P > 0 THEN GOSUB 4000: 'Draw rayburst if object real. 917 IF EF=1 THEN GOSUB 5100 :'To display lens equation on screen. 920 GOSUB 3230: 'Draw the rest of the ray diagram. 930 ' 940 ' **** Keyboard command entry, reset codes, escape (quit). 950 ' 960 R$ = INKEY$: IF R$ = "" THEN 960: 'Waits for key input 965 ''''locate 6,1: PRINT "Key ";R$;" pressed ":'debugging 970 B = ASC(RIGHT$(R$, 1)) 980 IF B = 48 GOTO 430: 'ZERO resets default P,Q,F conditions 990 IF B = 47 GOTO 420: '/ resets ALL default conditions. 1000 IF B = 27 GOTO 1640: 'Escape key to exit 1010 ' 1020 ' *** Draw display without text 1030 ' 1040 IF R$ = "d" THEN CLS : GOTO 840: '[g]raphic display once only, without menu text 1050 ''IF R$ = "r" THEN CLS : GOTO 440: '[r]ewrite display 1059 IF R$ = "g" THEN TT = -TT: GOTO 440: 'Suppress all text, toggle. 1060 IF R$ = "c" THEN QUIET = -QUIET: GOTO 440: '[c]lean display, no menu prompts. 1061 IF R$ = "s" THEN SCT = -SCT: GOTO 440: 'Change sign convention, toggle. 1062 IF R$ = "`" THEN IT = -IT: GOTO 440: 'Toggle for interrupted drawing. 1063 IF R$ = "a" THEN OH = 0: GOTO 440: 'Set object height zero. 1064 IF R$ = "b" THEN OH = HD: GOTO 440: 'Set object height to default 1065 IF R$ = "*" THEN RB = -RB: GOTO 440: 'Rayburst toggle 1066 IF R$ = "x" THEN CLS : SHELL: GOTO 440 : 'Shell to DOS 1067 IF R$ = "'" THEN DI = -DI : GOTO 440 :'Dotted line toggle for ext emergent. 1068 IF R$ = ";" THEN DE = -DE : GOTO 440 :'Dotted line toggle for ext incident. 1071 IF R$ = "w" THEN EF=-EF : GOTO 440 :'Freshman equation toggle 1072 ' 1090 ' 1091 ' **** Scroll diagram left or right using comma and period keys. 1092 ' 1100 ''IF M=-1 GOTO 1170:'No shift allowed for mirror simulation. 1110 IF B = 44 THEN LENS = LENS - SCALE: GOTO 440: 'Comma pressed 1120 IF B = 46 THEN LENS = LENS + SCALE: GOTO 440: 'Period pressed 1130 IF R$ = "z" THEN LENS = H / 2: GOTO 440: 'Restore lens to zero at center of screen 1140 ' 1150 ' **** Cursor control codes, increment size, focal length, object size. 1160 ' 1170 IF B = RIGHT THEN P = P - IJ: GOTO 440: 'Right arrow, object moves right 1180 IF B = LEFT THEN P = P + IJ: GOTO 440: 'Left arrow, object moves left 1190 IF B = UP THEN OH = OH + HD / 3: GOTO 440: 'longer object 1200 IF B = DOWN THEN OH = OH - HD / 3: GOTO 440: 'shorter object 1210 IF B = 49 THEN IJ = .1: GOTO 1260: 'One (.1 unit increment) 1220 IF B = 50 THEN IJ = .5: GOTO 1260: 'Two (.5 unit increment) 1230 IF B = 51 THEN IJ = 1: GOTO 1260: 'Three (1 unit increment) 1240 IF B = 52 THEN IJ = 5: GOTO 1260: 'Four (5 unit increment) 1250 GOTO 1270 1260 LOCATE 2, 47: PRINT USING "##.#"; IJ; : GOTO 960 1270 IF B = 53 THEN N = 1: GOTO 440: 'Three (3 rays displayed) 1280 IF B = 54 THEN N = 2: GOTO 440: 'Five (5 rays displayed) 1290 IF B = 55 THEN N = 4: GOTO 440: 'Seven (7 rays displayed) 1300 IF R$ = "!" THEN N = 6: GOTO 440: '13 rays displayed 1310 ' 1320 ' **** Routine to enter infinite values after pressing 8. 1330 ' 1340 'IF P=0 THEN LOCATE 17+IV,1:PRINT "Enter a NONZERO object distance.":GOTO 1440:'P=0 trap 1350 IF B = 56 GOTO 1360 ELSE 1430: 'Pressed 8 key. 1360 LOCATE 5, 1: INPUT "Infinite P, Q or F"; T$ 1370 IF T$ = "p" THEN P = VINF: GOTO 440 1380 IF T$ = "f" THEN F = VINF: GOTO 440 1390 IF T$ = "q" THEN Q = VINF: GOTO 1500 1391 GOTO 1360 1400 ' 1410 ' **** Direct numeric entry of P, Q or F values. 1420 ' 1430 IF R$ = "p" OR R$ = "o" THEN 1440 ELSE 1450 1440 LOCATE 5, 1: INPUT ; "Object distance = "; P: P = SCT * P: GOTO 440 1450 IF R$ = "f" THEN 1460 ELSE 1470 1460 LOCATE 5, 1: INPUT ; "Focal length = "; F: IF F = 0 GOTO 1460 ELSE 440: 'F=0 not allowed. 1470 IF R$ = "q" OR R$ = "i" THEN 1480 ELSE 1560 1480 LOCATE 5, 1: INPUT ; "Image distance = "; Q: IF Q = 0 GOTO 1480 1499 'Next few lines were fixed Jan 5, 2000 1500 IF ABS(Q) > VTOP THEN Q = VINF 1505 IF ABS(P) > VTOP THEN P = VINF 1510 IF ABS(P + Q) < 1 / VTOP THEN F = VINF: GOTO 440: 'Object and image coincident 1520 F = P * Q / (P + Q): GOTO 440: 'Calculate a new focal length 1530 ' 1540 ' **** Toggles for lens sign, vertical size, mirror. 1550 ' 1560 IF R$ = "m" THEN M = -M: GOTO 440: 'Mirror/lens toggle 1570 IF R$ = "v" THEN VT = -VT: GOSUB 1800: GOTO 440: 'Reduce or restore vertical size 1580 IF R$ = "h" THEN HT = -HT: GOSUB 1850: GOTO 440: 'Enlarge or restore horizontal scale 1590 IF B = 45 THEN 1600 ELSE 1620: 'Minus key to toggle lens sign. 1600 IF ABS(F) < VTOP THEN 1610 ELSE 440 1610 F = -F: GOTO 440: 'Change lens sign if not infinite. 1620 IF B = 63 THEN DLY = 0: CLS : GOSUB 2980: GOTO 440: '? For help screen 1630 GOTO 960: 'if invalid key pressed 1637 ' 1638 ' **** Exit the program. 1639 ' Pressing the escape key branches to next statement 1640 CLS : LOCATE 12, 20: PRINT "Do you really want to quit [y/N]?" 1650 R$ = INKEY$: IF R$ = "" GOTO 1650 1660 IF R$ = "y" OR R$ = "Y" THEN 1670 ELSE 440: 'Exit/restart 1670 CLS : SYSTEM: 'Exit the program 1680 ' 1690 ' **** Axis and lens drawing subroutine 1700 ' 1710 LINE (0, AXIS)-(H, AXIS) : 'axis 1715 LINE (LENS, AXIS - HD)-(LENS, AXIS + HD): 'line representing lens 1716 IF M = -1 GOTO 1735: 'Begin drawing of lens curves, not mirror. 1717 FL = ABS(F * SCALE) 1718 IF FL > VTOP GOTO 1735 1719 R = SQR(FL ^ 2 + (HD / ASPECT) ^ 2) 1723 SAG = R - FL: IF F < 0 THEN R = FL - SAG: 'SAGitta 1724 HANG = ATN(HD / (ASPECT * (R - SAG))) 1725 IF VT = 1 OR HT = 1 GOTO 1735: 'Don't draw lens in magnified modes 1726 IF F > 5 GOTO 1735: 'Don't draw lens if R too large 1728 IF HARDWARE = 1 GOTO 1731: 'Sanyo555 native DOS basic. 1729 CIRCLE (LENS - FL, AXIS), R, , TWOPI - HANG, HANG, ASPECT 1730 CIRCLE (LENS + FL, AXIS), R, , PI - HANG, PI + HANG, ASPECT: GOTO 1735 1731 CIRCLE (LENS - FL, AXIS), R, 1 - HANG / TWOPI, HANG / TWOPI, ASPECT 1732 CIRCLE (LENS + FL, AXIS), R, ((PI - HANG) / TWOPI), ((HANG + PI) / TWOPI), ASPECT: 'End lens curve draw 1735 FOR I = -MARKS / 2 TO MARKS / 2 1740 LINE (H / 2 + I * SCALE, .49 * V)-(H / 2 + I * SCALE, .51 * V) 1750 NEXT I 1760 RETURN 1770 ' 1780 ' **** Routine to reduce and restore vertical size 1790 ' Removed the GOTO 440 from each line, added RETURN 1800 IF VT = -1 THEN OH = OH * VR: HD = HD * VR: 'Vertical reduction 1810 IF VT = 1 THEN OH = OH / VR: HD = HD / VR: 'Restore vertical sizes 1811 RETURN 1820 ' 1830 ' **** Routine to enlarge and restore horizontal scale 1840 ' Removed the GOTO 440 from each line, added RETURN 1850 IF HT = -1 THEN MARKS = 10: 'Ten horizontal units shown 1860 IF HT = 1 THEN MARKS = 30: 'Thirty horizontal units shown 1861 RETURN 1870 ' 1880 ' **** Time waster subroutine 1890 ' 1900 FOR I = 1 TO DLY: J = DLY - I 1910 IF INKEY$ = "" THEN 1920 ELSE GOTO 1930 1920 NEXT I 1930 RETURN 1940 ' 1950 ' **** Subroutine to print display lines at top of screen. 1960 ' Uses P, F, Q, MAG, VTOP 1970 LOCATE 1, 1: PRINT "F ="; 1990 IF ABS(F) > VTOP THEN 2000 ELSE 2010 2000 PRINT "infinite"; : GOTO 2020 2010 PRINT USING S$; F; 2020 PRINT ", Object distance ="; 2030 IF ABS(P) > VTOP THEN 2040 ELSE 2050 2040 PRINT "infinite"; : GOTO 2060 2050 PRINT USING S$; P * SCT; 2060 PRINT ", Image distance ="; 2070 IF ABS(Q) > VTOP THEN 2080 ELSE 2090 2080 PRINT "infinite"; : GOTO 2100 2090 PRINT USING S$; Q 2100 LOCATE 2, 1: PRINT "Magnification = "; 2110 IF ABS(MAG) > VTOP THEN 2120 ELSE 2130 2120 PRINT "infinite"; : GOTO 2135 2130 PRINT USING S$; MAG 2135 IF SCT = -1 THEN LOCATE 2, 35: PRINT "CARTESIAN"; 2140 RETURN 2150 ' 2160 ' **** Subroutine to print information at left of screen 2170 ' Uses P, Q, MAG, IJ 2180 LOCATE 2, 47: PRINT USING "##.#"; IJ; : PRINT " unit movement" 2190 IF P = 0 GOTO 2200 ELSE 2230 2200 LOCATE 18 + IV, 1: PRINT "Object and image" 2210 LOCATE 19 + IV, 1: PRINT "are coincident" 2220 LOCATE 20 + IV, 1: PRINT "at the lens position."; : GOTO 2350 2230 LOCATE 17 + IV, 1: IF P > 0 THEN PRINT "REAL object." ELSE PRINT "VIRTUAL object." 2240 IF Q > VTOP THEN 2250 ELSE 2280 2250 LOCATE 18 + IV, 1: PRINT "Image is real and/or virtual." 2260 LOCATE 19 + IV, 1: PRINT "Rays emerge from the lens" 2270 LOCATE 20 + IV, 1: PRINT "in a parallel bundle."; : GOTO 2350 2280 IF Q < 0 THEN 2290 ELSE 2320 2290 LOCATE 18 + IV, 1: PRINT "VIRTUAL image." 2300 LOCATE 19 + IV, 1: PRINT "Emergent rays diverge" 2310 LOCATE 20 + IV, 1: PRINT "FROM the image arrowhead."; : GOTO 2350 2320 LOCATE 18 + IV, 1: PRINT "REAL image." 2330 LOCATE 19 + IV, 1: PRINT "Emergent rays converge" 2340 LOCATE 20 + IV, 1: PRINT "TO the image arrowhead." 2350 RETURN 2360 ' 2370 ' **** Subroutine to determine computer type 2380 ' 2390 'Automatic sensing of computer and screen display. Subroutine begins here. 2400 ON ERROR GOTO 2970 2405 LOCATE 1, 1: PRINT "ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»" 2410 LOCATE 2, 1: PRINT "º LENS, by Dr. Donald E. Simanek º" 2420 LOCATE 3, 1: PRINT "º Thin lens ray tracing simulation º" 2430 LOCATE 4, 1: PRINT "º º" 2440 LOCATE 5, 1: PRINT "º http://www.lhup.edu/~dsimanek º" 2450 LOCATE 6, 1: PRINT "ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ" 2460 LOCATE 2, 50: PRINT "ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»" 2470 LOCATE 3, 50: PRINT "º 1 1 1 º" 2480 LOCATE 4, 50: PRINT "º - + - = - º" 2490 LOCATE 5, 50: PRINT "º P Q F º" 2500 LOCATE 6, 50: PRINT "ÈÍÍÍÍÍÍÍÍÍÍÍÍÍͼ" 2505 LOCATE 10, 1: PRINT "Checking your computer and graphic screen." 2510 RIGHT = 77: LEFT = 75: UP = 72: DOWN = 80: 'Cursor keys, all except Sanyo 555 2520 DEF SEG = 0: HARDWARE = PEEK(&H410): MODE = HARDWARE AND 48 2530 LOCATE 12, 1: PRINT "Hardware code ="; HARDWARE 2540 ADAPTER = PEEK(&H487): 'Test for mono or color EGA card. 2550 LOCATE 13, 1: PRINT "Adapter code = "; ADAPTER: PRINT 2559 IF ADAPTER = 96 GOTO 2760: 'VGA 2560 IF HARDWARE = 111 GOTO 2650: 'Mono or color EGA, find out which 2570 IF HARDWARE = 125 GOTO 2680: 'PC with no graphics card 2580 IF HARDWARE = 99 GOTO 2660: 'Tandy 3000 2590 'IF HARDWARE= 97 GOTO 2760 :'VGA display adapter 2591 IF ADAPTER = 97 GOTO 2730: 'EGA display adapter 2600 IF HARDWARE = 109 GOTO 2790: 'Xerox 6064 2610 IF HARDWARE = 92 GOTO 2740: 'Tandy 2000 2620 IF HARDWARE = 1 GOTO 2780: 'Sanyo 555, original MS-DOS 2630 IF HARDWARE = 236 GOTO 2750: 'Sanyo 555, with video card, DS-DOS 2640 GOTO 2750: 'Default to IBM CGA if no codes match. 2650 IF ADAPTER = 0 GOTO 2710 ELSE 2730: 'Zero is Persyst BoB display 2660 PRINT "Tandy 3000": V = 200: SCRN = 2: ASPECT = 5 / 12: GOTO 2800 2670 'IBM with no graphics card, error message to user. 2680 LOCATE 19, 1: PRINT "This program requires a graphics card." 2690 LOCATE 21, 1: PRINT "Press any key to exit." 2700 R$ = INKEY$: IF R$ = "" GOTO 2700 ELSE CLS : SYSTEM 2710 PRINT "Persyst BoB high res graphics.": V = 200: SCRN = 2: ASPECT = 5 / 12: IV = 0: GOTO 2800 2720 'Use CGA with Persyst board. 2730 PRINT "EGA graphics.": V = 350: SCRN = 9: IV = 0: GOTO 2800 2740 PRINT "Tandy 2000 high res graphics.": V = 400: SCRN = 3: ASPECT = .9: IV = 0: GOTO 2800 2750 PRINT "CGA graphics.": V = 200: SCRN = 2: ASPECT = 5 / 12: IV = 0: GOTO 2800 2760 PRINT "VGA graphics.": V = 480: SCRN = 12: ASPECT = 1: IV = 5: GOTO 2800 2780 PRINT "Sanyo 555 graphics": V = 200: SCRN = 2: ASPECT = .5080001: IV = 0: RIGHT = 29: LEFT = 28: UP = 30: DOWN = 31: GOTO 2800 2790 PRINT "Xerox 6064 or ATT 6300 high res graphics": V = 400: SCRN = 100: ASPECT = .9: IV = 0: GOTO 2800 2800 PRINT : PRINT "At the prompt type to accept hardware choice, to select a" 2801 PRINT "different one, or to go directly into program, bypassing help screen." 2802 PRINT : INPUT "Is the screen graphics choice correct? [Y/n/g]", R$ 2812 IF R$ = "N" OR R$ = "n" GOTO 2820 ELSE 2960: 'to test screen mode 2820 CLS : 'User selection of graphics adaptor 2830 RIGHT = 77: LEFT = 75: UP = 72: DOWN = 80: 'Cursor keys, all except Sanyo 555 2840 PRINT "Select computer and display adaptor from this list:": PRINT 2850 PRINT "1 IBM PC, XT, AT and compatibles with CGA" 2860 PRINT "2 Same with EGA color graphics card" 2870 PRINT "3 Xerox 6064 or ATT 6300, monochrome high resolution" 2880 PRINT "4 Tandy 2000, monochrome high resolution" 2890 PRINT "5 Sanyo 555, native MS-DOS" 2900 PRINT "6 Sanyo 555, CGA graphics, DS-DOS" 2910 PRINT "7 VGA graphics adapter" 2920 R$ = INKEY$: IF R$ = "" THEN 2920 2930 ICHOOSE = ASC(R$) - 48 2940 PRINT : PRINT "Configuring program for" 2950 ON ICHOOSE GOTO 2750, 2730, 2790, 2740, 2780, 2750, 2760 2960 SCREEN SCRN: 'Test to see if screen mode gives error 2961 IF IE = 1 THEN IE = 0: GOTO 2830: 'Reset error flag and choose another screen 2962 ON ERROR GOTO 0 2968 RETURN 2969 ' **** Error handler for "Illegal Function Call" due to wrong screen mode 2970 SCREEN 2: CLS : IE = 1: 'Set flag to indicate error occured 2971 PRINT "Your interpreter or compiler doesn't recognize" 2972 PRINT "the selected screen mode.": 2973 PRINT 2974 RESUME NEXT 2979 ' 2980 ' **** Help information screen 2990 ' 3000 LOCATE 1, 1: PRINT "THIN LENSES AND MIRRORS, Ver."; VER; " By Donald Simanek " 3010 LOCATE 3, 1: PRINT "This program draws paraxial ray diagrams for a thin lens or mirror." 3020 GOSUB 1710: 'Draw the lens/mirror and the axis. 3030 GOSUB 1710: LOCATE 16 + .6 * IV, 39: PRINT "LENS": GOSUB 1900 3040 LOCATE 4, 1: PRINT "The optic axis of the lens shows length units and the lens' focal points." 3050 LOCATE 5, 1: PRINT "The 'object' is shown as an arrow. Rays are drawn from arrowhead through lens." 3060 GOSUB 3230: 'Draw the rest of the ray diagram. 3070 LOCATE 15 + .6 * IV, 24: PRINT "F": LOCATE 15 + .6 * IV, 57: PRINT "F": GOSUB 1900 3080 LOCATE 14 + .6 * IV, 6: PRINT "OBJECT" 3090 LOCATE 6, 1: PRINT "Rays will ALWAYS pass through the lens from left to right." 3100 LOCATE 18 + IV, 1: PRINT "Set CAPS LOCK off. Don't enter values greater than 3E33."; : GOSUB 1900 3110 LOCATE 20 + IV, 1: PRINT "A menu of keyboard commands will be shown at the bottom of the screen." 3120 LOCATE 21 + IV, 1: PRINT "You can toggle the menu on/off at any time by pressing the letter ." 3130 LOCATE 22 + IV, 1: PRINT "Press the key to quit the program. Press to recall this help screen." 3140 LOCATE 23 + IV, 1: PRINT "Press to change the vertical size, to change the horizontal size." 3150 LOCATE 25 + IV, 20: PRINT "==> Press any key to begin. <=="; 3160 IF INKEY$ = "" GOTO 3160 3170 RETURN 3180 ' 3190 ' **** Subroutine to construct the ray drawing. 3200 ' 3210 ' **** Draw the focal points on the axis, if on-screen 3220 ' 3230 IF ABS(F) > 30 GOTO 3310 3231 XF = LENS - ABS(F) * SCALE: IF XF < 0 GOTO 3245 3240 LINE (XF, .47 * V)-(XF, .53 * V) 3245 XF = LENS + ABS(F) * SCALE: IF XF > H GOTO 3260 3250 LINE (XF, .47 * V)-(XF, .53 * V) 3260 IF ABS(P) < .01 GOTO 3270 ELSE 3310: 'when object very near lens. 3270 P = 0: Q = 0: IH = -OH: XP = LENS: XQ = LENS: GOTO 3830: 'plot image arrow only 3280 ' 3290 ' **** Draw object arrow (if on screen) 3300 ' 3310 IF ABS(OH) > V / 2 GOTO 3400: 'Don't draw obj arrow larger than screen 3315 IF XP < 0 OR XP > H GOTO 3410: 'Off screen left or right 3320 LINE (XP, AXIS)-(XP, AXIS - 9 * OH / 10) 3330 HL = XP - H / 100: IF HL < 0 THEN HL = 0 3340 LINE (HL, AXIS - .9 * OH)-(XP + H / 100, AXIS - .9 * OH) 3350 LINE (HL, AXIS - .9 * OH)-(XP, AXIS - OH) 3360 LINE (XP + H / 100, AXIS - .9 * OH)-(XP, AXIS - OH) 3370 PAINT (XP, AXIS - .95 * OH) 3380 ' 3390 ' **** Draw incident rays; uses XP, LP, XQ, AXIS, IH, OH, LENS, P, F 3400 ' IT=-1 is the toggle for interrupted ray trace mode. 3410 FOR DISP = -HD TO HD STEP HD/N 3420 IF IT = -1 THEN 3421 ELSE 3425 3421 R$ = INKEY$: IF R$ = "" THEN 3421: 'Interrupt ray drawing 3422 IF R$ = "e" THEN LOCATE 21 + IV, 60: PRINT "Enter a command"; : GOTO 3890: 'to enter command 3425 X0 = XP: LP = AXIS + DISP: Y0 = AXIS 3430 IF XP < 0 THEN 3440 ELSE 3460: 'Trap rays off left side of screen 3440 X0 = 0: Y0 = AXIS - XP * (DISP + OH)/(LENS - XP) 3460 Y0 = Y0 - OH: 'Corrects for object height 3470 IF P > 0 GOTO 3500: 'Bypass virtual object routine if object real. 3480 HLEN = 1.5 * SCALE: 'Length of incident rays shown for virtual object case 3490 Y0 = LP + HLEN * (LP - Y0)/(X0 - LENS): X0 = LENS - HLEN: 'Virtual object exception 3491 'BUG! Off-screen incident ray segments shouldn't be allowed. 1492 'This causes problems on some computers, which will require the temporary 1493 'fix on the next line. Most computers don't need this line. 3496 'IF Y0<0 or Y0>V GOTO 3520:'Prevents error due to this bug. 3500 LINE (X0, Y0)-(LENS,LP): 'Ray from object to lens. 3501 'Dotted construction lines, ext of incident rays. Rays trapped only at right. 3503 IF DE=-1 THEN 3510 3504 IF LENS<=0.001 or LENS=>H GOTO 3510 3506 YD = LP + (H-LENS)*(LP-Y0)/(LENS-X0) :GOTO 3508 3508 LINE -(H,YD),,,&HFF00 3509 ' 3510 ' **** Calculate and draw the emergent rays in all cases. 3511 ' 3520 IF IT = -1 THEN 3521 ELSE 3535 :'Interrupted ray toggle. 3521 R$ = INKEY$: IF R$ = "" THEN 3521: 'Interrupted ray drawing. 3522 IF R$ = "e" THEN LOCATE 21 + IV, 60: PRINT "Enter a command"; : GOTO 3890: 'Exit sub to enter command. 3525 ' 3530 ' **** Calculate YN and TY 3531 ' 3535 IF ABS(Q) < VTOP THEN 3580: 'Next lines handle image at infinity. 3536 TY = LP + OH * (((1 + M) / 2) * H - M * LENS) / (LENS - XP) 3537 GOTO 3630 3580 YN = (DISP - IH) * (((1 + M) / 2) * H - M * LENS) / (SCALE * Q): 'y disp 3590 TY = LP - YN: 'Coordinate where rays hit right of screen 3600 ' 3610 ' **** Trap emergent ray if off top or bottom of screen 3620 ' 3630 HH = H: IF M = -1 THEN HH = 0: ' **** Mirror toggle 3640 IF TY < 0 THEN 3650 ELSE 3670: 'Hits top of screen 3650 HN = LENS + (HH - LENS) * (AXIS + DISP) / (AXIS + DISP - TY) 3660 LINE (LENS, LP)-(HN, 0): GOTO 3701 3670 IF TY > V THEN 3680 ELSE 3700: 'Hits bottom of screen 3680 HN = LENS + (HH - LENS) * (V - AXIS - DISP) / (TY - AXIS - DISP) 3687 ' 3688 ' Here's where the emergent ray is drawn. Uses LP. 3699 ' 3690 LINE (LENS, LP)-(HN, V): GOTO 3701: 'Bottom hit? 3700 LINE (LENS, LP)-(HH, TY): 'Hits right side of screen 3701 'Dotted construction line extensions of emergent rays. 3702 'Rays trapped only at left. 3703 IF DI=-1 THEN 3709 3704 IF LENS<=0.001 or LENS=>H GOTO 3709 :'Lens off screen, don't draw. 3705 YD = LP - (LENS)*(TY-LP)/(HH-LENS) :'Calculation ok. 3706 IF M=-1 GOTO 3708 3707 LINE (0,YD)-(LENS, LP),,,&HFF00 : GOTO 3709 3708 YD = LP + (H-LENS)*(TY-LP)/(HH-LENS) : LINE (LENS,LP)-(H,YD),,,&HF0F0 :'mirror 3709 ' 3710 NEXT DISP 3729 ' 3730 ' **** Draw image arrow (if on screen) 3740 ' 3750 IF OH = 0 GOTO 3890: 'Don't draw image arrow if object size is zero. 3760 ' Bug *** IF ABS(OH)H OR XQ<0 GOTO 3890 :'Image off screen left or right 3810 IF ABS(IH) > V / 2 GOTO 3890: 'Image too large for screen 3820 IF M = -1 THEN XQ = 2 * LENS - XQ: 'ok, located correctly 3828 ' **** Begin drawing image arrow vertical line. 3829 'VTOP was VINF on next line (Feb 1, 2001) 3830 IF ABS(Q) > VTOP GOTO 3890: 'No image arrow at infinity 3831 LINE (XQ, AXIS)-(XQ, AXIS + .9 * IH) 3832 HW = IH * H / (100 * OH + .0001): '.0001 prevents /0 3840 H1 = XQ - HW: IF H1 < 0 THEN H1 = 0 3845 H2 = XQ + HW: IF H2 > H THEN H2 = H: 'HW is half-width 3850 '** Image arrowhead. Sanyo & T100 don't like off-screen points 3860 LINE (H1, AXIS + .9 * IH)-(H2, AXIS + .9 * IH) 3870 LINE (H1, AXIS + .9 * IH)-(XQ, AXIS + IH) 3880 LINE (H2, AXIS + .9 * IH)-(XQ, AXIS + IH) 3890 RETURN 3995 ' 3996 'Rayburst effect. Works best for N=5. 2/12/01 3997 'Scrolls OK. Good display. Rays not trapped at screen edges! 3998 'Uses N, XP, AXIS, OH, HD, LENS 3999 'Rays created clockwise from start. Sign of A determines rotation sense 4000 'Entry point of subroutine RAYBURST 4001 IF P < VTOP GOTO 4200 4002 'Routine for parallel rays from infinite object. 2/13/01 4005 RI = HD/N :'to RI = V - HD/N step HD/N 4006 IF RI = AXIS - HD THEN RI= AXIS + HD + HD/N 4010 LINE (0,RI)-(H,RI) :'Horizontal line 4011 IF RI > V - HD/(2*N) THEN GOTO 5000 :'Prevent RI=V, CGA doesn't like. 4015 RI = RI + HD/N : GOTO 4006 4200 XC = XP: YC = AXIS - OH: 'Rayburst origin position on the screen 4300 X = LENS - XC: Y = OH + HD: 'Initial vector components of line 4351 ANG = ATN ((OH + HD)/X) - ATN ((OH - HD)/X) :'OK 4355 'LOCATE 16,1 : PRINT ANG, Y, (OH-HD), N :'For debugging 4400 A = ANG/(N+1) : 'Sets radian size of incremental change in angle 4450 NN=1 :'NN counts the rays in burst 4600 'Begin ray drawing loop. 4640 X = X - A * Y: Y = Y + A * X: 'New ray vector components. 4700 IF IFULL=0 THEN ANG=-A :'Rays fill 2 pi first time through 4703 IF A*NN > (TWOPI - ANG - A/2) GOTO 5000 :'Stop ray drawing. 4706 XS = 10 * X: YS = 10 * Y: 'Scale up X and Y to fill screen 4710 LINE (XC, YC)-(XC + XS, YC + YS) : 'Draw one ray. 4850 NN = NN + 1 :'Increment ray count. 4900 GOTO 4600 5000 RETURN 5001 ' 5100 'Entry point of equation display. 5160 LOCATE 2, 65: PRINT " ÉÍÍÍÍÍÍÍÍÍÍÍÍÍ»" 5170 LOCATE 3, 65: PRINT " º 1 1 1 º" 5180 LOCATE 4, 65: PRINT " º - + - = - º" 5181 IF SCT=1 THEN 5185 ELSE 5186 5185 LOCATE 5, 65: PRINT " º P Q F º" : GOTO 5190 5186 LOCATE 5, 65: PRINT " º P F Q º" 5190 LOCATE 6, 65: PRINT " ÈÍÍÍÍÍÍÍÍÍÍÍÍͼ" 5200 RETURN 6000 'Last line of program LENS.BAS