glrepl-window.lisp

   1
   2 (in-package :glrepl)
   3
   4
   5 ;; line in a window
   6 (defclass glrepl-window-line ()
   7   ((chain :initform (make-instance 'flexichain:standard-cursorchain) :accessor chain-of)
   8    (cursor :initform nil :accessor cursor-of))
   9   (:documentation  "Line of text in a glrepl window"))
  10
  11
  12 (defmethod initialize-instance :after ((self glrepl-window-line) &rest args)
  13   (declare (ignore args))
  14   (setf (cursor-of self) (make-instance 'flexichain:right-sticky-flexicursor :position 0 :chain (chain-of self))))
  15
  16
  17 (defclass command-history ()
  18    ((history-entries :initform (make-array 0 :adjustable t :fill-pointer 0) :accessor history-entries-of)
  19     (history-index :initform 0 :accessor history-index-of)))
  20
  21
  22 ;; to do -- seperate doc view?
  23
  24 ;; window
  25 (defclass glrepl-window ()
  26   ((win-height :initarg :pixel-height :initform 768 :accessor win-height-of)
  27    (win-width :initarg :pxiel-width :initform 1024 :accessor win-width-of)
  28    (text-height :initarg :text-cell-height :initform 25 :reader text-height-of)
  29    (text-width :initarg :text-cell-width :initform 80 :reader text-width-of)
  30    (lines :initform (make-array 0  :adjustable t :fill-pointer 0) :accessor lines-of)
  31    (top-line :initform 0 :accessor top-line-of)
  32    (cursor-line :initform 0 :accessor cursor-line-of)
  33    (font :initform nil :accessor font-of)
  34    (mark :initform nil :accessor mark-of)
  35    (history :initform (make-instance 'command-history) :accessor history-of)
  36    (kills :initform (make-array 0 :adjustable t :fill-pointer 0) :accessor kills-of))
  37   (:documentation "Holds the document and view of a glrepl window"))
  38
  39
  40
  41 ;; line access primitives
  42 (defgeneric add-line (win))
  43
  44 (defmethod add-line ((win glrepl-window))
  45   (vector-push-extend  (make-instance 'glrepl-window-line) (lines-of win)))
  46
  47 (defgeneric line-as-string (win glrepl-window))
  48
  49 (defmethod line-as-string ((win glrepl-window) line-index)
  50   "Return the line as a string"
  51   (let* ((chain (chain-of (aref (lines-of win) line-index)))
  52          (result (make-array (flexichain:nb-elements chain) :element-type 'base-char)))
  53     (iterate
  54       (for index from 0 below (flexichain:nb-elements  chain))
  55       (setf (aref result index) (flexichain:element* chain index)))
  56     result))
  57
  58 (defgeneric (setf line-as-string) (str win linw-index))
  59
  60 (defmethod (setf line-as-string) (str (win glrepl-window) line-index)
  61   "Set the contents of this line to reflect the string"
  62   (let* ((result-line (chain-of (aref (lines-of win) line-index)))
  63          (chain-length (flexichain:nb-elements result-line)))
  64     ;; write the new ones
  65     (iterate
  66       (for index from 0 below (max  (length str) chain-length))
  67       (while (< index (length str)))
  68       (if (< index chain-length)
  69           ;; replace an existing char
  70           (setf (flexichain:element* result-line index)  (char str index))
  71           ;; add a non-exsising one
  72           (flexichain:push-end result-line (char str index)))
  73       ;; chop bits off the end
  74       (finally
  75        (if (< (length str) chain-length)
  76            (flexichain:delete* result-line (length str)))))))
  77
  78
  79 ;; current edited line
  80 (defgeneric current-line (win))
  81 (defmethod current-line ((win glrepl-window))
  82   "Return the chain that represents the current line"
  83   (chain-of (aref (lines-of win) (cursor-line-of win))))
  84
  85 (defgeneric (setf current-line) (strr win))
  86
  87 (defmethod (setf current-line) (str (win glrepl-window))
  88   (setf (line-as-string win (cursor-line-of win)) str))
  89
  90 (defgeneric current-line-as-string (win))
  91 (defmethod current-line-as-string ((win glrepl-window))
  92   "Return the current line as a string"
  93   (line-as-string win  (cursor-line-of win)))
  94
  95 ;; result
  96 (defgeneric current-result-line (win))
  97 (defmethod current-result-line (win)
  98   (chain-of (aref (lines-of win)  (1+ (cursor-line-of win)))))
  99
 100 (defmethod (setf current-result-line) (str (win glrepl-window))
 101   (setf (line-as-string win (1+ (cursor-line-of win))) str))
 102
 103
 104 ;; cursor
 105 (defgeneric current-cursor (win))
 106 (defmethod current-cursor ((win glrepl-window))
 107   "Return the cusror of the chain that represents the current line"
 108   (cursor-of (aref (lines-of win) (cursor-line-of win))))
 109
 110
 111
 112 ;; cursor motion
 113 (defgeneric cursor-up (win))
 114
 115 ;; (defmethod cursor-up ((win glrepl-window))
 116 ;;   (when (not (zerop (cursor-line-of win)))
 117 ;;     (decf (cursor-line-of win) 2)
 118 ;;     (if (not (zerop (top-line-of win)))
 119 ;;         (decf (top-line-of win) 2)
 120 ;;         (if (not (zerop (cursor-y-of win)))
 121 ;;             (decf (cursor-y-of win))))))
 122
 123 (defgeneric cursor-down (win))
 124
 125 ;; (defmethod cursor-down ((win glrepl-window))
 126 ;;   (when (not (= (cursor-line-of win) (array-dimension (lines-of win) 0)))
 127 ;;      (incf (cursor-line-of win) 2)
 128 ;;      (if (> (- (cursor-line-of win) (top-line-of win)) (text-height-of win))
 129 ;;        (incf (top-line-of win) 2)
 130 ;;        (incf (cursor-y-of win)))))
 131
 132 (defgeneric cursor-column (win))
 133
 134 (defmethod cursor-column ((win glrepl-window))
 135   ;; return column position of cusror
 136   (flexichain:cursor-pos (current-cursor win)))
 137
 138 (defgeneric cursor-left (win))
 139
 140 (defmethod cursor-left ((win glrepl-window))
 141   (when (not (flexichain:at-beginning-p (current-cursor win)))
 142     (decf (flexichain:cursor-pos (current-cursor win)))))
 143
 144 (defgeneric cursor-right (win))
 145
 146 (defmethod cursor-right ((win glrepl-window))
 147   (when (not (flexichain:at-end-p (current-cursor win)))
 148     (incf (flexichain:cursor-pos (current-cursor win)))))
 149
 150 ;; inserting content
 151 (defgeneric add-char (win c))
 152
 153 (defmethod add-char ((win glrepl-window) c)
 154   (flexichain:insert (current-cursor win) c))
 155
 156 (defgeneric add-string (win s))
 157
 158 (defmethod add-string ((win glrepl-window) s)
 159   (iterate
 160     (for char in-string s)
 161     (add-char win char)))
 162
 163 ;; deleting things
 164 (defgeneric del-char-left (win))
 165
 166 (defmethod del-char-left ((win glrepl-window))
 167   (when (not (flexichain:at-beginning-p (current-cursor win)))
 168     (flexichain:delete< (current-cursor win))))
 169
 170 (defgeneric del-char-right (win))
 171
 172 (defmethod del-char-right ((win glrepl-window))
 173   (when (not (flexichain:at-end-p (current-cursor win)))
 174     (flexichain:delete> (current-cursor win))))
 175
 176
 177 ;; mark in a window
 178 (defclass glrepl-window-mark ()
 179   ((line :initform 0 :initarg :line :accessor line-of)
 180    (cursor :initform 0 :initarg :cursor :accessor cursor-of)))
 181
 182 (defmethod initialize-instance :after ((mark glrepl-window-mark) &rest args)
 183   (destructuring-bind
 184                 (&key window &allow-other-keys)
 185           args
 186         (setf (line-of mark) (cursor-line-of window))
 187         (setf (cursor-of mark) (flexichain:clone-cursor (cursor-of (line-of mark))))))
 188
 189
 190 ;; marking
 191 (defgeneric set-mark (win))
 192
 193 (defmethod set-mark ((win glrepl-window))
 194   (setf (mark-of win)
 195         (make-instance 'glrepl-window-mark
 196                        :line (cursor-line-of win)
 197                        :cursor (flexichain:clone-cursor (current-cursor win)))))
 198
 199
 200 ;; cutnpaste
 201 (defmethod yank ((win glrepl-window))
 202   )
 203
 204 (defmethod paste ((win glrepl-window))
 205   )
 206
 207 ;; command history
 208 (defgeneric add-to-history (history str)
 209   (:method ((history command-history) str)
 210     (vector-push-extend str (history-entries-of history))
 211     (setf (history-index-of history) (1- (length (history-entries-of history)))))
 212   (:method ((win glrepl-window) str)
 213     (add-to-history (history-of win) str)))
 214
 215
 216 (defgeneric previous-history (history)
 217   (:method ((history command-history))
 218     (decf (history-index-of history))
 219     (if (minusp (history-index-of history))
 220         (setf (history-index-of history) (1- (length (history-entries-of history)))))
 221     (aref (history-entries-of history) (history-index-of history)))
 222   (:method ((win glrepl-window))
 223     (previous-history (history-of win))))
 224
 225
 226 (defgeneric next-history (history)
 227     (:method ((history command-history))
 228       (incf (history-index-of history))
 229       (if (>= (history-index-of history) (length (history-entries-of history)))
 230           (setf (history-index-of history) 0))
 231       (aref (history-entries-of history) (history-index-of history)))
 232     (:method ((win glrepl-window))
 233       (next-history (history-of win))))
 234
 235 ;; rendering
 236 (defgeneric viewport (win))
 237
 238 1(defmethod viewport ((win glrepl-window))
 239   "Set a viewport that gives us 0,0 in the top left hand corner, raster style"
 240   (gl:viewport (- (win-width-of win)) (- (win-height-of win))  (* 2 (win-width-of win)) (* 2 (win-height-of win))))
 241
 242 (defgeneric texture-width-of (self))
 243
 244 (defmethod texture-width-of ((self glrepl-window))
 245   (/ 1.0 (text-width-of self)))
 246
 247 (defgeneric texture-height-of (self))
 248
 249 (defmethod texture-height-of ((self glrepl-window))
 250   (/ 1.0 (text-height-of self)))
 251
 252 (defgeneric window-pixel-atxy (self x y))
 253
 254 (defmethod window-pixel-atxy ((win glrepl-window) x y)
 255   (values (* x  (texture-width-of win))
 256           (-  (* (1- (text-height-of win)) (texture-height-of win)) (* y (texture-height-of win)))))