snok.rkt

#lang racket
(require 2htdp/universe
         2htdp/image)

(define snake-head-img
  (overlay (triangle 8 'solid 'black)
           (rectangle 10 10 'solid 'green)))

(define snake-body-img (rectangle 10 10 'solid 'green))

(define (rotate-img img dir)
  (match dir
    ['up img]
    ['left (rotate 90 img)]
    ['down (rotate 180 img)]
    ['right (rotate 270 img)]))

(struct snake (dir head tail) #:transparent)

(struct pos (x y) #:transparent)

(define a-snake
  (snake 'down
         (pos 8 10)
         (list (pos 9 10) (pos 10 10) (pos 10 11) (pos 10 12) (pos 11 12) (pos 12 12) (pos 13 12) (pos 14 12))))

(define (remove-last lst)
  (match lst
    [(list x) (list)]
    [(list x xs ...) (cons x (remove-last xs))]))

(define (move-tail tl hd)
  (cons hd (remove-last tl)))

(define (move-head hd dir)
  (match hd
    [(pos old-x old-y)
     (match dir
       ['left (pos (- old-x 1) old-y)]
       ['right (pos (+ old-x 1) old-y)]
       ['up (pos old-x (- old-y 1))]
       ['down (pos old-x (+ old-y 1))])]))

(define (move-snake snk)
  (match snk
    [(snake old-dir old-hd old-tl )
     (define new-head (move-head old-hd old-dir))
     (define new-tail (move-tail old-tl old-hd))
     (snake old-dir new-head new-tail)]))

(define (draw-tile img p scene)
  (match p
    [(pos x y) (place-image img (* x 10) (* y 10) scene)]))

(define (draw-tail tl scene)
  (match tl
    [(list) scene]
    [(list x xs ...) (draw-tail xs (draw-tile snake-body-img x scene))]))

(define (draw-snake snk)
  (match snk
    [(snake dir hd tl)
     (define scene/tail (draw-tail tl (empty-scene 600 600)))
     (draw-tile (rotate-img snake-head-img dir) hd scene/tail)]))

(define (key->dir a-key old-dir)
  (match a-key
    ["left" 'left]
    ["right" 'right]
    ["up" 'up]
    ["down" 'down]
    [_ old-dir]))

(define (turn-snake snk a-key)
  (match snk
    [(snake old-dir hd tl)
     (define new-dir (key->dir a-key old-dir))
     (snake new-dir hd tl)]))

(define (start-game)
  (big-bang a-snake
            (on-tick move-snake 1/8)
            (to-draw draw-snake)
            (on-key turn-snake)))

(start-game)