sanyo-demo
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