;;; Problem 1-3. Turtle Graphics
;;; The book "Thinking about TLC Logo" by Allen, Davis, and Johnson
;;; is highly recommended as further reading on the subject
;;; of turtle graphics and most of the ideas discussed in the
;;; course. The many delightful cartoons alone make it worth
;;; reading.
;;; Obtain the definitions of the turtle graphics primitives.
(load "{turing}<3-lisp.utilities>turtle.3-lisp")
;;; (WIPE) clears the window and "homes" the turtle.
(define WIPE (lambda [] (begin (clearwindow) (center))))
; In general, all drawings shown below were drawn just
; after a (WIPE), and no attempt was made to drag the
; turtle off the picture it had just traced out.
;;; 1-3-a Triangles and rectangles.
;;; (TRIANGLE s) will draw an equilateral triangle S units
;;; on a side. The turtle is returned to where it started.
(define TRIANGLE
(lambda [size]
(begin (forward size)
(right 120)
(forward size)
(right 120)
(forward size)
(right 120))))
; Example triangle:
(triangle 150)
;;; (RECTANGLE l w) will draw rectangle L units long and W units
;;; wide. The turtle is returned to where it started.
(define RECTANGLE
(lambda [length width]
(begin (forward length)
(right 90)
(forward width)
(right 90)
(forward length)
(right 90)
(forward width)
(right 90))))
; Example rectangle:
(rectangle 150 70)
;;; 1-3-b Polygons.
;;; (POLYGON n s) will draw an N-sided (N>=3) regular polygon with sides
;;; s units long. As always, the turtle is returned to where it
;;; started.
(define POLYGON
(lambda [sides size]
(for i 1 sides
(begin (forward size)
(right (/ 360 sides))))))
; Example polygons:
(polygon 5 75)
(polygon 8 60)
; Nested polygons, for the fun of it.
(for sides 3 13 (polygon sides 30))
;;; 1-3-c A setup procedure.
;;; (SETUP x y angle erase?) positions the turtle at the given
;;; X and Y coordinates, facing in a particular direction, and
;;; optionally clears the screen if ERASE? => $TRUE.
;;; The coordinate system is as follows:
;;; Coordinate 0,0 corresponds to the center of the
;;; turtle's window, with the x axis running horizontally, and
;;; the y axis running vertically. The units are in screen pixels;
;;; i.e., roughly 75 units to the inch. The base orientation is
;;; facing east (along the x axis, towards +infinity); ANGLE
;;; indicates the desired clockwise deviation, in degrees,
;;; from the base orientation.
(define SETUP
(lambda [x y angle erase?]
(begin
(center)
(jump x)
(left 90)
(jump y)
(right 90)
(left angle)
(if erase? (clearwindow)))))
; Examples:
(setup 0 0 0 $true) ; Face left
(setup 0 0 90 $true) ; Face up
(setup 0 0 180 $true) ; Face right
(setup 0 0 90 $true) ; Face down
;;; (4-CORNERS n s x y) uses SETUP to draw (POLYGON n s)
;;; in each of the four corners of the screen, where X and Y
;;; give the maximum x and y coordinates of the screen, resp.
;;; Frankly, this procedure is quite shoddy with regard to
;;; the positioning of the polygons; a much better solution
;;; could have been written if POLYGON drew a polygon *centered*
;;; at the starting point, instead of tangential to the staring
;;; point.
(define 4-corners
(lambda [sides size max-x max-y]
(begin
(setup max-x max-y 90 $true)
(polygon sides size)
(setup max-x (- 0 max-y) 90 $false)
(polygon sides size)
(setup (- 0 max-x) max-y 90 $false)
(polygon sides size)
(setup (- 0 max-x) (- 0 max-y) 90 $false)
(polygon sides size)
(setup 0 0 0 $false))))
; Example of pentagons in the corners (well...) of a 100 by 60
; screen:
(4-corners 5 40 100 60)
;;; 1-3-d Recursive polygons.
;;; (RECURSIVE-POLYGON n s k) will draw a K-th generation
;;; N-sided recursive polygon S units a side. The 0th
;;; generation recursive polygon (any size, any number of
;;; sides) is defined to be a point. The first generation is
;;; simply the appropriately-sized regular N-sided polygon.
;;; A K>1 recursive polygon is a regular N-sided polygon with
;;; smaller, simpler recursive polygons at each vertex.
(let [[scale-down-factor 3]]
(define RECURSIVE-POLYGONS
(lambda [sides size generation]
(if (<= generation 0)
"ok"
(for i 1 sides
(begin
(forward size)
(recursive-polygons sides
(/ size scale-down-factor)
(1- generation))
(right (/ 360 sides)) ))))))
; Note: The three expressions within the scope of the FOR
; can be permuted without violating the spirit of the
; procedure.
; Examples:
(recursive-polygons 3 100 3)
(recursive-polygons 4 100 3)
(recursive-polygons 6 75 3)
;;; 1-3-e Thick polygons.
(load "{turing}<3-lisp.utilities>ps-1-definitions.3-lisp")
; In the interest of time and space, we have not show commented
; versions of SPIRAL, WHORL, BORDER, etc.
; But for those who didn't get to the stage to running the
; suggested test:
(begin (setup -200 100 0 $true)
(rectangle 8 5 16 3 right))
;;; (THICK-POLYGON n s nib-size) draws an N-sided regular polygon
;;; with sides S units long using lines NIB-SIZE units wide.
(define THICK-POLYGON ; c.f. POLYGON
(lambda [sides size nib-size]
(let [[forward (thick-forward nib-size)]]
(for i 1 sides
(begin (forward size)
(right (/ 360 sides)))))))
; Example of a thick pentagon:
(thick-polygon 5 100 10)
; The trick of rebinding FORWARD can be made in the
; definitions of BORDER, etc. to yield THICK-BORDER,etc.
;;; 1-3-f STRING-MAP and ASSOC
;;; (ASSOC key seq) looks up KEY in SEQ and returns the
;;; item paired with it. SEQ must designate
;;; a sequence of two element sequences of the form [key x].
;;; In keeping with LISP tradition, ASSOC will return $FALSE
;;; if KEY is not present.
(define ASSOC
(lambda [key seq]
(cond [(null seq) $false]
[(= key (first (first seq))) (second (first seq))]
[$true (assoc key (rest seq))])))
; Examples:
1> (assoc 2 [[1 "a"] [2 "b"] [3 "c"]])
1= "b"
1> (assoc 10 [[1 "a"] [2 "b"] [3 "c"]])
1= $false
1> (assoc 2 [[2 "a"] [2 "b"] [2 "c"]])
1= "a"
;;; (STRING-TO-SEQUENCE-OF-CHARACTERS string) designates the
;;; sequence of characters in STRING. This function will be
;;; employed in the definition of STRING-MAP.
(define STRING-TO-SEQUENCE-OF-CHARACTERS
(lambda [string]
(if (zero (string-length string))
[]
(cons (nth-char 1 string)
(string-to-sequence-of-characters
(substring 2 (string-length string) string))))))
; Examples:
1> (string-to-sequence-of-characters "csli")
1= [#c #s #l #i]
1> (string-to-sequence-of-characters "")
1= []
1> (string-to-sequence-of-characters "G ap")
1= [#G # #a #p]
;;; (STRING-MAP f string) applys the function designated by F
;;; to each character in the string STRING, collecting the results
;;; into a sequence. Since STRING-MAP is intended to be used with
;;; procedures F with side-effects, it is also important to know
;;; that the characters are visited in left-to-right order.
(define STRING-MAP
(lambda [fun string]
(map fun (string-to-sequence-of-characters string))))
; Example:
1> (string-map list "abc")
1= [[#a][#b][#c]]
;;; 1-3-g Large letters.
;;; Each letter drawing procedure assumes that the initial
;;; position of the turtle is at the lower left corner of the
;;; region in which the character is drawn, facing to the right.
;;; After drawing the large letter, the turtle is left on the
;;; bottom right side of letter just drawn, again facing to the
;;; right. These simple assumptions allow words to be composed
;;; in normal left-to-right order without additional concern about
;;; inter-letter spacing, basline alignment.
; Note the error on p.15 of the problem set: ((DRAW/Q 4)) in
; "... the expression ((DRAW/Q 4)) would draw a 'Q' four pixels thick."
; should be (((DRAW/Q (THICK-FORWARD 4))).
(define DRAW/C
(lambda [forward]
(lambda []
(begin
(jump 5)
(forward 75)
(jump -75)
(left 90)
(forward 100)
(right 90)
(forward 75)
(right 90)
(jump 100)
(left 90)
(jump 5)))))
; Sample "C".
(begin (wipe) ((draw/c (thick-forward 5))))
(define DRAW/I
(lambda [forward]
(lambda []
(begin
(jump 5)
(left 90)
(forward 100)
(jump -100)
(right 90)
(jump 5)))))
; Sample "I".
(begin (wipe) ((draw/i (thick-forward 5))))
(define DRAW/L
(lambda [forward]
(lambda []
(begin
(jump 5)
(left 90)
(forward 100)
(jump -100)
(right 90)
(forward 75)
(jump 5)))))
; Sample "L".
(begin (wipe) ((draw/l (thick-forward 5))))
(define DRAW/S
(lambda [forward]
(lambda []
(begin
(jump 5)
(forward 75)
(left 90)
(forward 30)
(left 60)
(forward 80)
(right 60)
(forward 30)
(right 90)
(forward 75)
(right 90)
(jump 100)
(left 90)
(jump 5)))))
; Sample "S".
(begin (wipe) ((draw/s (thick-forward 5))))
;;; *DRAWING-TABLE* designates a sequence of character
;;; procedure pairings (suitable for use with ASSOC).
(set *DRAWING-TABLE*
[[#C draw/C] [#I draw/I] [#L draw/L] [#S draw/S]])
; Use TURTLE-WRITE to spell out "CSLI". (Oops! No border.)
(begin (setup -170 0 0 $true)
(turtle-write "CSLI" 10))
;;; End of solution to 1-3.