Robots/Common Lisp

Common Lisp

ncurses

To interface the ncurses C terminal library from Lisp, the croatoan library is used. <lang lisp>;; 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)))))</lang>