Some Turtle Graphics for the fun

[newBert]

Code Select Expand

#!/usr/bin/newlisp
;=======================================
; Turtle graphics   (NewLISP + GUI-server)
; tree.lsp
;
; NewLISP v9.2.4                   B. Carette - nov. 2007
;=======================================
;; initialization GUI-server
(load (append (env "NEWLISPDIR") "/guiserver.lsp"))
(gs:init)

;; constants & variables
(constant 'PI2 (acos 0) 'DP2 (div PI2 90)) ; degre -> radian
(constant 'WIDTH 400 'HEIGHT 400) ; size of the window
(set 'coorX 0 'coorY 0) ; coordinates of the "turtle"
(set 'dir 0) ; orientation (heading to the north)
(set 'back-color '(1 1 1)) ; backcolor = white
(set 'pen-color '(0 0 0)) ; pen = black
(set 'pen true) ; pen is down

;; building the GUI
(gs:frame 'WIN 100 100 WIDTH (+ HEIGHT 34) "NewLISP Turtle")
(gs:canvas 'Canvas)
(gs:set-size 'Canvas WIDTH HEIGHT)
(gs:set-background 'Canvas back-color)
(gs:add-to 'WIN 'Canvas)
(gs:set-visible 'WIN true)

;; graphic procedures (commands for the turtle)
(define (home)
; center of the screen, heading to north
(pen-up)
(set 'coorX 0 'coorY 0)
(set 'dir PI2)
(pen-down))

(define (clear-screen)
(gs:delete-tag 'L)
(home))

(define (pen-down)
(set 'pen true))

(define (pen-up)
(set 'pen nil))

(define (pendown?)
pen)

(define (set-pos x y)
;  set the new positionof the turtle
(set 'coorX (add (div WIDTH 2) coorX) 'coorY (sub (div HEIGHT 2) coorY))
(set 'newX (add (div WIDTH 2) x) 'newY (sub (div HEIGHT 2) y))
(if (pendown?)
; draw if pen is down
(gs:draw-line 'L (int coorX) (int coorY) (int newX) (int newY) pen-color ))
(set 'coorX x 'coorY y))

(define (pos)
; return current position
(cons coorX coorY))

(define (forward dist)
(set-pos (add coorX (mul dist (cos dir)))
    (add coorY (mul dist (sin dir)))))

(define (backward dist)
(forward (- dist)))

(define (set-heading angle)
; set the orientation
(set 'dir (mod angle 360)))

(define (orientation)
; return current heading
dir)

(define (right degre)
; set orientation to the right (in degre)
(set-heading (sub dir (mul degre DP2))))

(define (left degre)
; set orientation to the left (in degre)
(set-heading (add dir (mul degre DP2))))

;; main program (a Turtle Graphics program)
(define (tree size)
(gs:set-stroke (div size 10))
(set 'pen-color (amb gs:red gs:green gs:blue))
(forward size)
(if (> size 5)
(begin
(right 30)
(tree (/ size 2))
(right 30)
(tree (/ size 2))
(left 90)
(tree (/ size 2))
(left 30)
(tree (/ size 2))
(right 60)
(gs:update)))
(pen-up)
(backward size)
(pen-down)
(gs:set-stroke 0.0))

(clear-screen)
(pen-up)
(backward 100)
(pen-down)
(tree 150)

;; boucle d'attente d'événements
(gs:listen)

[cormullion]

Great! That turtle's on speed! Remember when turtles used to move slowly over a piece of paper?

[newBert]

I made this script because I read somewhere on the Web that NewLISP was a Logo with parenthesis (it  was a Lisp Fan's remark). I like a lot Logo but I think it was Logo which is a "Lisp without parenthesis" ( a question of origins) !



NewLISP is just (or rather: moreover) a *new* Lisp/Scheme which restores to favor those so much criticized parenthesis ;-)



... and even what's more, NewLISP demystifies and democratizes LISP, as Logo in its day. I like this rendez-vous between Lisp and Logo (through NewLISP).



:-)

[newdep]

..wow.. I never though those where so quick to produce, I expected slow drawing ..this is nice ;-)

[newBert]

And yet another one, if it doesn't disturb :

Code Select Expand

#!/usr/bin/newlisp
;=======================================
; Turtle graphics   (NewLISP + GUI-server)
; mandala.lsp
; NewLISP v9.2.5 - Bertrand Carette (nov. 2007)
;=======================================
;; initialization GUI-server
(load (append (env "NEWLISPDIR") "/guiserver.lsp"))
(gs:init)

;; constants & variables
(constant 'PI2 (acos 0) 'DP2 (div PI2 90)) ; degre -> radian
(constant 'WIDTH 400 'HEIGHT 400) ; size of the window
(set 'coorX 0 'coorY 0) ; coordinates of the "turtle"
(set 'dir 0) ; orientation (heading to the north)
(set 'back-color '(1 1 1)) ; backcolor = white
(set 'pen-color '(0 0 0)) ; pen = black
(set 'pen true) ; pen is down

;; building the GUI
(gs:frame 'WIN 100 100 WIDTH (+ HEIGHT 34) "NewLISP Turtle")
(gs:canvas 'Canvas)
(gs:set-size 'Canvas WIDTH HEIGHT)
(gs:set-background 'Canvas back-color)
(gs:add-to 'WIN 'Canvas)
(gs:set-visible 'WIN true)

;; graphic procedures (commands for the turtle)
(define (home)
; center of the screen, heading to north
(pen-up)
(set 'coorX 0 'coorY 0)
(set 'dir PI2)
(pen-down))

(define (clear-screen)
(gs:delete-tag 'L)
(home))

(define (pen-down)
(set 'pen true))

(define (pen-up)
(set 'pen nil))

(define (pendown?)
pen)

(define (set-pos x y)
;  set the new positionof the turtle
(set 'coorX (add (div WIDTH 2) coorX) 'coorY (sub (div HEIGHT 2) coorY))
(set 'newX (add (div WIDTH 2) x) 'newY (sub (div HEIGHT 2) y))
(if (pendown?)
; draw if pen is down
(gs:draw-line 'L (int coorX) (int coorY) (int newX) (int newY) pen-color ))
(set 'coorX x 'coorY y))

(define (pos)
; return current position
(cons coorX coorY))

(define (forward dist)
(set-pos (add coorX (mul dist (cos dir)))
(add coorY (mul dist (sin dir)))))

(define (backward dist)
(forward (- dist)))

(define (set-heading angle)
; set the orientation
(set 'dir (mod angle 360)))

(define (orientation)
; return current heading
dir)

(define (right degre)
; set orientation to the right (in degre)
(set-heading (sub dir (mul degre DP2))))

(define (left degre)
; set orientation to the left (in degre)
(set-heading (add dir (mul degre DP2))))

;; main program (a Turtle Graphics program : mandala.lsp)
(define (get-vectors)
; create an array of vectors
(home)
(pen-up)
(set 'nsom 20) ; amount of vertices
(set 'sommets (array (+ nsom 1)))
(set 'rayon 180) ; radius
(set 'angle (/ 360 nsom))
(for (i 0 nsom)
(home)
(right (* i angle))
(forward rayon)
(nth-set (sommets i) (pos))))

(define (draw-vectors , a b)
; pen down and draw the mandala
(for (i 0 nsom)
(set 'a i)
(for (j 0 a)
(set 'b j)
(pen-up)
(set-pos (first (sommets a)) (last (sommets a)))
(pen-down)
(set-pos (first (sommets b)) (last (sommets b))))))

(get-vectors)
(draw-vectors)
(gs:update)

;; waiting for event
(gs:listen true)

[newdep]

aaha very nice !!.. The logic of pen-down and up is someting that never came

to my mind befor..that probably related to Logo..



how do I create a bigger mandala? increasing the width and height did not had any effect, its nicely hidden, I like to see thison full screen ;-)



Norman,

[newBert]

aaha very nice !!.. The logic of pen-down and up is someting that never came

to my mind befor..that probably related to Logo..

Yes, with 'pen-up' you can go forward without drawing and when 'pen-down', the "turtle" leaves its prints.

how do I create a bigger mandala? increasing the width and height did not had any effect, its nicely hidden, I like to see thison full screen ;-)

To create a bigger mandala, you need to increase the size of the screen before drawing because the 'home'-position depends on the WIDTH and HEIGHT constants ... This should be improved ;) ... I don't know ... maybe with gs:get-bounds. I must try !



Thank you for pointing that.

[newBert]

how do I create a bigger mandala? increasing the width and height did not had any effect, its nicely hidden, I like to see thison full screen ;-)



Norman,

I think we can do it now with version 9.2.7 and the (gs:window-resized) function, adding these two procedures in the previous script :

Code Select Expand

(gs:window-resized 'WIN 'resize-action)

Code Select Expand

(define (resize-action id w h , x y)
(set 'x (- (/ w 2) (/ WIDTH 2)) 'y (- (/ h 2) (/ HEIGHT 2)))
(gs:move-tag 'L x y)
(set 'WIDTH w 'HEIGHT h))

Quickly done and not really checked ... to be tested ;)



P.S.: must define WIDTH and HEIGHT with (set) rather than (constant) at the top of the script !

[newBert]

Here is a new (corrected) version of the "NewLISP Turtle", if there is no objection ;) with an example (another recursive tree) :

Code Select Expand

#!/usr/bin/newlisp
;=========================================================================
; Turtle Graphics  (NewLISP + GUI-server) - A recursive tree
;
; NewLISP v9.2.17                   Bertrand Carette - jan 2008
;=========================================================================

;; initialisation GUI-server ---------------------------------------------
(load (append (env "NEWLISPDIR") "/guiserver.lsp"))
(gs:init)

;; constants & variables -------------------------------------------------
(constant 'PI2 (acos 0) 'DP2 (div PI2 90)); degree -> radian
(set 'WIDTH 400 'HEIGHT 400)              ; size of the screen
(set 'xcor 0 'ycor 0)                     ; coordinates of the turtle
(set 'heading 0)                          ; orientation (heading to north)
(set 'background '(1 1 1))                ; background color = white
(set 'pen-color '(0 0 0))                 ; pen color = black
(set 'pen true)                           ; pen is down

;; building graphic interface --------------------------------------------
(gs:frame 'WIN 100 100 WIDTH (+ HEIGHT 34) "NewLISP Turtle")
(gs:canvas 'Canvas)
(gs:set-size 'Canvas WIDTH HEIGHT)
(gs:set-background 'Canvas background)
(gs:window-resized 'WIN 'resize-action)
(gs:add-to 'WIN 'Canvas)
(gs:set-visible 'WIN true)

(define (resize-action id w h , x y)
(set 'x (int (sub (div w 2) (div WIDTH 2))))
(set 'y (int (sub (div h 2) (div HEIGHT 2))))
(gs:move-tag 'L x y)
(set 'WIDTH (int w) 'HEIGHT (int h)))

;; turtle graphics procedures --------------------------------------------
(define (home)
; center of the screen, heading to north
(pen-up)
(set 'xcor 0 'ycor 0)
(set 'heading PI2)
(pen-down))

(define (clear-screen)
(gs:delete-tag 'L)
(home))

(define (pen-down)
(set 'pen true))

(define (pen-up)
(set 'pen nil))

(define (pen?)
; status of the pen
pen)

(define (set-pos x y)
;  set new position
(set 'xcor (int (add (div WIDTH 2) xcor)))
(set 'ycor (int (sub (div HEIGHT 2) ycor)))
(set 'newx (int (add (div WIDTH 2) x)))
(set 'newy (int (sub (div HEIGHT 2) y)))
(if (pen?)
; draw if pen is down
(gs:draw-line 'L xcor ycor newx newy pen-color ))
(set 'xcor x 'ycor y))

(define (pos)
; output current position
(cons xcor ycor))

(define (forward dist)
; move forward of 'dist' steps
(set-pos (add xcor (mul dist (cos heading)))
       (add ycor (mul dist (sin heading)))))

(define (backward dist)
; move backward
(forward (sub dist)))

(define (set-heading angle)
(set 'heading (mod angle 360)))

(define (orientation)
; output current heading
heading)

(define (right degre)
; set heading to right (in degree)
(set-heading (sub heading (mul degre DP2))))

(define (left degre)
; set heading to left (in degree)
(set-heading (add heading (mul degre DP2))))

;; MAIN PROGRAM : a recursive tree ---------------------------------------

(define (tree size)
(unless (< size 5)
(begin
(forward (div size 3))
(left 30)
(tree (div (mul size 2) 3))
(right 30)
(forward (div size 6))
(right 25)
(tree (div size 2))
(left 25)
(forward (div size 3))
(right 25)
(tree (div size 2))
(left 25)
(forward (div size 6))
(backward size)))
(forward size)
(backward size))

(clear-screen)
(pen-up)
(backward 100)
(pen-down)
(tree 150)
(gs:update)

;; event loop ------------------------------------------------------------
(gs:listen)

(exit)

How could I encapsulate constants, variables, interface and turtle graphics procedures in a context (and even a module file), in such a way that the main program remains clear and readable ?