Author Topic: Pentacle Flux Capacitor #2: Dancing Man  (Read 3767 times)

0 Members and 1 Guest are viewing this topic.

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Pentacle Flux Capacitor #2: Dancing Man
« on: September 05, 2019, 12:18:51 pm »
Playing with lightning:
Code: QB64: [Select]
  1. 'Pentacle Flux Capacitor 2.bas for QB64 fork 2017-08-23
  2. 'translated from: Pentacle Flux Capacitor 2.txt for JB (B+=MGA) 2017-08-23
  3. ' updated 2019-09-05 with cleaner more random blackouts, er..., ah, drama!
  4.  
  5. CONST xmax = 800
  6. CONST ymax = 600
  7. SCREEN _NEWIMAGE(xmax, ymax, 32)
  8. _TITLE "Pentacle Flux Capacitor #2: Dancing Man"
  9.  
  10. COMMON SHARED xc, yc, dist, tp(), tp2()
  11. xc = xmax / 2
  12. yc = ymax / 2 + 20
  13. DIM tp(4, 1), tp2(4, 1)
  14. blackout& = _NEWIMAGE(xmax, ymax, 32)
  15. _DEST blackout&
  16. LINE (0, 0)-(xmax, ymax), &H99000000, BF
  17. PFC& = _NEWIMAGE(xmax, ymax, 32)
  18. _DEST PFC&
  19. drawPFC
  20.     _PUTIMAGE , PFC&, 0
  21.     _DISPLAY
  22.     _PUTIMAGE , blackout&, 0
  23.     _DISPLAY
  24.     _DELAY RND * 80 / 1000
  25.     Lightning xc, yc - 90, xc, yc + 10, 135
  26.     FOR i = 0 TO 4
  27.         xe = tp2(i, 0)
  28.         ye = tp2(i, 1)
  29.         d = rand(.1 * dist, .7 * dist)
  30.         SELECT CASE i
  31.             CASE 0
  32.                 Lightning xc, yc - 90, xe, ye, d
  33.                 Lightning xc, yc - 90, xe, ye, d
  34.             CASE 1, 4
  35.                 Lightning xc, yc - 70, xe, ye, d
  36.             CASE 2, 3
  37.                 Lightning xc, yc + 10, xe, ye, d
  38.         END SELECT
  39.     NEXT
  40.     _DISPLAY
  41.     _DELAY RND * 40 / 1000 + 20 / 1000
  42.  
  43.  
  44. SUB drawPFC
  45.     '3 main points for array tp()
  46.     pRadius = 40: cRadius = 1.5 * pRadius
  47.     a3 = _PI(2 / 5): r = ymax / 2 - cRadius
  48.     ao = _PI(-1 / 2): a = ao
  49.     FOR rr = r TO 0 STEP -10
  50.         midInk 255, 255, 255, 0, 0, 128, rr / r
  51.         CircleFill xc, yc, rr
  52.     NEXT
  53.     FOR i = 0 TO 4
  54.         tp(i, 0) = xc + r * COS(a)
  55.         tp(i, 1) = yc + r * SIN(a)
  56.         FOR rr = cRadius TO pRadius STEP -1
  57.             COLOR _RGB((rr - pRadius) / (cRadius - pRadius) * 255 * (cRadius - rr + pRadius) / cRadius, 0, 0)
  58.             xx = tp(i, 0): yy = tp(i, 1)
  59.             CircleFill xx, yy, rr
  60.         NEXT
  61.         a = a + a3
  62.     NEXT
  63.     xx = tp(0, 0): yy = tp(0, 1)
  64.     dist = distance##(xx, yy, xc, yc)
  65.     FOR pnt = 0 TO 4
  66.         FOR dis = 0 TO .5 * dist STEP 10
  67.             dGray = 255 * dis / dist
  68.             xx = tp(pnt, 0): yy = tp(pnt, 1)
  69.             midpoint xx, yy, xc, yc, dis / dist, midx, midy
  70.             FOR r = pRadius * (dist - dis) / dist TO 0 STEP -1
  71.                 midInk dGray, dGray, dGray, 255, 255, 255, (pRadius - r) / pRadius
  72.                 CircleFill midx, midy, r
  73.             NEXT
  74.         NEXT
  75.         tp2(pnt, 0) = midx
  76.         tp2(pnt, 1) = midy
  77.     NEXT
  78.  
  79.  
  80. SUB Lightning (x1, y1, x2, y2, d)
  81.     IF d < 5 THEN
  82.         COLOR _RGB(225, 225, 245)
  83.         LINE (x1, y1)-(x2, y2)
  84.     ELSE
  85.         mx = (x2 + x1) / 2
  86.         my = (y2 + y1) / 2
  87.         mx = mx + -.5 * RND * d * .4 * rand&&(-2, 2)
  88.         my = my + -.5 * RND * d * .4 * rand&&(-2, 2)
  89.         Lightning x1, y1, mx, my, d / 2
  90.         Lightning x2, y2, mx, my, d / 2
  91.     END IF
  92.  
  93. 'Steve McNeil's
  94. SUB CircleFill (CX AS LONG, CY AS LONG, R AS LONG)
  95.     DIM Radius AS LONG, RadiusError AS LONG
  96.     DIM X AS LONG, Y AS LONG
  97.  
  98.     Radius = ABS(R)
  99.     RadiusError = -Radius
  100.     X = Radius
  101.     Y = 0
  102.  
  103.     IF Radius = 0 THEN PSET (CX, CY): EXIT SUB
  104.  
  105.     ' Draw the middle span here so we don't draw it twice in the main loop,
  106.     ' which would be a problem with blending turned on.
  107.     LINE (CX - X, CY)-(CX + X, CY), , BF
  108.  
  109.     WHILE X > Y
  110.         RadiusError = RadiusError + Y * 2 + 1
  111.         IF RadiusError >= 0 THEN
  112.             IF X <> Y + 1 THEN
  113.                 LINE (CX - Y, CY - X)-(CX + Y, CY - X), , BF
  114.                 LINE (CX - Y, CY + X)-(CX + Y, CY + X), , BF
  115.             END IF
  116.             X = X - 1
  117.             RadiusError = RadiusError - X * 2
  118.         END IF
  119.         Y = Y + 1
  120.         LINE (CX - X, CY - Y)-(CX + X, CY - Y), , BF
  121.         LINE (CX - X, CY + Y)-(CX + X, CY + Y), , BF
  122.     WEND
  123.  
  124. SUB midpoint (x1, y1, x2, y2, fraction, midx, midy)
  125.     midx = (x2 - x1) * fraction + x1
  126.     midy = (y2 - y1) * fraction + y1
  127.  
  128. SUB midInk (r1, g1, b1, r2, g2, b2, fr)
  129.     COLOR _RGB(r1 + (r2 - r1) * fr, g1 + (g2 - g1) * fr, b1 + (b2 - b1) * fr)
  130.  
  131. FUNCTION distance## (x1##, y1##, x2##, y2##)
  132.     distance## = ((x1## - x2##) ^ 2 + (y1## - y2##) ^ 2) ^ .5
  133.  
  134. FUNCTION rand&& (lo&&, hi&&)
  135.     rand&& = INT(RND * (hi&& - lo&& + 1)) + lo&&
  136.  

Dancing man.PNG
* Dancing man.PNG (Filesize: 69.05 KB, Dimensions: 800x625, Views: 286)
« Last Edit: September 05, 2019, 12:21:24 pm by bplus »

Offline Petr

  • Forum Resident
  • Posts: 1720
  • The best code is the DNA of the hops.
    • View Profile
Re: Pentacle Flux Capacitor #2: Dancing Man
« Reply #1 on: September 05, 2019, 04:55:37 pm »
Very nice BPlus. All what miss me, is Faraday's cage and Nikola Tesla inside. He was the first to do these high voltage experiments. :)

Offline Ashish

  • Forum Resident
  • Posts: 630
  • Never Give Up!
    • View Profile
Re: Pentacle Flux Capacitor #2: Dancing Man
« Reply #2 on: September 07, 2019, 10:47:32 am »
Beautiful! I can watch this for hours. I'm big fan of Nikola Tesla.
if (Me.success) {Me.improve()} else {Me.tryAgain()}


My Projects - https://github.com/AshishKingdom?tab=repositories
OpenGL tutorials - https://ashishkingdom.github.io/OpenGL-Tutorials