michael
Senior Member
member is offline
Posts: 335
|
 |
Bouncing donut... possible gaming application
« Thread started on: Nov 26th, 2016, 04:00am » |
|
I am working out the physics for this bouncing ball for pin ball games and ping pong ball style games and perhaps heat seeking missles
The second example, the donut loses bounce and eventually just stops on the bottom
Code: 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
Here is one that eventually runs out of bounce Code: 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
|
Logged