;; CMPU 101 Spring 2013 ;; Lecture 19 (require 2htdp/image) (require 2htdp/universe) ; ; Example: Write a function to move a 4-segment worm around on the ; grid. ; ; This problem will involve making the world contain both a list ; of posns for the worm segments and a direction for the worm to move. ; ; We will still use a stop-when clause that displays a final scene ; when the leading segment hits a wall. ; ; ; ; ; ; ;; ;; ; ; ; ; ;;; ;;; ; ;; ;;; ;;;; ;;; ; ;; ;;;; ;;; ; ; ; ; ; ;;; ; ; ; ;; ; ;;; ; ; ; ; ; ; ;; ; ;; ; ; ; ; ; ;; ; ; ; ; ; ; ; ;; ; ;; ; ; ; ;; ; ; ;; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ;; ; ; ; ; ;; ; ; ; ; ;;; ; ; ; ; ; ;; ; ; ;;; ;;; ; ;; ;;;; ;; ;; ;; ; ;; ;; ;;;; ; ; Constants (define RADIUS 10) ;\ (define DIAMETER (* RADIUS 2)) ; worm-related (define SEGMENT (circle RADIUS 'solid 'red)) ;/ (define WIDTH 800) ;\ (define HEIGHT 800) ; scene-related (define MT (empty-scene WIDTH HEIGHT)) ; (define COLOR 'black) ;/ (define CENTER (make-posn (/ WIDTH 2) (/ HEIGHT 2))) ; center of grid (define CLOCK-RATE 1/4) ; rate of clock ticks (every 1/4 sec) ;; Contract: (make-grid-hor-lines-v2) -> list of posn pairs ;; Header: (define make-grid-hor-lines-v2 (lambda () ...)) ;; Purpose: To make horizontal lines at every DIAMETER position in ;; grid (uses build-list for recursion). (define make-grid-hor-lines-v2 (lambda () (build-list ;; NOTE: using higher-order function (sub1 (/ WIDTH DIAMETER)) (lambda (c) (list (make-posn 0 (* (add1 c) DIAMETER)) (make-posn WIDTH (* (add1 c) DIAMETER))))))) ;; Contract: (make-grid-vert-lines-v2) -> list of posn pairs ;; Header: (define make-grid-vert-lines-v2 (lambda () ...)) ;; Purpose: To make vertical lines at every DIAMETER position in ;; grid (uses build-list). (define make-grid-ver-lines-v2 (lambda () (build-list ;; NOTE: using higher-order function (sub1 (/ HEIGHT DIAMETER)) (lambda (c) (list (make-posn (* (add1 c) DIAMETER) 0) (make-posn (* (add1 c) DIAMETER) HEIGHT)))))) ;; Contract: (draw-lines list-of-posn-pairs) -> image ;; Header: (define draw-lines (lambda (lopp) ...)) ;; Purpose: To draw lines between endpoints specified by each posn ;; pair in input list (define draw-lines (lambda (lopp) (cond [(empty? lopp) MT] [else (scene+line (draw-lines (rest lopp)) (posn-x (first (first lopp))) (posn-y (first (first lopp))) (posn-x (first (rest (first lopp)))) (posn-y (first (rest (first lopp)))) COLOR)]))) ;; Make the endpoints of all the lines to be in grid (define LOPS (append (make-grid-hor-lines-v2) (make-grid-ver-lines-v2))) ;; The game board: the equivalent of the empty-scene (define GRID (draw-lines LOPS)) ; ; ; ; ; ; ; ;; ; ; ; ; ; ; ;;; ;; ; ;;; ; ; ; ;; ; ; ;;; ; ;; ; ; ; ; ;;; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ;; ; ; ; ; ; ; ; ; ; ; ;; ; ; ; ; ;;;; ;;; ; ; ; ; ;;; ;; ;; ;; ;; ; ; The state of the world is a (define-struct worm (lop dx dy)) ; where lop is a list of posns and dx and dy are numbers ; representing the change in the position as time passes. ; Contracts: ;; CONSTRUCTOR: ; (make-worm list-of-posns number number) -> worm ;; ACCESSORS: ; (worm-lop worm) -> list of posns ; (worm-dx worm) -> number ; (worm-dy worm) -> number ;; MUTATORS: ; (set-worm-lop! worm list-of-posns) -> void ; (set-worm-dx! worm number) -> void ; (set-worm-dy! worm number) -> void ;; TYPE-CHECKER ; (worm? anything) -> boolean ; To start the simulation, we need to make an initial worm with 4 ; segments (as specified at top of these notes), so we need a list ; of posns in which each one differs from the previous by at most ; DIAMETER in either the x or the y direction. Also, make the initial ; worm a straight line. (define INIT-POS-LIST (list CENTER (make-posn (+ DIAMETER (posn-x CENTER)) (posn-y CENTER)) (make-posn (+ (* DIAMETER 2) (posn-x CENTER)) (posn-y CENTER)) (make-posn (+ (* DIAMETER 3) (posn-x CENTER)) (posn-y CENTER)))) ;; AN INITIAL WORM WITH HEAD CENTERED ON SCENE, MOVING LEFT (define INIT-WORM (make-worm INIT-POS-LIST (* -1 DIAMETER) 0)) ;(check-expect (worm-lop INIT-WORM) INIT-POS-LIST) ;; Statement to return lop field of the worm ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ;;; ; ;;;; ; ;;; ;;; ; ;; ;;;; ; ; ; ; ; ; ; ; ; ; ;; ; ;;; ; ; ; ; ;; ; ; ; ; ;; ; ; ; ;; ; ; ; ; ; ; ; ; ; ;;; ; ; ; ; ;; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ;;;; ;; ; ; ; ;;; ; ; ; ; ; ;; ; ;; ;; ;;; ; ; ;; ;; ;; ; ;; ;;; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ;; ;; ; ; Contract: (main worm) -> worm ; Header: (define main (lambda (w) ... )) ; Purpose: starts big-bang with initial world. (define main (lambda (w) (big-bang w (on-draw draw-segments) ;; Show every segment in worm (on-tick go CLOCK-RATE) ;; The clock will tick every quarter sec. (on-key worm-key) ;; This function will be triggered with every key press (stop-when at-edge? final-scene) (on-mouse add-segment)))) ;; make the worm stop ; ; For the on-draw clause, you created a function called ; draw-segment that consumed a dotpos called ; w. This function placed the SEGMENT image at (w, DIAMETER) ; on top of the GRID scene created above. How should we change ; draw-segment to work with a list of posns? ; ; ; ; ; ; ; ; ; ; ; ; ; ;; ; ;;; ; ;; ;;; ;; ;;; ; ; ; ; ; ; ;;; ; ;; ; ;;; ;; ; ; ; ;; ; ;; ; ;; ; ; ; ; ; ; ; ; ; ; ; ; ; ;; ; ;;; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ;; ; ; ; ; ; ; ; ; ;;; ; ; ; ; ;;; ; ; ; ;; ; ;;; ; ;; ;; ;; ;; ;; ;; ; ; ;;Contract: (draw-segment worm) -> scene (image) ;;Header: (define draw-segments (lambda (w) ...)) ;;Purpose: Render result of placing SEGMENT at positions indicated in worm struct ;; lop fields on the background GRID. ;;Function definition: (define draw-segments (lambda (w) (local ;; variable to hold just the list of posns in worm-lop [(define lop (worm-lop w)) ;; inner recursive function to draw each segment in worm-lop (define draw-help (lambda (lp) (cond ;; base case, return GRID [(empty? lp) GRID] ;; recursive case, place another segment on scene [else (place-image SEGMENT (posn-x (first lp)) (posn-y (first lp)) (draw-help (rest lp)))])))] ;; initial call to inner recursive function (draw-help lop)))) (printf "(draw-segments INIT-WORM) =>~%") (draw-segments INIT-WORM) ;; called to check position of worm segment in ;; initial world ; ; For the on-tick clause, you wrote a function called go-right ; to consume a positive natural number w and increase w by ; DIAMETER each time it is called by on-tick. ; ; How should we change go-right to comply with our new world ; model? Note: This could involve several functions. ; ; ; ; ; ; ; ; ; ; ;; ; ; ; ; ; ;;; ; ;; ;;;; ; ;;; ; ;; ; ; ; ;;; ; ; ; ; ; ; ;; ; ;; ; ;; ; ; ; ; ; ;; ; ; ; ;; ; ;;; ; ; ; ;; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ;;;; ;;; ; ; ; ;;; ; ;; ;; ;; ;;; ; ;; ; ;;Contract: (go worm) -> worm ;;Header: (define go (lambda (w) ...)) ;;Purpose: Move worm in direction indicated in the dx and dy fields of w ;;;Function definition: (define go (lambda (w) ;; choice is to create a new worm with the x and y fields possibly ;; modified. (make-worm ;; add a segment to the new worm that is offset from the current ;; first in worm-lop by worm-dx and worm-dy (cons (make-posn (+ (worm-dx w) (posn-x (first (worm-lop w)))) (+ (worm-dy w) (posn-y (first (worm-lop w))))) ;; take last posn off of worm-lop (remove-last (worm-lop w))) ;; return dx and dy fields unchanged (worm-dx w) (worm-dy w)))) ;;Contract: (remove-last list-of-posns) -> list-of-posns ;;Header: (define remove-last (lambda (lop) ...)) ;;Purpose: Return all but the last posn in lop ;;;Function definition: (define remove-last (lambda (lop) (cond ;; base case: one item left in list, return empty [(empty? (rest lop)) empty] ;; recursive case: > 1 posn left in list, cons current first onto ;; recursive call on rest of list [else (cons (first lop) (remove-last (rest lop)))]))) ; ; ; ; ; ; ; ; ; ; ; ;;; ; ;; ; ;; ;;; ; ; ; ; ; ;;; ; ; ;; ; ; ; ; ; ;; ; ;; ; ;; ; ;; ; ; ; ; ; ;; ; ;;; ;; ; ; ;; ; ; ; ; ; ; ; ; ; ;; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ;;; ; ;;; ; ;; ; ;; ;;; ;; ;; ; ; ; ; ; ; ; ; ; ; ;;; ; ; Contract: (worm-key worm string) -> worm ; Header: (define worm-key (lambda w k) ...)) ; Purpose: Change the direction of movement based on the key presses ; of the 4 direction keys: up, down, left, right. (define worm-key (lambda (w k) (cond ;; if up arrow pressed, create new world with neg dy [(key=? k "up") (make-worm (worm-lop w) 0 (- 0 DIAMETER))] ;; else if down arrow pressed, create new world with pos dy [(key=? k "down") (make-worm (worm-lop w) 0 DIAMETER)] ;; else if left arrow pressed, create new world with neg dx [(key=? k "left") (make-worm (worm-lop w) (- 0 DIAMETER) 0)] ;; else if right arrow pressed, create new world with pos dx [(key=? k "right") (make-worm (worm-lop w) DIAMETER 0)] [else w]))) ;; otherwise, return world unchanged ; ; Add a clause to add a segment to the worm when the mouse is pressed. ; ; ; ;;; ; ;; ; ;; ;; ;;; ; ; ;;; ;;; ; ; ; ;;; ; ;;; ; ; ; ; ; ; ; ; ; ; ; ;; ; ;; ; ;; ;; ; ;; ; ; ; ; ; ;; ; ; ; ;; ; ;;; ;; ;; ; ; ; ; ; ;; ; ;; ; ; ; ; ; ; ; ; ; ; ; ; ; ;; ; ; ; ; ; ; ; ; ; ;; ; ; ;; ; ; ; ; ; ;;; ; ;; ; ; ;; ;;; ;;; ;;;;;; ;;; ; ; Contract: (add-segment worm number number string) -> worm ; Header: (define add-segment (lambda w x y str) ...)) ; Purpose: Add a new segment to the head of the worm. ; (define add-segment ; (lambda (w x y str) ; ;; if user pressed the button on the mouse inside the window ; (if (string=? str "button-down") ; (begin ; ;; change the contents of the worm-lop by consing on a new segment ; ;; in the cell the worm would move to on the next clock tick. ; (set-worm-lop! w (cons (make-posn (+ (posn-x (first (worm-lop w))) ; (worm-dx w)) ; (+ (posn-y (first (worm-lop w))) ; (worm-dy w))) ; (worm-lop w))) w) ; ;; user did some other mouse action, return worm unchanged ; w))) (define add-segment ;; ALTERNATE VERSION (lambda (w x y str) ;; if user pressed the button on the mouse inside the window (if (string=? str "button-down") ;; make a new worm including a new segment ;; in the cell the worm would move to on the next clock tick. (make-worm (cons (make-posn (+ (posn-x (first (worm-lop w))) (worm-dx w)) (+ (posn-y (first (worm-lop w))) (worm-dy w))) (worm-lop w)) (worm-dx w) (worm-dy w)) ;; user did some other mouse action, return worm unchanged w))) ; ; ; ; ;; ; ; ; ; ; ;;; ;;;; ;;; ; ;;; ; ; ; ; ;; ;;; ; ;; ; ; ; ; ; ;; ; ; ; ;;; ;; ; ; ; ;;; ; ; ; ; ;; ; ;; ; ; ; ;;; ; ; ;; ;; ; ; ;; ; ; ; ; ; ;;; ; ; ; ;; ; ; ;; ;; ; ; ; ; ; ; ; ; ; ;; ; ; ; ;; ; ; ; ; ; ; ; ; ; ; ; ; ;; ; ; ;; ; ; ; ; ; ;;; ;; ;;; ; ;; ; ; ; ;; ;;; ; ;; ; ; ; ; ; ; ; Contract: (at-edge? worm) -> boolean ; Header: (define at-edge? (lambda (w) ... )) (define at-edge? (lambda (w) ;; return true if the x,y coordinate of first worm segment is at left, right, top ;; or bottom of grid (or (= (posn-x (first (worm-lop w))) 0) (= (posn-y (first (worm-lop w))) 0) (= (posn-x (first (worm-lop w))) WIDTH) (= (posn-y (first (worm-lop w))) HEIGHT)))) ; Contract: (final-scene worm) -> scene (image) ; Header: (define final-scene (lambda (w) ... )) ; Purpose: Write a text image on the middle of the scene (define final-scene (lambda (w) (local [(define TEXT (text "WORM HIT WALL" 48 'purple)) (define BOX (rectangle (image-width TEXT) (image-height TEXT) 'solid 'white))] (overlay TEXT BOX (draw-segments w))))) ; ; ; ; ; ; ; ; ; ; ; ; ; ; ;;; ;;; ; ; ; ;; ;; ;;; ; ; ;; ; ; ; ;; ; ; ; ;;; ; ; ; ;; ; ; ;;; ; ; ; ; ; ; ; ; ;; ;; ; ; ; ; ;; ; ; ; ; ; ; ; ;; ;; ; ; ; ; ;; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ;; ; ;;; ; ;;;;;; ; ; ; ;; ;;; ; ;;;; ; ; ; ;;; ;; ;; ;; ;; ; ; ;; ;; ;; ;; ; ;; ; ;; Call the main function, passing in the initial state of the world. ;(printf "(main INIT-WORM)~%") (main INIT-WORM)