From acaed097bfe13ea46be62a7cdff10e254924a1a2 Mon Sep 17 00:00:00 2001 From: John Connors Date: Tue, 5 Aug 2008 21:41:06 +0100 Subject: [PATCH] Added missing file --- glrepl-window.lisp | 185 +++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 185 insertions(+) create mode 100644 glrepl-window.lisp diff --git a/glrepl-window.lisp b/glrepl-window.lisp new file mode 100644 index 0000000..ade2b62 --- /dev/null +++ b/glrepl-window.lisp @@ -0,0 +1,185 @@ + +(in-package :glrepl) + + +;; line in a window +(defclass glrepl-window-line () + ((chain :initform (make-instance 'flexichain:standard-cursorchain :element-type 'base-char) :accessor chain-of) + (cursor :initform nil :accessor cursor-of)) + (:documentation "Line of text in a glrepl window")) + + +(defmethod initialize-instance :after ((self glrepl-window-line) &rest args) + (declare (ignore args)) + (setf (cursor-of self) (make-instance 'flexichain:right-sticky-flexicursor :position 0 :chain (chain-of self)))) + + +;; to do -- seperate doc view? + +;; window +(defclass glrepl-window () + ((win-height :initarg :pixel-height :initform 768 :accessor win-height-of) + (win-width :initarg :pxiel-width :initform 1024 :accessor win-width-of) + (text-height :initarg :text-cell-height :initform 25 :reader text-height-of) + (text-width :initarg :text-cell-width :initform 80 :reader text-width-of) + (lines :initform (make-array 1 :element-type 'glrepl-window-line :adjustable t :fill-pointer 0) :accessor lines-of) + (top-line :initform 0 :accessor top-line-of) + (cursor-line :initform 0 :accessor cursor-line-of) + (cursor-x :initform 0 :accessor cursor-x-of) + (cursor-y :initform 0 :accessor cursor-y-of) + (font :initform nil :accessor font-of) + (mark :initform nil :accessor mark-of) + (kills :initform (make-array 0 :adjustable t :fill-pointer 0) :accessor kills-of)) + (:documentation "Holds the document and view of a glrepl window")) + +(defgeneric current-line (win)) +(defmethod current-line ((win glrepl-window)) + "Return the chain that represents the current line" + (chain-of (aref (lines-of win) (cursor-line-of win)))) + +(defgeneric current-result-line (win)) + +(defmethod current-result-line (win) + (chain-of (aref (lines-of win) (1+ (cursor-line-of win))))) + +(defmethod (setf current-result-line) ((win glrepl-window) str) + (let ((current-result-line (current-result-line win))) + ;; wipe out current rresults + ;; write the new ones + (iterate + (for index from 0 below (flexichain:nb-elements current-result-line)) + (flexichain:pop-start current-result-line)) + (iterate + (for c in-string str) + (flexichain:push-end current-result-line c)))) + +(defgeneric current-cursor (win)) +(defmethod current-cursor ((win glrepl-window)) + "Return the cusror of the chain that represents the current line" + (cursor-of (aref (lines-of win) (cursor-line-of win)))) + +(defgeneric current-line-as-string (win)) +(defmethod current-line-as-string ((win glrepl-window)) + "Return the current line as a string" + (let* ((chain (current-line win)) + (result (make-array (flexichain:nb-elements chain) :element-type 'base-char))) + (iterate + (for index from 0 to (flexichain:nb-elements chain)) + (setf (aref result index) (flexichain:element* chain index))) + result)) + +;; mark in a window +(defclass glrepl-window-mark () + ((line :initform 0 :initarg :line :accessor line-of) + (cursor :initform 0 :initarg :cursor :accessor cursor-of))) + +(defmethod initialize-instance :after ((mark glrepl-window-mark) &rest args) + (destructuring-bind + (&key window &allow-other-keys) + args + (setf (line-of mark) (cursor-line-of window)) + (setf (cursor-of mark) (flexichain:clone-cursor (cursor-of (line-of mark)))))) + + +(defgeneric add-line (win)) + +(defmethod add-line ((win glrepl-window)) + (vector-push-extend (make-instance 'glrepl-window-line) (lines-of win))) + +(defgeneric cursor-up (win)) +(defmethod cursor-up ((win glrepl-window)) + (when (not (zerop (cursor-line-of win))) + (decf (cursor-line-of win) 2) + (if (not (zerop (top-line-of win))) + (decf (top-line-of win) 2) + (if (not (zerop (cursor-y-of win))) + (decf (cursor-y-of win)))))) + + +(defgeneric cursor-down (win)) + +(defmethod cursor-down ((win glrepl-window)) + (when (not (= (cursor-line-of win) (array-dimension (lines-of win) 0))) + (incf (cursor-line-of win) 2) + (if (> (- (cursor-line-of win) (top-line-of win)) (text-height-of win)) + (incf (top-line-of win) 2) + (incf (cursor-y-of win))))) + +(defgeneric cursor-column (win)) + +(defmethod cursor-column ((win glrepl-window)) + ;; return column position of cusror + (flexichain:cursor-pos (current-cursor win))) + +(defgeneric cursor-left (win)) + +(defmethod cursor-left ((win glrepl-window)) + (when (not (flexichain:at-beginning-p (current-cursor win))) + (decf (flexichain:cursor-pos (current-cursor win))))) + +(defgeneric cursor-right (win)) + +(defmethod cursor-right ((win glrepl-window)) + (when (not (flexichain:at-end-p (current-cursor win))) + (incf (flexichain:cursor-pos (current-cursor win))))) + +(defgeneric add-char (win c)) + +(defmethod add-char ((win glrepl-window) c) + (flexichain:insert (current-cursor win) c)) + +(defgeneric add-string (win s)) + +(defmethod add-string ((win glrepl-window) s) + (iterate + (for char in-string s) + (add-char win char))) + +(defgeneric del-char-left (win)) + +(defmethod del-char-left ((win glrepl-window)) + (when (not (flexichain:at-beginning-p (current-cursor win))) + (flexichain:delete< (current-cursor win)))) + +(defgeneric del-char-right (win)) + +(defmethod del-char-right ((win glrepl-window)) + (when (not (flexichain:at-end-p (current-cursor win))) + (flexichain:delete> (current-cursor win)))) + +(defgeneric set-mark (win)) + +(defmethod set-mark ((win glrepl-window)) + (setf (mark-of win) + (make-instance 'glrepl-window-mark + :line (cursor-line-of win) + :cursor (flexichain:clone-cursor (current-cursor win))))) + + +(defmethod yank ((win glrepl-window)) + ) + +(defmethod paste ((win glrepl-window)) + ) + +(defgeneric viewport (win)) + +(defmethod viewport ((win glrepl-window)) + "Set a viewport that gives us 0,0 in the top left hand corner, raster style" + (gl:viewport (- (win-width-of win)) (- (win-height-of win)) (* 2 (win-width-of win)) (* 2 (win-height-of win)))) + +(defgeneric texture-width-of (self)) + +(defmethod texture-width-of ((self glrepl-window)) + (/ 1.0 (text-width-of self))) + +(defgeneric texture-height-of (self)) + +(defmethod texture-height-of ((self glrepl-window)) + (/ 1.0 (text-height-of self))) + +(defgeneric window-pixel-atxy (self x y)) + +(defmethod window-pixel-atxy ((win glrepl-window) x y) + (values (* x (texture-width-of win)) + (- (* (1- (text-height-of win)) (texture-height-of win)) (* y (texture-height-of win))))) -- 2.11.4.GIT