[OpenSource] Turtle Graphics Library (x64) [ALL OS]

[Mijikai]

A turtle graphics Library for PureBasic.

The library only needs a pointer to a line function, so it works with any graphics backend.
Have fun and feel free to post your improvements & art

Edit (21.11.2024):
- fixed a small mistake in the code
- added a module version (last code)

Edit (22.11.2024):
- Update 1.01: added file handling and improved some aspects of the library, includes and examples

Images:





Library:

Code: Select all

EnableExplicit

;--------------------------------------------------------------------------------------
;Project:   Turtle Library
;File:      turtle.pb
;Version:   1.01
;Platform:  Linux, Windows, Mac
;Compiler:  PureBasic 6.12 LTS (x64) - C Backend
;--------------------------------------------------------------------------------------
; MIT License
; Copyright 2024 © Mijikai
; 
; Permission is hereby granted, free of charge, to any person obtaining a copy
; of this software and associated documentation files (the "Software"), to deal
; in the Software without restriction, including without limitation the rights
; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
; copies of the Software, and to permit persons to whom the Software is
; furnished to do so, subject to the following conditions:
; 
; The above copyright notice and this permission notice shall be included in all
; copies or substantial portions of the Software.
; 
; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
; SOFTWARE.
;--------------------------------------------------------------------------------------
;Component: lzma
;LZMA SDK is written and placed in the public domain by Igor Pavlov.
;Some code in LZMA SDK is based on public domain code from other developers:
;1) PPMd var.H (2001): Dmitry Shkarin
;2) SHA-256: Wei Dai (Crypto++ library)
;--------------------------------------------------------------------------------------

UseLZMAPacker()

Prototype.i turtleLine(X1.d,Y1.d,X2.d,Y2.d,Color.l)

Structure TURTLE_HEADER_STRUCT
  magic.l
  width.l
  height.l
  title.a[64]
  bytes.q
  packed.q
EndStructure

Structure TURTLE_FILE_STRUCT
  title.s
  width.l
  height.l
  length.i
  commands.s
EndStructure

Structure TURTLE_POSITION_STRUCT
  x.d
  y.d
EndStructure

Structure TURTLE_STRUCT
  *vtable
  render.l
  color.l
  origin.TURTLE_POSITION_STRUCT
  start.TURTLE_POSITION_STRUCT
  stop.TURTLE_POSITION_STRUCT
  direction.d
  length.d
  *draw.turtleLine
EndStructure

#TURTLE_VERSION = 101

;--------------------------------------------------------------------------------------

ProcedureDLL.i turtleInterface(Version.i)
  Protected *turtle.TURTLE_STRUCT
  With *turtle
    If Version = #Null
      Version = #TURTLE_VERSION
    EndIf
    If Version = #TURTLE_VERSION
      *turtle = AllocateStructure(TURTLE_STRUCT)
      If *turtle
        \vtable = ?vtable
        \color = $FFFFFFFF
      EndIf
    EndIf
    ProcedureReturn *turtle
  EndWith
EndProcedure

;--------------------------------------------------------------------------------------

Procedure.i turtleLine(*turtle.TURTLE_STRUCT,*Function)
  With *turtle
    \draw = *Function
    ProcedureReturn #Null
  EndWith
EndProcedure

Procedure.i turtleColor(*turtle.TURTLE_STRUCT,Color.l)
  With *turtle
    \color = Color
    ProcedureReturn #Null
  EndWith
EndProcedure

Procedure.i turtleOrigin(*turtle.TURTLE_STRUCT,X.l,Y.l,Center.b)
  With *turtle
    If Center
      \origin\x = X / 2.0
      \origin\y = Y / 2.0
    Else
      \origin\x = X
      \origin\y = Y
    EndIf
    \start = \origin
    ProcedureReturn #Null
  EndWith
EndProcedure

Procedure.i turtleStart(*turtle.TURTLE_STRUCT)
  With *turtle
    \render = #True
    ProcedureReturn #Null
  EndWith
EndProcedure

Procedure.i turtleStop(*turtle.TURTLE_STRUCT)
  With *turtle
    \render = #False
    ProcedureReturn #Null
  EndWith
EndProcedure

Procedure.i turtleOffset(*turtle.TURTLE_STRUCT,X.d,Y.d)
  With *turtle
    \start\x = X
    \start\y = Y
    ProcedureReturn #Null
  EndWith
EndProcedure

Procedure.i turtleReset(*turtle.TURTLE_STRUCT)
  With *turtle
    \start = \origin
    ProcedureReturn #Null
  EndWith
EndProcedure

Procedure.i turtleLength(*turtle.TURTLE_STRUCT,Length.d)
  With *turtle
    \length = Length
    ProcedureReturn #Null
  EndWith
EndProcedure

Procedure.i turtleAngle(*turtle.TURTLE_STRUCT,Angle.d)
  With *turtle
    \direction = Radian(Angle)
    ProcedureReturn #Null
  EndWith
EndProcedure

Procedure.i turtleLeft(*turtle.TURTLE_STRUCT,Angle.d)
  With *turtle
    \direction - Radian(Angle)
    ProcedureReturn #Null
  EndWith
EndProcedure

Procedure.i turtleRight(*turtle.TURTLE_STRUCT,Angle.d)
  With *turtle
    \direction + Radian(Angle)
    ProcedureReturn #Null
  EndWith
EndProcedure

Procedure.i turtleTarget(*turtle.TURTLE_STRUCT,X.d,Y.d)
  With *turtle
    \direction = ATan2((X - \start\x),(Y - \start\y))
    ProcedureReturn #Null
  EndWith
EndProcedure

Procedure.i turtleMove(*turtle.TURTLE_STRUCT)
  With *turtle
    \stop\x = \start\x + (Cos(\direction) * \length)
    \stop\y = \start\y + (Sin(\direction) * \length)
    If \render
      \draw(\start\x,\start\y,\stop\x,\stop\y,\color)
    EndIf
    \start = \stop
    ProcedureReturn #Null
  EndWith
EndProcedure

Procedure.i turtlePosition(*turtle.TURTLE_STRUCT,*X.Double,*Y.Double)
  With *turtle
    *X\d = \start\x
    *Y\d = \start\y
    ProcedureReturn #Null
  EndWith  
EndProcedure

Procedure.i turtleRun(*turtle.TURTLE_STRUCT,*Code.Ascii,*X.Double,*Y.Double)
  Protected.d x,y
  Protected.i offset,a,b,c,d
  Protected.Ascii *pos
  Protected.s parameter
  With *turtle
    While *Code\a
      offset = 0
      *pos = *Code + 2
      If *pos\a = '('
        Repeat
          *pos + 2
          If *pos\a = ','
            offset + 1
          EndIf
        Until *pos\a = ')'
      Else
        *pos = *Code
      EndIf
      Select *Code\a
        Case '$';Color
          If offset = 3
            parameter = PeekS(*Code + 4,((*pos - *Code) >> 1) - 2,#PB_Unicode)
            a = Val(StringField(parameter,1,","))
            b = Val(StringField(parameter,2,","))
            c = Val(StringField(parameter,3,","))
            d = Val(StringField(parameter,4,","))
            turtleColor(*turtle,RGBA(a,b,c,d))
          EndIf
        Case '*';Origin
          If offset = 2
            parameter = PeekS(*Code + 4,((*pos - *Code) >> 1) - 2,#PB_Unicode)
            x = ValD(StringField(parameter,1,","))
            y = ValD(StringField(parameter,2,","))
            a = Val(StringField(parameter,3,","))
            turtleOrigin(*turtle,x,y,a)
          EndIf
        Case '-';Start
          turtleStart(*turtle)
        Case '.';Stop
          turtleStop(*turtle)
        Case '#';Offset
          If offset = 1
            parameter = PeekS(*Code + 4,((*pos - *Code) >> 1) - 2,#PB_Unicode)
            x = ValD(StringField(parameter,1,","))
            y = ValD(StringField(parameter,2,","))
            turtleOffset(*turtle,x,y)
          EndIf
        Case '!';Reset
          turtleReset(*turtle)
        Case '_'
          If *Code <> *pos
            x = ValD(PeekS(*Code + 4,((*pos - *Code) >> 1) - 2,#PB_Unicode))
            turtleLength(*turtle,x)
          EndIf
        Case '~';Angle 
          If *Code <> *pos
            x = ValD(PeekS(*Code + 4,((*pos - *Code) >> 1) - 2,#PB_Unicode))
            turtleAngle(*turtle,x)
          EndIf
        Case '>';Right
          If *Code <> *pos
            x = ValD(PeekS(*Code + 4,((*pos - *Code) >> 1) - 2,#PB_Unicode))
            turtleRight(*turtle,x)
          EndIf
        Case '<';Left
          If *Code <> *pos
            x = ValD(PeekS(*Code + 4,((*pos - *Code) >> 1) - 2,#PB_Unicode))
            turtleLeft(*turtle,x)
          EndIf
        Case '@';Target
          If offset = 1
            parameter = PeekS(*Code + 4,((*pos - *Code) >> 1) - 2,#PB_Unicode)
            x = ValD(StringField(parameter,1,","))
            y = ValD(StringField(parameter,2,","))
            turtleTarget(*turtle,x,y)
          EndIf
        Case '+'
          turtleMove(*turtle)
        Case '?'
          *X\d = \start\x
          *Y\d = \start\y
      EndSelect
      *Code = *pos + 2
    Wend
    ProcedureReturn #Null
  EndWith
EndProcedure

Procedure.i turtleCatch(*turtle.TURTLE_STRUCT,*Buffer.TURTLE_HEADER_STRUCT)
  Protected.TURTLE_FILE_STRUCT *data
  Protected.i packed,bytes
  Protected *ascii
  If *Buffer
    If *Buffer\magic = $73636774
      If *Buffer\width > 0 And *Buffer\height > 0 And *Buffer\bytes > 0
        packed = Bool(*Buffer\bytes <> *Buffer\packed)
        *ascii = AllocateMemory(*Buffer\bytes)
        If *ascii
          If packed
            bytes = UncompressMemory(*Buffer + SizeOf(TURTLE_HEADER_STRUCT),*Buffer\packed,*ascii,*Buffer\bytes,#PB_PackerPlugin_Lzma)
          Else
            CopyMemory(*Buffer + SizeOf(TURTLE_HEADER_STRUCT),*ascii,*Buffer\bytes)
            bytes = *Buffer\bytes
          EndIf
          If *Buffer\bytes = bytes
            *data = AllocateStructure(TURTLE_FILE_STRUCT)
            If *data
              *data\title = PeekS(@*Buffer\title[0],64,#PB_Ascii)
              *data\width = *Buffer\width
              *data\height = *Buffer\height
              *data\length = bytes
              *data\commands = PeekS(*ascii,bytes,#PB_Ascii)
            EndIf
          EndIf
          FreeMemory(*ascii)
        EndIf
      EndIf
    EndIf
  EndIf
  ProcedureReturn *data
EndProcedure

Procedure.i turtleLoad(*turtle.TURTLE_STRUCT,File.s)
  Protected.String *string
  Protected.i bytes,handle,packed,result
  Protected.TURTLE_HEADER_STRUCT header
  Protected *ascii
  Protected.TURTLE_FILE_STRUCT *data
  If File
    If LCase(Right(File,5)) <> ".tgcf"
      File + ".tgcf"  
    EndIf
    handle = ReadFile(#PB_Any,File)
    If IsFile(handle)
      bytes = Lof(handle)
      If bytes > SizeOf(TURTLE_HEADER_STRUCT)
        If ReadData(handle,@header,SizeOf(TURTLE_HEADER_STRUCT)) = SizeOf(TURTLE_HEADER_STRUCT)
          If header\magic = $73636774   
            bytes - SizeOf(TURTLE_HEADER_STRUCT)
            If header\width > 0 And header\height > 0 And header\bytes > 0
              If header\packed = bytes
                packed = Bool(header\bytes <> header\packed)
                If packed
                  *ascii = AllocateMemory(header\bytes + header\packed)
                Else
                  *ascii = AllocateMemory(header\bytes)
                EndIf
                If *ascii
                  If packed
                    result = Bool(ReadData(handle,*ascii + header\bytes,header\packed) = header\packed)
                    If result
                      bytes = UncompressMemory(*ascii + header\bytes,header\packed,*ascii,header\bytes,#PB_PackerPlugin_Lzma)
                    EndIf
                  Else
                    result = Bool(ReadData(handle,*ascii,header\bytes) = header\bytes)
                  EndIf
                  If result And header\bytes = bytes
                    *data = AllocateStructure(TURTLE_FILE_STRUCT)
                    If *data
                      *data\title = PeekS(@header\title[0],64,#PB_Ascii)
                      *data\width = header\width
                      *data\height = header\height
                      *data\length = bytes
                      *data\commands = PeekS(*ascii,bytes,#PB_Ascii)
                    EndIf
                  EndIf
                  FreeMemory(*ascii)
                EndIf
              EndIf
            EndIf
          EndIf
        EndIf
      EndIf
      CloseFile(handle)
    EndIf
  EndIf
  ProcedureReturn *data
EndProcedure

Procedure.i turtleFree(*turtle.TURTLE_STRUCT,*File.TURTLE_FILE_STRUCT)
  FreeStructure(*File)
  ProcedureReturn #Null
EndProcedure

Procedure.i turtleSave(*turtle.TURTLE_STRUCT,File.s,Override.b,Title.s,Width.i,Height.i,*Commands)
  Protected.String *string
  Protected.i bytes,handle,result
  Protected.TURTLE_HEADER_STRUCT *header
  Protected *ascii
  If File And *Commands
    If LCase(Right(File,5)) <> ".tgcf"
      File + ".tgcf"  
    EndIf
    If Override = #False
      If FileSize(File) >= 0
        ProcedureReturn #False
      EndIf
    EndIf
    bytes = MemoryStringLength(*Commands)
    If bytes
      *string = @*Commands
      *ascii = Ascii(*string\s)
      If *ascii
        *header = AllocateMemory(SizeOf(TURTLE_HEADER_STRUCT) + bytes)
        If *header
          *header\bytes = bytes
          *header\packed = CompressMemory(*ascii,bytes,*header + SizeOf(TURTLE_HEADER_STRUCT),bytes,#PB_PackerPlugin_Lzma,9)
          If *header\packed = 0
            CopyMemory(*ascii,*header + SizeOf(TURTLE_HEADER_STRUCT),bytes)
            *header\packed = *header\bytes
          EndIf
          *header\magic = $73636774
          PokeS(@*header\title[0],Title,64,#PB_Ascii)
          If Width And Height
            *header\width = Width
            *header\height = Height
          Else
            *header\width = 800
            *header\height = 600
          EndIf
          handle = CreateFile(#PB_Any,File)
          If IsFile(handle)
            bytes = *header\packed + SizeOf(TURTLE_HEADER_STRUCT)
            If WriteData(handle,*header,bytes) = bytes
              result = Bool(FlushFileBuffers(handle) <> 0)
            EndIf
            CloseFile(handle)
            If result = #False
              DeleteFile(File)
            EndIf
          EndIf 
          FreeMemory(*header)
        EndIf
        FreeMemory(*ascii)
      EndIf
    EndIf
  EndIf
  ProcedureReturn result
EndProcedure

Procedure.i turtleRelease(*turtle.TURTLE_STRUCT)
  FreeStructure(*turtle)
  ProcedureReturn #Null
EndProcedure

;--------------------------------------------------------------------------------------

DataSection
  vtable:
  Data.i @turtleLine()
  Data.i @turtleColor()
  Data.i @turtleOrigin() 
  Data.i @turtleStart()
  Data.i @turtleStop()
  Data.i @turtleOffset()
  Data.i @turtleReset()
  Data.i @turtleLength()
  Data.i @turtleAngle()
  Data.i @turtleLeft()
  Data.i @turtleRight()
  Data.i @turtleTarget()
  Data.i @turtleMove()
  Data.i @turtlePosition()
  Data.i @turtleRun()
  Data.i @turtleCatch()
  Data.i @turtleLoad()
  Data.i @turtleFree()
  Data.i @turtleSave()
  Data.i @turtleRelease()
EndDataSection

Include:

Code: Select all

EnableExplicit

;--------------------------------------------------------------------------------------
;Project:   Turtle Library
;File:      turtle.pbi
;Version:   1.01
;Platform:  Linux, Windows, Mac
;Compiler:  PureBasic 6.12 LTS (x64) - C Backend
;--------------------------------------------------------------------------------------

Import "turtle.so"
  turtleInterface.i(Version.i = #Null)
EndImport

#TURTLE_VERSION = 101

Interface TURTLE
  Line.i(*Function)
  Color.i(Color.l)
  Origin.i(X.l,Y.l,Center.b = #False)
  Start.i()
  Stop.i()
  Offset.i(X.d,Y.d)
  Reset.i()
  Length.i(Length.d)
  Angle.i(Angle.d)
  Left.i(Angle.d)
  Right.i(Angle.d)
  Target.i(X.d,Y.d)
  Move.i()
  Position.i(*X,*Y)
  Run.i(*Code,*X = 0,*Y = 0)
  Catch.i(*Buffer)
  Load.i(File.s)
  Free.i(*File)
  Save.i(File.s,Override.b,Title.s,Width.i,Height.i,*Commands)
  Release.i()  
EndInterface

Structure TURTLE_FILE
  title.s
  width.l
  height.l
  length.i
  commands.s
EndStructure

Include (helper):

Code: Select all

EnableExplicit

;--------------------------------------------------------------------------------------
;Project:   Turtle Library
;File:      turtle_output.pbi
;Version:   1.01
;Platform:  Linux, Windows, Mac
;Compiler:  PureBasic 6.12 LTS (x64) - C Backend
;--------------------------------------------------------------------------------------

Procedure.i turtleLine(X1.d,Y1.d,X2.d,Y2.d,Color.l)
  ProcedureReturn LineXY(X1,Y1,X2,Y2,Color)
EndProcedure

Procedure.i turtleWindow(*Turtle.TURTLE,Title.s,Width.i,Height.i,Once.b,*Render,*Parameter = #Null,*Event = #Null)
  Protected.i task,exit
  If InitSprite() And *Render
    If OpenWindow(0,0,0,Width,Height,Title,#PB_Window_SystemMenu|#PB_Window_ScreenCentered)
      If OpenWindowedScreen(WindowID(0),0,0,WindowWidth(0),WindowHeight(0))
        SetFrameRate(60)
        If CreateSprite(0,WindowWidth(0),WindowHeight(0))
          *Turtle\Line(@turtleLine())
          *Turtle\Origin(WindowWidth(0),WindowHeight(0),#True)
          If Once
            If StartDrawing(SpriteOutput(0))
              DrawingMode(#PB_2DDrawing_AllChannels)
              If CallFunctionFast(*Render,*Turtle,*Parameter)
                exit = #True  
              EndIf
              StopDrawing()
            EndIf
          EndIf
          Repeat
            Repeat
              task = WindowEvent()
              Select task
                Case #PB_Event_None
                  Break
                Case #PB_Event_CloseWindow
                  exit = #True
                Default
                  If *Event
                    CallFunctionFast(*Event,task)
                  EndIf
              EndSelect
            ForEver
            ClearScreen(0)
            If Once = #False
              If StartDrawing(SpriteOutput(0))
                DrawingMode(#PB_2DDrawing_AllChannels)
                If CallFunctionFast(*Render,*Turtle,*Parameter)
                  exit = #True
                EndIf
                StopDrawing()
              EndIf
            EndIf
            DisplaySprite(0,0,0)
            FlipBuffers()
          Until exit
          FreeSprite(0)  
        EndIf
        CloseScreen()
      EndIf
      CloseWindow(0)  
    EndIf    
  EndIf
  ProcedureReturn #Null
EndProcedure

Example:

Code: Select all

EnableExplicit

;--------------------------------------------------------------------------------------
;Project:   Turtle Library
;File:      turtle_example.pb
;Version:   1.01
;Platform:  Linux, Windows, Mac
;Compiler:  PureBasic 6.12 LTS (x64) - C Backend
;--------------------------------------------------------------------------------------

XIncludeFile "turtle.pbi"
XIncludeFile "turtle_output.pbi"

Procedure.i Render(*turtle.TURTLE,*Parameter)
  Protected.i x,y
  With *turtle
    \Offset(520,158)
    \Start()
    \Length(100)
    \Color(RGBA(255,60,60,255))
    For y = 1 To 20
      For x = 1 To 20
        \Right(30)
        \Move()
      Next
      \Left(20)
      \Move()
    Next
    ProcedureReturn #Null
  EndWith
EndProcedure

; Procedure.i Render(*turtle.TURTLE,*Parameter);<- string command version
;   Protected.i x,y
;   Protected.s c1,c2,c3
;   With *turtle
;     c1 = "#(520,158)-_(100)$(255,60,60,255)"
;     c2 = ">(30)+"
;     c3 = "<(20)+"
;     \Run(@c1)
;     For y = 1 To 20
;       For x = 1 To 20
;         \Run(@c2)
;       Next
;       \Run(@c3)
;     Next
;     ProcedureReturn #Null
;   EndWith
; EndProcedure

Procedure.i Main()
  Protected *turtle.TURTLE
  *turtle = turtleInterface()
  If *turtle
    turtleWindow(*turtle,"Turtle Graphics",800,600,#True,@Render())
    *turtle\Release()
  EndIf
  ProcedureReturn #Null
EndProcedure

End Main()

The whole thing as single Module (some functions have been adjusted):

Code: Select all

EnableExplicit

;--------------------------------------------------------------------------------------
;Project:   Turtle Module
;File:      turtle_module.pbi
;Version:   1.01
;Platform:  Linux, Windows, Mac
;Compiler:  PureBasic 6.12 LTS (x64) - C Backend
;--------------------------------------------------------------------------------------
; MIT License
; Copyright 2024 © Mijikai
; 
; Permission is hereby granted, free of charge, to any person obtaining a copy
; of this software and associated documentation files (the "Software"), to deal
; in the Software without restriction, including without limitation the rights
; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
; copies of the Software, and to permit persons to whom the Software is
; furnished to do so, subject to the following conditions:
; 
; The above copyright notice and this permission notice shall be included in all
; copies or substantial portions of the Software.
; 
; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
; SOFTWARE.
;--------------------------------------------------------------------------------------
;Component: lzma
;LZMA SDK is written and placed in the public domain by Igor Pavlov.
;Some code in LZMA SDK is based on public domain code from other developers:
;1) PPMd var.H (2001): Dmitry Shkarin
;2) SHA-256: Wei Dai (Crypto++ library)
;--------------------------------------------------------------------------------------

DeclareModule turtle
  
  Interface TURTLE
    Line.i(*Function)
    Color.i(Color.l)
    Origin.i(X.l,Y.l,Center.b = #False)
    Start.i()
    Stop.i()
    Offset.i(X.d,Y.d)
    Reset.i()
    Length.i(Length.d)
    Angle.i(Angle.d)
    Left.i(Angle.d)
    Right.i(Angle.d)
    Target.i(X.d,Y.d)
    Move.i()
    Position.i(*X,*Y)
    Run.i(*Code,*X = 0,*Y = 0)
    Catch.i(*Buffer)
    Load.i(File.s)
    Free.i(*File)
    Save.i(File.s,Override.b,Title.s,Width.i,Height.i,*Commands)
    Release.i()  
  EndInterface
  
  Structure TURTLE_FILE
    title.s
    width.l
    height.l
    length.i
    commands.s
  EndStructure
  
  Declare.i Create()
  Declare.i Window(*Turtle,Title.s,Width.i,Height.i,Once.b,*Render,*Parameter = #Null,*Event = #Null)
  Declare.i Clear()

EndDeclareModule

Module turtle
  
  UseLZMAPacker()
  
  Prototype.i turtleLine(X1.d,Y1.d,X2.d,Y2.d,Color.l)
  
  Structure TURTLE_HEADER_STRUCT
    magic.l
    width.l
    height.l
    title.a[64]
    bytes.q
    packed.q
  EndStructure
  
  Structure TURTLE_FILE_STRUCT
    title.s
    width.l
    height.l
    length.i
    commands.s
  EndStructure
  
  Structure TURTLE_POSITION_STRUCT
    x.d
    y.d
  EndStructure
  
  Structure TURTLE_STRUCT
    *vtable
    render.l
    color.l
    origin.TURTLE_POSITION_STRUCT
    start.TURTLE_POSITION_STRUCT
    stop.TURTLE_POSITION_STRUCT
    direction.d
    length.d
    *draw.turtleLine
  EndStructure
  
  #TURTLE_VERSION = 101
  
  ;--------------------------------------------------------------------------------------
  
  Procedure.i Create()
    Protected *turtle.TURTLE_STRUCT
    With *turtle
      *turtle = AllocateStructure(TURTLE_STRUCT)
      If *turtle
        \vtable = ?vtable
        \color = $FFFFFFFF
      EndIf
      ProcedureReturn *turtle
    EndWith
  EndProcedure
  
  ;--------------------------------------------------------------------------------------
  
  Procedure.i turtleLine(*turtle.TURTLE_STRUCT,*Function)
    With *turtle
      \draw = *Function
      ProcedureReturn #Null
    EndWith
  EndProcedure
  
  Procedure.i turtleColor(*turtle.TURTLE_STRUCT,Color.l)
    With *turtle
      \color = Color
      ProcedureReturn #Null
    EndWith
  EndProcedure
  
  Procedure.i turtleOrigin(*turtle.TURTLE_STRUCT,X.l,Y.l,Center.b)
    With *turtle
      If Center
        \origin\x = X / 2.0
        \origin\y = Y / 2.0
      Else
        \origin\x = X
        \origin\y = Y
      EndIf
      \start = \origin
      ProcedureReturn #Null
    EndWith
  EndProcedure
  
  Procedure.i turtleStart(*turtle.TURTLE_STRUCT)
    With *turtle
      \render = #True
      ProcedureReturn #Null
    EndWith
  EndProcedure
  
  Procedure.i turtleStop(*turtle.TURTLE_STRUCT)
    With *turtle
      \render = #False
      ProcedureReturn #Null
    EndWith
  EndProcedure
  
  Procedure.i turtleOffset(*turtle.TURTLE_STRUCT,X.d,Y.d)
    With *turtle
      \start\x = X
      \start\y = Y
      ProcedureReturn #Null
    EndWith
  EndProcedure
  
  Procedure.i turtleReset(*turtle.TURTLE_STRUCT)
    With *turtle
      \start = \origin
      ProcedureReturn #Null
    EndWith
  EndProcedure
  
  Procedure.i turtleLength(*turtle.TURTLE_STRUCT,Length.d)
    With *turtle
      \length = Length
      ProcedureReturn #Null
    EndWith
  EndProcedure
  
  Procedure.i turtleAngle(*turtle.TURTLE_STRUCT,Angle.d)
    With *turtle
      \direction = Radian(Angle)
      ProcedureReturn #Null
    EndWith
  EndProcedure
  
  Procedure.i turtleLeft(*turtle.TURTLE_STRUCT,Angle.d)
    With *turtle
      \direction - Radian(Angle)
      ProcedureReturn #Null
    EndWith
  EndProcedure
  
  Procedure.i turtleRight(*turtle.TURTLE_STRUCT,Angle.d)
    With *turtle
      \direction + Radian(Angle)
      ProcedureReturn #Null
    EndWith
  EndProcedure
  
  Procedure.i turtleTarget(*turtle.TURTLE_STRUCT,X.d,Y.d)
    With *turtle
      \direction = ATan2((X - \start\x),(Y - \start\y))
      ProcedureReturn #Null
    EndWith
  EndProcedure
  
  Procedure.i turtleMove(*turtle.TURTLE_STRUCT)
    With *turtle
      \stop\x = \start\x + (Cos(\direction) * \length)
      \stop\y = \start\y + (Sin(\direction) * \length)
      If \render
        \draw(\start\x,\start\y,\stop\x,\stop\y,\color)
      EndIf
      \start = \stop
      ProcedureReturn #Null
    EndWith
  EndProcedure
  
  Procedure.i turtlePosition(*turtle.TURTLE_STRUCT,*X.Double,*Y.Double)
    With *turtle
      *X\d = \start\x
      *Y\d = \start\y
      ProcedureReturn #Null
    EndWith  
  EndProcedure
  
  Procedure.i turtleRun(*turtle.TURTLE_STRUCT,*Code.Ascii,*X.Double,*Y.Double)
    Protected.d x,y
    Protected.i offset,a,b,c,d
    Protected.Ascii *pos
    Protected.s parameter
    With *turtle
      While *Code\a
        offset = 0
        *pos = *Code + 2
        If *pos\a = '('
          Repeat
            *pos + 2
            If *pos\a = ','
              offset + 1
            EndIf
          Until *pos\a = ')'
        Else
          *pos = *Code
        EndIf
        Select *Code\a
          Case '$';Color
            If offset = 3
              parameter = PeekS(*Code + 4,((*pos - *Code) >> 1) - 2,#PB_Unicode)
              a = Val(StringField(parameter,1,","))
              b = Val(StringField(parameter,2,","))
              c = Val(StringField(parameter,3,","))
              d = Val(StringField(parameter,4,","))
              turtleColor(*turtle,RGBA(a,b,c,d))
            EndIf
          Case '*';Origin
            If offset = 2
              parameter = PeekS(*Code + 4,((*pos - *Code) >> 1) - 2,#PB_Unicode)
              x = ValD(StringField(parameter,1,","))
              y = ValD(StringField(parameter,2,","))
              a = Val(StringField(parameter,3,","))
              turtleOrigin(*turtle,x,y,a)
            EndIf
          Case '-';Start
            turtleStart(*turtle)
          Case '.';Stop
            turtleStop(*turtle)
          Case '#';Offset
            If offset = 1
              parameter = PeekS(*Code + 4,((*pos - *Code) >> 1) - 2,#PB_Unicode)
              x = ValD(StringField(parameter,1,","))
              y = ValD(StringField(parameter,2,","))
              turtleOffset(*turtle,x,y)
            EndIf
          Case '!';Reset
            turtleReset(*turtle)
          Case '_'
            If *Code <> *pos
              x = ValD(PeekS(*Code + 4,((*pos - *Code) >> 1) - 2,#PB_Unicode))
              turtleLength(*turtle,x)
            EndIf
          Case '~';Angle 
            If *Code <> *pos
              x = ValD(PeekS(*Code + 4,((*pos - *Code) >> 1) - 2,#PB_Unicode))
              turtleAngle(*turtle,x)
            EndIf
          Case '>';Right
            If *Code <> *pos
              x = ValD(PeekS(*Code + 4,((*pos - *Code) >> 1) - 2,#PB_Unicode))
              turtleRight(*turtle,x)
            EndIf
          Case '<';Left
            If *Code <> *pos
              x = ValD(PeekS(*Code + 4,((*pos - *Code) >> 1) - 2,#PB_Unicode))
              turtleLeft(*turtle,x)
            EndIf
          Case '@';Target
            If offset = 1
              parameter = PeekS(*Code + 4,((*pos - *Code) >> 1) - 2,#PB_Unicode)
              x = ValD(StringField(parameter,1,","))
              y = ValD(StringField(parameter,2,","))
              turtleTarget(*turtle,x,y)
            EndIf
          Case '+'
            turtleMove(*turtle)
          Case '?'
            *X\d = \start\x
            *Y\d = \start\y
        EndSelect
        *Code = *pos + 2
      Wend
      ProcedureReturn #Null
    EndWith
  EndProcedure
  
  Procedure.i turtleCatch(*turtle.TURTLE_STRUCT,*Buffer.TURTLE_HEADER_STRUCT)
    Protected.TURTLE_FILE_STRUCT *data
    Protected.i packed,bytes
    Protected *ascii
    If *Buffer
      If *Buffer\magic = $73636774
        If *Buffer\width > 0 And *Buffer\height > 0 And *Buffer\bytes > 0
          packed = Bool(*Buffer\bytes <> *Buffer\packed)
          *ascii = AllocateMemory(*Buffer\bytes)
          If *ascii
            If packed
              bytes = UncompressMemory(*Buffer + SizeOf(TURTLE_HEADER_STRUCT),*Buffer\packed,*ascii,*Buffer\bytes,#PB_PackerPlugin_Lzma)
            Else
              CopyMemory(*Buffer + SizeOf(TURTLE_HEADER_STRUCT),*ascii,*Buffer\bytes)
              bytes = *Buffer\bytes
            EndIf
            If *Buffer\bytes = bytes
              *data = AllocateStructure(TURTLE_FILE_STRUCT)
              If *data
                *data\title = PeekS(@*Buffer\title[0],64,#PB_Ascii)
                *data\width = *Buffer\width
                *data\height = *Buffer\height
                *data\length = bytes
                *data\commands = PeekS(*ascii,bytes,#PB_Ascii)
              EndIf
            EndIf
            FreeMemory(*ascii)
          EndIf
        EndIf
      EndIf
    EndIf
    ProcedureReturn *data
  EndProcedure
  
  Procedure.i turtleLoad(*turtle.TURTLE_STRUCT,File.s)
    Protected.String *string
    Protected.i bytes,handle,packed,result
    Protected.TURTLE_HEADER_STRUCT header
    Protected *ascii
    Protected.TURTLE_FILE_STRUCT *data
    If File
      If LCase(Right(File,5)) <> ".tgcf"
        File + ".tgcf"  
      EndIf
      handle = ReadFile(#PB_Any,File)
      If IsFile(handle)
        bytes = Lof(handle)
        If bytes > SizeOf(TURTLE_HEADER_STRUCT)
          If ReadData(handle,@header,SizeOf(TURTLE_HEADER_STRUCT)) = SizeOf(TURTLE_HEADER_STRUCT)
            If header\magic = $73636774   
              bytes - SizeOf(TURTLE_HEADER_STRUCT)
              If header\width > 0 And header\height > 0 And header\bytes > 0
                If header\packed = bytes
                  packed = Bool(header\bytes <> header\packed)
                  If packed
                    *ascii = AllocateMemory(header\bytes + header\packed)
                  Else
                    *ascii = AllocateMemory(header\bytes)
                  EndIf
                  If *ascii
                    If packed
                      result = Bool(ReadData(handle,*ascii + header\bytes,header\packed) = header\packed)
                      If result
                        bytes = UncompressMemory(*ascii + header\bytes,header\packed,*ascii,header\bytes,#PB_PackerPlugin_Lzma)
                      EndIf
                    Else
                      result = Bool(ReadData(handle,*ascii,header\bytes) = header\bytes)
                    EndIf
                    If result And header\bytes = bytes
                      *data = AllocateStructure(TURTLE_FILE_STRUCT)
                      If *data
                        *data\title = PeekS(@header\title[0],64,#PB_Ascii)
                        *data\width = header\width
                        *data\height = header\height
                        *data\length = bytes
                        *data\commands = PeekS(*ascii,bytes,#PB_Ascii)
                      EndIf
                    EndIf
                    FreeMemory(*ascii)
                  EndIf
                EndIf
              EndIf
            EndIf
          EndIf
        EndIf
        CloseFile(handle)
      EndIf
    EndIf
    ProcedureReturn *data
  EndProcedure
  
  Procedure.i turtleFree(*turtle.TURTLE_STRUCT,*File.TURTLE_FILE_STRUCT)
    FreeStructure(*File)
    ProcedureReturn #Null
  EndProcedure
  
  Procedure.i turtleSave(*turtle.TURTLE_STRUCT,File.s,Override.b,Title.s,Width.i,Height.i,*Commands)
    Protected.String *string
    Protected.i bytes,handle,result
    Protected.TURTLE_HEADER_STRUCT *header
    Protected *ascii
    If File And *Commands
      If LCase(Right(File,5)) <> ".tgcf"
        File + ".tgcf"  
      EndIf
      If Override = #False
        If FileSize(File) >= 0
          ProcedureReturn #False
        EndIf
      EndIf
      bytes = MemoryStringLength(*Commands)
      If bytes
        *string = @*Commands
        *ascii = Ascii(*string\s)
        If *ascii
          *header = AllocateMemory(SizeOf(TURTLE_HEADER_STRUCT) + bytes)
          If *header
            *header\bytes = bytes
            *header\packed = CompressMemory(*ascii,bytes,*header + SizeOf(TURTLE_HEADER_STRUCT),bytes,#PB_PackerPlugin_Lzma,9)
            If *header\packed = 0
              CopyMemory(*ascii,*header + SizeOf(TURTLE_HEADER_STRUCT),bytes)
              *header\packed = *header\bytes
            EndIf
            *header\magic = $73636774
            PokeS(@*header\title[0],Title,64,#PB_Ascii)
            If Width And Height
              *header\width = Width
              *header\height = Height
            Else
              *header\width = 800
              *header\height = 600
            EndIf
            handle = CreateFile(#PB_Any,File)
            If IsFile(handle)
              bytes = *header\packed + SizeOf(TURTLE_HEADER_STRUCT)
              If WriteData(handle,*header,bytes) = bytes
                result = Bool(FlushFileBuffers(handle) <> 0)
              EndIf
              CloseFile(handle)
              If result = #False
                DeleteFile(File)
              EndIf
            EndIf 
            FreeMemory(*header)
          EndIf
          FreeMemory(*ascii)
        EndIf
      EndIf
    EndIf
    ProcedureReturn result
  EndProcedure
  
  Procedure.i turtleRelease(*turtle.TURTLE_STRUCT)
    FreeStructure(*turtle)
    ProcedureReturn #Null
  EndProcedure
  
  ;--------------------------------------------------------------------------------------
  
  Procedure.i turtleDraw(X1.d,Y1.d,X2.d,Y2.d,Color.l)
    ProcedureReturn LineXY(X1,Y1,X2,Y2,Color)
  EndProcedure
  
  Procedure.i Window(*Turtle,Title.s,Width.i,Height.i,Once.b,*Render,*Parameter = #Null,*Event = #Null)
    Protected.i task,exit
    If *Turtle
      If InitSprite() And *Render
        If OpenWindow(0,0,0,Width,Height,Title,#PB_Window_SystemMenu|#PB_Window_ScreenCentered)
          If OpenWindowedScreen(WindowID(0),0,0,WindowWidth(0),WindowHeight(0))
            SetFrameRate(60)
            If CreateSprite(0,WindowWidth(0),WindowHeight(0))
              turtleLine(*Turtle,@turtleDraw())
              turtleOrigin(*Turtle,WindowWidth(0),WindowHeight(0),#True)
              If Once
                If StartDrawing(SpriteOutput(0))
                  DrawingMode(#PB_2DDrawing_AllChannels)
                  If CallFunctionFast(*Render,*Turtle,*Parameter)
                    exit = #True  
                  EndIf
                  StopDrawing()
                EndIf
              EndIf
              Repeat
                Repeat
                  task = WindowEvent()
                  Select task
                    Case #PB_Event_None
                      Break
                    Case #PB_Event_CloseWindow
                      exit = #True
                    Default
                      If *Event
                        CallFunctionFast(*Event,task)
                      EndIf
                  EndSelect
                ForEver
                ClearScreen(0)
                If Once = #False
                  If StartDrawing(SpriteOutput(0))
                    DrawingMode(#PB_2DDrawing_AllChannels)
                    If CallFunctionFast(*Render,*Turtle,*Parameter)
                      exit = #True  
                    EndIf
                    StopDrawing()
                  EndIf
                EndIf
                DisplaySprite(0,0,0)
                FlipBuffers()
              Until exit
              FreeSprite(0)  
            EndIf
            CloseScreen()
          EndIf
          CloseWindow(0)  
        EndIf    
      EndIf
    EndIf
    ProcedureReturn #Null
  EndProcedure
  
  Procedure.i Clear()
    ProcedureReturn Box(0,0,WindowWidth(0),WindowHeight(0),RGBA(0,0,0,0))
  EndProcedure
  
  ;--------------------------------------------------------------------------------------
  
  DataSection
    vtable:
    Data.i @turtleLine()
    Data.i @turtleColor()
    Data.i @turtleOrigin() 
    Data.i @turtleStart()
    Data.i @turtleStop()
    Data.i @turtleOffset()
    Data.i @turtleReset()
    Data.i @turtleLength()
    Data.i @turtleAngle()
    Data.i @turtleLeft()
    Data.i @turtleRight()
    Data.i @turtleTarget()
    Data.i @turtleMove()
    Data.i @turtlePosition()
    Data.i @turtleRun()
    Data.i @turtleCatch()
    Data.i @turtleLoad()
    Data.i @turtleFree()
    Data.i @turtleSave()
    Data.i @turtleRelease()
  EndDataSection
  
EndModule

Procedure.i Render(*turtle.turtle::TURTLE,*Parameter);Example 1
  Protected.i x
  Static.i t,s
  With *turtle
    \Start()
    \Angle(270)
    If t % 2 = 0
      \Color(RGBA(Random(127) + 128,Random(127) + 128,Random(127) + 128,255))
      \Length(50 + s)
      \Offset(480 + s / 4,360 + s / 2)
      s + 4
      If s > 160
        turtle::Clear()
        s = 0
      EndIf
    EndIf  
    For x = 1 To 9
      \Right(100)
      \Move()
      \Left(140)
      \Move()
    Next
    t + 1
    ProcedureReturn #Null
  EndWith
EndProcedure

; Procedure.i Render(*turtle.turtle::TURTLE,*Parameter);Example 2
;   Static.i x,y,i
;   Static.s Dim s(80),c
;   With *turtle
;     If i 
;       If y % 2 = 0 And x < 80
;         c = s(x)
;         \Run(@c)
;         x + 1
;         If y % 16 = 0
;           \Color(RGBA(Random(127) + 128,Random(127) + 128,Random(127) + 128,255))
;         EndIf
;       ElseIf x = 80
;         turtle::Clear()
;         x = 0
;         y = 0
;       EndIf
;       y + 1
;     Else
;       s(i) = "#(420,340)-_(200)~(270)"
;       i + 1
;       For x = 1 To 9
;         s(i) = ">(100)+<(140)+"
;         i + 1
;         For y = 1 To 7
;           s(i) = ">(200)+"
;           i + 1
;         Next
;       Next
;       x = 0
;       y = 0
;     EndIf
;     ProcedureReturn #Null
;   EndWith
; EndProcedure

Procedure.i Main()
  Protected.turtle::TURTLE *t
  *t = turtle::Create()
  If *t
    turtle::Window(*t,"Turtle Graphics",800,600,#False,@Render())
    *t\Release()  
  EndIf
EndProcedure

End Main()

[idle]

Nice and thanks for sharing, I will give this a spin later

Edit later:
IF you just want to check it out quickly. I give it 9 stars out of 9

Code: Select all

EnableExplicit
;--------------------------------------------------------------------------------------
;Project:   Turtle Library
;File:      turtle.pb
;Version:   1.00
;Platform:  Linux, Windows, Mac
;Compiler:  PureBasic 6.12 LTS (x64) - C Backend
;--------------------------------------------------------------------------------------
; MIT License
; Copyright 2024 © Mijikai
; 
; Permission is hereby granted, free of charge, to any person obtaining a copy
; of this software and associated documentation files (the "Software"), to deal
; in the Software without restriction, including without limitation the rights
; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
; copies of the Software, and to permit persons to whom the Software is
; furnished to do so, subject to the following conditions:
; 
; The above copyright notice and this permission notice shall be included in all
; copies or substantial portions of the Software.
; 
; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
; SOFTWARE.
;--------------------------------------------------------------------------------------

#TURTLE_VERSION = 100

Interface TURTLE
  Line.i(*Function)
  Color.i(Color.l)
  Origin.i(X.l,Y.l,Center.b = #False)
  Start.i()
  Stop.i()
  Offset.i(X.d,Y.d)
  Reset.i()
  Length.i(Length.d)
  Angle.i(Angle.d)
  Left.i(Angle.d)
  Right.i(Angle.d)
  Target.i(X.d,Y.d)
  Move.i()
  Position.i(*X,*Y)
  Run.i(*Code,*X = 0,*Y = 0)
  Release.i()  
EndInterface

Prototype.i turtleLine(X1.d,Y1.d,X2.d,Y2.d,Color.l)

Structure TURTLE_POSITION_STRUCT
  x.d
  y.d
EndStructure

Structure TURTLE_STRUCT
  *vtable
  render.l
  color.l
  origin.TURTLE_POSITION_STRUCT
  start.TURTLE_POSITION_STRUCT
  stop.TURTLE_POSITION_STRUCT
  direction.d
  length.d
  *draw.turtleLine
EndStructure

#TURTLE_VERSION = 100

;--------------------------------------------------------------------------------------

ProcedureDLL.i turtleInterface(Version.i)
  Protected *turtle.TURTLE_STRUCT
  With *turtle
    If Version = #Null
      Version = #TURTLE_VERSION
    EndIf
    If Version = #TURTLE_VERSION
      *turtle = AllocateStructure(TURTLE_STRUCT)
      If *turtle
        \vtable = ?vtable
        \color = $FFFFFFFF
      EndIf
    EndIf
    ProcedureReturn *turtle
  EndWith
EndProcedure

;--------------------------------------------------------------------------------------

Procedure.i _turtleLine(*turtle.TURTLE_STRUCT,*Function)
  With *turtle
    \draw = *Function
    ProcedureReturn #Null
  EndWith
EndProcedure

Procedure.i turtleColor(*turtle.TURTLE_STRUCT,Color.l)
  With *turtle
    \color = Color
    ProcedureReturn #Null
  EndWith
EndProcedure

Procedure.i turtleOrigin(*turtle.TURTLE_STRUCT,X.l,Y.l,Center.b)
  With *turtle
    If Center
      \origin\x = X / 2.0
      \origin\y = Y / 2.0
    Else
      \origin\x = X
      \origin\y = Y
    EndIf
    \start = \origin
    ProcedureReturn #Null
  EndWith
EndProcedure

Procedure.i turtleStart(*turtle.TURTLE_STRUCT)
  With *turtle
    \render = #True
    ProcedureReturn #Null
  EndWith
EndProcedure

Procedure.i turtleStop(*turtle.TURTLE_STRUCT)
  With *turtle
    \render = #False
    ProcedureReturn #Null
  EndWith
EndProcedure

Procedure.i turtleOffset(*turtle.TURTLE_STRUCT,X.d,Y.d)
  With *turtle
    \start\x = X
    \start\y = Y
    ProcedureReturn #Null
  EndWith
EndProcedure

Procedure.i turtleReset(*turtle.TURTLE_STRUCT)
  With *turtle
    \start = \origin
    ProcedureReturn #Null
  EndWith
EndProcedure

Procedure.i turtleLength(*turtle.TURTLE_STRUCT,Length.d)
  With *turtle
    \length = Length
    ProcedureReturn #Null
  EndWith
EndProcedure

Procedure.i turtleAngle(*turtle.TURTLE_STRUCT,Angle.d)
  With *turtle
    \direction = Radian(Angle)
    ProcedureReturn #Null
  EndWith
EndProcedure

Procedure.i turtleLeft(*turtle.TURTLE_STRUCT,Angle.d)
  With *turtle
    \direction - Radian(Angle)
    ProcedureReturn #Null
  EndWith
EndProcedure

Procedure.i turtleRight(*turtle.TURTLE_STRUCT,Angle.d)
  With *turtle
    \direction + Radian(Angle)
    ProcedureReturn #Null
  EndWith
EndProcedure

Procedure.i turtleTarget(*turtle.TURTLE_STRUCT,X.d,Y.d)
  With *turtle
    \direction = ATan2((X - \start\x),(Y - \start\y))
    ProcedureReturn #Null
  EndWith
EndProcedure

Procedure.i turtleMove(*turtle.TURTLE_STRUCT)
  With *turtle
    \stop\x = \start\x + (Cos(\direction) * \length)
    \stop\y = \start\y + (Sin(\direction) * \length)
    If \render
      \draw(\start\x,\start\y,\stop\x,\stop\y,\color)
    EndIf
    \start = \stop
    ProcedureReturn #Null
  EndWith
EndProcedure

Procedure.i turtlePosition(*turtle.TURTLE_STRUCT,*X.Double,*Y.Double)
  With *turtle
    *X\d = \start\x
    *Y\d = \start\y
    ProcedureReturn #Null
  EndWith  
EndProcedure

Procedure.i turtleRun(*turtle.TURTLE_STRUCT,*Code.Ascii,*X.Double,*Y.Double)
  Protected.d x,y
  Protected.i offset,a,b,c,d
  Protected.Ascii *pos
  Protected.s parameter
  With *turtle
    While *Code\a
      offset = 0
      *pos = *Code + 2
      If *pos\a = '('
        Repeat
          *pos + 2
          If *pos\a = ','
            offset + 1
          EndIf
        Until *pos\a = ')'
      Else
        *pos = *Code
      EndIf
      Select *Code\a
        Case '$';Color
          If offset = 3
            parameter = PeekS(*Code + 4,((*pos - *Code) >> 1) - 2,#PB_Unicode)
            a = Val(StringField(parameter,1,","))
            b = Val(StringField(parameter,2,","))
            c = Val(StringField(parameter,3,","))
            d = Val(StringField(parameter,4,","))
            turtleColor(*turtle,RGBA(a,b,c,d))
          EndIf
        Case '*';Origin
          If offset = 2
            parameter = PeekS(*Code + 4,((*pos - *Code) >> 1) - 2,#PB_Unicode)
            x = ValD(StringField(parameter,1,","))
            y = ValD(StringField(parameter,2,","))
            a = Val(StringField(parameter,3,","))
            turtleOrigin(*turtle,x,y,a)
          EndIf
        Case '-';Start
          turtleStart(*turtle)
        Case '.';Stop
          turtleStop(*turtle)
        Case '#';Offset
          If offset = 1
            parameter = PeekS(*Code + 4,((*pos - *Code) >> 1) - 2,#PB_Unicode)
            x = ValD(StringField(parameter,1,","))
            y = ValD(StringField(parameter,2,","))
            turtleOffset(*turtle,x,y)
          EndIf
      Case '!';Reset
        turtleReset(*turtle)
      Case '_'
        If *Code <> *pos
          x = ValD(PeekS(*Code + 4,((*pos - *Code) >> 1) - 2,#PB_Unicode))
          turtleLength(*turtle,x)
        EndIf
      Case '~';Angle 
        If *Code <> *pos
          x = ValD(PeekS(*Code + 4,((*pos - *Code) >> 1) - 2,#PB_Unicode))
          turtleAngle(*turtle,x)
        EndIf
      Case '>';Right
        If *Code <> *pos
          x = ValD(PeekS(*Code + 4,((*pos - *Code) >> 1) - 2,#PB_Unicode))
          turtleRight(*turtle,x)
        EndIf
      Case '<';Left
        If *Code <> *pos
          x = ValD(PeekS(*Code + 4,((*pos - *Code) >> 1) - 2,#PB_Unicode))
          turtleLeft(*turtle,x)
        EndIf
      Case '@';Target
        If offset = 1
          parameter = PeekS(*Code + 4,((*pos - *Code) >> 1) - 2,#PB_Unicode)
          x = ValD(StringField(parameter,1,","))
          y = ValD(StringField(parameter,2,","))
          turtleTarget(*turtle,x,y)
        EndIf
      Case '+'
        turtleMove(*turtle)
      Case '?'
        *X\d = \start\x
        *Y\d = \start\y
    EndSelect
    *Code = *pos + 2
  Wend
  ProcedureReturn #Null
EndWith
EndProcedure

Procedure.i turtleRelease(*turtle.TURTLE_STRUCT)
  FreeStructure(*turtle)
  ProcedureReturn #Null
EndProcedure

;--------------------------------------------------------------------------------------

DataSection
  vtable:
  Data.i @_turtleLine()
  Data.i @turtleColor()
  Data.i @turtleOrigin() 
  Data.i @turtleStart()
  Data.i @turtleStop()
  Data.i @turtleOffset()
  Data.i @turtleReset()
  Data.i @turtleLength()
  Data.i @turtleAngle()
  Data.i @turtleLeft()
  Data.i @turtleRight()
  Data.i @turtleTarget()
  Data.i @turtleMove()
  Data.i @turtlePosition()
  Data.i @turtleRun()
  Data.i @turtleRelease()
EndDataSection
EnableExplicit

Procedure.i turtleLine(X1.d,Y1.d,X2.d,Y2.d,Color.l)
  ProcedureReturn LineXY(X1,Y1,X2,Y2,Color)
EndProcedure

Procedure.i turtleWindow(Title.s,*Turtle.TURTLE,Once.b,*Render,*Event = #Null)
  Protected.i task,exit
  If InitSprite() And *Render
    If OpenWindow(0,0,0,800,600,Title,#PB_Window_SystemMenu|#PB_Window_ScreenCentered)
      If OpenWindowedScreen(WindowID(0),0,0,WindowWidth(0),WindowHeight(0))
        SetFrameRate(60)
        If CreateSprite(0,WindowWidth(0),WindowHeight(0))
          *Turtle\Line(@turtleLine())
          *Turtle\Origin(WindowWidth(0),WindowHeight(0),#True)
          If Once
            If StartDrawing(SpriteOutput(0))
              DrawingMode(#PB_2DDrawing_AllChannels)
              CallFunctionFast(*Render,*Turtle)
              StopDrawing()
            EndIf
          EndIf
          Repeat
            Repeat
              task = WindowEvent()
              Select task
                Case #PB_Event_None
                  Break
                Case #PB_Event_CloseWindow
                  exit = #True
                Default
                  If *Event
                    CallFunctionFast(*Event,task)
                  EndIf
              EndSelect
            ForEver
            ClearScreen(0)
            If Once = #False
              If StartDrawing(SpriteOutput(0))
                DrawingMode(#PB_2DDrawing_AllChannels)
                CallFunctionFast(*Render,*Turtle)
                StopDrawing()
              EndIf
            EndIf
            DisplaySprite(0,0,0)
            FlipBuffers()
          Until exit
          FreeSprite(0)  
        EndIf
        CloseScreen()
      EndIf
      CloseWindow(0)  
    EndIf    
  EndIf
  ProcedureReturn #Null
EndProcedure

Procedure.i Render(*turtle.TURTLE)
  Protected.i x,y
  With *turtle
    \Offset(480,420)
    \Start()
    \Length(100)
    \Color(RGBA(255,60,60,255))
    For y = 1 To 20
      For x = 1 To 20
        \Right(125)
        \Move()
      Next
      \Left(20)
      \Move()
    Next
    ProcedureReturn #Null
  EndWith
EndProcedure

; Procedure.i Render(*turtle.TURTLE);<- string command version
;   Protected.i x,y
;   Protected.s c1,c2,c3
;   With *turtle
;     c1 = "#(520,158)-_(100)$(255,60,60,255)"
;     c2 = ">(30)+"
;     c3 = "<(20)+"
;     \Run(@c1)
;     For y = 1 To 20
;       For x = 1 To 20
;         \Run(@c2)
;       Next
;       \Run(@c3)
;     Next
;     ProcedureReturn #Null
;   EndWith
; EndProcedure

Procedure.i Main()
  Protected *turtle.TURTLE
  *turtle = turtleInterface(0)
  If *turtle
    turtleWindow("Turtle Graphics",*turtle,#True,@Render())
  EndIf
  *turtle\Release()
  ProcedureReturn #Null
EndProcedure

End Main()

[Mesa]

It works with pb x86 too + windows.

M.

[jacdelad]

Thanks for sharing, Mijikai. I give it 7 out of 7 stars.
Quick question: Is this method...efficient? Or is it designed to be as easy as possible?

[Mijikai]

Thanks for the replies.

Quick question: Is this method...efficient? Or is it designed to be as easy as possible?

In general both.
But im sure that the string command parser \Run() can be improved.
Direct calls to the library would be faster but i dont think that counts, it is neglectable (concepts like this are basically used everywhere nowdays).
Otherwise it is only dependent on the user supplied graphics backend including the line drawing function everything else is really simple.
Since the structure is exposed, direct access to it is easy to add (add TURTLE_STRUCT to turtle.pbi).

[Mijikai]

Updated the first post and added a Module version (with nice examples)
Have fun

[idle]

Updated the first post and added a Module version (with nice examples)
Have fun

you have always been a superstar

[skywalk]

Thanks for the post.
Can you explain pros and cons vs vector lib?
Does turtle support antialiased lines and text?

[Mijikai]

@idle Im just a average nerd, looking up to the true heros in the PB community.

Can you explain pros and cons vs vector lib?
Does turtle support antialiased lines and text?

The turtle library provides simple functions to generate shapes (using straight line segments) defined by points on a plane.
These shapes are often reused to generate even more complex shapes (nice for fractals).

Short answer: The visual quality depends on the line drawing function supplied by the user, and its implementation.
The turtle library itself has no drawing function, the user provides the line drawing method with a function pointer.
There is a helper Include (turtle_output.pbi) that shows how it could be done (using a windowed screen and PBs 2D drawing commands).
Later I added a module version of the turtle which is a more direct ready to use option that incoporates turtle_output.pbi for easy experimenting.

[Mijikai]

Update 1.01:
- added file handling and improved some aspects of the library, includes and examples

The TGCF TutleGraphicsCommandFile ".tgcf" Format:

Code: Select all

Structure TURTLE_HEADER_STRUCT
  magic.l       ;<- the magic number 'tgfc'
  width.l       ;<- the output width (what should be used to display the commands)
  height.l      ;<- the output height
  title.a[64]   ;<- custom text (ascii)
  bytes.q       ;<- command byte size unpacked
  packed.q      ;<- command byte size packed
EndStructure

;After the structure the unpacked (ascii) or packed (LZMA) command data follows!

Once a file is loaded the the user gets access to a TURTLE_FILE structure:

Code: Select all

Structure TURTLE_FILE;<- a pointer to this structure is returned by load & catch
  title.s       ;<- the description
  width.l       ;<- output width
  height.l      ;<- output height
  length.i      ;<- amount of charachters in commands
  commands.s    ;<- all commands as single string
EndStructure

Example that shows file handling with the library (load & save):

Code: Select all

EnableExplicit

XIncludeFile "turtle.pbi"
XIncludeFile "turtle_output.pbi"

Procedure.i Render(*t.turtle,*f.TURTLE_FILE);<- draw it from file
  *t\Run(@*f\commands)
  ProcedureReturn #Null
EndProcedure

Procedure.i Save(*t.TURTLE);<- how to save a creation
  Protected.i x,y
  Protected.s c
  c = "#(440,300)_(160)-"
  For y = 1 To 18
    For x = 1 To 4
      c + ">(80)+"
    Next
    c + "<(100)"
  Next
  ProcedureReturn *t\Save("testfile",#False,"Check this out! by Somebody",800,600,@c)
EndProcedure

Procedure.i Main()
  Protected *t.TURTLE
  Protected *f.TURTLE_FILE
  *t = turtleInterface()
  If *t
    If Save(*t);<- saves it (only works if the file does not already exist!)
      *f = *t\Load("testfile");<- loads it
      If *f
        turtleWindow(*t,"Turtle Graphics: " + *f\title,*f\width,*f\height,#True,@Render(),*f)
        *t\Free(*f)
      EndIf
    EndIf
    *t\Release()
  EndIf
  ProcedureReturn #Null
EndProcedure

End Main()

Example that shows file handling with the library (catch):

Code: Select all

EnableExplicit

XIncludeFile "turtle.pbi"
XIncludeFile "turtle_output.pbi"

Procedure.i Render(*t.TURTLE,*f.TURTLE_FILE)
  *t\Run(@*f\commands)
  ProcedureReturn #Null
EndProcedure

Procedure.i Main()
  Protected.TURTLE *t
  Protected.TURTLE_FILE *f
  *t = turtleInterface()
  If *t
    *f = *t\Catch(?file)
    If *f
      turtleWindow(*t,"Turtle Graphics: " + *f\title,*f\width,*f\height,#True,@Render(),*f)  
      *t\Free(*f)
    EndIf
    *t\Release()
  EndIf
  ProcedureReturn #Null
EndProcedure

End Main()

DataSection
  file:
  Data.a $74,$67,$63,$73,$20,$03,$00,$00,$58,$02,$00,$00,$53,$74,$61,$72
  Data.a $2D,$53,$61,$77,$20,$62,$79,$20,$4D,$69,$6A,$69,$6B,$61,$69,$00
  Data.a $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00
  Data.a $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00
  Data.a $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$4E,$02,$00,$00
  Data.a $00,$00,$00,$00,$38,$00,$00,$00,$00,$00,$00,$00,$5D,$00,$00,$00
  Data.a $04,$00,$11,$8A,$02,$ED,$B3,$3E,$42,$CF,$A2,$B4,$7F,$0B,$78,$BC
  Data.a $95,$79,$22,$F0,$6A,$77,$39,$30,$B0,$28,$BC,$7D,$0D,$21,$D8,$10
  Data.a $81,$01,$0F,$B6,$6E,$12,$3E,$73,$E8,$86,$D8,$25,$D5,$8D,$8A,$FF
  Data.a $91,$87,$40,$00,$00
EndDataSection

Here is a exampe with the module version (catch):

Code: Select all

EnableExplicit

XIncludeFile "turtle_module.pbi"

Procedure.i Render(*t.turtle::TURTLE,*f.turtle::TURTLE_FILE)
  *t\Run(@*f\commands)
  ProcedureReturn #Null
EndProcedure

Procedure.i Main()
  Protected.turtle::TURTLE *t
  Protected.turtle::TURTLE_FILE *f
  *t = turtle::Create()
  If *t
    *f = *t\Catch(?file)
    If *f
      turtle::Window(*t,"Turtle Graphics: " + *f\title,*f\width,*f\height,#True,@Render(),*f)  
      *t\Free(*f)
    EndIf
    *t\Release()
  EndIf
  ProcedureReturn #Null
EndProcedure

End Main()

DataSection
  file:
  Data.a $74,$67,$63,$73,$20,$03,$00,$00,$58,$02,$00,$00,$53,$74,$61,$72
  Data.a $2D,$53,$61,$77,$20,$62,$79,$20,$4D,$69,$6A,$69,$6B,$61,$69,$00
  Data.a $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00
  Data.a $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00
  Data.a $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$4E,$02,$00,$00
  Data.a $00,$00,$00,$00,$38,$00,$00,$00,$00,$00,$00,$00,$5D,$00,$00,$00
  Data.a $04,$00,$11,$8A,$02,$ED,$B3,$3E,$42,$CF,$A2,$B4,$7F,$0B,$78,$BC
  Data.a $95,$79,$22,$F0,$6A,$77,$39,$30,$B0,$28,$BC,$7D,$0D,$21,$D8,$10
  Data.a $81,$01,$0F,$B6,$6E,$12,$3E,$73,$E8,$86,$D8,$25,$D5,$8D,$8A,$FF
  Data.a $91,$87,$40,$00,$00
EndDataSection