Robots/Common Lisp

ncurses

To interface the ncurses C terminal library from Lisp, the croatoan library is used.

;; Load the library from the quicklisp repository
(ql:quickload "croatoan")
(in-package :croatoan)

(defun robots ()
  (with-screen (scr :input-echoing nil :input-blocking t :enable-function-keys t :cursor-visible nil)
    (let ((pos (center-position scr))
          (keys '((#\q . :up-left)
                  (#\w . :up)
                  (#\e . :up-right)
                  (#\a . :left)
                  (#\d . :right)
                  (#\y . :down-left)
                  (#\x . :down)
                  (#\c . :down-right)))
          (robots (loop repeat 10 collect (random-position scr))))
      (labels ((move-pos (key)
                 (setq pos (mapcar #'+ pos (get-direction (cdr (assoc key keys))))))
               (manhattan-distance (pos1 pos2)
                 (+ (abs (- (car pos1) (car pos2)))
                    (abs (- (cadr pos1) (cadr pos2)))))
               (robot-alive-p (r)
                 (not (> (loop for r2 in robots count (equalp r r2)) 1)))
               (player-alive-p ()
                 (every #'null (loop for r2 in robots collect (equalp pos r2))))
               (new-robot-position (r)
                 (cdar (sort (loop for key in keys
                                   for new-r = (mapcar #'+ r (get-direction (cdr key)))
                                   collect (cons (manhattan-distance pos new-r) new-r))
                             '< :key #'car)))
               (update-robots ()
                 (setq robots (loop for r in robots collect (if (robot-alive-p r) (new-robot-position r) r)))
                 (unless (player-alive-p) (return-from robots 'you-lose))
                 (when (every #'null (mapcar #'robot-alive-p robots))
                   (return-from robots 'you-win)))
               (draw-board (w)
                 (clear w)
                 (mapc #'(lambda (r) (add w (if (robot-alive-p r) #\A #\#) :position r)) robots)
                 (add w #\@ :position pos)
                 (refresh w)))
        (bind scr #\l 'exit-event-loop)
        (bind scr '(#\q #\w #\e #\a #\d #\y #\x #\c)
              (lambda (w e) (move-pos e) (update-robots) (draw-board w)))
        (bind scr #\t (lambda (w e) (setq pos (random-position scr)) (draw-board w)))        
        (draw-board scr)
        (run-event-loop scr)))))