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