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


PFC #3 improvements
08-25-2017, 02:57 PM
Post: #1
 (Print Post)
PFC #3 improvements
Code Snippet: [Select]
' Pentacle Flux Capacitor #3.bas SmallBASIC 0.12.9 (B+=MGA) 2017-08-25
' based on mods made in Just Basic version

' Pentacle Flux Capacitor 2.bas SmallBASIC 0.12.9 (B+=MGA) 2017-08-23
'Pentacle Flux Capacitor 2.bas for QB64 fork 2017-08-23
'translated from: Pentacle Flux Capacitor 2.txt for JB (B+=MGA) 2017-08-23

'Some dancing music for the Dancing figure

'Electric Light Orchestra (ELO) It's a Livin' Thing...
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'  https://www.youtube.com/watch?v=i2d45tOgBl0&index=1&list=RDi2d45tOgBl0
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

RANDOMIZE TIMER
'COMMON SHARED xc, yc, dist, tp(), tp2()
xc = xmax / 2
yc = ymax / 2
DIM tp(4, 1), tp2(4, 1)
drawPFC
PFC = Image(0, 0, xmax, ymax)
while 1
 cls
 PFC.show(0, 0, , 20) ' use image transparency
 color rgb(rand(100, 255), rand(100, 255), rand(200, 255))
 Lightning xc, yc - 90, xc, yc + 10, 135
 FOR i = 0 TO 4
   xe = tp2(i, 0)
   ye = tp2(i, 1)
   d = rand(.1 * dist, .7 * dist)
   SELECT CASE i
   CASE 0
     Lightning xc, yc - 90, xe, ye, .65*d
     Lightning xc, yc - 90, xe, ye, .65*d
   CASE 1, 4
     Lightning xc, yc - 70, xe, ye, d
   CASE 2, 3
     Lightning xc, yc + 10, xe, ye, d
   END SELECT
 NEXT
 Showpage
 delay 30
WEND

SUB drawPFC
 local pRadius, cRadius, a3, r, ao, a, rr, i, xx, yy, dGray, dis, pnt, midx, midy
 'keep global tp(), tp2(), xc, yc, dist
 '3 main points for array tp()
 pRadius = 40: cRadius = 1.5 * pRadius
 a3 = PI * (2 / 5): r = ymax / 2 - cRadius - 20
 ao = PI* (-1 / 2): a = ao
 FOR rr = ymax/2-20 TO 0 STEP -1
   midInk 0, 0, 0, 128, 0, 0, rr / r
   Circle xc, yc, rr filled
 NEXT
 FOR i = 0 TO 4
   tp(i, 0) = xc + r * COS(a)
   tp(i, 1) = yc + r * SIN(a)
   FOR rr = cRadius TO pRadius STEP -1
     COLOR RGB((rr - pRadius) /(cRadius - pRadius) * 255 * (cRadius - rr + pRadius) / cRadius, 0, 0)
     xx = tp(i, 0): yy = tp(i, 1)
     Circle xx, yy, rr filled
   NEXT
   a = a + a3
 NEXT
 xx = tp(0, 0): yy = tp(0, 1)
 dist = distance(xx, yy, xc, yc) 'global
 FOR pnt = 0 TO 4
   FOR dis = 0 TO .5 * dist STEP 10
     dGray = 255 * dis / dist
     xx = tp(pnt, 0): yy = tp(pnt, 1)
     midpoint xx, yy, xc, yc, dis / dist, midx, midy
     FOR r = pRadius * (dist - dis) / dist TO 0 STEP -1
       midInk dGray, dGray, dGray, 255, 255, 255, (pRadius - r) / pRadius
       Circle midx, midy, r filled
     NEXT
   NEXT
   tp2(pnt, 0) = midx
   tp2(pnt, 1) = midy
 NEXT
END SUB

SUB Lightning (x1, y1, x2, y2, d)
 local mx, my
 IF d < 5 THEN
   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 midpoint (x1, y1, x2, y2, fraction, byref midx, byref midy)
 midx = (x2 - x1) * fraction + x1
 midy = (y2 - y1) * fraction + y1
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 SUB

FUNC distance(x1, y1, x2, y2)
 distance = ((x1 - x2) ^ 2 + (y1 - y2) ^ 2) ^ .5
END

FUNC rand(lo, hi)
 rand = INT(RND * (hi - lo + 1)) + lo
END


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