1 ; Copyright 2022 Frank Duncan (frank@consxy.com) under AGPL3. See distributed LICENSE.txt.
2 (in-package #:clnl-gltk)
4 ; add word wrpaping, add border optional, so can use for text boxes for the TEXTBOX widget
6 (defstruct textbox x y width height text word-wrap border)
8 (setf (documentation 'textbox-text 'function)
9 "TEXTBOX-TEXT TB => TEXT
14 TEXT: string currently being displayed
18 TEXTBOX-TEXT allows for the retrieving and setting of the internal text
21 (defun textbox (x y width height &key text (border t) word-wrap)
22 "TEXTBOX X Y WIDTH HEIGHT &key TEXT BORDER WORD-WRAP => TB
26 X: x offset, in pixels
27 Y: y offset, in pixels
28 WIDTH: width, in characters
29 HEIGHT: height, in characters
30 TEXT: optional string for the textual display
31 BORDER: boolean, whether we draw a border, defaults to t
32 WORD-WRAP: boolean, whether we attempt to wrap the text
33 TB: a textbox that can later be rendered
37 TEXTBOX creates a textbox widget.
39 The widget is defined in terms of characters, rather than pixels. In this
40 way, it will never clip a portion of a character off. It will also display
41 whatever it can of its text, clipping off characters that are outside.
43 Multiline strings are supported, and each one appears on a new line.
45 When BORDER is NIL, no border is drawn and the text box floats, which can be
48 When WORD-WRAP is non NIL, the text is attempted to wrap by the following rules.
49 The wrapping is done at the line if possible, at a breaking character if possible,
50 or just fits as many letters as it can befoer wrapping. It then only clips off
51 on the bottom. The only breaking character currently is #\Space."
52 (make-textbox :x x :y y :width width :height height :text text :border border :word-wrap word-wrap))
54 (defmethod resize ((tb textbox) width height)
55 (setf (textbox-width tb) width)
56 (setf (textbox-height tb) height))
58 (defmethod reposition ((tb textbox) x y)
59 (setf (textbox-x tb) x)
60 (setf (textbox-y tb) y))
62 (defun break-lines (text width)
64 ((zerop (length text)) nil)
65 ((char= #\Space (aref text 0)) (break-lines (subseq text 1) width))
66 ((char= #\Newline (aref text 0)) (break-lines (subseq text 1) width))
70 (> (length text) width)
71 (position #\Space (subseq text 0 width) :from-end t)))
72 (pos-nl (position #\Newline text))
75 ((and pos-nl (< pos-nl width)) pos-nl)
76 ((and pos-space (< pos-space width)) pos-space)
77 ((min width (length text))))))
80 (break-lines (subseq text pos) width))))))
82 (defmethod render ((tb textbox))
83 (gl:color 1f0 1f0 1f0)
84 (with-slots (x y width height text border word-wrap) tb
85 (gl:with-pushed-matrix
87 ((px-width (+ (* width *font-width*) 6))
88 (px-height (+ (* height *font-height*) 6)))
90 (when border (draw-border 0 0 px-width px-height))
91 (gl:translate 2 (- px-height 4 *font-height*) 0)
94 ((lines (if word-wrap (break-lines text width) (cl-ppcre:split "\\n" text))))
100 (gl:with-pushed-matrix
101 (font-print (subseq line 0 (min (length line) width))))
102 (gl:translate 0 (- *font-height*) 0)))))))))