Changeset main,57
- Timestamp:
- 11/16/2007 05:02:49 PM (19 years ago)
- branch-nick:
- tui
- revision id:
- dsowen@fugue88.ws-20071116170249-94hz80fpsdchxhwp
- Location:
- main/grid
- Files:
-
- 4 edited
-
display.lisp (modified) (4 diffs)
-
model.lisp (modified) (1 diff)
-
package.lisp (modified) (1 diff)
-
test.lisp (modified) (3 diffs)
Legend:
- Unmodified
- Added
- Removed
-
main/grid/display.lisp
r56 r57 5 5 (defclass grid () 6 6 ((data :initarg :data) 7 (header-columns :type (integer 0) :initarg :header-columns)8 7 (window :initarg :window) 9 8 (row-scroll :type (integer 0) :initform 0 :accessor row-scroll) 10 9 (column-scroll :type (integer 0) :initform 0 :accessor column-scroll))) 11 10 12 (defun make-grid (window data &key (header-columns 0))11 (defun make-grid (window data) 13 12 (make-instance 'grid 14 13 :data data 15 :header-columns header-columns16 14 :window window)) 17 15 … … 32 30 33 31 (defun column-split (grid column) 34 (with-slots ( header-columns) grid35 (saturate header-columnscolumn)))32 (with-slots (data) grid 33 (saturate (header-columns data) column))) 36 34 37 35 (defun column-offset (grid column) 38 (with-slots (data header-columns column-scroll) grid 39 (let ((base (+ header-columns column-scroll)) 40 (column-widths (mapcar (peval 'column-width data) 41 (range header-columns)))) 42 (multiple-value-bind (in-header in-data) (column-split grid column) 43 (let ((w1 (reduce '+ column-widths :end in-header)) 44 (w2 (reduce '+ column-widths :start base 45 :end (+ base in-data)))) 46 (+ w1 w2)))))) 36 (with-slots (data column-scroll) grid 37 (let ((header-columns (header-columns data))) 38 (let ((base (+ header-columns column-scroll)) 39 (column-widths (mapcar (peval 'column-width data) 40 (range header-columns)))) 41 (multiple-value-bind (in-header in-data) (column-split grid column) 42 (let ((w1 (reduce '+ column-widths :end in-header)) 43 (w2 (reduce '+ column-widths :start base 44 :end (+ base in-data)))) 45 (+ w1 w2))))))) 47 46 48 47 (defun row-split (grid row) … … 96 95 97 96 (defun draw (grid) 98 (with-slots (data header-columns window column-scroll) grid 99 (erase window) 100 (let ((x 0)) 101 (dotimes (i header-columns) 102 (draw-column grid i x) 103 (incf x (column-width data i))) 104 (do ((i (+ header-columns column-scroll) (incf i))) 105 ((or (>= i (columns data)) 106 (> x (nth-value 1 (size window))))) 107 (draw-column grid i x) 108 (incf x (column-width data i)))))) 97 (with-slots (data window column-scroll) grid 98 (let ((header-columns (header-columns data))) 99 (erase window) 100 (let ((x 0)) 101 (dotimes (i header-columns) 102 (draw-column grid i x) 103 (incf x (column-width data i))) 104 (do ((i (+ header-columns column-scroll) (incf i))) 105 ((or (>= i (columns data)) 106 (> x (nth-value 1 (size window))))) 107 (draw-column grid i x) 108 (incf x (column-width data i))))))) 109 109 110 110 … … 121 121 122 122 (defmethod max-column-scroll ((grid grid)) 123 (with-slots (data header-columnswindow) grid124 (- (columns data) header-columns1)))123 (with-slots (data window) grid 124 (- (columns data) (header-columns data) 1))) 125 125 126 126 (defmethod (setf column-scroll) :around (i (grid grid)) -
main/grid/model.lisp
r56 r57 18 18 "Returns the number of columns of data.")) 19 19 20 #|(defgeneric header-columns (grid-data)20 (defgeneric header-columns (grid-data) 21 21 (:documentation 22 22 "Returns the number of columns that contain header data, and may be 23 23 considered for locking in place during scrolling operations. Header 24 24 columns are always at the left of the grid (from column 0).") 25 (:method (grid-data) 0)) |#25 (:method (grid-data) 0)) 26 26 27 27 (defgeneric column-width (grid-data column) -
main/grid/package.lisp
r56 r57 1 1 (defpackage #:grid 2 2 (:use #:cl #:dso-util #:tui-display-string #:tui-output #:tui-window) 3 (:export #:rows #:header-rows #:columns #: column-width #:item4 #: uses-display-strings #:row-scroll #:column-scroll #:make-grid5 #: draw))3 (:export #:rows #:header-rows #:columns #:header-columns #:column-width 4 #:item #:uses-display-strings #:row-scroll #:column-scroll 5 #:make-grid #:draw)) -
main/grid/test.lisp
r56 r57 15 15 16 16 (defmethod columns ((gd test)) 10) 17 18 (defmethod header-columns ((gd test)) 19 1) 17 20 18 21 (defmethod column-width ((gd test) column) … … 44 47 (clear screen) 45 48 (with-subwindow (window screen 5 16 0 0) 46 (let ((grid (make-grid window data :header-columns 1)))49 (let ((grid (make-grid window data))) 47 50 (flet ((try (i) 48 51 (setf (row-scroll grid) i) … … 60 63 (try 99)))) 61 64 (clear screen) 62 (let ((grid (make-grid screen data :header-columns 1)))65 (let ((grid (make-grid screen data))) 63 66 (draw grid) 64 67 (read-key screen)))))
Note: See TracChangeset
for help on using the changeset viewer.
