Squot640 FREEWARE by Eric F. Tchong, listed 04-30-2004 10 ' 1993 squot640.bas - FREEWARE 2004 20 GOTO 100 30 SAVE "squot640":LIST-80 40 GOTO 760 ' set x for horizontal bounce 50 GOTO 790 ' set y for vertical bounce 60 GOTO 870 ' clear line 70 GOTO 890 ' wait for key 80 GOTO 920 ' calculate centered text 90 ' Begin 100 DEFSTR M,Q:Q=MKI$(0) 110 SP=500:B=555:C=222:K=15:A=0:EC=0 ' locals 120 X=0:Y=0:DX=0:DY=0:P1=B:P2=C:SS=0 130 SCREEN 9:KEY OFF:DIM M(11) 140 M(1)="A KALEIDOSCOPIC GRAPHICS GENERATOR" 150 M(2)="in GwBasic" 160 M(3)="by Eric F. Tchong - Aruba" 170 M(4)="Esc = Exit Enter = New data" 180 M(5)=CHR$(25)+" = Turtle "+CHR$(24)+" = Turbo " 190 M(6)=CHR$(27)+" = Slower "+CHR$(26)+" = Faster" 200 M(7)="c = clear screen s = single-step" 210 M(8)="r = restart data x = exit s-step":PRINT 220 M(9) ="Horizontal limit =" 230 M(10)=" Vertical limit =" 240 M(11)="0 for previous limits ..." 250 CLS:COLOR 15,0 260 FOR I=1 TO 11 270 IF I=9 THEN GOSUB 80:PRINT B:GOTO 310 280 IF I=10 THEN GOSUB 80:PRINT C:GOTO 310 290 GOSUB 80 300 IF I=3 OR I=6 OR I=8 THEN PRINT 310 NEXT 320 LOCATE 17,25:INPUT "Horizontal limit 1-640 ";B ' b=x limit 330 IF B>640 THEN GOSUB 60:GOTO 320 340 IF B=0 THEN B=P1 ELSE P1=B 350 LOCATE 18,25:INPUT "Vertical limit 1-350 ";C ' c=y limit 360 IF C>350 THEN GOSUB 60:GOTO 350 370 IF C=0 THEN C=P2 ELSE P2=C 380 ' Initialize 390 CLS:X=0:Y=0:DX=1:DY=1 ' dx=x step, dy=y step 400 LSET Q=MKI$(0) 410 WHILE CVI(Q)=0 420 ' Generate patterns 430 IF SS=1 THEN GOSUB 70 ' single-step mode 440 FOR EC=1 TO SP:NEXT ' slow, fast or turbo 450 A=X:A=A+DX ' get x, x=x+x step 460 IF A>B THEN GOSUB 40 ' Is x > x limit ? 470 IF A=0 THEN GOSUB 40 ' Is x = 0 ? 480 X=A:A=Y:A=A+DY ' save x, get y, y=y+y step 490 IF A>C THEN GOSUB 50 ' Is y > y limit ? 500 IF A=0 THEN GOSUB 50 ' Is y = 0 ? 510 Y=A ' save y 520 IF POINT (X,Y)=0 THEN 540 ELSE 560 ' test for pset or preset 530 ' Set pixel on 540 PSET(X,Y):PSET(640-X,Y):PSET(X,350-Y):PSET(640-X,350-Y):GOTO 570 550 ' Set pixel off 560 PRESET(X,Y):PRESET (640-X,Y):PRESET (X,350-Y):PRESET (640-X,350-Y) 570 MID$(Q,1)=INKEY$:IF CVI(Q) THEN 580 580 WEND 590 IF ASC(Q)=13 THEN 250 ' enter to restart with new values 600 IF ASC(Q)=27 THEN 960 ' Esc = exit 610 IF ASC(Q)=32 THEN 710 ' space to display data in use 620 IF ASC(Q)=99 THEN CLS ' c = clear screen 630 IF ASC(Q)=114 THEN 390 ' r = restart 640 IF ASC(Q)=115 THEN SS=1:GOTO 400 ' s = single step 650 IF ASC(Q)=120 THEN SS=0:GOTO 400 ' x = exit single-step mode 660 IF CVI(Q)=20480 THEN GOSUB 820 ' Turtle down arrow 670 IF CVI(Q)=19200 THEN GOSUB 840 ' Turbo up arrow 680 IF CVI(Q)=18432 THEN GOSUB 830 ' Slower left arrow 690 IF CVI(Q)=19712 THEN GOSUB 850 ' Faster right arrow 700 GOTO 400 710 CLS:COLOR 15,0 720 LOCATE 17,25:PRINT "Horizontal limit =";B 730 LOCATE 18,25:PRINT " Vertical limit =";C 740 GOSUB 70:CLS:GOTO 400 750 ' Set x for horizontal bounce 760 COLOR K,0:K=K+1:IF K>15 THEN K=9 770 F=A:A=0:A=A-DX:DX=A:A=F:A=A+DX:A=A+DX:RETURN 780 ' Set y for vertical bounce 790 COLOR K,0:K=K+1:IF K>15 THEN K=9 800 F=A:A=0:A=A-DY:DY=A:A=F:A=A+DY:RETURN 810 ' Change cursor speed 820 SP=20000:RETURN ' Turtle 830 SP=0:RETURN ' Turbo 840 SP=SP+100:IF SP=20100 THEN 820 ELSE RETURN ' Slower 850 SP=SP-100:IF SP= -100 THEN 830 ELSE RETURN ' Faster 860 ' Clear line 870 PRINT CHR$(30);:PRINT STRING$(40,32):PRINT CHR$(30);:RETURN 880 ' Wait for key 890 LSET Q=MKI$(0) 900 WHILE CVI(Q)=0:MID$(Q,1)=INKEY$:WEND:RETURN 910 ' Calculate centered text 920 X=(80-LEN(M(I)))/2 930 IF I=9 OR I=10 THEN PRINT TAB(X) M(I);:RETURN 940 PRINT TAB(X) M(I):RETURN 950 ' Exit 960 SCREEN 2:SCREEN 0:KEY 5,"squot640.bas":KEY 6,CHR$(34)+",a" 970 KEY ON:END 980 ' Originally a Z80 machine language program. 990 ' Rewritten for GwBasic by Eric F. Tchong: August 13, 1993 1000 ' Reference: 80 Micro, June 1984 - pages 83 to 92