X-Git-Url: https://code.consxy.com/gitweb/gitweb.cgi?a=blobdiff_plain;f=src%2Fmain%2Finterface.lisp;h=6033740249a3be3843873e70b9d670e1056cb948;hb=057ed8d;hp=92f292ab4a00b3859bbc6207f4b0a94e4611e0a2;hpb=5c8699f151207953f4029e0fc6c488afce99f756;p=clnl diff --git a/src/main/interface.lisp b/src/main/interface.lisp index 92f292a..6033740 100644 --- a/src/main/interface.lisp +++ b/src/main/interface.lisp @@ -1,12 +1,13 @@ (in-package #:clnl-interface) (defvar *patch-size* 13d0) -(defvar *world-dims* '(:xmin -5 :xmax 5 :ymin -5 :ymax 5)) (defvar *turtle-list* nil) +(defvar *patch-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) @@ -40,16 +41,35 @@ (gl:ortho -71 71 -71 71 1 5000) (gl:matrix-mode :modelview) (gl:load-identity) - (mapcar - (lambda (turtle) - (let - ((color (nl-color->rgb (getf turtle :color)))) - (gl:color (car color) (cadr color) (caddr color))) - (gl:with-pushed-matrix - (gl:translate (* (getf turtle :xcor) *patch-size*) (* (getf turtle :ycor) *patch-size*) 0) - (gl:rotate (getf turtle :heading) 0 0 -1) - (gl:call-list *turtle-list*))) - (clnl-nvm:current-state)) + (destructuring-bind (turtles patches) (clnl-nvm:current-state) + (mapcar + (lambda (patch) + (let + ((color (nl-color->rgb (getf patch :color)))) + (gl:color (car color) (cadr color) (caddr color))) + (gl:with-pushed-matrix + (gl:translate (* (getf patch :xcor) *patch-size*) (* (getf patch :ycor) *patch-size*) 0) + (gl:translate (floor (* -.5d0 *patch-size*)) (floor (* -.5d0 *patch-size*)) 0) + (gl:scale *patch-size* *patch-size* 1) + (gl:call-list *patch-list*))) + patches) + (mapcar + (lambda (turtle) + (let + ((color (nl-color->rgb (getf turtle :color)))) + (gl:color (car color) (cadr color) (caddr color))) + (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:scale *patch-size* *patch-size* 1) + (gl:scale (getf turtle :size) (getf turtle :size) 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)))))) + turtles)) (gl:flush)) (defun display () @@ -60,7 +80,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)) @@ -75,7 +95,7 @@ (setf *turtle-list* (gl:gen-lists 1)) (gl:with-new-list (*turtle-list* :compile) (gl:rotate 180 0 0 -1) - (gl:scale (* (/ 1d0 300d0) 13) (* (/ 1d0 300d0) 13) 1) + (gl:scale (/ 1d0 300d0) (/ 1d0 300d0) 1) (gl:translate -150 -150 -4.0) (gl:begin :polygon) (gl:vertex 150 5 0) @@ -84,6 +104,38 @@ (gl:vertex 260 250 0) (gl:end))) +(defun set-patch-list () + (setf *patch-list* (gl:gen-lists 1)) + (gl:with-new-list (*patch-list* :compile) + (gl:translate 0d0 0d0 -4.0) + (gl:begin :polygon) + (gl:vertex 0 0 0) + (gl:vertex 0 1 0) + (gl:vertex 1 1 0) + (gl:vertex 1 0 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 @@ -102,20 +154,27 @@ DESCRIPTION: ; 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)) (cl-glut:close-func (cffi:get-callback 'close-func)) (set-turtle-list) + (set-patch-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 @@ -136,18 +195,26 @@ DESCRIPTION: (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) + (set-patch-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)