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."
;; [[file:~/xelf/gui.org::*Cell%20spreadsheets][Cell spreadsheets:1]]
(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)
(cursor-row :initform 0 :initarg :cursor-row :accessor cursor-row)
(cursor-column :initform 0 :initarg :cursor-column :accessor cursor-column)
......@@ -1373,35 +1373,41 @@ replace the original grid with this one."
(draw-box left top (- right left) (- bottom top)
:color *empty-cell-color*)))
(defmethod cell-header-bounding-box ((sheet cell-sheet) row column)
(multiple-value-bind (top left right bottom)
(cell-bounding-box sheet row column)
(let ((spacer (if (zerop row) (header-width sheet) 0)))
(values top
(+ left spacer)
(+ top spacer
(if (plusp row)
(aref (column-widths sheet) column)
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 row-header-bounding-box ((sheet cell-sheet) row)
(let* ((top
(+ (header-height sheet)
(reduce #'+ (subseq (row-heights sheet)
0 row))))
(left 0)
(right (header-width sheet))
(bottom (+ top (aref (row-heights sheet) row))))
(values top left right bottom)))
(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 column-header-bounding-box ((sheet cell-sheet) column)
(let* ((top 0)
(left
(+ (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)
(draw-header-background sheet row 0)
(draw-header-in-cell sheet row 0 (format nil "~d" row)))
(apply #'draw-header-cell
sheet (format nil "~d" row)
(multiple-value-list
(row-header-bounding-box sheet row))))
(defmethod draw-column-header ((sheet cell-sheet) column)
(draw-header-background sheet 0 column)
(draw-header-in-cell sheet 0 column (format nil "~d" column)))
(apply #'draw-header-cell
sheet (format nil "~d" column)
(multiple-value-list
(column-header-bounding-box sheet column))))
(defmethod draw ((sheet cell-sheet))
(layout sheet)
......
......@@ -5755,7 +5755,7 @@ replace the original grid with this one."
#+begin_src lisp :tangle commands.lisp
(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)
(cursor-row :initform 0 :initarg :cursor-row :accessor cursor-row)
(cursor-column :initform 0 :initarg :cursor-column :accessor cursor-column)
......@@ -5943,41 +5943,41 @@ replace the original grid with this one."
(draw-box left top (- right left) (- bottom top)
:color *empty-cell-color*)))
(defmethod row-header-bounding-box ((sheet cell-sheet) row column)
(let* ((top FIXME
(+ (if (zerop column)
(header-height sheet)
0)
(defmethod row-header-bounding-box ((sheet cell-sheet) row)
(let* ((top
(+ (header-height sheet)
(reduce #'+ (subseq (row-heights sheet)
0 row))))
(left
(+ (if (zerop column)
0
(header-width sheet)
(left 0)
(right (header-width sheet))
(bottom (+ top (aref (row-heights sheet) row))))
(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)
0 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)))
(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)
(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-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)
(draw-header-background sheet row 0)
(draw-header-in-cell sheet row 0 (format nil "~d" row)))
(apply #'draw-header-cell
sheet (format nil "~d" row)
(multiple-value-list
(row-header-bounding-box sheet row))))
(defmethod draw-column-header ((sheet cell-sheet) column)
(draw-header-background sheet 0 column)
(draw-header-in-cell sheet 0 column (format nil "~d" column)))
(apply #'draw-header-cell
sheet (format nil "~d" column)
(multiple-value-list
(column-header-bounding-box sheet column))))
(defmethod draw ((sheet cell-sheet))
(layout sheet)
......@@ -5989,7 +5989,6 @@ replace the original grid with this one."
(draw-column-header sheet column)))
(do-nodes (node sheet)
(draw node))))
#+end_src
* 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