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

   1 ; Copyright 2022 Frank Duncan (frank@consxy.com) under AGPL3.  See distributed LICENSE.txt.
   2 (in-package #:clnl-gltk)
   3
   4 (defstruct inputbox x y width first-drawn-char cursor text)
   5
   6 (defun inputbox (x y width)
   7  "INPUTBOX X Y WIDTH => IB
   8
   9 ARGUMENTS AND VALUES:
  10
  11   X: x offset, in pixels
  12   Y: y offset, in pixels
  13   WIDTH: width, in characters
  14   IB: an inputbox that can later be rendered
  15
  16 DESCRIPTION:
  17
  18   INPUTBOX creates an inputbox widget.
  19
  20   The inputbox is a simple, single lined, box that can hold a mutating string.
  21   Use the various INPUTBOX-* functions to add to it and modify it.  As a string
  22   is added to it that is too large, it will scroll the characters automatically.
  23
  24   The widget is defined in terms of characters, rather than pixels.  In this
  25   way, it will never clip a portion of a character off."
  26  (make-inputbox :x x :y y :width width :text "" :first-drawn-char 0 :cursor 0))
  27
  28 (defmethod resize ((ib inputbox) width height)
  29  (declare (ignore y))
  30  (setf (inputbox-width ib) width))
  31
  32 (defmethod render ((ib inputbox))
  33  (gl:color 1f0 1f0 1f0)
  34  (with-slots (x y width first-drawn-char cursor text) ib
  35   (gl:with-pushed-matrix
  36    (let
  37     ((px-width (+ (* width *font-width*) 6))
  38      (px-height (+ (* 1 *font-height*) 6)))
  39     (gl:translate x y 0)
  40     (gl:line-width 1f0)
  41     (gl:begin :lines)
  42     (gl:vertex 0 0)
  43     (gl:vertex px-width 0)
  44     (gl:vertex px-width 0)
  45     (gl:vertex px-width px-height)
  46     (gl:vertex px-width px-height)
  47     (gl:vertex 0 px-height)
  48     (gl:vertex 0 px-height)
  49     (gl:vertex 0 0)
  50     (gl:end)
  51     (gl:translate 2 (- px-height 4 *font-height*) 0)
  52
  53     (font-print (subseq text first-drawn-char cursor))
  54
  55     (gl:color 1f0 1f0 1f0 1f0)
  56     (gl:begin :quads)
  57     (gl:vertex 0 0)
  58     (gl:vertex *font-width* 0)
  59     (gl:vertex *font-width* (1+ *font-height*))
  60     (gl:vertex 0 (1+ *font-height*))
  61     (gl:end)
  62     (when (< cursor (length text))
  63      (gl:color 0.0f0 0.0f0 0.0f0 1f0)
  64      (font-print (subseq text cursor (1+ cursor))))
  65
  66     (gl:color 1f0 1f0 1f0 1f0)
  67
  68     (when (< cursor (1- (length text)))
  69      (font-print (subseq text (1+ cursor) (min (length text) (+ first-drawn-char width)))))))))
  70
  71 (defun add-char (ib c)
  72  (with-slots (width first-drawn-char cursor text) ib
  73   (setf (inputbox-text ib) (format nil "~A~A~A" (subseq text 0 cursor) (code-char c) (subseq text cursor)))
  74   (incf cursor)
  75   (when (<= (+ first-drawn-char width) cursor) (incf first-drawn-char))))
  76
  77 (defun delete-char (ib)
  78  (with-slots (width first-drawn-char cursor text) ib
  79   (when (and (< 0 cursor) (< 0 (length text)))
  80    (setf (inputbox-text ib) (concatenate 'string (subseq text 0 (1- cursor)) (subseq text cursor)) )))
  81  (left ib))
  82
  83 (defun empty (ib) ; for control u
  84  (with-slots (first-drawn-char cursor text) ib
  85   (setf text (subseq text cursor))
  86   (setf cursor 0)
  87   (setf first-drawn-char 0)))
  88
  89 ; May someday make this generic
  90 (defun clear (ib)
  91  "FUNCTION CLEAR IB => RESULT
  92
  93 ARGUMENTS AND VALUES:
  94
  95   IB: an inputbox
  96   RESULT: undefined
  97
  98 DESCRIPTION:
  99
 100   Rests the inputbox IB to empty."
 101  (with-slots (first-drawn-char cursor text) ib
 102   (setf text "")
 103   (setf cursor 0)
 104   (setf first-drawn-char 0)
 105   nil))
 106
 107 ; May someday make this generic
 108 (defun value (ib)
 109  "FUNCTION VALUE IB => TEXT
 110
 111 ARGUMENTS AND VALUES:
 112
 113   IB: an inputbox
 114   TEXT: a string, the text currently in IB
 115
 116 DESCRIPTION:
 117
 118   Returns the TEXT that currently resides in the inputbox IB."
 119  (inputbox-text ib))
 120
 121 (defun left (ib)
 122  (with-slots (first-drawn-char cursor) ib
 123   (when (< 0 cursor)
 124    (decf cursor)
 125    (when (< cursor first-drawn-char)
 126     (decf first-drawn-char)))))
 127
 128 (defun right (ib)
 129  (with-slots (first-drawn-char width cursor text) ib
 130   (when (< cursor (length text))
 131    (incf cursor)
 132    (when (<= (+ first-drawn-char width) cursor)
 133     (incf first-drawn-char)))))
 134
 135 ; Generic this later if we add other keyboard widgets
 136 (defun key-pressed (ib key)
 137  "KEY-PRESSED IB KEY => RESULT
 138
 139 ARGUMENTS AND VALUES:
 140
 141   IB: An inputbox
 142   KEY: Key pressed, an integer or a symbol
 143   RESULT: Undefined
 144
 145 DESCRIPTION:
 146
 147   KEY-PRESSED will do the appropriate thing in the case of a key being pressed.
 148
 149   When an integer, will insert the text into the appropriate location, if it's
 150   an ascii character less than 256.
 151
 152   The other values acceptable are:
 153
 154   :key-left moves the cursor one to the left
 155   :key-right moves the cursor one to the right"
 156  (cond
 157   ((and (integerp key) (< 31 key 256)) (add-char ib key))
 158   ((equal key 8) (delete-char ib))
 159   ((equal key 21) (empty ib))
 160   ((equal key :key-left) (left ib))
 161   ((equal key :key-right) (right ib))))