X-Git-Url: https://code.consxy.com/gitweb/gitweb.cgi?a=blobdiff_plain;ds=sidebyside;f=src%2Fmain%2Finterface.lisp;h=ba3efc5fdc4961e3da75ed3a77ac4faab272fe47;hb=b018550f2029475c8bececad3c6658048c8c80f0;hp=387679e826c0e7f96ce99c2a17286b5158ba3a74;hpb=471de83db1aee70065808cbc061867e3320bf4b7;p=clnl diff --git a/src/main/interface.lisp b/src/main/interface.lisp index 387679e..ba3efc5 100644 --- a/src/main/interface.lisp +++ b/src/main/interface.lisp @@ -1,12 +1,12 @@ (in-package #:clnl-interface) (defvar *patch-size* 13d0) -(defvar *world-dims* '(:xmin -5 :xmax 5 :ymin -5 :ymax 5)) (defvar *turtle-list* nil) ; It may be useful to keep windows around (defvar *glut-window-opened* nil) +(defvar *dimensions* nil) (defvar *colors* '((140 140 140) ; gray (5) @@ -43,13 +43,18 @@ (mapcar (lambda (turtle) (let - ((color (nl-color->rgb (clnl-nvm:turtle-color turtle)))) + ((color (nl-color->rgb (getf turtle :color)))) (gl:color (car color) (cadr color) (caddr color))) - (gl:with-pushed-matrix - (gl:translate (* (clnl-nvm:turtle-xcor turtle) *patch-size*) (* (clnl-nvm:turtle-ycor turtle) *patch-size*) 0) - (gl:rotate (clnl-nvm:turtle-heading turtle) 0 0 -1) - (gl:call-list *turtle-list*))) - (clnl-nvm:turtles)) + (mapcar + (lambda (x-modification y-modification) + (gl:with-pushed-matrix + (gl:translate (* (getf turtle :xcor) *patch-size*) (* (getf turtle :ycor) *patch-size*) 0) + (gl:translate x-modification y-modification 0) + (gl:rotate (getf turtle :heading) 0 0 -1) + (gl:call-list *turtle-list*))) + (list 0 (1- (world-width-in-pixels)) (- (1- (world-width-in-pixels))) 0 0) + (list 0 0 0 (1- (world-height-in-pixels)) (- (1- (world-height-in-pixels)))))) + (clnl-nvm:current-state)) (gl:flush)) (defun display () @@ -60,7 +65,7 @@ (cl-glut:post-redisplay)) (defun close-func () - (sb-ext:exit)) + (sb-ext:exit :abort t)) (defun reshape (width height) (when (and (/= 0 width) (/= 0 height)) @@ -84,19 +89,52 @@ (gl:vertex 260 250 0) (gl:end))) +(defun initialize (&key dims) + "INITIALIZE &key DIMS => RESULT + + DIMS: (:xmin XMIN :xmax XMAX :ymin YMIN :ymax YMAX) + +ARGUMENTS AND VALUES: + + RESULT: undefined + XMIN: An integer representing the minimum patch coord in X + XMAX: An integer representing the maximum patch coord in X + YMIN: An integer representing the minimum patch coord in Y + YMAX: An integer representing the maximum patch coord in Y + +DESCRIPTION: + + This is where the initialization of the interface that sits behind + the interface lives. From here, one can go into headless or running + mode, but for certain things this interface will still need to act, + and also allows for bringing up and taking down of visual elements." + (setf *dimensions* dims)) + (defun run () + "RUN => RESULT + +ARGUMENTS AND VALUES: + + RESULT: undefined, should never get here + +DESCRIPTION: + + RUN runs the view in an external window. + + This should be run inside another thread as it starts the glut main-loop. + Closing this window will then cause the entire program to terminate." ; I do this because I don't know who or what in the many layers ; is causing the floating point errors, but I definitely don't ; want to investigate until simply ignoring them becomes a problem. (sb-int:with-float-traps-masked (:invalid) (cl-glut:init) - (gl:clear-color 0 0 0 1) (cl-glut:init-window-size - (floor (* *patch-size* (1+ (- (getf *world-dims* :xmax) (getf *world-dims* :xmin))))) - (floor (* *patch-size* (1+ (- (getf *world-dims* :ymax) (getf *world-dims* :ymin)))))) - (setf *glut-window-opened* t) - (cl-glut:create-window "CLNL Test Window") + (world-width-in-pixels) + (world-height-in-pixels)) (cl-glut:init-display-mode :double :rgba) + (cl-glut:create-window "CLNL Test Window") + (setf *glut-window-opened* t) + (gl:clear-color 0 0 0 1) (cl-glut:display-func (cffi:get-callback 'display)) (glut:reshape-func (cffi:callback reshape)) (cl-glut:idle-func (cffi:get-callback 'idle)) @@ -104,22 +142,51 @@ (set-turtle-list) (cl-glut:main-loop))) +(defun world-width-in-pixels () + (floor (* *patch-size* (1+ (- (getf *dimensions* :xmax) (getf *dimensions* :xmin)))))) + +(defun world-height-in-pixels () + (floor (* *patch-size* (1+ (- (getf *dimensions* :ymax) (getf *dimensions* :ymin)))))) + (defun export-view () + "EXPORT-VIEW => IMAGE-DATA + +ARGUMENTS AND VALUES: + + IMAGE-DATA: A vector, pixel data as returned by opengls readPixels + +DESCRIPTION: + + EXPORT-VIEW returns the current view in raw data of RGBA pixels. + + Each pixel is made up of 4 bytes of data, which an be walked over. The number + of pixels is the current width x height. Converting to some other image format + is a matter of pulling that information out and putting it into whatever format + you like. + + This requires opengl to run, but can be used with xvfb in a headless mode." (sb-int:with-float-traps-masked (:invalid) (when (not *glut-window-opened*) (cl-glut:init) - (gl:clear-color 0 0 0 1) (cl-glut:init-window-size 1 1) (cl-glut:create-window "CLNL Test Window") + (gl:clear-color 0 0 0 1) (set-turtle-list) (setf *glut-window-opened* t)) (let ((fbo (first (gl:gen-framebuffers 1))) (render-buf (first (gl:gen-renderbuffers 1))) - ;(width (floor (* *patch-size* (1+ (- (getf *world-dims* :xmax) (getf *world-dims* :xmin)))))) - ;(height (floor (* *patch-size* (1+ (- (getf *world-dims* :ymax) (getf *world-dims* :ymin)))))) - (width 143) ; Hard coded for now, yay v1 (if you see this comment in a year, please cry for me) - (height 143)) + ;(width + ; (floor (* *patch-size* (1+ (- + ; (getf *dimensions* :ymax) + ; (getf *dimensions* :ymin)))))) + ;(height + ; (floor (* *patch-size* (1+ (- (getf *world-dims* :xmax) (getf *world-dims* :xmin)))))) + ; (floor (* *patch-size* (1+ (- + ; (getf *dimensions* :xmax) + ; (getf *dimensions* :xmin))))) + (width (world-width-in-pixels)) ; Hard coded for now, yay v1 (if you see this comment in a year, please cry for me) + (height (world-height-in-pixels))) (gl:bind-framebuffer :framebuffer fbo) (gl:bind-renderbuffer :renderbuffer render-buf) (gl:renderbuffer-storage :renderbuffer :rgba8 width height)