1 (in-package #:clnl-gltk)
3 ; add word wrpaping, add border optional, so can use for text boxes for the TEXTBOX widget
5 (defstruct textbox x y width height text word-wrap border)
7 (setf (documentation 'textbox-text 'function)
8 "TEXTBOX-TEXT TB => TEXT
13 TEXT: string currently being displayed
17 TEXTBOX-TEXT allows for the retrieving and setting of the internal text
20 (defun textbox (x y width height &key text (border t) word-wrap)
21 "TEXTBOX X Y WIDTH HEIGHT &key TEXT BORDER WORD-WRAP => TB
25 X: x offset, in pixels
26 Y: y offset, in pixels
27 WIDTH: width, in characters
28 HEIGHT: height, in characters
29 TEXT: optional string for the textual display
30 BORDER: boolean, whether we draw a border, defaults to t
31 WORD-WRAP: boolean, whether we attempt to wrap the text
32 TB: a textbox that can later be rendered
36 TEXTBOX creates a textbox widget.
38 The widget is defined in terms of characters, rather than pixels. In this
39 way, it will never clip a portion of a character off. It will also display
40 whatever it can of its text, clipping off characters that are outside.
42 Multiline strings are supported, and each one appears on a new line.
44 When BORDER is NIL, no border is drawn and the text box floats, which can be
47 When WORD-WRAP is non NIL, the text is attempted to wrap by the following rules.
48 The wrapping is done at the line if possible, at a breaking character if possible,
49 or just fits as many letters as it can befoer wrapping. It then only clips off
50 on the bottom. The only breaking character currently is #\Space."
51 (make-textbox :x x :y y :width width :height height :text text :border border :word-wrap word-wrap))
53 (defmethod resize ((tb textbox) width height)
54 (setf (textbox-width tb) width)
55 (setf (textbox-height tb) height))
57 (defmethod reposition ((tb textbox) x y)
58 (setf (textbox-x tb) x)
59 (setf (textbox-y tb) y))
61 (defun break-lines (text width)
63 ((zerop (length text)) nil)
64 ((char= #\Space (aref text 0)) (break-lines (subseq text 1) width))
65 ((char= #\Newline (aref text 0)) (break-lines (subseq text 1) width))
69 (> (length text) width)
70 (position #\Space (subseq text 0 width) :from-end t)))
71 (pos-nl (position #\Newline text))
74 ((and pos-nl (< pos-nl width)) pos-nl)
75 ((and pos-space (< pos-space width)) pos-space)
76 ((min width (length text))))))
79 (break-lines (subseq text pos) width))))))
81 (defmethod render ((tb textbox))
82 (gl:color 1f0 1f0 1f0)
83 (with-slots (x y width height text border word-wrap) tb
84 (gl:with-pushed-matrix
86 ((px-width (+ (* width *font-width*) 6))
87 (px-height (+ (* height *font-height*) 6)))
89 (when border (draw-border 0 0 px-width px-height))
90 (gl:translate 2 (- px-height 4 *font-height*) 0)
93 ((lines (if word-wrap (break-lines text width) (cl-ppcre:split "\\n" text))))
99 (gl:with-pushed-matrix
100 (font-print (subseq line 0 (min (length line) width))))
101 (gl:translate 0 (- *font-height*) 0)))))))))