You are not logged in or registered. Please login or register to use the full functionality of this board...
SIGN IN Join Our Community For FREE


It's the 4th, have a blast!
07-03-2017, 11:42 PM
Post: #1
 (Print Post)
It's the 4th, have a blast!
Code Snippet: [Select]
' more particles.bas  SmallBASIC 0.12.8 [B+=MGA] 2016-11-18
' from: more particles.sdlbas [B+=MGA] 2016-11-18
' attempt to simulate alpha effect
func rand(n1, n2)
  if n1 > n2 then hi = n1 : lo = n2 else hi = n2 : lo = n1
  rand = (rnd * (hi - lo + 1)) \ 1 + lo
end
def rdir = iff(rnd < .5, -1, 1)
numPoints = 100
dim  vx(numPoints), vy(numPoints), clr(numPoints), life(numPoints), lifeTime(numPoints)
wantColor = 1  'colorize on/off, 1 or 0
for i = 0 to numPoints
  initPoint(i)
next
while 1
  cls
  for p = 0 to numPoints
    life(p) += 1
    if life(p) = lifeTime(p) then
      initPoint(p)
    else
      'redraw the whole arc of particle path
      x0 = xmax/2 : y0 = .35 *  ymax : drop = vy(p)
      for i = 0 to life(p)
        if wantColor then
          select case clr(p)
          case 0
            r = 1: g = 0 : b = 0
          case 1
            r =1 : g = 1 : b = 1
          case 2
            r =0 : g = 0 : b = 1
          case 3
            r = 0 : g = .7 : b = 0
          case 4
            r= 1: g = 1 : b = 0
          case 5
            r = 1 : g = 0 : b = 1
          case 6
            r = 1 : g = .6 : b = 0
          end select
          if r = 0 then
            r = 3 * (life(p) - i)
          else
            r = i/life(p) * 255 * r
          end if
          if g = 0 then
            g = 3 * (life(p) - i)
          else
            g = i/life(p) * 255 * g
          end if
          if b = 0 then
            b = 3 * (life(p) -1)
          else
            b = i/life(p) * 255 * b
          end if
          color rgb(r, g, b)
        else
          m = i/life(p) * 255
          color rgb(m, m, m)
        end if
        xnext = x0 + vx(p)
        drop += .1
        ynext = y0 + drop
        radius = i/life(p) * 8
        circle xnext, ynext, radius filled
        x0 = xnext
        y0 = ynext
      next
    end if
  next
  showpage
wend
sub initPoint(p)
  vx(p) = rnd * 7  * rdir
  vy(p) = rnd * 7  * rdir
  clr(p) = rand(0, 6)
  life(p) = 0
  lifeTime(p) = rand(30, 70)
end


Attached File(s) Image(s)
   

B += _
Find all posts by this user
Like Post
07-03-2017, 11:46 PM
Post: #2
 (Print Post)
RE: It's the 4th, have a blast!
Code Snippet: [Select]
'fireworks 3.bas SmallBASIC 0.12.2 [B+=MGA] 2015-05-09
'fireworks 2.bas 2016-05-05 now with Gravity, Newtonian bounce, smoke debris
'fireworks 3.bas try with map variables make bursts around a central point

flare_max = 300 : debris_max = 5000 : debris_stack = 0
dim flare(flare_max)
dim debris(debris_max)
sub NewDebris(i)
  local c
  debris(i).x = rnd * xmax
  debris(i).y = rnd * ymax
  c = rnd * 255
  debris(i).c = rgb(c, c, c)
end
while 1
   rnd_cycle = rnd * 30
   loop_count = 0
   burst.x = .75 * xmax * rnd + .125 * xmax
   burst.y = .5 * ymax * rnd +.125 * ymax
   repeat
      cls
      'color 14 : locate 0,0: ? debris_stack; " Debris" 'debug line
      for i=1 to 20   'new burst using random old flames to sim burnout
         nxt = rnd * flare_max + 1
         angle = rnd * 2 * pi
         flare(nxt).x = burst.x + rnd * 5 * cos(angle)
         flare(nxt).y = burst.y + rnd * 5 * sin(angle)
         angle = rnd * 2 * pi
         flare(nxt).dx = rnd * 15 * cos(angle)
         flare(nxt).dy = rnd * 15 * sin(angle)
         rc = int(rnd * 3)
         if rc = 0 then
            'flare(nxt).c = 12 'patriotic theme
            flare(nxt).c = rgb(255, rnd * 255, 0)
         elseif rc = 1
            'flare(nxt).c = 9 'patriotic theme
            flare(nxt).c = rgb(100 + rnd * 155, 100 + rnd * 155, 220)
         else
            flare(nxt).c = 15
         endif
      next
      for i = 0 to flare_max
         if flare(i).dy then 'while still moving vertically
            line flare(i).x, flare(i).y step flare(i).dx, flare(i).dy, rgb(98, 98, 98)
            circle step flare(i).dx, flare(i).dy, 1, 1, flare(i).c filled
            flare(i).x += flare(i).dx
            flare(i).y += flare(i).dy
            flare(i).dy += .4  'add  gravity
            flare(i).dx *= .99 'add some air resistance
            if flare(i).x < 0 or flare(i).x > xmax then flare(i).dy = 0  'outside of screen
            'add some spark bouncing here
            if flare(i).y > ymax then
              if abs(flare(i).dy) > .5 then
                flare(i).y = ymax : flare(i).dy *= -.25
              else
                flare(i).dy = 0
              fi
            fi
          fi
      next
      for i = 0 to debris_stack
        pset debris(i).x, debris(i).y, debris(i).c
        debris(i).x += rnd * 3 - 1.5
        debris(i).y += rnd * 3.5 - 1.5
        if debris(i).x < 0 or debris(i).y < 0 or debris(i).x > xmax or debris(i).y > ymax then NewDebris(i)
      next
      showpage
      delay 2
      loop_count += 1
    until loop_count > rnd_cycle
    if debris_stack < debris_max then
      for i = 1 to 20
        NewDebris i + debris_stack
      next
      debris_stack += 20
    fi
wend


Attached File(s) Image(s)
   

B += _
Find all posts by this user
Like Post



Forum Jump:


User(s) browsing this thread: 1 Guest(s)




QB64 Member Project - Martin Fractals version one
QB64 Member Project - Spinning Color Wheel
QB64 Member Project - Othello
QB64 Member Project - ARB Checkers
QB64 Member Project - Kobolts Monopoly
QB64 Member Project - Spiro Roses
QB64 Member Project - Line Thickness
QB64 Member Project - Blokus
QB64 Member Project - Martin Fractals version four
QB64 Member Project - Rotating Background
QB64 Member Project - Touche
QB64 Member Project - Domain
QB64 Member Project - Inside Moves
QB64 Member Project - Basic Dithering
QB64 Member Project - Kings Court
QB64 Member Project - Dakapo
QB64 Member Project - Amazon
QB64 Member Project - MAPTRIANGLE
QB64 Member Project - Score 4
QB64 Member Project - Splatter
QB64 Member Project - Color Triangles
QB64 Member Project - 9 Board
QB64 Member Project - Rubix's Magic
QB64 Member Project - Bowditch curve
QB64 Member Project - Point Blank
QB64 Member Project - Pivot version two
QB64 Member Project - RGB Color Wheel
QB64 Member Project - Kings Valley verion one
QB64 Member Project - Foursight
QB64 Member Project - OpenGL Triangles
QB64 Member Project - Isolation
QB64 Member Project - Swirl
QB64 Member Project - Dreamy Clock
QB64 Member Project - Overboard
QB64 Member Project - Pivet version one
QB64 Member Project - Kings Vallery version two
QB64 Member Project - Qubic
QB64 Member Project - Sabotage
QB64 Member Project - Martin Fractals version two
QB64 Member Project - Algeria Weather
QB64 Member Project - Connect Four
QB64 Member Project - Martin Fractals version three
QB64 Member Project - Input
QB64 Member Project - Exit
QB64 Member Project - Color Rotating Text
QB64 Member Project - STxAxTIC 3D World
QB64 Member Project - Red Scrolling LED Sign
QB64 Member Project - Quarto
QB64 Member Project - Full Color LED Sign