No longer writing .png files
[glrepl.git] / glrepl-window.lisp
blobb8534ae1ebbcc152e8b3ac0c78788b8fdc2025db
2 (in-package :glrepl)
5 ;; line in a window
6 (defclass glrepl-window-line ()
7 ((chain :initform (make-instance 'flexichain:standard-cursorchain :element-type 'base-char :initial-element #\Nul) :accessor chain-of)
8 (cursor :initform nil :accessor cursor-of))
9 (:documentation "Line of text in a glrepl window"))
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))))
17 ;; to do -- seperate doc view?
19 ;; window
20 (defclass glrepl-window ()
21 ((win-height :initarg :pixel-height :initform 768 :accessor win-height-of)
22 (win-width :initarg :pxiel-width :initform 1024 :accessor win-width-of)
23 (text-height :initarg :text-cell-height :initform 25 :reader text-height-of)
24 (text-width :initarg :text-cell-width :initform 80 :reader text-width-of)
25 (lines :initform (make-array 1 :element-type 'glrepl-window-line :adjustable t :fill-pointer 0) :accessor lines-of)
26 (top-line :initform 0 :accessor top-line-of)
27 (cursor-line :initform 0 :accessor cursor-line-of)
28 (cursor-x :initform 0 :accessor cursor-x-of)
29 (cursor-y :initform 0 :accessor cursor-y-of)
30 (font :initform nil :accessor font-of)
31 (mark :initform nil :accessor mark-of)
32 (kills :initform (make-array 0 :adjustable t :fill-pointer 0) :accessor kills-of))
33 (:documentation "Holds the document and view of a glrepl window"))
35 (defgeneric current-line (win))
36 (defmethod current-line ((win glrepl-window))
37 "Return the chain that represents the current line"
38 (chain-of (aref (lines-of win) (cursor-line-of win))))
40 (defgeneric current-result-line (win))
42 (defmethod current-result-line (win)
43 (chain-of (aref (lines-of win) (1+ (cursor-line-of win)))))
45 (defmethod (setf current-result-line) ((win glrepl-window) str)
46 (let ((current-result-line (current-result-line win)))
47 ;; wipe out current rresults
48 ;; write the new ones
49 (iterate
50 (for index from 0 below (flexichain:nb-elements current-result-line))
51 (flexichain:pop-start current-result-line))
52 (iterate
53 (for c in-string str)
54 (flexichain:push-end current-result-line c))))
56 (defgeneric current-cursor (win))
57 (defmethod current-cursor ((win glrepl-window))
58 "Return the cusror of the chain that represents the current line"
59 (cursor-of (aref (lines-of win) (cursor-line-of win))))
61 (defgeneric current-line-as-string (win))
62 (defmethod current-line-as-string ((win glrepl-window))
63 "Return the current line as a string"
64 (let* ((chain (current-line win))
65 (result (make-array (flexichain:nb-elements chain) :element-type 'base-char)))
66 (iterate
67 (for index from 0 to (flexichain:nb-elements chain))
68 (setf (aref result index) (flexichain:element* chain index)))
69 result))
71 ;; mark in a window
72 (defclass glrepl-window-mark ()
73 ((line :initform 0 :initarg :line :accessor line-of)
74 (cursor :initform 0 :initarg :cursor :accessor cursor-of)))
76 (defmethod initialize-instance :after ((mark glrepl-window-mark) &rest args)
77 (destructuring-bind
78 (&key window &allow-other-keys)
79 args
80 (setf (line-of mark) (cursor-line-of window))
81 (setf (cursor-of mark) (flexichain:clone-cursor (cursor-of (line-of mark))))))
84 (defgeneric add-line (win))
86 (defmethod add-line ((win glrepl-window))
87 (vector-push-extend (make-instance 'glrepl-window-line) (lines-of win)))
89 (defgeneric cursor-up (win))
90 (defmethod cursor-up ((win glrepl-window))
91 (when (not (zerop (cursor-line-of win)))
92 (decf (cursor-line-of win) 2)
93 (if (not (zerop (top-line-of win)))
94 (decf (top-line-of win) 2)
95 (if (not (zerop (cursor-y-of win)))
96 (decf (cursor-y-of win))))))
99 (defgeneric cursor-down (win))
101 (defmethod cursor-down ((win glrepl-window))
102 (when (not (= (cursor-line-of win) (array-dimension (lines-of win) 0)))
103 (incf (cursor-line-of win) 2)
104 (if (> (- (cursor-line-of win) (top-line-of win)) (text-height-of win))
105 (incf (top-line-of win) 2)
106 (incf (cursor-y-of win)))))
108 (defgeneric cursor-column (win))
110 (defmethod cursor-column ((win glrepl-window))
111 ;; return column position of cusror
112 (flexichain:cursor-pos (current-cursor win)))
114 (defgeneric cursor-left (win))
116 (defmethod cursor-left ((win glrepl-window))
117 (when (not (flexichain:at-beginning-p (current-cursor win)))
118 (decf (flexichain:cursor-pos (current-cursor win)))))
120 (defgeneric cursor-right (win))
122 (defmethod cursor-right ((win glrepl-window))
123 (when (not (flexichain:at-end-p (current-cursor win)))
124 (incf (flexichain:cursor-pos (current-cursor win)))))
126 (defgeneric add-char (win c))
128 (defmethod add-char ((win glrepl-window) c)
129 (flexichain:insert (current-cursor win) c))
131 (defgeneric add-string (win s))
133 (defmethod add-string ((win glrepl-window) s)
134 (iterate
135 (for char in-string s)
136 (add-char win char)))
138 (defgeneric del-char-left (win))
140 (defmethod del-char-left ((win glrepl-window))
141 (when (not (flexichain:at-beginning-p (current-cursor win)))
142 (flexichain:delete< (current-cursor win))))
144 (defgeneric del-char-right (win))
146 (defmethod del-char-right ((win glrepl-window))
147 (when (not (flexichain:at-end-p (current-cursor win)))
148 (flexichain:delete> (current-cursor win))))
150 (defgeneric set-mark (win))
152 (defmethod set-mark ((win glrepl-window))
153 (setf (mark-of win)
154 (make-instance 'glrepl-window-mark
155 :line (cursor-line-of win)
156 :cursor (flexichain:clone-cursor (current-cursor win)))))
159 (defmethod yank ((win glrepl-window))
162 (defmethod paste ((win glrepl-window))
165 (defgeneric viewport (win))
167 (defmethod viewport ((win glrepl-window))
168 "Set a viewport that gives us 0,0 in the top left hand corner, raster style"
169 (gl:viewport (- (win-width-of win)) (- (win-height-of win)) (* 2 (win-width-of win)) (* 2 (win-height-of win))))
171 (defgeneric texture-width-of (self))
173 (defmethod texture-width-of ((self glrepl-window))
174 (/ 1.0 (text-width-of self)))
176 (defgeneric texture-height-of (self))
178 (defmethod texture-height-of ((self glrepl-window))
179 (/ 1.0 (text-height-of self)))
181 (defgeneric window-pixel-atxy (self x y))
183 (defmethod window-pixel-atxy ((win glrepl-window) x y)
184 (values (* x (texture-width-of win))
185 (- (* (1- (text-height-of win)) (texture-height-of win)) (* y (texture-height-of win)))))