code.consxy.com Git - clnl/blob - src/main/clnl-gltk/switch.lisp

   1 ; Copyright 2022 Frank Duncan (frank@consxy.com) under AGPL3.  See distributed LICENSE.txt.
   2 (in-package #:clnl-gltk)
   3
   4 (defstruct switch x y width text callback hover on)
   5
   6 ; Height is constant for switches in netlogo
   7 (defvar *switch-height* 33
   8  "*SWITCH-HEIGHT*
   9
  10 VALUE TYPE:
  11
  12   an integer
  13
  14 INITIAL VALUE:
  15
  16   33
  17
  18 DESCRIPTION:
  19
  20   The default switch height.")
  21
  22 (defun in-switch (m-x m-y switch)
  23  (with-slots (x y width) switch
  24   (and (< x m-x (+ x width)) (< y m-y (+ y *switch-height*)))))
  25
  26 (defun switch (x y width text callback &optional initial-state)
  27  "SWITCH X Y WIDTH TEXT CALLBACK &optional INITIAL-STATE => SWITCH
  28
  29 ARGUMENTS AND VALUES:
  30
  31   X: x offset, in pixels
  32   Y: y offset, in pixels
  33   WIDTH: width, in pixels
  34   TEXT: string for the textual display
  35   CALLBACK: a function
  36   INITIAL-STATE: a boolean, defaulting to nil
  37   SWITCH: a switch that can later be rendered
  38
  39 DESCRIPTION:
  40
  41   SWITCH creates a switch widget.
  42
  43   The widget will center the viewable TEXT inside itself, replacing the
  44   last three characters with an ellipses if the text is too large for the
  45   given dimensions.  It will never clip a character.
  46
  47   SWITCH objects also work with mouse movement functions.  When it identifies
  48   that a mousedown has happened, the state of the SWITCH will be changed,
  49   and CALLBACK will be called with the new state.
  50
  51   The INITIAL-STATE defines whether the switch starts on or off."
  52  (make-switch :x x :y y :width width :text text :callback callback :on initial-state))
  53
  54 (defmethod render ((switch switch))
  55  (gl:color 1f0 1f0 1f0)
  56  (with-slots (x y width text hover on) switch
  57   (gl:with-pushed-matrix
  58    (gl:translate x y 0)
  59
  60    (when hover
  61     (gl:color .25f0 .25f0 .25f0)
  62     (gl:begin :quads)
  63     (gl:vertex 0 0) (gl:vertex width 0) (gl:vertex width *switch-height*) (gl:vertex 0 *switch-height*)
  64     (gl:end))
  65
  66    (gl:color 1f0 1f0 1f0)
  67    (gl:begin :quads)
  68    (gl:vertex 6 4) (gl:vertex 8 4) (gl:vertex 8 28) (gl:vertex 6 28)
  69    (gl:end)
  70
  71    (let
  72     ((bottom (if on 21 8)))
  73     (gl:color 0f0 0f0 0f0)
  74     (gl:begin :quads)
  75     (gl:vertex 2 bottom) (gl:vertex 12 bottom) (gl:vertex 12 (+ bottom 4)) (gl:vertex 2 (+ bottom 4))
  76     (gl:end)
  77     (gl:color 1f0 1f0 1f0)
  78     (draw-border 2 bottom 12 (+ bottom 4)))
  79
  80    (gl:color 1f0 1f0 1f0)
  81    (gl:with-pushed-matrix (gl:translate 14 15 0) (font-print "On"))
  82    (gl:with-pushed-matrix (gl:translate 14 1 0) (font-print "Off"))
  83
  84    (draw-border 0 0 width *switch-height*)
  85
  86    ; It also clips off text if too long, and replaces with elipses, so we can do similar
  87    (let
  88     ((text
  89       (if (< (* *font-width* (length text)) (- width 46))
  90        text
  91        (format nil "~A..." (subseq text 0 (- (truncate (- width 46) *font-width*) 3))))))
  92     (gl:translate
  93      (truncate (- width -28 (* *font-width* (length text))) 2)
  94      (truncate (- *switch-height* 4 *font-height*) 2)
  95      0)
  96     (font-print text)))))
  97
  98 (defmethod toggle ((switch switch) &optional (state :unused))
  99  (setf (switch-on switch) (if (eql state :unused) (not (switch-on switch)) state)))
 100
 101 (defmethod reposition ((switch switch) x y)
 102  (setf (switch-x switch) x)
 103  (setf (switch-y switch) y))
 104
 105 (defmethod resize ((switch switch) width height)
 106  (declare (ignore height))
 107  (setf (switch-width switch) width))
 108
 109 (defmethod mousemove ((switch switch) m-x m-y)
 110  (setf (switch-hover switch) (in-switch m-x m-y switch)))
 111
 112 (defmethod mousedown ((switch switch) m-x m-y)
 113  (when (in-switch m-x m-y switch) (toggle switch) (funcall (switch-callback switch) (switch-on switch))))