Changeset main,46 for main

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.

Location:

main/widget

Files:

• generic.lisp (modified) (2 diffs)
• label.lisp (modified) (1 diff)
• numberbox-test.lisp (modified) (2 diffs)
• numberbox.lisp (modified) (1 diff)
• textbox-test.lisp (modified) (1 diff)
• textbox.lisp (modified) (4 diffs)

main/widget/generic.lisp

@@ -1 +1 @@
 (defpackage #:tui-widget-generic
   (:use #:cl)
-  (:export #:text #:widget #:parent-window #:column #:row #:scroll
-           #:insertion-point #:destroy #:draw #:activate))
+  (:export #:text #:widget #:parent-window #:column #:row #:inactive-background
+           #:active-background #:scroll #:insertion-point #:destroy #:draw
+           #:activate))
 
 (in-package #:tui-widget-generic)
@@ -23 +24 @@
   ((parent-window :initarg :parent-window)
    (column :type (integer 0) :initarg :column)
-   (row :type (integer 0) :initarg :row)))
+   (row :type (integer 0) :initarg :row)
+   ;; TODO: initform for bg-color
+   (inactive-background :initarg :inactive-background)
+   (active-background :initarg :active-background)))
 
 (defclass scroll ()

main/widget/label.lisp

@@ -30 +30 @@
 
 (defmethod activate ((label label) &optional callback)
+  (declare (ignore callback))
   #\Tab)

main/widget/numberbox-test.lisp

@@ -12 +12 @@
 
 
+(defun create-nb (window row name)
+  (create-numberbox window row 10 name 10
+                    :inactive-background '(#\Space 60)
+                    :active-background '(#\Space 57)))
+
 (defun test ()
   (with-screen (s)
@@ -17 +22 @@
            (data2 (make-instance 'data))
            (data3 (make-instance 'data))
-           (nbs (list (create-numberbox s 10 10 data1 10)
-                      (create-numberbox s 11 10 data2 10)
-                      (create-numberbox s 12 10 data3 10))))
+           (nbs (list (create-nb s 10 data1)
+                      (create-nb s 11 data2)
+                      (create-nb s 12 data3))))
       (setf (cdddr nbs) nbs)
       (refresh s)

main/widget/numberbox.lisp

@@ -32 +32 @@
     (setf (text data) s)))
 
-(defun create-numberbox (parent-window y x data width)
+(defun create-numberbox (parent-window y x data width &key
+                         (inactive-background '(#\Space 0))
+                         (active-background '(#\Space 0)))
   (let* ((data-wrapper (make-instance 'numberbox-data :data data :width width))
-         (textbox (create-textbox parent-window y x data-wrapper width)))
+         (textbox (create-textbox parent-window y x data-wrapper width
+                                  :inactive-background inactive-background
+                                  :active-background active-background)))
     (change-class textbox 'numberbox)))
 

main/widget/textbox-test.lisp

@@ -14 +14 @@
   (with-screen (s)
     (let* ((data (make-instance 'data))
-           (tb (create-textbox s 10 10 data 8)))
+           (tb (create-textbox s 10 10 data 8
+                               :active-background '(#\Space 60))))
       (unwind-protect
            (flet ((cb (key)

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))))