Author Topic: Pentacle Flux Capacitor #3, "Dancing Man"  (Read 75 times)

B+

  • Sr. Member
  • ****
  • Posts: 436
    • View Profile
Pentacle Flux Capacitor #3, "Dancing Man"
« on: 25. August 2017, 21:04:27 »
Code: [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