snake-rkt/private/snake.rkt

#lang racket/base

(require
  racket/list)

(provide
  *NORTH* *SOUTH* *EAST* *WEST*
  +pos -pos *pos =pos
  snake-heading snake-positions turn-snake!
  game-snake game-preys make-game update-game! game-over?)

; headings
(define *NORTH* '(0 . -1))
(define *SOUTH* '(0 . 1))
(define *EAST* '(1 . 0))
(define *WEST* '(-1 . 0))

; Maths for positions
; Null position
(define *NULL-POS* '(0 . 0))
; Vector addition
(define (+pos p1 p2)
  (cons (+ (car p1) (car p2))
        (+ (cdr p1) (cdr p2))))
; Vector substraction
(define (-pos p1 p2)
  (cons (- (car p1) (car p2))
        (- (cdr p1) (cdr p2))))
; Product by scalar
(define (*pos scalar pos)
  (cons (* scalar (car pos))
        (* scalar (cdr pos))))
; Equality
(define (=pos p1 p2)
  (and (eq? (car p1) (car p2))
       (eq? (cdr p1) (cdr p2))))

; Snake structure
(struct snake
  ((heading #:mutable) ; direction of the head
   (positions #:mutable) ; positions of the snake body, as pairs of positions
  ))

; Make a snake whose head is at position head-position, going into the direction heading, and with a length of len
(define (make-snake head-position heading len)
  (let ((opp-heading (-pos *NULL-POS* heading)))
    (snake
      heading
      (build-list
        len
        (lambda (x)
          (+pos head-position (*pos x opp-heading)))))))

; Move the snake
(define (move-snake! snk)
  (set-snake-positions!
    snk
    (let ((old-pos (snake-positions snk)))
      (cons (+pos (snake-heading snk) (car old-pos))
            (reverse (cdr (reverse old-pos)))))))

; Turn the snake in the given direction, if possible
(define (turn-snake! snk new-heading)
  (let ((old-heading (snake-heading snk)))
    (when
      (or
        (and (or (=pos old-heading *NORTH*) (=pos old-heading *SOUTH*))
             (or (=pos new-heading *EAST*) (=pos new-heading *WEST*)))
        (and (or (=pos old-heading *EAST*) (=pos old-heading *WEST*))
             (or (=pos new-heading *NORTH*) (=pos new-heading *SOUTH*))))
      (set-snake-heading! snk new-heading))))

; Grow the snake by the given amount of length
; The last position is repeated
(define (grow-snake! snk len)
  (let* ((old-pos (snake-positions snk))
         (rev-old-pos (reverse old-pos)))
    (set-snake-positions!
      snk
      (reverse
        (append
          (make-list len (car rev-old-pos))
          rev-old-pos)))))

; Check if the snake collided with itself (the head is repeated in the positions list)
(define (snake-collided? snk)
  (let ((pos (snake-positions snk)))
    (member (car pos) (cdr pos) =pos)))

; Check if the snake's head is outside the area
(define (snake-fled? snk width height)
  (let ((head (car (snake-positions snk))))
    (or (< (car head) 0)
        (< (cdr head) 0)
        (<= width (car head))
        (<= height (cdr head)))))

; Add preys to a list of preys in a given area (and return the list)
(define (add-preys preys nb width height excluded-pos)
  (if (<= nb 0)
      preys
      (let ((pos (cons (random width) (random height))))
        (if (or (member pos preys =pos) (member pos excluded-pos =pos))
            (add-preys preys nb width height excluded-pos)
            (add-preys (cons pos preys) (- nb 1) width height excluded-pos)))))

; Make a list of preys
(define (make-preys nb width height excluded-pos)
  (add-preys '() nb width height excluded-pos))

; Check if the snake has eaten a prey (and grow by the given amount), and return the list of preys still in the area
(define (eat-prey! preys snk growth)
  (let ((head (car (snake-positions snk))))
    (if (member head preys =pos)
        (begin
          (grow-snake! snk growth)
          (remove head preys =pos))
        preys)))

; Game structure
(struct game
  (snake
   (preys #:mutable)
   width
   height
   snake-growth))

; Initialize the game
(define (make-game width height snake-heading snake-length snake-growth nb-preys)
  (let ((snk (make-snake (cons (floor (/ width 2)) (floor (/ height 2)))  snake-heading snake-length)))
    (game
      snk
      (make-preys nb-preys width height (snake-positions snk))
      width
      height
      snake-growth)))

; Update the game world
(define (update-game! gm)
  (move-snake! (game-snake gm))
  (set-game-preys! gm (eat-prey! (game-preys gm) (game-snake gm) (game-snake-growth gm))))

; Check if the game ended, and if so, by winning or loosing
(define (game-over? gm)
  (cond
    ((null? (game-preys gm))
     'WON)
    ((or (snake-fled? (game-snake gm) (game-width gm) (game-height gm))
         (snake-collided? (game-snake gm)))
     'LOST)
    (#t #f)))