Sany Basic - DEMO.BAS

De originele sourcecode van DEMO.BAS op de bijgeleverde [[Sanyo Basic]] diskette voor de [[Sanyo MBC 555]].

(:sanyo_mbc-550_demo_image.jpeg)

100 ' *** PROGRAM NAME "DEMO.BAS" REV 1.0 (9/27/1983)*** 1000 COLOR 3,0: CLS:DIM A(17),B(17) 1010 LOCATE 10,15:INPUT "DO YOU USE A COLOR DISPLAY MONITOR ? (Y/N) ",Y$ 1020 IF Y$<>"Y" THEN CCC=0:MASK=3 ELSE CCC=1:MASK=7 1030 GOSUB 4000:GOSUB 1050:GOSUB 1310 1040 GOTO 1030 1050 '***** SANYO MBC-550 ****** 1060 COLOR MASK,0 :CLS:WINDOW(0,0)-(639,199):VIEW(0,0)-(639,199) 1070 C1=INT(8*RND(1)) AND MASK 1080 C2=INT(8*RND(2)) AND MASK 1090 IF C1=C2 OR C1=0 OR C2=0 THEN 1070 1100 COLOR C1,C2:CLS 1110 LOCATE 25,10:PRINT "If you want to stop the program, please press SPACE bar.";:LOCATE 1,1 1120 GOSUB 5000 1300 FOR P=1 TO 800 : NEXT:RETURN 1310 '******** CHARACTER ******** 1320 COLOR MASK,0:GOSUB 4020:CLS:'GOSUB 4060 1325 WINDOW(0,0)-(639,199) 1330 LOCATE 25,15:PRINT "The character set of MBC-550"; 1340 SYMBOL(76,0),"---- THE CHARACTER TABLE -----",2,1 1350 LOCATE 4,9:PRINT "0 1 2 3 4 5 6 7 8 9 A B C D E F " 1360 J=48 1370 FOR I=7 TO 22 :GOSUB 4020 1380 LOCATE I,7:PRINT CHR$(J); 1390 J=J+1:IF J=58 THEN J=65:GOSUB 4020 1400 NEXT I:GOSUB 4020 1410 C=31 1420 FOR I=17 TO 69 STEP 4:GOSUB 4020 1430 FOR J=7 TO 22 1440 C=C+1 1450 LOCATE J,I:PRINT CHR$(C);:FOR P=1 TO 2 :GOSUB 4020:NEXT P 1460 NEXT J:GOSUB 4020:NEXT I:FOR P=1 TO 300:GOSUB 4020:NEXT P 1470 GOSUB 1500 1480 LOCATE 24,38:PRINT "END";:GOSUB 4020 1490 GOSUB 3980:GOSUB 1050:GOTO 1810 1500 RETURN 1700 RETURN 1810 '******** PATTERN3 ******* 1820 WINDOW(0,0)-(639,459):VIEW(20,6)-(619,194) 1830 COLOR MASK,0:GOSUB 4020:CLS 1840 LINE(0,0)-(639,399),,B 1850 LOCATE 25,15:PRINT "DRAWING BOX "; 1860 FOR I=1 TO 20:GOSUB 4020 1870 A1=INT(RND*639):B1=INT(RND*399):A2=INT(RND*639):B2=INT(RND*399) 1880 IF A1<3 OR B1<3 OR A2<3 OR B2<3 THEN 1870 1890 IF ABS(A2-A1)>200 OR ABS(B2-B1)>200 OR ABS(A2-A1)<40 OR ABS(B2-B1)<40 THEN 1870 1900 C=C+1:IF C=0 OR C>MASK THEN C=1 1910 LINE(A1,B1)-(A2,B2),C AND MASK,BF 1930 NEXT I 1940 LOCATE 24,38:PRINT "END"; 1950 GOSUB 3980:GOSUB 1050 1960 '******** GRAPH-3 ******* 1970 WINDOW(0,0)-(639,459):VIEW(50,0)-(589,199) 1980 COLOR MASK,0:GOSUB 4020:CLS 1990 LOCATE 25,14:PRINT "AN EXAMPLE OF CURVE USING SINE AND COSINE FUNCTIONS."; 2000 L=100:A=319:B=100:C=2.4:DV=1.0173 2010 C0=INT(RND*8) AND MASK:IF C0=0 THEN 2010 2020 FOR T=0 TO 1.57 STEP 1.74533E-02:V1=L*(COS(T)-SIN(T)):V2=L*(SIN(T)+COS(T)): V3=-V2:V4=V1:GOSUB 4020 2030 LINE(INT(A+V1*C),INT(B+V2)*2+20)-(INT(A+V3*C),INT(B+V4)*2+20),C0 2040 LINE-(INT(A-V1*C),INT(B-V2)*2+20),C0 2050 LINE-(INT(A-V3*C),INT(B-V4)*2+20),C0 2060 LINE-(INT(A+V1*C),INT(B+V2)*2+20),C0 2070 L=L/DV:NEXT T 2080 L=100:A=319:B=100:C=2.4:DV=1.0173 2090 C1=INT(RND*8) AND MASK:IF C1=0 OR C1=C0 THEN 2090 2100 FOR T=4.72 TO 3.14 STEP -1.75433E-02:V1=L*(COS(T)-SIN(T)):V2=L*(SIN(T)+COS(T)): V3=-V2:V4=V1 2110 LINE(INT(A+V1*C),INT(B+V2)*2+22)-(INT(A+V3*C),INT(B+V4)*2+22),C1 2120 LINE(INT(A+V3*C),INT(B+V4)*2+22)-(INT(A-V1*C),INT(B-V2)*2+22),C1 2130 LINE(INT(A-V1*C),INT(B-V2)*2+22)-(INT(A-V3*C),INT(B-V4)*2+22),C1 2140 LINE(INT(A-V3*C),INT(B-V4)*2+22)-(INT(A+V1*C),INT(B+V2)*2+22),C1 2150 L=L/DV:NEXT T 2160 LOCATE 24,38:PRINT "END"; 2170 GOSUB 3980:GOSUB 1050 2180 '******* ROUND-1 ****** 2190 IF CCC=0 THEN 2670 ELSE WINDOW (0,0)-(639,199):VIEW (0,0)-(639,199) 2200 COLOR 0,MASK:GOSUB 4020:CLS 2210 LOCATE 25,10 2220 PRINT "An example of geometrical pattern using CIRCLE and PAINT command."; 2230 CIRCLE (200,100),150 :CIRCLE (439,100),150 2240 FOR I=1 TO 20:GOSUB 4020 2250 A=639*RND(1): IF A<50 OR A>550 THEN 2250 2260 B=199*RND(2): IF B<25 OR B>165 THEN 2260 2270 C=300*RND(3): IF C<30 THEN 2270 ELSE IF C>A OR C+30>B*1.8 THEN 2250 ELSE IF A+C>639 OR 2*B+C>350 THEN 2250 2280 CIRCLE (A,B),C 2290 NEXT I 2300 CL=INT(RND*8):IF CL=0 OR CL=MASK THEN 2300 ELSE LINE (0,0)-(639,190),0,B:PAINT(1,1),CL,0 2310 FOR I=1 TO 85 2320 GOSUB 4020:A=INT(639*RND(1)):'IF A<60 OR A>575 THEN 5190 2330 B=INT(199*RND(2)):IF B<30 OR B>150 THEN 2330 2340 D=COLOR (POINT(A,0),POINT(B,1)) 2350 IF D<> MASK THEN 2320 2360 E=INT(8*RND(4)) AND MASK:IF E=MASK OR E=0 THEN 2360 2370 PAINT(A,B),E,0 2380 NEXT I 2390 LOCATE 24,38:PRINT "END"; 2400 GOSUB 3980:GOSUB 1050 2410 '******** SQUARE ******** 2420 WINDOW (0,0)-(639,199):VIEW (0,0)-(639,199) 2425 IF CCC THEN COLOR 0,3 :BACK=3 ELSE COLOR 3,0:BACK=0 2430 GOSUB 4050:CLS 2440 LOCATE 24,5:PRINT "An example of geometrical pattern by LINE and CIRCLE commands."; 2450 LOCATE 25,5:PRINT "This program contains the method of reduction by WINDOW and VIEW command."; 2460 FOR K=1 TO 4 2470 VIEW (60 *K,16.5*K)-(639-60 *K,199-18*K),MASK 2480 C1=INT(8*RND(1)) AND MASK:C11=C1:IF C1=0 OR C1=BACK OR C1=MASK THEN 2480 2490 FOR J=0 TO 5 2500 FOR I=0 TO 3:GOSUB 4020 2510 LINE (100*J+20,46*I+8)-(120+100*J,46+46*I+8),C1,BF 2530 C1=C1+1:IF C1>MASK THEN C1=1 2540 NEXT I,J 2550 C2=INT(8*RND(2)) AND MASK:IF C2=0 OR C2=MASK THEN 2550 2560 IF C2=C11 THEN 2550 ELSE 2570 2570 FOR J=0 TO 5:GOSUB 4020 2580 FOR I=0 TO 3 2590 CIRCLE (100*J+70,46*I+31),48,,,.45,C2 2600 PAINT(100*J+70,46*I+31),C2 2610 C2=C2+1:IF C2>MASK THEN C2=1 2620 IF K=4 AND J=5 THEN LOCATE 23,38:PRINT "END"; 2630 NEXT I,J 2640 IF K<>4 THEN FOR P=1 TO 300:GOSUB 4020:NEXT P 2650 NEXT K 2660 GOSUB 3980:GOSUB 1050 2670 '******** BAR GRAPH ******** 2680 COLOR MASK,0:GOSUB 4020:CLS:WINDOW(0,0)-(639,459):VIEW(0,0)-(639,199) 2690 LOCATE 25,15:PRINT "An example of histogram."; 2700 LINE (84,100)-(84,364),MASK 2710 LINE (84,360)-(630,360),MASK 2720 FOR I=1 TO 7:GOSUB 4020 2730 LINE (82,360-I*37)-(86,360-I*37),MASK 2740 NEXT I 2760 FOR I=0 TO 7:GOSUB 4020 2770 LOCATE 20-I*2,6:PRINT USING "####";I*800; 2780 NEXT I 2790 LOCATE 21,12:PRINT " 4 6 8 10 12 2 4 6 8" 2810 S=0:P=0 2820 FOR I=0 TO 16:GOSUB 4020 2830 D=120*RND:IF D<40 THEN 2830 2840 S=S+D 2850 A(I)=D 2860 CC=INT(RND*8) AND MASK:IF CC<=1 THEN 2860 2870 LINE (90+32*I,358)-(115+32*I,358-2.3*A(I)),CC,BF 2890 NEXT I 2900 M=S/17:LINE(90,358-2.3*M)-(600,358-2.3*M),6:D=M/4:E=M-D 2910 FOR I=0 TO 16:GOSUB 4020 2920 F=E+RND*2*D:P=P+F 2930 B(I)=F 2940 NEXT I 2950 FOR I=0 TO 15:GOSUB 4020 2960 LINE(102+32*I,338-2*B(I))-(135+32*I,338-2*B(I+1)),MASK 2970 NEXT I 3000 LOCATE 24,38:PRINT "END"; 3010 GOSUB 3980:GOSUB 1050 3020 '******* circle graph ******* 3030 COLOR MASK,0:GOSUB 4020:CLS:WINDOW(0,0)-(639,199):VIEW(0,0)-(639,199) 3040 LOCATE 25,15:PRINT "An example of circle graph."; 3050 GOSUB 4020 3060 LOCATE 2,10:PRINT " Table of market share."; 3070 LINE(78,20)-(400,20) 3090 P2=1:A(0)=0:A(1)=.32:A(2)=.51:A(3)=.67:A(4)=.79:A(5)=.87:A(6)=1 3140 A(6)=1:GOSUB 3210:A(0)=1 3150 FOR J=0 TO 5:S=A(J):GOSUB 4020 3160 CIRCLE(140,100),130,-A(J),-A(J+1),,7-J 3161 IF J THEN T=(A(J)+A(J+1))*3.1415 ELSE T=A(1)*3.1415 3165 PAINT(140+30*COS(T),100+15*SIN(T)),7-J:GOSUB 4020 3170 NEXT J:A(0)=0 3200 GOTO 3390 3210 XS=280 : S=55 : FOR J=1 TO 6:GOSUB 4020 3220 LINE (XS,S)-(XS+15,S+8),MASK,B:PAINT (XS+10,S+3),8-J,MASK 3230 S=S+16:NEXT J 3240 XS=40:YS=8:P2=3.1415*2 3250 FOR J=0 TO 5:GOSUB 4020 3260 S=INT((A(J+1)-A(J))*100+.5) 3270 LOCATE YS,XS:PRINT USING "## %";S; 3280 YS=YS+2 3290 NEXT J 3300 XS=46:YS=8 3310 LOCATE YS,XS :PRINT "MODEL X1"; 3320 LOCATE YS+2,XS:PRINT "MODEL X2"; 3330 LOCATE YS+4,XS:PRINT "MODEL X3"; 3340 LOCATE YS+6,XS:PRINT "MODEL X4"; 3350 LOCATE YS+8,XS:PRINT "MODEL X5"; 3360 LOCATE YS+10,XS:PRINT "THE OTHERS"; 3370 RETURN 3390 FOR J=1 TO 300:GOSUB 4020:NEXT J:CLS:'GOSUB 4050:GOSUB 4060 3430 GOSUB 3990:GOSUB 1050 3960 RETURN 3970 '********** COMMON SUBROUTINE ********* 3980 FOR P=1 TO 2000 : NEXT P 3990 RETURN 4000 LOCATE CSRLIN,POS,0:RETURN 4010 LOCATE CSRLIN,POS,1:RETURN 4020 ZZ$=INKEY$:IF ZZ$="" THEN RETURN 4025 ZZ$=INKEY$:IF ZZ$<>"" THEN GOTO 4025 4030 ZZ$=INKEY$:IF ZZ$="" THEN GOTO 4030 ELSE RETURN 4040 RETURN 4050 RETURN 4060 RETURN 5000 ' **** SANYO MBC-550 SERIES ***** 5010 WINDOW (0,0)-(640,455) 5020 VIEW (0,0)-(639,199) 5030 'CLS 5040 '----- MARK ---------- 5050 RESTORE 5640 5060 XB=0: YB=0 5070 FOR I=1 TO 11:GOSUB 4020:GOSUB 5510: NEXT 5080 GOSUB 5360 5090 '----- MBC-5 ------- 5100 ' 5110 RESTORE 5850 5120 YB=170 5130 FOR I=1 TO 7:GOSUB 4020:GOSUB 5510: NEXT 5140 '----- 50 ------------ 5150 RESTORE 5980 5160 XB=70 5170 FOR I=1 TO 3:GOSUB 4020:GOSUB 5510: NEXT 5220 GOSUB 5410 5230 '-------------------- 5240 ' 5250 RESTORE 6060 5260 XB=400: YB=290 5270 FOR I=1 TO 6:GOSUB 4020:GOSUB 5510: NEXT 5280 RESTORE 6090 5290 XB=485 5300 FOR I=1 TO 2:GOSUB 4020:GOSUB 5510: NEXT 5310 RESTORE 6060 5320 XB=553:GOSUB 4020: GOSUB 5510 5330 GOSUB 5460 5340 FOR I=1 TO 1000:NEXT : RETURN 5350 '---------------------- 5360 C1=PSET 5370 RESTORE 6180 5380 XB=0:YB=0 5390 FOR I=1 TO 9: GOSUB 5590: NEXT 5400 RETURN 5410 C1=PSET 5420 RESTORE 6200 5430 XB=0: YB=170 5440 FOR I=1 TO 7: GOSUB 5590: NEXT 5450 RETURN 5460 C1=PSET 5470 RESTORE 6210 5480 XB=400: YB=290 5490 FOR I=1 TO 7: GOSUB 5590: NEXT 5500 RETURN 5510 '=====SUBROUTINES====================== 5520 ' 5530 READ X1,Y1,X2,Y2 5540 LINE (X1+XB,Y1+YB)-(X2+XB,Y2+YB) 5550 READ X: IF X=0 THEN RETURN 5560 READ Y 5570 LINE -(X+XB,Y+YB) 5580 GOTO 5550 5590 '---------------------------- 5600 READ X,Y 5610 PAINT (X+XB,Y+YB),C1 5620 RETURN 5630 '===== WORLD MARK ================ 5640 DATA 152,72,151,70,146,65,142,62,140,61,138,60,134,59,129,58,125,58,120,59, 116,60,114,61,112,62,108,65,103,70,102,72,127,64,152,72,0 5650 DATA 127,68, 99,77,98,79,97,83,96,89,96,93,97,97,127,73,158,97, 159,93,159,89,158,83,157,79,156,77,148,75,127,68,0 5660 DATA 127,77,98,100,99,102,100,104,101,106,102,108,108,114,110,115,113,116, 127,83,141,116,144,115,146,114,152,108,153,106,154,104,155,102, 156,100,127,77,0 5670 DATA 127,91,116,118,120,119,125,120,129,120,134,119,138,118,127,91,0 5680 '===== S ====================== 5690 DATA 246,67,201,67,196,68,193,69,190,70,188,71,185,74,184,76,183,79,183,80, 184,83,185,85,187,88,196,92,204,94,210,95,220,96,225,96,227,98, 227,100,225,102,215,104,206,104,201,103,195,101,183,95,183,105 5700 DATA 194,110,203,112,212,113,219,113,227,112,235,110,243,106,246,103, 248,100,249,97,249,94,248,91,247,89,243,85,241,84,238,83,233,82, 223,81,214,80,209,79,207,79,205,77,205,76,207,74,215,73,223,73,229,74 5710 DATA 233,75,236,76,240,78,246,67,0 5720 '===== A ======================= 5730 DATA 307,67,279,67,256,111,274,111,271,108,274,101,299,101,304,111,323,111, 303,72,307,67,0 5740 DATA 287,76,277,94,296,94,287,76,0 5750 '===== N ==================== 5760 DATA 395,67,379,67,379,95,360,67,335,67,335,111,350,111,347,104,347,77, 370,111,391,111,391,73,395,67,0 5770 '===== Y ======================== 5780 DATA 433,67,404,67,430,93,430,111,449,111,449,93,475,67,457,67,441,83, 430,72,433,67,0 5790 '===== O =========================== 5800 DATA 538,67,503,67,497,68,494,69,487,73,482,78,479,84,478,87,478,92, 479,95,480,98,481,100,488,107,492,109,501,112,506,113,520,113,525,112 5810 DATA 534,109,538,107,543,102,545,98,546,95,547,91,547,88,546,85,543,79, 540,75,535,72,538,67,0 5820 DATA 517,76,507,76,504,77,502,78,497,83,496,85,495,88,495,92,496,95,497,97, 501,101,503,102,505,103,509,104,515,104,518,103,521,102,523,101 5830 DATA 527,97,528,95,529,92,529,88,528,85,527,83,522,78,520,77,517,76,0 5840 '===== M ================== 5850 DATA 127,3,105,3,87,75,69,3,47,3,47,100,60,100,60,18,81,100,93,100,113,18, 113,100,127,100,127,3,0 5860 '===== B ================= 5870 DATA 181,3,143,3,143,100,180,100,184,99,188,97,193,92,194,90,195,87, 196,84,196,66,195,62,193,58,187,52,184,51,179,50,182,49,186,47 5880 DATA 190,43,191,41,193,37,194,33,194,17,193,14,190,8,187,6,181,3,0 5890 DATA 171,12,156,12,156,45,171,45,174,44,176,43,179,40,180,38,181,35, 181,22,180,19,179,17,176,14,174,13,171,12,0 5900 DATA 175,55,156,55,156,90,174,90,177,89,182,84,183,82,184,79,184,66, 183,63,182,60,178,56,175,55,0 5910 '===== C ==================== 5920 DATA 263,30,263,21,262,17,261,14,260,12,253,5,247,2,241,1,228,1,224,2, 220,4,214,10,212,14,211,16,210,20,210,82,211,85,214,91,220,96 5930 DATA 226,100,245,100,251,98,253,97,260,90,261,88,262,85,263,81,263,70, 250,70,250,80,249,82,245,86,241,88,232,88,228,86,224,82,223,80 5940 DATA 222,77,222,25,223,22,224,20,225,18,227,15,230,14,233,13,239,13, 242,14,244,15,248,18,250,23,250,30,263,30,0 5950 '===== - ==================== 5960 DATA 315,45,276,45,276,59,315,59,315,45,0 5970 '===== 5 ==================== 5980 DATA 376,3,332,3,332,59,344,59,345,54,347,51,350,48,352,47,355,46,359,46, 363,48,367,52,369,56,369,78,367,82,364,85,358,88,354,88,350,86 5990 DATA 346,82,345,80,344,77,344,75,332,75,332,81,333,85,335,89,342,96, 348,99,351,100,360,100,365,99,368,98,370,97,372,96,378,90,381,84 6000 DATA 382,80,382,53,381,49,379,45,372,38,368,36,365,35,361,34,354,35, 348,38,345,41,345,15,376,15,376,3,0 6010 '===== 0 ====================== 6020 DATA 434,1,417,1,411,3,407,5,402,10,400,14,398,20,398,81,400,87,402,91, 407,96,411,98,417,100,434,100,440,98,444,96,449,91,451,87,453,81 6030 DATA 453,20,451,14,449,10,444,5,440,3,434,1,0 6040 DATA 431,14,420,14,416,16,412,20,410,24,410,76,412,81,416,85,420,87, 431,87,435,85,439,81,441,76,441,24,439,20,435,16,431,14,0 6050 '===== S ===================== 6060 DATA 35,14,34,13,32,12,29,11,22,11,19,12,17,13,13,17,12,19,11,22,11,25, 12,28,15,31,23,35,24,36,25,38,25,42,24,45,22,46,21,47,17,48,16,48, 13,47,11,46,9,45,5,49,6,51,9,52,13,53,18,52,22,51,25,49,28,45,30,41, 30,37 6070 DATA 29,34,24,30,21,28,19,27,17,25,16,23,16,20,17,18,21,15,26,15,28,16, 31,19,35,15,0 6080 '===== E ==================== 6090 DATA 73,30,74,27,74,22,73,18,72,16,69,13,67,12,63,11,54,11,51,12,47,14,42, 19,40,23,37,31,37,36,38,40,40,44,45,49,47,50,49,51,52,52,58,52 6100 DATA 64,51,66,50,68,49,69,43,65,46,63,47,60,48,57,48,53,47,49,45,45,42, 44,40,43,36,43,30,73,30,0 6110 DATA 67,28,68,25,68,21,66,17,64,16,62,15,54,15,51,16,48,18,46,22,44,26, 44,28,67,28,0 6120 '===== R =================== 6130 DATA 101,12,95,13,93,14,91,16,89,20,88,21,87,21,89,14,83,14,77,52,83,52, 86,32,87,30,90,24,91,22,94,19,97,19,100,20,101,12,0 6140 '===== I ================== 6150 DATA 117,1,115,1,112,4,112,6,115,9,117,9,120,6,120,4,117,1,0 6160 DATA 117,14,111,14,104,52,110,52,117,14,0 6170 '===== PAINT START POINT ==================== 6180 DATA 115,65,105,80,110,100,127,110: '==MARK== 6190 DATA 220,87,300,85,360,82,440,95,487,90: '==SANYO== 6200 DATA 50,10,150,10,220,10,280,50,340,10,420,10,490,10: '==MBC-5000= 6210 DATA 14,23,40,35,84,24,115,5,112,15,123,35,167,23: '==SERIES== 6220 ' ....220,10,280,50,340,10,420,10,490,10: '==MBC-5000= 6210 D ```