PROCgraphics coun%=0:angle=0:angley=0:coun%=1000 *REFRESH OFF REPEAT x%=coun%*COS(RAD(angle)) y%=coun%*SIN(RAD(angley)) PROCcolor("b","000,000,000") CLG PROCcolor("f","255,255,255"):PROC_donut(1+x%,1+y%,RND(255),RND(200),RND(220)):*REFRESH angle+=2.1:angley+=3:IF angle>359 THEN angle=0 IF angley>359 THEN angley=0 IF y%<1 THEN angley-=180 IF x%<0 THEN angle-=180 WAIT 10 UNTIL FALSE END DEF PROC_donut(H,V,RR,GG,BB) PROC_ellipsering(3,3,H,V,30,40,RR,GG,BB,10) PROC_sphere(H,V,10,RR,GG,BB,7) ENDPROC DEF PROC_ellipsering(CENTERH,CENTERV,H,V,SIZE,THICKNESS,X,C,A,DI) IF SIZE > THICKNESS THEN SIZE = THICKNESS OC=THICKNESS/2 OUTCENTERH=CENTERH+OC OUTCENTERV=CENTERV+OC R=0 SWITCH=0 DEPTHCOUNT=SIZE/2 FOR Y=1 TO DEPTHCOUNT COLOUR 1,X,C,A GCOL 1 ELLIPSE H,V,OUTCENTERH-R,OUTCENTERV-R ELLIPSE H,V,OUTCENTERH+R,OUTCENTERV+R R=R+1 X=X-DI C=C-DI A=A-DI IF X<2 THEN X=2 IF C<2 THEN C=2 IF A<2 THEN A=2 NEXT Y PROCresetrgb ENDPROC DEFPROC_sphere(H,V,SIZE,R,G,B,DI) LOCAL r%,g%,b%,di%,c%,x%,size%,skip% skip%=FALSE r%=R g%=G b%=B size%=SIZE di%=DI FOR x%=0 TO size% c%=50 r%=r%-di% g%=g%-di% b%=b%-di% IF r% <2 THEN r%=2 IF g% <2 THEN g%=2 IF b%<2 THEN b%=2 IF r%<50 AND g%<50 AND b%<50 THEN skip%=TRUE IF skip%=FALSE THEN COLOUR 1,r%,g%,b%:GCOL 1 CIRCLE H,V,x% ENDIF NEXT x% PROCresetrgb ENDPROC DEF PROCcolor(fb$,rgb$) PRIVATE assemble$,br%,bg%,bb% IF rgb$="0" OR rgb$="black" THEN rgb$="000,000,000" IF rgb$="1" OR rgb$="red" THEN rgb$="200,000,000" IF rgb$="2" OR rgb$="green" THEN rgb$="000,200,000" IF rgb$="3" OR rgb$="yellow" THEN rgb$="200,200,000" IF rgb$="4" OR rgb$="blue" THEN rgb$="000,000,200" IF rgb$="5" OR rgb$="magenta" THEN rgb$="200,000,200" IF rgb$="6" OR rgb$="cyan" THEN rgb$="000,200,200" IF rgb$="7" OR rgb$="white" THEN rgb$="200,200,200" IF rgb$="8" OR rgb$="grey" THEN rgb$="056,056,056" IF rgb$="9" OR rgb$="light red" THEN rgb$="248,056,056" IF rgb$="10" OR rgb$="light green" THEN rgb$="056,248,056" IF rgb$="11" OR rgb$="light yellow" THEN rgb$="248,248,056" IF rgb$="12" OR rgb$="light blue" THEN rgb$="056,056,248" IF rgb$="13" OR rgb$="light magenta" THEN rgb$="248,056,248" IF rgb$="14" OR rgb$="light cyan" THEN rgb$="056,248,248" IF rgb$="15" OR rgb$="light white" THEN rgb$="248,248,248" assemble$=rgb$ br%=VAL(MID$(assemble$,1,3)):bg%=VAL(MID$(assemble$,5,3)):bb%=VAL(MID$(assemble$,9,3)) IF fb$="f" OR fb$="F" THEN COLOUR 0,br%,bg%,bb% : GCOL 0 IF fb$="b" OR fb$="B" THEN COLOUR 1,br%,bg%,bb% : GCOL 128+1 ENDPROC REM restore default color palettes DEFPROCresetrgb COLOUR 0,0,0,0 :COLOUR 1,200,0,0 :COLOUR 2,000,200,000 COLOUR 3,200,200,000:COLOUR 4,000,000,200:COLOUR 5,200,000,200 COLOUR 6,000,200,200:COLOUR 7,200,200,200:COLOUR 8,056,056,056 COLOUR 9,248,056,056:COLOUR 10,056,248,056:COLOUR 11,248,248,056 COLOUR 12,056,056,248:COLOUR 13,248,056,248:COLOUR 14,056,248,248 COLOUR 15,248,248,248 ENDPROC REM "mygraphics" -LIBRARY ************************ DEF PROCgraphics VDU 23,22,1024;600;8,15,16,1 OFF VDU 5 REM these variables are temporary ENDPROC
PROCgraphics coun%=0:angle=0:angley=0:coun%=1000 *REFRESH OFF REPEAT x%=coun%*COS(RAD(angle)) y%=coun%*SIN(RAD(angley)) PROCcolor("b","000,000,000") CLG PROCcolor("f","255,255,255"):PROC_donut(1+x%,1+y%,RND(255),RND(200),RND(220)):*REFRESH angle-=2.1:angley+=3.1:IF angle>359 THEN angle=0 IF angley>359 THEN angley=0 :IF angle<0 THEN angle=360 IF y%<1 THEN angley-=180 IF x%<0 THEN angle-=180 IF x%>500 THEN angle+=180 coun%-=1:IF coun%<0 coun%=0 WAIT 10 UNTIL FALSE END DEF PROC_donut(H,V,RR,GG,BB) PROC_ellipsering(3,3,H,V,30,40,RR,GG,BB,10) PROC_sphere(H,V,10,RR,GG,BB,7) ENDPROC DEF PROC_ellipsering(CENTERH,CENTERV,H,V,SIZE,THICKNESS,X,C,A,DI) IF SIZE > THICKNESS THEN SIZE = THICKNESS OC=THICKNESS/2 OUTCENTERH=CENTERH+OC OUTCENTERV=CENTERV+OC R=0 SWITCH=0 DEPTHCOUNT=SIZE/2 FOR Y=1 TO DEPTHCOUNT COLOUR 1,X,C,A GCOL 1 ELLIPSE H,V,OUTCENTERH-R,OUTCENTERV-R ELLIPSE H,V,OUTCENTERH+R,OUTCENTERV+R R=R+1 X=X-DI C=C-DI A=A-DI IF X<2 THEN X=2 IF C<2 THEN C=2 IF A<2 THEN A=2 NEXT Y PROCresetrgb ENDPROC DEFPROC_sphere(H,V,SIZE,R,G,B,DI) LOCAL r%,g%,b%,di%,c%,x%,size%,skip% skip%=FALSE r%=R g%=G b%=B size%=SIZE di%=DI FOR x%=0 TO size% c%=50 r%=r%-di% g%=g%-di% b%=b%-di% IF r% <2 THEN r%=2 IF g% <2 THEN g%=2 IF b%<2 THEN b%=2 IF r%<50 AND g%<50 AND b%<50 THEN skip%=TRUE IF skip%=FALSE THEN COLOUR 1,r%,g%,b%:GCOL 1 CIRCLE H,V,x% ENDIF NEXT x% PROCresetrgb ENDPROC DEF PROCcolor(fb$,rgb$) PRIVATE assemble$,br%,bg%,bb% IF rgb$="0" OR rgb$="black" THEN rgb$="000,000,000" IF rgb$="1" OR rgb$="red" THEN rgb$="200,000,000" IF rgb$="2" OR rgb$="green" THEN rgb$="000,200,000" IF rgb$="3" OR rgb$="yellow" THEN rgb$="200,200,000" IF rgb$="4" OR rgb$="blue" THEN rgb$="000,000,200" IF rgb$="5" OR rgb$="magenta" THEN rgb$="200,000,200" IF rgb$="6" OR rgb$="cyan" THEN rgb$="000,200,200" IF rgb$="7" OR rgb$="white" THEN rgb$="200,200,200" IF rgb$="8" OR rgb$="grey" THEN rgb$="056,056,056" IF rgb$="9" OR rgb$="light red" THEN rgb$="248,056,056" IF rgb$="10" OR rgb$="light green" THEN rgb$="056,248,056" IF rgb$="11" OR rgb$="light yellow" THEN rgb$="248,248,056" IF rgb$="12" OR rgb$="light blue" THEN rgb$="056,056,248" IF rgb$="13" OR rgb$="light magenta" THEN rgb$="248,056,248" IF rgb$="14" OR rgb$="light cyan" THEN rgb$="056,248,248" IF rgb$="15" OR rgb$="light white" THEN rgb$="248,248,248" assemble$=rgb$ br%=VAL(MID$(assemble$,1,3)):bg%=VAL(MID$(assemble$,5,3)):bb%=VAL(MID$(assemble$,9,3)) IF fb$="f" OR fb$="F" THEN COLOUR 0,br%,bg%,bb% : GCOL 0 IF fb$="b" OR fb$="B" THEN COLOUR 1,br%,bg%,bb% : GCOL 128+1 ENDPROC REM restore default color palettes DEFPROCresetrgb COLOUR 0,0,0,0 :COLOUR 1,200,0,0 :COLOUR 2,000,200,000 COLOUR 3,200,200,000:COLOUR 4,000,000,200:COLOUR 5,200,000,200 COLOUR 6,000,200,200:COLOUR 7,200,200,200:COLOUR 8,056,056,056 COLOUR 9,248,056,056:COLOUR 10,056,248,056:COLOUR 11,248,248,056 COLOUR 12,056,056,248:COLOUR 13,248,056,248:COLOUR 14,056,248,248 COLOUR 15,248,248,248 ENDPROC REM "mygraphics" -LIBRARY ************************ DEF PROCgraphics VDU 23,22,1024;600;8,15,16,1 OFF VDU 5 REM these variables are temporary ENDPROC