Author Topic: Juila Rings by Relsoft  (Read 665 times)

Offline The Librarian

  • Moderator
Juila Rings by Relsoft
« on: February 06, 2019, 08:38:50 PM »
Juila Rings

Author: Relsoft
Source: qb64.net Forum
URL: http://www.qb64.net/forum/index.php?topic=128.0
Version: QB64
Tags: [fractal] [julia set]

Description:
Automated Julia set explorer.

Source Code:
Code: QB64 [Select]
  1. ' The Lord of the Julia Rings
  2. ' The Fellowship of the Julia Ring
  3. ' Free Basic
  4. ' Relsoft
  5. ' Rel.BetterWebber.com
  6. '
  7. ' Converted to QB64 format by Galleon (FB specific code commented)
  8.  
  9. DEFLNG A-Z
  10.  
  11. ''$include: 'TinyPTC.bi'
  12. ''$include: 'user32.bi'
  13.  
  14. 'option explicit
  15.  
  16. CONST SCR_WIDTH = 320 * 2
  17. CONST SCR_HEIGHT = 240 * 2
  18.  
  19. CONST SCR_SIZE = SCR_WIDTH * SCR_HEIGHT
  20. CONST SCR_MIDX = SCR_WIDTH \ 2
  21. CONST SCR_MIDY = SCR_HEIGHT \ 2
  22.  
  23. CONST FALSE = 0, TRUE = NOT FALSE
  24.  
  25. CONST PI = 3.141593
  26. CONST MAXITER = 20
  27. CONST MAXSIZE = 4
  28.  
  29. DIM Buffer(SCR_SIZE - 1) AS LONG
  30. DIM Lx(SCR_WIDTH - 1) AS SINGLE
  31. DIM Ly(SCR_HEIGHT - 1) AS SINGLE
  32. DIM sqrt(SCR_SIZE - 1) AS SINGLE
  33.  
  34. 'if( ptc_open( "FreeBASIC Julia (Relsoft)", SCR_WIDTH, SCR_HEIGHT ) = 0 ) then
  35. '   end -1
  36. 'end if
  37.  
  38. SCREEN _NEWIMAGE(SCR_WIDTH, SCR_HEIGHT, 32), , 1, 0
  39.  
  40. DIM px AS LONG, py AS LONG
  41. DIM xmin AS SINGLE, xmax AS SINGLE, ymin AS SINGLE, ymax AS SINGLE
  42. DIM theta AS SINGLE
  43. DIM deltax AS SINGLE, deltay AS SINGLE
  44. DIM xsquare AS SINGLE, ysquare AS SINGLE
  45. DIM ytemp AS SINGLE
  46. DIM temp1 AS SINGLE, temp2 AS SINGLE
  47. DIM i AS LONG, pixel AS LONG
  48. DIM r AS LONG, g AS LONG, b AS LONG
  49. DIM red AS LONG, grn AS LONG, blu AS LONG
  50. DIM tmp AS LONG, i_last AS LONG
  51.  
  52. DIM cmagsq AS SINGLE
  53. DIM drad_L AS SINGLE
  54. DIM drad_H AS SINGLE
  55. DIM ztoti AS LONG
  56.  
  57. 'pointers to array "buffer"
  58. 'dim p_buffer as long ptr, p_bufferl as long ptr
  59.  
  60. xmin = -2.0
  61. xmax = 2.0
  62. ymin = -1.5
  63. ymax = 1.5
  64.  
  65. deltax = (xmax - xmin) / (SCR_WIDTH - 1)
  66. deltay = (ymax - ymin) / (SCR_HEIGHT - 1)
  67.  
  68. FOR i = 0 TO SCR_WIDTH - 1
  69.     Lx(i) = xmin + i * deltax
  70.  
  71. FOR i = 0 TO SCR_HEIGHT - 1
  72.     Ly(i) = ymax - i * deltay
  73.  
  74. FOR i = 0 TO SCR_SIZE - 1
  75.     sqrt(i) = SQR(i)
  76.  
  77. 'dim hwnd as long
  78. 'hwnd = GetActiveWindow
  79.  
  80. DIM stime AS LONG, Fps AS SINGLE, Fps2 AS SINGLE
  81.  
  82. stime = TIMER
  83.  
  84.  
  85.     '    p_buffer = @buffer(0)
  86.     '    p_bufferl = @buffer(SCR_SIZE-1)
  87.  
  88.     frame = (frame + 1) AND &H7FFFFFFF
  89.     theta = frame * PI / 180
  90.  
  91.     p = COS(theta) * SIN(theta * .7)
  92.     q = SIN(theta) + SIN(theta)
  93.     p = p * .6
  94.     q = q * .6
  95.  
  96.     cmag = SQR(p * p + q * q)
  97.     cmagsq = (p * p + q * q)
  98.     drad = 0.04
  99.     drad_L = (cmag - drad)
  100.     drad_L = drad_L * drad_L
  101.     drad_H = (cmag + drad)
  102.     drad_H = drad_H * drad_H
  103.  
  104.     FOR py = 0 TO (SCR_HEIGHT \ 2) - 1
  105.         ty = Ly(py)
  106.         FOR px = 0 TO SCR_WIDTH - 1
  107.             x = Lx(px)
  108.             y = ty
  109.             xsquare = 0
  110.             ysquare = 0
  111.             ztot = 0
  112.             i = 0
  113.             WHILE (i < MAXITER) AND ((xsquare + ysquare) < MAXSIZE)
  114.                 xsquare = x * x
  115.                 ysquare = y * y
  116.                 ytemp = x * y * 2
  117.                 x = xsquare - ysquare + p
  118.                 y = ytemp + q
  119.                 zmag = (x * x + y * y)
  120.                 IF (zmag < drad_H) AND (zmag > drad_L) AND (i > 0) THEN
  121.                     ztot = ztot + (1 - (ABS(zmag - cmagsq) / drad))
  122.                     i_last = i
  123.                 END IF
  124.                 i = i + 1
  125.                 IF zmag > 4.0 THEN
  126.                     EXIT WHILE
  127.                 END IF
  128.             WEND
  129.  
  130.             IF ztot > 0 THEN
  131.                 i = CINT(SQR(ztot) * 500)
  132.             ELSE
  133.                 i = 0
  134.             END IF
  135.             IF i < 256 THEN
  136.                 red = i
  137.             ELSE
  138.                 red = 255
  139.             END IF
  140.  
  141.             IF i < 512 AND i > 255 THEN
  142.                 grn = i - 256
  143.             ELSE
  144.                 IF i >= 512 THEN
  145.                     grn = 255
  146.                 ELSE
  147.                     grn = 0
  148.                 END IF
  149.             END IF
  150.  
  151.             IF i <= 768 AND i > 511 THEN
  152.                 blu = i - 512
  153.             ELSE
  154.                 IF i >= 768 THEN
  155.                     blu = 255
  156.                 ELSE
  157.                     blu = 0
  158.                 END IF
  159.             END IF
  160.  
  161.             tmp = INT((red + grn + blu) \ 3)
  162.             red = INT((red + grn + tmp) \ 3)
  163.             grn = INT((grn + blu + tmp) \ 3)
  164.             blu = INT((blu + red + tmp) \ 3)
  165.  
  166.             SELECT CASE (i_last MOD 3)
  167.                 CASE 1
  168.                     tmp = red
  169.                     red = grn
  170.                     grn = blu
  171.                     blu = tmp
  172.                 CASE 2
  173.                     tmp = red
  174.                     blu = grn
  175.                     red = blu
  176.                     grn = tmp
  177.             END SELECT
  178.  
  179.             'pixel = red shl 16 or grn shl 8 or blu
  180.             '*p_buffer = pixel
  181.             '*p_bufferl = pixel
  182.             'p_buffer = p_buffer + Len(long)
  183.             'p_bufferl = p_bufferl - Len(long)
  184.             pixel = _RGB32(red, grn, blu)
  185.             PSET (px, py), pixel
  186.             PSET (SCR_WIDTH - 1 - px, SCR_HEIGHT - 1 - py), pixel
  187.  
  188.         NEXT px
  189.     NEXT py
  190.  
  191.     'calc fps
  192.     Fps = Fps + 1
  193.     IF stime + 1 < TIMER THEN
  194.         Fps2 = Fps
  195.         Fps = 0
  196.         stime = TIMER
  197.     END IF
  198.  
  199.     '    SetWindowText hwnd, "FreeBasic Julia Rings FPS:" + str$(Fps2)
  200.     LOCATE 1, 1: PRINT "QB64 Julia Rings FPS:" + STR$(Fps2)
  201.  
  202.     'ptc_update @buffer(0)
  203.     PCOPY 1, 0
  204.  
  205.  
  206. 'ptc_close
  207.  
  208.  

« Last Edit: February 06, 2019, 08:41:28 PM by The Librarian »