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?
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
50 (for index from
0 below
(flexichain:nb-elements current-result-line
))
51 (flexichain:pop-start current-result-line
))
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
)))
67 (for index from
0 to
(flexichain:nb-elements chain
))
68 (setf (aref result index
) (flexichain:element
* chain index
)))
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
)
78 (&key window
&allow-other-keys
)
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
)
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
))
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
)))))