Text Only | Text with Attachments

QB64.org Forum

Active Forums => Programs => Topic started by: Phlashlite on January 30, 2022, 10:31:41 am

Title: Worley Noise Demo
Post by: Phlashlite on January 30, 2022, 10:31:41 am
Ported Worley Noise generator. Enjoy!

-Phlashlite



Code: QB64: [Select]
  1. _TITLE "Worley Noise Demo"
  2.  
  3. 'Based on:
  4. 'Coding in the Cabana
  5. 'The Coding Train / Daniel SULffman
  6. 'https://thecodingtrain.com/CodingInTheCabana/004-worley-noise.html
  7. '[youtube]https://youtu.be/4066MndcyCk[/youtube]
  8.  
  9. 'QB64 Port by Phlashlite
  10. 'Other resources used: https://www.carljohanrosen.com/share/CellNoiseAndProcessing.pdf
  11.  
  12. 'This version only calculates noise for a 2D Vector.  But, a third dimension (or more)
  13. 'could easily be added.
  14.  
  16.  
  17. TYPE Coordinates
  18.     cx AS INTEGER
  19.     cy AS INTEGER
  21.  
  22. '++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  23. CONST WDTH = 400
  24. CONST HGHT = 400
  25. CONST CellCount = 20 'Number of random points to scatter
  26. CONST Nth = 1 'Adjustable within the number of CellPnts(CellCount), -> 1 to CellCount - 1
  27. '++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  28.  
  29. DIM SHARED CellPnts(CellCount) AS Coordinates
  30. DIM SHARED Distances(CellCount) AS INTEGER
  35.  
  36. Start = LBOUND(Distances) '__________________Used for sorting in SUB Main...
  37. Finish = UBOUND(Distances) '_________________... ... .... ^
  38.  
  39. '++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  40. 'The greater GradS, the lighter the overall feel is.  Playing with these adjusts
  41. 'the "tightnes" of the gradient between light and dark.  The larger the delta,
  42. 'the smoother the gradient
  43.  
  44. GradS = 200 '_______________________________Used to adjust color gradient...  (< 0)
  45. GradF = -100 '________________________________in SUB Main, Map! Function call (<-> 0)
  46. '++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  47.  
  49.     Setup
  50.     Main
  51.  
  52.     'Demo random settings and text.___________________________________________________
  53.     GradS = Rndm(1, 300)
  54.     GradF = Rndm(-100, 500)
  55.     PRINT "IM STILL WORKING!  Give me a few seconds... "
  56.     _DISPLAY
  57.     '__________________________________________________________________________
  58.  
  60.  
  61. SUB Setup
  62.     SCREEN _NEWIMAGE(WDTH, HGHT, 32)
  63.  
  64.     'Distribute the random points
  65.     FOR i = 1 TO CellCount
  66.         CellPnts(i).cx = RND * WDTH
  67.         CellPnts(i).cy = RND * HGHT
  68.  
  69.         'Visual queue, not "required". Turn off "_DISPLAY" below to see these.
  70.         CIRCLE (CellPnts(i).cx, CellPnts(i).cy), 2, _RGB(255, 0, 0)
  71.     NEXT
  72.  
  74.  
  75. SUB Main
  76.     'Where the magic happens.
  77.  
  78.     'Adjust STEP to play with an interlaced or screen grid type effect.
  79.     FOR x = 0 TO WDTH STEP 1 '___________________________From every screen point...
  80.         FOR y = 0 TO HGHT STEP 1 '_______________________... ... ... ^
  81.             FOR i = 1 TO CellCount STEP 1 '______________To every "CellPnts"
  82.  
  83.                 'Check the distance between and store value in Distances()
  84.                 Distances(i) = dist(x, y, CellPnts(i).cx, CellPnts(i).cy)
  85.  
  86.                 'Sort Distances()
  87.                 CALL QuickSort(Start, Finish, Distances())
  88.  
  89.                 '"Map!" the initial distance() between a specific screen point and a
  90.                 'CellPnts to a user definable distance.  Affects the color .gradient
  91.                 '++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  92.                 Gradient = map!(Distances(Nth), Distances(Start), Distances(Finish), GradS, GradF)
  93.  
  94.                 'Draw it
  95.                 PSET (x, y), _RGB(Gradient, Gradient, Gradient)
  96.                 '++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  97.             NEXT
  98.         NEXT
  99.     NEXT
  100.  
  101.     _DISPLAY 'Comment this line to watch the screen be drawn.  It's slooooow.
  102.  
  104.  
  105.  
  106. '______________________________________________________________________________
  107.  
  108. ' Map function I found or translated from somewhere.
  109. ' The Coding Train" guy on youtube, where I translated the rain code from explained it in one of his videos.
  110.  
  111. FUNCTION map! (value!, minRange!, maxRange!, newMinRange!, newMaxRange!)
  112.     map! = ((value! - minRange!) / (maxRange! - minRange!)) * (newMaxRange! - newMinRange!) + newMinRange!
  114.  
  115. '______________________________________________________________________________
  116. FUNCTION dist (x1, y1, x2, y2)
  117.     'The dist() function calculates the Euclidean distance between two points in 2D.
  118.     '2D formula:
  119.     '  dist = sqr{(x1-x2)^2+(y1-y2)^2}
  120.     dist = SQR((x1 - x2) * (x1 - x2) + (y1 - y2) * (y1 - y2))
  122. '______________________________________________________________________________
  123.  
  124. 'Standard random numbers in a range of mn! (min) to mx! (max)
  125.  
  126. FUNCTION Rndm! (mn!, mx!)
  127.     IF mn! > mx! THEN
  128.         SWAP mn!, mx!
  129.     END IF
  130.     Rndm! = RND * (mx! - mn!) + mn!
  132.  
  133. '______________________________________________________________________________
  134. SUB QuickSort (start AS INTEGER, finish AS INTEGER, array() AS INTEGER)
  135.     'Straight from the QB64 wiki
  136.     DIM Hi AS INTEGER, Lo AS INTEGER, Middle AS INTEGER
  137.     Hi = finish
  138.     Lo = start
  139.     Middle = array((Lo + Hi) / 2) 'find middle of array
  140.  
  141.     DO
  142.         DO WHILE array(Lo) < Middle
  143.             Lo = Lo + 1
  144.         LOOP
  145.  
  146.         DO WHILE array(Hi) > Middle
  147.             Hi = Hi - 1
  148.         LOOP
  149.  
  150.         IF Lo <= Hi THEN
  151.             SWAP array(Lo), array(Hi)
  152.             Lo = Lo + 1
  153.             Hi = Hi - 1
  154.         END IF
  155.     LOOP UNTIL Lo > Hi
  156.  
  157.     IF Hi > start THEN CALL QuickSort(start, Hi, array())
  158.     IF Lo < finish THEN CALL QuickSort(Lo, finish, array())
  159.  
  161.  
  162. '______________________________________________________________________________
  163.  
  164. 'Original P5js code:
  165.  
  166. '// Worley Noise
  167. '// Coding in the Cabana
  168. '// The Coding Train / Daniel SULffman
  169. '// https://thecodingtrain.com/CodingInTheCabana/004-worley-noise.html
  170. '// [youtube]https://youtu.be/4066MndcyCk[/youtube]
  171. '// p5 port: https://editor.p5js.org/codingtrain/sketches/QsiCWVczZ
  172.  
  173. 'function setup() {
  174. '  createCanvas(100, 100);
  175. '  pixelDensity(1);
  176. '  for (let i = 0; i < 20; i++) {
  177. '    points[i] = createVector(random(width), random(height), random(width));
  178. '  }
  179. '}
  180.  
  181. 'function draw() {
  182. '  LLadPixels();
  183. '  for (let x = 0; x < width; x++) {
  184. '    for (let y = 0; y < height; y++) {
  185. '      let distances = [];
  186. '      for (let i = 0; i < points.length; i++) {
  187. '        let v = points[i];
  188. '        let z = frameCount % width;
  189. '        let d = dist(x, y, z, v.x, v.y, v.z);
  190. '        distances[i] = d;
  191. '      }
  192. '      let sorted = sort(distances);
  193. '      let r = map(sorted[0], 0, 150, 0, 255);
  194. '      let g = map(sorted[1], 0, 50, 255, 0);
  195. '      let b = map(sorted[2], 0, 200, 255, 0);
  196. '      let index = (x + y * width) * 4;
  197. '      pixels[index + 0] = r;
  198. '      pixels[index + 1] = g;
  199. '      pixels[index + 2] = b;
  200. '      pixels[index + 3] = 255;
  201. '    }
  202. '  }
  203. '  updatePixels();
  204. '}
  205.  
Title: Re: Worley Noise Demo
Post by: bplus on January 30, 2022, 11:25:39 am
Ha, that reminds me of this: https://qb64forum.alephc.xyz/index.php?topic=3890.msg132266#msg132266

Playing with Voronoi code.
Title: Re: Worley Noise Demo
Post by: Phlashlite on January 30, 2022, 11:38:00 am
Quote from: bplus on January 30, 2022, 11:25:39 am
Ha, that reminds me of this: https://qb64forum.alephc.xyz/index.php?topic=3890.msg132266#msg132266

Playing with Voronoi code.

@bplus
Yep, they are very similar!  I am working on cloud textures... But this is very slow.  Both the education and the code... LOL
Title: Re: Worley Noise Demo
Post by: bplus on January 30, 2022, 11:44:54 am
You know I think there is a fractal for cloud making, @Phlashlite is that different than what you're after?
Title: Re: Worley Noise Demo
Post by: Phlashlite on January 30, 2022, 11:46:50 am
Quote from: bplus on January 30, 2022, 11:44:54 am
You know I think there is a fractal for cloud making, @Phlashlite is that different than what you're after?

Don't know.  Haven't seen it... LOL.  Maybe.
Title: Re: Worley Noise Demo
Post by: Phlashlite on January 30, 2022, 12:11:34 pm
@bplus

Like a Diamond-square algorithm?  Possibly.
Title: Re: Worley Noise Demo
Post by: bplus on January 30, 2022, 01:00:41 pm
Yeah checking it now, but QB64 is bugging out with a recursive attempt, so after lunch I will try a non recursive effort which I am pretty sure might work.
Title: Re: Worley Noise Demo
Post by: bplus on January 31, 2022, 12:35:44 pm
I think I am getting closer, my original try with recursion was buggy as heck and then I discovered I had to color the corners of the new squares being used to determine middle dot, so now it's almost looking like clouds.

Clouds Picasso style!
Code: QB64: [Select]
  1. Screen _NewImage(800, 600, 32)
  2. DefLng A-Z
  4. 'seed
  5. fcirc 0, 0, 2, _RGB32(200)
  6. fcirc _Width - 1, 0, 2, _RGB32(164)
  7. fcirc _Width - 1, _Height - 1, 2, _RGB32(184)
  8. fcirc 0, _Height - 1, 2, _RGB32(128)
  9.  
  11.     Cls
  12.     fcirc 0, 0, 2, _RGB32(200)
  13.     fcirc _Width - 1, 0, 2, _RGB32(164)
  14.     fcirc _Width - 1, _Height - 1, 2, _RGB32(184)
  15.     fcirc 0, _Height - 1, 2, _RGB32(128)
  16.  
  17.     cloud 0, 0, _Width - 1, _Height - 1
  18.     _Display
  19.     _Limit 1
  21.  
  22. Sub cloud (x1, y1, x2, y2) ' corners of square or rect
  23.     Dim c As Long
  24.     mx = (x1 + x2) / 2
  25.     my = (y1 + y2) / 2
  26.     If (mx <= x1 + 1) Or (my <= y + 1) Then Exit Sub
  27.     c = _Red32(Point(x1, y1)) + _Red32(Point(x2, y1)) + _Red32(Point(x1, y2)) + _Red32(Point(x2, y2))
  28.     If Rnd < .50 Then fcirc mx, my, 3, _RGB32((c + c / 4 + Rnd * 64 - 32) / 5) Else fcirc mx, my, 2, _RGB32(c)
  29.     'AHA! need to color corners of future squares  NOT just the middle!
  30.     fcirc mx, y1, 3, _RGB32((c + c / 4 + Rnd * 64 - 32) / 5)
  31.     fcirc x1, my, 3, _RGB32((c + c / 4 + Rnd * 64 - 32) / 5)
  32.     fcirc x2, my, 3, _RGB32((c + c / 4 + Rnd * 64 - 32) / 5)
  33.     fcirc mx, y2, 3, _RGB32((c + c / 4 + Rnd * 64 - 32) / 5)
  34.     cloud x1, y1, mx, my
  35.     cloud mx, y1, x2, my
  36.     cloud x1, my, mx, y2
  37.     cloud mx, my, x2, y2
  39.  
  40. Sub fcirc (CX As Long, CY As Long, R As Long, C As _Unsigned Long)
  41.     Dim Radius As Long, RadiusError As Long
  42.     Dim X As Long, Y As Long
  43.     Radius = Abs(R): RadiusError = -Radius: X = Radius: Y = 0
  44.     If Radius = 0 Then PSet (CX, CY), C: Exit Sub
  45.     Line (CX - X, CY)-(CX + X, CY), C, BF
  46.     While X > Y
  47.         RadiusError = RadiusError + Y * 2 + 1
  48.         If RadiusError >= 0 Then
  49.             If X <> Y + 1 Then
  50.                 Line (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
  51.                 Line (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
  52.             End If
  53.             X = X - 1
  54.             RadiusError = RadiusError - X * 2
  55.         End If
  56.         Y = Y + 1
  57.         Line (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
  58.         Line (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
  59.     Wend
  61.  
  62.  
  63.  

Needs some blending, shmearing :)
Title: Re: Worley Noise Demo
Post by: _vince on January 31, 2022, 12:56:27 pm
very opulent flooring!
Title: Re: Worley Noise Demo
Post by: bplus on January 31, 2022, 02:44:13 pm
Quote from: _vince on January 31, 2022, 12:56:27 pm
very opulent flooring!

Yeah that maybe a better app than trying to make clouds. I tried smear but the blocks are too distinct to blur out easily.
Title: Re: Worley Noise Demo
Post by: Phlashlite on February 01, 2022, 10:46:59 pm
@bplus  I'll have to study it.  It might work for what I'm looking for... with some modification of course!... Thanks!

Quote from: bplus on January 31, 2022, 12:35:44 pm

Clouds Picasso style!

Title: Re: Worley Noise Demo
Post by: bplus on February 02, 2022, 05:43:32 am
Perlin Noise might be better approach.
Title: Re: Worley Noise Demo
Post by: FellippeHeitor on February 02, 2022, 06:38:41 am
Code: QB64: [Select]
  1. 'noise function related variables
  2. DIM SHARED perlin_octaves AS SINGLE, perlin_amp_falloff AS SINGLE
  3.  
  4. DIM SHARED noiseScale AS _FLOAT
  5. noiseScale = 0.02
  6.  
  7. SCREEN _NEWIMAGE(300, 300, 32)
  8.  
  10.     CLS , _RGB32(51)
  11.  
  12.     COLOR _RGB32(255)
  13.     _PRINTSTRING (0, 0), "Move your mouse"
  14.  
  16.     FOR x = 0 TO _WIDTH
  17.         noiseVal = noise((_MOUSEX + x) * noiseScale, _MOUSEY * noiseScale, 0)
  18.         COLOR _RGB32(noiseVal * 255)
  19.         LINE (x, _MOUSEY + noiseVal * 80)-(x, _HEIGHT)
  20.     NEXT
  21.     _DISPLAY
  22.     _LIMIT 60
  24.  
  25. FUNCTION noise! (x AS SINGLE, y AS SINGLE, z AS SINGLE)
  26.     STATIC p5NoiseSetup AS _BYTE
  27.     STATIC perlin() AS SINGLE
  28.     STATIC PERLIN_YWRAPB AS SINGLE, PERLIN_YWRAP AS SINGLE
  29.     STATIC PERLIN_ZWRAPB AS SINGLE, PERLIN_ZWRAP AS SINGLE
  30.     STATIC PERLIN_SIZE AS SINGLE
  31.  
  32.     CONST true = -1, false = 0
  33.  
  34.     IF NOT p5NoiseSetup THEN
  35.         p5NoiseSetup = true
  36.  
  37.         PERLIN_YWRAPB = 4
  38.         PERLIN_YWRAP = INT(1 * (2 ^ PERLIN_YWRAPB))
  39.         PERLIN_ZWRAPB = 8
  40.         PERLIN_ZWRAP = INT(1 * (2 ^ PERLIN_ZWRAPB))
  41.         PERLIN_SIZE = 4095
  42.  
  43.         perlin_octaves = 4
  44.         perlin_amp_falloff = 0.5
  45.  
  46.         REDIM perlin(PERLIN_SIZE + 1) AS SINGLE
  47.         DIM i AS SINGLE
  48.         FOR i = 0 TO PERLIN_SIZE + 1
  49.             perlin(i) = RND
  50.         NEXT
  51.     END IF
  52.  
  53.     x = ABS(x)
  54.     y = ABS(y)
  55.     z = ABS(z)
  56.  
  57.     DIM xi AS SINGLE, yi AS SINGLE, zi AS SINGLE
  58.     xi = INT(x)
  59.     yi = INT(y)
  60.     zi = INT(z)
  61.  
  62.     DIM xf AS SINGLE, yf AS SINGLE, zf AS SINGLE
  63.     xf = x - xi
  64.     yf = y - yi
  65.     zf = z - zi
  66.  
  67.     DIM r AS SINGLE, ampl AS SINGLE, o AS SINGLE
  68.     r = 0
  69.     ampl = .5
  70.  
  71.     FOR o = 1 TO perlin_octaves
  72.         DIM of AS SINGLE, rxf AS SINGLE
  73.         DIM ryf AS SINGLE, n1 AS SINGLE, n2 AS SINGLE, n3 AS SINGLE
  74.         of = xi + INT(yi * (2 ^ PERLIN_YWRAPB)) + INT(zi * (2 ^ PERLIN_ZWRAPB))
  75.  
  76.         rxf = 0.5 * (1.0 - COS(xf * _PI))
  77.         ryf = 0.5 * (1.0 - COS(yf * _PI))
  78.  
  79.         n1 = perlin(of AND PERLIN_SIZE)
  80.         n1 = n1 + rxf * (perlin((of + 1) AND PERLIN_SIZE) - n1)
  81.         n2 = perlin((of + PERLIN_YWRAP) AND PERLIN_SIZE)
  82.         n2 = n2 + rxf * (perlin((of + PERLIN_YWRAP + 1) AND PERLIN_SIZE) - n2)
  83.         n1 = n1 + ryf * (n2 - n1)
  84.  
  85.         of = of + PERLIN_ZWRAP
  86.         n2 = perlin(of AND PERLIN_SIZE)
  87.         n2 = n2 + rxf * (perlin((of + 1) AND PERLIN_SIZE) - n2)
  88.         n3 = perlin((of + PERLIN_YWRAP) AND PERLIN_SIZE)
  89.         n3 = n3 + rxf * (perlin((of + PERLIN_YWRAP + 1) AND PERLIN_SIZE) - n3)
  90.         n2 = n2 + ryf * (n3 - n2)
  91.  
  92.         n1 = n1 + (0.5 * (1.0 - COS(zf * _PI))) * (n2 - n1)
  93.  
  94.         r = r + n1 * ampl
  95.         ampl = ampl * perlin_amp_falloff
  96.         xi = INT(xi * (2 ^ 1))
  97.         xf = xf * 2
  98.         yi = INT(yi * (2 ^ 1))
  99.         yf = yf * 2
  100.         zi = INT(zi * (2 ^ 1))
  101.         zf = zf * 2
  102.  
  103.         IF xf >= 1.0 THEN xi = xi + 1: xf = xf - 1
  104.         IF yf >= 1.0 THEN yi = yi + 1: yf = yf - 1
  105.         IF zf >= 1.0 THEN zi = zi + 1: zf = zf - 1
  106.     NEXT
  107.     noise! = r
  109.  
  110. SUB noiseDetail (lod!, falloff!)
  111.     IF lod! > 0 THEN perlin_octaves = lod!
  112.     IF falloff! > 0 THEN perlin_amp_falloff = falloff!
  114.  
  115. FUNCTION map! (value!, minRange!, maxRange!, newMinRange!, newMaxRange!)
  116.     map! = ((value! - minRange!) / (maxRange! - minRange!)) * (newMaxRange! - newMinRange!) + newMinRange!
  118.  

From https://github.com/AshishKingdom/p5js.bas/blob/master/p5js.bas
Title: Re: Worley Noise Demo
Post by: bplus on February 02, 2022, 11:32:49 am
 
Quote from: FellippeHeitor on February 02, 2022, 06:38:41 am
Code: QB64: [Select]
  1. 'noise function related variables
  2. DIM SHARED perlin_octaves AS SINGLE, perlin_amp_falloff AS SINGLE
  3.  
  4. DIM SHARED noiseScale AS _FLOAT
  5. noiseScale = 0.02
  6.  
  7. SCREEN _NEWIMAGE(300, 300, 32)
  8.  
  10.     CLS , _RGB32(51)
  11.  
  12.     COLOR _RGB32(255)
  13.     _PRINTSTRING (0, 0), "Move your mouse"
  14.  
  16.     FOR x = 0 TO _WIDTH
  17.         noiseVal = noise((_MOUSEX + x) * noiseScale, _MOUSEY * noiseScale, 0)
  18.         COLOR _RGB32(noiseVal * 255)
  19.         LINE (x, _MOUSEY + noiseVal * 80)-(x, _HEIGHT)
  20.     NEXT
  21.     _DISPLAY
  22.     _LIMIT 60
  24.  
  25. FUNCTION noise! (x AS SINGLE, y AS SINGLE, z AS SINGLE)
  26.     STATIC p5NoiseSetup AS _BYTE
  27.     STATIC perlin() AS SINGLE
  28.     STATIC PERLIN_YWRAPB AS SINGLE, PERLIN_YWRAP AS SINGLE
  29.     STATIC PERLIN_ZWRAPB AS SINGLE, PERLIN_ZWRAP AS SINGLE
  30.     STATIC PERLIN_SIZE AS SINGLE
  31.  
  32.     CONST true = -1, false = 0
  33.  
  34.     IF NOT p5NoiseSetup THEN
  35.         p5NoiseSetup = true
  36.  
  37.         PERLIN_YWRAPB = 4
  38.         PERLIN_YWRAP = INT(1 * (2 ^ PERLIN_YWRAPB))
  39.         PERLIN_ZWRAPB = 8
  40.         PERLIN_ZWRAP = INT(1 * (2 ^ PERLIN_ZWRAPB))
  41.         PERLIN_SIZE = 4095
  42.  
  43.         perlin_octaves = 4
  44.         perlin_amp_falloff = 0.5
  45.  
  46.         REDIM perlin(PERLIN_SIZE + 1) AS SINGLE
  47.         DIM i AS SINGLE
  48.         FOR i = 0 TO PERLIN_SIZE + 1
  49.             perlin(i) = RND
  50.         NEXT
  51.     END IF
  52.  
  53.     x = ABS(x)
  54.     y = ABS(y)
  55.     z = ABS(z)
  56.  
  57.     DIM xi AS SINGLE, yi AS SINGLE, zi AS SINGLE
  58.     xi = INT(x)
  59.     yi = INT(y)
  60.     zi = INT(z)
  61.  
  62.     DIM xf AS SINGLE, yf AS SINGLE, zf AS SINGLE
  63.     xf = x - xi
  64.     yf = y - yi
  65.     zf = z - zi
  66.  
  67.     DIM r AS SINGLE, ampl AS SINGLE, o AS SINGLE
  68.     r = 0
  69.     ampl = .5
  70.  
  71.     FOR o = 1 TO perlin_octaves
  72.         DIM of AS SINGLE, rxf AS SINGLE
  73.         DIM ryf AS SINGLE, n1 AS SINGLE, n2 AS SINGLE, n3 AS SINGLE
  74.         of = xi + INT(yi * (2 ^ PERLIN_YWRAPB)) + INT(zi * (2 ^ PERLIN_ZWRAPB))
  75.  
  76.         rxf = 0.5 * (1.0 - COS(xf * _PI))
  77.         ryf = 0.5 * (1.0 - COS(yf * _PI))
  78.  
  79.         n1 = perlin(of AND PERLIN_SIZE)
  80.         n1 = n1 + rxf * (perlin((of + 1) AND PERLIN_SIZE) - n1)
  81.         n2 = perlin((of + PERLIN_YWRAP) AND PERLIN_SIZE)
  82.         n2 = n2 + rxf * (perlin((of + PERLIN_YWRAP + 1) AND PERLIN_SIZE) - n2)
  83.         n1 = n1 + ryf * (n2 - n1)
  84.  
  85.         of = of + PERLIN_ZWRAP
  86.         n2 = perlin(of AND PERLIN_SIZE)
  87.         n2 = n2 + rxf * (perlin((of + 1) AND PERLIN_SIZE) - n2)
  88.         n3 = perlin((of + PERLIN_YWRAP) AND PERLIN_SIZE)
  89.         n3 = n3 + rxf * (perlin((of + PERLIN_YWRAP + 1) AND PERLIN_SIZE) - n3)
  90.         n2 = n2 + ryf * (n3 - n2)
  91.  
  92.         n1 = n1 + (0.5 * (1.0 - COS(zf * _PI))) * (n2 - n1)
  93.  
  94.         r = r + n1 * ampl
  95.         ampl = ampl * perlin_amp_falloff
  96.         xi = INT(xi * (2 ^ 1))
  97.         xf = xf * 2
  98.         yi = INT(yi * (2 ^ 1))
  99.         yf = yf * 2
  100.         zi = INT(zi * (2 ^ 1))
  101.         zf = zf * 2
  102.  
  103.         IF xf >= 1.0 THEN xi = xi + 1: xf = xf - 1
  104.         IF yf >= 1.0 THEN yi = yi + 1: yf = yf - 1
  105.         IF zf >= 1.0 THEN zi = zi + 1: zf = zf - 1
  106.     NEXT
  107.     noise! = r
  109.  
  110. SUB noiseDetail (lod!, falloff!)
  111.     IF lod! > 0 THEN perlin_octaves = lod!
  112.     IF falloff! > 0 THEN perlin_amp_falloff = falloff!
  114.  
  115. FUNCTION map! (value!, minRange!, maxRange!, newMinRange!, newMaxRange!)
  116.     map! = ((value! - minRange!) / (maxRange! - minRange!)) * (newMaxRange! - newMinRange!) + newMinRange!
  118.  

From https://github.com/AshishKingdom/p5js.bas/blob/master/p5js.bas


Yeah I tried running p5js Perlin Noise when Ashish mentioned it at Discord. Wouldn't work possible from the 2.0 change in using variables with Function names.

But the above is only 1D, not cloudy at all, but reminds me of landscape building.

https://en.wikipedia.org/wiki/Perlin_noise
Mentions Dot Product which I dont know if you are using in p5js?
Title: Re: Worley Noise Demo
Post by: Phlashlite on February 02, 2022, 12:32:29 pm
@bplus  Actually, there is a method of using Perlin noise to distribute the points for the Worley noise that is interesting.

Also, if one is industrious, it can be sped up by 15% to 20% by avoiding unnecessary calculations as described in this paper:

 https://jcgt.org/published/0008/01/02/paper.pdf (https://jcgt.org/published/0008/01/02/paper.pdf)

I also tried 2 stepping the x,y loops which sped it up by a factor of 4... but I would need to fuzz the neighbors which might end up just killing those gains...

Anyway, I am working on it :).

I appreciate the interactions here.  Thanks all!
Title: Re: Worley Noise Demo
Post by: bplus on February 02, 2022, 12:36:56 pm
Here is one less Picasso and more moving:
Code: QB64: [Select]
  1. Screen _NewImage(800, 600, 32)
  2. DefLng A-Z
  4. 'seed
  5. fcirc 0, 0, 2, _RGB32(128, 128, 128, 200)
  6. fcirc _Width - 1, 0, 2, _RGB32(164, 164, 164, 200)
  7. fcirc _Width - 1, _Height - 1, 2, _RGB32(184, 184, 184, 200)
  8. fcirc 0, _Height - 1, 2, _RGB32(200, 200, 200, 200)
  9. cloud 0, 0, _Width - 1, _Height - 1, -1
  11.     cloud 0, 0, _Width - 1, _Height - 1, 0
  12.     _Display
  13.     _Limit 30
  15.  
  16. Sub cloud (x1, y1, x2, y2, initTF) ' corners of square or rect
  17.     Dim As Long c, ave, al
  18.     al = 255
  19.     mx = (x1 + x2) / 2
  20.     my = (y1 + y2) / 2
  21.     If (mx <= x1 + 1) Or (my <= y + 1) Then Exit Sub
  22.     c = (_Red32(Point(x1, y1)) + _Red32(Point(x2, y1)) + _Red32(Point(x1, y2)) + _Red32(Point(x2, y2))) / 4
  23.     ave = (5 * c + Rnd * 64 - 32) / 5
  24.     fcirc mx, my, 3, _RGB32(ave, ave, ave, al)
  25.     If init Then
  26.         'AHA! need to color corners of future squares  NOT just the middle!
  27.         fcirc mx, y1, 3, _RGB32(c + 32 * Rnd - 16, c + 32 * Rnd - 16, c + 32 * Rnd - 16, al)
  28.         fcirc x1, my, 3, _RGB32(c + 32 * Rnd - 16, c + 32 * Rnd - 16, c + 32 * Rnd - 16, al)
  29.         fcirc x2, my, 3, _RGB32(c + 32 * Rnd - 16, c + 32 * Rnd - 16, c + 32 * Rnd - 16, al)
  30.         fcirc mx, y2, 3, _RGB32(c + 32 * Rnd - 16, c + 32 * Rnd - 16, c + 32 * Rnd - 16, al)
  31.     End If
  32.     cloud x1, y1, mx, my, 0
  33.     cloud mx, y1, x2, my, 0
  34.     cloud x1, my, mx, y2, 0
  35.     cloud mx, my, x2, y2, 0
  37.  
  38. Sub fcirc (CX As Long, CY As Long, R As Long, C As _Unsigned Long)
  39.     Dim Radius As Long, RadiusError As Long
  40.     Dim X As Long, Y As Long
  41.     Radius = Abs(R): RadiusError = -Radius: X = Radius: Y = 0
  42.     If Radius = 0 Then PSet (CX, CY), C: Exit Sub
  43.     Line (CX - X, CY)-(CX + X, CY), C, BF
  44.     While X > Y
  45.         RadiusError = RadiusError + Y * 2 + 1
  46.         If RadiusError >= 0 Then
  47.             If X <> Y + 1 Then
  48.                 Line (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
  49.                 Line (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
  50.             End If
  51.             X = X - 1
  52.             RadiusError = RadiusError - X * 2
  53.         End If
  54.         Y = Y + 1
  55.         Line (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
  56.         Line (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
  57.     Wend
  59.  
Title: Re: Worley Noise Demo
Post by: Phlashlite on February 02, 2022, 12:55:02 pm
Ooooh... That is close! :)
Title: Re: Worley Noise Demo
Post by: bplus on February 02, 2022, 01:02:33 pm
Yeah close, but not IT yet!
Title: Re: Worley Noise Demo
Post by: Phlashlite on February 02, 2022, 01:11:58 pm
I have to step through these things to figure them out...

I mean, I get the gist of it.. but I need details!

LOL!
Title: Re: Worley Noise Demo
Post by: FellippeHeitor on February 02, 2022, 01:26:11 pm
Quote from: bplus on February 02, 2022, 11:32:49 am
https://en.wikipedia.org/wiki/Perlin_noise
Mentions Dot Product which I dont know if you are using in p5js?

I have no idea. Whatever p5.js is doing, this is doing.
Title: Re: Worley Noise Demo
Post by: bplus on February 02, 2022, 02:04:58 pm
Quote from: FellippeHeitor on February 02, 2022, 01:26:11 pm
I have no idea. Whatever p5.js is doing, this is doing.

Yeah my version of p5js has several Noise examples 1, 2, 3 could be dimensions? So what you reassembled may have been only the first dimension?

Update: OK I ran p5js through QB64 v1.5 to test the 3 "Perlin Noise" samples, plus I show that my version of p5js for QB64 has errors. It shows the Perlins as variations of 1 dimension.
 
Title: Re: Worley Noise Demo
Post by: bplus on February 02, 2022, 10:16:20 pm
OK time to give your CPU's a workout! I found some pretty nice code from RetroBASIC forum by Galileo who found code from FreeBasic some years ago, I modified to get sky moving but a little jerky. Maybe with Mem tricks we can rewrite the noise array faster.

Code: QB64: [Select]
  2. _Title "Noise Texture Generator" ' trans Yabasic Port by Galileo to QB64 b+ 2022-02-02
  3. '//Noise texure generator
  4. '//Taken from
  5. '//http://www.student.kuleuven.be/~m0216922/CG/randomnoise.html/CG/randomnoise.html
  6. '//=======================================================================
  7. '// Ported from FreeBASIC to Yabasic by Galileo, 1/2018
  8. '// Original code: https://www.freebasic.net/forum/viewtopic.php?f=7&t=13842
  9.  
  10. Const twidth = 800, theight = 600, zoom = 128
  11. Dim Shared noise(twidth * theight) '//the noise array
  12. Dim Shared texture(twidth * theight) '//texture array
  13. Dim Shared pal(256) As _Unsigned Long '//color palette
  14.  
  15. Screen _NewImage(twidth, theight, 32)
  16. _ScreenMove 100, 100
  17. Dim x, y
  18.  
  19. MakePalette 255, 255, 255, 100, 100, 180
  20. GenerateNoise
  22.     For y = 0 To theight - 1
  23.         For x = 0 To twidth - 1
  24.             If x <> twidth - 1 Then
  25.                 noise(x + y * theight) = noise((x + 1) + y * theight)
  26.             Else
  27.                 If Rnd < .5 Then noise(x + y * theight) = Rnd Else noise(x + y * theight) = noise((x - 1) + y * theight)
  28.             End If
  29.         Next
  30.     Next
  31.     buildtexture
  32.     drawtexture
  33.     _Display
  35.  
  36. '//interpolation code by rattrapmax6
  37. Sub MakePalette (sr, sg, sb, er, eg, eb) ' (b+) start and end RGB's ? yes
  38.     Dim i, istart(3), iend(3), ishow(3), rend(3), interpol(3)
  39.  
  40.     interpol(0) = 255
  41.     istart(1) = sr
  42.     istart(2) = sg
  43.     istart(3) = sb
  44.     iend(1) = er
  45.     iend(2) = eg
  46.     iend(3) = eb
  47.     interpol(1) = (istart(1) - iend(1)) / interpol(0)
  48.     interpol(2) = (istart(2) - iend(2)) / interpol(0)
  49.     interpol(3) = (istart(3) - iend(3)) / interpol(0)
  50.     rend(1) = istart(1)
  51.     rend(2) = istart(2)
  52.     rend(3) = istart(3)
  53.  
  54.     For i = 0 To 255
  55.         ishow(1) = rend(1)
  56.         ishow(2) = rend(2)
  57.         ishow(3) = rend(3)
  58.  
  59.         pal(i) = _RGB32(ishow(1), ishow(2), ishow(3))
  60.  
  61.         rend(1) = rend(1) - interpol(1)
  62.         rend(2) = rend(2) - interpol(2)
  63.         rend(3) = rend(3) - interpol(3)
  64.     Next i
  66.  
  67. '//generates random noise.
  68. Sub GenerateNoise ()
  69.     Dim As Long x, y
  70.  
  71.     For x = 0 To twidth - 1
  72.         For y = 0 To theight - 1
  73.             noise(x + y * twidth) = Rnd
  74.         Next y
  75.     Next x
  77.  
  78. Function SmoothNoise (x, y)
  79.     '//get fractional part of x and y
  80.     Dim fractx, fracty, x1, y1, x2, y2, value
  81.     fractx = x - Int(x)
  82.     fracty = y - Int(y)
  83.  
  84.     '//wrap around
  85.     x1 = (Int(x) + twidth) Mod twidth
  86.     y1 = (Int(y) + theight) Mod theight
  87.  
  88.     '//neighbor values
  89.     x2 = (x1 + twidth - 1) Mod twidth
  90.     y2 = (y1 + theight - 1) Mod theight
  91.  
  92.     '//smooth the noise with bilinear interpolation
  93.     value = 0.0
  94.     value = value + fractx * fracty * noise(x1 + y1 * twidth)
  95.     value = value + fractx * (1 - fracty) * noise(x1 + y2 * twidth)
  96.     value = value + (1 - fractx) * fracty * noise(x2 + y1 * twidth)
  97.     value = value + (1 - fractx) * (1 - fracty) * noise(x2 + y2 * twidth)
  98.  
  99.     SmoothNoise = value
  101.  
  102. Function Turbulence (x, y, size)
  103.     Dim value, initialsize
  104.  
  105.     initialsize = size
  106.     While (size >= 1)
  107.         value = value + SmoothNoise(x / size, y / size) * size
  108.         size = size / 2.0
  109.     Wend
  110.     Turbulence = (128.0 * value / initialsize)
  112.  
  113. '//builds the texture.
  114. Sub buildtexture
  115.     Dim x, y
  116.  
  117.     For x = 0 To twidth - 1
  118.         For y = 0 To theight - 1
  119.             texture(x + y * twidth) = Turbulence(x, y, zoom)
  120.         Next y
  121.     Next x
  123.  
  124. '//draws texture to screen.
  125. Sub drawtexture ()
  126.     Dim x, y
  127.  
  128.     For x = 0 To twidth - 1
  129.         For y = 0 To theight - 1
  130.             PSet (x, y), pal(texture((x + y * twidth)))
  131.         Next y
  132.     Next x
  134.  
  135.  

  [ This attachment cannot be displayed inline in 'Print Page' view ]  
Title: Re: Worley Noise Demo
Post by: _vince on February 05, 2022, 06:57:26 am
nice, that is a lot of mingling of basics.  How would you rank your favourite BASICs?  Justbasic, freebasic, xbasic, qbasic, qb64, libertybasic, VB.NET etc
Title: Re: Worley Noise Demo
Post by: bplus on February 05, 2022, 09:06:43 am
Quote from: _vince on February 05, 2022, 06:57:26 am
nice, that is a lot of mingling of basics.  How would you rank your favourite BASICs?  Justbasic, freebasic, xbasic, qbasic, qb64, libertybasic, VB.NET etc

Using QB64 all the time now but first Eval function was in JB and 100 line Interpreter (with double parking) built from SmallBASIC Interpreter (no line numbers!).
Title: Re: Worley Noise Demo
Post by: _vince on February 06, 2022, 08:27:52 am
mod of a B+ mod!

Code: QB64: [Select]
  2. _Title "Noise Texture Generator" ' trans Yabasic Port by Galileo to QB64 b+ 2022-02-02
  3. '//Noise texure generator
  4. '//Taken from
  5. '//http://www.student.kuleuven.be/~m0216922/CG/randomnoise.html/CG/randomnoise.html
  6. '//=======================================================================
  7. '// Ported from FreeBASIC to Yabasic by Galileo, 1/2018
  8. '// Original code: https://www.freebasic.net/forum/viewtopic.php?f=7&t=13842
  9.  
  10. Const twidth = 800, theight = 600, zoom = 128
  11. Dim Shared noise(10*twidth * theight) '//the noise array
  12. Dim Shared texture(10*twidth * theight) '//texture array
  13. Dim Shared pal(256) As _Unsigned Long '//color palette
  14.  
  15. Screen _NewImage(twidth, theight, 32)
  16. _ScreenMove 100, 100
  17. Dim x, y
  18.  
  19. locate 1,1
  20. ? "please give us a few seconds"
  22.  
  23. MakePalette 255, 255, 255, 100, 100, 180
  24.  
  25. GenerateNoise
  26. buildtexture
  27.  
  28.  
  31. for i=0 to 9*(twidth )
  32.         drawtexture i
  33.         _limit 30
  34.         _display
  37.  
  38. 'Do
  39. '    For y = 0 To theight - 1
  40. '        For x = 0 To twidth - 1
  41. '            If x <> twidth - 1 Then
  42. '                noise(x + y * theight) = noise((x + 1) + y * theight)
  43. '            Else
  44. '                If Rnd < .5 Then noise(x + y * theight) = Rnd Else noise(x + y * theight) = noise((x - 1) + y * theight)
  45. '            End If
  46. '        Next
  47. '    Next
  48. '    buildtexture
  49. '    drawtexture
  50. '    _Display
  51. 'Loop Until _KeyDown(27)
  54.  
  55. '//interpolation code by rattrapmax6
  56. Sub MakePalette (sr, sg, sb, er, eg, eb) ' (b+) start and end RGB's ? yes
  57.     Dim i, istart(3), iend(3), ishow(3), rend(3), interpol(3)
  58.  
  59.     interpol(0) = 255
  60.     istart(1) = sr
  61.     istart(2) = sg
  62.     istart(3) = sb
  63.     iend(1) = er
  64.     iend(2) = eg
  65.     iend(3) = eb
  66.     interpol(1) = (istart(1) - iend(1)) / interpol(0)
  67.     interpol(2) = (istart(2) - iend(2)) / interpol(0)
  68.     interpol(3) = (istart(3) - iend(3)) / interpol(0)
  69.     rend(1) = istart(1)
  70.     rend(2) = istart(2)
  71.     rend(3) = istart(3)
  72.  
  73.     For i = 0 To 255
  74.         ishow(1) = rend(1)
  75.         ishow(2) = rend(2)
  76.         ishow(3) = rend(3)
  77.  
  78.         pal(i) = _RGB32(ishow(1), ishow(2), ishow(3))
  79.  
  80.         rend(1) = rend(1) - interpol(1)
  81.         rend(2) = rend(2) - interpol(2)
  82.         rend(3) = rend(3) - interpol(3)
  83.     Next i
  85.  
  86. '//generates random noise.
  87. Sub GenerateNoise ()
  88.     Dim As Long x, y
  89.  
  90.     For x = 0 To 10*twidth - 1
  91.         For y = 0 To theight - 1
  92.             noise(x + y * twidth) = Rnd
  93.         Next y
  94.     Next x
  96.  
  97. Function SmoothNoise (x, y)
  98.     '//get fractional part of x and y
  99.     Dim fractx, fracty, x1, y1, x2, y2, value
  100.     fractx = x - Int(x)
  101.     fracty = y - Int(y)
  102.  
  103.     '//wrap around
  104.     x1 = (Int(x) + 10*twidth) Mod twidth
  105.     y1 = (Int(y) + theight) Mod theight
  106.  
  107.     '//neighbor values
  108.     x2 = (x1 + 10*twidth - 1) Mod twidth
  109.     y2 = (y1 + theight - 1) Mod theight
  110.  
  111.     '//smooth the noise with bilinear interpolation
  112.     value = 0.0
  113.     value = value + fractx * fracty * noise(x1 + y1 * twidth)
  114.     value = value + fractx * (1 - fracty) * noise(x1 + y2 * twidth)
  115.     value = value + (1 - fractx) * fracty * noise(x2 + y1 * twidth)
  116.     value = value + (1 - fractx) * (1 - fracty) * noise(x2 + y2 * twidth)
  117.  
  118.     SmoothNoise = value
  120.  
  121. Function Turbulence (x, y, size)
  122.     Dim value, initialsize
  123.  
  124.     initialsize = size
  125.     While (size >= 1)
  126.         value = value + SmoothNoise(x / size, y / size) * size
  127.         size = size / 2.0
  128.     Wend
  129.     Turbulence = (128.0 * value / initialsize)
  131.  
  132. '//builds the texture.
  133. Sub buildtexture
  134.     Dim x, y
  135.  
  136.     For x = 0 To 10*twidth - 1
  137.         For y = 0 To theight - 1
  138.             texture(x + y * 10*twidth) = Turbulence(x, y, zoom)
  139.         Next y
  140.     Next x
  142.  
  143. '//draws texture to screen.
  144. Sub drawtexture (dx )
  145.     Dim x, y
  146.  
  147.     For x = 0 To twidth - 1
  148.         For y = 0 To theight - 1
  149.             PSet (x, y), pal(texture(((x + dx) + y * 10*twidth)))
  150.         Next y
  151.     Next x
  153.  
  154.  
Title: Re: Worley Noise Demo
Post by: bplus on February 06, 2022, 10:04:43 am
@_vince  yeah! nice mod much better!
Title: Re: Worley Noise Demo
Post by: Phlashlite on February 06, 2022, 11:57:23 am
Those are nice!  Thank you both!  Lots to process... :)
Title: Re: Worley Noise Demo
Post by: SierraKen on February 06, 2022, 05:37:20 pm
Really cool clouds! I tried to make my own mod with this but no success. I was trying to make it all different colors at once instead of just white and blue.
Title: Re: Worley Noise Demo
Post by: bplus on February 06, 2022, 09:39:20 pm
Quote from: SierraKen on February 06, 2022, 05:37:20 pm
Really cool clouds! I tried to make my own mod with this but no success. I was trying to make it all different colors at once instead of just white and blue.

You can redefine the pallet making sub, put in your own 255 colors best if colors close to each other in number are also close in hue.
Text Only | Text with Attachments