PureBasic Forums - English

Posted: **Fri Jul 25, 2014 9:15 am**

Hi all,

just for fun, here is a small program that generates a Koch Snowflake. This is one of the earliest fractal curves which have been described.
The program also allows for "negative iterations" which means that the smaller triangles are drawn on the inside of the bigger ones rather than on the outside. ( For iterations = -1, you might be reminded of a certain make of car.

)

Download (Windows 32 bit EXE, 194 KB)

Posted: **Fri Jul 25, 2014 12:05 pm**

@Little John,

Very nice. The negative iterations are a nice touch.

Thank you.

Posted: **Fri Jul 25, 2014 3:00 pm**

Thank you, davido.

Posted: **Sat Sep 27, 2014 9:46 am**

Great program Little John
do we can see source code if is not a problem.
thanks

Posted: **Sun Sep 28, 2014 1:32 pm**

Hi aston,

you are welcome!

Here is a short code that contains the core parts of the program.
Is this sufficient?

//edit 2014-10-05:

Fixed: SpinGadget events were not handled correctly on Linux.
Made some cosmetic changes.

Code: Select all

; Jürgen Lüthje, 2014-10-05
; tested with
; - PB 5.23 LTS (x64) and PB 5.31 beta 1 (x64) on Windows 7
; - PB 5.31 beta 1 (x64) on Linux Mint 17 Cinnamon

EnableExplicit

CompilerIf #PB_Compiler_OS = #PB_OS_Windows
   #DefaultDPIx = 96.0     ; default DPI on Windows
   #DefaultDPIy = 96.0
   
   Global g_ScaleDPIx.f = 1.0
   Global g_ScaleDPIy.f = 1.0
   
   Procedure _InitScaleDPI()
      ; Windows 5.0 or higher needed for minimum functionality of this procedure
      ; [simplified after <http://www.purebasic.fr/english/viewtopic.php?f=12&t=40507>, 2010-01-02
      ;  see also <http://msdn.microsoft.com/en-us/library/windows/desktop/dd464660%28v=vs.85%29.aspx>]
      Protected *IsProcessDPIAware, *SetProcessDPIAware
      Protected dll.i, dc.i, lpx.i, lpy.i, dpiaware.i=#False
      
      ; Only use this in EXEs, as DLLs inherit DPI from the calling process.
      CompilerIf #PB_Compiler_ExecutableFormat = #PB_Compiler_Executable
         dll = OpenLibrary(#PB_Any, "user32.dll")
         If dll
            *IsProcessDPIAware = GetFunction(dll, "IsProcessDPIAware")
            If *IsProcessDPIAware
               dpiaware = CallFunctionFast(*IsProcessDPIAware)
            EndIf
            If Not dpiaware
               *SetProcessDPIAware = GetFunction(dll, "SetProcessDPIAware")
               If *SetProcessDPIAware
                  CallFunctionFast(*SetProcessDPIAware)
               EndIf
            EndIf
            CloseLibrary(dll)
         EndIf
      CompilerEndIf
      
      dc = GetDC_(#Null)
      If dc
         lpx = GetDeviceCaps_(dc, #LOGPIXELSX)
         lpy = GetDeviceCaps_(dc, #LOGPIXELSY)
         If lpx > 0
            g_ScaleDPIx = lpx/#DefaultDPIx
         EndIf
         If lpy > 0
            g_ScaleDPIy = lpy/#DefaultDPIy
         EndIf
         ReleaseDC_(#Null, dc)
      EndIf
   EndProcedure
   
   _InitScaleDPI()
   
CompilerElse
   #Black = $000000
   #White = $FFFFFF
   
   Global g_ScaleDPIx.f = 1.25   ; adjust this value to your system
   Global g_ScaleDPIy.f = 1.25   ; adjust this value to your system
CompilerEndIf   


Macro DPIx (_x_)
   (_x_) * g_ScaleDPIx
EndMacro
Macro DPIy (_y_)
   (_y_) * g_ScaleDPIy
EndMacro


; -- Text
#ProgVersion$ = "Koch Snowflake 1.01 light"
#GuiTextIterations$ = "Iterations" + #LF$ + "(-5 to +5):"

Enumeration Windows
   #winMain
EndEnumeration

Enumeration Gadgets
   #gdgKoch
   #spnText
   #spnCtrl
EndEnumeration

Enumeration Images
   #imgKoch
EndEnumeration

#Min_Iterations = -5
#Max_Iterations =  5

;----------------
#Win_Width  = 300                ; change this value if desired
#Win_Height = 380                ; change this value if desired
;----------------

#Image_Size   = #Win_Width - 20
#FlakeSideLen = 0.8*#Image_Size - 20
#FlakeBase_X  = (#Image_Size - #FlakeSideLen) / 2.0
#FlakeBase_Y  = #Image_Size/2.0 + #FlakeSideLen * 0.8660254/3.0   ; 0.8660254 = Sin(Radian(60.0))
#SpinText_X   = 10
#SpinText_Y   = #Win_Height - 75
#SpinCtrl_X   = #SpinText_X + 60
#SpinCtrl_Y   = #Win_Height - 70


Macro Polar2Rect_X (_distance_, _angle_)
   ; -- convert polar coordinates to rectangular coordinates
   ; in : _distance_: must be >= 0
   ;      _angle_   : expressed in rad
   ;                  (positive means counter-clockwise)
   ; out: corresponding x coordinate
   
   ((_distance_) * Cos(_angle_))
EndMacro

Macro Polar2Rect_Y (_distance_, _angle_)
   ; -- convert polar coordinates to rectangular coordinates
   ; in : _distance_: must be >= 0
   ;      _angle_   : expressed in rad
   ;                  (positive means counter-clockwise)
   ; out: corresponding y coordinate
   
   (-(_distance_) * Sin(_angle_))
EndMacro


Procedure DrawCurve (img.i, x1.d, y1.d, angle1.d, sideLength.d, iterations.i)
   ; -- draw *one* Koch curve
   ; in: img       : number of image to draw on
   ;     {x1,y1}   : starting point of current section
   ;     angle1    : angle (in rad) between positive x-axis and current section
   ;                 (positive means counter-clockwise)
   ;     sideLength: length of current section
   ;     iterations: number of sections = 4^iterations
   ;                 (0 iterations means straight line)
   Protected.d x2, y2, angle2, x3, y3, angle3, x4, y4
   
   If iterations > 0
      sideLength / 3.0
      iterations - 1
      
      ; first section
      DrawCurve(img, x1, y1, angle1, sideLength, iterations)
      
      ; second section
      x2 = x1 + Polar2Rect_X(sideLength, angle1)
      y2 = y1 + Polar2Rect_Y(sideLength, angle1)
      angle2 = angle1 - #PI/3.0
      DrawCurve(img, x2, y2, angle2, sideLength, iterations)
      
      ; third section
      x3 = x2 + Polar2Rect_X(sideLength, angle2)
      y3 = y2 + Polar2Rect_Y(sideLength, angle2)
      angle3 = angle1 + #PI/3.0
      DrawCurve(img, x3, y3, angle3, sideLength, iterations)
      
      ; fourth section
      x4 = x3 + Polar2Rect_X(sideLength, angle3)
      y4 = y3 + Polar2Rect_Y(sideLength, angle3)
      DrawCurve(img, x4, y4, angle1, sideLength, iterations)
      
   Else
      ; draw section
      x2 = x1 + Polar2Rect_X(sideLength, angle1)
      y2 = y1 + Polar2Rect_Y(sideLength, angle1)
      StartDrawing(ImageOutput(img))
      LineXY(Int(x1), Int(y1), Int(x2), Int(y2), #Black)
      StopDrawing()
   EndIf
EndProcedure


Procedure DrawSnowFlake (x.i, y.i, length.i, iterations.i)
   ; -- draw Koch snowflake (which consists of 3 Koch curves)
   ; in: {x,y}     : lower left vertex of main triangle
   ;     length    : side length of main triangle
   ;     iterations: number of desired iterations
   
   CreateImage(#imgKoch, DPIx(#Image_Size), DPIy(#Image_Size), 24, #White)
   
   If iterations >= 0
      DrawCurve(#imgKoch, x,            y,                              0.0 , length, iterations)   ; bottom, from left to right
      DrawCurve(#imgKoch, x+length,     y,                     Radian(120.0), length, iterations)   ; right , from bottom to top
      DrawCurve(#imgKoch, x+length/2.0, y-length*Sin(#PI/3.0), Radian(240.0), length, iterations)   ; left  , from top to bottom
   Else
      DrawCurve(#imgKoch, x,            y,                     Radian( 60.0), length, -iterations)  ; left  , from bottom to top
      DrawCurve(#imgKoch, x+length/2.0, y-length*Sin(#PI/3.0), Radian(-60.0), length, -iterations)  ; right , from top to bottom
      DrawCurve(#imgKoch, x+length,     y,                     Radian(180.0), length, -iterations)  ; bottom, from right to left
   EndIf
EndProcedure


Procedure On_ChangeIterations()
   Protected.i iterations
   
   Select EventType()
      Case #PB_EventType_Up, #PB_EventType_Down
         iterations = GetGadgetState(#spnCtrl)
         SetGadgetText(#spnCtrl, Str(iterations))
         
      Case #PB_EventType_Change
         iterations = Val(GetGadgetText(#spnCtrl))
         If iterations < #Min_Iterations
            iterations = #Min_Iterations
            SetGadgetText(#spnCtrl, Str(iterations))
         ElseIf iterations > #Max_Iterations
            iterations = #Max_Iterations
            SetGadgetText(#spnCtrl, Str(iterations))
         EndIf
         SetGadgetState(#spnCtrl, iterations)
   EndSelect
   
   FreeImage(#imgKoch)
   DrawSnowFlake(DPIx(#FlakeBase_X), DPIy(#FlakeBase_Y), DPIx(#FlakeSideLen), iterations)
   SetGadgetState(#gdgKoch, ImageID(#imgKoch))
EndProcedure


;===========================
;-- START OF MAIN PROGRAM
;===========================

Define ev.i, iterations.i=0

; -- Create window
If OpenWindow(#winMain, #PB_Ignore, #PB_Ignore, DPIx(#Win_Width), DPIy(#Win_Height), #ProgVersion$,
              #PB_Window_SystemMenu | #PB_Window_ScreenCentered) = 0
   MessageRequester(#ProgVersion$, "Fatal error: Can't create main window.")
   End
EndIf

; -- Create gadgets
DrawSnowFlake(DPIx(#FlakeBase_X), DPIy(#FlakeBase_Y), DPIx(#FlakeSideLen), iterations)
ImageGadget(#gdgKoch, DPIx(10), DPIy(10), DPIx(#Image_Size), DPIy(#Image_Size), ImageID(#imgKoch))
TextGadget(#spnText, DPIx(#SpinText_X), DPIy(#SpinText_Y), DPIx(55), DPIy(30), #GuiTextIterations$)
SpinGadget(#spnCtrl, DPIx(#SpinCtrl_X), DPIy(#SpinCtrl_Y), DPIx(40), DPIy(20), #Min_Iterations, #Max_Iterations)
SetGadgetState(#spnCtrl, iterations) : SetGadgetText(#spnCtrl, Str(iterations))
CreateStatusBar(0, WindowID(#winMain))
AddStatusBarField(#PB_Ignore)
StatusBarText(0, 0, " Image: " + Str(ImageWidth(#imgKoch)) + " x " + Str(ImageHeight(#imgKoch)))
SetActiveGadget(#spnCtrl)

; -- Bind events
BindGadgetEvent(#spnCtrl, @On_ChangeIterations())

; -- Main loop
Repeat
   ev = WaitWindowEvent()
Until ev = #PB_Event_CloseWindow

Posted: **Sun Sep 28, 2014 5:23 pm**

Hi...and thanks
I think that would be ok

Posted: **Sun Sep 28, 2014 9:03 pm**

@Little John,

Thank you for disclosing the code. Its always nice to learn how it should be done.

Checked it on my wife's MacBook Pro + PureBasic 5.30. It worked perfectly.

Posted: **Mon Sep 29, 2014 1:02 pm**

Hi davido,

I don't have the opportunity to check code on a Mac computer myself.
It's good to know that it works.

Thank you!

Posted: **Sun Oct 05, 2014 12:12 pm**

Code slightly improved (see above).

PureBasic Forums - English

Koch Snowflake

Koch Snowflake

Re: Koch Snowflake

Re: Koch Snowflake

Re: Koch Snowflake

Re: Koch Snowflake

Re: Koch Snowflake

Re: Koch Snowflake

Re: Koch Snowflake

Re: Koch Snowflake