From 7e28e52a4d8924e4e7c3d1c8d9ab0772c055a270 Mon Sep 17 00:00:00 2001
From: John Connors <johnc@yagc.ndo.co.uk>
Date: Wed, 6 Aug 2008 01:20:49 +0100
Subject: [PATCH] The REPL..she works

---
 glrepl-tests.lisp  | 488 +++++++++++++++++++++++++++--------------------------
 glrepl-window.lisp |  16 +-
 package.lisp       |   3 +-
 3 files changed, 261 insertions(+), 246 deletions(-)
 rewrite glrepl-tests.lisp (72%)

diff --git a/glrepl-tests.lisp b/glrepl-tests.lisp
dissimilarity index 72%
index f2824c2..184f4df 100755
--- a/glrepl-tests.lisp
+++ b/glrepl-tests.lisp
@@ -1,237 +1,251 @@
-
-(asdf:oos 'asdf:load-op 'trivial-gray-streams)
-(asdf:oos 'asdf:load-op 'alexandria)
-(asdf:oos 'asdf:load-op 'flexichain)
-
-(defpackage :glrepl-tests
-    (:use :cl :iterate :glrepl :alexandria :trivial-gray-streams))
-
-(in-package :glrepl-tests)
-
-;;  (- (win-width-of win)) (* 2 (win-height-of win)) 
-;;                (* 2 (win-width-of win)) (- (* 2 (win-height-of win)))))
-
-(defvar *esc-pressed* nil)
-
-(defparameter *glwindow* nil)
-
-(defparameter *console* t)
-;; gives us unicode keys
-;; (cffi:defcallback char-callback :void ((key :int) (action :int))
-;;   )
-                                       
-
-;; evaluate a form, echo result to console: somewhat stolen
-;; from perfectstorm..
-(defun console-eval (s)
-  "Evauluate s and return the output as a string"
-  (let ((eval-result
-         (format nil "~a"
-                 (handler-case (multiple-value-list 
-                               (eval (read (make-string-input-stream s))))
-               (error (e)
-                 (format nil "~a" e))))))
-    eval-result))
-                                       
-(cffi:defcallback key-callback :void ((key :int) (action :int))
-  (when (= action glfw:+press+)
-    (format t "Keypress ~A " key)
-    (cond 
-      ((= key glfw:+key-esc+)  (setf *esc-pressed* t))
-      ;; TO DO
-      ;; page up, page down, skip sexps
-
-      ;; backspace removes previous char
-      ((= key glfw:+key-backspace+) (del-char-left *glwindow*))
-      ((= key glfw:+key-del+ (del-char-right *glwindow*)))      
-      ;; del removes next char
-      ;; return inserts newline
-      ;; f10 toggles console
-      ((= key glfw:+key-f10+) (setf *console* (not *console*)))
-      ;; f5 evaluates -- TO DO -- sort this out
-      ((= key glfw:+key-f5+) (console-eval (current-line-as-string *glwindow*))) 
-      ;; arrows move cursor
-      ((= key glfw:+key-left+) (cursor-left *glwindow*))
-      ((= key glfw:+key-right+) (cursor-right *glwindow*))
-      ((< key 128) (add-char *glwindow* (code-char key))))))
-
-(cffi:defcallback window-size-callback :void ((width :int) (height :int))
-  (setf (win-width-of *glwindow*) width)
-  (setf (win-height-of *glwindow*) height)
-  (viewport *glwindow*))
-
-
-(defun init-gl ()
-  (gl:enable gl:+texture-2d+)
-  (gl:matrix-mode gl:+projection+)
-  (gl:load-identity)
-  (gl:push-matrix)
-  (gl:matrix-mode gl:+modelview+)
-  (gl:load-identity)
-  (gl:push-matrix)
-  (viewport *glwindow*))
-
-(defun end-gl ()
-  ())
-
-(defun callback-set ()
-  (setf *esc-pressed* nil)
-  (glfw:set-key-callback (cffi:callback key-callback)))
-
-(defun callback-clear ()
-  (glfw:set-key-callback (cffi:null-pointer)))
-
-(defun render-char (font c x y)
- (when (graphic-char-p c)
-   (let ((image (aref (glrepl::images-of font) (char-code c))))
-     (when (typep  image 'rgba-image)
-       (with-opengl
-         (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:+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+
-           (gl:tex-coord-2i 0 1)
-           (gl:vertex-2f x y) ;; top lhs
-           (gl:tex-coord-2i 1 1)
-           (gl:vertex-2f  (+ x texture-width) y  ) ;; top rhs
-           (gl:tex-coord-2f 1 0)
-           (gl:vertex-2f  (+ x texture-width) (+ y texture-height)) ;; bot rhs
-           (gl:tex-coord-2i 0 0)
-           (gl:vertex-2f x (+ y texture-height))))))))) ;; bot lhs
-     
-;; (defun render-world ()
-;;   (multiple-value-bind 
-;;         (px py)
-;;       (window-pixel-atxy *glwindow* 0 0)
-;;   (render-char (font-of *glwindow*) #\A px py)))
-
-(defun render-world ()
-  (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)))
-  (iterate 
-    ;; while there is still a line to render
-    (while (and (not (null cursor)) (< screen-line (text-height-of *glwindow*))))
-    (iterate
-      (while (not (flexichain:at-end-p cursor)))
-      (setf char-to-render (flexichain:element> cursor))
-      (multiple-value-bind  (pixel-x pixel-y)
-          (window-pixel-atxy *glwindow* screen-column screen-line)
-        (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 screen-column)
-          ;; word wrap if off ed
-          (when (>= screen-column (text-width-of *glwindow*))
-            (setf screen-column 0)
-            (incf screen-line)))
-        (when (char= #\Newline char-to-render)
-            (setf screen-column 0)
-            (incf screen-line)))
-      (incf (flexichain:cursor-pos cursor)))
-      ;; ran out of this line, bump onto next
-    (incf current-chain-offset)
-    (setf cursor nil)
-    (setf rendered-chain nil)
-    (let ((current-chain-index (+ (cursor-line-of *glwindow*) current-chain-offset)))
-      (when (< current-chain-index (length (lines-of *glwindow*)))
-      (setf rendered-chain (chain-of (aref (lines-of *glwindow*) current-chain-index)))
-      (setf cursor (make-instance 'standard-flexicursor :chain rendered-chain)))))))
-                 
-    
-;;  (render-char (font-of window) #\A 0.5 0.5))
-
-(defun update-world (dt))
-
-(defun main-loop ()
-    (let ((t0 (glfw:get-time))
-          (dt 0.0)
-          (test-image (make-instance 'glrepl::rgba-image :width 64 :height 64)))
-      (iterate
-        (for i from 0 below (* 64 64))
-        (setf (glrepl::pixel test-image i) #X000000FF))
-      (glrepl::update-image test-image)
-      (glfw:sleep 0.05d0)      
-      (gl:clear-color 0.0 0.0 0.0 1.0)
-      (iterate
-        (while (= (glfw::get-window-param glfw:+opened+) glfw:+true+))
-        (gl:clear gl:+color-buffer-bit+)
-        (setf dt (- (glfw:get-time) t0))
-        (setf t0 (glfw:get-time))      
-        (update-world dt)
-        (render-world)
-        ;;(glrepl::render  test-image)
-        ;; update
-        ;; check for time available if time is avaliable render
-        ;; surrender any cpu time..
-        (glfw:swap-buffers)
-        (if *esc-pressed*
-            (glfw:close-window)))))
-
-(defun test-glrepl ()
-  (if (glfw::init)
-      (progn 
-        (handler-case  
-            (progn
-              (setf *glwindow* (make-instance 'glrepl-window))                  
-              (add-line *glwindow*)
-              (add-string *glwindow* "Hello World")
-              (if (glfw:open-window (win-width-of *glwindow*) (win-height-of *glwindow*) 16 16 16 16 16)     
-                  (progn
-                    (init-gl)
-                    (format t "Making font..") 
-                    (setf (font-of *glwindow*) (make-font glrepl::*font-pathname*)) ;; prbly shld be mber of window
-                    (format t "Done..")       
-                    (glfw:swap-interval 1)
-                    (glfw:enable glfw:+key-repeat+)         
-                    (callback-set)
-                    ;;                (glrepl::dump (aref *font-images* 65))
-                    (main-loop)
-                    (callback-clear)
-                    (end-gl)
-                    (glfw:terminate))
-                  (error "Failed to open window")))
-          (error (ohbum)
-            (progn
-              (format T "Boom ~A " ohbum)
-              (when *glwindow*
-                (destroy-font (font-of *glwindow*)))			
-              (end-gl)
-              (glfw:close-window)
-              (glfw:terminate)))))
-        (error "Failed to init glfw")))
-
-;; (defun test-glrepl ()
-;;   (glfw:with-init-window ("Glrepl" *win-width* *win-height*)
-;;     (glfw:set-window-size-callback (cffi:callback window-size-callback))
-;;     (glfw:set-key-callback (cffi:callback key-callback))
-;;     (glfw:swap-interval 1)
-;;     (let* ((frame 0))
-;;       (iterate
-;;         (while (and (not *esc-pressed*)
-;;                     (eql (glfw:get-window-param glfw:+opened+) gl:+true+)))
-;;         (gl:clear gl:+color-buffer-bit+)
-;;         (incf frame)
-;;         (glfw:swap-buffers)
-;;           (cl:sleep 0.1))
-;;       (if (eql (glfw:get-window-param glfw:+opened+) gl:+true+)
-;;         (glfw:close-window))
-;;       (glfw:terminate))))
-
-(setf *glwindow* (make-instance 'glrepl-window))
-(make-instance 'glrepl-window-line)
-
-(add-line *glwindow*)
-(add-string *glwindow* "Hello World")
-
-;;(test-glrepl)
\ No newline at end of file
+
+(asdf:oos 'asdf:load-op 'trivial-gray-streams)
+(asdf:oos 'asdf:load-op 'alexandria)
+(asdf:oos 'asdf:load-op 'flexichain)
+
+(defpackage :glrepl-tests
+  (:use :cl :iterate :glrepl :alexandria :trivial-gray-streams))
+
+(in-package :glrepl-tests)
+
+;;  (- (win-width-of win)) (* 2 (win-height-of win))
+;;                (* 2 (win-width-of win)) (- (* 2 (win-height-of win)))))
+
+(defvar *esc-pressed* nil)
+
+(defparameter *glwindow* nil)
+
+(defparameter *console* t)
+;; gives us unicode keys
+;; (cffi:defcallback char-callback :void ((key :int) (action :int))
+;;   )
+
+
+;; evaluate a form, echo result to console: somewhat stolen
+;; from perfectstorm..
+(defun console-eval (s)
+  "Evauluate s and return the output as a string"
+  (let ((eval-result
+         (format nil "~a"
+                 (handler-case (multiple-value-list
+                                (eval (read (make-string-input-stream s))))
+                   (error (e)
+                     (format nil "~a" e))))))
+    eval-result))
+
+(cffi:defcallback char-callback :void ((key :int) (action :int))
+  ;; (format t "Char ~A " key)
+  (when (and *console* (= action glfw:+press+))
+    (let ((c (code-char key)))
+      (when c
+        (add-char *glwindow* (code-char key))))))
+
+
+(cffi:defcallback key-callback :void ((key :int) (action :int))
+  ;; (format t "Keypress ~A " key)
+  (when (= action glfw:+press+)
+    ;; f10 toggles console
+    (when (= key glfw:+key-f10+)
+      (setf *console* (not *console*)))
+    ;; esc quits
+    (when
+        (= key glfw:+key-esc+)  (setf *esc-pressed* t))
+    (when *console*
+      (cond        
+        ;;       ;; backspace removes previous char
+        ((= key glfw:+key-backspace+) (del-char-left *glwindow*))
+        ;;       ;; del removes next char
+        ((= key glfw:+key-del+) (del-char-right *glwindow*))
+        ((= key glfw:+key-f5+)  (setf (current-result-line *glwindow*) (console-eval (current-line-as-string *glwindow*))))
+        ((= key glfw:+key-f6+) (setf (current-result-line *glwindow*) "Repl Result"))
+        ))))
+
+
+
+;;       ;; TO DO
+;;       ;; page up, page down, skip sexps
+
+
+;;       ;; return inserts newline
+;;       ;; f5 evaluates -- TO DO -- sort this out
+
+;;       ;; arrows move cursor
+;;       ((= key glfw:+key-left+) (cursor-left *glwindow*))
+;;       ((= key glfw:+key-right+) (cursor-right *glwindow*))
+
+(cffi:defcallback window-size-callback :void ((width :int) (height :int))
+  (setf (win-width-of *glwindow*) width)
+  (setf (win-height-of *glwindow*) height)
+  (viewport *glwindow*))
+
+
+(defun init-gl ()
+  (gl:enable gl:+texture-2d+)
+  (gl:matrix-mode gl:+projection+)
+  (gl:load-identity)
+  (gl:push-matrix)
+  (gl:matrix-mode gl:+modelview+)
+  (gl:load-identity)
+  (gl:push-matrix)
+  (viewport *glwindow*))
+
+(defun end-gl ()
+  ())
+
+(defun callback-set ()
+  (setf *esc-pressed* nil)
+  (glfw:set-key-callback (cffi:callback key-callback))
+  (glfw:set-char-callback (cffi:callback char-callback)))
+
+(defun callback-clear ()
+  (glfw:set-key-callback (cffi:null-pointer))
+  (glfw:set-char-callback (cffi:null-pointer)))
+
+(defun render-char (font c x y)
+  (when (graphic-char-p c)
+    (let ((image (aref (glrepl::images-of font) (char-code c))))
+      (when (typep  image 'rgba-image)
+        (with-opengl
+          (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:+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+
+              (gl:tex-coord-2i 0 1)
+              (gl:vertex-2f x y) ;; top lhs
+              (gl:tex-coord-2i 1 1)
+              (gl:vertex-2f  (+ x texture-width) y  ) ;; top rhs
+              (gl:tex-coord-2f 1 0)
+              (gl:vertex-2f  (+ x texture-width) (+ y texture-height)) ;; bot rhs
+              (gl:tex-coord-2i 0 0)
+              (gl:vertex-2f x (+ y texture-height))))))))) ;; bot lhs
+
+;; (defun render-world ()
+;;   (multiple-value-bind
+;;         (px py)
+;;       (window-pixel-atxy *glwindow* 0 0)
+;;   (render-char (font-of *glwindow*) #\A px py)))
+
+(defun render-world ()
+  (when *console*
+    (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)))
+      (iterate
+        ;; while there is still a line to render
+        (while (and (not (null cursor)) (< screen-line (text-height-of *glwindow*))))
+        (iterate
+          (while (not (flexichain:at-end-p cursor)))
+          (setf char-to-render (flexichain:element> cursor))
+          (multiple-value-bind  (pixel-x pixel-y)
+              (window-pixel-atxy *glwindow* screen-column screen-line)
+            (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 screen-column)
+              ;; word wrap if off ed
+              (when (>= screen-column (text-width-of *glwindow*))
+                (setf screen-column 0)
+                (incf screen-line)))
+            (when (char= #\Newline char-to-render)
+              (setf screen-column 0)
+              (incf screen-line)))
+          (incf (flexichain:cursor-pos cursor)))
+        ;; ran out of this line, bump onto next
+        (incf screen-line)
+        (setf screen-column 0)
+        (incf current-chain-offset)
+        (setf cursor nil)
+        (setf rendered-chain nil)
+        (let ((current-chain-index (+ (cursor-line-of *glwindow*) current-chain-offset)))
+          (when (< current-chain-index (length (lines-of *glwindow*)))
+            (setf rendered-chain (chain-of (aref (lines-of *glwindow*) current-chain-index)))
+            (setf cursor (make-instance 'flexichain:left-sticky-flexicursor :position 0 :chain rendered-chain))))))))
+
+
+;;  (render-char (font-of window) #\A 0.5 0.5))
+
+(defun update-world (dt))
+
+(defun main-loop ()
+  (let ((t0 (glfw:get-time))
+        (dt 0.0)
+        (test-image (make-instance 'glrepl::rgba-image :width 64 :height 64)))
+    (iterate
+      (for i from 0 below (* 64 64))
+      (setf (glrepl::pixel test-image i) #X000000FF))
+    (glrepl::update-image test-image)
+    (glfw:sleep 0.05d0)
+    (gl:clear-color 0.0 0.0 0.0 1.0)
+    (iterate
+      (while (= (glfw::get-window-param glfw:+opened+) glfw:+true+))
+      (gl:clear gl:+color-buffer-bit+)
+      (setf dt (- (glfw:get-time) t0))
+      (setf t0 (glfw:get-time))
+      (update-world dt)
+      (render-world)
+      ;;(glrepl::render  test-image)
+      ;; update
+      ;; check for time available if time is avaliable render
+      ;; surrender any cpu time..
+      (glfw:swap-buffers)
+      (if *esc-pressed*
+          (glfw:close-window)))))
+
+(defun test-glrepl ()
+  (if (glfw::init)
+      (progn
+        (setf *glwindow* (make-instance 'glrepl-window))
+        (add-line *glwindow*)
+        (add-line *glwindow*)
+        (add-string *glwindow* "Hello World")
+        (if (glfw:open-window (win-width-of *glwindow*) (win-height-of *glwindow*) 16 16 16 16 16)
+            (progn
+              (init-gl)
+              (format t "Making font..")
+              (setf (font-of *glwindow*) (make-font glrepl::*font-pathname*)) ;; prbly shld be mber of window
+              (format t "Done..")
+              (glfw:swap-interval 1)
+              (glfw:enable glfw:+key-repeat+)
+              (callback-set)
+              ;;                (glrepl::dump (aref *font-images* 65))
+              (main-loop)
+              (callback-clear)
+              (end-gl)
+              (glfw:terminate))
+            (error "Failed to open window")))
+      (error "Failed to init glfw")))
+
+;; (defun test-glrepl ()
+;;   (glfw:with-init-window ("Glrepl" *win-width* *win-height*)
+;;     (glfw:set-window-size-callback (cffi:callback window-size-callback))
+;;     (glfw:set-key-callback (cffi:callback key-callback))
+;;     (glfw:swap-interval 1)
+;;     (let* ((frame 0))
+;;       (iterate
+;;         (while (and (not *esc-pressed*)
+;;                     (eql (glfw:get-window-param glfw:+opened+) gl:+true+)))
+;;         (gl:clear gl:+color-buffer-bit+)
+;;         (incf frame)
+;;         (glfw:swap-buffers)
+;;           (cl:sleep 0.1))
+;;       (if (eql (glfw:get-window-param glfw:+opened+) gl:+true+)
+;;         (glfw:close-window))
+;;       (glfw:terminate))))
+
+;; (setf *glwindow* (make-instance 'glrepl-window))
+;; (make-instance 'glrepl-window-line)
+
+;; (add-line *glwindow*)
+;; (add-string *glwindow* "Hello World")
+
+(test-glrepl)
\ No newline at end of file
diff --git a/glrepl-window.lisp b/glrepl-window.lisp
index b8534ae..89a8099 100644
--- a/glrepl-window.lisp
+++ b/glrepl-window.lisp
@@ -4,7 +4,7 @@
 
 ;; line in a window
 (defclass glrepl-window-line ()
-  ((chain :initform (make-instance 'flexichain:standard-cursorchain :element-type 'base-char :initial-element #\Nul) :accessor chain-of)
+  ((chain :initform (make-instance 'flexichain:standard-cursorchain) :accessor chain-of)
    (cursor :initform nil :accessor cursor-of))
   (:documentation  "Line of text in a glrepl window"))
 
@@ -22,7 +22,7 @@
    (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)
+   (lines :initform (make-array 0  :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)
@@ -42,16 +42,16 @@
 (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)))
+(defmethod (setf current-result-line) (str (win glrepl-window))
+  (let ((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))
+      (for index from 0 below (flexichain:nb-elements result-line))
+      (flexichain:pop-start result-line))
     (iterate
       (for c in-string str)      
-      (flexichain:push-end current-result-line c))))
+      (flexichain:push-end result-line c))))
 
 (defgeneric current-cursor (win))
 (defmethod current-cursor ((win glrepl-window))
@@ -64,7 +64,7 @@
   (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))
+      (for index from 0 below (flexichain:nb-elements  chain))
       (setf (aref result index) (flexichain:element* chain index)))
     result))
 
diff --git a/package.lisp b/package.lisp
index 9339252..8ae3540 100644
--- a/package.lisp
+++ b/package.lisp
@@ -20,7 +20,8 @@
            glrepl-window
            glrepl-window-line
            current-line
-           current-line-as-string
+           current-result-line
+           current-line-as-string           
            current-cursor
            glrepl-window-mark
            add-line
-- 
2.11.4.GIT