BBC BASIC for Windows
« Isometric Fireworks »

Welcome Guest. Please Login or Register.
Apr 5th, 2018, 9:54pm



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: Isometric Fireworks  (Read 202 times)
marsFS
New Member
Image


member is offline

Avatar




PM

Gender: Male
Posts: 6
xx Isometric Fireworks
« Thread started on: Nov 28th, 2017, 11:45pm »

Hi all,

I've made a little fireworks demo building on the nice isometric code posted by DDRM recently.

Have a play and use the code however you like, let me know if you have any suggestions or improvements to be made, it works in BB4W and BB4SDL :)
Code:
      MODE 22
      ORIGIN 1024,384

      VDU 23,1,0;0;0;0;

      ON ERROR OSCLI "REFRESH ON": MODE 22: END

      REM particle max, firework max
      pMAX%=50
      FireWorkMax%=10

      REM firework structure
      DIM p{(FireWorkMax%) x,y,z,xv,yv,zv,px(pMAX%),py(pMAX%),pz(pMAX%),pxv(pMAX%),pyv(pMAX%),pzv(pMAX%),r%,g%,b%,frameDelay%,pSize,hasExploded%,fade%}

      REM speed constants
      baselineYSpeed=4.0
      maxYSpeed=4.0
      GRAVITY=0.05
      delay%=ABS(INKEY(-256)=87)

      REM initialize all fireworks
      FOR a%=0 TO FireWorkMax%
        PROCinitFW(a%)
      NEXT

      REM isometric constants
      zs=SQR(2)
      r2=SQR(2)

      REM only update screen after everything is drawn
      *REFRESH OFF

      REM main loop
      REPEAT
  
        REM loop to rotate isometric view
        FOR a=0 TO (PI*2) STEP PI/1000
          CLS
          xs=COS(a)
          ys=SIN(a)
    
          REM Draw x axis in red, y axis in green, z axis in blue
          GCOL 1
          PROCDrawLine(0,0,0,400,0,0)
          GCOL 2
          PROCDrawLine(0,0,0,0,400,0)
          GCOL 4
          PROCDrawLine(0,0,0,0,0,400)
    
          REM update fireworks
          PROCmoveFW
    
          REM update display and pause if space pressed
    
          *REFRESH
          REPEAT
            REM no delay on SDL as graphics is slower
            IF delay% WAIT 1
          UNTIL NOT INKEY(-99)
    
        NEXT
      UNTIL FALSE
      END

      REM initialize a firework object to starting location
      DEF PROCinitFW(i%)
      p{(i%)}.x=-400+RND(800)
      p{(i%)}.y=-200+RND(400)
      p{(i%)}.z=0
      p{(i%)}.xv=-3+RND(1)*5
      p{(i%)}.yv=-3+RND(1)*5
      p{(i%)}.zv=baselineYSpeed+(RND(1)*maxYSpeed)

      REM explosion starting colour, fade causes explosion colour to fade out
      p{(i%)}.r%=RND(255)
      p{(i%)}.g%=RND(255)
      p{(i%)}.b%=RND(255)
      p{(i%)}.fade%=100

      REM firwork waits until frameDelay=0
      p{(i%)}.frameDelay%=RND(200)
      p{(i%)}.pSize=1.0+RND(1)*3
      p{(i%)}.hasExploded%=0

      ENDPROC

      REM update firework and explosions position and plot particles
      DEF PROCmoveFW
      LOCAL i%,j%
      FOR i%=0 TO FireWorkMax%
  
        REM set colour to yellow for firework and rgb for explosion
        GCOL 3
        IF p{(i%)}.hasExploded%=0 THEN
          COLOUR 3,255,255,0
        ELSE
          COLOUR 3,p{(i%)}.r%,p{(i%)}.g%,p{(i%)}.b%
        ENDIF
  
        REM if firework is visible then update
        IF p{(i%)}.frameDelay%<=0 THEN
          REM update main firework co-ordinates
          p{(i%)}.x+=p{(i%)}.xv
          p{(i%)}.y+=p{(i%)}.yv
          p{(i%)}.z+=p{(i%)}.zv
          p{(i%)}.zv-=GRAVITY
    
          REM plot main firework particle
          PROCplotParticle(p{(i%)}.x,p{(i%)}.y,p{(i%)}.z)
    
          REM if firwork has exploded then update explosion co-ordinates
          IF p{(i%)}.hasExploded%=1 THEN
            FOR j%=0 TO pMAX%
              p{(i%)}.px(j%)+=p{(i%)}.pxv(j%)
              p{(i%)}.py(j%)+=p{(i%)}.pyv(j%)
              p{(i%)}.pz(j%)+=p{(i%)}.pzv(j%)
              p{(i%)}.pzv(j%)-=GRAVITY
        
              REM plot explosion particles
              PROCplotParticle(p{(i%)}.px(j%),p{(i%)}.py(j%),p{(i%)}.pz(j%))
            NEXT
      
            REM decrement fade counter, if 0 then initialize a new firework
            p{(i%)}.fade%-=1
            IF p{(i%)}.fade%<0 THEN PROCinitFW(i%)
      
            REM fade explosion rgb color values
            IF p{(i%)}.r%>0 THEN p{(i%)}.r%-=1
            IF p{(i%)}.g%>0 THEN p{(i%)}.g%-=1
            IF p{(i%)}.b%>0 THEN p{(i%)}.b%-=1
      
          ENDIF
    
          REM if firework has not exploded and has reached maximum height then trigger explosion
          IF p{(i%)}.zv<0 AND p{(i%)}.hasExploded%=0 THEN
      
            REM update main firework particle to be part of explosion
            p{(i%)}.hasExploded%=1
      
            p{(i%)}.xv=-5+RND(1)*9
            p{(i%)}.yv=-5+RND(1)*9
            p{(i%)}.zv=-5+RND(1)*9
      
            REM set explosion position to match main firework and randomize explosion particle velocities
            FOR j%=0 TO pMAX%
              p{(i%)}.px(j%)=p{(i%)}.x
              p{(i%)}.py(j%)=p{(i%)}.y
              p{(i%)}.pz(j%)=p{(i%)}.z
              p{(i%)}.pxv(j%)=-5+RND(1)*9
              p{(i%)}.pyv(j%)=-5+RND(1)*9
              p{(i%)}.pzv(j%)=-5+RND(1)*9
            NEXT
          ENDIF
    
        ELSE
          p{(i%)}.frameDelay%-=1
        ENDIF
      NEXT
      ENDPROC

      REM draw a line in isometric viewport
      DEF PROCDrawLine(px1,py1,pz1,px2,py2,pz2)
      MOVE px1*xs+py1*ys,pz1*zs+(py1*xs-px1*ys)
      DRAW px2*xs+py2*ys,pz2*zs+(py2*xs-px2*ys)
      ENDPROC

      REM draw a rectangle in isometric viewport
      DEF PROCplotParticle(px1,py1,pz1)
      RECTANGLE FILL px1*xs+py1*ys,pz1*zs+(py1*xs-px1*ys),8,8
      ENDPROC
 
User IP Logged

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