#!/usr/local/bin/kalypso
;
; snake
;
; get chased by a snake while making off with the goods
;

;
; start up curses
;

(defun init ()
  (initscr)
  (setq !!random-seed!! (time))
  (setq LINES (getLINES))
  (setq COLS (getCOLS))
  )

;
; chop the tail off a list
;

(defun butlast (l)
  (reverse (cdr (reverse l)))
  )

;
; a faster version of last
;
(defun last (l)
  (nthelem (length l) l)
  )

;
; data abstraction -
; a segment is a two element list, x first
;

(setq seg-x car)
(def seg-y (macro (args) (list 'car (list 'cdr (cadr args)))))
(setq make-segment list)
	 
(defun draw-segment (s)
  (move (seg-y s) (seg-x s))
  (addstr "s")
  )

(defun draw-head (s)
  (move (seg-y s) (seg-x s))
  (addstr "S")
  )

(defun erase-segment (s)
  (move (seg-y s) (seg-x s))
  (addstr " ")
  )

(defun draw-person (p)
  (move (seg-y p) (seg-x p))
  (addstr "I")
  )

(setq erase-person erase-segment)

(defun draw-gold (p)
  (move (seg-y p) (seg-x p))
  (addstr "$")
  )

(setq erase-gold erase-segment)

(defun draw-exit (p)
  (move (seg-y p) (seg-x p))
  (addstr "#")
  )

(setq erase-exit erase-segment)

(defun draw-segments (snake)
  (cond ((nil? snake))
	(t (draw-segment (car snake)) (draw-segments (cdr snake)))
	)
  )

(defun draw-snake (snake)
  (cond ((nil? snake) nil)
	(t (draw-head (car snake))
	   (draw-segments (cdr snake))
	   )
	)
  )

(defun make-snake (l)
  (cond ((equal? l 0) nil)
	(t (cons (make-segment l l) (make-snake (1- l))))
	)
  )

(defun sign (x)
  (cond ((< 0 x) -1)
	((> 0 x) 1)
	((= 0 x) 0)
	(t nil)
	)
  )

(defun direction (from to)
  (make-segment (sign (- (seg-x from) (seg-x to)))
		(sign (- (seg-y from) (seg-y to)))
		)
  )

(defun getting-me-there (d here there)
  (let ((dir (direction here there)))
    (and d (or (and (not (= 0 (seg-x d))) (= (seg-x dir) (seg-x d)))
	       (and (not (= 0 (seg-y d))) (= (seg-y dir) (seg-y d)))
	       )
	 )
    )
  )

;
; make a new segment that is 'direction' away from 'old'
;

(defun segment-in-direction (old direction)
  (make-segment (+ (seg-x old) (seg-x direction))
		(+ (seg-y old) (seg-y direction)))
  )

;
; return a random segment of a snake
;

(defun random-segment (snake)
    (nth (random (length snake)) snake)
  )

;
; check and make sure the given point is on the screen
;

(defun onscreen (x y)
  (and (< -1 x)
       (< -1 y)
       (< x COLS)
       (< y LINES))
  )

(setq !directions '((-1 -1) (-1 0) (-1 1) (0 -1) (0 1) (1 -1) (1 0) (1 1)))

;
; create a list of the possible places for a new segment of
; the snake
;

(defun possible-segments (snake)
  (let ((new) (d !directions) (p))
    (while d
      (setq new (segment-in-direction (car snake) (car d)))
      (cond ((and (not (member? new snake))
		  (onscreen (seg-x new) (seg-y new))
		  )
	     (setq p (cons new p))
	     )
	    )
      (setq d (cdr d))
      )
    p
    )
  )

;
; move the money
;
(defun move-gold ()
  (if gold-pos then
      (erase-gold gold-pos)
      )
  (while (or (member? (setq gold-pos (make-segment (random COLS) (random LINES)))
		     snake
		     )
	     (equal? gold-pos person)
	     )
	 nil
	 )
  (draw-gold gold-pos)
  )

;
; place the exit
;
(defun move-exit ()
  (if exit-pos then
      (erase-exit exit-pos)
      )
  (while (or (member? (setq exit-pos (make-segment (random COLS) (random LINES)))
		     snake
		     )
	     (equal? exit-pos person)
	     )
	 nil
	 )
  (draw-exit exit-pos)
  )

;
; move the snake, possibly in your direction
;

(defun move-towards ()
  (< (random 100) (- 80 (/ 80 (1+ (/ turn-number 30)))))
  )

(defun move-snake ()
  (let ((to-person (segment-in-direction (car snake)
					 (direction (car snake) person)))
	(possible (possible-segments snake)))
    (if (nil? possible) then
	(throw 'restart nil)
	)
    (erase-segment (last snake))
    (draw-segment (car snake))
    (setq snake
	  (cons (if (and (member? to-person possible) (move-towards)) then
		    to-person
		 else
		    (random-segment possible))
		(butlast snake)
		)
	  )
    (draw-head (car snake))
    )
  )

;
; read a character and move the player
;

(defun char-person ()
  (let ((char (getchar)))
    (cond ((and (<= ~A char) (<= char ~Z)) (setq char (+ char (- ~a ~A)))
	   (setq running char))
	  (t (setq running nil))
	  )
    char
    )
  )

(defun map-character (character)
  (cond ((= ~k character) (make-segment 0 -1))
	((= ~j character) (make-segment 0 1))
	((= ~h character) (make-segment -1 0))
	((= ~l character) (make-segment 1 0))
	(t nil)
	)
  )

(defun move-person (character)
  (let ((direction) (newpos) (ret))
    (setq direction (map-character character))
    (setq ret t)
    (cond (direction
    	   (setq newpos (segment-in-direction direction person))
    	   (erase-person person)
    	   (if (onscreen (seg-x newpos) (seg-y newpos)) then
	       (setq person newpos)
	    else
	       (setq ret nil)
	       )
    	   (draw-person person)
	   )
	  )
    ret
    )
  )

(defun play-game (snake person gold-pos exit-pos)
  (setq turn-number 0)
  (draw-person person)
  (draw-snake snake)
  (while (not (member? person snake))
    (refresh)
    (cond ((and running (getting-me-there (map-character running)
					  person gold-pos)
		)
	   (move-person running)
	   )
	  (t
	   (setq running nil)
	   (let ((ch (char-person)))
	     (cond ((or (not running)
			(getting-me-there (map-character running)
					  person
					  gold-pos
					  )
			)
		    (move-person ch)
		    )
		   )
	     )
	   )
	  )
    (cond ((equal? person exit-pos)
	   (setq running nil)
	   (throw 'restart nil)
    	   )
	  ((equal? person gold-pos) (setq gold (+ gold 10))
	   (move 0 0) (addstr (sprint gold))
	   (move-gold)
	   (draw-person person)
	   (setq running nil)
	   )
	  )
    (move-snake)
    (cond ((= (car snake) gold-pos)
	   (move-gold)
	   (draw-head (car snake))
	   )
	  ((= (car snake) exit-pos)
	   (move-exit)
	   (draw-head (car snake))
	   )
	  )
    (setq turn-number (1+ turn-number))
    )
  (throw 'restart t)
  )

;
; replace the existing mainline routine with our own
;

(defun exit-sweetly (sig)
  (done)
  )

(defun done ()
  (move (- LINES 1) (- COLS 1))
  (refresh)
  (endwin)
  (terpr)
  (exit 0)
  )

(defun snake-game ()
  (let ((snake)
	(l 6)
	(person (make-segment 40 10))
	(gold 0)
	(gold-pos)
	(running)
	(exit-pos))
    (cond ((and (number? argc) (positive? argc))
	   (setq l (atoi (car argv)))
	   )
	  )
    (init)
    (noecho)
    (crmode)
    (signal 2 'exit-sweetly)
    (prog ()
      loop
      (if (*catch 'restart
		  (setq snake (make-snake l))
		  (setq gold 0)
		  (move-gold)
		  (move-exit)
		  (setq running nil)
		  (play-game snake person gold-pos exit-pos)
		  ) then
	  (go you-lose)
	  else
	  (go you-win)
	  )
    you-lose
      (move (1- LINES) 0)
      (addstr "You've been eaten ")
      (go again?)
    you-win
      (move (1- LINES) 0)
      (addstr "You win ")
    again?
      (addstr "with $") (addstr (sprint gold))
      (addstr ", another? ")
      (refresh)
      (if (not (= (getchar) ~y)) then
	  (return nil)
	  )
      (clear)
      (refresh)
      (go loop)
      )
    )
  (endwin)
  (terpr)
  )

(snake-game)
