(defun init-playfield ()
  (setf *playfield*
        (make-array
         '(10 15)
         :initial-contents
         '(("#" "#" "#" "#" "#" "#" "#" "#" "#" "#" "#" "#" "#" "#" "#")
           ("#" " " " " " " " " " " " " " " " " " " " " " " " " " " "#")
           ("#" " " " " " " " " " " " " " " " " " " " " " " " " " " "#")
           ("#" " " " " " " " " " " " " " " " " " " " " " " " " " " "#")
           ("#" " " " " " " " " " " " " " " " " " " " " " " " " " " "#")
           ("#" " " " " " " " " " " " " " " " " " " " " " " " " " " "#")
           ("#" " " " " " " " " " " " " " " " " " " " " " " " " " " "#")
           ("#" " " " " " " " " " " " " " " " " " " " " " " " " " " "#")
           ("#" " " " " " " " " " " " " " " " " " " " " " " " " " " "#")
           ("#" "#" "#" "#" "#" "#" "#" "#" "#" "#" "#" "#" "#" "#" "#")))))

(defmethod shared-initialize :after
    ((obj tiles) slot-names &rest initargs &key &allow-other-keys)
  (with-slots (grid rows cols ground-tile wreckage-tile
               player-row player-col)
      obj
    (setf grid (make-array `(,rows ,cols) :initial-element ground-tile)
          (aref grid player-row player-col) *player^*)
    (loop for c below cols do
      (setf (aref grid 0 c) wreckage-tile
            (aref grid (1- rows) c) wreckage-tile))
    (loop for r below rows do
      (setf (aref grid r 0) wreckage-tile
            (aref grid r (1- cols)) wreckage-tile))))

(let ((string
"*****
*O O*
* X *
*XX *
*****"))
  (with-input-from-string (in string)
    (loop for line = (read-line in nil nil)
          while line collect (coerce line 'string))))

(defun init-internal-fences ()
  (dotimes (n 15)
    (setf
     (aref *playfield*
           (+ 1 (random 8)) (+ 1 (random 13))) "#")))

Kudos, I just didn't do this.

In hindsight, I should have just done an initial teleport of the player. That's not the order I wrote things in. There are a few places in which I use magic numbers like 10 10 here. Lisp is quite accomodating to this, since values can be hot-fixed interactively in lisp and it saves thinking ahead. Anyway, I think we will talk more about teleporting.

(defun init-robot-positions ()

  (setf *robot-coords* (list
                        (+ 1 (random 8))
                        (+ 1 (random 13))))

  (loop while
        (equal
         (aref *playfield*
               (nth 0 *robot-coords*) (nth 1 *robot-coords*)) "#")

        do

           (setf *robot-coords* (list (+ 1 (random 8)) (+ 1 (random 13))))
        )
  (setf
   (aref *playfield*
         (nth 0 *robot-coords*) (nth 1 *robot-coords*)) "R")


 (setf *robot-positions* (append *robot-positions* (list *robot-coords*))))

(defun random-robot (grid)
  (loop for rrow = (random (array-dimension grid 0))
        for rcol = (random (array-dimension grid 1))
        for tile = (aref grid rrow rcol)
        when (equal tile *ground*)
          return (setf (aref grid rrow rcol) *robot*)))

(defun print-2d-array-as-table (array)
  (loop for i from 0 below (array-dimension array 0)
    do (loop for j from 0 below (array-dimension array 1)
             do (princ (aref array i j))
                (if (= j (1- (array-dimension array 1)))
                    (terpri)
                    (princ #\Space)))))

Aw, you should write it yourself. I guess it's interesting to see what stackoverflow thinks of looping, since I loop a lot as well.

But I don't loop here.

(defmethod display ((obj tiles) stream)
  (with-slots (rows cols grid) obj
    (with-text-style (stream (make-text-style :fix nil 12))
      (present grid '(sequence t) :stream stream))))

Aside, =:from 0= is implicit in the =:below= loop keyword.

My code is CLIM's fancy version of basically =(print array)=, but clim lets me customize the font to be fixed-width. Technically clim doesn't have the idea of arrays, or it can understand a 2d array as a sequence of sequences (of aesthetic prints which is =princ= as well).

(defun game-init ()

  (defparameter *user-input* nil)

  (defparameter *move-vector* '(0 0))

  (defparameter check-move '(0 0))

  (defparameter *robot-positions* (list))

  (init-playfield)
  (init-internal-fences)
  (init-player-position)
  (dotimes (n 6)
    (init-robot-positions)))

(eval-when (:compile-toplevel :load-toplevel :execute)
  (defvar *ground* #\,)
  (defvar *player^* #\^) (defvar *player>* #\>)(defvar *player<* #\<)(defvar *playerv* #\v)
  (defvar *wreckage* #\*)
  (defvar *robot* #\r))

(defclass tiles ()
  ((rows :initarg :rows)
   (cols :initarg :cols)
   (grid)
   (bots-crashed :initarg :bots-crashed)
   (alive :initform t)
   (player-row :initarg :player-row)
   (player-col :initarg :player-col)
   (ground-tile :initarg :Ground-tile )
   (wreckage-tile :initarg :Wreckage-tile)
   )

  (:default-initargs :rows 19 :cols 23 :ground-tile *ground*
                     :wreckage-tile *wreckage* :player-row '10 :player-col '10
                     :bots-crashed '0)
  (:documentation ""))

(defmethod shared-initialize :after
    ((obj tiles) slot-names &rest initargs &key &allow-other-keys)
  (with-slots (grid rows cols ground-tile wreckage-tile
               player-row player-col)
      obj
    (setf grid (make-array `(,rows ,cols) :initial-element ground-tile)
          (aref grid player-row player-col) *player^*)
    (loop for c below cols do
      (setf (aref grid 0 c) wreckage-tile
            (aref grid (1- rows) c) wreckage-tile))
    (loop for r below rows do
      (setf (aref grid r 0) wreckage-tile
            (aref grid r (1- cols)) wreckage-tile))))

(make-tv (robots (tiles))
    ((com-f1 com-up com-f2)
     (com-left com-down com-right))
    ((bots-crashed)))

(defun robots-main (frame pane) (display frame pane))

(defun robots-subject (frame pane)
  (with-slots (alive player-row player-col) frame
    (present (format nil "
  Welcome to screwlisp's robots!

  You are These characters: v^<>
  denoting your facing.

  Your score is in the top right panel.

  You are currently ~@[~a ~]alive.
  ~0@*~@[Teleport to respawn~]
  Take screenshots of your high scores and
   post them to the itch or on mastodon plz
  " (unless alive 'not))
             'string :stream pane)))

(defun robots-object (frame pane)
  (present (format nil "
  Arrowkeys, text or buttons move
  F1 attracts a single robot
  F2 teleports

  Safety feature:
  Automatically safe teleports when
  you start feeling claustrophobic

  You're welcome
  ") 'string :Stream pane))

(make-tv (robots (tiles))
    ((com-f1 com-up com-f2)
     (com-left com-down com-right))
    ((bots-crashed)))

(defun parse-input ()

  (cond
    ((equal *user-input* 8)     
     (setf *move-vector* '(-1 0)))

    ((equal *user-input* 2)
     (setf *move-vector* '(1 0)))

    ((equal *user-input* 4)
     (setf *move-vector* '(0 -1)))

    ((equal *user-input* 6)
     (setf *move-vector* '(0 1)))))

(defun main-loop ()

  (loop
     (print-2d-array-as-table *playfield*)
     (print *player-coords*)
     (setq *user-input* (read))
     (parse-input)
     (game-state)
     (when (equal *user-input* 'quit) (return))))

(defun claustrophobia (grid player-row player-col)
  (loop for mr from -1 to +1
        summing
        (loop for mc from -1 to +1
              sum (if (equal *wreckage* (aref grid
                                            (+ player-row mr)
                                            (+ player-col mc)))
                      1 0))))

(defun player-move (frame dir)
  (with-slots (grid player-row player-col alive) frame
    (when alive
      (when (< (random 10) (claustrophobia grid player-row player-col))
        (return-from player-move (teleport frame)))

      (multiple-value-bind (new-row new-col)
          (move grid player-row player-col dir)
        (setf player-row new-row player-col new-col)
        (unless (member (aref grid player-row player-col)
                        (list *player^* *playerv* *player<* *player>*))
          (setf alive nil))
        )
      (with-slots (grid player-row player-col bots-crashed) frame
        (incf bots-crashed
              (update-grid grid player-row player-col))))
    ))

(defun robot-choose-dir (grid robo-row robo-col
                         player-row player-col)
  (cond ((> player-row robo-row) :down)
        ((< player-row robo-row) :up)
        ((< player-col robo-col) :left)
        ((> player-col robo-col) :right)))



(defun move (grid old-row old-col dirkey
               &aux
                 (new-row (case dirkey
                            (:up (1- old-row))
                            (:down (1+ old-row))
                            (t old-row)))
                 (new-col (case dirkey
                            (:left (1- old-col))
                            (:right (1+ old-col))
                            (t old-col)))
                 (old-tile (aref grid old-row old-col))
                 (new-tile (aref grid new-row new-col))
                 (player-dir (case dirkey
                               (:up *player^*)
                               (:down *playerv*)
                               (:left *player<*) (:right *player>*))))
  (cond
    ((and (equal old-tile *robot*)
          (or (equal new-tile *ground*)
              (member new-tile (list *player^* *playerv*
                                     *player<* *player>*))))
     (setf (aref grid old-row old-col) *ground*
           (aref grid new-row new-col) *robot*)
     (values new-row new-col))
    ((and (equal old-tile *robot*)
          (equal new-tile *robot*))
     (setf (aref grid old-row old-col) *wreckage*
           (aref grid new-row new-col) *wreckage*)
     (values new-row new-col))
    ((and (equal old-tile *robot*)
          (equal new-tile *wreckage*))
     (setf (aref grid old-row old-col) *wreckage*
           (aref grid new-row new-col) *wreckage*)
     (values new-row new-col))
    ((and (member old-tile (list *player^* *playerv*
                                 *player<* *player>*))
          (not (equal old-tile player-dir)))
     (setf (aref grid old-row old-col) player-dir)
     (values old-row old-col))
    ((and (member old-tile (list *player^* *playerv*
                                 *player<* *player>*))
          (equal old-tile player-dir)
          (equal new-tile *ground*))
     (setf (aref grid new-row new-col) old-tile
           (aref grid old-row old-col) *ground*)
     (values new-row new-col))
    ((and (member old-tile (list *player^* *playerv*
                                 *player<* *player>*))
          (equal old-tile player-dir)
          (equal new-tile *wreckage*))
     (values old-row old-col))
    (t (values new-row new-col)
    )))

(define-robots-command (com-f1 :name "f1" :keystroke (:f1))
    () "
Add robot randomly
"
  (let ((frame *application-frame*))
    (with-slots (grid) frame (random-robot grid))
    ))

(defun random-robot (grid)
  (loop for rrow = (random (array-dimension grid 0))
        for rcol = (random (array-dimension grid 1))
        for tile = (aref grid rrow rcol)
        when (equal tile *ground*)
          return (setf (aref grid rrow rcol) *robot*)))

(defun teleport (frame)
  (with-slots (grid alive player-row player-col bots-crashed) frame
    (loop for rrow = (random (array-dimension grid 0))
          for rcol = (random (array-dimension grid 1))
          for tile = (aref grid rrow rcol)
          while (not (equal *ground* tile))
          finally
             (setf (aref grid player-row player-col) *ground*
              player-row rrow player-col rcol
                   (aref grid rrow rcol) *player^*)
             (unless alive
               (setf bots-crashed 0 alive t)))))

(define-robots-command (com-f2 :name "f2" :keystroke (:f2))
    () "
Teleport
"
  (let ((frame *application-frame*))
    (teleport frame)

    (with-slots (grid player-row player-col) frame
      (update-grid grid player-row player-col)
      (dotimes (r (random 4)) (random-robot grid))
    )))

(define-robots-command (com-up :name "up" :keystroke (:up))
    ()
  (let ((frame *application-frame*))
    (player-move frame :up)))

(define-robots-command (com-down :name "down" :keystroke (:down))
    ()
  (let ((frame *application-frame*))
    (player-move frame :down)))

(define-robots-command (com-left :name "left" :keystroke (:left))
    ()
  (let ((frame *application-frame*))
    (player-move frame :left)))

(define-robots-command (com-right :name "right" :keystroke (:right))
    ()
  (let ((frame *application-frame*))
    (player-move frame :right)))

I guess vidak's is more or less just the four movement commands at the end. I guess my move =defun= has bends over backwards to visually compare the moving-from tile on the board to the moving-to tile on the board, since there is no information except the board. I did that deliberately ;_;.

And I did that verbosely as well, since I wanted game logic to be like this:

(cond
 ((and (equal from-tile this)
       (equal to-tile that))
  (then-do-this)))

but I guess that move defun is a monster. The thing I was trying not to do was that thing people do in this situation, where they express update logic as a dense regular expression. I decided not to do that since it seems obtuse to work with to me.

One key problem you can see come up several times for me, is that I am purely identifying tiles by the characters in the array, but the character could be four different tiles depending on their facing! Ouch.

Mine has a bunch of features and quirks. Like I had the idea of claustrophobia: The player has a chance of automatically executing a safe teleport if they feel too closed in by wreckage (to stop people hiding inside a bunker and accruing infinite points).

(defun game-state ()
  (setf check-move *move-vector*)
  (setf new-coords (map 'list #'+ *player-coords* check-move))

  (setf
   (aref *playfield*
         (nth 0 *player-coords*) (nth 1 *player-coords*)) " ")

  (setf *player-coords* new-coords)

  (setf
   (aref *playfield*
         (nth 0 *player-coords*)
         (nth 1 *player-coords*)) "@")

  (dolist (robot-item *robot-positions*)

    (setf
     (aref *playfield*
           (nth 0 robot-item)
           (nth 1 robot-item)) " ")

    (when (<
           (nth 0 robot-item)
           (nth 0 *player-coords*))
      (setf (nth 0 robot-item) (incf (nth 0 robot-item))))

    (when (>
           (nth 0 robot-item)
           (nth 0 *player-coords*))
      (setf (nth 0 robot-item) (decf (nth 0 robot-item))))

    (when (<
           (nth 1 robot-item)
           (nth 1 *player-coords*))
      (setf (nth 1 robot-item) (incf (nth 1 robot-item))))

    (when (>
           (nth 1 robot-item)
           (nth 1 *player-coords*))
      (setf (nth 1 robot-item) (decf (nth 1 robot-item))))

  (setf
     (aref *playfield*
           (nth 0 robot-item)
           (nth 1 robot-item)) "R"))

    (when (equal "#" (aref *playfield*
                         (nth 0 new-coords)
                         (nth 1 new-coords)))

    (print "Destroyed by an electric fence")

    (break))

  (when (equal "R" (aref *playfield*
                         (nth 0 new-coords)
                         (nth 1 new-coords)))

    (print "Destroyed by a robot")

    (break)))

(defun update-grid (grid player-row player-col &aux (bots-crashed 0))
  (loop for row below (array-dimension grid 0)
        for skip = ()
          then
          (loop for col below (array-dimension grid 1)
                for tile = (aref grid row col)
                for moved-robots = skip
                  then
                  (if (and (equal tile *robot*)
                           (not (member (list row col) moved-robots :test 'equal)))
                    (push 
                     (multiple-value-bind (new-x new-y)
                         (move grid row col
                               (robot-choose-dir grid row col
                                                 player-row player-col))
                       (when (equal *wreckage*
                                    (aref grid  new-x new-y))
                         (incf bots-crashed))
                       (list new-x new-y))
                     moved-robots)
                    moved-robots)
                finally (return moved-robots))
        finally (return bots-crashed))
  )