PureBasic Forums - English

Code: Select all

;"The Rose" Algorithm by Peter Maurer of AT & T (see "A Rose is a Rose" 
;in the American Mathematical Monthly Vol 94 No 7 (Aug - Sept 1987) pp 631 - 645)
;http://www.jstor.org/stable/2322215

;Program by Terry Morris

EnableExplicit

Enumeration ; gadgets
  #CanvasGadget
EndEnumeration

#MAIN_WINDOW = 0

Global ProgName.s = "The Rose"
Global BackColour.i, ForeColour.i
Global EventId.i, Multiplier.i
Global CentreX.i, CentreY.i, N.i, D.i, Quit.i, Z.i

CompilerIf #PB_Compiler_OS = #PB_OS_Windows
  Procedure CentreAnyFormInWorkArea(WindowNo.i)
    Protected WindowTop.i, WindowLeft.i, WindowWidth.i, WindowHeight.i, ReturnValue.i, WorkAreaRect.RECT
    Protected SpareHeight.i, SpareWidth.i, WorkAreaHeight.i, WorkAreaWidth.i, WindowRect.rect
    ReturnValue = SystemParametersInfo_(#SPI_GETWORKAREA, 0, @WorkAreaRect, 0)
    GetWindowRect_(WindowID(WindowNo),@WindowRect)
    WindowWidth = WindowRect\right - WindowRect\left
    WindowHeight = WindowRect\bottom - WindowRect\top
    WorkAreaHeight = WorkAreaRect\Bottom - WorkAreaRect\Top
    WorkAreaWidth = WorkAreaRect\Right - WorkAreaRect\Left
    SpareHeight = Int((WorkAreaHeight - WindowHeight) / 2)
    SpareWidth = Int((WorkAreaWidth - WindowWidth) / 2)
    WindowTop = WorkAreaRect\Top + SpareHeight
    WindowLeft = WorkAreaRect\Left + SpareWidth
    ReturnValue = MoveWindow_(WindowID(WindowNo), WindowLeft, WindowTop, WindowWidth, WindowHeight, 0)
  EndProcedure
CompilerEndIf

Procedure Initialize()
CentreX = WindowWidth(#MAIN_WINDOW) / 2 ; Get horizontal centre.
CentreY = WindowHeight(#MAIN_WINDOW) / 2    ; Get vertical centre
Multiplier = CentreX - 5
If Multiplier > (CentreY - 5)
  Multiplier = CentreY - 5
EndIf
EndProcedure

Procedure DrawPatternAlgorithmC(Cx.i, Cy.i, Mult.i)
Protected TT.i, t.f, c.i, OldX.i, OldY.i, Theta.i, NewX.i, NewY.i
Protected X.f, r.f
StartDrawing(CanvasOutput(#CanvasGadget))
Box(0, 0, OutputWidth(), OutputHeight(), BackColour)
StopDrawing()
Repeat
  Theta = TT
  r = Sin(2 * #PI * N * Theta/Z) ; Corrects error
  t = 2 * #PI * Theta/Z          ; in article
  OldX = Cx + Int(r * Cos(t) * Mult)
  OldY = Cy - Int(r * Sin(t) * Mult)
  Repeat
    Theta = Mod(Theta + D, Z)
    X = Radian(Mod(N * Theta, Z))
    r = Sin(X)
    t = Radian(Theta)
    NewX = Cx + Int(r * Cos(t) * Mult)
    NewY = Cy - Int(r * Sin(t) * Mult)
    StartDrawing(CanvasOutput(#CanvasGadget))
    LineXY(OldX, OldY, NewX, NewY, ForeColour)
    StopDrawing()
    c + 1
    OldX = NewX: OldY = NewY
  Until Theta = TT Or Quit = #True
  TT + 1
Until C>= Z Or Quit = #True
EndProcedure

Procedure DrawPatternsInThread(*Value)
  ForeColour = RGB(Random(255,129),Random(255,128),Random(255,128))
  Z = 360
  N = 4: D = 43
  DrawPatternAlgorithmC(CentreX, CentreY, Multiplier)
  Delay(3000)
  N = 5: D = 97
  DrawPatternAlgorithmC(CentreX, CentreY, Multiplier)
  Delay(3000)
  N = 6: D = 72
  DrawPatternAlgorithmC(CentreX, CentreY, Multiplier)
  Delay(3000)
  N = 4: D = 120
  DrawPatternAlgorithmC(CentreX, CentreY, Multiplier)
  Delay(3000)
  z = 359: N = 90: D = 90
  DrawPatternAlgorithmC(CentreX, CentreY, Multiplier)
  Delay(3000)
  N = 40: D = 89
  DrawPatternAlgorithmC(CentreX, CentreY, Multiplier)
  Delay(3000)
  Repeat
  Z = Random (360, 359)
  N = Random(Z - 1, 1)
  D = Random(Z- 1, 1)
  ForeColour = RGB(Random(255,129),Random(255,128),Random(255,128))
  DrawPatternAlgorithmC(CentreX, CentreY, Multiplier)
  Delay(3000)
Until Quit = #True  
EndProcedure

If OpenWindow(#MAIN_WINDOW, 600, 100, 600, 600, ProgName, #PB_Window_SystemMenu | #PB_Window_SizeGadget | #PB_Window_MinimizeGadget |#PB_Window_TitleBar | #PB_Window_MaximizeGadget | #PB_Window_Invisible | #PB_Window_ScreenCentered)
  CompilerIf #PB_Compiler_OS = #PB_OS_Windows
    CentreAnyFormInWorkArea(#MAIN_WINDOW)
  CompilerEndIf
  ExamineDesktops()
  CanvasGadget(#CanvasGadget, 0, 0, DesktopWidth(0), DesktopHeight(0))
  Initialize()
  CreateThread(@DrawPatternsInThread(),0)
  HideWindow(#MAIN_WINDOW, #False)
Repeat  
  EventID = WaitWindowEvent()
   Select EventId
      Case #PB_Event_SizeWindow
        Initialize()  
    EndSelect
 Until EventID = #PB_Event_CloseWindow 
 Quit = #True
EndIf