Snake in Dynamic Modal Playground

gistfile1.txt

(events Left Right Up Down Tick)

(define interpolate
  (lambda (dynamic)
    (begin [^] (value (@ dynamic))
      (or
        (after [Tick] (@ dynamic))
        (after [^]    value)))))

(define direction
  (begin [^] (dir (cons 0 0))
    (or
      (after [Left]  (cons -1 0))
      (after [Right] (cons +1 0))
      (after [Up]    (cons 0 -1))
      (after [Down]  (cons 0 +1))
      (after [Tick]  dir))))

(define newSnake
  (lambda (initialPosition)
    (let ((head
            (begin [*; Tick] (h initialPosition)
              (after [*; Tick]
                (cons
                  (+ (car h) (car (@ direction)))
                  (+ (cdr h) (cdr (@ direction))))))))
      (after [(*; Tick)*]
        (cons nil (@ head))))))

(define lastPiece
  (lambda (sn)
    (if (isnil (car sn))
      (cdr sn)
      (car (car sn)))))

(define snakeOutOfBounds
  (lambda (sn)
    (let ((h (cdr sn)))
      (||
        (<= (car h) -10)
        (>= (car h) +10)
        (<= (cdr h) -10)
        (>= (cdr h) +10)))))

(define veq
  (lambda (u v)
    (&&
      (== (car u) (car v))
      (== (cdr u) (cdr v)))))

(define snakeEatsFruit
  (lambda (sn fruit)
    (let ((h (cdr sn)))
      (veq h fruit))))

(define snakeEatsItself
  (lambda (sn)
    (fold
      (lambda (eats piece)
        (|| eats (veq piece (cdr sn))))
      false
      (car sn))))

(define growSnake
  (lambda (snake)
    (let ((newPiece
            (join [*; Tick]
              (after [(*; Tick)*]
                (let ((last (lastPiece (@ snake))))
                  (after [*; Tick]
                    last))))))
      (or
        (after [1] (@ snake))
        (after [*; Tick; (*; Tick)*]
          (cons (cons (@ newPiece) (car (@ snake))) (cdr (@ snake))))))))

(define range
  (lambda (lo hi)
    (if (> lo hi)
      nil
      (cons lo (range (+ lo 1) hi)))))

(define map
  (lambda (f xs)
    (if (isnil xs)
      nil
      (cons (f (car xs)) (map f (cdr xs))))))

(define fold
  (lambda (f a xs)
    (if (isnil xs)
      a
      (fold f (f a (car xs)) (cdr xs)))))

(define rng
  (begin [*; Tick] (state 51895843)
    (after [*; Tick]
      (% (* 65539 state) 2147483648))))

(define freshFruit
  (after [(*; Tick)*]
    (let ((r (/ (@ rng) 113025456)))
      (cons
        (+ -9 r)
        (+ -9 (/ (- (@ rng) (* 113025456 r)) 5948709))))))

(define drawSnake
  (lambda (sn)
    (pixels
      (fold
        (lambda (pxs piece)
          (pixels
            (rgbxy 0 255 0 (car piece) (cdr piece))
            pxs))
        (pixels)
        (car sn))
      (rgbxy 0 0 255 (car (cdr sn)) (cdr (cdr sn))))))

(define game
  (begin [*; Tick]
    (state
      (cons
        (newSnake (cons 0 0))
        (@ freshFruit)))
    (after [*; Tick]
      (let ((snake (car state))
            (fruit (cdr state)))
        (if (|| (snakeEatsItself (@ snake)) (snakeOutOfBounds (@ snake)))
          (cons
            (newSnake (cons 0 0))
            (@ freshFruit))
          (if (snakeEatsFruit (@ snake) fruit)
            (cons
              (growSnake snake)
              (@ freshFruit))
            state))))))

(define graphics
  (let ((boundary
          (pixels
            (fold
              (lambda (p1 p2) (pixels p1 p2))
              (pixels)
              (map (lambda (x) (rgbxy 0 0 0 x -10)) (range -10 +10)))
            (fold
              (lambda (p1 p2) (pixels p1 p2))
              (pixels)
              (map (lambda (x) (rgbxy 0 0 0 x +10)) (range -10 +10)))
            (fold
              (lambda (p1 p2) (pixels p1 p2))
              (pixels)
              (map (lambda (y) (rgbxy 0 0 0 -10 y)) (range -10 +10)))
            (fold
              (lambda (p1 p2) (pixels p1 p2))
              (pixels)
              (map (lambda (y) (rgbxy 0 0 0 +10 y)) (range -10 +10))))))
    (interpolate
      (after [(*; Tick)*]
        (let ((snake (@ (car (@ game))))
              (fruit (cdr (@ game))))
          (pixels
            (drawSnake snake)
            (rgbxy 255 0 0 (car fruit) (cdr fruit))
            boundary))))))