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


Recurring Lightning.bas
08-23-2017, 01:55 PM
Post: #1
 (Print Post)
Recurring Lightning.bas
Code Snippet: [Select]
'recurring lightning.bas for SmallBASIC 0.12.9 2017-08-22
'translated from: recurring lightning.txt for JB (B+=MGA) 2017-08-21

def rand(lo, hi) = (rnd * (hi - lo + 1)) \ 1 + lo
def distance(x1, y1, x2, y2) = ( (x1 - x2) ^ 2 + (y1 - y2) ^ 2) ^ .5

drawlandscape
land = image(0, 0, xmax, ymax)
while 1
  land.show(0, 0)
  delay 65      '<< adjust time as needed for your system
  cls
  rPause = rand(30, 3500)
  delay rPause
  rStop = rand(1, 4)
  xo = rand(.25 * XMAX, .75 * XMAX)
  yo = rand(0, .35 * YMAX)
  for i = 1 to rStop
    xe = rand(0, XMAX)
    ye = rand(0, .5 * YMAX)
    dist = distance(xo, yo, xe, ye)
    d = rand(.3 * dist, .9 * dist)
    Lightning xo, yo, xe, ye, d
  next
  delay 50
wend

sub Lightning(x1, y1, x2, y2, d)
  local mx, my
  if d < 5 then
    color rgb(225, 225, 245)
    line x1, y1, x2, y2
  else
    mx = (x2 + x1) / 2
    my = (y2 + y1) / 2
    mx = mx + -.5 * rnd * d * .4 * rand(-2, 2)
    my = my + -.5 * rnd * d * .4 * rand(-2, 2)
    Lightning x1, y1, mx, my, d/2
    Lightning x2, y2, mx, my, d/2
  end if
end sub

sub drawLandscape
  'the sky
  for i = 0 to ymax
    midInk 0, 0, 0, 128, 128, 128, i/ymax
    line 0, i, XMAX, i
  next
  'the land
  startH = YMAX - 200
  rr = 70 : gg = 70 : bb = 90
  for mountain = 1 to 6
    Xright = 0
    y = startH
    while Xright < XMAX
      ' upDown = local up / down over range, change along Y
      ' range = how far up / down, along X
      upDown = (rnd *.8 - .35) * (mountain *.5)
      range = Xright + rand(15, 25) * 2.5/mountain
      for x = Xright -1 to range
        y = y + upDown
        color rgb(rr, gg, bb)
        line x, y, x, YMAX
      next
      Xright = range
    wend
    rr = rand(rr - 15, rr) : gg = rand(gg - 15, gg) : bb = rand(bb - 25, bb)
    if rr < 0 then rr = 0
    if gg < 0 then gg = 0
    if bb < 0 then bb = 0
    startH = startH + rand(5, 20)
  next
end sub

sub midInk(r1, g1, b1, r2, g2, b2, fr)
  color rgb(r1+(r2-r1)*fr, g1+(g2-g1)*fr, b1+(b2-b1)*fr)
end

Hot summer night, heat lightning flashes above a hills scene.

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



Forum Jump:


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




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