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