scratch.lisp @ cb3863ea23c1 default tip

More
author Steve Losh <steve@stevelosh.com>
date Thu, 22 Apr 2021 00:50:55 -0400
parents 9d304403bb0b
children (none)
(in-package :mycelium)

(ql:quickload :bordeaux-threads)

(bt:interrupt-thread
  (first (remove "main thread" (bt:all-threads) :key #'bt:thread-name :test-not #'string=))
  (lambda () (error "stop")))

(ql:quickload :boots)


(boots%::print-attr
  (boots:attr :fg (boots:rgb 1 2 3)))

(defun key-name (key)
  (case key 
    (#\tab "tab")
    (t (string key))))

(defun select-box (heading options)
  (with-chiron-layer
      (boots:stack (:margin t :width 20 :height (+ (length options) 2) :border t
                    :fill-char #\space :fill-attr +default+)
        (boots:canvas (:fill-char #\space :fill-attr +default+ :height 1 :border-bottom t) (pad)
          (boots:draw pad
                      (truncate (- (boots:width pad) (length heading)) 2)
                      0 heading +default+))
        (boots:canvas (:fill-char #\space :fill-attr +default+) (pad)
          (iterate (for y :from 0)
                   (for (key description result) :in options)
                   (boots:draw pad 0 y (format nil "[~A] ~A" (key-name key)
                                               description) +default+))))
    (third (iterate
             (boots:redraw)
             (for (values e m) = (boots:read-event))
             (unless (handle-global-event e m)
               (thereis (find-if (lambda (option)
                                   (boots:event= option e m))
                                 options :key #'first)))))))


(widget-pos 'forage)
(panel-widgets (current-panel))

(mod -1 6)

(current-panel)
(focus-dir 0 1)

(focus 'forage)
(focusedp 'forage)
(unlockedp 'money)

(values *calories*)
(offer 'tools 'field-guide)

(iterate (for i :in (available-to-buy))
         (collect (cons (description i)
                        (cons (section i) (key i)))))