From 7fb69d7818912e2cabc1ada508ed65a26e58f740 Mon Sep 17 00:00:00 2001 From: John Connors Date: Sun, 10 Aug 2008 10:16:59 +0100 Subject: [PATCH] Cursor has appeared --- glrepl-main.lisp | 56 ++++++++++++++++++++++++++++++++++++++++++++++---------- glrepl.lisp | 23 +++++++++++------------ 2 files changed, 57 insertions(+), 22 deletions(-) diff --git a/glrepl-main.lisp b/glrepl-main.lisp index 051e212..ea848b3 100644 --- a/glrepl-main.lisp +++ b/glrepl-main.lisp @@ -83,6 +83,7 @@ (defun init-gl () (gl:enable gl:+texture-2d+) + (gl:enable gl:+blend+) (gl:matrix-mode gl:+projection+) (gl:load-identity) (gl:push-matrix) @@ -112,8 +113,6 @@ (cffi::mem-ref (name-of image) :uint32)) (gl:tex-env-f gl:+texture-env+ gl:+texture-env-mode+ gl:+replace+) ;; maybe +decal+? (gl:color-4f 0.0 0.0 0.0 1.0) - (gl:enable gl:+texture-2d+) - (gl:enable gl:+blend+) (gl:blend-func gl:+src-alpha+ gl:+one-minus-src-alpha+) (let ((texture-height (texture-height-of *glwindow*)) (texture-width (texture-width-of *glwindow*))) @@ -134,10 +133,8 @@ (gl:bind-texture gl:+texture-2d+ (cffi::mem-ref (name-of image) :uint32)) (gl:tex-env-f gl:+texture-env+ gl:+texture-env-mode+ gl:+replace+) ;; maybe +decal+? - (gl:color-4f 0.0 0.0 0.0 1.0) - (gl:enable gl:+texture-2d+) - (gl:enable gl:+blend+) - (gl:blend-func gl:+one+ gl:+one+) + (gl:color-4f 1.0 0.0 0.0 1.0) + (gl:blend-func gl:+src-alpha+ gl:+one-minus-src-alpha+) (let ((texture-height (texture-height-of *glwindow*)) (texture-width (texture-width-of *glwindow*))) (gl:with-begin gl:+quads+ @@ -156,14 +153,36 @@ ;; (window-pixel-atxy *glwindow* 0 0) ;; (render-char (font-of *glwindow*) #\A px py))) +(defun render-string (str x y) + (let ((sx x) + (sy y)) + (iterate + ;; while there is still a line to render + (for char-to-render in-string str) + (multiple-value-bind (pixel-x pixel-y) + (window-pixel-atxy *glwindow* sx sy) + ;; we have a drawble + (when (graphic-char-p char-to-render) + ;; actually draw our char + (render-char (font-of *glwindow*) char-to-render pixel-x pixel-y) + ;; advance cursor to next screen colum + (incf sx)))))) + +(defun render-debug () + (render-string + (format nil "Flexichain cursor pos ~A " (flexichain:cursor-pos (current-cursor *glwindow*))) + 0 20)) + (defun render-world () (when *console* + (render-debug) (let* ((rendered-chain (current-line *glwindow*)) (screen-line 0) (screen-column 0) (current-chain-offset 0) (char-to-render #\Nul) (cursor (make-instance 'flexichain:left-sticky-flexicursor :position 0 :chain rendered-chain))) + (declare (type fixnum screen-line screen-column current-chain-offset)) (iterate ;; while there is still a line to render (while (and (not (null cursor)) (< screen-line (text-height-of *glwindow*)))) @@ -172,6 +191,8 @@ (setf char-to-render (flexichain:element> cursor)) (multiple-value-bind (pixel-x pixel-y) (window-pixel-atxy *glwindow* screen-column screen-line) + + ;; we have a drawble (when (graphic-char-p char-to-render) ;; actually draw our char (render-char (font-of *glwindow*) char-to-render pixel-x pixel-y) @@ -184,10 +205,23 @@ (when (>= screen-column (text-width-of *glwindow*)) (setf screen-column 0) (incf screen-line))) + + ;; we have a newline (when (char= #\Newline char-to-render) + ;; first render the cursor if its at eol + (setf screen-column 0) (incf screen-line))) - (incf (flexichain:cursor-pos cursor))) + + (incf (flexichain:cursor-pos cursor)) + (finally + (multiple-value-bind (pixel-x pixel-y) + (window-pixel-atxy *glwindow* screen-column screen-line) + + (when (and (zerop current-chain-offset) + (= (flexichain:cursor-pos cursor) (flexichain:cursor-pos (current-cursor *glwindow*)))) + (render-cursor (font-of *glwindow*) pixel-x pixel-y))))) + ;; ran out of this line, bump onto next (incf screen-line) (setf screen-column 0) @@ -250,11 +284,13 @@ ;; (glrepl::dump (aref *font-images* 65)) (main-loop) (callback-clear) - (end-gl))) + (end-gl) + (glfw:close-window) + (glfw:terminate))) (progn (glfw:terminate) - (error "Failed to open window"))) - (error "Failed to init glfw")))) + (error "Failed to open window")))) + (error "Failed to init glfw"))) ;; (defun test-glrepl () ;; (glfw:with-init-window ("Glrepl" *win-width* *win-height*) diff --git a/glrepl.lisp b/glrepl.lisp index 0c878df..a30fb1e 100755 --- a/glrepl.lisp +++ b/glrepl.lisp @@ -3,26 +3,23 @@ (defclass glrepl-font () - ((height :initform 128 :reader bitmap-height-of) ;; 15 up - (width :initform 128 :reader bitmap-width-of) ;; 16 across + ((height :initform 128 :reader bitmap-height-of :type fixnum) ;; 15 up + (width :initform 128 :reader bitmap-width-of :type fixnum) ;; 16 across (pathname :initform (merge-pathnames #P"VeraMono.ttf") :initarg :pathname :reader pathname-of) - (images :initform (make-array 128) :reader images-of))) + (images :initform (make-array 128) :reader images-of :type (simple-array t *)))) -(defparameter *bitmap-height* 128) ;; 15 up -(defparameter *bitmap-width* 128) ;; 16 across -(defparameter *font-pathname* (merge-pathnames #P"VeraMono.ttf")) -(defparameter *font-images* (make-array 128)) - ;; note that these are 7 bit fonts since I'm avoiding the horrors of encoding for now ;; probably the correct way to do this is to decode on the fly and cache font textures ;; but deadlines are DEADlines... (defun make-font (font-pathname) + (declare (optimize (speed 3) (safety 0) (debug 0))) (let ((result (make-instance 'glrepl-font :pathname font-pathname))) (iterate (for i from 0 below 128) + (declare (fixnum i)) (vecto:with-canvas (:width (bitmap-width-of result) :height (bitmap-height-of result)) (let ((repl-font (vecto:get-font (pathname-of result))) (repl-letter (string (code-char i)))) @@ -43,14 +40,16 @@ (make-instance 'rgba-image :width (bitmap-width-of result) :height (bitmap-height-of result))) (iterate (for x from 0 below (bitmap-width-of result)) + (declare (fixnum x)) (iterate (for y from 0 below (bitmap-height-of result)) + (declare (fixnum y)) (setf (pixel-xy (aref (images-of result) i) x y) ;; #XFF000000 (pixval - (aref (zpng::data-array (vecto::image vecto::*graphics-state*)) y x 0) - (aref (zpng::data-array (vecto::image vecto::*graphics-state*)) y x 1) - (aref (zpng::data-array (vecto::image vecto::*graphics-state*)) y x 2) - (aref (zpng::data-array (vecto::image vecto::*graphics-state*)) y x 3)) + (the fixunum (aref (zpng::data-array (vecto::image vecto::*graphics-state*)) y x 0)) + (the fixnum (aref (zpng::data-array (vecto::image vecto::*graphics-state*)) y x 1)) + (the fixnum (aref (zpng::data-array (vecto::image vecto::*graphics-state*)) y x 2)) + (the fixnum (aref (zpng::data-array (vecto::image vecto::*graphics-state*)) y x 3))) ))) (update-image (aref (images-of result) i)))) (error () (format t "Skipping char ~A~&" i))))))) -- 2.11.4.GIT