Author Topic: Fractal Art by Zom-B  (Read 1927 times)

Offline The Librarian

  • Moderator
Fractal Art by Zom-B
« on: March 11, 2018, 09:58:04 AM »
Fractal Art

Author: Zom-B
Source: qb64.net Forum
URL: http://www.qb64.net/forum/index.php?topic=1124.0
Version: 2010
Tags: [2d], [fractal]

Description:
This is [...] a series of fractal artworks that I ported from Ultra Fractal to Quick Basic 4.5 with the Future library, and are currently upgrading to QB64. I received permission from the author(s) of the artworks to republish their works in this particular form. The original consists of a lot of include and routine files $included in the main, which I have merged here for convenience.

(Code edited by The Librarian to run in QB64 v1.2.)

Source Code (one of four):
Code: QB64 [Select]
  1. '> Merged with Zom-B's smart $include merger 0.51
  2.  
  3. DEFSNG A-Z
  4.  
  5. '####################################################################################################################
  6. '# Math Library V1.0 (include)
  7. '# By Zom-B
  8. '####################################################################################################################
  9.  
  10. CONST sqrt2 = 1.41421356237309504880168872420969807856967187537695 ' Knuth01
  11. CONST sqrt3 = 1.73205080756887729352744634150587236694280525381038 ' Knuth02
  12. CONST sqrt5 = 2.23606797749978969640917366873127623544061835961153 ' Knuth03
  13. CONST sqrt10 = 3.16227766016837933199889354443271853371955513932522 ' Knuth04
  14. CONST cubert2 = 1.25992104989487316476721060727822835057025146470151 ' Knuth05
  15. CONST cubert3 = 1.44224957030740838232163831078010958839186925349935 ' Knuth06
  16. CONST q2pow025 = 1.18920711500272106671749997056047591529297209246382 ' Knuth07
  17. CONST phi = 1.61803398874989484820458683436563811772030917980576 ' Knuth08
  18. CONST log2 = 0.69314718055994530941723212145817656807550013436026 ' Knuth09
  19. CONST log3 = 1.09861228866810969139524523692252570464749055782275 ' Knuth10
  20. CONST log10 = 2.30258509299404568401799145468436420760110148862877 ' Knuth11
  21. CONST logpi = 1.14472988584940017414342735135305871164729481291531 ' Knuth12
  22. CONST logphi = 0.48121182505960344749775891342436842313518433438566 ' Knuth13
  23. CONST q1log2 = 1.44269504088896340735992468100189213742664595415299 ' Knuth14
  24. CONST q1log10 = 0.43429448190325182765112891891660508229439700580367 ' Knuth15
  25. CONST q1logphi = 2.07808692123502753760132260611779576774219226778328 ' Knuth16
  26. CONST pi = 3.14159265358979323846264338327950288419716939937511 ' Knuth17
  27. CONST deg2rad = 0.01745329251994329576923690768488612713442871888542 ' Knuth18
  28. CONST q1pi = 0.31830988618379067153776752674502872406891929148091 ' Knuth19
  29. CONST pisqr = 9.86960440108935861883449099987615113531369940724079 ' Knuth20
  30. CONST gamma05 = 1.7724538509055160272981674833411451827975494561224 '  Knuth21
  31. CONST gamma033 = 2.6789385347077476336556929409746776441286893779573 '  Knuth22
  32. CONST gamma067 = 1.3541179394264004169452880281545137855193272660568 '  Knuth23
  33. CONST e = 2.71828182845904523536028747135266249775724709369996 ' Knuth24
  34. CONST q1e = 0.36787944117144232159552377016146086744581113103177 ' Knuth25
  35. CONST esqr = 7.38905609893065022723042746057500781318031557055185 ' Knuth26
  36. CONST eulergamma = 0.57721566490153286060651209008240243104215933593992 ' Knuth27
  37. CONST expeulergamma = 1.7810724179901979852365041031071795491696452143034 '  Knuth28
  38. CONST exppi025 = 2.19328005073801545655976965927873822346163764199427 ' Knuth29
  39. CONST sin1 = 0.84147098480789650665250232163029899962256306079837 ' Knuth30
  40. CONST cos1 = 0.54030230586813971740093660744297660373231042061792 ' Knuth31
  41. CONST zeta3 = 1.2020569031595942853997381615114499907649862923405 '  Knuth32
  42. CONST nloglog2 = 0.36651292058166432701243915823266946945426344783711 ' Knuth33
  43.  
  44. CONST logr10 = 0.43429448190325182765112891891660508229439700580367
  45. CONST logr2 = 1.44269504088896340735992468100189213742664595415299
  46. CONST pi05 = 1.57079632679489661923132169163975144209858469968755
  47. CONST pi2 = 6.28318530717958647692528676655900576839433879875021
  48. CONST q05log10 = 0.21714724095162591382556445945830254114719850290183
  49. CONST q05log2 = 0.72134752044448170367996234050094606871332297707649
  50. CONST q05pi = 0.15915494309189533576888376337251436203445964574046
  51. CONST q13 = 0.33333333333333333333333333333333333333333333333333
  52. CONST q16 = 0.16666666666666666666666666666666666666666666666667
  53. CONST q2pi = 0.63661977236758134307553505349005744813783858296183
  54. CONST q2sqrt5 = 0.89442719099991587856366946749251049417624734384461
  55. CONST rad2deg = 57.2957795130823208767981548141051703324054724665643
  56. CONST sqrt02 = 0.44721359549995793928183473374625524708812367192231
  57. CONST sqrt05 = 0.70710678118654752440084436210484903928483593768847
  58. CONST sqrt075 = 0.86602540378443864676372317075293618347140262690519
  59. CONST y2q112 = 1.05946309435929526456182529494634170077920431749419 ' Chromatic base
  60.  
  61. '####################################################################################################################
  62. '# Screen mode selector v1.0 (include)
  63. '# By Zom-B
  64. '####################################################################################################################
  65.  
  66. videoaspect:
  67. DATA "all aspect",15
  68. DATA "4:3",11
  69. DATA "16:10",10
  70. DATA "16:9",14
  71. DATA "5:4",13
  72. DATA "3:2",12
  73. DATA "5:3",9
  74. DATA "1:1",7
  75. DATA "other",8
  76.  
  77. videomodes:
  78. DATA 256,256,7
  79. DATA 320,240,1
  80. DATA 400,300,1
  81. DATA 512,384,1
  82. DATA 512,512,7
  83. DATA 640,480,1
  84. DATA 720,540,1
  85. DATA 768,576,1
  86. DATA 800,480,2
  87. DATA 800,600,1
  88. DATA 854,480,3
  89. DATA 1024,600,8
  90. DATA 1024,640,2
  91. DATA 1024,768,1
  92. DATA 1024,1024,7
  93. DATA 1152,768,5
  94. DATA 1152,864,1
  95. DATA 1280,720,3
  96. DATA 1280,768,6
  97. DATA 1280,800,2
  98. DATA 1280,854,5
  99. DATA 1280,960,1
  100. DATA 1280,1024,4
  101. DATA 1366,768,3
  102. DATA 1400,1050,1
  103. DATA 1440,900,2
  104. DATA 1440,960,5
  105. DATA 1600,900,3
  106. DATA 1600,1200,1
  107. DATA 1680,1050,2
  108. DATA 1920,1080,3
  109. DATA 1920,1200,2
  110. DATA 2048,1152,3
  111. DATA 2048,1536,1
  112. DATA 2048,2048,7
  113. DATA ,,
  114.  
  115. '####################################################################################################################
  116. '# Ultra Fractal Gradient library v1.0 (include)
  117. '# By Zom-B
  118. '#
  119. '# Smooth Gradient algorithm from Ultra Fractal (www.ultrafractal.com)
  120. '####################################################################################################################
  121.  
  122. TYPE GRADIENTPOINT
  123.     index AS SINGLE
  124.     r AS SINGLE
  125.     g AS SINGLE
  126.     b AS SINGLE
  127.     rdr AS SINGLE
  128.     rdl AS SINGLE
  129.     gdr AS SINGLE
  130.     gdl AS SINGLE
  131.     bdr AS SINGLE
  132.     bdl AS SINGLE
  133.  
  134. '$dynamic
  135.  
  136. DIM SHARED gradientSmooth(1) AS _BYTE '_BIT <- bugged
  137. DIM SHARED gradientPoints(1) AS INTEGER
  138. DIM SHARED gradient(1, 1) AS GRADIENTPOINT
  139.  
  140.  
  141. '####################################################################################################################
  142. '# Sierpinsky Rays+aet for QB64
  143. '# By Zom-B
  144. '#
  145. '# Original art by Daniele (alcamese@libero.it)
  146. '# Tweaked by Athena Tracey (athena_1963@hotmail.com)
  147. '####################################################################################################################
  148.  
  149. CONST Doantialias = -1
  150. CONST Usegaussian = 0
  151.  
  152. '####################################################################################################################
  153.  
  154. _TITLE "Sierpinsky Rays+aet"
  155. WIDTH 80, 40
  156.  
  157. PRINT TAB(30); "Sierpinsky Rays+aet"
  158. PRINT TAB(18); "Original art by Daniele (alcamese@libero.it)"
  159. PRINT TAB(15); "Tweaked by Athena Tracey (athena_1963@hotmail.com)"
  160. PRINT TAB(19); "Converted to Quick Basic and QB64 by Zom-B"
  161.  
  162. selectScreenMode 7, 32
  163.  
  164. '####################################################################################################################
  165.  
  166. DIM SHARED sizeX%, sizeY%
  167. DIM SHARED maxX%, maxY%
  168. DIM SHARED halfX%, halfY%
  169.  
  170. sizeX% = _WIDTH
  171. sizeY% = _HEIGHT
  172. maxX% = sizeX% - 1
  173. maxY% = sizeY% - 1
  174. halfX% = sizeX% \ 2
  175. halfY% = sizeY% \ 2
  176.  
  177. DIM SHARED magX, magY
  178.  
  179. magX = 1.300052002080083203328133125325 / halfY%
  180. magY = 1.300052002080083203328133125325 / halfY%
  181.  
  182. DIM SHARED zx(149), zy(149)
  183.  
  184. '####################################################################################################################
  185.  
  186. setNumGradients 5
  187.  
  188. addGradientPoint 0, -0.0450, 0.710, 1.000, 1.000
  189. addGradientPoint 0, 0.0025, 1.000, 0.702, 0.729
  190. addGradientPoint 0, 0.0850, 0.082, 0.431, 0.000
  191. addGradientPoint 0, 0.2300, 0.812, 0.745, 0.824
  192. addGradientPoint 0, 0.5500, 0.380, 0.000, 0.000
  193. addGradientPoint 0, 0.7600, 1.000, 0.757, 1.000
  194. addGradientPoint 0, 0.8800, 0.000, 0.263, 0.000
  195. addGradientPoint 0, 0.9550, 0.710, 1.000, 1.000
  196. addGradientPoint 0, 1.0025, 1.000, 0.702, 0.729
  197. setGradientSmooth 0, -1
  198.  
  199. addGradientPoint 1, -0.0450, 0.165, 0.000, 0.184
  200. addGradientPoint 1, 0.7475, 0.718, 0.918, 1.000
  201. addGradientPoint 1, 0.8425, 0.945, 0.710, 1.000
  202. addGradientPoint 1, 0.9550, 0.165, 0.000, 0.184
  203. addGradientPoint 1, 1.7475, 0.718, 0.918, 1.000
  204. setGradientSmooth 1, -1
  205.  
  206. addGradientPoint 2, -0.2750, 0.000, 0.973, 0.114
  207. addGradientPoint 2, 0.0475, 1.000, 0.545, 0.875
  208. addGradientPoint 2, 0.1725, 0.000, 0.345, 0.000
  209. addGradientPoint 2, 0.5500, 1.000, 0.071, 1.000
  210. addGradientPoint 2, 0.7250, 0.000, 0.973, 0.114
  211. addGradientPoint 2, 1.0475, 1.000, 0.545, 0.875
  212. setGradientSmooth 2, -1
  213.  
  214. addGradientPoint 3, -0.0675, 1.000, 0.502, 1.000
  215. addGradientPoint 3, 0.0700, 0.000, 0.000, 0.698
  216. addGradientPoint 3, 0.1650, 0.725, 0.741, 0.000
  217. addGradientPoint 3, 0.3300, 0.290, 0.000, 0.757
  218. addGradientPoint 3, 0.4550, 0.000, 0.251, 0.039
  219. addGradientPoint 3, 0.6375, 0.584, 0.918, 1.000
  220. addGradientPoint 3, 0.8250, 0.000, 0.165, 0.000
  221. addGradientPoint 3, 0.9325, 1.000, 0.502, 1.000
  222. addGradientPoint 3, 1.0700, 0.000, 0.000, 0.698
  223. setGradientSmooth 3, -1
  224.  
  225. addGradientPoint 4, -0.1025, 1.000, 0.282, 0.082
  226. addGradientPoint 4, 0.0775, 0.306, 0.376, 1.000
  227. addGradientPoint 4, 0.2225, 0.333, 0.298, 0.000
  228. addGradientPoint 4, 0.3000, 1.000, 1.000, 0.208
  229. addGradientPoint 4, 0.3800, 0.337, 0.271, 0.741
  230. addGradientPoint 4, 0.6400, 0.651, 0.404, 0.220
  231. addGradientPoint 4, 0.8075, 0.000, 1.000, 1.000
  232. addGradientPoint 4, 0.8975, 1.000, 0.282, 0.082
  233. addGradientPoint 4, 1.0775, 0.306, 0.376, 1.000
  234. setGradientSmooth 4, -1
  235.  
  236. renderProgressive 256, 4
  237.  
  238. i$ = INPUT$(1)
  239.  
  240. '####################################################################################################################
  241.  
  242. SUB renderProgressive (startSize%, endSize%)
  243.     pixStep% = startSize%
  244.  
  245.     pixWidth% = pixStep% - 1
  246.     FOR y% = 0 TO maxY% STEP pixStep%
  247.         FOR x% = 0 TO maxX% STEP pixStep%
  248.             calcPoint x%, y%, r%, g%, b%
  249.             LINE (x%, y%)-STEP(pixWidth%, pixWidth%), _RGB(r%, g%, b%), BF
  250.         NEXT
  251.         IF INKEY$ = CHR$(27) THEN SYSTEM
  252.     NEXT
  253.  
  254.     DO
  255.         pixSize% = pixStep% \ 2
  256.         pixWidth% = pixSize% - 1
  257.         FOR y% = 0 TO maxY% STEP pixStep%
  258.             y1% = y% + pixSize%
  259.             FOR x% = 0 TO maxX% STEP pixStep%
  260.                 x1% = x% + pixSize%
  261.  
  262.                 IF x1% < sizeX% THEN
  263.                     calcPoint x1%, y%, r%, g%, b%
  264.                     LINE (x1%, y%)-STEP(pixWidth%, pixWidth%), _RGB(r%, g%, b%), BF
  265.                 END IF
  266.                 IF y1% < sizeY% THEN
  267.                     calcPoint x%, y1%, r%, g%, b%
  268.                     LINE (x%, y1%)-STEP(pixWidth%, pixWidth%), _RGB(r%, g%, b%), BF
  269.                     IF x1% < sizeX% THEN
  270.                         calcPoint x1%, y1%, r%, g%, b%
  271.                         LINE (x1%, y1%)-STEP(pixWidth%, pixWidth%), _RGB(r%, g%, b%), BF
  272.                     END IF
  273.                 END IF
  274.             NEXT
  275.             IF INKEY$ = CHR$(27) THEN SYSTEM
  276.         NEXT
  277.         pixStep% = pixStep% \ 2
  278.     LOOP WHILE pixStep% > 2
  279.  
  280.     FOR y% = 0 TO maxY% STEP 2
  281.         y1% = y% + 1
  282.         FOR x% = 0 TO maxX% STEP 2
  283.             x1% = x% + 1
  284.  
  285.             IF x1% < sizeX% THEN
  286.                 calcPoint x1%, y%, r%, g%, b%
  287.                 PSET (x1%, y%), _RGB(r%, g%, b%)
  288.             END IF
  289.             IF y1% < sizeY% THEN
  290.                 calcPoint x%, y1%, r%, g%, b%
  291.                 PSET (x%, y1%), _RGB(r%, g%, b%)
  292.                 IF x1% < sizeX% THEN
  293.                     calcPoint x1%, y1%, r%, g%, b%
  294.                     PSET (x1%, y1%), _RGB(r%, g%, b%)
  295.                 END IF
  296.             END IF
  297.         NEXT
  298.         IF INKEY$ = CHR$(27) THEN SYSTEM
  299.     NEXT
  300.  
  301.     IF NOT Doantialias THEN EXIT SUB
  302.  
  303.     endArea% = endSize% * endSize%
  304.  
  305.     IF Usegaussian THEN
  306.         FOR y% = 0 TO maxY%
  307.             FOR x% = 0 TO maxX%
  308.                 c& = POINT(x%, y%)
  309.                 r% = _RED(c&)
  310.                 g% = _GREEN(c&)
  311.                 b% = _BLUE(c&)
  312.                 FOR i% = 2 TO endArea%
  313.                     DO 'Marsaglia polar method for random gaussian
  314.                         u! = RND * 2 - 1
  315.                         v! = RND * 2 - 1
  316.                         s! = u! * u! + v! * v!
  317.                     LOOP WHILE s! >= 1 OR s! = 0
  318.                     s! = SQR(-2 * LOG(s!) / s!) * 0.5
  319.                     u! = u! * s!
  320.                     v! = v! * s!
  321.  
  322.                     calcPoint x% + u!, y% + v!, r1%, g1%, b1%
  323.  
  324.                     r% = r% + r1%
  325.                     g% = g% + g1%
  326.                     b% = b% + b1%
  327.                 NEXT
  328.  
  329.                 PSET (x%, y%), _RGB(CINT(r% / endArea%), CINT(g% / endArea%), CINT(b% / endArea%))
  330.                 IF INKEY$ = CHR$(27) THEN SYSTEM
  331.             NEXT
  332.         NEXT
  333.     ELSE
  334.         FOR y% = 0 TO maxY%
  335.             FOR x% = 0 TO maxX%
  336.                 r% = 0
  337.                 g% = 0
  338.                 b% = 0
  339.                 FOR v% = 0 TO endSize% - 1
  340.                     y1! = y% + v% / endSize%
  341.                     FOR u% = 0 TO endSize% - 1
  342.                         IF u% = 0 AND v& = 0 THEN
  343.                             c& = POINT(x%, y%)
  344.                         ELSE
  345.                             x1! = x% + u% / endSize%
  346.                             calcPoint x1!, y1!, r1%, g1%, b1%
  347.                         END IF
  348.                         r% = r% + r1%
  349.                         g% = g% + g1%
  350.                         b% = b% + b1%
  351.                     NEXT
  352.                 NEXT
  353.                 PSET (x%, y%), _RGB(CINT(r% / endArea%), CINT(g% / endArea%), CINT(b% / endArea%))
  354.                 IF INKEY$ = CHR$(27) THEN SYSTEM
  355.             NEXT
  356.         NEXT
  357.     END IF
  358.  
  359. '####################################################################################################################
  360.  
  361. SUB calcPoint (screenX!, screenY!, r%, g%, b%)
  362.     applyLocation screenX!, screenY!, px, py
  363.  
  364.     fractal px, py, numIter1%, numIter2%
  365.  
  366.     outside1 numIter1%, index!
  367.     getGradient 0, index!, r!, g!, b!
  368.  
  369.     outside2 numIter2%, index!
  370.     getGradient 1, index!, r2!, g2!, b2!
  371.     r! = ABS(r! - r2!): g! = ABS(g! - g2!): b! = ABS(b! - b2!)
  372.  
  373.     outside3 numIter2%, index!
  374.     getGradient 2, index!, r2!, g2!, b2!
  375.     r1! = r!: g1! = g!: b1! = b!
  376.     mergeOverlay r!, g!, b!, r2!, g2!, b2!
  377.     r! = r1! + (r! - r1!) * 0.45
  378.     g! = g1! + (g! - g1!) * 0.45
  379.     b! = b1! + (b! - b1!) * 0.45
  380.  
  381.     outside4 numIter2%, index!
  382.     getGradient 3, index!, r2!, g2!, b2!
  383.     r! = r! + r2!: g! = g! + g2!: b! = b! + b2!
  384.  
  385.     outside5 px, py, numIter2%, index!
  386.     getGradient 4, index!, r2!, g2!, b2!
  387.     r1! = r!: g1! = g!: b1! = b!
  388.     mergeColor r!, g!, b!, r2!, g2!, b2!
  389.     r! = r1! + (r! - r1!) * 0.5
  390.     g! = g1! + (g! - g1!) * 0.5
  391.     b! = b1! + (b! - b1!) * 0.5
  392.  
  393.     r% = r! * 255
  394.     g% = g! * 255
  395.     b% = b! * 255
  396.  
  397. '####################################################################################################################
  398.  
  399. SUB applyLocation (inX!, inY!, outX, outY)
  400.     x = (inX! - halfX%) * magX
  401.     y = (halfY% - inY!) * magY
  402.     outX = 0.99999998476912904932780850903444 * x - 1.7453292431333680334067268304459D-4 * y - 0.01168313399#
  403.     outY = 1.7453292431333680334067268304459D-4 * x + 0.99999998476912904932780850903444 * y - 0.00626625065#
  404.  
  405. '####################################################################################################################
  406.  
  407. SUB fractal (px, py, numIter1%, numIter2%)
  408.     xx = px * px: yy = py * py
  409.  
  410.     x = ABS(px * xx - 3 * px * yy) * 0.2
  411.     y = ABS(3 * xx * py - py * yy) * 0.2
  412.     x = x - INT(x * 2.5 + 0.5) * 0.4
  413.     y = y - INT(y * 2.5 + 0.5) * 0.4
  414.  
  415.     zx(0) = x: zy(0) = y
  416.  
  417.     numIter1% = -1
  418.     numIter2% = -1
  419.     FOR numIter% = 1 TO 149
  420.         x = x * 2: y = y * 2
  421.  
  422.         IF y > 1 THEN
  423.             y = y - 1
  424.         ELSEIF x > 1 THEN
  425.             x = x - 1
  426.         END IF
  427.  
  428.         zx(numIter%) = x: zy(numIter%) = y
  429.  
  430.         IF x * x + y * y > 127 THEN
  431.             IF numIter2% = -1 THEN numIter2% = numIter% - 1
  432.             IF numIter1% >= 0 THEN EXIT SUB
  433.         END IF
  434.  
  435.         bail = ABS(x + y)
  436.         IF bail * bail > 127 THEN
  437.             IF numIter1% = -1 THEN numIter1% = numIter% - 1
  438.             IF numIter2% >= 0 THEN EXIT SUB
  439.         END IF
  440.     NEXT
  441.  
  442.     IF numIter1% = -1 THEN numIter1% = 149
  443.     IF numIter2% = -1 THEN numIter2% = 149
  444.  
  445. '####################################################################################################################
  446.  
  447. SUB outside1 (numIter%, index!)
  448.     index! = ATN(numIter% / 25)
  449.  
  450. '####################################################################################################################
  451.  
  452. SUB outside2 (numIter%, index!)
  453.     closest = 1E+38
  454.     ix = 0
  455.     iy = 0
  456.  
  457.     FOR a% = 1 TO numIter%
  458.         x = zx(a%) * zx(a%): y = zy(a%) * zy(a%)
  459.         d = x * x + y * y
  460.  
  461.         IF d < closest THEN
  462.             closest = d
  463.             ix = zx(a%)
  464.             iy = zy(a%)
  465.         END IF
  466.     NEXT
  467.  
  468.     index! = SQR(SQR(ix * ix + iy * iy) * 2) / 2
  469.  
  470. '####################################################################################################################
  471.  
  472. SUB outside3 (numIter%, index!)
  473.     x = zx(numIter% + 1)
  474.     y = zy(numIter% + 1)
  475.     d = atan2(y, x) / pi2
  476.     index! = SQR((6.349563872353654# - 4.284804271440222# * LOG(LOG(SQR(x * x + y * y))) + ABS((d - INT(d)) * 4 - 2)) * 2) / 2
  477.  
  478. '####################################################################################################################
  479.  
  480. SUB outside4 (numIter%, index!)
  481.     closest = 1E+38
  482.  
  483.     FOR a% = 1 TO numIter%
  484.         zy2 = zy(a%) * zy(a%)
  485.         d = zx(a%) + zx(a%) * zx(a%) + zy2
  486.         d = SQR(d * d + zy2)
  487.  
  488.         IF d < closest THEN
  489.             closest = d
  490.         END IF
  491.     NEXT
  492.  
  493.     index! = asin(closest ^ .1) ^ (1 / 1.5) * .41577394#
  494.  
  495. '####################################################################################################################
  496.  
  497. SUB outside5 (px, py, numIter%, index!)
  498.     r = SQR(px * px + py * py)
  499.     cost = px / r
  500.     sint = py / r
  501.  
  502.     ave = 0
  503.     i% = 0
  504.     FOR a% = 1 TO numIter%
  505.         prevave = ave
  506.  
  507.         x = zx(a%)
  508.         y = zy(a%)
  509.         r = SQR(x * x + y * y)
  510.         x = zx(a%) / r + cost
  511.         y = zy(a%) / r + sint
  512.  
  513.         ave = ave + SQR(x * x + y * y)
  514.  
  515.         cost = -cost
  516.         sint = -sint
  517.         i% = i% + 1
  518.     NEXT
  519.  
  520.     ave = ave / numIter%
  521.     prevave = prevave / (numIter% - 1)
  522.     x = zx(numIter% + 1)
  523.     y = zy(numIter% + 1)
  524.     f = 2.2762545841680618369458486886285 - 1.4426950408889634073599246810019 * LOG(LOG(SQR(x * x + y * y)))
  525.     index! = prevave + (ave - prevave) * f
  526.  
  527.     index! = index! * 2
  528.  
  529. '####################################################################################################################
  530. '# Math Library V0.11 (routines)
  531. '# By Zom-B
  532. '####################################################################################################################
  533.  
  534. '> merger: Skipping unused FUNCTION remainder% (a%, b%)
  535.  
  536. '> merger: Skipping unused FUNCTION fRemainder (a, b)
  537.  
  538. '####################################################################################################################
  539.  
  540. '> merger: Skipping unused FUNCTION safeLog (x)
  541.  
  542. '####################################################################################################################
  543.  
  544. FUNCTION asin (y)
  545.     IF y = -1 THEN asin = -pi05: EXIT FUNCTION
  546.     IF y = 1 THEN asin = pi05: EXIT FUNCTION
  547.     asin = ATN(y / SQR(1 - y * y))
  548.  
  549. '> merger: Skipping unused FUNCTION acos (y)
  550.  
  551. '> merger: Skipping unused FUNCTION safeAcos (y)
  552.  
  553. FUNCTION atan2 (y, x)
  554.     IF x > 0 THEN
  555.         atan2 = ATN(y / x)
  556.     ELSEIF x < 0 THEN
  557.         IF y > 0 THEN
  558.             atan2 = ATN(y / x) + pi
  559.         ELSE
  560.             atan2 = ATN(y / x) - pi
  561.         END IF
  562.     ELSEIF y > 0 THEN
  563.         atan2 = pi / 2
  564.     ELSE
  565.         atan2 = -pi / 2
  566.     END IF
  567.  
  568. '####################################################################################################################
  569. '# Screen mode selector v1.0 (routines)
  570. '# By Zom-B
  571. '####################################################################################################################
  572.  
  573. SUB selectScreenMode (yOffset%, colors%)
  574.     DIM aspectName$(10), aspectCol%(10)
  575.     RESTORE videoaspect
  576.     FOR y% = 0 TO 10
  577.         READ aspectName$(y%), aspectCol%(y%)
  578.         IF aspectCol%(y%) = 0 THEN numAspect% = y% - 1: EXIT FOR
  579.     NEXT
  580.  
  581.     DIM vidX%(100), vidY%(100), vidA%(100)
  582.     RESTORE videomodes
  583.     FOR y% = 1 TO 100
  584.         READ vidX%(y%), vidY%(y%), vidA%(y%)
  585.         IF (vidX%(y%) <= 0) THEN numModes% = y% - 1: EXIT FOR
  586.     NEXT
  587.  
  588.     IF numModes% > _HEIGHT - yOffset% - 1 THEN numModes% = _HEIGHT - yOffset% - 1
  589.  
  590.     DEF SEG = &HB800
  591.     LOCATE yOffset% + 1, 1
  592.     PRINT "Select video mode:"; TAB(61); "Click "
  593.     POKE yOffset% * 160 + 132, 31
  594.  
  595.     y% = 0
  596.     lastY% = 0
  597.     selectedAspect% = 0
  598.     reprint% = 1
  599.     lastButton% = 0
  600.     DO
  601.         IF INKEY$ = CHR$(27) THEN CLS: SYSTEM
  602.         IF reprint% THEN
  603.             reprint% = 0
  604.  
  605.             FOR x% = 1 TO numModes%
  606.                 LOCATE yOffset% + x% + 1, 1
  607.                 COLOR 7, 0
  608.                 PRINT USING "##:"; x%;
  609.                 IF selectedAspect% = 0 THEN
  610.                     COLOR aspectCol%(vidA%(x%))
  611.                 ELSEIF selectedAspect% = vidA%(x%) THEN
  612.                     COLOR 15
  613.                 ELSE
  614.                     COLOR 8
  615.                 END IF
  616.                 PRINT STR$(vidX%(x%)); ","; vidY%(x%);
  617.             NEXT
  618.  
  619.             FOR x% = 0 TO numAspect%
  620.                 IF x% > 0 AND selectedAspect% = x% THEN
  621.                     COLOR aspectCol%(x%), 3
  622.                 ELSE
  623.                     COLOR aspectCol%(x%), 0
  624.                 END IF
  625.                 LOCATE yOffset% + x% + 2, 64
  626.                 PRINT "<"; aspectName$(x%); ">"
  627.             NEXT
  628.         END IF
  629.         IF _MOUSEINPUT THEN
  630.             IF lastY% > 0 THEN
  631.                 FOR x% = 0 TO 159 STEP 2
  632.                     POKE lastY% + x%, PEEK(lastY% + x%) AND &HEF
  633.                 NEXT
  634.             END IF
  635.  
  636.             x% = _MOUSEX
  637.             y% = _MOUSEY - yOffset% - 1
  638.  
  639.             IF x% <= 60 THEN
  640.                 IF y% > 0 AND y% <= numModes% THEN
  641.                     IF _MOUSEBUTTON(1) = 0 AND lastButton% THEN EXIT DO
  642.                     y% = (yOffset% + y%) * 160 + 1
  643.                     FOR x% = 0 TO 119 STEP 2
  644.                         POKE y% + x%, PEEK(y% + x%) OR &H10
  645.                     NEXT
  646.                 ELSE
  647.                     y% = 0
  648.                 END IF
  649.             ELSE
  650.                 IF y% > 0 AND y% - 1 <= numAspect% THEN
  651.                     IF _MOUSEBUTTON(1) THEN
  652.                         selectedAspect% = y% - 1
  653.                         reprint% = 1
  654.                     END IF
  655.                     y% = (yOffset% + y%) * 160 + 1
  656.                     FOR x% = 120 TO 159 STEP 2
  657.                         POKE y% + x%, PEEK(y% + x%) OR &H10
  658.                     NEXT
  659.                 ELSE
  660.                     y% = 0
  661.                 END IF
  662.             END IF
  663.             lastY% = y%
  664.             lastButton% = _MOUSEBUTTON(1)
  665.         END IF
  666.     LOOP
  667.  
  668.     CLS 'bug evasion for small video modes
  669.     SCREEN _NEWIMAGE(vidX%(y%), vidY%(y%), colors%)
  670.  
  671. '####################################################################################################################
  672. '# Ultra Fractal Gradient library v1.1 (routines)
  673. '# By Zom-B
  674. '#
  675. '# Smooth Gradient algorithm from Ultra Fractal (www.ultrafractal.com)
  676. '####################################################################################################################
  677.  
  678. '> merger: Skipping unused SUB defaultGradient (gi%)
  679.  
  680. '> merger: Skipping unused SUB grayscaleGradient (gi%)
  681.  
  682. '####################################################################################################################
  683.  
  684. SUB setNumGradients (gi%)
  685.     offset% = LBOUND(gradientPoints) - 1
  686.     REDIM _PRESERVE gradientSmooth(gi% + offset%) AS _BYTE '_BIT <- bugged
  687.     REDIM _PRESERVE gradientPoints(gi% + offset%) AS INTEGER
  688.     REDIM _PRESERVE gradient(gi% + offset%, 1) AS GRADIENTPOINT
  689.  
  690. SUB addGradientPoint (gi%, index!, r!, g!, b!)
  691.     p% = gradientPoints(gi%)
  692.  
  693.     IF UBOUND(gradient, 2) < p% THEN
  694.         REDIM _PRESERVE gradient(0 TO UBOUND(gradient, 1), 0 TO p%) AS GRADIENTPOINT
  695.     END IF
  696.  
  697.     gradient(gi%, p%).index = index!
  698.     gradient(gi%, p%).r = r!
  699.     gradient(gi%, p%).g = g!
  700.     gradient(gi%, p%).b = b!
  701.     gradientPoints(gi%) = p% + 1
  702.  
  703. SUB setGradientSmooth (gi%, s%)
  704.     gradientSmooth(gi%) = s%
  705.  
  706.     IF gradientSmooth(0) = 0 THEN EXIT SUB
  707.  
  708.     FOR i% = 0 TO gradientPoints(gi%) - 1
  709.         ip1% = i% + 1
  710.         IF ip1% = gradientPoints(gi%) THEN ip1% = 2
  711.         in1% = i% - 1
  712.         IF in1% = -1 THEN in1% = gradientPoints(gi%) - 3
  713.  
  714.         dxl! = gradient(gi%, i%).index - gradient(gi%, in1%).index
  715.         dxr! = gradient(gi%, ip1%).index - gradient(gi%, i%).index
  716.         IF dxl! < 0 THEN dxl! = dxl! + 1
  717.         IF dxr! < 0 THEN dxr! = dxr! + 1
  718.  
  719.         d! = (gradient(gi%, i%).r - gradient(gi%, in1%).r) * dxr!
  720.         IF d! = 0 THEN
  721.             gradient(gi%, i%).rdr = 0
  722.             gradient(gi%, i%).rdl = 0
  723.         ELSE
  724.             d! = (gradient(gi%, ip1%).r - gradient(gi%, i%).r) * dxl! / d!
  725.             IF d! <= 0 THEN
  726.                 gradient(gi%, i%).rdr = 0
  727.                 gradient(gi%, i%).rdl = 0
  728.             ELSE
  729.                 gradient(gi%, i%).rdr = 1 / (1 + d!)
  730.                 gradient(gi%, i%).rdl = gradient(gi%, i%).rdr - 1
  731.             END IF
  732.         END IF
  733.  
  734.         d! = (gradient(gi%, i%).g - gradient(gi%, in1%).g) * dxr!
  735.         IF d! = 0 THEN
  736.             gradient(gi%, i%).gdr = 0
  737.             gradient(gi%, i%).gdl = 0
  738.         ELSE
  739.             d! = (gradient(gi%, ip1%).g - gradient(gi%, i%).g) * dxl! / d!
  740.             IF d! <= 0 THEN
  741.                 gradient(gi%, i%).gdr = 0
  742.                 gradient(gi%, i%).gdl = 0
  743.             ELSE
  744.                 gradient(gi%, i%).gdr = 1 / (1 + d!)
  745.                 gradient(gi%, i%).gdl = gradient(gi%, i%).gdr - 1
  746.             END IF
  747.         END IF
  748.  
  749.         d! = (gradient(gi%, i%).b - gradient(gi%, in1%).b) * dxr!
  750.         IF d! = 0 THEN
  751.             gradient(gi%, i%).bdr = 0
  752.             gradient(gi%, i%).bdl = 0
  753.         ELSE
  754.             d! = (gradient(gi%, ip1%).b - gradient(gi%, i%).b) * dxl! / d!
  755.             IF d! <= 0 THEN
  756.                 gradient(gi%, i%).bdr = 0
  757.                 gradient(gi%, i%).bdl = 0
  758.             ELSE
  759.                 gradient(gi%, i%).bdr = 1 / (1 + d!)
  760.                 gradient(gi%, i%).bdl = gradient(gi%, i%).bdr - 1
  761.             END IF
  762.         END IF
  763.     NEXT
  764.  
  765. '####################################################################################################################
  766.  
  767. SUB getGradient (gi%, index!, red!, green!, blue!)
  768.     IF index! < 0 THEN x! = 0 ELSE x! = index! - INT(index!)
  769.  
  770.     FOR l% = gradientPoints(gi%) - 2 TO 1 STEP -1
  771.         IF gradient(gi%, l%).index <= x! THEN
  772.             EXIT FOR
  773.         END IF
  774.     NEXT
  775.  
  776.     r% = l% + 1
  777.     u! = (x! - gradient(gi%, l%).index) / (gradient(gi%, r%).index - gradient(gi%, l%).index)
  778.  
  779.     IF gradientSmooth(gi%) THEN
  780.         u2! = u! * u!
  781.         u3! = u2! * u!
  782.         ur! = u3! - (u2! + u2!) + u!
  783.         ul! = u2! - u3!
  784.  
  785.         red! = gradient(gi%, l%).r + (gradient(gi%, r%).r - gradient(gi%, l%).r) * (u3! + 3 * (gradient(gi%, l%).rdr * ur! + (1 + gradient(gi%, r%).rdl) * ul!))
  786.         green! = gradient(gi%, l%).g + (gradient(gi%, r%).g - gradient(gi%, l%).g) * (u3! + 3 * (gradient(gi%, l%).gdr * ur! + (1 + gradient(gi%, r%).gdl) * ul!))
  787.         blue! = gradient(gi%, l%).b + (gradient(gi%, r%).b - gradient(gi%, l%).b) * (u3! + 3 * (gradient(gi%, l%).bdr * ur! + (1 + gradient(gi%, r%).bdl) * ul!))
  788.     ELSE
  789.         red! = gradient(gi%, l%).r + (gradient(gi%, r%).r - gradient(gi%, l%).r) * u!
  790.         green! = gradient(gi%, l%).g + (gradient(gi%, r%).g - gradient(gi%, l%).g) * u!
  791.         blue! = gradient(gi%, l%).b + (gradient(gi%, r%).b - gradient(gi%, l%).b) * u!
  792.     END IF
  793.  
  794. '> merger: Skipping unused SUB testGradient (gi%)
  795.  
  796. '####################################################################################################################
  797. '# Merge modes library v0.1 (routines)
  798. '# By Zom-B
  799. '####################################################################################################################
  800.  
  801. '> merger: Skipping unused SUB testMerge
  802.  
  803. '####################################################################################################################
  804.  
  805. SUB mergeOverlay (br!, bg!, bb!, tr!, tg!, tb!)
  806.     IF br! <= 0.5 THEN br! = br! * tr! * 2 ELSE br! = 1 - (1 - br!) * (1 - tr!) * 2
  807.     IF bg! <= 0.5 THEN bg! = bg! * tg! * 2 ELSE bg! = 1 - (1 - bg!) * (1 - tg!) * 2
  808.     IF bb! <= 0.5 THEN bb! = bb! * tb! * 2 ELSE bb! = 1 - (1 - bb!) * (1 - tb!) * 2
  809.  
  810. '> merger: Skipping unused SUB mergeHardLight (br!, bg!, bb!, tr!, tg!, tb!)
  811.  
  812. '> merger: Skipping unused SUB mergeSoftLight (br!, bg!, bb!, tr!, tg!, tb!)
  813.  
  814. SUB mergeColor (r!, g!, b!, r2!, g2!, b2!)
  815.     max! = r!
  816.     min! = r!
  817.     IF max! < g! THEN max! = g!
  818.     IF min! > g! THEN min! = g!
  819.     IF max! < b! THEN max! = b!
  820.     IF min! > b! THEN min! = b!
  821.  
  822.     lum1! = max! + min!
  823.  
  824.     max! = r2!
  825.     min! = r2!
  826.     IF max! < g2! THEN max! = g2!
  827.     IF min! > g2! THEN min! = g2!
  828.     IF max! < b2! THEN max! = b2!
  829.     IF min! > b2! THEN min! = b2!
  830.  
  831.     sum! = max! + min!
  832.     dif! = max! - min!
  833.  
  834.     IF sum! < 1 THEN
  835.         sat2! = dif! / sum!
  836.     ELSE
  837.         sat2! = dif! / (2 - sum!)
  838.     END IF
  839.  
  840.     IF dif! = 0 THEN
  841.         lum1! = lum1! * 0.5
  842.         r! = lum1!: g! = lum1!: b! = lum1!
  843.         EXIT SUB
  844.     END IF
  845.  
  846.     IF lum1! < 1 THEN
  847.         chr! = sat2! * lum1!
  848.     ELSE
  849.         chr! = sat2! * (2 - lum1!)
  850.     END IF
  851.     min! = (lum1! - chr!) * 0.5
  852.  
  853.     IF max! = r2! THEN
  854.         hue2! = (g2! - b2!) / dif!
  855.         IF hue2! < 0 THEN
  856.             r! = chr! + min!: g! = min!: b! = chr! * -hue2! + min!
  857.         ELSE
  858.             r! = chr! + min!: g! = chr! * hue2! + min!: b! = min!
  859.         END IF
  860.     ELSEIF max! = g2! THEN
  861.         hue2! = (b2! - r2!) / dif!
  862.         IF hue2! < 0 THEN
  863.             r! = chr! * -hue2! + min!: g! = chr! + min!: b! = min!
  864.         ELSE
  865.             r! = min!: g! = chr! + min!: b! = chr! * hue2! + min!
  866.         END IF
  867.     ELSE
  868.         hue2! = (r2! - g2!) / dif!
  869.         IF hue2! < 0 THEN
  870.             r! = min!: g! = chr! * -hue2! + min!: b! = chr! + min!
  871.         ELSE
  872.             r! = chr! * hue2! + min!: g! = min!: b! = chr! + min!
  873.         END IF
  874.     END IF
  875.  
  876. '> merger: Skipping unused SUB mergeHSLAddition (r!, g!, b!, r2!, g2!, b2!)
  877.  
  878. '####################################################################################################################
  879.  
  880. '> merger: Skipping unused SUB mergeHue (r!, g!, b!, r2!, g2!, b2!)
  881.  
  882. '> merger: Skipping unused SUB rgb2hsl (r!, g!, b!, chr!, smallest!, hue!, sat!, lum!)
  883.  
  884. '> merger: Skipping unused SUB hsl2rgb (hue!, sat!, lum!, r!, g!, b!)
  885.  
  886. '> merger: Skipping unused SUB hsl2rgb2 (hue!, chr!, smallest!, r!, g!, b!)
  887.  

« Last Edit: August 08, 2018, 11:18:24 PM by odin »