BBC BASIC for Windows
« Bouncing donut... possible gaming application »

Welcome Guest. Please Login or Register.
Apr 5th, 2018, 11:08pm



ATTENTION MEMBERS: Conforums will be closing it doors and discontinuing its service on April 15, 2018.
Ad-Free has been deactivated. Outstanding Ad-Free credits will be reimbursed to respective payment methods.

If you require a dump of the post on your message board, please come to the support board and request it.


Thank you Conforums members.

BBC BASIC for Windows Resources
Online BBC BASIC for Windows documentation
BBC BASIC for Windows Beginners' Tutorial
BBC BASIC Home Page
BBC BASIC on Rosetta Code
BBC BASIC discussion group
BBC BASIC for Windows Programmers' Reference

« Previous Topic | Next Topic »
Pages: 1  Notify Send Topic Print
 thread  Author  Topic: Bouncing donut... possible gaming application  (Read 528 times)
michael
Senior Member
ImageImageImageImage


member is offline

Avatar




PM


Posts: 335
xx 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
 
« Last Edit: Nov 26th, 2016, 04:30am by michael » User IP Logged

I like making program generators and like reinventing the wheel
Pages: 1  Notify Send Topic Print
« Previous Topic | Next Topic »

| |

This forum powered for FREE by Conforums ©
Terms of Service | Privacy Policy | Conforums Support | Parental Controls