main.lisp

   1
   2 (in-package :lambdamundo)
   3
   4 ;; callbacks --------------------
   5
   6 ;; window size / projection
   7
   8 (cffi:defcallback lambdamundo-resize-callback
   9     :void ((w :int) (h :int))
  10   (setf (win-width-of glrepl:*glwindow*) w)
  11   (setf (win-height-of glrepl:*glwindow*) h)
  12   (let* ((h/w (/ h w))
  13          (znear 5)
  14          (zfar 30)
  15          (xmax (* znear  0.5)))
  16     (gl:viewport 0 0 w h)
  17     (gl:with-setup-projection
  18             (glu:perspective 45.0 h/w 0.1 50.0))))
  19
  20 ;;     (gl:with-setup-projection
  21 ;;       (gl:frustum (- xmax) xmax (* (- xmax) h/w) (* xmax h/w) znear zfar))
  22
  23 ;;     (gl:load-identity)
  24 ;;     (gl:translate-f 0 0 -20)))
  25
  26
  27 ;; keyboard
  28
  29 (cffi:defcallback lambdamundo-char-callback :void ((key :int) (action :int))
  30   ;; (format t "Char ~A " key)
  31   (when (and glrepl:*console* (= action glfw:+press+))
  32     (let ((c (code-char key)))
  33       (when c
  34         (glrepl:add-char glrepl:*glwindow* (code-char key))))))
  35
  36 (cffi:defcallback lambdamundo-key-callback :void ((key :int) (action :int))
  37   (unless glrepl:*console* (when-funcall (gethash key *standard-key-fns*) action))
  38   (when glrepl:*console*   (when-funcall (gethash key *console-key-fns*) action)))
  39
  40 ;; mouse
  41
  42 (defparameter *mouse-wheel-pos* 0)
  43 (defparameter *mouse-wheel-delta* 0)
  44 (defparameter *mouse-wheel-changed* nil)
  45
  46 (defun render-debug ()
  47   (glrepl::render-string
  48    (format nil "~6,2F ~6,2F ~6,2F ~6,3F " (aref *modelview-debug* 0) (aref *modelview-debug* 1) (aref *modelview-debug* 2) (aref *modelview-debug* 3))
  49    0 20)
  50   (glrepl::render-string
  51    (format nil "~6,2F ~6,2F ~6,2F ~6,3F " (aref *modelview-debug* 4) (aref *modelview-debug* 5) (aref *modelview-debug* 6) (aref *modelview-debug* 7))
  52    0 21)
  53   (glrepl::render-string
  54    (format nil "~6,2F ~6,2F ~6,2F ~6,3F " (aref *modelview-debug* 8) (aref *modelview-debug* 9) (aref *modelview-debug* 10) (aref *modelview-debug* 11))
  55    0 22)
  56   (glrepl::render-string
  57    (format nil "~6,2F ~6,2F ~6,2F ~6,3F " (aref *modelview-debug* 12) (aref *modelview-debug* 13) (aref *modelview-debug* 14) (aref *modelview-debug* 14))
  58    0 23))
  59
  60
  61 (cffi:defcallback lambdamundo-mouse-wheel-callback :void ((pos :int))
  62   (setf *mouse-wheel-delta* (- pos *mouse-wheel-pos*))
  63   (setf *mouse-wheel-pos* pos)
  64   (setf *mouse-wheel-changed* t))
  65
  66 (defun callback-set ()
  67   (glfw:set-key-callback (cffi:callback lambdamundo-key-callback))
  68   (glfw:set-char-callback (cffi:callback lambdamundo-char-callback))
  69   (glfw:set-mouse-wheel-callback (cffi:callback lambdamundo-mouse-wheel-callback))
  70 ;;  (glfw:set-window-size-callback (cffi:callback lambdamundo-resize-callback))
  71
  72 )
  73
  74 (defun callback-clear ()
  75   (glfw:set-key-callback (cffi:null-pointer))
  76   (glfw:set-char-callback (cffi:null-pointer))
  77   (glfw:set-window-size-callback (cffi:null-pointer))
  78   (glfw:set-mouse-wheel-callback (cffi:null-pointer)))
  79
  80 ;; gl init and de-init --------------------
  81
  82 (defun begin-gl ()
  83   (gl:enable gl:+texture-2d+)
  84   (gl:enable gl:+blend+)
  85   (gl:enable gl:+depth-test+)
  86   (gl:disable gl:+cull-face+)
  87   (gl:disable gl:+lighting+))
  88
  89 (defun end-gl ())
  90
  91 ;; drawing --------------------
  92 ;; each cell will have to know how to cull itself
  93
  94 (eval-when ( :load-toplevel :compile-toplevel :execute )
  95   (defparameter *draw-fns* (make-hash-table :test 'equalp)
  96    "An table of functions called in order to render the scene")
  97
  98   (defparameter *draw-array* (make-array 0 :adjustable t :fill-pointer 0)
  99     "An array that indexes *draw-fns* to establish draw order" )
 100
 101   (defun extend-draw-array (name priority)
 102     "If the name is in the array, adjust priority, else add it to the array"
 103     (assert (not (null (gethash name *draw-fns*))) (name) "~S is not a drawable")
 104     (let
 105         ((draw-priority-pos
 106           (position-if #'(lambda (x) (equal (car x) name)) *draw-array*)))
 107       (if draw-priority-pos
 108           (setf (aref *draw-array* draw-priority-pos) (cons name priority))
 109         (vector-push-extend (cons name priority) *draw-array*)))))
 110
 111 (defmacro make-draw-function (name priority &body forms)
 112   `(progn
 113      (setf (gethash ,name *draw-fns*)
 114            (compile nil '(lambda ()  ,@forms)))
 115      (extend-draw-array ,name ,priority)
 116      (sort *draw-array* #'(lambda (a b)
 117                             (< (car a) (car b))))))
 118
 119 (defun render-world ()
 120   (gl:disable gl:+texture-2d+)
 121   (gl:disable gl:+blend+)
 122   (with-camera *camera*
 123     (iterate
 124       (for entry in-vector *draw-array*)
 125       (funcall (gethash (car entry) *draw-fns*)))
 126     (iterate
 127       (for actor in-vector *actors*)
 128       (render actor))))
 129
 130 (make-draw-function
 131  "testcube" 1
 132  (let ((vertices
 133         (list
 134          '(1.0 1.0 1.0)
 135          '(1.0 1.0 -1.0)
 136          '(1.0 -1.0 1.0)
 137          '(1.0 -1.0 -1.0)
 138          '(-1.0 1.0 1.0)
 139          '(-1.0 1.0 -1.0)
 140          '(-1.0 -1.0 1.0)
 141          '(-1.0 -1.0 -1.0)))
 142        (polys
 143         (list
 144          '(2 1 3 4)
 145          '(5 6 7 8)
 146          '(1 2 6 5)
 147          '(4 3 7 8)
 148          '(3 1 5 7)
 149          '(2 4 8 6))))
 150    (gl:with-begin gl:+quads+
 151      (gl:color-3f 0.0 1.0 0.0)
 152      (iterate
 153        (for poly in polys)
 154        (iterate
 155          (for vertex in poly)
 156          (apply #'gl:vertex-3f (nth (1- vertex) vertices)))))))
 157
 158
 159 ;; animation --------------------
 160
 161 (defparameter *frames* 0)
 162
 163 (defun update-world (dt)
 164   (incf *frames*)
 165   (when *mouse-wheel-changed*
 166     (pan *camera* 0.0 (* *mouse-wheel-delta* dt))
 167     (setf *mouse-wheel-changed* nil)))
 168
 169 (defmacro one-shot (&rest forms)
 170   `(setf *one-shot-fn* #'(lambda () ,@forms)))
 171
 172 (defmacro one-shot-compile (pathname)
 173   `(setf *one-shot-fn* #'(lambda ()
 174                            (multiple-value-bind
 175                                  (output-file  warnings-p failure-p)
 176                                (compile-file (merge-pathnames ,pathname) :verbose t :print t)
 177                              (declare (ignore warnings-p))
 178                              (when (not failure-p)
 179                                (load output-file :print t))))))
 180
 181 (defparameter *one-shot-fn* nil)
 182
 183 ;; main routine -------------------
 184 (defun main-loop ()
 185   (let ((t0 (coerce (glfw:get-time) 'single-float))
 186         (dt 0.0))
 187     (setf *mouse-wheel-pos* (glfw:get-mouse-wheel))
 188     (setf *mouse-wheel-delta* 0)
 189     (setf glrepl:*console-render-debug-fn* #'render-debug)
 190     (glfw:sleep 0.05d0)
 191     (gl:clear-color 0.0 0.0 0.0 1.0)
 192     (iterate
 193       (while (= (glfw::get-window-param glfw:+opened+) glfw:+true+))
 194       (gl:clear (logior gl:+color-buffer-bit+ gl:+depth-buffer-bit+))
 195       (setf dt (- (coerce (glfw:get-time) 'single-float) t0))
 196       (setf t0 (coerce (glfw:get-time) 'single-float))
 197       (update-world dt)
 198       (gl:viewport 0 0 (win-width-of glrepl:*glwindow*) (win-height-of glrepl:*glwindow*))
 199       (gl:matrix-mode gl:+projection+)
 200       (gl:load-identity)
 201       (glu:perspective 45.0 (/ (win-height-of glrepl:*glwindow*) (win-width-of glrepl:*glwindow*)) 0.1 50.0)
 202       (gl:matrix-mode gl:+modelview+)
 203       (render-world)
 204       (when glrepl:*console*
 205           (glrepl:render-console))
 206       (when *one-shot-fn*
 207         (funcall *one-shot-fn*)
 208         (setf *one-shot-fn* nil))
 209       ;; update
 210       ;; check for time available if time is avaliable render
 211       ;; surrender any cpu time..
 212       (glfw:swap-buffers))))
 213
 214 (defun begin-swank ()
 215   (unless *swank-port*
 216     (setf *swank-port* (swank::start-session 4112))
 217     (format t "Please fire up your emacs and connect.~%")
 218     (iterate
 219       (while (zerop  (length swank::*connections*)))
 220       (cl:sleep 0.1)
 221       (format t ".")
 222       (force-output))
 223     (format t "~%Connected.~%")))
 224
 225 (defun end-swank ()
 226   (when (not (zerop (length swank::*connections*)))
 227      (swank::end-session *swank-port*))
 228  (setf *swank-port* nil))
 229
 230 (defun oh-bum ()
 231   "Cleanup when something went wrong."
 232 ;;  (end-swank)
 233   (glfw:close-window)
 234   (glfw:terminate))
 235
 236 ;;
 237
 238
 239
 240
 241 ;;
 242 (defun lambdamundo ()
 243   (if (glfw::init)
 244       (progn
 245         (setf glrepl:*glwindow* (make-instance 'glrepl-window))
 246         (add-line glrepl:*glwindow*)
 247         (add-line glrepl:*glwindow*)
 248         (add-string glrepl:*glwindow* "(one-shot-compile #P\"mesh-compiler.lisp)\"")
 249         (if (glfw:open-window
 250              (win-width-of *glwindow*)
 251              (win-height-of *glwindow*)
 252              16 16 16 16 32)
 253             (progn
 254               (glfw:set-window-title "Lambdmundo")
 255               (progn
 256                 (begin-gl)
 257                 (begin-swank)
 258                 (format t "Making font..~%")
 259                 (setf (font-of glrepl:*glwindow*) (make-font (merge-pathnames #P"VeraMono.ttf")))
 260                 (format t "Done.")
 261                 (format t "Compiling mesh compiler..~%")
 262                 (gl-ext:load-extension "ARB_vertex_program")
 263                 (gl-ext:load-extension "ARB_vertex_buffer_object")
 264                 (one-shot-compile #P"mesh-compiler.lisp")
 265                 (format t "Done..~%")
 266                 (glfw:swap-interval 1)
 267                 (glfw:enable glfw:+key-repeat+)
 268                 (callback-set)
 269                 (set-current-camera (make-camera))
 270                 (main-loop)
 271                 (callback-clear)
 272 ;;                (end-swank)
 273                 (end-gl)
 274                 (if (= (glfw::get-window-param glfw:+opened+) glfw:+true+)
 275                     (glfw:close-window))
 276                 (glfw:terminate)))
 277             (progn
 278               (glfw:terminate)
 279               (error "Failed to open window"))))
 280         (error "Failed to init glfw")))
 281
 282
 283 ;; (lambdamundo-window ("Lambdamundo"
 284 ;;                     :dimensions (640 480)
 285 ;;                     :colourbits (0 0 0 0)
 286 ;;                     :depthbits 32
 287 ;;                     :stencilbits 0
 288 ;;                     :mode glfw:+window+)
 289 ;;   :key-callback
 290 ;;   (:void ((key :int) (action :int)) )
 291 ;;   :resize-callback
 292 ;;   (:void ((width :int) (height :int))
 293 ;;          )
 294 ;;   :start
 295 ;;   ((glfw:enable glfw:+key-repeat+)
 296 ;;    (glfw:swap-interval 0)
 297 ;;    (begin-gl)
 298 ;;    (glfw:set-window-size-callback (cffi:callback window-size-callback))
 299 ;;    (glfw:set-key-callback (cffi:callback key-callback)))
 300 ;;   :main
 301 ;;   ;; to do -- we need to drop in and out of body forms
 302 ;;   ((draw)
 303 ;;    (cl:sleep 1)
 304 ;;    (animate))))
 305