28.6 Examples of Applications

The following is an example that outlines a simple 4-by-4 sliding piece puzzle: [annotate]

(define-application-frame puzzle ()
    ((puzzle-array :initform (make-array '(4 4))))
  (:menu-bar t)
  (:panes
    (display
      (outlining ()
        (make-pane 'application-pane
                   :text-cursor nil
                   :width :compute
                   :height :compute
                   :incremental-redisplay T
                   :display-function 'draw-puzzle))))
  (:layouts
    (:default display)))

(defmethod run-frame-top-level :before ((puzzle puzzle))
  ;; Initialize the puzzle
  ...)

(define-presentation-type puzzle-cell ()
  :inherit-from '(integer 1 15))

(defmethod draw-puzzle ((puzzle puzzle) stream &key max-width max-height)
  (declare (ignore max-width max-height))
  ;; Draw the puzzle, presenting each cell as a PUZZLE-CELL
  ...)

(define-puzzle-command com-move-cell
    ((cell 'puzzle-cell :gesture :select))
  ;; Move the selected cell to the adjacent open cell,
  ;; if there is one
  ...)

(define-puzzle-command (com-scramble :menu t)
    ()
  ;; Scramble the pieces of the puzzle
  ...)

(define-puzzle-command (com-exit-puzzle :menu "Exit")
    ()
  (frame-exit *application-frame*))

(defun puzzle ()
  (let ((puzzle 
          (make-application-frame 'puzzle 
            :width 80 :height 80)))
    (run-frame-top-level puzzle)))

The following is an application frame with two layouts: [annotate]

(define-application-frame test-frame () ()
  (:panes
    (a (horizontally ()
         (make-pane 'push-button :label "Press me")
         (make-pane 'push-button :label "Squeeze me")))
    (b toggle-button)
    (c slider)
    (d text-field)
    (e :interactor-pane
       :width 300 :max-width +fill+
       :height 300 :max-height +fill+))
  (:layouts
    (default 
      (vertically ()
        a b c (scrolling () e)))
    (other
      (vertically ()
        a (scrolling () e) b d))))

(define-test-frame-command (com-switch :name t :menu t)
    ()
  (setf (frame-current-layout *application-frame*)
        (ecase (frame-current-layout *application-frame*)
          (default other)
          (other default))))

(let ((test-frame 
        (make-application-frame 'test-frame)))
  (run-frame-top-level test-frame))