BBC BASIC for Windows
Programming >> Graphics and Games >> Bouncing donut... possible gaming application
http://bb4w.conforums.com/index.cgi?board=graphics&action=display&num=1480136452
Bouncing donut... possible gaming application
Post by michael 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