PCDisk Magazine Disks

home *** CD-ROM | disk | FTP | other *** search

/ PCDisk Magazine Disks / PCDisk Magazine - Disk 2.img / TUTOR3.BAS (.txt) < prev next >

Wrap

GW-BASIC | 1984-11-10 | 20.2 KB | 494 lines

10 ' ==================================================================== 20 ' GRAPHICS TUTOR 30 ' Copyright (C) 1984 Stan W. Merrill -- All Rights Reserved 40 ' ==================================================================== 50 ' -------------------------------------------------------------------- 60 ' -- Declare Global Constants 70 ' -------------------------------------------------------------------- 80 ' -- program constants 90 NO = 0 : YES = 1 : MENU.ENTRIES = 9 100 YELLOW = 14 : WHITE = 15 : BLACK = 0 110 CYAN = 3 : FKEY.ROW = 6 : FKEY.COL = 34 120 NO.CURSOR = 0 : ESC$ = CHR$(27) 130 ' -- provide values and labels for graph variable 140 GRAPH.TITLE$ = ">>> Monthly Sales <<<" 150 NUM.CASES = 12 : DIM VALUE(12), LABEL$(12), X(12), Y(12) 160 DATA 100, 150, 100, 175, 200, 50 170 DATA 200, 225, 150, 275, 300, 325 180 DATA Jan, Feb, Mar, Apr, May, Jun 190 DATA Jul, Aug, Sep, Oct, Nov, Dec 200 ' -- graph constants 210 SCREEN.WIDTH = 320 : SCREEN.HEIGHT = 200 : PI = 3.14159 : NUM.TICKS = 4 220 X.CENTER = 160 : Y.CENTER = 100 : RADIUS = 75 : ASPECT = 0.92 230 START.X = 75 : END.X = 275 : START.Y = 20 : END.Y = 150 240 LENGTH.X = ABS(END.X - START.X) : LENGTH.Y = ABS(END.Y - START.Y) 250 SCREEN.WIDTH.ADJUST = LENGTH.X/SCREEN.WIDTH 260 SCREEN.HEIGHT.ADJUST = (LENGTH.Y/SCREEN.HEIGHT) * 2 270 TEXT.CELL.WIDTH = SCREEN.WIDTH/40 280 TEXT.CELL.HEIGHT = SCREEN.HEIGHT/25 290 BAR.WIDTH = INT(LENGTH.X/(NUM.CASES + 1)) 300 GAP = INT(BAR.WIDTH/NUM.CASES) 310 ' ------------------------------------------------------------------ 320 ' -- Main Control Section 330 ' ------------------------------------------------------------------ 340 GOSUB 1480 ' -- reset function keys 350 WHILE (YES) 360 WIDTH 80 ' -- set screen width 370 SCREEN 0,0,0 ' -- set text mode 380 CLS 390 GOSUB 620 ' -- Menu title 400 GOSUB 770 ' -- Show menu 410 GOSUB 1290 ' -- Get choice (FKEY) 420 COLOR WHITE, BLACK, NO.CURSOR 430 IF FKEY <= 9 THEN GOSUB 1150 ' -- Highlight Key Top 440 IF FKEY = 1 THEN GOSUB 1810 ' -- Rubber Bands 450 IF FKEY = 2 THEN GOSUB 3040 ' -- Pie Chart 460 IF FKEY = 3 THEN GOSUB 1970 ' -- Line Graph 470 IF FKEY = 4 THEN GOSUB 2850 ' -- Bar Graph 480 IF FKEY = 5 THEN GOSUB 3410 ' -- Turtle 490 IF FKEY = 6 THEN GOSUB 4100 ' -- Neon Girl 500 IF FKEY = 7 THEN GOSUB 3950 ' -- Text Color 510 IF FKEY = 8 THEN GOSUB 4690 ' -- Geo Shapes 520 IF FKEY = 46 THEN CLS : LIST 1810-1960 ' -- Rubber Bands 530 IF FKEY = 48 THEN CLS : LIST 1970-2170 ' -- Line Graph 540 IF FKEY = 49 THEN CLS : LIST 2850-3030 ' -- Bar Graph 550 IF FKEY = 47 THEN CLS : LIST 3040-3400 ' -- Pie Chart 560 IF FKEY = 50 THEN CLS : LIST 3410-3760 ' -- Turtle 570 IF FKEY = 51 THEN CLS : LIST 4100-4680 ' -- Neon Girl 580 IF FKEY = 52 THEN CLS : LIST 3950-4090 ' -- Text Color 590 IF FKEY = 53 THEN CLS : LIST 4690-4930 ' -- Geo Shapes 600 WEND 610 END 620 ' ------------------------------------------------------------------ 630 ' -- Subroutine: MENU TITLE 640 ' ------------------------------------------------------------------ 650 TITLE$ = "> > > GRAPHICS TUTOR < < <" 660 AUTHOR$ = "Copyright (C) 1984 by Stan W. Merrill -- All Rights Reserved" 670 MSG1$ = "Press a Function Key to View a Graphics Display" 680 MSG2$ = "Press the <ALT> Key Plus a Function Key to View Program" 690 MSG3$ = "Type RUN and Press "+CHR$(17)+CHR$(196)+CHR$(217)+" to Restart Program After Viewing" 700 COLOR YELLOW, BLACK 710 LOCATE 2,(40 - (LEN(TITLE$)/2)) : PRINT TITLE$; 720 LOCATE 3,(40 - (LEN(AUTHOR$)/2)) : PRINT AUTHOR$; 730 LOCATE 23, (40 - (LEN(MSG1$)/2)) : PRINT MSG1$; 740 LOCATE 24, (40 - (LEN(MSG2$)/2)) : PRINT MSG2$; 750 LOCATE 25, (40 - (LEN(MSG3$)/2)) : PRINT MSG3$; 760 RETURN 770 ' ------------------------------------------------------------------ 780 ' -- Subroutine: DRAW A SET OF FKEYS 790 ' -- Requires: FKEY.ROW, FKEY.COL Returns: (nothing) 800 ' ------------------------------------------------------------------ 810 RESTORE 1010 820 LEFT.OF.BOX = FKEY.COL : FKEY = -1 830 FOR TOP.OF.BOX = FKEY.ROW TO (FKEY.ROW + 12) STEP 3 840 COLOR CYAN, BLACK : GOSUB 1040 ' -- Draw box 850 FKEY = FKEY + 2 : GOSUB 1150 ' -- Label the box 860 COLOR WHITE, BLACK : READ EXPLANATION$ 870 LOCATE TOP.OF.BOX + 1, (FKEY.COL - LEN(EXPLANATION$) - 2), NO.CURSOR 880 PRINT EXPLANATION$; 890 NEXT 'TOP.OF.BOX 900 ' 910 LEFT.OF.BOX = FKEY.COL + 6 : FKEY = 0 920 FOR TOP.OF.BOX = FKEY.ROW TO (FKEY.ROW + 12) STEP 3 930 COLOR CYAN, BLACK : GOSUB 1040 ' -- Draw box 940 FKEY = FKEY + 2 : GOSUB 1150 ' -- Label the Fkey 950 COLOR WHITE, BLACK : READ EXPLANATION$ 960 LOCATE TOP.OF.BOX + 1, LEFT.OF.BOX + 8, NO.CURSOR 970 PRINT EXPLANATION$; 980 NEXT 'TOP.OF.BOX 990 FKEY = -1 1000 ' 1010 DATA "Rubber Bands", "Line Graph", "Turtle", "Text Color", "" 1020 DATA "Pie Chart", "Bar Graph", "Neon Girl", "Geo Shapes", "QUIT to SYSTEM" 1030 RETURN 1040 ' ------------------------------------------------------------------ 1050 ' -- Subroutine: DRAW A BOX 1060 ' -- Requires: TOP.OF.BOX, LEFT.OF.BOX Returns: (nothing) 1070 ' ------------------------------------------------------------------ 1080 LOCATE TOP.OF.BOX, LEFT.OF.BOX 1090 PRINT "KEYTHENTHENTHENTHENOPTION"; 1100 LOCATE TOP.OF.BOX + 1, LEFT.OF.BOX 1110 PRINT "OPEN CALL"; 1120 LOCATE TOP.OF.BOX + 2, LEFT.OF.BOX 1130 PRINT "NOTSOUNDSOUNDSOUNDSOUND'"; 1140 RETURN 1150 ' ------------------------------------------------------------------ 1160 ' -- Subroutine: LABEL THE FKEY 1170 ' -- Requires: FKEY Returns: (nothing) 1180 ' ------------------------------------------------------------------ 1190 ' -- Determine Key Top Location 1200 ODD.EVEN = ((FKEY MOD 2) XOR 1) ' -- 1 if even, 0 if odd 1210 TOP.OF.BOX = FKEY.ROW + ((FKEY - 1 - ODD.EVEN) * 3/2) 1220 LEFT.OF.BOX = FKEY.COL 1230 IF (ODD.EVEN = 1) THEN LEFT.OF.BOX = FKEY.COL + 6 1240 LOCATE TOP.OF.BOX + 1, LEFT.OF.BOX + 2 1250 ' -- Label Key Top 1260 IF (FKEY < 10) THEN PRINT "F"; CHR$(FKEY + 48); 1270 IF (FKEY = 10) THEN PRINT "F10"; 1280 RETURN 1290 ' ------------------------------------------------------------------ 1300 ' -- Subroutine: GET USER'S CHOICE (using Function keys) 1310 ' -- Requires: (nothing) Returns: FKEY 1320 ' ------------------------------------------------------------------ 1330 DEF SEG=0: POKE 1050, PEEK(1052) '-- Clear keyboard buffer 1340 DEF SEG: POKE 106,0 '-- Clear BASIC's buffer 1350 VALID.KEY = NO 1360 CHOICE$ = INKEY$ 1370 WHILE ((LEN(CHOICE$) < 2) AND (VALID.KEY = NO)) 1380 CHOICE$ = INKEY$ 1390 WHILE (LEN(CHOICE$) >= 2) 1400 CHOICE$ = RIGHT$(CHOICE$,1) 1410 FKEY = ASC(CHOICE$) - 58 ' -- See BASIC manual, App. G 1420 IF (FKEY >= 1 AND FKEY <= MENU.ENTRIES) THEN VALID.KEY = YES 1430 IF (FKEY >= 46 AND FKEY <= (MENU.ENTRIES+45)) THEN VALID.KEY = YES 1440 WEND 1450 IF FKEY = 10 THEN CLS : SYSTEM 1460 WEND 1470 RETURN 1480 ' ------------------------------------------------------------------ 1490 ' -- Subroutine: FUNCTION KEYS 1500 ' ------------------------------------------------------------------ 1510 KEY OFF ' -- turn off function key menu 1520 FOR FKEY = 1 TO 10 ' -- reset function keys so they 1530 KEY FKEY,"" ' -- can be used as regular keys 1540 NEXT 'FKEY ' -- (See BASIC manual, App. G) 1550 RETURN 1560 ' ------------------------------------------------------------------ 1570 ' -- Subroutine: RANDOMIZE 1580 ' ------------------------------------------------------------------ 1590 T$ = MID$(TIME$,7,2) 1600 TIME = VAL(T$) 1610 RANDOMIZE TIME 1620 RETURN 1630 ' ------------------------------------------------------------------ 1640 ' -- Subroutine: NUMLOCK ON 1650 ' ------------------------------------------------------------------ 1660 DEF SEG = 0 1670 POKE &H417, (PEEK(&H417) OR &H20) 1680 RETURN 1690 ' ------------------------------------------------------------------ 1700 ' -- Subroutine: NUMLOCK ON 1710 ' ------------------------------------------------------------------ 1720 DEF SEG = 0 1730 POKE &H417, (PEEK(&H417) AND &HDF) 1740 RETURN 1750 ' ------------------------------------------------------------------ 1760 ' -- Subroutine: WAIT FOR USER TO RESPOND 1770 ' ------------------------------------------------------------------ 1780 LOCATE 25, 10, NO.CURSOR : PRINT "Press <ESC> to return."; 1790 WHILE (INKEY$ <> ESC$) : WEND 1800 RETURN 1810 ' ------------------------------------------------------------------ 1820 ' -- Subroutine: RUBBER BANDS 1830 ' ------------------------------------------------------------------ 1840 SCREEN 1 1850 LOCATE 25, 10 : PRINT "Press <ESC> to return."; 1860 WHILE (INKEY$ <> ESC$) 1870 ' -- randomly generate options for the CIRCLE statement 1880 X = (RND(1) * 319) ' -- x coordinate 1890 Y = (RND(1) * 199) ' -- y coordinate 1900 R = (RND(1) * 27) + 3 ' -- radius (minimum of 3 wide) 1910 TINT = (RND(1) * 3) ' -- color 1920 ASPECT.RATIO = (RND(1) * 2) ' -- aspect ratio 1930 ' -- draw the circle (actually the ellipse) 1940 CIRCLE (X,Y),R,TINT,,,ASPECT.RATIO 1950 WEND 1960 RETURN 1970 ' ------------------------------------------------------------------ 1980 ' -- Subroutine: LINE GRAPH 1990 ' ------------------------------------------------------------------ 2000 SCREEN 1 : TINT = 2 2010 LOCATE 1, (40 - (LEN(GRAPH.TITLE$)))/2 : PRINT GRAPH.TITLE$; 2020 GOSUB 2180 : ' -- read the data 2030 GOSUB 2310 : ' -- draw scale axes 2040 GOSUB 2390 : ' -- label x axis 2050 GOSUB 2600 : ' -- label y axis 2060 ' -- plot the points 2070 FOR CASE = 1 TO NUM.CASES 2080 X(CASE) = ((BAR.WIDTH + GAP) * CASE) + START.X + GAP 2090 Y(CASE) = INT(END.Y - ((VALUE(CASE)/SCALE.VALUE)*LENGTH.Y)) 2100 CIRCLE (X(CASE), Y(CASE)),2,TINT 2110 NEXT 'CASE 2120 ' -- connect each set of points with a line 2130 FOR CASE = 2 TO NUM.CASES 2140 LINE(X(CASE-1),Y(CASE-1))-(X(CASE),Y(CASE)),TINT-1 2150 NEXT 'CASE 2160 GOSUB 1750 : ' -- wait for user 2170 RETURN 2180 ' ------------------------------------------------------------------ 2190 ' -- Subroutine: READ DATA VALUES AND LABELS 2200 ' ------------------------------------------------------------------ 2210 RESTORE 160 2220 ' -- read the data values 2230 FOR CASE = 1 TO NUM.CASES 2240 READ VALUE(CASE) 2250 NEXT 'CASE 2260 ' -- read the labels 2270 FOR CASE = 1 TO NUM.CASES 2280 READ LABEL$(CASE) 2290 NEXT 'CASE 2300 RETURN 2310 ' ------------------------------------------------------------------ 2320 ' -- Subroutine: DRAW AXES 2330 ' ------------------------------------------------------------------ 2340 ' -- draw the y (vertical) axis 2350 LINE (START.X, START.Y) - (START.X, END.Y) 2360 ' -- draw the x (horizontal) axis 2370 LINE (START.X, END.Y) - (END.X, END.Y) 2380 RETURN 2390 ' ------------------------------------------------------------------ 2400 ' -- Subroutine: LABEL X (HORIZONTAL) AXIS WITH TEXT LABELS 2410 ' ------------------------------------------------------------------ 2420 FOR CASE = 1 TO NUM.CASES 2430 ' -- calculate where this label belongs 2440 TICK = ((BAR.WIDTH + GAP) * CASE) + START.X + GAP 2450 ' -- draw a tick mark there 2460 LINE (TICK, END.Y+5) - (TICK, END.Y) 2470 ' -- convert the tick mark's location to text screen coordinates 2480 ROW = INT((END.Y+5)/TEXT.CELL.HEIGHT) 2490 COL = INT(TICK/TEXT.CELL.WIDTH) + GAP 2500 ' -- determine how long the label is (allow up to 3 characters) 2510 LABEL.LENGTH = LEN(LABEL$(CASE)) 2520 IF LABEL.LENGTH > 3 THEN LABEL.LENGTH = 3 2530 ' -- print the label 2540 FOR BYTE = 1 TO LABEL.LENGTH 2550 LOCATE (ROW + BYTE + 1), COL 2560 PRINT MID$(LABEL$(CASE), BYTE, 1); 2570 NEXT 'BYTE 2580 NEXT 'CASE 2590 RETURN 2600 ' ------------------------------------------------------------------ 2610 ' -- Subroutine: LABEL Y (VERTICAL) AXIS WITH NUMERIC LABELS 2620 ' ------------------------------------------------------------------ 2630 ' -- find highest value of the variable 2640 HIGH.VALUE = 0 2650 FOR CASE = 1 TO NUM.CASES 2660 IF (HIGH.VALUE < VALUE(CASE)) THEN HIGH.VALUE = VALUE(CASE) 2670 NEXT 'CASE 2680 ' -- find the next round number greater than the highest value 2690 SCALE.VALUE = 100 2700 WHILE (SCALE.VALUE < HIGH.VALUE) 2710 SCALE.VALUE = SCALE.VALUE + 100 2720 WEND 2730 ' -- divide the length of the y axis into equal parts 2740 TICK = LENGTH.Y/NUM.TICKS 2750 ' -- draw tick marks up the y axis 2760 FOR CASE = 0 TO NUM.TICKS 2770 LINE (START.X-5, (TICK*CASE)+START.Y) - (START.X, (TICK*CASE)+START.Y) 2780 NEXT 'CASE 2790 ' -- label each tick mark with a value 2800 FOR CASE = 0 TO NUM.TICKS 2810 LOCATE INT(((TICK*CASE)+START.Y)/TEXT.CELL.HEIGHT)+1, INT((START.X-40)/8) 2820 PRINT USING "####"; (NUM.TICKS-CASE)*(SCALE.VALUE/NUM.TICKS); 2830 NEXT 'CASE 2840 RETURN 2850 ' ------------------------------------------------------------------ 2860 ' -- Subroutine: BAR GRAPH 2870 ' ------------------------------------------------------------------ 2880 SCREEN 1 : TINT = 2 2890 LOCATE 1, (40 - (LEN(GRAPH.TITLE$)))/2 : PRINT GRAPH.TITLE$; 2900 GOSUB 2180 : ' -- read the data 2910 GOSUB 2310 : ' -- draw and label scale axes 2920 GOSUB 2390 : ' -- label x axis 2930 GOSUB 2600 : ' -- label y axis 2940 ' -- draw the bars 2950 FOR CASE = 1 TO NUM.CASES 2960 TOP.Y = INT(END.Y - ((VALUE(CASE)/SCALE.VALUE)*LENGTH.Y)) 2970 TOP.X = ((BAR.WIDTH + GAP) * CASE) + START.X - INT(BAR.WIDTH/2) 2980 BOTTOM.Y = END.Y - 1 2990 BOTTOM.X = TOP.X + BAR.WIDTH - GAP 3000 LINE (TOP.X, TOP.Y) - (BOTTOM.X, BOTTOM.Y),TINT,BF 3010 NEXT 'CASE 3020 GOSUB 1750 : ' -- wait for user 3030 RETURN 3040 ' ------------------------------------------------------------------ 3050 ' -- Subroutine: PIE CHART 3060 ' ------------------------------------------------------------------ 3070 SCREEN 1 : TINT = 1 3080 GOSUB 2180 : ' -- read the data 3090 LOCATE 1, (40 - (LEN(GRAPH.TITLE$)))/2 : PRINT GRAPH.TITLE$; 3100 ' -- calculate the total for all values (the whole pie) 3110 TOTAL = 0 3120 FOR CASE = 1 TO NUM.CASES 3130 TOTAL = TOTAL + VALUE(CASE) 3140 NEXT 'CASE 3150 ' -- start the pie 3160 END.POINT = 0 3170 LINE (X.CENTER, Y.CENTER) - (X.CENTER+RADIUS, Y.CENTER),TINT 3180 ' 3190 FOR CASE = 1 TO NUM.CASES 3200 ' -- draw a wedge of circle for this value 3210 PORTION = (VALUE(CASE)/TOTAL) 3220 START.POINT = END.POINT 3230 END.POINT = PORTION*(-2*PI) + START.POINT 3240 CIRCLE (X.CENTER, Y.CENTER),RADIUS,TINT,START.POINT,END.POINT,ASPECT 3250 ' -- find a point somewhere inside the wedge 3260 ANGLE = ((END.POINT-START.POINT)/2) + START.POINT 3270 X.POINT = X.CENTER + RADIUS/2 * COS(ANGLE) 3280 Y.POINT = Y.CENTER + RADIUS/2 * SIN(ANGLE) * ASPECT 3290 ' -- use the point to paint the inside of the wedge 3300 PAINT (X.POINT, Y.POINT), TINT, TINT 3310 TINT = TINT + 1 : IF TINT > 3 THEN TINT = 1 3320 ' -- label the wedge 3330 X.POINT = X.CENTER + ((RADIUS+16) * COS(ANGLE)) 3340 Y.POINT = Y.CENTER + ((RADIUS+16) * SIN(ANGLE)) * ASPECT + 10 3350 ROW = INT(Y.POINT/TEXT.CELL.HEIGHT) 3360 COL = INT(X.POINT/TEXT.CELL.WIDTH) 3370 LOCATE ROW, COL, NO.CURSOR : PRINT LABEL$(CASE); 3380 NEXT 'CASE 3390 GOSUB 1750 : ' -- wait for user 3400 RETURN 3410 ' ------------------------------------------------------------------ 3420 ' -- Subroutine: TURTLE 3430 ' ------------------------------------------------------------------ 3440 GOSUB 3770 : ' -- give instructions 3450 ' -- set up environment 3460 SCREEN 1 : COLOR 0, 0 : TINT = 1 3470 X = X.CENTER : Y = Y.CENTER : PSET(X, Y), TINT 3480 GOSUB 1630 ' -- NumLock ON (for easy use of cursor keys) 3490 ' -- draw 3500 OKAY = YES 3510 WHILE (OKAY) 3520 ' -- wait for user to press a key 3530 K$ = INKEY$ : IF K$ = "" THEN 3530 3540 ' -- if user wants to quit, then get ready to do so 3550 IF K$ = ESC$ THEN OKAY = NO 3560 ' -- otherwise, change the coordinates 3570 IF (K$ = "1" OR K$ = "4" OR K$ = "7") THEN X = X - 1 3580 IF (K$ = "3" OR K$ = "6" OR K$ = "9") THEN X = X + 1 3590 IF (K$ = "7" OR K$ = "8" OR K$ = "9") THEN Y = Y - 1 3600 IF (K$ = "1" OR K$ = "2" OR K$ = "3") THEN Y = Y + 1 3610 ' -- or return to the center of the screen 3620 IF K$ = "5" THEN X = X.CENTER : Y = Y.CENTER 3630 ' -- or save the drawing 3640 IF K$ = "+" THEN DEF SEG = &HB800 : BSAVE "pic", 0, &H4000 3650 ' -- or replace this drawing with the last one 3660 IF K$ = "-" THEN DEF SEG = &HB800 : BLOAD "pic", 0 3670 ' -- or change color 3680 IF K$ = "0" THEN TINT = TINT + 1 : IF TINT > 3 THEN TINT = 0 3690 ' -- or erase everything 3700 IF K$ = "." THEN CLS : X = X.CENTER : Y = Y.CENTER 3710 PSET(X,Y), TINT 3720 'LINE (X - 2, Y - 2) - (X + 2, Y + 2),TINT,BF 3730 'CIRCLE (X, Y),2,TINT 3740 WEND 3750 GOSUB 1690 ' -- NumLock OFF 3760 RETURN 3770 ' ------------------------------------------------------------------ 3780 ' -- Subroutine: TURTLE INSTRUCTIONS 3790 ' ------------------------------------------------------------------ 3800 SCREEN 0 : CLS : COLOR YELLOW, BLACK 3810 LOCATE 3, 25 : PRINT ">>> TURTLE INSTRUCTIONS <<<" 3820 COLOR CYAN, BLACK 3830 LOCATE 7, 16 : PRINT "The TURTLE is a small dot that you push around" 3840 LOCATE 8, 25 : PRINT "on the screen to draw pictures." 3850 LOCATE 11, 22 : PRINT "Use CURSOR keys to move the turtle"; 3860 LOCATE 12, 25 : PRINT "Press <ESC> to End" 3870 LOCATE 13, 25 : PRINT "Press <+> to Save Picture"; 3880 LOCATE 14, 25 : PRINT "Press <-> to Restore Picture"; 3890 LOCATE 15, 25 : PRINT "Press <Del> to Clear Screen"; 3900 LOCATE 16, 25 : PRINT "Press <Ins> to Change Color"; 3910 LOCATE 17, 22 : PRINT "(Use black to erase unwanted points)" 3920 LOCATE 25, 28 : PRINT "Press <ESC> to continue."; 3930 WHILE (INKEY$ <> ESC$) : WEND 3940 RETURN 3950 ' ------------------------------------------------------------------ 3960 ' -- Subroutine: TEXT COLOR 3970 ' ------------------------------------------------------------------ 3980 SCREEN 1 3990 FOR PALETTE = 0 TO 1 4000 COLOR BLACK, PALETTE 4010 CLS : LOCATE 10 4020 FOR TINT = 0 TO 3 4030 POKE 78, TINT : ' -- change foreground text color 4040 PRINT TAB(15); "I LOVE YOU!" 4050 FOR DELAY = 1 TO 1000 : NEXT 'DELAY 4060 NEXT 'TINT 4070 FOR DELAY = 1 TO 2000 : NEXT 'DELAY 4080 NEXT 'PALETTE 4090 RETURN 4100 ' ------------------------------------------------------------------ 4110 ' -- Subroutine: NEON GIRL 4120 ' ------------------------------------------------------------------ 4130 SCREEN 1 : CLS : COLOR BLACK, 1 4140 ' -- draw a border around the screen 4150 LINE (40, 1) - (300, 185),1,B 4160 ' -- label the drawing 4170 FOR ROW = 1 TO 20 4180 LOCATE ROW, 3 4190 PRINT MID$(" N e o n G i r l", ROW, 1); 4200 NEXT 'ROW 4210 ' -- draw the girl's right arm 4220 DRAW "C1BM67,180E2U2E2U2E6U1E1U1U2E4U1E1U2E1U6E2U3E1U2E1U2E2U2E3U2E3" 4230 DRAW "R1E3R2E1R3E1R4F2" 4240 ' -- right shoulder 4250 DRAW "BM107,172H2U4H1U6H1U6E1U4E1U3E1U5E1U3E1E1U1E2U3E3U2R1U1R10E1R3" 4260 DRAW "E1R4E1R3E1R4" 4270 ' -- neck 4280 DRAW "BM151,92C3D20L2G1L1G1L3G4C1D1F3D1F7D1F5D1F1D2F12D1F1D1F1D2F1D4" 4290 DRAW "BM187,93C3D19F2R2F5R1F1C1D4G6D1G7L1G5L2G8D1G2" 4300 ' -- left shoulder 4310 DRAW "BM199,121R1F1R1F1R2F1G1D6G1F1D6G1D4G1D11F1D1E2U1E1U2E3U3E3U3E4" 4320 DRAW "U3E4U2BM207,125R2E1F3E1F3E1R2E2R2F4D6G1L1D3G1D2G2D15G1D2G1D2G2" 4330 ' -- left arm 4340 DRAW "BM225,131E2F2R1F6R2F1D8G1D1G2D2G4BM240,139F4D2F2D2F1D4F1D2F1D11" 4350 DRAW "G2C3H2F3D2F5BM235,179C1E2U2E6R1E1" 4360 ' -- chin 4370 DRAW "C3BM143,64F1D2F1D6F1D4F1D2F1D1F1D2F1D2F5D1F2D1F2D1R5F1R6E1R4E3" 4380 DRAW "R1E3R2E4U2E1U3E1U2E1U3E1U2E2U4E2U2" 4390 ' -- bangs 4400 DRAW "BM143,64R1U1R1U4E1H1U1E2U2E1U3R1E2R5H3U5F5R1D1R5E5U1E1U2F4D4G2" 4410 DRAW "E1F1R6E2F4R3F2D4F1D2F2D1F1D2F1D2" 4420 ' -- hair 4430 DRAW "BM151,96C2L5G1U4L3H5R2E1R2E1L5H3U2E3L1H2L1H4U5E5U3L2G2D2H4E4U1" 4440 DRAW "L3H3L5G2E1U4R1E2R2H2U8E1U5E1U1ER2U1R7E1U6E3R1E4R1E1R5F3R1F7E5" 4450 DRAW "R3E1R8F4E2F2R3F1R6E4D4F3L1G3F4R4D2R5D1F2D4F1D4G2E2F3R2D4G1D1G1" 4460 DRAW "D1G2F2D2G2D1G1D2G2L4G4D1G3D1G1D5F2G1L2G2D2G1D1G2L2H3" 4470 ' -- right eye 4480 DRAW "BM150,56E2R2E1R7F1R1F1H1L8C3BM165,60G2L2G1L4H1L2H1E2R1E1R1E1R4" 4490 DRAW "F1R2F1H2L1H1L6G1BD1BR3C1G1D1F1R1E1U1H1L1" 4500 ' -- left eye 4510 DRAW "BM175,56C2R1E1R2E1R4E1R3F1L7C3BM176,60F2R1F1R7E1R1H3L1H1L5G1L1" 4520 DRAW "G1E2R1E1R6F1BD1BL5C1G1D1F1R1E1U1H1L1" 4530 ' -- nose 4540 DRAW "C3BM173,62F2BM173,64F2BM173,66F2BM173,68F2BM173,70F2BM176,72F3" 4550 DRAW "D2G1BL2H1L1G1BM170,76BM166,74D1G1D1F1R1E1R1" 4560 ' -- lips 4570 DRAW "BM160,88E1R2E1R3E1R5F1R3F1R2F1L6H1L6G1L6D1F4R1F1R8E1R1E4U1D1G2" 4580 DRAW "L3G1L8H1L2H2U1" 4590 ' -- tell user how to quit 4600 LOCATE 25, 11 : PRINT "Press <ESC> to return."; 4610 ' -- change colors to give a neon sign effect 4620 PALETTE = 0 4630 WHILE (INKEY$ <> ESC$) 4640 COLOR BLACK, PALETTE 4650 IF PALETTE = 1 THEN PALETTE = 0 ELSE PALETTE = 1 4660 FOR DELAY = 1 TO 150 : NEXT 'DELAY 4670 WEND 4680 RETURN 4690 ' ------------------------------------------------------------------ 4700 ' -- Subroutine: GEO SHAPES 4710 ' ------------------------------------------------------------------ 4720 ' -- foreground colors for hi-res mode 4730 SCREEN 2 : GOSUB 1560 ' -- Randomize 4740 WHILE (1) 4750 ' -- tell user how to quit 4760 CLS : LOCATE 25, 30 : PRINT "Press <ESC> to return."; 4770 ' -- draw a geometric patter in hi-res graphics mode 4780 M=RND*50+3 : N=RND*M+1 4790 FOR ANGLE=1 TO 32 STEP RND+0.01 4800 RADIUS=SIN((M/N)*ANGLE)*75 4810 SIDE=RADIUS/100*225 4820 LINE -(319+SIDE*SIN(ANGLE),100+RADIUS*COS(ANGLE)) 4830 IF INKEY$ = ESC$ THEN RETURN 4840 NEXT 'ANGLE 4850 ' -- show all fifteen possible foreground colors 4860 FOR TINT = 1 TO 15 4870 OUT 985, TINT : ' -- change hi-res foreground color 4880 SOUND TINT*66, 0.1 4890 FOR DELAY = 1 TO 500 : NEXT 'DELAY 4900 IF INKEY$ = ESC$ THEN RETURN 4910 NEXT 'TINT 4920 WEND 4930 RETURN