(in-package #:clnl-interface)
-(defvar *patch-size* 13d0)
-
(defvar *turtle-list* nil)
+(defvar *patch-list* nil)
; It may be useful to keep windows around
(defvar *glut-window-opened* nil)
(gl:clear :color-buffer-bit :depth-buffer-bit)
(gl:matrix-mode :projection)
(gl:load-identity)
- (gl:ortho -71 71 -71 71 1 5000)
+ (gl:ortho
+ (floor (* (- (getf *dimensions* :xmin) 0.5) (patch-size)))
+ (floor (* (+ (getf *dimensions* :xmax) 0.5) (patch-size)))
+ (floor (* (- (getf *dimensions* :ymin) 0.5) (patch-size)))
+ (floor (* (+ (getf *dimensions* :ymax) 0.5) (patch-size)))
+ 0 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 ()
(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:translate -150 -150 -4.0)
+ (gl:scale (/ 1 300d0) (/ 1d0 300d0) 1)
+ (gl:translate -150 -150 -0.0)
(gl:begin :polygon)
(gl:vertex 150 5 0)
(gl:vertex 40 250 0)
(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: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)
+ DIMS: (:xmin XMIN :xmax XMAX :ymin YMIN :ymax YMAX :patch-size PATCH-SIZE)
ARGUMENTS AND VALUES:
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
+ PATCH-SIZE: A double representing the size of the patches in pixels
DESCRIPTION:
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))
+ (setf *dimensions* dims)
+ (when *glut-window-opened*
+ (cl-glut:reshape-window (world-width-in-pixels) (world-height-in-pixels))))
(defun run ()
"RUN => RESULT
(sb-int:with-float-traps-masked (:invalid)
(cl-glut:init)
(cl-glut:init-window-size
- (floor (* *patch-size* (1+ (- (getf *dimensions* :xmax) (getf *dimensions* :xmin)))))
- (floor (* *patch-size* (1+ (- (getf *dimensions* :ymax) (getf *dimensions* :ymin))))))
+ (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)
(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 patch-size () (getf *dimensions* :patch-size))
+
+(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
(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+ (-
+ ; (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+ (-
+ ; (floor (* (patch-size) (1+ (- (getf *world-dims* :xmax) (getf *world-dims* :xmin))))))
+ ; (floor (* (patch-size) (1+ (-
; (getf *dimensions* :xmax)
; (getf *dimensions* :xmin)))))
- (width 143) ; Hard coded for now, yay v1 (if you see this comment in a year, please cry for me)
- (height 143))
+ (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)
projects / clnl / blobdiff