1 (in-package #:clnl-gltk)
3 (defstruct switch x y width text callback hover on)
5 ; Height is constant for switches in netlogo
6 (defvar *switch-height* 33
19 The default switch height.")
21 (defun in-switch (m-x m-y switch)
22 (with-slots (x y width) switch
23 (and (< x m-x (+ x width)) (< y m-y (+ y *switch-height*)))))
25 (defun switch (x y width text callback &optional initial-state)
26 "SWITCH X Y WIDTH TEXT CALLBACK &optional INITIAL-STATE => SWITCH
30 X: x offset, in pixels
31 Y: y offset, in pixels
32 WIDTH: width, in pixels
33 TEXT: string for the textual display
35 INITIAL-STATE: a boolean, defaulting to nil
36 SWITCH: a switch that can later be rendered
40 SWITCH creates a switch widget.
42 The widget will center the viewable TEXT inside itself, replacing the
43 last three characters with an ellipses if the text is too large for the
44 given dimensions. It will never clip a character.
46 SWITCH objects also work with mouse movement functions. When it identifies
47 that a mousedown has happened, the state of the SWITCH will be changed,
48 and CALLBACK will be called with the new state.
50 The INITIAL-STATE defines whether the switch starts on or off."
51 (make-switch :x x :y y :width width :text text :callback callback :on initial-state))
53 (defmethod render ((switch switch))
54 (gl:color 1f0 1f0 1f0)
55 (with-slots (x y width text hover on) switch
56 (gl:with-pushed-matrix
60 (gl:color .25f0 .25f0 .25f0)
62 (gl:vertex 0 0) (gl:vertex width 0) (gl:vertex width *switch-height*) (gl:vertex 0 *switch-height*)
65 (gl:color 1f0 1f0 1f0)
67 (gl:vertex 6 4) (gl:vertex 8 4) (gl:vertex 8 28) (gl:vertex 6 28)
71 ((bottom (if on 21 8)))
72 (gl:color 0f0 0f0 0f0)
74 (gl:vertex 2 bottom) (gl:vertex 12 bottom) (gl:vertex 12 (+ bottom 4)) (gl:vertex 2 (+ bottom 4))
76 (gl:color 1f0 1f0 1f0)
77 (draw-border 2 bottom 12 (+ bottom 4)))
79 (gl:color 1f0 1f0 1f0)
80 (gl:with-pushed-matrix (gl:translate 14 15 0) (font-print "On"))
81 (gl:with-pushed-matrix (gl:translate 14 1 0) (font-print "Off"))
83 (draw-border 0 0 width *switch-height*)
85 ; It also clips off text if too long, and replaces with elipses, so we can do similar
88 (if (< (* *font-width* (length text)) (- width 46))
90 (format nil "~A..." (subseq text 0 (- (truncate (- width 46) *font-width*) 3))))))
92 (truncate (- width -28 (* *font-width* (length text))) 2)
93 (truncate (- *switch-height* 4 *font-height*) 2)
97 (defmethod toggle ((switch switch) &optional (state :unused))
98 (setf (switch-on switch) (if (eql state :unused) (not (switch-on switch)) state)))
100 (defmethod reposition ((switch switch) x y)
101 (setf (switch-x switch) x)
102 (setf (switch-y switch) y))
104 (defmethod resize ((switch switch) width height)
105 (declare (ignore height))
106 (setf (switch-width switch) width))
108 (defmethod mousemove ((switch switch) m-x m-y)
109 (setf (switch-hover switch) (in-switch m-x m-y switch)))
111 (defmethod mousedown ((switch switch) m-x m-y)
112 (when (in-switch m-x m-y switch) (toggle switch) (funcall (switch-callback switch) (switch-on switch))))