1 ; Copyright 2022 Frank Duncan (frank@consxy.com) under AGPL3. See distributed LICENSE.txt.
2 (in-package #:clnl-gltk)
4 (defstruct inputbox x y width first-drawn-char cursor text)
6 (defun inputbox (x y width)
7 "INPUTBOX X Y WIDTH => IB
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
18 INPUTBOX creates an inputbox widget.
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.
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))
28 (defmethod resize ((ib inputbox) width height)
30 (setf (inputbox-width ib) width))
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
37 ((px-width (+ (* width *font-width*) 6))
38 (px-height (+ (* 1 *font-height*) 6)))
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)
51 (gl:translate 2 (- px-height 4 *font-height*) 0)
53 (font-print (subseq text first-drawn-char cursor))
55 (gl:color 1f0 1f0 1f0 1f0)
58 (gl:vertex *font-width* 0)
59 (gl:vertex *font-width* (1+ *font-height*))
60 (gl:vertex 0 (1+ *font-height*))
62 (when (< cursor (length text))
63 (gl:color 0.0f0 0.0f0 0.0f0 1f0)
64 (font-print (subseq text cursor (1+ cursor))))
66 (gl:color 1f0 1f0 1f0 1f0)
68 (when (< cursor (1- (length text)))
69 (font-print (subseq text (1+ cursor) (min (length text) (+ first-drawn-char width)))))))))
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)))
75 (when (<= (+ first-drawn-char width) cursor) (incf first-drawn-char))))
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)) )))
83 (defun empty (ib) ; for control u
84 (with-slots (first-drawn-char cursor text) ib
85 (setf text (subseq text cursor))
87 (setf first-drawn-char 0)))
89 ; May someday make this generic
91 "FUNCTION CLEAR IB => RESULT
100 Rests the inputbox IB to empty."
101 (with-slots (first-drawn-char cursor text) ib
104 (setf first-drawn-char 0)
107 ; May someday make this generic
109 "FUNCTION VALUE IB => TEXT
111 ARGUMENTS AND VALUES:
114 TEXT: a string, the text currently in IB
118 Returns the TEXT that currently resides in the inputbox IB."
122 (with-slots (first-drawn-char cursor) ib
125 (when (< cursor first-drawn-char)
126 (decf first-drawn-char)))))
129 (with-slots (first-drawn-char width cursor text) ib
130 (when (< cursor (length text))
132 (when (<= (+ first-drawn-char width) cursor)
133 (incf first-drawn-char)))))
135 ; Generic this later if we add other keyboard widgets
136 (defun key-pressed (ib key)
137 "KEY-PRESSED IB KEY => RESULT
139 ARGUMENTS AND VALUES:
142 KEY: Key pressed, an integer or a symbol
147 KEY-PRESSED will do the appropriate thing in the case of a key being pressed.
149 When an integer, will insert the text into the appropriate location, if it's
150 an ascii character less than 256.
152 The other values acceptable are:
154 :key-left moves the cursor one to the left
155 :key-right moves the cursor one to the right"
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))))