Text Only | Text with Attachments

QB64.org Forum

Active Forums => Programs => Topic started by: Ashish on May 04, 2021, 02:01:02 am

Title: Colorful Triangle Geometry
Post by: Ashish on May 04, 2021, 02:01:02 am
Hi everyone!
I made a program which makes colorful and beautiful pattern full of triangles.
I hope you will like like it. :)

Code: QB64: [Select]
  1. 'Coded By Ashish
  2. '4 may, 2021
  3. 'edited : 9 may,2021
  4. _Title "Triangular Geometry"
  5. Screen _NewImage(800, 600, 32)
  7. 404 pattern 400, 0, 0, 600, 800, 600, 600, Int(Rnd * 255), 50 + Int(Rnd * 205)
  9. _Delay 0.25
  10. GoTo 404
  11. Sub pattern (x0, y0, x1, y1, x2, y2, d_max, s_min, s_width)
  12.     mx = (x1 + x2) / 2: my = (y1 + y2) / 2
  13.     d = Int(Sqr((mx - x0) ^ 2 + (my - y0) ^ 2))
  14.     drawTriangleSolid x0, y0, x1, y1, x2, y2, hsb(map(d, 10, d_max, s_min, (s_max + s_width) Mod 255), 255, 128, map(d, 10, d_max, 50, 255))
  15.     If d > 10 Then
  16.         If d >= d_max Then
  17.             pattern mx, my, x0, y0, x1, y1, d_max, s_min, s_width
  18.             pattern mx, my, x0, y0, x2, y2, d_max, s_min, s_width
  19.  
  20.         Else
  21.             If Rnd > 0.5 Then pattern mx, my, x0, y0, x1, y1, d_max, s_min, s_width Else pattern mx, my, x0, y0, x2, y2, d_max, s_min, s_width
  22.         End If
  23.     End If
  25.  
  26. Sub drawTriangleSolid (x1, y1, x2, y2, x3, y3, c~&)
  27.     Static temp_color_img As Long, drawTriangle_init As _Byte
  28.     If drawTriangle_init = 0 Then
  29.         temp_color_img = _NewImage(1, 1, 32)
  30.         drawTriangle_init = 1
  31.     End If
  32.     preDest = _Dest
  33.     _Dest temp_color_img
  34.     PSet (0, 0), c~&
  35.     _Dest preDest
  36.  
  37.     _MapTriangle (0, 0)-(0, 0)-(0, 0), temp_color_img To(x1, y1)-(x2, y2)-(x3, y3), 0, _Smooth
  38.  
  40.  
  41. Sub drawTriangle (x1, y1, x2, y2, x3, y3, c~&)
  42.     Line (x1, y1)-(x2, y2), c~&
  43.     Line (x2, y2)-(x3, y3), c~&
  44.     Line (x3, y3)-(x1, y1), c~&
  46.  
  47. 'method adapted form http://stackoverflow.com/questions/4106363/converting-rgb-to-hsb-colors
  48. Function hsb~& (__H As _Float, __S As _Float, __B As _Float, A As _Float)
  49.     Dim H As _Float, S As _Float, B As _Float
  50.  
  51.     H = map(__H, 0, 255, 0, 360)
  52.     S = map(__S, 0, 255, 0, 1)
  53.     B = map(__B, 0, 255, 0, 1)
  54.  
  55.     If S = 0 Then
  56.         hsb~& = _RGBA32(B * 255, B * 255, B * 255, A)
  57.         Exit Function
  58.     End If
  59.  
  60.     Dim fmx As _Float, fmn As _Float
  61.     Dim fmd As _Float, iSextant As Integer
  62.     Dim imx As Integer, imd As Integer, imn As Integer
  63.  
  64.     If B > .5 Then
  65.         fmx = B - (B * S) + S
  66.         fmn = B + (B * S) - S
  67.     Else
  68.         fmx = B + (B * S)
  69.         fmn = B - (B * S)
  70.     End If
  71.  
  72.     iSextant = Int(H / 60)
  73.  
  74.     If H >= 300 Then
  75.         H = H - 360
  76.     End If
  77.  
  78.     H = H / 60
  79.     H = H - (2 * Int(((iSextant + 1) Mod 6) / 2))
  80.  
  81.     If iSextant Mod 2 = 0 Then
  82.         fmd = (H * (fmx - fmn)) + fmn
  83.     Else
  84.         fmd = fmn - (H * (fmx - fmn))
  85.     End If
  86.  
  87.     imx = _Round(fmx * 255)
  88.     imd = _Round(fmd * 255)
  89.     imn = _Round(fmn * 255)
  90.  
  91.     Select Case Int(iSextant)
  92.         Case 1
  93.             hsb~& = _RGBA32(imd, imx, imn, A)
  94.         Case 2
  95.             hsb~& = _RGBA32(imn, imx, imd, A)
  96.         Case 3
  97.             hsb~& = _RGBA32(imn, imd, imx, A)
  98.         Case 4
  99.             hsb~& = _RGBA32(imd, imn, imx, A)
  100.         Case 5
  101.             hsb~& = _RGBA32(imx, imn, imd, A)
  102.         Case Else
  103.             hsb~& = _RGBA32(imx, imd, imn, A)
  104.     End Select
  105.  
  107.  
  108.  
  109. 'from p5js.bas
  110. Function map! (value!, minRange!, maxRange!, newMinRange!, newMaxRange!)
  111.     map! = ((value! - minRange!) / (maxRange! - minRange!)) * (newMaxRange! - newMinRange!) + newMinRange!
  113.  
  114.  


 [ This attachment cannot be displayed inline in 'Print Page' view ]  
Title: Re: Colorful Triangle Geometry
Post by: johnno56 on May 04, 2021, 08:10:15 am
I was all set to ask, "Does it come in blue?".... Never mind.... Bonus: I like it...
Title: Re: Colorful Triangle Geometry
Post by: _vince on May 05, 2021, 01:45:12 am
nice use of recursion, reminds me of

Code: QB64: [Select]
  4. pi = 4*atn(1)
  5. c = 2*sqr(3)/9
  6. cc = sqr(12) / 6
  7.  
  8. sw = 1024
  9. sh = 768
  10.  
  11. screen _newimage(sw, sh, 12)
  12. tri sw/2, sh/2, 600, 0
  13. tri sw/2, sh/2, 600, pi
  14. kock sw/2, sh/2, 600, 3
  17.  
  18. sub kock(x, y, s, i)
  19.         if i = 0 then exit sub
  20.         for a = pi/6 to 2*pi + pi/6 step pi/3
  21.                 xx = s*c*cos(a) + x
  22.                 yy = s*c*sin(a) + y
  23.        
  24.                 tri xx, yy, s/3, a+pi/6
  25.                 tri xx, yy, s/3, a+pi/6+pi
  26.  
  27.                 kock xx, yy, s/3, i - 1
  28.         next
  30.  
  31. sub tri(x, y, s, a)
  32.         line (x,y)-(x+s*cc*cos(pi/6 + a),y+s*cc*sin(pi/6 + a)),8
  33.         line (x,y)-(x+s*cc*cos(5*pi/6 + a),y+s*cc*sin(5*pi/6 + a)),8
  34.         line (x,y)-(x-s*cc*cos(pi/2 + a),y-s*cc*sin(pi/2 + a)),8
  35.  
  36.         line (x+s*cc*cos(pi/6 + a),y+s*cc*sin(pi/6 + a))-(x+s*cc*cos(5*pi/6 + a),y+s*cc*sin(5*pi/6 + a))
  37.         line-(x-s*cc*cos(pi/2 + a),y-s*cc*sin(pi/2 + a))
  38.         line-(x+s*cc*cos(pi/6 + a),y+s*cc*sin(pi/6 + a))
  40.  
Title: Re: Colorful Triangle Geometry
Post by: Ashish on May 05, 2021, 02:22:35 am
Thank you Johnno and Vince!
I like that program Vince!, Thanks for sharing
Title: Re: Colorful Triangle Geometry
Post by: TempodiBasic on May 07, 2021, 01:34:16 pm
@Ashish
cool ! speedy maptriangles colors.
I find it very good.
Just a feedback....
 it sometimes uses color very near in the spectrum of visible and my old eyes cannot distinguish them
 like in this screenshot
  [ This attachment cannot be displayed inline in 'Print Page' view ]  
Title: Re: Colorful Triangle Geometry
Post by: TempodiBasic on May 07, 2021, 01:39:10 pm
@vince
hey man with your math geometry I'm loosing my mind in its different prospectives
se here
  [ This attachment cannot be displayed inline in 'Print Page' view ]  

... I'm thinking how it can appear if it uses  many colors
Title: Re: Colorful Triangle Geometry
Post by: Ashish on May 09, 2021, 01:13:55 am
@TempodiBasic
Thanks! I have updated the code now... I hope it works fine for you now
Title: Re: Colorful Triangle Geometry
Post by: Ashish on May 09, 2021, 01:17:24 am
Here's a little modification I made to this -

Code: QB64: [Select]
  1. 'Coded By Ashish
  2. '4 may, 2021
  3. 'edited : 9 may,2021
  4. _Title "Triangular Geometry"
  5. Screen _NewImage(800, 600, 32)
  7. '404 pattern 400, 0, 0, 600, 800, 600, 600, Int(Rnd * 255), 50 + Int(Rnd * 205)
  8. Dim vx(2), vy(2)
  9. Dim ox, oy, r, start_ang, h, clr_start, clr_width
  11.     'creating new set of vertices of equilateral triangle
  12.     ox = Int(Rnd * 800): oy = Int(Rnd * 600)
  13.     r = 50 + Int(Rnd * 200)
  14.     start_ang = Rnd * _Pi(2)
  15.     n = 0
  16.     'Print start_ang, start_ang + _Pi(2)
  17.     For i = start_ang To start_ang + _Pi(2) Step _Pi(0.67)
  18.         'Print i
  19.         vx(n) = ox + r * Cos(i): vy(n) = oy + r * Sin(i)
  20.         n = n + 1
  21.     Next
  22.     h = r * 1.5
  23.     'color settings
  24.     clr_start = Int(Rnd * 255): clr_width = 50 + Int(Rnd * 255)
  25.     pattern vx(0), vy(0), vx(1), vy(1), vx(2), vy(2), h, clr_start, clr_width
  26.     _Display
  27.     _Limit 10
  29. '_Display
  30. '_Delay 0.25
  31. 'GoTo 404
  32. Sub pattern (x0, y0, x1, y1, x2, y2, d_max, s_min, s_width)
  33.     mx = (x1 + x2) / 2: my = (y1 + y2) / 2
  34.     d = Int(Sqr((mx - x0) ^ 2 + (my - y0) ^ 2))
  35.     drawTriangleSolid x0, y0, x1, y1, x2, y2, hsb(map(d, 10, d_max, s_min, (s_max + s_width) Mod 255), 255, 128, map(d, 10, d_max, 50, 255))
  36.     If d > 10 Then
  37.         If d >= d_max Then
  38.             pattern mx, my, x0, y0, x1, y1, d_max, s_min, s_width
  39.             pattern mx, my, x0, y0, x2, y2, d_max, s_min, s_width
  40.  
  41.         Else
  42.             If Rnd > 0.5 Then pattern mx, my, x0, y0, x1, y1, d_max, s_min, s_width Else pattern mx, my, x0, y0, x2, y2, d_max, s_min, s_width
  43.         End If
  44.     End If
  46.  
  47. Sub drawTriangleSolid (x1, y1, x2, y2, x3, y3, c~&)
  48.     Static temp_color_img As Long, drawTriangle_init As _Byte
  49.     If drawTriangle_init = 0 Then
  50.         temp_color_img = _NewImage(1, 1, 32)
  51.         drawTriangle_init = 1
  52.     End If
  53.     preDest = _Dest
  54.     _Dest temp_color_img
  55.     PSet (0, 0), c~&
  56.     _Dest preDest
  57.  
  58.     _MapTriangle (0, 0)-(0, 0)-(0, 0), temp_color_img To(x1, y1)-(x2, y2)-(x3, y3), 0, _Smooth
  59.  
  61.  
  62. Sub drawTriangle (x1, y1, x2, y2, x3, y3, c~&)
  63.     Line (x1, y1)-(x2, y2), c~&
  64.     Line (x2, y2)-(x3, y3), c~&
  65.     Line (x3, y3)-(x1, y1), c~&
  67.  
  68. 'method adapted form http://stackoverflow.com/questions/4106363/converting-rgb-to-hsb-colors
  69. Function hsb~& (__H As _Float, __S As _Float, __B As _Float, A As _Float)
  70.     Dim H As _Float, S As _Float, B As _Float
  71.  
  72.     H = map(__H, 0, 255, 0, 360)
  73.     S = map(__S, 0, 255, 0, 1)
  74.     B = map(__B, 0, 255, 0, 1)
  75.  
  76.     If S = 0 Then
  77.         hsb~& = _RGBA32(B * 255, B * 255, B * 255, A)
  78.         Exit Function
  79.     End If
  80.  
  81.     Dim fmx As _Float, fmn As _Float
  82.     Dim fmd As _Float, iSextant As Integer
  83.     Dim imx As Integer, imd As Integer, imn As Integer
  84.  
  85.     If B > .5 Then
  86.         fmx = B - (B * S) + S
  87.         fmn = B + (B * S) - S
  88.     Else
  89.         fmx = B + (B * S)
  90.         fmn = B - (B * S)
  91.     End If
  92.  
  93.     iSextant = Int(H / 60)
  94.  
  95.     If H >= 300 Then
  96.         H = H - 360
  97.     End If
  98.  
  99.     H = H / 60
  100.     H = H - (2 * Int(((iSextant + 1) Mod 6) / 2))
  101.  
  102.     If iSextant Mod 2 = 0 Then
  103.         fmd = (H * (fmx - fmn)) + fmn
  104.     Else
  105.         fmd = fmn - (H * (fmx - fmn))
  106.     End If
  107.  
  108.     imx = _Round(fmx * 255)
  109.     imd = _Round(fmd * 255)
  110.     imn = _Round(fmn * 255)
  111.  
  112.     Select Case Int(iSextant)
  113.         Case 1
  114.             hsb~& = _RGBA32(imd, imx, imn, A)
  115.         Case 2
  116.             hsb~& = _RGBA32(imn, imx, imd, A)
  117.         Case 3
  118.             hsb~& = _RGBA32(imn, imd, imx, A)
  119.         Case 4
  120.             hsb~& = _RGBA32(imd, imn, imx, A)
  121.         Case 5
  122.             hsb~& = _RGBA32(imx, imn, imd, A)
  123.         Case Else
  124.             hsb~& = _RGBA32(imx, imd, imn, A)
  125.     End Select
  126.  
  128.  
  129.  
  130. 'from p5js.bas
  131. Function map! (value!, minRange!, maxRange!, newMinRange!, newMaxRange!)
  132.     map! = ((value! - minRange!) / (maxRange! - minRange!)) * (newMaxRange! - newMinRange!) + newMinRange!
  134.  
  135.  
Title: Re: Colorful Triangle Geometry
Post by: TempodiBasic on May 09, 2021, 11:54:27 am
@Ashish
very funny!
It works well.
Title: Re: Colorful Triangle Geometry
Post by: bplus on May 11, 2021, 12:49:19 am
Well @Ashish color and recursive subs, you know I had to join the fun!

Here is my rendition:
Code: QB64: [Select]
  1. _Title "Recursively Divide a Triangle into 2" 'b+ 2021-05-11
  2. ' inspired by Ashish post here:  https://www.qb64.org/forum/index.php?topic=3867.msg132129#msg132129
  3. ' Find the longest side middle point and draw line from that to angle point opposite that side.
  4. ' Then pass the 2 new tri's back to recursive sub until the longest side < 20, not 10
  5. ' See what happens... Ok way way to boring we need random filling and color!
  7. Screen _NewImage(1200, 600, 32)
  8. _Delay .25
  11.     Cls
  12.     DivideTriTo2 600, 0, 0, 600, 1200, 600
  13.     _Delay 2
  15.  
  16. Sub DivideTriTo2 (x1, y1, x2, y2, x3, y3)
  17.     s1 = _Hypot(x1 - x2, y1 - y2)
  18.     s2 = _Hypot(x3 - x2, y3 - y2)
  19.     s3 = _Hypot(x1 - x3, y1 - y3)
  20.     ftri x1, y1, x2, y2, x3, y3, _RGB32(Rnd * 255, Rnd * 255, Rnd * 255, Rnd * 255)
  21.     _Delay .002
  22.     If s1 >= s2 And s1 >= s3 And s1 > 20 Then
  23.         ptx = x3: pty = y3
  24.         mx = (x1 + x2) / 2: my = (y1 + y2) / 2
  25.         If Rnd < .75 Then DivideTriTo2 mx, my, ptx, pty, x1, y1
  26.         If Rnd < .75 Then DivideTriTo2 mx, my, ptx, pty, x2, y2
  27.     ElseIf s2 >= s1 And s2 >= s3 And s2 > 20 Then
  28.         ptx = x1: pty = y1
  29.         mx = (x3 + x2) / 2: my = (y3 + y2) / 2
  30.         If Rnd < .75 Then DivideTriTo2 mx, my, ptx, pty, x2, y2
  31.         If Rnd < .75 Then DivideTriTo2 mx, my, ptx, pty, x3, y3
  32.     ElseIf s3 >= s1 And s3 >= s2 And s3 > 20 Then
  33.         ptx = x2: pty = y2
  34.         mx = (x1 + x3) / 2: my = (y1 + y3) / 2
  35.         If Rnd < .75 Then DivideTriTo2 mx, my, ptx, pty, x1, y1
  36.         If Rnd < .75 Then DivideTriTo2 mx, my, ptx, pty, x3, y3
  37.     End If
  39.  
  40. '2019-12-16 fix by Steve saves some time with STATIC and saves and restores last dest
  41. Sub ftri (x1, y1, x2, y2, x3, y3, K As _Unsigned Long)
  42.     Dim D As Long
  43.     Static a&
  44.     D = _Dest
  45.     If a& = 0 Then a& = _NewImage(1, 1, 32)
  46.     _Dest a&
  47.     _DontBlend a& '  '<<<< new 2019-12-16 fix
  48.     PSet (0, 0), K
  49.     _Blend a& '<<<< new 2019-12-16 fix
  50.     _Dest D
  51.     _MapTriangle _Seamless(0, 0)-(0, 0)-(0, 0), a& To(x1, y1)-(x2, y2)-(x3, y3)
  53.  

  [ This attachment cannot be displayed inline in 'Print Page' view ]  
Text Only | Text with Attachments