1  (in-package :ami.ui)
 2  
 3  (define-interface route-debugger ()
 4    ()
 5    (:panes
 6     (app-selector option-pane
 7                   :items '(CCH)
 8                   :selected-item 'CCH
 9                   :title "Site")
10     ()))
11  
12  (defun select-model (pinboard-layout x y)
13    (map-pane-children
14     pinboard-layout
15     #'(lambda (object)
16         (setf (selected object) (over-pinboard-object-p object x y))))
17    (redisplay-element pinboard-layout))
18  
19  (defun draw-custom-button (gp pane x y width height)
20    (with-geometry pane
21      (gp:draw-rectangle
22       gp
23       x y
24       100 (if (selected pane) 100 40)
25       :foreground :white
26       :filled t)
27      (gp:draw-rectangle
28       gp
29       x y
30       100 (if (selected pane) 100 40)
31       :foreground (if (selected pane) :red :black)
32       :filled nil)
33      (gp:draw-string gp "Model" (+ x 3) (+ y 16) :font (gp:find-best-font pane (gp:make-font-description :weight 800 :size 11)))
34      (gp:draw-string gp "4 fields" (+ x 3) (+ y 34) :font (gp:find-best-font pane (gp:make-font-description :weight 400 :size 8)))
35      (if (selected p)
36          (dolist)
37  
38  (defclass custom-button (drawn-pinboard-object)
39    ((parent :initarg :parent :accessor parent)
40     (text :initarg :text :accessor text)
41     (selected :initarg :selected :initform nil :accessor selected))
42    (:default-initargs
43     :display-callback 'draw-custom-button))
44  
45  (defmethod calculate-constraints :after ((p custom-button))
46    (let ((num-fields 4))
47      (with-geometry p
48        (setf %min-width% 100)
49        (setf %min-height% (if (selected p) 100 40))
50        (setf %max-width% 100)
51        (setf %max-height (if (selected p) 100 40)))))
52  
53  
54  (define-interface model-space-viewer ()
55    ()
56    (:panes
57     (
58    (:layouts
59     (model-space 
60      pinboard-layout
61      nil
62      :accessor model-space-pinboard
63      :draw-with-buffer t
64      :fit-size-to-children nil
65      :input-model '(((:button-1 :press) select-model))))
66    (:default-initargs
67     :title "Model Space"
68     :best-width 500
69     :best-height 500
70     :background :white))
71                   
72  
73  (defmethod initialize-instance :after ((self model-space-viewer) &key)
74    (setf (layout-description (model-space-pinboard self))
75          (loop repeat 10
76                collect
77                (make-instance 'custom-button
78                               :text "Model"
79                               :x (random 500)
80                               :y (random 500)
81                               :width 30
82                               :height 30))))