;;; Snake game -- everything but collision detection
(require 2htdp/image)
(require 2htdp/universe)

(define TICK-RATE 0.5)
(define SNAKE-COLOR "red")
(define FOOD-COLOR "green")
(define BOARD-WIDTH 30)
(define BOARD-HEIGHT 20)
(define CELL-SIZE/PIXELS 10)
(define HALF-CELL/PIXELS (quotient CELL-SIZE/PIXELS 2))
(define SEG-IMAGE  (circle HALF-CELL/PIXELS "solid" SNAKE-COLOR))
(define FOOD-IMAGE (circle HALF-CELL/PIXELS "solid" FOOD-COLOR))
(define BACKGROUND (empty-scene (* BOARD-WIDTH  CELL-SIZE/PIXELS)
                                (* BOARD-HEIGHT CELL-SIZE/PIXELS)))

;;; Board coordinate system is in grid/cell units,
;;; with x & y increasing to the right & upward direction, respectively.

;;; A Snake is (make-snake Dir Segs)
;;; A Dir is one of: 'up 'down 'left 'right
;;; A Segs is one of:
;;; - empty
;;; - (cons Posn Segs)
;;; Where the first element of the Segs list is the head of the snake.
;;;
;;; A Food is a Posn
;;; A World is a (make-world Snake Food)
(define-struct snake (dir segs))
(define-struct world (snake food))
#;
(define (snake-template snake)
  ... (snake-dir snake) ... (snake-segs snake) ...)
#;
(define (segs-template segs)
  (cond [(empty? segs) ...]
        [else (first segs) ... (segs-template (rest segs)) ...]))

;;; Example segments & snakes
(define segs1 (list (make-posn 3 5) (make-posn 4 5)))
(define snake1 (make-snake 'down segs1))

(define world1 (make-world snake1 (make-posn 2 1)))
(define world2 (make-world snake1 (make-posn 3 5))) ; Eating scenario
(define initial-world (make-world (make-snake 'right segs1)
                                  (make-posn 2 1)))

#| Wish list:
;;; - collision detection
wall-collide? segs -> boolean
self-collide? segs -> boolean
snake-dead? world -> boolean
|#

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Rendering code
;;;;;;;;;;;;;;;;;;

;;; Image Number Number Image -> Image
;;; Like place-image, but with "cell" coordinates
(define (place-image-on-grid img x y scene)
  (place-image img (* CELL-SIZE/PIXELS (+ x 1/2))
                   (* CELL-SIZE/PIXELS (- BOARD-HEIGHT (+ y 1/2)))
                   scene))
  
(check-expect (place-image-on-grid FOOD-IMAGE 3 4 BACKGROUND)
	      (place-image FOOD-IMAGE 35 155 BACKGROUND))

;;; food+scene : Food image -> image
;;; Render the food onto the image.
(define (food+scene food scene)
  (place-image-on-grid FOOD-IMAGE (posn-x food) (posn-y food) scene))

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

;;; snake+scene : snake image -> image
;;; Render the snake onto the image.
(define (snake+scene snake scene)
  (segs+scene (snake-segs snake) scene))

;;; Segs Image -> Image
;;; Render a list of segments onto an image.
(define (segs+scene segs scene)
  (cond [(empty? segs) scene]
        [else (place-image-on-grid SEG-IMAGE 
                                   (posn-x (first segs))
                                   (posn-y (first segs))
                                   (segs+scene (rest segs) scene))]))

(check-expect (segs+scene empty BACKGROUND) BACKGROUND)
(check-expect (segs+scene segs1 BACKGROUND)
              (place-image-on-grid SEG-IMAGE 3 5
                                   (place-image-on-grid SEG-IMAGE 4 5
                                                        BACKGROUND)))

(check-expect (snake+scene snake1 BACKGROUND)
              (place-image-on-grid SEG-IMAGE 3 5
                                   (place-image-on-grid SEG-IMAGE 4 5
                                                        BACKGROUND)))
(check-expect (snake+scene (make-snake 'down empty) BACKGROUND)
              BACKGROUND)

;;; world -> image
;;; Render the world into a image.
(define (world->image w)
  (snake+scene (world-snake w)
               (food+scene (world-food w) BACKGROUND)))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Snake motion
;;;;;;;;;;;;;;;;

;;; change-direction snake dir -> snake
;;; Change the snake's direction to the given value.
(define (change-direction snake dir)
  (make-snake dir (snake-segs snake)))
  
(check-expect (change-direction snake1 'right)
              (make-snake 'right segs1))

;;; snake-slither snake -> snake
;;; Move the snake one cell in its current direction.
(define (snake-slither snake)
  (make-snake (snake-dir snake) 
              (move-segs (snake-segs snake) (snake-dir snake))))  

(check-expect (snake-slither snake1)
	      (make-snake 'down (list (make-posn 3 4) (make-posn 3 5))))

;;; move-segs: segs dir -> segs
;;; Slither the list of segs in the given direction.
;;; SEGS must be non-empty.
(define (move-segs segs dir)
  (cons (move-posn (first segs) dir)
        (segments-all-but-last segs)))

(check-expect (move-segs segs1 'down)
	      (list (make-posn 3 4) (make-posn 3 5)))

;;; A NESegs (a non-empty list of segments) is one of:
;;; - (cons Posn empty)
;;; - (cons Posn NESegs)

;;; all-but-last : NESegs -> Segs
;;; Return all but the last element of the segment list.
(define (segments-all-but-last nesegs)
  (cond [(empty? (rest nesegs)) empty]
        [else (cons (first nesegs) 
                    (segments-all-but-last (rest nesegs)))]))

(check-expect (segments-all-but-last (list (make-posn 10 20)
					   (make-posn 10 21)))
	      (list (make-posn 10 20)))


;;; move-posn : Posn Dir -> Posn
;;; Move the posn 1 unit in the given direction.
(define (move-posn posn dir)
  (cond [(symbol=? dir 'up)   (make-posn (posn-x posn) (+ (posn-y posn) 1))]
        [(symbol=? dir 'down) (make-posn (posn-x posn) (- (posn-y posn) 1))]
        [(symbol=? dir 'left) (make-posn (- (posn-x posn) 1) (posn-y posn))]
        [else                 (make-posn (+ (posn-x posn) 1) (posn-y posn))]))

(check-expect (move-posn (make-posn 3 9) 'left)  (make-posn 2 9))
(check-expect (move-posn (make-posn 3 9) 'right) (make-posn 4 9))
(check-expect (move-posn (make-posn 3 9) 'up)    (make-posn 3 10))
(check-expect (move-posn (make-posn 3 9) 'down)  (make-posn 3 8))

;;; snake -> snake
;;; Grow the snake by one segment.
;;; How: Add a fresh head to the snake's segments.
(define (snake-grow snake)
  (make-snake (snake-dir snake) 
              (cons (move-posn (first (snake-segs snake))
                               (snake-dir snake))
                    (snake-segs snake))))

(check-expect (snake-grow snake1)
	      (make-snake 'down (list (make-posn 3 4) (make-posn 3 5) (make-posn 4 5))))

;;; Collision detection: self-collision, food eating, wall collision
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Currently incomplete!

;;; posn=? : Posn Posn -> Boolean
;;; Are the two posns equal?
(define (posn=? p1 p2)
  (and (= (posn-x p1) (posn-x p2))
       (= (posn-y p1) (posn-y p2))))

(check-expect (posn=? (make-posn 1 5) (make-posn 1 8)) false)
(check-expect (posn=? (make-posn 1 5) (make-posn 8 5)) false)
(check-expect (posn=? (make-posn 1 5) (make-posn 1 5)) true)
       
;;; world -> boolean
;;; Is the snake in an eating configuration (head on top of food)?
(define (eating? w) 
  (posn=? (first (snake-segs (world-snake w)))
          (world-food w)))

(check-expect (eating? world1) false)
(check-expect (eating? world2) true)

;;; eat&grow : World -> World
;;; Eat the food, grow the snake & make new food somewhere random.
(define (eat&grow w)
  (make-world (snake-grow (world-snake w))		; grown snake,
              (make-posn (random BOARD-WIDTH)		; and new food
			 (random BOARD-HEIGHT))))

(check-expect (world-snake (eat&grow world2))
              (make-snake 'down (list (make-posn 3 4) (make-posn 3 5) (make-posn 4 5))))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Big-bang interface
;;;;;;;;;;;;;;;;;;;;;;

(define (world->world.v1 w)	; This version was for early testing.
  (make-world (snake-slither (world-snake w))
	      (world-food w)))

(define (world->world w)
  (cond [(eating? w) (eat&grow w)]
        [else (make-world (snake-slither (world-snake w))
                          (world-food w))]))

;;; world key-event -> world
;;; Handle key-presses in the game.
(define (handle-key w ke)
  (cond [(key=? ke "n") initial-world]
        [(or (key=? ke "up")
             (key=? ke "down")
             (key=? ke "left")
             (key=? ke "right"))
         (make-world (make-snake (string->symbol ke)
                                 (snake-segs (world-snake w)))
                     (world-food w))]
        [else w]))                   
             
(big-bang initial-world
	  (to-draw   world->image)
	  (on-tick   world->world 0.2)
          (on-key    handle-key))