;; The first three lines of this file were inserted by DrRacket. They record metadata
;; about the language level of this file in a form that our tools can easily process.
#reader(lib "htdp-beginner-reader.ss" "lang")((modname working) (read-case-sensitive #t) (teachpacks ()) (htdp-settings #(#t constructor repeating-decimal #f #t none #f ())))
(require 2htdp/image)
(require 2htdp/universe)

(define-struct world (snake food))
(define-struct snake (dir segs))

;;; SNAKE WORLD 
;;;
;;; World is: (make-world Snake Food)
;;; Food is: Posn
;;; Snake is: (make-snake Direction Segs)
;;;   A snake's Segs may not be empty.
;;;   The first element of the list is the head.
;;; Direction is one of: 'up 'down 'left 'right
;;; Segs is one of:
;;;  -- empty
;;;  -- (cons Posn Segs)
;;; Coordinates are in "grid" units, with X running left-to-right,
;;; and Y running bottom-to-top.


;; RUN PROGRAM RUN
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define (start w)
  (big-bang w
            (to-draw   world->scene)
            (on-tick   world->world 0.2)
            (on-key    handle-key)
            (stop-when game-over?)))

;;; Wish list

;;; world->scene : World -> Scene
;;; food+scene   : Food Scene -> Scene 
;;; snake+scene  : Snake Scene -> Scene
;;; world->world : World -> World

;;; snake-slither : Snake -> Snake
;;; snake-change-direction : Snake Direction -> Snake
;;; snake-eat : World -> World
;;; snake-grow : Snake -> Snake
;;; snake-self-collide? : Snake -> Boolean
;;; eating? : World -> Boolean
;;; snake-wall-collide? : Snake -> Boolean

;; --- CONSTANTS : DESCRIBE PROPERTIES THAT ARE ALWAYS THE SAME 

(define GRID-SIZE 30) ; width of a game-board square
(define BOARD-HEIGHT 20) ; height in grid squares
(define BOARD-WIDTH  30) ; width  in grid squares
(define BOARD-HEIGHT-PIXELS (* GRID-SIZE BOARD-HEIGHT))
(define BOARD-WIDTH-PIXELS  (* GRID-SIZE BOARD-WIDTH))

(define BACKGROUND (empty-scene BOARD-WIDTH-PIXELS BOARD-HEIGHT-PIXELS))

(define SEGMENT-RADIUS (quotient GRID-SIZE 2))
(define SEGMENT-IMAGE  (circle SEGMENT-RADIUS 'solid 'red))

(define FOOD-RADIUS (floor (* 0.9 SEGMENT-RADIUS)))
(define FOOD-IMAGE  (circle FOOD-RADIUS 'solid 'green))

(define Snake1 (make-snake 'right (cons (make-posn 5 3) empty)))
(define Snake2 (make-snake 'right (cons (make-posn 5 3) (cons (make-posn 5 2) empty))))
(define Food1  (make-posn 8 12))
(define World1 (make-world Snake1 Food1))
(define World2 (make-world Snake1 (make-posn 5 3))) ; An eating scenario


;; --- FUNCTIONS 

;;; Image-painting functions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;; world->scene : World -> Scene
;;; Build an image of the given world.
(define (world->scene w) 
  (snake+scene (world-snake w) 
               (food+scene (world-food w) BACKGROUND)))

(check-expect (world->scene World1)
              (snake+scene Snake1
                           (food+scene Food1 BACKGROUND)))

;;; food+scene : Food Scene -> Scene 
;;; Add image of food to the given scene.
(define (food+scene f scn)
  (place-image-on-grid FOOD-IMAGE (posn-x f) (posn-y f) scn))

(check-expect (food+scene (make-posn 3 4) BACKGROUND)
              (place-image-on-grid FOOD-IMAGE 3 4 BACKGROUND))

;;; place-image-on-grid Image Number Number Scene
;;; Just like PLACE-IMAGE, but use grid coordinates.
(define (place-image-on-grid img x y scn)
  (place-image img
               (* GRID-SIZE x)
               (- BOARD-HEIGHT-PIXELS (* GRID-SIZE y))
               scn))

(check-expect (place-image-on-grid FOOD-IMAGE 0 0 BACKGROUND)
              (place-image FOOD-IMAGE 0 BOARD-HEIGHT-PIXELS BACKGROUND))

;;; snake+scene : Snake Scene -> Scene 
;;; Add an image of the snake to the scene.
(define (snake+scene snk scn)
  (segments+scene (snake-segs snk) scn))

(check-expect (snake+scene Snake1 BACKGROUND)
              (segments+scene (cons (make-posn 5 3) empty) BACKGROUND))

;;; segments+scene : Segs Scene -> Scene 
;;; Add an image of the snake segments to the scene.
(define (segments+scene segs scn) 
  (cond [(empty? segs) scn]
        [else (segment+scene (first segs)              
                             (segments+scene (rest segs) scn))]))

(check-expect (segments+scene empty BACKGROUND) BACKGROUND)
(check-expect (segments+scene (cons (make-posn 3 4) empty) BACKGROUND)              
              (segment+scene (make-posn 3 4) BACKGROUND))
            
;;; segment+scene : Posn Scene -> Scene
;;; Add one snake segment to a scene.
(define (segment+scene seg scn)
  (place-image-on-grid SEGMENT-IMAGE (posn-x seg) (posn-y seg) scn))

(check-expect (segment+scene (make-posn 3 4) BACKGROUND)
              (place-image-on-grid SEGMENT-IMAGE 3 4 BACKGROUND))
  

;;; Snake motion & growth
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; world->world : World -> World
(define (world->world w)
  (cond [(eating? w) (snake-eat w)]
        [else
         (make-world (snake-slither (world-snake w))
                     (world-food w))]))

(check-expect (world->world World1)
              (make-world (snake-slither Snake1) Food1))

(check-expect (world-snake (world->world World2))
	      (make-snake 'right (cons (make-posn 6 3)
				       (cons (make-posn 5 3) empty))))

;; posn=? : Posn Posn -> Boolean
(define (posn=? p1 p2)
  (and (= (posn-x p1) (posn-x p2))
       (= (posn-y p1) (posn-y p2))))

;; eating? : World -> Boolean
;; Is the snake eating the food in the world.
(define (eating? w)
  (posn=? (world-food w)
          (first (snake-segs (world-snake w)))))

;; snake-slither : Snake -> Snake
(define (snake-slither snk)
  (make-snake (snake-dir snk)                                                       
              (cons (next-head (first (snake-segs snk))
                               (snake-dir snk))
                    (cut-tail (snake-segs snk)))))

(check-expect (snake-slither (make-snake 'right (cons (make-posn 3 4) empty)))
              (make-snake 'right (cons (make-posn 4 4) empty)))
(check-expect (snake-slither (make-snake 'left (cons (make-posn 3 4) empty)))
              (make-snake 'left (cons (make-posn 2 4) empty)))

(check-expect (snake-slither (make-snake 'right (cons (make-posn 3 4)
                                                      (cons (make-posn 2 4) empty))))
              (make-snake 'right (cons (make-posn 4 4)
                                       (cons (make-posn 3 4) empty))))

;; next-head : Posn Direction -> Posn
;; Compute next position for head.
(define (next-head seg dir)
  (cond [(symbol=? 'right dir) (make-posn (add1 (posn-x seg)) (posn-y seg))]
        [(symbol=? 'left dir)  (make-posn (sub1 (posn-x seg)) (posn-y seg))]
        [(symbol=? 'down dir)  (make-posn (posn-x seg) (sub1 (posn-y seg)))]
        [(symbol=? 'up dir)    (make-posn (posn-x seg) (add1 (posn-y seg)))]))
  
(check-expect (next-head (make-posn 3 4) 'right) (make-posn 4 4))
(check-expect (next-head (make-posn 3 4) 'left) (make-posn 2 4))
(check-expect (next-head (make-posn 3 4) 'up) (make-posn 3 5))
(check-expect (next-head (make-posn 3 4) 'down) (make-posn 3 3))

;; NeSegs is one of:
;; - (cons Posn empty)
;; - (cons Posn NeSegs)
  
;; cut-tail : NeSegs -> Segs
;; Cut off the tail.
(define (cut-tail segs) 
  (cond [(empty? (rest segs)) empty]
        [(cons? segs) 
         (cons (first segs)
               (cut-tail (rest segs)))]))

(check-expect (cut-tail (cons (make-posn 3 4) empty)) empty)
(check-expect (cut-tail (cons (make-posn 3 4) (cons (make-posn 2 4) empty)))
              (cons (make-posn 3 4) empty))

;; snake-change-direction : Snake Direction -> Snake
;; Change the direction of the snake.
(define (snake-change-direction snk dir)
  (make-snake dir
              (snake-segs snk)))
  
;; world-change-dir : World Direction -> World
(define (world-change-dir w dir)
  (make-world (snake-change-direction (world-snake w) dir)
              (world-food w)))

;;; snake-eat : World -> World
(define (snake-eat w)
  (make-world (snake-grow (world-snake w))
              (make-posn (random BOARD-WIDTH) (random BOARD-HEIGHT))))


;;; snake-grow : Snake -> Snake
(define (snake-grow snk)
    (make-snake (snake-dir snk)                                                       
                (cons (next-head (first (snake-segs snk))
                                 (snake-dir snk))
                      (snake-segs snk))))



;;; Collisions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; snake-wall-collide? : Snake -> Boolean
;; Is the snake colliding with any of the walls?
(define (snake-wall-collide? snk)
  (head-collide? (first (snake-segs snk))))

;; head-collide? : Posn -> Boolean
(define (head-collide? p)
  (or (<= (posn-x p) 0)
      (>= (posn-x p) BOARD-WIDTH)
      (<= (posn-y p) 0)
      (>= (posn-y p) BOARD-HEIGHT)))


;; snake-self-collide? : Snake -> Boolean
(define (snake-self-collide? snk)
  (segs-self-collide? (first (snake-segs snk))
                      (rest (snake-segs snk))))

;; segs-self-collide? : Posn Segs -> Boolean
(define (segs-self-collide? h segs)
  (cond [(empty? segs) false]
        [(cons? segs)
         (or (posn=? (first segs) h)
             (segs-self-collide? h (rest segs)))]))
  

;;; Movie handlers
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; World KeyEvent -> World
(define (handle-key w ke) 
  (cond [(string=? ke "w") (world-change-dir w 'up)]
        [(string=? ke "s") (world-change-dir w 'down)]
        [(string=? ke "a") (world-change-dir w 'left)]
        [(string=? ke "d") (world-change-dir w 'right)]
        [else w]))

;; game-over? : World -> Boolean
(define (game-over? w)
  (or (snake-wall-collide? (world-snake w))
      (snake-self-collide? (world-snake w))))