Tweet
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
Comment