Commit f29516f8 authored by David O'Toole's avatar David O'Toole

fix cell header rendering

parent 2f95963c
...@@ -1184,7 +1184,7 @@ replace the original grid with this one." ...@@ -1184,7 +1184,7 @@ replace the original grid with this one."
;; [[file:~/xelf/gui.org::*Cell%20spreadsheets][Cell spreadsheets:1]] ;; [[file:~/xelf/gui.org::*Cell%20spreadsheets][Cell spreadsheets:1]]
(defclass cell-sheet (sheet) (defclass cell-sheet (sheet)
((grid :initform (make-grid 8 20) :accessor grid :initarg :grid) ((grid :initform (make-grid 20 8) :accessor grid :initarg :grid)
(node-spacing :initform 2 :initarg :node-spacing :accessor node-spacing) (node-spacing :initform 2 :initarg :node-spacing :accessor node-spacing)
(cursor-row :initform 0 :initarg :cursor-row :accessor cursor-row) (cursor-row :initform 0 :initarg :cursor-row :accessor cursor-row)
(cursor-column :initform 0 :initarg :cursor-column :accessor cursor-column) (cursor-column :initform 0 :initarg :cursor-column :accessor cursor-column)
...@@ -1373,35 +1373,41 @@ replace the original grid with this one." ...@@ -1373,35 +1373,41 @@ replace the original grid with this one."
(draw-box left top (- right left) (- bottom top) (draw-box left top (- right left) (- bottom top)
:color *empty-cell-color*))) :color *empty-cell-color*)))
(defmethod cell-header-bounding-box ((sheet cell-sheet) row column) (defmethod row-header-bounding-box ((sheet cell-sheet) row)
(multiple-value-bind (top left right bottom) (let* ((top
(cell-bounding-box sheet row column) (+ (header-height sheet)
(let ((spacer (if (zerop row) (header-width sheet) 0))) (reduce #'+ (subseq (row-heights sheet)
(values top 0 row))))
(+ left spacer) (left 0)
(+ top spacer (right (header-width sheet))
(if (plusp row) (bottom (+ top (aref (row-heights sheet) row))))
(aref (column-widths sheet) column) (values top left right bottom)))
spacer))
(+ top (aref (row-heights sheet) row))))))
(defmethod draw-header-background ((sheet cell-sheet) row column)
(multiple-value-bind (top left right bottom)
(cell-header-bounding-box sheet row column)
(draw-box left top (- right left) (- bottom top) :color "red")))
(defmethod draw-header-in-cell ((sheet cell-sheet) row column string) (defmethod column-header-bounding-box ((sheet cell-sheet) column)
(multiple-value-bind (top left right bottom) (let* ((top 0)
(cell-header-bounding-box sheet row column) (left
(draw-string string left top :color "white" :font *sheet-header-font*))) (+ (header-width sheet)
(reduce #'+ (subseq (column-widths sheet)
0 column))))
(right (+ left (aref (column-widths sheet) column)))
(bottom (+ top (header-height sheet))))
(values top left right bottom)))
(defmethod draw-header-cell ((sheet cell-sheet) string top left right bottom)
(draw-box left top (- right left) (- bottom top) :color "gray20")
(draw-string string left top :color "white" :font *sheet-header-font*))
(defmethod draw-row-header ((sheet cell-sheet) row) (defmethod draw-row-header ((sheet cell-sheet) row)
(draw-header-background sheet row 0) (apply #'draw-header-cell
(draw-header-in-cell sheet row 0 (format nil "~d" row))) sheet (format nil "~d" row)
(multiple-value-list
(row-header-bounding-box sheet row))))
(defmethod draw-column-header ((sheet cell-sheet) column) (defmethod draw-column-header ((sheet cell-sheet) column)
(draw-header-background sheet 0 column) (apply #'draw-header-cell
(draw-header-in-cell sheet 0 column (format nil "~d" column))) sheet (format nil "~d" column)
(multiple-value-list
(column-header-bounding-box sheet column))))
(defmethod draw ((sheet cell-sheet)) (defmethod draw ((sheet cell-sheet))
(layout sheet) (layout sheet)
......
...@@ -5755,7 +5755,7 @@ replace the original grid with this one." ...@@ -5755,7 +5755,7 @@ replace the original grid with this one."
#+begin_src lisp :tangle commands.lisp #+begin_src lisp :tangle commands.lisp
(defclass cell-sheet (sheet) (defclass cell-sheet (sheet)
((grid :initform (make-grid 8 20) :accessor grid :initarg :grid) ((grid :initform (make-grid 20 8) :accessor grid :initarg :grid)
(node-spacing :initform 2 :initarg :node-spacing :accessor node-spacing) (node-spacing :initform 2 :initarg :node-spacing :accessor node-spacing)
(cursor-row :initform 0 :initarg :cursor-row :accessor cursor-row) (cursor-row :initform 0 :initarg :cursor-row :accessor cursor-row)
(cursor-column :initform 0 :initarg :cursor-column :accessor cursor-column) (cursor-column :initform 0 :initarg :cursor-column :accessor cursor-column)
...@@ -5943,41 +5943,41 @@ replace the original grid with this one." ...@@ -5943,41 +5943,41 @@ replace the original grid with this one."
(draw-box left top (- right left) (- bottom top) (draw-box left top (- right left) (- bottom top)
:color *empty-cell-color*))) :color *empty-cell-color*)))
(defmethod row-header-bounding-box ((sheet cell-sheet) row column) (defmethod row-header-bounding-box ((sheet cell-sheet) row)
(let* ((top FIXME (let* ((top
(+ (if (zerop column) (+ (header-height sheet)
(header-height sheet)
0)
(reduce #'+ (subseq (row-heights sheet) (reduce #'+ (subseq (row-heights sheet)
0 row)))) 0 row))))
(left (left 0)
(+ (if (zerop column) (right (header-width sheet))
0 (bottom (+ top (aref (row-heights sheet) row))))
(header-width sheet) (values top left right bottom)))
(defmethod column-header-bounding-box ((sheet cell-sheet) column)
(let* ((top 0)
(left
(+ (header-width sheet)
(reduce #'+ (subseq (column-widths sheet) (reduce #'+ (subseq (column-widths sheet)
0 column)))) 0 column))))
(right (+ left (aref (column-widths sheet) column))) (right (+ left (aref (column-widths sheet) column)))
(bottom (+ top (aref (row-heights sheet) row)))) (bottom (+ top (header-height sheet))))
(values top left right bottom))) (values top left right bottom)))
(defmethod draw-header-cell ((sheet cell-sheet) string top left right bottom)
(defmethod draw-header-background ((sheet cell-sheet) row column) (draw-box left top (- right left) (- bottom top) :color "gray20")
(multiple-value-bind (top left right bottom) (draw-string string left top :color "white" :font *sheet-header-font*))
(cell-header-bounding-box sheet row column)
(draw-box left top (- right left) (- bottom top) :color "red")))
(defmethod draw-header-in-cell ((sheet cell-sheet) row column string)
(multiple-value-bind (top left right bottom)
(cell-header-bounding-box sheet row column)
(draw-string string left top :color "white" :font *sheet-header-font*)))
(defmethod draw-row-header ((sheet cell-sheet) row) (defmethod draw-row-header ((sheet cell-sheet) row)
(draw-header-background sheet row 0) (apply #'draw-header-cell
(draw-header-in-cell sheet row 0 (format nil "~d" row))) sheet (format nil "~d" row)
(multiple-value-list
(row-header-bounding-box sheet row))))
(defmethod draw-column-header ((sheet cell-sheet) column) (defmethod draw-column-header ((sheet cell-sheet) column)
(draw-header-background sheet 0 column) (apply #'draw-header-cell
(draw-header-in-cell sheet 0 column (format nil "~d" column))) sheet (format nil "~d" column)
(multiple-value-list
(column-header-bounding-box sheet column))))
(defmethod draw ((sheet cell-sheet)) (defmethod draw ((sheet cell-sheet))
(layout sheet) (layout sheet)
...@@ -5989,7 +5989,6 @@ replace the original grid with this one." ...@@ -5989,7 +5989,6 @@ replace the original grid with this one."
(draw-column-header sheet column))) (draw-column-header sheet column)))
(do-nodes (node sheet) (do-nodes (node sheet)
(draw node)))) (draw node))))
#+end_src #+end_src
* Desktop * Desktop
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment