1 (in-package #:clnl-gltk)
3 (defstruct inputbox x y width first-drawn-char cursor text)
5 (defun inputbox (x y width)
6 "INPUTBOX X Y WIDTH => IB
10 X: x offset, in pixels
11 Y: y offset, in pixels
12 WIDTH: width, in characters
13 IB: an inputbox that can later be rendered
17 INPUTBOX creates an inputbox widget.
19 The inputbox is a simple, single lined, box that can hold a mutating string.
20 Use the various INPUTBOX-* functions to add to it and modify it. As a string
21 is added to it that is too large, it will scroll the characters automatically.
23 The widget is defined in terms of characters, rather than pixels. In this
24 way, it will never clip a portion of a character off."
25 (make-inputbox :x x :y y :width width :text "" :first-drawn-char 0 :cursor 0))
27 (defmethod resize ((ib inputbox) width height)
29 (setf (inputbox-width ib) width))
31 (defmethod render ((ib inputbox))
32 (gl:color 1f0 1f0 1f0)
33 (with-slots (x y width first-drawn-char cursor text) ib
34 (gl:with-pushed-matrix
36 ((px-width (+ (* width *font-width*) 6))
37 (px-height (+ (* 1 *font-height*) 6)))
42 (gl:vertex px-width 0)
43 (gl:vertex px-width 0)
44 (gl:vertex px-width px-height)
45 (gl:vertex px-width px-height)
46 (gl:vertex 0 px-height)
47 (gl:vertex 0 px-height)
50 (gl:translate 2 (- px-height 4 *font-height*) 0)
52 (font-print (subseq text first-drawn-char cursor))
54 (gl:color 1f0 1f0 1f0 1f0)
57 (gl:vertex *font-width* 0)
58 (gl:vertex *font-width* (1+ *font-height*))
59 (gl:vertex 0 (1+ *font-height*))
61 (when (< cursor (length text))
62 (gl:color 0.0f0 0.0f0 0.0f0 1f0)
63 (font-print (subseq text cursor (1+ cursor))))
65 (gl:color 1f0 1f0 1f0 1f0)
67 (when (< cursor (1- (length text)))
68 (font-print (subseq text (1+ cursor) (min (length text) (+ first-drawn-char width)))))))))
70 (defun add-char (ib c)
71 (with-slots (width first-drawn-char cursor text) ib
72 (setf (inputbox-text ib) (format nil "~A~A~A" (subseq text 0 cursor) (code-char c) (subseq text cursor)))
74 (when (<= (+ first-drawn-char width) cursor) (incf first-drawn-char))))
76 (defun delete-char (ib)
77 (with-slots (width first-drawn-char cursor text) ib
78 (when (and (< 0 cursor) (< 0 (length text)))
79 (setf (inputbox-text ib) (concatenate 'string (subseq text 0 (1- cursor)) (subseq text cursor)) )))
82 (defun empty (ib) ; for control u
83 (with-slots (first-drawn-char cursor text) ib
84 (setf text (subseq text cursor))
86 (setf first-drawn-char 0)))
88 ; May someday make this generic
90 "FUNCTION CLEAR IB => RESULT
99 Rests the inputbox IB to empty."
100 (with-slots (first-drawn-char cursor text) ib
103 (setf first-drawn-char 0)
106 ; May someday make this generic
108 "FUNCTION VALUE IB => TEXT
110 ARGUMENTS AND VALUES:
113 TEXT: a string, the text currently in IB
117 Returns the TEXT that currently resides in the inputbox IB."
121 (with-slots (first-drawn-char cursor) ib
124 (when (< cursor first-drawn-char)
125 (decf first-drawn-char)))))
128 (with-slots (first-drawn-char width cursor text) ib
129 (when (< cursor (length text))
131 (when (<= (+ first-drawn-char width) cursor)
132 (incf first-drawn-char)))))
134 ; Generic this later if we add other keyboard widgets
135 (defun key-pressed (ib key)
136 "KEY-PRESSED IB KEY => RESULT
138 ARGUMENTS AND VALUES:
141 KEY: Key pressed, an integer or a symbol
146 KEY-PRESSED will do the appropriate thing in the case of a key being pressed.
148 When an integer, will insert the text into the appropriate location, if it's
149 an ascii character less than 256.
151 The other values acceptable are:
153 :key-left moves the cursor one to the left
154 :key-right moves the cursor one to the right"
156 ((and (integerp key) (< 31 key 256)) (add-char ib key))
157 ((equal key 8) (delete-char ib))
158 ((equal key 21) (empty ib))
159 ((equal key :key-left) (left ib))
160 ((equal key :key-right) (right ib))))