X-Git-Url: https://code.consxy.com/gitweb/gitweb.cgi?a=blobdiff_plain;f=src%2Fmain%2Fclnl-gltk%2Finputbox.lisp;fp=src%2Fmain%2Fclnl-gltk%2Finputbox.lisp;h=78c70f0fba4ccf486545093563def88de1ac8147;hb=7fac438c77bb0e3749bababc0cc89a1366893444;hp=0000000000000000000000000000000000000000;hpb=89cb3482de1fefc2d8e5f67e1e04a0790e8cd243;p=clnl

diff --git a/src/main/clnl-gltk/inputbox.lisp b/src/main/clnl-gltk/inputbox.lisp
new file mode 100644
index 0000000..78c70f0
--- /dev/null
+++ b/src/main/clnl-gltk/inputbox.lisp
@@ -0,0 +1,160 @@
+(in-package #:clnl-gltk)
+
+(defstruct inputbox x y width first-drawn-char cursor text)
+
+(defun inputbox (x y width)
+ "INPUTBOX X Y WIDTH => IB
+
+ARGUMENTS AND VALUES:
+
+  X: x offset, in pixels
+  Y: y offset, in pixels
+  WIDTH: width, in characters
+  IB: an inputbox that can later be rendered
+
+DESCRIPTION:
+
+  INPUTBOX creates an inputbox widget.
+
+  The inputbox is a simple, single lined, box that can hold a mutating string.
+  Use the various INPUTBOX-* functions to add to it and modify it.  As a string
+  is added to it that is too large, it will scroll the characters automatically.
+
+  The widget is defined in terms of characters, rather than pixels.  In this
+  way, it will never clip a portion of a character off."
+ (make-inputbox :x x :y y :width width :text "" :first-drawn-char 0 :cursor 0))
+
+(defmethod resize ((ib inputbox) width height)
+ (declare (ignore y))
+ (setf (inputbox-width ib) width))
+
+(defmethod render ((ib inputbox))
+ (gl:color 1f0 1f0 1f0)
+ (with-slots (x y width first-drawn-char cursor text) ib
+  (gl:with-pushed-matrix
+   (let
+    ((px-width (+ (* width *font-width*) 6))
+     (px-height (+ (* 1 *font-height*) 6)))
+    (gl:translate x y 0)
+    (gl:line-width 1f0)
+    (gl:begin :lines)
+    (gl:vertex 0 0)
+    (gl:vertex px-width 0)
+    (gl:vertex px-width 0)
+    (gl:vertex px-width px-height)
+    (gl:vertex px-width px-height)
+    (gl:vertex 0 px-height)
+    (gl:vertex 0 px-height)
+    (gl:vertex 0 0)
+    (gl:end)
+    (gl:translate 2 (- px-height 4 *font-height*) 0)
+
+    (font-print (subseq text first-drawn-char cursor))
+
+    (gl:color 1f0 1f0 1f0 1f0)
+    (gl:begin :quads)
+    (gl:vertex 0 0)
+    (gl:vertex *font-width* 0)
+    (gl:vertex *font-width* (1+ *font-height*))
+    (gl:vertex 0 (1+ *font-height*))
+    (gl:end)
+    (when (< cursor (length text))
+     (gl:color 0.0f0 0.0f0 0.0f0 1f0)
+     (font-print (subseq text cursor (1+ cursor))))
+
+    (gl:color 1f0 1f0 1f0 1f0)
+
+    (when (< cursor (1- (length text)))
+     (font-print (subseq text (1+ cursor) (min (length text) (+ first-drawn-char width)))))))))
+
+(defun add-char (ib c)
+ (with-slots (width first-drawn-char cursor text) ib
+  (setf (inputbox-text ib) (format nil "~A~A~A" (subseq text 0 cursor) (code-char c) (subseq text cursor)))
+  (incf cursor)
+  (when (<= (+ first-drawn-char width) cursor) (incf first-drawn-char))))
+
+(defun delete-char (ib)
+ (with-slots (width first-drawn-char cursor text) ib
+  (when (and (< 0 cursor) (< 0 (length text)))
+   (setf (inputbox-text ib) (concatenate 'string (subseq text 0 (1- cursor)) (subseq text cursor)) )))
+ (left ib))
+
+(defun empty (ib) ; for control u
+ (with-slots (first-drawn-char cursor text) ib
+  (setf text (subseq text cursor))
+  (setf cursor 0)
+  (setf first-drawn-char 0)))
+
+; May someday make this generic
+(defun clear (ib)
+ "FUNCTION CLEAR IB => RESULT
+
+ARGUMENTS AND VALUES:
+
+  IB: an inputbox
+  RESULT: undefined
+
+DESCRIPTION:
+
+  Rests the inputbox IB to empty."
+ (with-slots (first-drawn-char cursor text) ib
+  (setf text "")
+  (setf cursor 0)
+  (setf first-drawn-char 0)
+  nil))
+
+; May someday make this generic
+(defun value (ib)
+ "FUNCTION VALUE IB => TEXT
+
+ARGUMENTS AND VALUES:
+
+  IB: an inputbox
+  TEXT: a string, the text currently in IB
+
+DESCRIPTION:
+
+  Returns the TEXT that currently resides in the inputbox IB."
+ (inputbox-text ib))
+
+(defun left (ib)
+ (with-slots (first-drawn-char cursor) ib
+  (when (< 0 cursor)
+   (decf cursor)
+   (when (< cursor first-drawn-char)
+    (decf first-drawn-char)))))
+
+(defun right (ib)
+ (with-slots (first-drawn-char width cursor text) ib
+  (when (< cursor (length text))
+   (incf cursor)
+   (when (<= (+ first-drawn-char width) cursor)
+    (incf first-drawn-char)))))
+
+; Generic this later if we add other keyboard widgets
+(defun key-pressed (ib key)
+ "KEY-PRESSED IB KEY => RESULT
+
+ARGUMENTS AND VALUES:
+
+  IB: An inputbox
+  KEY: Key pressed, an integer or a symbol
+  RESULT: Undefined
+
+DESCRIPTION:
+
+  KEY-PRESSED will do the appropriate thing in the case of a key being pressed.
+
+  When an integer, will insert the text into the appropriate location, if it's
+  an ascii character less than 256.
+
+  The other values acceptable are:
+
+  :key-left moves the cursor one to the left
+  :key-right moves the cursor one to the right"
+ (cond
+  ((and (integerp key) (< 31 key 256)) (add-char ib key))
+  ((equal key 8) (delete-char ib))
+  ((equal key 21) (empty ib))
+  ((equal key :key-left) (left ib))
+  ((equal key :key-right) (right ib))))