From 0ff1cc881fe83af0a0581deadddcb093f067bc28 Mon Sep 17 00:00:00 2001 From: John Connors Date: Tue, 29 Jul 2008 23:40:12 +0100 Subject: [PATCH] More work on glrepl window --- glreader.lisp | Bin 503 -> 4257 bytes glrepl-tests.lisp | 173 ++++++++++++++++++++++++++++++++---------------------- glrepl.asd | 4 +- glrepl.lisp | 2 +- package.lisp | 7 ++- 5 files changed, 111 insertions(+), 75 deletions(-) rewrite glreader.lisp (100%) diff --git a/glreader.lisp b/glreader.lisp dissimilarity index 100% index 1c87620c2bda4c880ca5ef5d62619149a3fd9e9d..c8906bfe1fe71882aa98cdc130f50c0b1271ded9 100644 GIT binary patch literal 4257 zcwPaa5MJ*eiwFQKXpKk!1MM7LbK5pD&-oP?Wv(G@)0Gs-&M0$pbsIaAX%ctx(d*6J zOb;R1weu%C_6dVxd*e2Yyykj#bS4{SggEEa*-w9F6l>5ilQtI zleowp-QhEY=V&s)pQGdHklsh?9e*1=n;tzHjfRu)ba-?;hW^pycsO~)hIh$C-?J%7 zo-_97H@Ql~op2&A?t`KGeI9#}SY$lB;7h?~wi-NU@OU$rH=BhCo5iKbd07Fm8BfGD zPoq5MzW?~K7pH*}5B3p_oUaAoV0%{px)SknRqnClqvyV>|0<5k)gBuS#}h#C;sx;X ze8{fZc*-JB&xCK=qe^jIZgOEpdf&3~;SdHL4*d=V18ca@z~dO0+01v+JoCk8m%u2^z{(oFt5cCGcp==D?pQSt#>dgk`clH1iiJF%Q4(8?78i`=%GP zAdjzuwTu)hVvmaf?mVbE^q4;uES)Yxf@zKc|t2rz8#MvUnuNrFs*hKt-rl#>Pp;R>;Y z;E+&I+M<^^&sK3rok7MzGF30Z$$9Y_9izu{0rOkPv<#@F0N+F4AudZurm1XNp)9wV z$QVlS(KP znFo^v1Fv5F8-deqg7w>!8wh@;oqlQzV9i5DKt&z~JjqsE@h(#ltmAZ31a(IX11-&5 zEaQ|${J!B)v2RP>2riT|kAiUw<}~u#0GA?1nDK&?4dqnIj3ujLC#KO(Ow8K{Y^^QR zXIsW90{Kn?3m`E3d;-wA?d-lj(VWZj2AU|IT{N%z(5uG~sU)XAn}&TQ^CUw5KwE=~ zV`eke=``P?sj^wm_6$${eFCaE#ebIX*klpx3x-5gT3u@no->gkcTaEd%59WG?WUIC zrpkCNY`a4oXaS8TjJX2sZPxrk1aS)65o}iMX*HY5jj);8*N-M_rZ@GYN#%o>r(?bf zKL#c&W{X^|VKL?cw^nZthvTpsjNEu7y$ttTW-%7~?8z@G`ae6XsTp`JCk0y%v*6Hg zCjvYp%zhdTeP%7Faun$119BIAzM?z1t5pmR0fH$-fn=_OB8nY#fQ8OhfV*!BC~SX5vM~H8q)^2hJr<z zO|DsCwp+rLfXx#10eNBklE(=-)OevJRCSc$t7U- zPBbrJcf;|zrwdxI4Mj+>&aM5%0;@J!b2xNhF zs)Sjsk8JS01b0m5!_Gk5BS718xpgeMb3&cTnC+lD3sgv2)&W@;tdiTnX!#Ug3W-RO zwV`-}R|GfcKS-G6uj6&+NwswnaKZQvT(>_>w8plT-}J)94MDxPz+?j(`j+-qJC3E# zX43)h0--j9Ck?meQhmL2zbDpquzQ!P_NWHB8}}(2HcrC@qbap^cIP(CV%a0+yCFQwDZ4rp7~YJ?)>lYcr+TD{O@!)nLZkho=u+}J>-Ay z<8kF}O|s2On1V-GgOOKJ%=kH-r$$qV40~Wr2G@WdF&^f!DB9q(YiGP%VWI&%=UU`T zQ8g6o$xnly!EL^ksXQ#p#h{zbZKhKw!r^(&w?tcQOyF5Xm8OFL4gv;t%z#r0l?qnG zctU#pbPX}9j3bPpFrT-QxaSp^6%=VGBNbcafbI&h!md1r*k((xI?@CG*SZr z2QH%rVG7FELrJM)bX@1dYOV`|yQVrCTTm)-_D41kKwChgx7jKX*Ktu6LDocGV`#)$ zeUUzOHVy?=d(9i2t{0g5wGW=HV|rthKCIG0^a3?ekJMS#{OcW6<~%JD%tlYg46jo9 zutS(5K#uHrFG!U0s~{8@@rWqUi-j3rYZ3j{&~BPhFAwF*Oro^8;;z)B;gVm1XFwfk zI|;fF31ObN)3c{Wm7FTY28V!S(9o?GA+ije&Mg8;=R4S{BaQmx^yfDeh=cy6OE^uU zQwred%nfGM#PrKvlg6Hlr7E4`IOKp1_hxe2*`IFK=a#k(AypT-J>x-7m}&$4fWQXkrZCs9eUg26zT~O%KVZ&ZCI2%TkB3Kf{%1O-{LgUukpH=lr!W6wJ6<@= z>$C~Eth(-xfgihAhk1g(6cRk?CS1`5w8mTyQ^zQg7Ta~fJnx$v_6J5D*Jt0%C6-0O z2kr>}p-jSoM_1sKVZkyh<(xyAB$!zFk9UAYHiWL)DG$CQ6nfuNWZ@(z0+}Y;-86Ob zqT+8C?V7BjtN8T}zN<$qag;%3@x1H|w#N4&=#v2;1dIm-n@PpoWA??cApJir+D2R zvD0+3c3i!>$HM2QQ)@7MZp5uepZ|3F{^aB9^LG{om@h;du}p8oa{lRKaDEoNJ$-xr z{$GIMd{bhkb1l{~-`+U-!^e{!ehkikK7D`o=KP;9{6mR%X7W>9WHKC6L zFpFfkSwloetIh^55f9lsPnovX_piP`F*)WzWz?cv$%w9TV^EzxtZdPYFDNGqQF^kl zgbqFwD~**{>q6ea4=^`~a5-@n(SVBF<0{y%q>otrc9F1GOI-C^g~AG;NMsq1g%AXL zifirbTU(egz^4J624vVMQ?zR&mF+9{lA7|!f{p4rN22XlU^~kw`)VZ>|IJcKQ_WUg zTm*3kpZ$IXC)S{-3MEy=#Ft|#?*bF30Op?oP_^To1kd-sY=UcuJY2|X)>I~@C}Cwa zu1$)u3al}#G^+f*Nk)8e4XUpF+@)n`iPi-}zqaknCCoxNOqEzJ*S3SU;_uE$%(T4* zA`vJ8Oo=uPx|yBmm@paarwmWT=ph=ep=B+9ofW9e_&Dky8`iF~XP>@Fd_BW##7dP4 zSU?d4^KA*b;AwxWm!SH_0k{c~$00K%pd?Llf^cqt5Tzx11J>g>^%z`%_on)-y8@Ab z%?Jy=)=OTG)sXa^Q% zur#Zcchzw_W~9o3n-$5n4zsY42>f$we;2t-*RM(S$4HIVd19U#n=#<{Si$NkLl*6q(=|2+h49nb@9K8>uA* zjjw6ms+8G5m&HW+gd#MEgA^csRmiazG-otOmBKdjZGOXoa-}wHwNQlEukI9jIr#u* zsvFo)3x8W?n4;JT9wTv$cO@=Hu#cE|%QNI4R!x{$fVb;|t$qh`ykgIAM>{Z_B-e&Y zXSEu)_PJR1fwfq^-fB1p%j)|)6~i@)isg70!)S?KV^?9|Sk*TnT)MXHa8}h+rFvpx+2E_N!J;iju*{oH(xzPY${YoNMMaeIR9 zl}GDluxsxXsC~UnZOwZ}*Y#zef_AQ9tA%bXhIM;m1dn-}Ir~Otc(lU?&eS&p20zFY zw-uZ*)24zts+U4Zu^CLXbo05-6n3se3*=3Z$r52Z%w0h^{BV zFK|@9z{jS3(b?SAdjKI(0g=+LqhCim`o`8@GeKhL+Geo6F+^DC3UIoaOa)ekd){n; z-_RN8nGSBMaW(MjO1*mxV)fH~z-|Z-(?fB^!}IVwJP*&q^YA=8cl!JnYcBmY08jt` DDM%-) literal 503 zcwTLg(Qd*p3`O7j6&95?w_1K+JZvv~1w)!iOvy--EO8M?eEiY^9n$s?MY^`{J$8lG zt4R7l9m8wq5=Ylm6&l{@;Iohy;IMv8mN&pt1IXWS8r9}Dd!z*I z)lDTPBeZqg0_qUYzrww{I6m|OK7}YYcyfSQiqu0pk{C)xSsw>!%On6g7C>wt0{&)B zouzkjzPWkpuCOJ4xr8Az)N9y)1nB9&5bcRw2K0fh9PSL|8b|h)z06m*)a%ie(`Dw= z`?5HtZo)IH9VG^|oe$-oi(~Z@OUkjV`0_rnDZ|e8R@f+Kvq1f^x#LQ6TcX0uqKwUv cMDJBkIt4Ylk`_*7q%Lm__45PSKNl%RKQ|qtj{pDw diff --git a/glrepl-tests.lisp b/glrepl-tests.lisp index f64ab8c..76d99d4 100755 --- a/glrepl-tests.lisp +++ b/glrepl-tests.lisp @@ -1,42 +1,57 @@ (defpackage :glrepl-tests - (:use :cl :iterate :glrepl :alexandria :flexichain)) + (:use :cl :iterate :glrepl :alexandria :trivial-gray-streams)) (in-package :glrepl-tests) -(defclass glrepl-window () - (win-height :initarg :pixel-height :initform 768 :reader win-height-of) - (win-width :initarg :pxiel-width :iniform 1024 :reader 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) - (chains :initarg (make-array 0 :adjustable t :fill-pointer 0) :accessor chains-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 :accesor cursor-y-of) - (marks :initform (make-array 0 :adjustable t :fill-pointer 0) :accessor marks-of) - (kills :iniform (make-array 0 :adjustable t :fill-pointer 0) :accessor kills-of)) +(defclass glrepl-window-line () + ((chain :initform (make-instance 'flexichain:standard-flexichain) :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 :chain (chain-of self)))) (defclass glrepl-window-mark () - (line :initform 0 :initarg :line :accesor line-of) - (cursor :initform 0 :initarg :cursor :accessor cursor-of)) + ((line :initform 0 :initarg :line :accessor line-of) + (cursor :initform 0 :initarg :cursor :accessor cursor-of))) -(defmethod initialize-instance :after ((self glrepl-window-mark) &rest args) +(defmethod initialize-instance :after ((win glrepl-window-mark) &rest args) (destructuring-bind - (&key window &allow-other-keys) + (&key window &allow-other-keys) args - (setf (line-of self) (cursor-line-of window)) - (setf (cursor-of self) (make-instance 'flexichain-cursor :chain (aref (chains-of window) (cursor-line-of window)))))) + (setf (line-of win) (cursor-line-of window)) + (setf (cursor-of win) (make-instance 'flexichain:standard-flexicursor -(defclass glrepl-window-line () - (chain :initform (make-instance 'standard-flexichain) :accessor chain-of) - (cursor :initform nil :accessor cursor-of)) +;; to do -- seperate doc view? +(defclass glrepl-window () + ((win-height :initarg :pixel-height :initform 768 :reader win-height-of) + (win-width :initarg :pxiel-width :initform 1024 :reader 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")) + +(defmethod current-chain ((win glrepl-window)) + (chain-of (aref (lines-of win) (cursor-line-of win)))) + +(defmethod current-cursor ((win glrepl-window)) + (cursor-of (aref (lines-of win) (cursor-line-of win)))) + + :chain (current-chain win)))) -(defmethod initialize-instance :after ((self glrepl-window-line)) - (setf (cursor-of self) (make-instance 'standard-flexicursor :chain (chain-of self)))) (defmethod add-line ((win glrepl-window)) - (vector-push-extend (chains-of win) (make-isntance 'glrepl-window-line))) + (vector-push-extend (chains-of win) (make-instance 'glrepl-window-line))) (defmethod cursor-up ((win glrepl-window)) (when (not (zerop (cursor-line-of win)) @@ -55,30 +70,41 @@ (defmethod cursor-column ((win glrepl-window)) ;; return column position of cusror - ))) + (flexichain:cursor-pos (current-cursor win))) + (defmethod cursor-left ((win glrepl-window)) - ) + (when (not (flexichain:at-beginning-p (current-cursor win))) + (decf (flexichain:cursor-pos (current-cursor win))))) (defmethod cursor-right ((win glrepl-window)) - ) + (when (not (flexichain:at-end-p (current-cursor win))) + (incf (flexichain:cursor-pos (current-cursor win)))))) -(defmethod add-char ((win glrepl-window) c)) +(defmethod add-char ((win glrepl-window) c) + (flexichain:insert (current-cursor win) c)) (defmethod del-char-left ((win glrepl-window)) - ) + (when (not (flexichain:at-beginning-p (current-cursor win))) + (flexichain:delete< (current-cursor win))))) (defmethod del-char-right ((win glrepl-window)) - ) + (when (not (flexichain:at-end-p (current-cursor win))) + (flexichain:delete> (current-cursor 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 set-mark ((win glrepl-window))) (defmethod yank ((win glrepl-window)) ) -(defmethod paste ((win glrepl-window))) +(defmethod paste ((win glrepl-window)) + ) -(defmethod ) (defvar *esc-pressed* nil) (defparameter *glrepl-font* nil) @@ -90,24 +116,27 @@ (defparameter *texture-width* (/ 2.0 80.0)) (defparameter *texture-height* (/ 2.0 25.0)) -(defclass glrepl-output-stream (gray:fundamental-output-stream) - ((window :initarg (make-instance 'glrepl-window) :window-of :reader gl-window-of))))) +;; (defclass glrepl-output-stream (trivial-gray-streams:trivial-gray-stream-mixin +;; trivial-gray-streams:fundamental-input-stream) +;; ((window :initarg (make-instance 'glrepl-window) :window-of :reader gl-window-of))) -(defmethod stream-write-char ((stream glrepl-output-stream) c) - (add-char (gl-window-of stream) c)) -(defmethod stream-terpri ((stream glrepl-output-stream)) - (add-line (gl-window-of stream))) +;; (defmethod stream-write-char ((stream glrepl-output-stream) c) +;; (add-char (gl-window-of stream) c)) +;; (defmethod stream-terpri ((stream glrepl-output-stream)) +;; (add-line (gl-window-of stream))) -(defmethod texture-width-of ((self glrepl-window)) - (* 0.5 (text-width-of self))) (defmethod texture-width-of ((self glrepl-window)) - (* 0.5 (text-height-of self))) - + (/ 2.0 (text-width-of self))) +(defmethod texture-height-of ((self glrepl-window)) + (/ 2.0 (text-height-of self))) +(defmethod window-pixel-atxy ((win glrepl-window) x y) + (values (* x (texture-width-of win)) + (* y (texture-height-of win)))) (cffi:defcallback key-callback :void ((key :int) (action :int)) (when (= action glfw:+press+) @@ -146,7 +175,7 @@ (defun render-char (font c x y) (when (graphic-char-p c) - (let ((image (aref *(images-of font) (char-code c)))) + (let ((image (aref (glrepl::images-of font) (char-code c)))) (when (typep image 'rgba-image) (with-opengl (gl:bind-texture gl:+texture-2d+ @@ -167,13 +196,13 @@ (gl:vertex-2f x (+ y *texture-height*)))))))) ;; bot lhs -(defun render-world () +(defun render-world (window) ;; (glrepl::render (aref *font-images* 65))) - (render-char *glrepl-font* #\A 0.5 0.5)) + (render-char (font-of window) #\A 0.5 0.5)) (defun update-world (dt)) -(defun main-loop () +(defun main-loop (window) (let ((t0 (glfw:get-time)) (dt 0.0) (test-image (make-instance 'glrepl::rgba-image :width 64 :height 64))) @@ -189,7 +218,7 @@ (setf dt (- (glfw:get-time) t0)) (setf t0 (glfw:get-time)) (update-world dt) - (render-world) + (render-world window) ;;(glrepl::render test-image) ;; update ;; check for time available if time is avaliable render @@ -200,30 +229,32 @@ (defun test-glrepl () (if (glfw::init) - (progn - (handler-case - (if (glfw:open-window *win-width* *win-height* 16 16 16 16 16) + (let ((window (make-instance 'glrepl-window))) + (progn + (handler-case + (if (glfw:open-window (win-width-of window) (win-height-of window) 16 16 16 16 16) + (progn + (init-gl) + (format t "Making font..") + (setf (font-of window) (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 window) + (callback-clear) + (end-gl) + (glfw:terminate)) + (error "Failed to open window")) + (error (ohbum) (progn - (init-gl) - (format t "Making font..") - (setf *glrepl-font* (make-font)) - (format t "Done..") - (glfw:swap-interval 1) - (glfw:enable glfw:+key-repeat+) - (callback-set) -;; (glrepl::dump (aref *font-images* 65)) - (main-loop) - (callback-clear) + (format T "Boom ~A " ohbum) + (destroy-font (font-of window)) (end-gl) - (glfw:terminate)) - (error "Failed to open window")) - (error (ohbum) - (progn - (format T "Boom ~A " ohbum) - (destroy-font *glrepl-font*) - (end-gl) - (glfw:terminate))))) - (error "Failed to init glfw"))) + (glfw:close-window) + (glfw:terminate)))))) + (error "Failed to init glfw"))) ;; (defun test-glrepl () ;; (glfw:with-init-window ("Glrepl" *win-width* *win-height*) diff --git a/glrepl.asd b/glrepl.asd index 3023587..2f27e0e 100644 --- a/glrepl.asd +++ b/glrepl.asd @@ -10,11 +10,11 @@ :serial t :components ((:file "package") (:file "glrgba") - (:file "glreader") +;; (:file "glreader") (:file "glrepl"))) (defsystem :glrepl-tests :name "glrepl tests" - :depends-on (:glrepl :flexichain) + :depends-on (:glrepl :flexichain :trivial-gray-streams) :serial t :components ((:file "glrepl-tests"))) diff --git a/glrepl.lisp b/glrepl.lisp index fc5c7bf..35043b1 100755 --- a/glrepl.lisp +++ b/glrepl.lisp @@ -19,7 +19,7 @@ ;; but deadlines are DEADlines... -(defun make-font (pathname) +(defun make-font (font-pathname) (let ((result (make-instance 'glrepl-font :pathname font-pathname))) (iterate (for i from 0 below 128) diff --git a/package.lisp b/package.lisp index a855d44..f9dd172 100644 --- a/package.lisp +++ b/package.lisp @@ -10,6 +10,11 @@ name-of make-font destroy-font - rgba-image)) + rgba-image + glrepl-font + bitmap-height-of + bitmap-width-of + pathname-of + images-of)) (in-package :glrepl) \ No newline at end of file -- 2.11.4.GIT