Announcement

Collapse
No announcement yet.

Turtle geometry for PBCC graphics

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • Turtle geometry for PBCC graphics

    There must be some free PB programs on genuine turtle geometry, but I haven't run across them. Post them here if you'd like to, & also post any corrections, additions or suggestions you wish for this PBCC freebie.

    Code:
    'Turtle5.BAS
    'FREEWARE; donated to Public Domain
    'by E.W. Menzel, Jr aka Emil Menzel
    'original QB version circa 1990
    'revised for PBCC 4.04, May 2008
    'based mostly on Abelson & diSessa, Turtle geometry, MIT Press, 1986
    '   but many of the PBCC routines are borrowed from various authors on the PB forums.
    'See Chris Boss's EZGUI website for a much fancier commercial PBWin .DLL
    '       version of a "turtle-like" graphics: http://cwsof.com/
    'See Abelson & diSessa for the full mathematical power of turtle geometry
    'For a good intro to turtle geometry on the Web see Brian Harvey's book: 
    '    http://www.cs.berkeley.edu/~bh/pdf/v1ch10.pdf
    
    #DIM ALL
    
    'WinAPI is used here only for function Keystat, & to hide the console
    'Keystat is like INSTAT but it works on both Console & Graphics screens
    #INCLUDE "Win32Api.Inc"
    DECLARE FUNCTION KeyStat() AS LONG
    
    'turtle primitive basic commands
    'NOTE: SUB tPBCPlotter & tCLEARSCREEN are the only turtle primitives that use PBCC GRAPHICs commands
    DECLARE SUB tBack (B1 AS SINGLE)    'Go backward B1 units
    DECLARE SUB tCLEARSCREEN ()          'clear window; center the pen;
                                         'set pendown to draw, & reset H angle to zero
    DECLARE SUB tLEFT (L1 AS SINGLE)     'turn left L1 degrees, angle
    DECLARE SUB tRIGHT (R1 AS SINGLE)    'turn right R1 degrees, angle
    DECLARE SUB tFORWARD (Distance AS SINGLE)  'move N units forward
    DECLARE SUB tPBCCPlotter()           'draw the move on screen
    DECLARE SUB tPENDOWN ()              'set pen to draw
    DECLARE SUB tPENUP ()                'set pen to move but not draw
    
    'other, more complex turtle programs, included mostly as demos
    DECLARE SUB Brownian(Numsteps AS SINGLE, StepSize AS SINGLE)
    DECLARE SUB Circa (NumSteps AS SINGLE, TurnSize AS SINGLE, StepSize AS SINGLE)
    DECLARE SUB ManyCircles()
    DECLARE SUB Polyspi (Angle AS SINGLE, Side AS SINGLE, Repeats AS QUAD)
    DECLARE SUB Hilbert (hSIZE AS SINGLE, Level AS SINGLE, hPARITY AS SINGLE) 'parity -90=Left, 90=right
    
    
    
    TYPE TurtleType
       H AS SINGLE     'heading angle of turtle, in degrees
       PS AS SINGLE    'PenStatus down (to draw) or up (move but don't draw)
       PX AS SINGLE    'present location, X axis
       PY AS SINGLE
       NX AS SINGLE    'new location, X axis
       NY AS SINGLE
       CX AS SINGLE    'constant for converting degrees to rads
       Colour AS LONG  'foreground color for draw
       Background AS LONG 'background color
       WIDTH AS SINGLE  'pen width in pixels
    
       PAUSE AS SINGLE  'millisec SLEEP after EACH pen move+draw (in sub tFORWARD)
                        'zero sleep is OK
    END TYPE
    GLOBAL turtle AS TurtleType
    GLOBAL wx1,wx2,wy1,wy2 AS LONG
    
    
    FUNCTION PBMAIN() AS LONG     '
        RANDOMIZE TIMER
        'hide the console screen ... uses win32api.inc
        LOCAL hConsole AS LONG
        hConsole = CONSHNDL
        ShowWindow hConsole, %SW_Hide 'turn off the console
        '''ShowWindow hConsole, %SW_Show 'if you want to turn it back on.
    
       LOCAL hBmpSource,hBmpNew AS DWORD
    
       turtle.CX = 3.14159 / 180 ' constant, used for converting deg to rad
       wx1=100: wy1=100  'top-left pos of graphics window, on screen
       wx2=400: wy2=400  'width & height of graphics window
    
       GRAPHIC WINDOW "Turtle",wx1,wy1,wx2,wy2 TO hBmpSource
       GRAPHIC ATTACH hBmpSource, 0
    
       'demo 1 -- Hilbert
       turtle.Colour = 0  ' color of lines... See SUB PBCCPlotter for color values
       turtle.Background = RGB(255,255,255) 'background color... See SUB PBCCPlotter
       tCLEARSCREEN  'sets PX, PY to center & sets penDown, in turtle.Background color
       turtle.WIDTH = 5  'width of lines
       turtle.PX=10: turtle.PY=30
       GRAPHIC SET POS (turtle.PX,turtle.PY)
       turtle.PAUSE = 20  'millisec of sleep after each pen move+draw
       CALL Hilbert(10, 5, 90)
       GRAPHIC SET POS (wx1+20, 10)
       GRAPHIC COLOR RGB(255,255,255),RGB(0,0,0)
       GRAPHIC PRINT "SUB Hilbert done... SUB Polyspi will be next"
       IF Keystat = 0 THEN SLEEP 5000
    
       'demo 2 -- Polyspi... try it with different parameters too!
       turtle.Background=0 'set new background color
       CALL tCLEARSCREEN
       turtle.PAUSE = 5  'sleep after each pen move+draw
       turtle.width=3
       CALL Polyspi(183, 1, 1000) 'last variable is "Repeats"
       turtle.Colour=%WHITE
       GRAPHIC SET POS (wx1+10, wy1+10)
       GRAPHIC COLOR RGB(255,255,255), RGB(0,0,0)
       GRAPHIC PRINT "SUB Polyspi done... SUB ManyCircles will be next"
       SLEEP 5000
    
      'demo 3 -- many circles... with SUB Circa you can also draw partial circles
       CALL tCLEARSCREEN
       '''turtle.WIDTH=10
       turtle.PAUSE=0
       GRAPHIC SET POS (wx1+10, wy2-20)
       GRAPHIC COLOR RGB(255,255,255), RGB(0,0,0)
       GRAPHIC PRINT "SUB ManyCircles"
       CALL ManyCircles
       IF Keystat = 0 THEN SLEEP 5000
    
       'demo 4 -- Brownian motion
       turtle.Colour = 15
       turtle.Background = %BLACK
       CALL tCLEARSCREEN
       turtle.WIDTH=1
       turtle.PAUSE=10
       GRAPHIC SET POS (10, 20)
       GRAPHIC COLOR RGB(255,255,255), RGB(0,0,0)
       GRAPHIC PRINT "Brownian motion "
       CALL Brownian(1000, 5)  'numsteps, stepsize
       GRAPHIC SET POS (10, 40)
       GRAPHIC COLOR RGB(255,255,255), RGB(0,0,0)
       GRAPHIC PRINT "All done "
    
       SLEEP 5000
    
    
       GRAPHIC WINDOW END
    END FUNCTION
    
    SUB tBack (B1 AS SINGLE) STATIC
       turtle.H = turtle.H + 180
       IF turtle.H > 360 THEN turtle.H = turtle.H - 360
       CALL  tFORWARD(B1)
       'might need fixing
    END SUB
    
    SUB tCLEARSCREEN STATIC
        turtle.PX = wx2/2  'center of window
        turtle.PY = wy2/2  'center of window
        turtle.H = 0       'angle turtle is now headed
        tPENDOWN
        GRAPHIC CLEAR turtle.Background   'clear graphic window
        GRAPHIC SET POS (turtle.PX, turtle.PY)
        GRAPHIC REDRAW
    END SUB
    
    SUB tFORWARD (F1 AS SINGLE) STATIC
          LOCAL HX,HY AS SINGLE
          'angle must be converted to rads, in BASIC
          HX = COS(turtle.H * turtle.CX)
          HY = SIN(turtle.H * turtle.CX)
          'translate angle & dist to Cartesian X,Y position
          turtle.NX = turtle.PX + HX * F1
          turtle.NY = turtle.PY + HY * F1
    
          IF ISTRUE turtle.PS THEN   'If Pen is down or set to draw
              CALL tPBCCPlotter
          END IF
          turtle.PX = turtle.NX
          turtle.PY = turtle.NY
    END SUB
    
    
    SUB tPBCCPlotter STATIC
           LOCAL again AS LONG
    
           IF NOT again THEN
               again=-1
               DIM ColorVal(15) AS LOCAL LONG
               'see PBCC Manual; some Colors are probably wrong
               ColorVal(0)=RGB(0,0,0) '%BLACK
               ColorVal(1)=RGB(0,0,255) '%BLUE
               ColorVal(2)=%GREEN
               ColorVal(3)=%CYAN
               ColorVal(4)=RGB(255,0,0)    '%red
               ColorVal(5)=%MAGENTA
               ColorVal(6)=RGB(255,255,0)          'brown?
               ColorVal(7)=%WHITE
               ColorVal(8)=%GRAY
               ColorVal(9)=%BLUE/2    'light blue?
               ColorVal(10)=%GREEN/2  'light green?
               ColorVal(11)=%CYAN/2   'light cyan?
               ColorVal(12)=%RED/2    'light red?
               ColorVal(13)=%MAGENTA/2 'light magenta?
               ColorVal(14)=%YELLOW
               ColorVal(15)=RGB(255,255,255)  'high intensity WHITE
           END IF
    
    
           'avoid going out of bounds on the Colorval array
           IF turtle.Colour <0 OR turtle.Colour> 15 THEN
               turtle.Colour = RND(0,15)
           END IF
           'note that ColorVal() is NOT used for background
    
           GRAPHIC COLOR ColorVal(turtle.Colour), turtle.Background
           GRAPHIC WIDTH turtle.WIDTH
           GRAPHIC LINE (turtle.PX,turtle.PY)-(turtle.NX, turtle.NY)
           GRAPHIC REDRAW
           SLEEP turtle.PAUSE
    END SUB
    
    
    SUB tLEFT (L1 AS SINGLE) STATIC
        turtle.H = turtle.H + L1
        IF turtle.H > 360 THEN turtle.H = turtle.H - 360
    END SUB
    
    SUB tPENDOWN STATIC
       turtle.PS = -1
    END SUB
    
    SUB tPENUP STATIC
       turtle.PS = 0
    END SUB
    
    SUB tRIGHT (R1 AS SINGLE) STATIC
       turtle.H = turtle.H - R1
       IF turtle.H < 0 THEN turtle.H = turtle.H + 360
    END SUB
    
    'end of Turtle basics
    
    'Now, a few Turtle demos, plus Keystat to check for keypress or mouse click
    
    SUB Brownian(Numsteps AS SINGLE, StepSize AS SINGLE)
       LOCAL I AS QUAD, kee AS INTEGER
       FOR I=1 TO Numsteps
          turtle.H= turtle.H + RND(1,360)
          IF turtle.H > 360 THEN turtle.H = turtle.H - 360
          kee=Keystat
          CALL tFORWARD(StepSize)
          IF kee THEN EXIT SUB
       NEXT
    END SUB
    
    
    SUB Circa (NumSteps AS SINGLE, TurnSize AS SINGLE, StepSize AS SINGLE)
        LOCAL I AS LONG
        'start walking in a circle
        IF NumSteps THEN
          FOR I = 1 TO NumSteps
            tRIGHT TurnSize
            tFORWARD StepSize
          NEXT
        END IF
    END SUB
    
    SUB ManyCircles
       LOCAL I, J AS SINGLE
       LOCAL x,y AS SINGLE
       x=turtle.PX: y=turtle.PY
       turtle.Colour=0
       FOR I = 1 TO .2 STEP -.05
          FOR J = 1 TO .2 STEP -.1
             turtle.Colour = turtle.Colour + 1
             IF turtle.Colour > 15 THEN turtle.Colour = 1
             turtle.PX = x
             turtle.PY = y
             turtle.H = 0
             turtle.Width = RND (3,10)
             CALL Circa (1000, I, J)
             IF Keystat THEN EXIT SUB
          NEXT
       NEXT
    END SUB
    
    
    ' A "space-filling algorithm" from Abelson & diSessa, Turtle geometry, p. 98
    SUB Hilbert (hSIZE AS SINGLE, Level AS SINGLE, hPARITY AS SINGLE)
      IF hPARITY <> 90 THEN hPARITY = -90   'right or left only
      IF Level = 0 THEN EXIT SUB
      IF Keystat THEN EXIT SUB   'quit if user presses key
    
       tLEFT hPARITY
       Hilbert hSIZE, Level - 1, -hPARITY
       tFORWARD hSIZE
       tRIGHT hPARITY
       Hilbert hSIZE, Level - 1, hPARITY
       tFORWARD hSIZE
       Hilbert hSIZE, Level - 1, hPARITY
       tRIGHT hPARITY
       tFORWARD hSIZE
       Hilbert hSIZE, Level - 1, -hPARITY
       tLEFT hPARITY
    END SUB
    
    'INSTAT does not work on a graphics window.
    'KeyStat does -- albeit the returned keycodes are not all the same as INKEY$.
    FUNCTION keyStat() AS LONG
        LOCAL I,ks AS LONG
        DIM kb(255) AS STATIC BYTE
        GetKeyBoardState kb(0)   'win api
        FOR I=0 TO 255           'or .. ASC("A") to ASC("Z")
            ks=GetKeyState(I)    'win api
            IF ks<0 THEN EXIT FOR
        NEXT
        '''SLEEP 50           'watch out! fast-repeating keys
        IF I>255 THEN I=0
        FUNCTION=I
    END FUNCTION
    
    SUB Poly (A AS SINGLE, D AS SINGLE) STATIC
       LOCAL Turn AS SINGLE
       TURN = 0
       DO
          tFORWARD D
          tLEFT A
          TURN = TURN + A
       LOOP UNTIL (TURN MOD 360) = 0
    END SUB
    
    SUB Polyspi (Angle AS SINGLE, Side AS SINGLE, Repeats AS QUAD) STATIC
       LOCAL keypress, colour AS INTEGER
       LOCAL rp AS QUAD
       colour=turtle.Colour
       rp=0
    
       DO
          turtle.colour = RND(0,15)
          tFORWARD Side
          tLEFT Angle
          INCR Side
          INCR rp
          keypress= Keystat
       LOOP UNTIL rp>=Repeats OR keypress
       turtle.Colour = colour  'restore original
    END SUB
    Last edited by Emil Menzel; 6 May 2008, 08:44 PM. Reason: error correction

  • #2
    This web site easily beats my program. Its demos are not written in PB, but they easily could be.

    http://www.psinvention.com/Turtle.htm

    Comment


    • #3
      Hi Emil,

      very nice code!
      Here is conversion of my thinBASIC OpenGL code to PB/WIN 8.04 ( PBCC possibly too ), producing Sierpniski triangle via L-system. For rendering it uses your turtle engine.


      Petr

      Code:
      'Turtle5.BAS
      'FREEWARE; donated to Public Domain
      'by E.W. Menzel, Jr aka Emil Menzel
      'original QB version circa 1990
      'revised for PBCC 4.04, May 2008
      'based mostly on Abelson & diSessa, Turtle geometry, MIT Press, 1986
      '   but many of the PBCC routines are borrowed from various authors on the PB forums.
      'See Chris Boss's EZGUI website for a much fancier commercial PBWin .DLL
      '       version of a "turtle-like" graphics: http://cwsof.com/
      'See Abelson & diSessa for the full mathematical power of turtle geometry
      'For a good intro to turtle geometry on the Web see Brian Harvey's book:
      '    http://www.cs.berkeley.edu/~bh/pdf/v1ch10.pdf
      ' -- Sierpinski triangle rendering by Petr Schreiber ( conversion from thinBASIC original )
      ' [+] -- more info on Sierpinski triangle: http://en.wikipedia.org/wiki/Sierpinski_triangle
      ' [+] -- more info on L systems: http://en.wikipedia.org/wiki/L-system#Example_6:_Sierpi.C5.84ski_triangle
      
      #DIM ALL
      
      'WinAPI is used here only for function Keystat, & to hide the console
      'Keystat is like INSTAT but it works on both Console & Graphics screens
      #INCLUDE "Win32Api.Inc"
      DECLARE FUNCTION KEYSTAT() AS LONG
      
      'turtle primitive basic commands
      'NOTE: SUB tPBCPlotter & tCLEARSCREEN are the only turtle primitives that use PBCC GRAPHICs commands
      DECLARE SUB tBack (B1 AS SINGLE)    'Go backward B1 units
      DECLARE SUB tCLEARSCREEN ()          'clear window; center the pen;
                                           'set pendown to draw, & reset H angle to zero
      DECLARE SUB tLEFT (L1 AS SINGLE)     'turn left L1 degrees, angle
      DECLARE SUB tRIGHT (R1 AS SINGLE)    'turn right R1 degrees, angle
      DECLARE SUB tFORWARD (Distance AS SINGLE)  'move N units forward
      DECLARE SUB tPBCCPlotter()           'draw the move on screen
      DECLARE SUB tPENDOWN ()              'set pen to draw
      DECLARE SUB tPENUP ()                'set pen to move but not draw
      
      'other, more complex turtle programs, included mostly as demos
      DECLARE SUB Brownian(Numsteps AS SINGLE, StepSize AS SINGLE)
      DECLARE SUB Circa (NumSteps AS SINGLE, TurnSize AS SINGLE, StepSize AS SINGLE)
      DECLARE SUB ManyCircles()
      DECLARE SUB Polyspi (Angle AS SINGLE, Side AS SINGLE, Repeats AS QUAD)
      DECLARE SUB Hilbert (hSIZE AS SINGLE, Level AS SINGLE, hPARITY AS SINGLE) 'parity -90=Left, 90=right
      
      
      
      TYPE TurtleType
         H AS SINGLE     'heading angle of turtle, in degrees
         PS AS SINGLE    'PenStatus down (to draw) or up (move but don't draw)
         PX AS SINGLE    'present location, X axis
         PY AS SINGLE
         NX AS SINGLE    'new location, X axis
         NY AS SINGLE
         CX AS SINGLE    'constant for converting degrees to rads
         Colour AS LONG  'foreground color for draw
         Background AS LONG 'background color
         WIDTH AS SINGLE  'pen width in pixels
      
         PAUSE AS SINGLE  'millisec SLEEP after EACH pen move+draw (in sub tFORWARD)
                          'zero sleep is OK
      END TYPE
      GLOBAL turtle AS TurtleType
      GLOBAL wx1,wx2,wy1,wy2 AS LONG
      
      
      FUNCTION PBMAIN() AS LONG     '
          RANDOMIZE TIMER
          'hide the console screen ... uses win32api.inc
      
          '''ShowWindow hConsole, %SW_Show 'if you want to turn it back on.
      
         LOCAL hBmpSource,hBmpNew AS DWORD
      
         turtle.CX = 3.14159 / 180 ' constant, used for converting deg to rad
         wx1=100: wy1=100  'top-left pos of graphics window, on screen
         wx2=400: wy2=400  'width & height of graphics window
      
         GRAPHIC WINDOW "Turtle",wx1,wy1,wx2,wy2 TO hBmpSource
         GRAPHIC ATTACH hBmpSource, 0
      
         'demo 1 -- Hilbert
         turtle.Colour = 0  ' color of lines... See SUB PBCCPlotter for color values
         turtle.Background = RGB(255,255,255) 'background color... See SUB PBCCPlotter
         tCLEARSCREEN  'sets PX, PY to center & sets penDown, in turtle.Background color
         turtle.WIDTH = 1  'width of lines
         turtle.PX=10: turtle.PY=30
         GRAPHIC SET POS (turtle.PX,turtle.PY)
         turtle.PAUSE = 1  'millisec of sleep after each pen move+draw
      
         ' -- L-System will have 2 variables
         CALL LSystem_Init(2)
      
         ' -- ... A and B
         CALL LSystem_FillPair(1, "A", "B-A-B")
         CALL LSystem_FillPair(2, "B", "A+B+A")
      
         ' -- Solve L-System in determined iterations, store result to display list 1
         CALL LSystem_Solve("A", 7)
      
      
      
         GRAPHIC SET POS (wx1+20, 10)
         GRAPHIC COLOR RGB(255,255,255),RGB(0,0,0)
         GRAPHIC PRINT "Sierpinski triangle... upside down :)"
         
         SLEEP 5000
      
      
         GRAPHIC WINDOW END
      END FUNCTION
      
      SUB tBack (B1 AS SINGLE) STATIC
         turtle.H = turtle.H + 180
         IF turtle.H > 360 THEN turtle.H = turtle.H - 360
         CALL  tFORWARD(B1)
         'might need fixing
      END SUB
      
      SUB tCLEARSCREEN STATIC
          turtle.PX = wx2/2  'center of window
          turtle.PY = wy2/2  'center of window
          turtle.H = 0       'angle turtle is now headed
          tPENDOWN
          GRAPHIC CLEAR turtle.Background   'clear graphic window
          GRAPHIC SET POS (turtle.PX, turtle.PY)
          GRAPHIC REDRAW
      END SUB
      
      SUB tFORWARD (F1 AS SINGLE) STATIC
            LOCAL HX,HY AS SINGLE
            'angle must be converted to rads, in BASIC
            HX = COS(turtle.H * turtle.CX)
            HY = SIN(turtle.H * turtle.CX)
            'translate angle & dist to Cartesian X,Y position
            turtle.NX = turtle.PX + HX * F1
            turtle.NY = turtle.PY + HY * F1
      
            IF ISTRUE turtle.PS THEN   'If Pen is down or set to draw
                CALL tPBCCPlotter
            END IF
            turtle.PX = turtle.NX
            turtle.PY = turtle.NY
      END SUB
      
      
      SUB tPBCCPlotter STATIC
             LOCAL again AS LONG
      
             IF NOT again THEN
                 again=-1
                 DIM ColorVal(15) AS LOCAL LONG
                 'see PBCC Manual; some Colors are probably wrong
                 ColorVal(0)=RGB(0,0,0) '%BLACK
                 ColorVal(1)=RGB(0,0,255) '%BLUE
                 ColorVal(2)=%GREEN
                 ColorVal(3)=%CYAN
                 ColorVal(4)=RGB(255,0,0)    '%red
                 ColorVal(5)=%MAGENTA
                 ColorVal(6)=RGB(255,255,0)          'brown?
                 ColorVal(7)=%WHITE
                 ColorVal(8)=%GRAY
                 ColorVal(9)=%BLUE/2    'light blue?
                 ColorVal(10)=%GREEN/2  'light green?
                 ColorVal(11)=%CYAN/2   'light cyan?
                 ColorVal(12)=%RED/2    'light red?
                 ColorVal(13)=%MAGENTA/2 'light magenta?
                 ColorVal(14)=%YELLOW
                 ColorVal(15)=RGB(255,255,255)  'high intensity WHITE
             END IF
      
      
             'avoid going out of bounds on the Colorval array
             IF turtle.Colour <0 OR turtle.Colour> 15 THEN
                 turtle.Colour = RND(0,15)
             END IF
             'note that ColorVal() is NOT used for background
      
             GRAPHIC COLOR ColorVal(turtle.Colour), turtle.Background
             GRAPHIC WIDTH turtle.WIDTH
             GRAPHIC LINE (turtle.PX,turtle.PY)-(turtle.NX, turtle.NY)
             GRAPHIC REDRAW
             SLEEP turtle.PAUSE
      END SUB
      
      
      SUB tLEFT (L1 AS SINGLE) STATIC
          turtle.H = turtle.H + L1
          IF turtle.H > 360 THEN turtle.H = turtle.H - 360
      END SUB
      
      SUB tPENDOWN STATIC
         turtle.PS = -1
      END SUB
      
      SUB tPENUP STATIC
         turtle.PS = 0
      END SUB
      
      SUB tRIGHT (R1 AS SINGLE) STATIC
         turtle.H = turtle.H - R1
         IF turtle.H < 0 THEN turtle.H = turtle.H + 360
      END SUB
      
      'end of Turtle basics
      
      'Now, a few Turtle demos, plus Keystat to check for keypress or mouse click
      
      SUB Brownian(Numsteps AS SINGLE, StepSize AS SINGLE)
         LOCAL I AS QUAD, kee AS INTEGER
         FOR I=1 TO Numsteps
            turtle.H= turtle.H + RND(1,360)
            IF turtle.H > 360 THEN turtle.H = turtle.H - 360
            kee=Keystat
            CALL tFORWARD(StepSize)
            IF kee THEN EXIT SUB
         NEXT
      END SUB
      
      
      SUB Circa (NumSteps AS SINGLE, TurnSize AS SINGLE, StepSize AS SINGLE)
          LOCAL I AS LONG
          'start walking in a circle
          IF NumSteps THEN
            FOR I = 1 TO NumSteps
              tRIGHT TurnSize
              tFORWARD StepSize
            NEXT
          END IF
      END SUB
      
      SUB ManyCircles
         LOCAL I, J AS SINGLE
         LOCAL x,y AS SINGLE
         x=turtle.PX: y=turtle.PY
         turtle.Colour=0
         FOR I = 1 TO .2 STEP -.05
            FOR J = 1 TO .2 STEP -.1
               turtle.Colour = turtle.Colour + 1
               IF turtle.Colour > 15 THEN turtle.Colour = 1
               turtle.PX = x
               turtle.PY = y
               turtle.H = 0
               turtle.Width = RND (3,10)
               CALL Circa (1000, I, J)
               IF KEYSTAT THEN EXIT SUB
            NEXT
         NEXT
      END SUB
      
      
      ' A "space-filling algorithm" from Abelson & diSessa, Turtle geometry, p. 98
      SUB Hilbert (hSIZE AS SINGLE, Level AS SINGLE, hPARITY AS SINGLE)
        IF hPARITY <> 90 THEN hPARITY = -90   'right or left only
        IF Level = 0 THEN EXIT SUB
        IF KEYSTAT THEN EXIT SUB   'quit if user presses key
      
         tLEFT hPARITY
         Hilbert hSIZE, Level - 1, -hPARITY
         tFORWARD hSIZE
         tRIGHT hPARITY
         Hilbert hSIZE, Level - 1, hPARITY
         tFORWARD hSIZE
         Hilbert hSIZE, Level - 1, hPARITY
         tRIGHT hPARITY
         tFORWARD hSIZE
         Hilbert hSIZE, Level - 1, -hPARITY
         tLEFT hPARITY
      END SUB
      
      'INSTAT does not work on a graphics window.
      'KeyStat does -- albeit the returned keycodes are not all the same as INKEY$.
      FUNCTION KEYSTAT() AS LONG
          LOCAL I,ks AS LONG
          DIM kb(255) AS STATIC BYTE
          GetKeyBoardState kb(0)   'win api
          FOR I=0 TO 255           'or .. ASC("A") to ASC("Z")
              ks=GetKeyState(I)    'win api
              IF ks<0 THEN EXIT FOR
          NEXT
          '''SLEEP 50           'watch out! fast-repeating keys
          IF I>255 THEN I=0
          FUNCTION=I
      END FUNCTION
      
      SUB Poly (A AS SINGLE, D AS SINGLE) STATIC
         LOCAL Turn AS SINGLE
         TURN = 0
         DO
            tFORWARD D
            tLEFT A
            TURN = TURN + A
         LOOP UNTIL (TURN MOD 360) = 0
      END SUB
      
      SUB Polyspi (Angle AS SINGLE, Side AS SINGLE, Repeats AS QUAD) STATIC
         LOCAL keypress, colour AS INTEGER
         LOCAL rp AS QUAD
         colour=turtle.Colour
         rp=0
      
         DO
            turtle.colour = RND(0,15)
            tFORWARD Side
            tLEFT Angle
            INCR Side
            INCR rp
            keypress= KEYSTAT
         LOOP UNTIL rp>=Repeats OR keypress
         turtle.Colour = colour  'restore original
      END SUB
      
      
      ' ------------------------------------------------------------------
      ' -- Auxiliary L-System functions ( could be optimized even more) --
      ' ------------------------------------------------------------------
      
      TYPE tReplace
        symbol AS STRING * 1      ' -- Symbol to replace
        changesTo AS STRING * 255 ' -- With what replace ( dynamic string would be better here )
      END TYPE
      
      SUB LSystem_Init( VariablesNum AS LONG )
      
        ' -- Storage for table of what replace with what
        DIM LSystem_Table(VariablesNum) AS GLOBAL tReplace
        GLOBAL LSystem_Solution AS STRING
      
      END SUB
      
      SUB LSystem_FillPair( id AS LONG, source AS STRING, destination AS STRING )
      
        LSystem_Table(id).symbol        = source
        LSystem_Table(id).changesTo     = destination
      
      END SUB
      
      SUB LSystem_Solve( recipe AS STRING, iterations AS LONG )
      
        ' i = iterator, s = symbol, n = nth character
        LOCAL i, s, n AS LONG
        LOCAL char AS STRING
      
        LSystem_Solution = recipe
      
        FOR i = 1 TO iterations
          FOR s = 1 TO UBOUND(LSystem_Table)          ' -- For each symbol/variable
      
            n = 0
            WHILE n <= LEN(LSystem_Solution)
      
              INCR n
              char = MID$(LSystem_Solution, n, 1)
      
              IF char = "(" THEN                      ' -- Already replaced by other symbol
                n = INSTR(n, LSystem_Solution, ")")   ' -- Seek where it ends
                IF n = LEN(LSystem_Solution) THEN
                  EXIT LOOP                           ' -- Last character
                ELSE
                  ITERATE LOOP                        ' -- Not last, journey continues
                END IF
              END IF
      
              ' -- We found a match for symbol, lets "replace" it
              IF char = LSystem_Table(s).symbol THEN
      
                LSystem_Solution = STRDELETE$(LSystem_Solution, n, 1)
                LSystem_Solution = STRINSERT$(LSystem_Solution, "("+LSystem_Table(s).changesTo+")", n)
                n = INSTR(n, LSystem_Solution, ")")
      
              END IF
      
            WEND
          NEXT
          LSystem_Solution = REMOVE$(LSystem_Solution, ANY "()")
      
        NEXT
      
      
        FOR n = 1 TO LEN(LSystem_Solution)
      
          char  = MID$(LSystem_Solution, n, 1)
          SELECT CASE char
            CASE "A", "B"                 ' -- Both A, B tokens mean draw line
              tFORWARD 3
      
            CASE "+"                      ' -- Clockwise 60°
              tLEFT -60
      
            CASE "-"                      ' -- Counter-Clockwise 60°
              tRIGHT -60
      
          END SELECT
      
        NEXT
      
      END SUB
      Last edited by Petr Schreiber jr; 7 May 2008, 11:16 AM.
      [email protected]

      Comment


      • #4
        Thank you, Petr

        ThinBASIC sounds ideal for turtle geometry applications, and especially of course for interactive & easily modifiable applications. I'll have to study your code and also ThinBASIC.

        Comment


        • #5
          Hi Emil,

          if I may, I recommend you to look into L-systems[1], [2] especially, you can grow a virtual tree[3] with very little input data.
          I did it in thinBASIC with combination of turtle graphics, L-system and module called TBGL, which is done in perfect PowerBASIC for Windows, v8.04.

          PowerBASIC for fantastic raw power DLL, thinBASIC for fast prototyping - that's ultimate developement combination I like a lot now


          Bye,
          Petr
          Last edited by Petr Schreiber jr; 7 May 2008, 04:44 PM.
          [email protected]

          Comment


          • #6
            Petr:

            L-systems looks great. It helps to solve some problems one has otherwise in trying to emulate LOGO/Turtle in BASIC. Thank you for pointing me to it.

            Here's an added SUB Hello, just for fun. Put it as Demo #0. It is not necessary to add any parameters before calling it... With PBCC's GRAPHIC PRINT statement I don't see any need to use turtle for "printing" but my needs might be more modest than other people's.

            Code:
            'Sub Hello was "borrowed" from www.psinvention.com
            'but it took some fiddling to get the L's right-side up
            'Either they or I have got something about angles wrong
             
            SUB Hello
              LOCAL num AS LONG, tp AS LONG, a AS STRING
              tp=turtle.pause
              turtle.Colour=14
              turtle.Background=%BLACK
              turtle.width=15
            
              FOR num=1 TO 4
                tCLEARSCREEN
                SELECT CASE num
                    CASE 4:     turtle.H=90:   turtle.PX=20:     turtle.PY=wy2/2 - 50 :turtle.pause=300: a$=" Got it "
                    CASE 3:     turtle.H=180:  turtle.PX=wx2/2:  turtle.PY=wy2/2 - 50 :turtle.pause=100: a$=" !#@*S--T "
                    CASE 2:     turtle.H=-90:  turtle.PX=wx2-20: turtle.PY=wy2/2 - 50 :turtle.pause=30 : a$=" OOPS TRY AGAIN "
                    CASE ELSE:  turtle.H=-180: turtle.PX=wx2-20: turtle.PY=wy2/2 - 50 :turtle.pause=0  : a$=" oops try again "
                END SELECT
                    
                'H
                tforward 100
                tright 180  'turn around
                tforward 50
                tleft 90
                tforward 50
                tleft 90
                tforward 50
                tright 180
                tforward 100
                tleft 90
                tpenup
                'E
                tforward 25
                tpendown
                tforward 50
                tleft 180
                tforward 50
                tright 90
                tforward 50
                tright 90
                tforward 50
                tleft 180
                tforward 50
                tright 90
                tforward 50
                tright 90
                tforward 50
            
                tpenup
                tforward 25
                tleft -90
                tpendown
                tforward 100
                tright 180
                tforward 100
                tleft -90
                tforward 50
                tpenup
                tforward 25
                tleft -90
                tpendown
                tforward 100
                tright 180
                tforward 100
                tleft -90
                tforward 50
                tpenup
                'O
                tforward 25
                tpendown
                tforward 50
                tright 90
                tforward 100
                tright 90
                tforward 50
                tright 90
                tforward 100
                
                GRAPHIC SET POS (wx1+20, 10)
                GRAPHIC COLOR RGB(255,255,255),RGB(0,0,0)
                GRAPHIC PRINT a$
                SLEEP 1000
            
              NEXT num
              turtle.pause=tp  'restore
            END SUB

            Comment


            • #7
              Hi Emil,

              this is very nice addition, I liked it a lot :laugh:


              Thanks,
              Petr
              [email protected]

              Comment


              • #8
                Hi Emil,

                The best tutorial that I know about L-Systems is William McWorter 's tutorial and one good implementation is L-Systems Java Applet by Robert Jessop that can be easily translated to PB.

                Regards
                Jordi

                Comment


                • #9
                  Thanks for the links,

                  I didn't know those websites.


                  Thanks,
                  Petr
                  [email protected]

                  Comment


                  • #10
                    Jordi,

                    Thanks. I have a 10-yr-old copy of FractInt somewhere in the rubble of my office, but I had completely forgotten it.

                    By the way, I'm happy to see your post in the Source Code forum on Brownian movement. The phenomenon has fascinated me ever since I was a child, when my father (himself a pastor) taught me to use a microscope and told me about Rev. Brown, and the early debates about whether or not the tiny dancing particles are living things or not. I probably swore that they were alive myself -- why should I take Einstein's word for it, especially at the age of six or seven?

                    The usefulness of L-systems (and its system of coding) sounds great for many purposes. For graphics, it could be the basis of a new version of DOS BASIC's DRAW statement, which we no longer have built-in to the new Windows-based PBs. I claimed a few years ago that I was going to do something about DRAW for Windows ( see http://www.powerbasic.com/support/pb...highlight=draw ) but alas I didn't.

                    (hint-hint)
                    Last edited by Emil Menzel; 10 May 2008, 05:21 PM.

                    Comment


                    • #11
                      uCalc version of Logo

                      There is a version of Logo, with turtle graphics, included in the zip file for uCalc Language Builder, at

                      http://www.ucalc.com/langbuilder.html

                      The file to run is Logo.Bat . It is not a complete version of Logo, but is enough to let you create/run mini-programs like this:

                      to square repeat 4 [forward 50 right 90] end
                      to flower repeat 36 [right 10 square] end
                      flower

                      This defines a square, then a "flower" using squares, and then draws a flower. You can directly draw things by entering commands like "forward 20 right 90 PenUp forward 30", etc, and use loops with "repeat".

                      This version of Logo is defined using 55 lines of code (see the Logo.uc file in the download).
                      Daniel Corbier
                      uCalc Fast Math Parser
                      uCalc Language Builder
                      sigpic

                      Comment


                      • #12
                        Originally posted by Daniel Corbier View Post
                        It is not a complete version of Logo, but is enough to let you create/run mini-programs like this:

                        to square repeat 4 [forward 50 right 90] end
                        to flower repeat 36 [right 10 square] end
                        flower
                        .
                        Very nice, Daniel. And of course it illustrates some signficant things that my program lacks.

                        Comment


                        • #13
                          I failed to mention that the title of this thread is inaccurate. With very minor modification, the source code will work just fine with PBWin 8+ as well as PBCC 4+.

                          For almost a month Petr & I have been working on further extensions and we will soon post a new thread on an emulation (for PBCC/PBWin) of DOS BASIC's DRAW statement. It will include turtle graphics capabilities, and a "repeat" function like the one that Daniel mentioned.

                          Comment


                          • #14
                            For almost a month Petr & I have been working on further extensions and we will soon post a new thread on an emulation
                            Consider posting it in the Source Code forum, using care when selecting a title so a 'search by title' will be fruitful.

                            For that matter, you might want to post your finished demo from this thread there, too and editing your posts to provide a link to the demo in the Source Code Forum. (so nobody downloads the versions from this thread when 'better' is available).

                            Strangely enough, when I want source code I search in the Source Code Forum; I have forty-one cents says lots of other folks do the same.
                            Michael Mattias
                            Tal Systems Inc. (retired)
                            Racine WI USA
                            [email protected]
                            http://www.talsystems.com

                            Comment


                            • #15
                              Michael,

                              Thanks for your good advice. Back in the old days when I still had to earn a living and was working as professor, I often told my students that the most important part of their paper was the title and the second-most-important was the Abstract, because most readers would probably not even read that far. My own choices of titles were by no means stellar, which proves the point. One of my favorite titles was "chimpanzee geometry"... but I digress.

                              Comment


                              • #16
                                One of my favorite titles was "chimpanzee geometry"... but I digress.
                                ...which reminds me...

                                The internet has conclusive DIS-proven the old saw that one hundred million chimpanzees pounding on one hundred million keyboards will eventually produce the collected works of Shakespeare.
                                Michael Mattias
                                Tal Systems Inc. (retired)
                                Racine WI USA
                                [email protected]
                                http://www.talsystems.com

                                Comment


                                • #17
                                  Yeah, but one day I walks into a bar in Madison, Wisconsin, over by the University, and what do I see but a guy playing checkers with a dog. Hey Mister, says I, that must be some smart hound dog you got there. Naw, says he, I've just about got him beat again, and that'll make it 5 games out of 7... But you ought to see my turtle or my chimpanzee!

                                  Comment


                                  • #18
                                    Notice: There is an error in the program that was posted at the outset of this thread. Instead of turning left the turtle turns right, and vice versa. That is why (for example) its rendition of the Sierpinsky triangle looks upside down from our perspective.

                                    The bug can easily be fixed. On the other hand, Petr Schreiber (who discovered the bug) and I have just completed a major overhaul and upgrading of the program . It too is Freeware, and is placed by us in the Public Domain. Get it instead. It will appear on the Source Code Forum within 24 hours.

                                    Comment


                                    • #19
                                      Hi,

                                      even less than 24 hours
                                      All interested can get the major update here.

                                      No need to Ctrl-C/Ctrl-V long code, all is packed in small ZIP archive, so once you download it, you can start experimenting immediately. Sample code, code skeletons and documenation all-in-one

                                      Works in both PB/CC 4 and PB/Win 8.


                                      Petr
                                      [email protected]

                                      Comment


                                      • #20
                                        Our tgDraw program has been substantially revised and expanded. It is available on the Source Code Forum at
                                        http://powerbasic.com/support/pbforu...ad.php?t=37809

                                        A highlight of the revised program is tgDrawer (for PBCC only), which amounts to an interpreter. Type in any statement in the tgDraw/turtleGraphics mini-language and press Enter. That beats drawing with a mouse by a long shot, at least for some problems. But you can use a mouse too, if you are so inclined.

                                        Another highlight is the ability to deal with multiple turtles.

                                        And then there is SuperDemo, which demonstrates almost all of the capabilities of tgDraw, including the tgDrawer interpreter function.

                                        Comment

                                        Working...
                                        X