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