main.lisp

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