Some Turtle Graphics for the fun

Guiserver, GTK-server, OpenGL, PostScript,
HTML 5, MIDI, IDE
Locked
newBert
Posts: 156
Joined: Fri Oct 28, 2005 5:33 pm
Location: France

Some Turtle Graphics for the fun

Post by newBert »

Code: Select all

 #!/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
Posts: 2038
Joined: Tue Nov 29, 2005 8:28 pm
Location: latiitude 50N longitude 3W
Contact:

Post by cormullion »

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

newBert
Posts: 156
Joined: Fri Oct 28, 2005 5:33 pm
Location: France

Post by 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
Posts: 2038
Joined: Mon Feb 23, 2004 7:40 pm
Location: Netherlands

Post by newdep »

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

newBert
Posts: 156
Joined: Fri Oct 28, 2005 5:33 pm
Location: France

Post by newBert »

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

Code: Select all

#!/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
Posts: 2038
Joined: Mon Feb 23, 2004 7:40 pm
Location: Netherlands

Post by 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,
-- (define? (Cornflakes))

newBert
Posts: 156
Joined: Fri Oct 28, 2005 5:33 pm
Location: France

Post by newBert »

newdep wrote: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.
newdep wrote: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
Posts: 156
Joined: Fri Oct 28, 2005 5:33 pm
Location: France

Post by newBert »

newdep wrote: 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 all

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

Code: Select all

(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
Posts: 156
Joined: Fri Oct 28, 2005 5:33 pm
Location: France

Post by newBert »

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

Code: Select all

 #!/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 ?

Locked