PROCgraphics
coun%=0:angle=0:angley=0:coun%=200
*REFRESH OFF
PROCcolor("b","000,000,000")
REPEAT
x%=coun%*COS(RAD(angle))
y%=coun%*SIN(RAD(angley))
REM CLG
PROC_donut(500+x%,500-y%,RND(255),RND(200),220):*REFRESH
angle=angle+2.1:angley+=3:IF angle>359 THEN angle=0
IF angley>359 THEN angley=0
WAIT 5
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
(leap)
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
VDU 23,22,1024;600;8,16,16,1
VDU 23,1,0;0;0;0;
ON ERROR OSCLI "REFRESH ON": COLOUR 1,255,255,255: PRINT "Done!": END
REM configure variables for angles and shapes etc
angle=0
angley=0
coun%=400
radius%=48
timeout%=0
shape%=0
shapes%=4
delay%=ABS(INKEY(-256)=87)
REM colour indexes
R%=255
G%=0
B%=0
REM colour increments
Ra%=-1
Ga%=0
Ba%=1
*REFRESH OFF
GCOL 1
REPEAT
REM calc new x and y offset
x%=coun%*COS(RAD(angle))
y%=coun%*SIN(RAD(angley))
REM set current draw colour
COLOUR 1,R%,G%,B%
REM choose a shape to draw
CASE shape% OF
WHEN 0 : CIRCLE FILL 1024+x%*2,600-y%,radius%
WHEN 1 : CIRCLE 1024+x%*2,600-y%,radius%
WHEN 2 : RECTANGLE 1024+x%*2,600-y%,radius%*2,radius%*2
WHEN 3 : CIRCLE 1024+x%*2,600-y%,radius%
CIRCLE 1024+x%*2,600-y%,radius% DIV 2
ENDCASE
*REFRESH
REM update angles
angle=angle+2.1:IF angle>359 THEN angle=angle-360
angley+=3: IF angley>359 THEN angley=angley-360
REM increment red counter
R%=R%+Ra%
IF R%<0 THEN R%=0 : Ra%=RND(3)-1 : Ga%=RND(5)-3 : Ba%=RND(5)-3
IF R%>255 THEN R%=255 : Ra%=RND(3)-3 : Ga%=RND(5)-3 : Ba%=RND(5)-3
REM increment green counter
G%=G%+Ga%
IF G%<0 THEN G%=0 : Ra%=RND(5)-3 : Ga%=RND(3)-1 : Ba%=RND(5)-3
IF G%>255 THEN G%=255 : Ra%=RND(5)-3 : Ga%=RND(3)-3 : Ba%=RND(5)-3
REM increment blue counter
B%=B%+Ba%
IF B%<0 THEN B%=0 : Ra%=RND(5)-3 : Ga%=RND(5)-3 : Ba%=RND(3)-1
IF B%>255 THEN B%=255 : Ra%=RND(5)-3 : Ga%=RND(5)-3 : Ba%=RND(3)-3
REM reset red counter if all adders =0
IF Ra%=0 AND Ga%=0 AND Ba%=0 THEN Ra%=2
REM update shape counter after timeout or Enter key pressed
timeout%+=1
IF timeout%>1000 OR INKEY(-74) THEN
timeout%=0
shape%=(shape%+1) MOD shapes%
radius%=48+RND(32)*2
REPEAT
WAIT 1
UNTIL NOT INKEY(-74)
CLS
ENDIF
REM pause if space pressed
REPEAT
REM no delay on SDL as graphics is slower
IF delay% WAIT 1
UNTIL NOT INKEY(-99)
UNTIL FALSE