Changeset main,43

Timestamp:

11/08/2007 07:13:21 PM (19 years ago)

Author:

David Owen <dsowen@…>

branch-nick:

tui-new

revision id:

dsowen@fugue88.ws-20071108191321-hjhsnqe3pkp72kl8

Message:

Scrolling now works.

Location:

main

Files:

• form-test.lisp (modified) (1 diff)
• form.lisp (modified) (4 diffs)

main/form-test.lisp

@@ -46 +46 @@
         (unwind-protect
              (progn
+               (setf (scroll form) 4)
                (tui-input:read-key w))
           (destroy-form form))))))

main/form.lisp

@@ -3 +3 @@
 (defpackage #:tui-form
   (:use #:cl #:dso-util #:tui-input #:tui-widget #:tui-window)
-  (:export #:form-value #:defform #:create-form #:destroy-form))
+  (:export #:form-value #:defform #:create-form #:destroy-form #:scroll))
 
 (in-package #:tui-form)
@@ -94 +94 @@
   (:method ((tbd textbox-def) form)
     (with-slots (row column name display-width) tbd
-      (with-slots (data window) form
+      (with-slots (data window scroll) form
         (let ((r (make-instance 'reflector :data data :name name)))
-          (create-textbox window row column r display-width))))))
+          (create-textbox window (- row scroll) column r display-width))))))
 
 
@@ -112 +112 @@
     (let ((lowest (reduce #'max (map 'list #'slot-value widget-defs (inflist 'row))))
           (max (1- (size window))))
-      (min 0 (- lowest max)))))
+      (max 0 (- lowest max)))))
 
 (defun percent-scroll (form)
@@ -123 +123 @@
       (setf widget (aref widgets widget)))
     (with-slots (row) widget
-        (<= scroll row (1- (size window))))))
+      (<= 0 (- row scroll) (1- (size window))))))
 
 (defmethod (setf scroll) :around (i (form form))
-  (with-slots (widget-defs peers) form
+  (with-slots (widget-defs window peers) form
     (let ((r (call-next-method (bound i 0 (max-scroll form)) form)))
       (dotimes (i (length widget-defs))
-        (let ((widget (aref widget-defs i))
-              (peer (aref peers i)))
-          (when (and peer (not (widget-visible-p form widget)))
+        (let ((peer (aref peers i)))
+          (when peer
             (destroy peer)
-            (setf (aref peers i) nil))
-          (when (and (not peer) (widget-visible-p form widget))
-            (setf (aref peers i) (create-peer widget form)))))
+            (setf (aref peers i) nil))))
+      (erase window)
+      (dotimes (i (length widget-defs))
+        (let ((widget-def (aref widget-defs i)))
+          (when (widget-visible-p form widget-def)
+            (setf (aref peers i) (create-peer widget-def form)))))
       r)))