Paste #Wi77C6XZvHb2CtLrB6Hq at spacepaste

; The Grid
; --------
; The grid of trees has dimensions size × size, where the size is set by the following variable:
(define size 10)
; For example, if the size were 3, the initial grid would be 3 × 3, and be drawn as:
#;.
; When making a list representing a point, use the following alias to make the intent clear:
(define point list)
; When extracting the first and second element of a point, use the following aliases:
(define X first)
(define Y second)
; A cleared part of the grid will be represented as a list of points.
; For example, the following represents a small “L” shaped path in the grid:
#;(list (point 0 1)
(point 0 0)
(point 1 2)
(point 0 2))
; If the size of the grid were 3, that would be drawn as:
#;.
; Drawing The Maze
; ================
(define barrier (render (scale . 1/4)))
; floor-piece : function color → image
; ------------------------------------
; This function produces a shape of a particular color, with the same dimensions as ‘barrier’.
#;(check-expect (floor-piece rectangle "brown") .)
#;(check-expect (floor-piece ellipse "orange") .)
; ★ Write a Partial (or Full) Design check-expect for floor-piece:
(check-expect (floor-piece rectangle "brown") .)
(check-expect (floor-piece ellipse "orange") .)
; ★ Fix floor-piece:
(define
(floor-piece shape color)
(shape 25 28 "solid" color))
(define ground (floor-piece rectangle "brown"))
(define invisible (floor-piece rectangle "transparent"))
(define highlight (overlay (shrink (floor-piece ellipse (list 100 100 0 25)))
invisible))
; xs : list-of-points → list-of-numbers
; -------------------------------------
; This function extracts the X co-ordinates of a list of points.
#;(check-expect (xs (list (point 1 2) (point 3 4) (point 1 5)))
(list 1 3 1))
; ★ Write a Partial (or Full) Design check-expect for xs:
(check-expect (xs (list (point 1 2) (point 3 4) (point 1 5)))
(list 1 3 1))
; ★ Fix xs:
(define (xs points)
(map X points))
; row : number list-of-points → list-of-points
; --------------------------------------------
; This function extracts the points that have a particular Y co-ordinate, from a list of points.
#;(check-expect (row (list (point 1 2) (point 3 4) (point 2 2)) 2)
(list (point 1 2) #;(point 3 4) (point 2 2)))
#;(check-expect (row (list (point 1 2) (point 3 4) (point 2 2)) 2)
(local [(define (y? a-point)
(= (Y a-point) 2))]
(list (point 1 2) #;(point 3 4) (point 2 2))))
; ★ Write a Full Design check-expect for row:
(check-expect (row (list (point 1 2) (point 3 4) (point 2 2)) 2)
(list (point 1 2) #;(point 3 4) (point 2 2)))
(check-expect (row (list (point 1 2) (point 3 4) (point 2 2)) 2)
(local [(define (y? a-point)
(= (Y a-point) 2))]
(list (point 1 2) #;(point 3 4) (point 2 2))))
; ★ Fix row:
(define (row points y)
(local [(define (y? a-point)
(= (Y a-point) y))]
(sift y? points)))
; xs->image : number list-of-numbers image image → image
; -----------------------------------------------------
; This function draws a row of foreground and background images, with a given total number of images,
; and a list of which images (numbered left to right as 0, 1, 2, ...) are the foreground ones.
#;(check-expect (xs->image 4 (list 2 0) ground barrier) .)
#;(check-expect (xs->image 4 (list 2 0) ground barrier) (beside ground barrier ground barrier))
#;(check-expect (xs->image 4 (list 2 0) ground barrier)
(local [(define (represent x)
(if [(element? x (list 2 0)) ground]
[else barrier]))]
(beside (represent 0) (represent 1) (represent 2) (represent 3))))
; ★ Write a Fuller (or Full) Design check-expect for xs->image:
(check-expect (xs->image 4 (list 2 0) ground barrier) .)
(check-expect (xs->image 4 (list 2 0) ground barrier) (beside ground barrier ground barrier))
(check-expect (xs->image 4 (list 2 0) ground barrier)
(local [(define (represent x)
(if [(element? x (list 2 0)) ground]
[else barrier]))]
(beside (represent 0) (represent 1) (represent 2) (represent 3))))
(define (xs->image total some-xs foreground background)
(local [(define (represent x)
(if [(element? x some-xs) foreground]
[else background]))](apply beside(map represent(range 0 total 1)))))
; points->image : number list-of-points image image → image
; ---------------------------------------------------------
; This function takes a list of points and draws them using a foreground image, filling in
; the rest of the grid with a background image.
(define (points->image a-size points foreground background)
(local [(define (row->image y)
(xs->image a-size (xs (row points y)) foreground background))]
(apply above (map row->image (range 0 size 1)))))
; draw-all : list-of-points point point → image
; ---------------------------------------------
; This function draws:
; • the maze
; • kat at a particular point
; • the path from kat to a particular point
(define kat (render (scale . 1/4)))
(define (draw-all a-maze kat-point click-point)
(align-overlay "left" "top"
(above (rectangle 0 (* (height barrier) (Y kat-point)) "solid" "transparent")
(beside (rectangle (* (width barrier) (X kat-point)) 0 "solid" "transparent")
kat))
(overlay (points->image size (path a-maze kat-point click-point) highlight invisible)
(points->image size a-maze invisible barrier)
(scale ground size))))
; Test The Functionality
; ----------------------
; Run the program now, and you should see a forest of trees, with a small L-shaped path.
; Pressing keys should move kat to the right.
; Clicking in the L-shaped path should highlight the point you clicked with an ellipse.
; Maze Generation Algorithm
; =========================
; The maze (cleared path) will start off containing a single point, for example:
#;(check-expect (in-grid? (point -1 0)) #false)
#;(check-expect (in-grid? (point 3 size)) #false)
#;(check-expect (in-grid? (point 1 2)) #true)
#;(check-expect (in-grid? (point (- size 1) 0)) #true)
#;(check-expect (in-grid? (point -1 0)) #false)
#;(check-expect (in-grid? (point 3 size)) #false)
(check-expect (in-grid? (point -1 0))
(if [(< -1 0) #false]
[(< 0 0) #false]
[(> (- size -1)0) #true]
[(> (- size 0)0) #true]
[(< -1 size) #true]
[(< 0 size) #true]
[(< -1 0) #false]
[(< 0 0) #false]
[else #false]))
(define (in-grid? a-point)
(if [(< (X a-point) 0) #false]
[(< (Y a-point) 0) #false]
[(> (- size (X a-point))0) #true]
[(> (- size (Y a-point))0) #true]
[(< (X a-point) size) #true]
[(< (Y a-point) size) #true]
[else #false]))
#;(check-expect (neighbours (point 3 7))
(local [(define x 3)
(define y 7)]
(list (point x 6)
(point x 8)
(point 2 y)
(point 4 y))))
#;(check-expect (neighbours (point 3 7))
(local [(define x 3)
(define y 7)]
(list (point x 6)
(point x 8)
(point 2 y)
(point 4 y))))
(define (neighbours a-point)
(local [(define x (X a-point))
(define y (Y a-point))]
(list (point x (- y 1 ))
(point x (+ y 1))
(point (- x 1) y)
(point (+ x 1)y))))
#;(check-expect (intersection (list "ant" "bee" "cat" "bee" "dog") (list "dog" "eel" "bee"))
(list "bee" "bee" "dog"))
#;(check-expect (intersection (list "ant" "bee" "cat" "bee" "dog") (list "dog" "eel" "bee"))
(local [(define (in-list-2? e) #true)]
(list #;"ant" "bee" #;"cat" "bee" "dog")))
(define (intersection list-1 list-2)
(local [(define e list-1)
(define (in-list-2? e)
(element? e list-2))]
(sift in-list-2? list-1)))
; random-element : list → any
; ---------------------------
; This function produces an element randomly chosen from a non-empty list.
#;(check-expect (<= 0 (random-element (range 0 1000 1)) 999)
#true)
#;(check-expect (= (random-element (range 0 1000 1))
(random-element (range 0 1000 1)))
; Probably:
#false)
#;(check-expect (element? (random-element (list "programming" "is" "fun"))
(list "programming" "is" "fun"))
#true)
(define (random-element list1)
(element list1 (random (length list1))))
; random-neighbour : point → point
; --------------------------------
; This function produces a random neighbour of a point.
#;(check-expect (element? (random-neighbour (point 123 104)) (list (point 123 103)
(point 123 105)
(point 122 104)
(point 124 104)))
#true)
(define (random-neighbour a-point)
(random-element (neighbours a-point)))
; bridge? : point list-of-points → boolean
; ----------------------------------------
; This function determines whether adding a point to a list-of-points creates a “bridge”:
; does it connect two or more points in the list-of-points?
#;(check-expect (bridge? (point 3 4)
(list (point 1 2)
(point 3 3) ; one of the neighbours of (point 3 4)
(point 4 5)
(point 2 4))) ; one of the neighbours of (point 3 4))
; (point 3 4) touches, so connects, (point 3 3) and (point 2 4)
#true)
#;(check-expect (bridge? (point 3 4)
(list (point 1 2)
(point 3 3)
(point 4 5)
(point 3 2)))
#false)
#;(check-expect (bridge? (point 3 4)
(list (point 1 2)
(point 3 3)
(point 4 5)
(point 2 4)))
(>= (length (list (list 3 3) #;(list 3 5) (list 2 4) #;(list 4 4)))
2))
(define (bridge? a-point points)
(element? a-point (apply join (map neighbours (join points)))))
; maybe-attach : point list-of-points → list-of-points
; ----------------------------------------------------
; This function checks the three conditions mentioned in #3 of the maze generation algorithm,
; and adds the point to the maze if the three conditions are satisfied, otherwise it just
; produces the maze unchanged.
#;(check-expect (maybe-attach (point 1 2)
(list (point 0 1) (point 0 0) (point 1 2) (point 0 2)))
(list (point 0 1) (point 0 0) (point 1 2) (point 0 2)))
#;(check-expect (maybe-attach (point -1 2)
(list (point 0 1) (point 0 0) (point 1 2) (point 0 2)))
(list (point 0 1) (point 0 0) (point 1 2) (point 0 2)))
#;(check-expect (maybe-attach (point 1 1)
(list (point 0 1) (point 0 0) (point 1 2) (point 0 2)))
(list (point 0 1) (point 0 0) (point 1 2) (point 0 2)))
#;(check-expect (maybe-attach (point 2 2)
(list (point 0 1) (point 0 0) (point 1 2) (point 0 2)))
(list (point 2 2) (point 0 1) (point 0 0) (point 1 2) (point 0 2)))
; ★ Write a Partial (or Full) Design check-expect for the case covered by the previous check-expect:
(define (maybe-attach a-point a-maze)
(if [(same? (and (bridge? a-point a-maze)
(not(element? a-point a-maze)))
#true)
(adjoin a-point a-maze)]
[else a-maze]))
(define (try-grow a-maze)
(local [(define new-maze (maybe-attach (random-neighbour (random-element a-maze)) a-maze))]
(if [(and (same? a-maze new-maze)
(positive? (random (squared size))))
(try-grow a-maze)]
[else new-maze])))
; The following has a large probability of being correct:
#;(check-expect (local [(define small-maze (try-grow (list (point 0 0))))]
(and (= (length small-maze) 2)
(element? (point 0 0) small-maze)
(or (element? (point 0 1) small-maze)
(element? (point 1 0) small-maze))))
#true)
; Unless size is small, the following produces a list of ten mazes, growing by one point each time:
#;(repeats try-grow (list (point 0 0)) 10)
; Moving Kat Around
; =================
; This part lets you move kat around the maze, by pressing the arrow keys on your keyboard.
; The big-bang expression at the end of the program is set up to use the function move.
; move : point text list-of-points → point
; ----------------------------------------
; This function helps react to pressing a key on the keyboard.
; It takes a point, a text representing a key, and a maze.
; If the text represents one of the arrow keys, and the point in that direction is in the maze,
; then produce that point, otherwise produce the original point.
#;(check-expect (move (point 0 2) "up"
(list (point 0 1) (point 0 0) (point 1 2) (point 0 2)))
(point 0 1))
#;(check-expect (move (point 0 2) "down"
(list (point 0 1) (point 0 0) (point 1 2) (point 0 2)))
(point 0 2))
#;(check-expect (move (point 0 2) "left"
(list (point 0 1) (point 0 0) (point 1 2) (point 0 2)))
(point 0 2))
#;(check-expect (move (point 0 2) "right"
(list (point 0 1) (point 0 0) (point 1 2) (point 0 2)))
(point 1 2))
#;(check-expect (move (point 0 2) "cat"
(list (point 0 1) (point 0 0) (point 1 2) (point 0 2)))
(point 0 2))
(define (move a-point key maze)
(local[(define(maze? a-point maze)(element? a-point maze))]
(if[(and(same? key "right")(maze?(point(+(X a-point) 1)(Y a-point))maze))(point (+ (X a-point) 1)(Y a-point))]
[(and(same? key "left")(maze?(point(-(X a-point) 1)(Y a-point))maze))(point (- (X a-point) 1)(Y a-point))]
[(and(same? key "up")(maze?(point (X a-point) (- (Y a-point)1))maze))(point (+ (X a-point) 1)(Y a-point))]
[(and(same? key "down")(maze?(point(X a-point) (+ (Y a-point)1))maze))(point (+ (X a-point) 1)(Y a-point))]
[else (point (X a-point)(Y a-point))])))
; click-point: point number number text → point
; ---------------------------------------------
; This function helps react to clicking on the grid.
; It takes a point representing the last place the mouse was clicked, the new click's co-ordinates,
; and a text describing whether it's in fact a mouse click (versus, for example, a drag action).
; If it's the right type of action, the point in the grid representing the mouse location is produced,
; otherwise the previous point is produced.
(define (click-point previous-point x y type)
(if [(same? type "button-down") (point (quotient x (width barrier))
(quotient y (height barrier)))]
[else previous-point]))
; path : list-of-points point point
; ---------------------------------
; For any two points in the generated maze, there is exactly one non-backtracking path connecting
; the two points. The following describes a function to find such a connecting path. It works more
; generally on parts of mazes, since that turns out to allow a simpler recursive implementation.
#;(path sub-maze from to)
; For part of a maze sub-maze, and a point end-point within it, with at most one path from
; start-point to end-point within sub-maze, produce the list of points connecting start-point
; to end-point. If there is no such path, produce the empty list.
; The approach:
; If start-point and end-point are the same point, the path contains exactly that point.
; Otherwise, if start-point is in the sub-maze, then the path, if there is one, continues from
; one of the neighbours and is within the partial maze with start-point removed. If one of
; those four neighbours produces a (non-empty) path then adding start-point to that path
; produces the whole path.
; Otherwise, we know already that there is no path.
; One of the simple cases:
#;(check-expect (path (list (point 0 0) (point 0 1) (point 1 1) (point 1 2))
(point 0 1)
(point 0 1))
(list (point 0 1)))
; Another kind of simple case:
#;(check-expect (path (list (point 0 0) (point 0 1) (point 1 1) (point 1 2))
(point 1 0)
(point 0 1))
(list))
; When there's a path from one of the neighbours:
#;(check-expect (path (list (point 0 0) (point 0 1) (point 1 1) (point 1 2))
(point 0 1)
(point 1 2))
(local [(define (rest-of-path a-neighbour)
(path (list (point 0 0) (point 1 1) (point 1 2))
a-neighbour
(point 1 2)))
(define maybe-rest-of-path
(join (rest-of-path (point 0 0))
(rest-of-path (point 0 2))
(rest-of-path (point -1 1))
(rest-of-path (point 1 1))))]
(adjoin (point 0 1) maybe-rest-of-path)))
; When there's no path from one of the neighbours:
#;(check-expect (path (list (point 0 0) (point 0 1) #;(point 1 1) (point 1 2))
(point 0 1)
(point 1 2))
(local [(define (rest-of-path a-neighbour)
(path (list (point 0 0) (point 1 2))
a-neighbour
(point 1 2)))
(define maybe-rest-of-path
(join (rest-of-path (point 0 0))
(rest-of-path (point 0 2))
(rest-of-path (point -1 1))
(rest-of-path (point 1 1))))]
(list)))
; ★ Write Full Design check-expects for the two previous non-simple cases:
; ★ Fix path:
(define (path sub-maze start-point end-point)
(local[(define(rest-of-path a-neighbour)(path (remove start-point sub-maze)a-neighbour end-point))
(define (maybe-rest-of-path x-point)
(apply join (map rest-of-path (neighbours x-point))))]
(if[(not (and (element? start-point sub-maze) (element? end-point sub-maze))) (list)]
[(same? start-point end-point) (list start-point)]
[(>(length (maybe-rest-of-path start-point)) 0) (adjoin start-point (maybe-rest-of-path start-point))]
[else (list)])))
; Launch the Animation
; ====================
(define make-state list)
(define maze first)
(define kat-point second)
(define path-point third)
(define (key state a-key)
(make-state (maze state) (move (kat-point state) a-key (maze state)) (path-point state)))
(define (draw state)
(apply draw-all state))
(define (tick state)
(make-state (try-grow (maze state)) (kat-point state) (path-point state)))
(define (click state x y type)
(make-state (maze state) (kat-point state) (click-point (path-point state) x y type)))
(big-bang (make-state (list (point 0 0))
(point 0 0)
(point 0 0))
[to-draw draw]
[on-tick tick]
[on-mouse click]
[on-key key])

spacepaste

Paste details