GUI table of unicode common lisp interface manager cat adventure

7 days ago by screwtape

Share this post:

Share on Bluesky Share on Twitter Share on Facebook

In which we use common lisp interface manager McCLIM to allow a cat to walk to a star.

1. Setup

(progn
  (require :asdf)
  (require :mcclim)
  (in-package :clim-user))

2. Aside

I used my https://medium.com/p/d4faec4f0413 lisp emacs unicode search to insert 😸⬤∿.

3. Simple game edition

Using unicode since we worked on that unicode lookup a while ago.

Same as before but basically let's have a 'cursor position' row and col.

3.1. Game frame

(define-application-frame game-frame ()
  ((display-list :initarg :display-list
                 :accessor display-list)
   (cursor-row)
   (cursor-col)
   (cursor-swap :initform '😸))
  (:pane :application
   :display-function 'display-list-tabler
   :incremental-redisplay t))

(defun display-list-tabler (frame pane)
  (with-slots (display-list) frame
    (formatting-table (pane :multiple-columns nil)
      (loop :for row :in display-list
            :for row-index :from 0 :do
              (formatting-row (pane)
                (loop
                  :for cell :in row
                  :for cell-index :from 0 :do
                    (formatting-cell
                        (pane :min-width 30 :min-height 30)
                      (updating-output
                          (pane :unique-id
                                (list row-index cell-index)
                                :id-test #'equal
                                :cache-value cell)
                        (draw-text* pane
                                    (format nil "~a" cell)
                                    0 0)))))))))

3.2. Utilities

(defun place-cursor-on-target (&optional (target '⬤))
  (with-application-frame (frame)
    (with-slots
          (display-list cursor-row cursor-col)
        frame
      (setf cursor-row
            (search `(,target) display-list :test 'member)
            cursor-col
            (search `(,target) (nth cursor-row display-list)))
      (list cursor-row cursor-col))))

(defun swap-cursor ()
  (with-application-frame (frame)
    (with-slots
          (display-list cursor-row
           cursor-col cursor-swap)
        frame
      (let* ((row (nth cursor-row display-list))
             (celllist (nthcdr cursor-col row)))
        (psetf (car celllist) cursor-swap
               cursor-swap (car celllist))))))

(defun move (Δx Δy)
  (with-application-frame (frame)
    (with-slots
          (display-list cursor-row
           cursor-col cursor-swap)
        frame
      (swap-cursor)
      (incf cursor-row Δy)
      (incf cursor-col Δx)
      (swap-cursor)
      (when (cursor-swapp '∿)
        (setf cursor-swap '☠)
        (swap-cursor)))))

(defun cursor-swapp (sym)
  (with-application-frame (frame)
    (with-slots
          (cursor-swap)
        frame
      (equal cursor-swap sym))))

3.3. Some game commands

  (define-game-frame-command (com-spawn :menu t) ()
    (when (cursor-swapp '😸)
      (place-cursor-on-target)
      (swap-cursor)))

  (define-game-frame-command (com-up :menu t)
      ()
    (let ((cat (place-cursor-on-target '😸)))
      (when cat
        (let ((Δx 0)
              (Δy -1))
          (move Δx Δy)))))

  (define-game-frame-command (com-down :menu t)
      ()
    (let ((cat (place-cursor-on-target '😸)))
      (when cat
        (let ((Δx 0)
              (Δy +1))
          (move Δx Δy)))))

  (define-game-frame-command (com-left :menu t)
      ()
    (let ((cat (place-cursor-on-target '😸)))
      (when cat
        (let ((Δx -1)
              (Δy 0))
          (move Δx Δy)))))

(define-game-frame-command (com-right :menu t)
      ()
    (let ((cat (place-cursor-on-target '😸)))
      (when cat
        (let ((Δx +1)
              (Δy 0))
          (move Δx Δy)))))

3.4. Make one of those with a 'game world'

Let's just walk from a point to another point

and if you fall in the water you die

(defparameter *game*
  (make-application-frame
   'game-frame
   :display-list
   '((""  ∿ ∿ ∿ ∿ ∿ ∿ ∿ ∿ )
     (""  ∿ ∿ ∿ ⊞ ⊞ ⊞ ⊞ ∿ )
     (""  ∿ ∿ ∿ ★ ∿ ∿ ⊞ ∿ )
     (""  ∿ ∿ ∿ ∿ ∿ ∿ ⊞ ∿ )
     (""  ∿ ⬤ ⊞ ⊞ ⊞ ⊞ ⊞ ∿ )
     (""  ∿ ∿ ∿ ∿ ∿ ∿ ∿ ∿ ))))
(run-frame-top-level *game*)

well I guess there are two hacky glitch fixes but y'know.

4. Next

See everyone for the lispy gopher climate live on Wednesday/Tuesday night! Same times, places as last week: https://mastodon.sdf.org/@screwtape/114027056148933440 and the week before that, etc.
Vote for itch.io devlogs on my Mastodon poll for where to write: https://mastodon.sdf.org/@screwtape/114032273532021596
Physically tell me here or live on the show what you like Special thanks to everyone who has been saying "Do more CLIM" for years.

</div>

Author: screwlisp

Created: 2025-02-21 Fri 21:51

Validate