Ooops
November 28, 2020, 01:23:24 PM

Author Topic: [bb] Burning Ship Fractal by markcw [ 1+ years ago ]  (Read 751 times)

Offline BlitzBot

  • Jr. Member
  • **
  • Posts: 1
[bb] Burning Ship Fractal by markcw [ 1+ years ago ]
« on: June 29, 2017, 12:28:43 AM »
Title : Burning Ship Fractal
Author : markcw
Posted : 1+ years ago

Description : I am bored writing my game so i thought i'd have some fun with fractals! :)

edit: just tidied up the code a bit, the rectangle tool had a small error and changed it so you can set the number of colours in the palette.


Code :
Code: BlitzBasic
  1. ;Burning Ship Fractal, on 12/2/06
  2. ;Translated from source code, by Paul Bourke
  3. ;Adapted from Mandelbrot Fractal code, by filax & fredborg
  4.  
  5. ;do: Init
  6.  
  7. window=2 ;window mode
  8. resmode=0 ;resolution
  9.  
  10. If resmode=0
  11.  width=640
  12.  height=480
  13. Else
  14.  width=800
  15.  height=600
  16. EndIf
  17.  
  18. AppTitle "Burning Ship Fractal"
  19. Graphics width,height,16,window
  20. SetBuffer BackBuffer()
  21.  
  22. ;do: Set Palette
  23.  
  24. cmax = 256
  25. Dim col(cmax)
  26.  
  27. DrawGradientLine(cmax-1,0,230,230,0,0,0) ;colour
  28. ;DrawGradientLine(cmax-1,230,230,230,0,0,0) ;grey
  29.  
  30. LockBuffer
  31. For i=0 To cmax-1
  32.  col(i)=ReadPixelFast(i,1) * 8 And $FFFFFF ;colour
  33.  ;col(i)=ReadPixelFast(i,1) And $FFFFFF ;grey
  34. Next
  35. UnlockBuffer
  36.  
  37. ;do: Draw Fractal
  38.  
  39. .reset
  40. dcx# = 0.43
  41. dcy# = 0.43
  42. dx# = 3.25
  43. dy# = -dx
  44.  
  45. .redraw
  46. Cls
  47.  
  48. For y=0 To height-1
  49.  LockBuffer
  50.  cy# = dcy + (y - height/2) * dy / Float(height)
  51.  For x=0 To width-1
  52.   cx# = dcx + (x - width/2) * dx / Float(width)
  53.   xi# = 0
  54.   yi# = 0
  55.   For c=0 To cmax-1
  56.    xip1# = xi*xi - yi*yi - cx  ;x(n+1) = x(n)^2 - y(n)^2 - c(x)
  57.    yip1# = 2 * Abs(xi*yi) - cy ;y(n+1) = 2 | x(n) y(n) | - c(y)
  58.    xi# = xip1
  59.    yi# = yip1
  60.    If xi*xi + yi*yi > 200 Then Exit
  61.   Next
  62.   value# = Sqr(c / Float(cmax))
  63.   colour = value * cmax-1
  64.   WritePixelFast x,y,col(colour)
  65.   If KeyDown(1) Then End ;Esc key
  66.  Next
  67.  UnlockBuffer
  68.  If window<2 Then Flip ;two flips in fullscreen, slower
  69.  Flip
  70. Next
  71.  
  72. image=CreateImage(width,height)
  73. CopyRect 0,0,width,height,0,0,BackBuffer(),ImageBuffer(image)
  74. SetBuffer BackBuffer()
  75.  
  76. ;do: Main Loop
  77.  
  78. While Not KeyDown(1)
  79.  Cls ;clear rect in fullscreen
  80.  DrawImage image,0,0
  81.  Color 255,255,255
  82.  Plot MouseX(),MouseY() ;show mouse x/y in fullscreen
  83.  Text 0,0,MouseX()+"-"+MouseY()
  84.  
  85.  If mousepress=0
  86.  
  87.   If MouseDown(1)
  88.    mousepress=1
  89.    sx=MouseX() ;start rect x/y
  90.    sy=MouseY()
  91.   EndIf
  92.  
  93.   If MouseDown(2)
  94.    Cls ;clear in fullscreen
  95.    Flip
  96.    mousepress=0
  97.    Goto reset
  98.   EndIf
  99.  
  100.  Else
  101.  
  102.   If MouseDown(1)
  103.  
  104.    ;do: Draw Rect
  105.  
  106.    ex=MouseX() ;end rect x/y
  107.    ey=MouseY()
  108.    mx=MouseX() ;set mouse x/y
  109.    my=MouseY()
  110.  
  111.    If sx>mx And sy>my ;upleft, recalculate true screen rect
  112.     If sx-mx>sy-my
  113.      ey=sy-(sx-mx)*3/4 ;x>
  114.     Else
  115.      ex=sx-(sy-my)*4/3 ;y>
  116.     EndIf
  117.    EndIf
  118.    If sx<=mx And sy>my ;upright
  119.     If mx-sx>sy-my ;x>
  120.      ey=sy+(sx-mx)*3/4
  121.     Else
  122.      ex=sx+(sy-my)*4/3 ;y>
  123.     EndIf
  124.    EndIf
  125.    If sx>mx And sy<=my ;downleft
  126.     If sx-mx>my-sy
  127.      ey=sy+(sx-mx)*3/4 ;x>
  128.     Else
  129.      ex=sx+(sy-my)*4/3 ;y>
  130.     EndIf
  131.    EndIf
  132.    If sx<=mx And sy<=my ;downright
  133.     If mx-sx>my-sy
  134.      ey=sy-(sx-mx)*3/4 ;x>
  135.     Else
  136.      ex=sx-(sy-my)*4/3 ;y>
  137.     EndIf
  138.    EndIf
  139.  
  140.    startx=sx
  141.    starty=sy
  142.    endx=Abs(ex-sx) ;set rect width/height
  143.    endy=Abs(ey-sy)
  144.    If ex<sx Then startx=ex ;set inverse rect x/y
  145.    If ey<sy Then starty=ey
  146.  
  147.    Rect startx,starty,endx,endy,False
  148.  
  149.   Else
  150.  
  151.    ;do: New Fractal
  152.    mousepress=0
  153.  
  154.    If Abs(sx-ex)>4 And Abs(sy-ey)>3 ;set minimum selection area
  155.     newdx# = dx * Float(endx) / Float(width)
  156.     newdy# = dy * Float(endy) / Float(height)
  157.     newdcx# = dcx + (startx + endx/2 - width/2) * dx / Float(width)
  158.     newdcy# = dcy + (starty + endy/2 - height/2) * dy / Float(height)
  159.     dx# = newdx
  160.     dy# = newdy
  161.     dcx# = newdcx
  162.     dcy# = newdcy
  163.     Cls ;clear in fullscreen
  164.     Flip
  165.     Goto redraw
  166.    EndIf
  167.  
  168.   EndIf
  169.  
  170.  EndIf
  171.  
  172.  Flip
  173. Wend
  174. End
  175.  
  176. ;do: Functions
  177.  
  178. Function DrawGradientLine(Nclr,Sred#,Sgreen#,Sblue#,Ered#,Egreen#,Eblue#)
  179.  
  180. Gred#=Ered-Sred/Nclr
  181. Ggreen#=Egreen-Sgreen/Nclr
  182. Gblue#=Eblue-Sblue/Nclr
  183.  
  184. For g=0 To Nclr
  185.  Color Sred,Sgreen,Sblue
  186.  Line g,0,g,5
  187.  Sred#=Sred+Gred
  188.  Sgreen#=Sgreen+Ggreen
  189.  Sblue#=Sblue+Gblue
  190. Next
  191.  
  192. End Function


Comments :


chwaga(Posted 1+ years ago)

 fractals are so cool...my dum brain can't grasp them tho


Santiworld(Posted 1+ years ago)

 very nice!...maibe can work like a good tool to make scenarys, no?


 

SimplePortal 2.3.6 © 2008-2014, SimplePortal