Changeset main,87

Timestamp:

02/23/2008 12:27:43 AM (18 years ago)

Author:

David Owen <dsowen@…>

branch-nick:

tui

revision id:

dsowen@fugue88.ws-20080223002743-09u28trz6kvjtdpo

Message:

• Integrate checkboxes into forms.
• Fixed checkbox display glitches.
• Added keystrokes to checkbox.
• Fixed package symbols.

Location:

main

Files:

• form.lisp (modified) (5 diffs)
• widget/checkbox.lisp (modified) (6 diffs)
• widget/db-checkbox.lisp (modified) (1 diff)
• widget/package.lisp (modified) (1 diff)

main/form.lisp

@@ -41 +41 @@
    (precision :initarg :precision)
    (inactive-background :initarg :inactive-background)
+   (active-background :initarg :active-background)))
+
+(defclass checkbox-def (value-widget-def)
+  ((inactive-background :initarg :inactive-background)
    (active-background :initarg :active-background)))
 
@@ -83 +87 @@
                   :active-background (list ,@active-background)))
 
+(defun make-checkbox-def (row column name &key read-only
+                          (inactive-background
+                           *default-inactive-widget-background*)
+                          (active-background
+                           *default-active-widget-background*))
+  `(make-instance 'checkbox-def
+                  :row ,row :column ,column :name ,name :read-only ,read-only
+                  :inactive-background (list ,@inactive-background)
+                  :active-background (list ,@active-background)))
+
 (defun parse-widget-form (widget-form)
   (destructuring-bind (type &rest args) widget-form
@@ -88 +102 @@
              (:label 'make-label-def)
              (:textbox 'make-textbox-def)
-             (:numberbox 'make-numberbox-def))
+             (:numberbox 'make-numberbox-def)
+             (:checkbox 'make-checkbox-def))
            args)))
 
@@ -97 +112 @@
 * (:label row column text)
 * (:textbox row column name display-width &key data-width read-only)
-* (:numberbox row column name display-width &key data-width precision read-only)"
+* (:numberbox row column name display-width &key data-width precision read-only)
+* (:checkbox row column name)"
   (destructuring-bind (&key ((:inactive-widget-background *default-inactive-widget-background*) '(#\Nul 0))
                             ((:active-widget-background *default-active-widget-background*) '(#\Nul 0)))
@@ -146 +162 @@
                             :validator validator
                             :inactive-background inactive-background
-                            :active-background active-background))))))
+                            :active-background active-background)))))
+  (:method ((cbd checkbox-def) form)
+    (with-slots (row column name inactive-background active-background) cbd
+      (with-slots (data window scroll) form
+        (let ((r (make-reflector data name)))
+          (create-widget 'db-checkbox window (- row scroll) column
+                         :data r
+                         :inactive-background inactive-background
+                         :active-background active-background))))))
 
 

main/widget/checkbox.lisp

@@ -26 +26 @@
    (cue-window :initarg :cue-window)
    (data-window :initarg :data-window)
-   (active :type boolean :initform nil)))
+   (active :type boolean :initform nil :accessor active)))
 
 
@@ -37 +37 @@
     (setf (background data-window)
           (if active active-background inactive-background))
-    (add-clipped-string data-window 0 0 (if (checked cb) "X" " "))
+    (add-clipped-string data-window 0 0 (if (checked cb) "X" "-"))
     (setf (cursor-position data-window) '(0 0))
     (refresh cue-window)))
@@ -46 +46 @@
     (when listener
       (funcall listener))))
+
+(defmethod (setf active) :after (flag (cb checkbox))
+  (draw cb))
 
 
@@ -68 +71 @@
 (defmethod activate ((cb checkbox) &key (key-callback 'nothing)
                      &allow-other-keys)
-  (with-slots (data-window active) cb
-    (with-accessors ((checked checked)) cb
-      (set-cursor-visible t)
+  (with-slots (data-window) cb
+    (with-accessors ((active active) (checked checked)) cb
+      #|(set-cursor-visible t)|#
       (setf active t)
       (unwind-protect
@@ -78 +81 @@
                 (let ((key (read-key data-window)))
                   (case key
+                    ((#\x #\X)
+                     (setf checked t))
+                    (#\-
+                     (setf checked nil))
                     (#\Space
                      (setf checked (not checked)))
@@ -85 +92 @@
                          (return r))))))))
         (setf active nil)
-        (set-cursor-visible nil)))))
+        #|(set-cursor-visible nil)|#))))

main/widget/db-checkbox.lisp

@@ -32 +32 @@
                           &key data &allow-other-keys)
   (assert data (data) "DATA must be specified.")
+  (loop until (remf args :data))
   (let ((inst (apply 'create-widget 'checkbox parent y x args)))
-    (change-class inst 'db-checkbox :data data)))
+    (change-class inst 'db-checkbox :data data)
+    (draw inst)
+    inst))

main/widget/package.lisp

@@ -1 +1 @@
 (defpackage #:tui-widget
-  (:use #:cl #:tui-widget-generic #:tui-widget-label #:tui-widget-textbox
-        #:tui-widget-numberbox)
+  (:use #:cl #:tui-widget-generic #:tui-widget-db-checkbox #:tui-widget-label
+        #:tui-widget-textbox #:tui-widget-numberbox)
   (:export #:text #:widget #:scroll #:insertion-point #:create-widget #:destroy
            #:activate