Changeset main,46 for main/widget/textbox.lisp

Timestamp:

11/12/2007 07:08:49 PM (19 years ago)

Author:

David Owen <dsowen@…>

branch-nick:

tui

revision id:

dsowen@tux-20071112190849-f4iha3mmvx2nskce

Message:

Textboxes and numberboxes now change colors.

File:

• main/widget/textbox.lisp (modified) (4 diffs)

main/widget/textbox.lisp

@@ -10 +10 @@
 (defclass textbox (widget scroll insertion-point)
   ((data :initarg :data)
-   (window :initarg :window)))
+   (window :initarg :window)
+   (active :type boolean :initform nil)))
 
 
@@ -28 +29 @@
 
 (defmethod draw ((textbox textbox))
-  (with-slots (data window scroll) textbox
+  (with-slots (data window scroll inactive-background active-background active)
+      textbox
+    (setf (background window) (if active
+                                  active-background
+                                  inactive-background))
     (erase window)
     (add-clipped-string window 0 (- scroll) (text data))
@@ -58 +63 @@
 
 
-(defun create-textbox (parent-window y x data width)
+(defun create-textbox (parent-window y x data width &key
+                       (inactive-background '(#\Space 0))
+                       (active-background '(#\Space 0)))
   (let* ((window (tui-window::create-subwindow parent-window 1 width y x))
-         (inst (make-instance 'textbox :data data :window window)))
+         (inst (make-instance 'textbox
+                              :data data
+                              :window window
+                              :inactive-background inactive-background
+                              :active-background active-background)))
     (draw inst)
     inst))
@@ -79 +90 @@
 
 (defmethod activate ((textbox textbox) &optional (callback 'nothing))
-  (with-slots (data window) textbox
-    (cdk::c-keypad (window-pointer window) t)
-    (setf (insertion-point textbox) :end)
-    (loop
-       (let ((key (read-key window)))
-         (case key
-           (:key-left (decf (insertion-point textbox)))
-           (:key-right (incf (insertion-point textbox)))
-           (:key-home (setf (insertion-point textbox) 0))
-           (:key-end (setf (insertion-point textbox) :end))
-           (:key-backspace
-            (multiple-value-bind (left right) (split textbox)
-              (when (string/= left "")
-                (setf left (subseq left 0 (1- (length left))))
-                (setf (text data) (concatenate 'string left right))
-                (decf (insertion-point textbox)))))
-           (:key-dc
-            (multiple-value-bind (left right) (split textbox)
-              (when (string/= right "")
-                (setf right (subseq right 1))
-                (setf (text data) (concatenate 'string left right))
-                (setf (insertion-point textbox) (insertion-point textbox)))))
-           (t
-            (if (or (keywordp key)
-                    (member key '(#\Return #\Newline #\Tab #\Esc)))
-                (let ((r (funcall callback key)))
-                  (when r
-                    (setf (insertion-point textbox) 0)
-                    (return-from activate r)))
-                (multiple-value-bind (left right) (split textbox)
-                  (setf (text data)
-                        (concatenate 'string left (string key) right))
-                  (incf (insertion-point textbox))))))))))
+  (with-slots (data window active) textbox
+    (setf active t)
+    (unwind-protect
+         (progn
+           (cdk::c-keypad (window-pointer window) t)
+           (setf (insertion-point textbox) :end)
+           (loop
+              (let ((key (read-key window)))
+                (case key
+                  (:key-left (decf (insertion-point textbox)))
+                  (:key-right (incf (insertion-point textbox)))
+                  (:key-home (setf (insertion-point textbox) 0))
+                  (:key-end (setf (insertion-point textbox) :end))
+                  (:key-backspace
+                   (multiple-value-bind (left right) (split textbox)
+                     (when (string/= left "")
+                       (setf left (subseq left 0 (1- (length left))))
+                       (setf (text data) (concatenate 'string left right))
+                       (decf (insertion-point textbox)))))
+                  (:key-dc
+                   (multiple-value-bind (left right) (split textbox)
+                     (when (string/= right "")
+                       (setf right (subseq right 1))
+                       (setf (text data) (concatenate 'string left right))
+                       (setf (insertion-point textbox)
+                             (insertion-point textbox)))))
+                  (t
+                   (if (or (keywordp key)
+                           (member key '(#\Return #\Newline #\Tab #\Esc)))
+                       (let ((r (funcall callback key)))
+                         (when r
+                           (setf (insertion-point textbox) 0)
+                           (return-from activate r)))
+                       (multiple-value-bind (left right) (split textbox)
+                         (setf (text data)
+                               (concatenate 'string left (string key) right))
+                         (incf (insertion-point textbox)))))))))
+      (setf active nil))))