I'm working on modernizing Rosetta Code's infrastructure. Starting with communications. Please accept this time-limited open invite to RC's Slack.. --Michael Mol (talk) 20:59, 30 May 2020 (UTC)

Robots/Common Lisp

From Rosetta Code

Common Lisp[edit]

ncurses[edit]

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)))))