Weblocks Widgets, Take 1

; Prompt is not currently in use, and I don't /think/ actually need a slot (choice) for the result...?
(defwidget choice-list ()
  ((choices :accessor choices
            :initarg :choices)
   (prompt :accessor prompt
           :initarg :prompt
           :initform "Choose an action:")
   (choice :accessor choice
           :initform nil)))

(defclass web-player ()
  ((choice-widget :accessor choice-widget
                  :initarg :choice-widget)
   (difficulty :accessor difficulty
               :initarg :difficulty)))

(defmethod render-widget-body ((widget choice-list) &rest args)
  (declare (ignore args))
  (with-html
    (:p (esc (format nil "The current choice is ~A." (choice widget))))
    (:pre :class "choices"
          (loop for choice in (choices widget)
             do (let ((x choice))
                  (render-link (lambda (&rest args)
                                 (declare (ignore args))
;                                 (setf (choice widget) x)
;                                 (mark-dirty widget)
                                 (answer widget x))
                               choice))
               (htm :br)))))

(defmethod offer-choice ((it web-player) actions &key prompt &allow-other-keys)
  (let ((new-widget (make-instance 'choice-list :choices actions :prompt prompt))
        (old-widget (choice-widget it)))
    (with-flow old-widget
      (setf (choice new-widget) (yield new-widget))
      (setf (choice-widget it) new-widget))))

(defun run-game (pc)
  (setf (difficulty pc) (offer-choice pc (list "easy" "medium" "hard") :prompt "Select difficulty:"))
  (offer-choice pc (list "G3" "H3" "I3")))

(defun make-main-page ()
  (let* ((choice-widget (make-instance 'choice-list
                                       :choices (list "A1" "B1" "C1")))
         (pc (make-instance 'web-player
                            :choice-widget choice-widget))
         (comp (make-instance 'composite :widgets
                              (list
                               "Some text."
                               choice-widget))))
    (prog1 comp
      (run-game pc))))