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*)))
  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 (defun render-world ()
 113   (gl:disable gl:+texture-2d+)
 114   (gl:disable gl:+blend+)
 115   (with-camera *camera*
 116     (iterate
 117       (for entry in-vector *draw-array*)
 118       (funcall (gethash (car entry) *draw-fns*)))))
 119
 120 (make-draw-function
 121  "testcube" 1
 122  (let ((vertices
 123         (list
 124          '(1.0 1.0 1.0)
 125          '(1.0 1.0 -1.0)
 126          '(1.0 -1.0 1.0)
 127          '(1.0 -1.0 -1.0)
 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        (polys
 133         (list
 134          '(2 1 3 4)
 135          '(5 6 7 8)
 136          '(1 2 6 5)
 137          '(4 3 7 8)
 138          '(3 1 5 7)
 139          '(2 4 8 6))))
 140    (gl:with-begin gl:+quads+
 141      (gl:color-3f 0.0 1.0 0.0)
 142      (iterate
 143        (for poly in polys)
 144        (iterate
 145          (for vertex in poly)
 146          (apply #'gl:vertex-3f (nth (1- vertex) vertices)))))))
 147
 148
 149 ;; animation --------------------
 150
 151 (defparameter *frames* 0)
 152
 153 (defun update-world (dt)
 154   (incf *frames*)
 155   (when *mouse-wheel-changed*
 156     (move *camera* 0.0 (* *mouse-wheel-delta* dt))
 157     (setf *mouse-wheel-changed* nil)))
 158
 159 ;; main routine -------------------
 160 (defun main-loop ()
 161   (let ((t0 (coerce (glfw:get-time) 'single-float))
 162         (dt 0.0))
 163     (setf *mouse-wheel-pos* (glfw:get-mouse-wheel))
 164     (setf *mouse-wheel-delta* 0)
 165     (setf glrepl:*console-render-debug-fn* #'render-debug)
 166     (glrepl::update-image test-image)
 167     (glfw:sleep 0.05d0)
 168     (gl:clear-color 0.0 0.0 0.0 1.0)
 169     (iterate
 170       (while (= (glfw::get-window-param glfw:+opened+) glfw:+true+))
 171       (gl:clear (logior gl:+color-buffer-bit+ gl:+depth-buffer-bit+))
 172       (setf dt (- (coerce (glfw:get-time) 'single-float) t0))
 173       (setf t0 (coerce (glfw:get-time) 'single-float))
 174       (update-world dt)
 175       (gl:viewport 0 0 (win-width-of glrepl:*glwindow*) (win-height-of glrepl:*glwindow*))
 176       (gl:matrix-mode gl:+projection+)
 177       (gl:load-identity)
 178       (glu:perspective 45.0 (/ (win-height-of glrepl:*glwindow*) (win-width-of glrepl:*glwindow*)) 0.1 50.0)
 179       (gl:matrix-mode gl:+modelview+)
 180       (render-world)
 181       (when glrepl:*console*
 182           (glrepl:render-console))
 183       ;; update
 184       ;; check for time available if time is avaliable render
 185       ;; surrender any cpu time..
 186       (glfw:swap-buffers))))
 187
 188 (defun begin-swank ()
 189   (unless *swank-port*
 190     (setf *swank-port* (swank::start-session 4112))
 191     (format t "Please fire up your emacs and connect!~%")
 192     (iterate
 193       (while (zerop  (length swank::*connections*)))
 194       (cl:sleep 1))))
 195
 196 (defun end-swank ()
 197   (when (not (zerop (length swank::*connections*)))
 198      (swank::end-session *swank-port*))
 199   (setf *swank-port* nil))
 200
 201 (defun oh-bum ()
 202   "Cleanup when something went wrong."
 203   (end-swank)
 204   (glfw:close-window)
 205   (glfw:terminate))
 206
 207 (defun lambdamundo ()
 208   (if (glfw::init)
 209       (progn
 210         (setf glrepl:*glwindow* (make-instance 'glrepl-window))
 211         (add-line glrepl:*glwindow*)
 212         (add-line glrepl:*glwindow*)
 213         (add-string glrepl:*glwindow* "(format nil \"Hello World\")")
 214         (if (glfw:open-window (win-width-of *glwindow*) (win-height-of *glwindow*) 16 16 16 16 32)
 215             (progn
 216               (glfw:set-window-title "Lambdmundo")
 217               (progn
 218                 (begin-gl)
 219                 (begin-swank)
 220                 (format t "Making font..")
 221                 (setf (font-of glrepl:*glwindow*) (make-font (merge-pathnames #P"VeraMono.ttf")));; prbly shld be mber of window
 222                 (format t "Done..")
 223                 (glfw:swap-interval 1)
 224                 (glfw:enable glfw:+key-repeat+)
 225                 (callback-set)
 226                 ;;                (glrepl::dump (aref *font-images* 65))
 227                 (main-loop)
 228                 (callback-clear)
 229                 (end-swank)
 230                 (end-gl)
 231                 (if (= (glfw::get-window-param glfw:+opened+) glfw:+true+)
 232                     (glfw:close-window))
 233                 (glfw:terminate)))
 234             (progn
 235               (glfw:terminate)
 236               (error "Failed to open window"))))
 237         (error "Failed to init glfw")))
 238
 239
 240 ;; (lambdamundo-window ("Lambdamundo"
 241 ;;                     :dimensions (640 480)
 242 ;;                     :colourbits (0 0 0 0)
 243 ;;                     :depthbits 32
 244 ;;                     :stencilbits 0
 245 ;;                     :mode glfw:+window+)
 246 ;;   :key-callback
 247 ;;   (:void ((key :int) (action :int)) )
 248 ;;   :resize-callback
 249 ;;   (:void ((width :int) (height :int))
 250 ;;          )
 251 ;;   :start
 252 ;;   ((glfw:enable glfw:+key-repeat+)
 253 ;;    (glfw:swap-interval 0)
 254 ;;    (begin-gl)
 255 ;;    (glfw:set-window-size-callback (cffi:callback window-size-callback))
 256 ;;    (glfw:set-key-callback (cffi:callback key-callback)))
 257 ;;   :main
 258 ;;   ;; to do -- we need to drop in and out of body forms
 259 ;;   ((draw)
 260 ;;    (cl:sleep 1)
 261 ;;    (animate))))
 262