Ooops
November 28, 2020, 10:58:38 AM

Author Topic: [bb] DLA seaweed by Andy_A [ 8 months ago ]  (Read 603 times)

Offline BlitzBot

  • Jr. Member
  • **
  • Posts: 1
[bb] DLA seaweed by Andy_A [ 8 months ago ]
« on: June 29, 2017, 12:28:38 AM »
Title : DLA seaweed
Author : Andy_A
Posted : 8 months ago

Description : Make your own cartoonish seaweed

Code :
Code: BlitzBasic
  1. ;http://psoup.math.wisc.edu/archive/alex_day.txt
  2.  
  3. sw% = 1152 : sh% = 720
  4.  
  5.  
  6. AppTitle "Diffusion Limited Aggregation"
  7. Graphics sw, sh, 32, 2
  8. SetBuffer BackBuffer()
  9. SeedRnd MilliSecs()
  10.  
  11. Const white% = $FFFFFF
  12.  
  13. w% = 192: h% = 120 : m% = 24
  14. multiplier% = 6
  15.  
  16. Dim hxc%(23), nc%(23,2)
  17.  
  18. palette
  19.  
  20. style% = 1
  21. exitFlag% = 0
  22. While exitFlag = 0
  23.         Dim s(w+1, h+1)
  24.         d = 1
  25.         Cls
  26.         While d <= h
  27.                 x = Rand(1,w-1)
  28.                 y = d
  29.                 c = 0
  30.                 While y <> 0 And c = 0
  31.                         c = s(x, y - 1)
  32.                         If c = 0 Then c = s(x - 1, y - 1)
  33.                         If c = 0 Then c = s(x + 1, y - 1)
  34.                         If Rand(0,1) = 1 And s(x + 1, y - 1) <> 0 Then c = s(x + 1, y - 1)
  35.                         If c = 0 Then y = y - 1
  36.                 Wend
  37.                 If KeyHit(1) Then End
  38.                 If c = 0 Then c = (x Mod m)
  39.                 s(x, y) = c
  40.                 If y = d - 1 Then d = d + 1
  41.         Wend
  42.         deltaClr# = 111.0/Float(sh)
  43.         bGrad# = 112.0
  44.         For i = 0 To sh-1
  45.                 Color 0,Int(bGrad*0.7), Int(bGrad)
  46.                 Line(0, i, sw-1, i)
  47.                 bGrad = bGrad - deltaClr
  48.         Next
  49.         For j = 0 To h-1
  50.                 jm% = sh-j*multiplier
  51.                 For i = 0 To w-1
  52.                         c = s(i,j)
  53.                         im% = i*multiplier
  54.                         If c <> 0 Then
  55.                                 Select style
  56.                                         Case 1
  57.                                                 radius% = Rand(4,7)
  58.                                                 ink(0): cfill(im, jm, radius + 2)
  59.                                                 Color nc(c,0), nc(c,1), nc(c,2)
  60.                                                 cfill(im, jm, radius)
  61.                                                 ink(white): cfill(im-2, jm-2, 2)
  62.                                         Case 2
  63.                                                 radius% = Rand(6,9)
  64.                                                 xr = im-radius
  65.                                                 yr = jm-radius
  66.                                                 r2 = radius+radius
  67.                                                 ink(0): Rect xr,yr,r2,r2,True
  68.                                                 Color nc(c,0), nc(c,1), nc(c,2)
  69.                                                 Rect xr+2,yr+2,r2-4,r2-4,True
  70.                                                 ink(white)
  71.                                                 Rect xr+4,yr+4,3,3,True
  72.                                         Case 3
  73.                                                 makeTris(im, jm, hxc(c))
  74.                                 End Select
  75.                         End If
  76.                 Next
  77.         Next
  78.         box(380, 2, 90, 20, $90, $FFFFFF)
  79.         box(480, 2, 90, 20, $90, $FFFFFF)
  80.         box(580, 2, 90, 20, $90, $FFFFFF)
  81.         box(680, 2, 90, 20, $FF0000, $FFFFFF)
  82.         ink($FFFFFF)
  83.         Text 425,6, "Circles",True
  84.         Text 525,6, "Squares",True
  85.         Text 625,6, "Triangles",True
  86.         Text 725,6, "EXIT",True
  87.         Flip
  88.        
  89.         While mouseExit = 0
  90.                 WaitMouse()
  91.                 mx = MouseX() : my = MouseY()
  92.                 If pnr(mx, my, 680, 2, 90, 20) Then
  93.                         mouseExit = 1
  94.                         exitFlag = 1
  95.                 End If
  96.                 If pnr(mx, my, 380, 2, 90, 20) Then style = 1: mouseExit = 1
  97.                 If pnr(mx, my, 480, 2, 90, 20) Then style = 2: mouseExit = 1
  98.                 If pnr(mx, my, 580, 2, 90, 20) Then style = 3: mouseExit = 1
  99.                 FlushMouse()
  100.         Wend
  101.         mouseExit = 0
  102. Wend
  103. End
  104.  
  105. Function ink%(hexVal%)
  106.         Local red%, grn%, blu%
  107.         red = (hexVal Shr 16) And 255
  108.         grn = (hexVal Shr 8 ) And 255
  109.         blu = hexVal And 255
  110.         Color red, grn, blu
  111. End Function
  112.  
  113. Function cfill%(x%, y%, r%)
  114.         Oval x-r, y-r, r + r, r + r,True
  115. End Function
  116.  
  117. Function box%(x%, y%, w%, h%, clr1%, clr2%)
  118.         ;main box color is clr1 (hex value)
  119.         ;box outline color is clr2 (hex value)
  120.         ink(clr2)
  121.         Rect x, y, w, h,True
  122.         ink(clr1)
  123.         Rect x+2,y+2,w-4,h-4,True
  124. End Function
  125.  
  126. Function pnr(px, py, rx, ry, rw, rh)
  127.         ;===========================================
  128.         ;   Function "Point In Rectangle"
  129.         ;===========================================
  130.         ; This function checks to see if the point
  131.         ; (px,py) is within the specified rectangle.
  132.         ;
  133.         ; If the point is inside the rectangle
  134.         ; a value of 1 is returned.
  135.         ;
  136.         ; If the point is not inside the rectangle
  137.         ; a value of 0 is returned.
  138.         ;============================================
  139.         ; px = the X coord of the point in question
  140.         ; py = the Y coord of the point in question
  141.         ; rx = Upper  Left X coord of rectangle
  142.         ; ry = Upper  Left Y coord of rectangle
  143.         ; rw =  width of rectangle
  144.         ; rh = height of rectangle
  145.         ;=============================================
  146.     Return ((px>=rx) And (px<=(rx+rw-1)) And (py>=ry) And (py<=(ry+rh-1)))
  147. End Function
  148.  
  149. Function palette()
  150.         Local i%
  151.         hxc(0)=$0000FF: hxc(1)=$4000FF
  152.         hxc(2)=$8000FF: hxc(3)=$C000FF            
  153.         hxc(4)=$FF00FF: hxc(5)=$FF00C0
  154.         hxc(6)=$FF0080: hxc(7)=$FF0040
  155.         hxc(8)=$FF0000: hxc(9)=$FF4000
  156.         hxc(10)=$FF8000: hxc(11)=$FFC000
  157.         hxc(12)=$FFFF00: hxc(13)=$C0FF00
  158.         hxc(14)=$80FF00: hxc(15)=$40FF00
  159.         hxc(16)=$00FF00: hxc(17)=$00FF40
  160.         hxc(18)=$00FF80: hxc(19)=$00FFC0
  161.         hxc(20)=$00FFFF: hxc(21)=$00C0FF
  162.         hxc(22)=$0080FF: hxc(23)=$0040FF
  163.         For i = 0 To 23
  164.                 nc(i,0) = (hxc(i) Shr 16) And 255
  165.                 nc(i,1) = (hxc(i) Shr  8) And 255
  166.                 nc(i,2) = hxc(i) And 255
  167.         Next
  168. End Function
  169.  
  170. Function makeTris(cx%, cy%, hexClr%)
  171.         Local a1%,a2%,a3%,mag1%,mag2%,mag3%,maga%,magb%,magc%
  172.         Local x1%,y1%,x2%,y2%,x3%,y3%,xa%,ya%,xb%,yb%,xc%,yc%
  173.     a1 = Rand(24,94)
  174.     a2 = Rand(134,224)
  175.     a3 = Rand(244,344)
  176.     mag1 = Rand(8,14)
  177.     mag2 = Rand(8,14)
  178.     mag3 = Rand(8,14)
  179.         maga = mag1-1
  180.         magb = mag2-1
  181.         magc = mag3-1
  182.     x1 = Cos(a1)*mag1+cx
  183.     y1 = Sin(a1)*mag1+cy
  184.     x2 = Cos(a2)*mag2+cx
  185.     y2 = Sin(a2)*mag2+cy
  186.     x3 = Cos(a3)*mag3+cx
  187.     y3 = Sin(a3)*mag3+cy
  188.     xa = Cos(a1)*maga+cx
  189.     ya = Sin(a1)*maga+cy
  190.     xb = Cos(a2)*magb+cx
  191.     yb = Sin(a2)*magb+cy
  192.     xc = Cos(a3)*magc+cx
  193.     yc = Sin(a3)*magc+cy
  194.         Ink(hexClr)
  195.     triFill(x1, y1, x2, y2, x3, y3)
  196.         Color 0,0,0
  197.         Line(x1,y1, x2,y2)
  198.         Line(x3,y3, x1,y1)
  199.         Line(xa,ya, xb,yb)
  200.         Line(xc,yc, xa,ya)
  201.         Color 255,255,255
  202.         Line(x2,y2, x3,y3)
  203.         Line(xb,yb, xc,yc)
  204. End Function
  205.  
  206.  
  207. Function triFill%(x1#,y1#,x2#,y2#,x3#,y3#)
  208.         Local slope1#,slope2#,slope3#,x#,y#,length#
  209.         If x2 < x1
  210.                 x = x2: y = y2: x2 = x1: y2 = y1: x1 = x: y1 = y
  211.         End If
  212.         If x3 < x1
  213.                 x = x3: y = y3: x3 = x1: y3 = y1: x1 = x: y1 = y
  214.         End If
  215.         If x3 < x2
  216.                 x = x3: y = y3: x3 = x2: y3 = y2: x2 = x: y2 = y
  217.         End If
  218.         If x1 <> x3 Then slope1 = (y3-y1)/(x3-x1)
  219.                 length = x2 - x1
  220.                 If length <> 0
  221.                         slope2 = (y2-y1)/(x2-x1)
  222.                         For x = 0 To length
  223.                                 Line x+x1,x*slope1+y1,x+x1,x*slope2+y1
  224.                         Next
  225.         End If
  226.         y = length*slope1+y1
  227.         length = x3-x2
  228.         If length <> 0
  229.                 slope3 = (y3-y2)/(x3-x2)
  230.                 For x = 0 To length
  231.                         Line x+x2,x*slope1+y,x+x2,x*slope3+y2
  232.                 Next
  233.         End If
  234. End Function


Comments :


RustyKristi(Posted 8 months ago)

 Awesome! can it take form of a shape or boundary like a box or rectangle?


Andy_A(Posted 8 months ago)

 If you mean resize to a particular rectangle then, yes.The actual plot is only 192x120 pixels and is then scaled. So I believe if you change the 'w' and 'h' variables you should be able to make if fit nearly any square or rectangle.If you mean to grow from all four sides, then it would take some doing, but should be possible.


RustyKristi(Posted 8 months ago)

 <div class="quote"> If you mean resize to a particular rectangle then, yes.The actual plot is only 192x120 pixels and is then scaled. So I believe if you change the 'w' and 'h' variables you should be able to make if fit nearly any square or rectangle. </div>Yes, that's the one. thanks!


Flanker(Posted 8 months ago)

 Nice looking for 2d games background !


Andy_A(Posted 8 months ago)

 Thanks!Just needs some fish ...


 

SimplePortal 2.3.6 © 2008-2014, SimplePortal