main.lisp

   1
   2
   3 (in-package :lambdamundo)
   4
   5
   6 (defmacro with-gensyms ((&rest names) &body body)
   7   `(let ,(loop for n in names collect `(,n (gensym)))
   8      ,@body))
   9
  10 (defmacro once-only ((&rest names) &body body)
  11   (let ((gensyms (loop for n in names collect (gensym))))
  12     `(let (,@(loop for g in gensyms collect `(,g (gensym))))
  13        `(let (,,@(loop for g in gensyms for n in names collect ``(,,g ,,n)))
  14           ,(let (,@(loop for n in names for g in gensyms collect `(,n ,g)))
  15              ,@body)))))
  16
  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 (/ height width))
  23          (znear 5)
  24          (zfar 30)
  25          (xmax (* znear  0.5)))
  26
  27     (gl:viewport 0 0 width height)
  28     (gl:with-setup-projection
  29       (gl:frustum (- xmax) xmax (* (- xmax) h) (* xmax h) znear zfar))
  30
  31     (gl:load-identity)
  32     (gl:translate-f 0 0 -20)))
  33
  34 (cffi:defcallback lambdamundo-key-callback :void ((key :int) (action :int))
  35   (when-funcall (gethash key *key-fns*)))
  36
  37 ;; gl init and de-init
  38
  39 (defun begin-gl ()
  40   (gl:enable gl:+texture-2d+)
  41   (gl:enable gl:+blend+)
  42   (gl:enable gl:+depth-test+)
  43   (gl:disable gl:+cull-face+)
  44   (gl:disable gl:+lighting+))
  45
  46 (defun end-gl ())
  47
  48 ;; drawing --------------------
  49 ;; each cell will have to know how to cull itself
  50
  51 (eval-when ( :load-toplevel :compile-toplevel :execute )
  52   (defparameter *draw-fns* (make-hash-table :test 'equalp)
  53    "An table of functions called in order to render the scene")
  54
  55   (defparameter *draw-array* (make-array 0 :adjustable t :fill-pointer 0)
  56     "An array that indexes *draw-fns* to establish draw order" )
  57
  58   (defun extend-draw-array (name priority)
  59     "If the name is in the array, adjust priority, else add it to the array"
  60     (assert (not (null (gethash name *draw-fns*))) (name) "~S is not a drawable")
  61     (let
  62         ((draw-priority-pos
  63           (position-if #'(lambda (x) (equal (car x) name)) *draw-array*)))
  64       (if draw-priority-pos
  65           (setf (aref *draw-array* draw-priority-pos) (cons name priority))
  66         (vector-push-extend (cons name priority) *draw-array*)))))
  67
  68 (defmacro make-draw-function (name priority &body forms)
  69   `(progn
  70      (setf (gethash ,name *draw-fns*)
  71            (compile nil '(lambda ()  ,@forms)))
  72      (extend-draw-array ,name ,priority)
  73      (sort *draw-array* #'(lambda (a b)
  74                             (< (car a) (car b))))))
  75 (defun render-world ()
  76   (with-camera *camera*
  77     (iterate
  78       (for entry in-vector *draw-array*)
  79       (funcall (gethash (car entry) *draw-fns*)))))
  80
  81 (make-draw-function
  82  "testcube" 1
  83  (let ((vertices
  84         (list
  85          '(1.0 1.0 1.0)
  86          '(1.0 1.0 -1.0)
  87          '(1.0 -1.0 1.0)
  88          '(1.0 -1.0 -1.0)
  89          '(-1.0 1.0 1.0)
  90          '(-1.0 1.0 -1.0)
  91          '(-1.0 -1.0 1.0)
  92          '(-1.0 -1.0 -1.0)))
  93        (polys
  94         (list
  95          '(2 1 3 4)
  96          '(5 6 7 8)
  97          '(1 2 6 5)
  98          '(4 3 7 8)
  99          '(3 1 5 7)
 100          '(2 4 8 6))))
 101    (gl:with-begin gl:+quads+
 102    (gl:color-3f 0.0 1.0 0.0)
 103    (iterate
 104     (for poly in polys)
 105     (iterate
 106      (for vertex in poly)
 107      (apply #'gl:vertex-3f (nth (1- vertex) vertices)))))))
 108
 109
 110 ;; animation --------------------
 111
 112 (defparameter *frames* 0)
 113
 114 (defun update-world (dt)
 115   (incf *frames*))
 116
 117 (defparameter *esc-pressed* nil)
 118
 119 ;; main routine -------------------
 120 (defun main-loop ()
 121   (let ((t0 (glfw:get-time))
 122         (dt 0.0)
 123         (test-image (make-instance 'glrepl::rgba-image :width 64 :height 64)))
 124     (iterate
 125       (for i from 0 below (* 64 64))
 126       (setf (glrepl::pixel test-image i) #X000000FF))
 127     (glrepl::update-image test-image)
 128     (glfw:sleep 0.05d0)
 129     (gl:clear-color 0.0 0.0 0.0 1.0)
 130     (iterate
 131       (while (= (glfw::get-window-param glfw:+opened+) glfw:+true+))
 132       (gl:clear gl:+color-buffer-bit+)
 133       (setf dt (- (glfw:get-time) t0))
 134       (setf t0 (glfw:get-time))
 135       (update-world dt)
 136       (render-world)
 137       (when *console*
 138           (glrepl:render-console))
 139       ;;(glrepl::render  test-image)
 140       ;; update
 141       ;; check for time available if time is avaliable render
 142       ;; surrender any cpu time..
 143       (glfw:swap-buffers)
 144       (if *esc-pressed*
 145           (glfw:close-window)))))
 146
 147 (defun set-callbacks ()
 148   (glfw:set-key-callback (cffi:callback lambdamundo-key-callback))
 149   (glfw:set-window-size-callback (cffi:callback lambdamundo-resize-callback)))
 150
 151 (defun lambdamundo ()
 152   (if (glfw::init)
 153       (progn
 154         (setf glrepl:*glwindow* (make-instance 'glrepl-window))
 155         (add-line glrepl:*glwindow*)
 156         (add-line glrepl:*glwindow*)
 157         (add-string glrepl:*glwindow* "(format nil \"Hello World\")")
 158         (if (glfw:open-window (win-width-of *glwindow*) (win-height-of *glwindow*) 16 16 16 16 16)
 159             (progn
 160               (glfw:set-window-title "Lambdmundo")
 161               (progn
 162                 (begin-gl)
 163                 (format t "Making font..")
 164                 (setf (font-of glrepl:*glwindow*) (make-font (merge-pathnames #P"VeraMono.ttf")));; prbly shld be mber of window
 165                 (format t "Done..")
 166                 (glfw:swap-interval 1)
 167                 (glfw:enable glfw:+key-repeat+)
 168                 ;;(callback-set)
 169                 ;;                (glrepl::dump (aref *font-images* 65))
 170                 (main-loop)
 171                 ;;(callback-clear)
 172                 (end-gl)
 173                 (glfw:close-window)
 174                 (glfw:terminate)))
 175             (progn
 176               (glfw:terminate)
 177               (error "Failed to open window"))))
 178         (error "Failed to init glfw"))))
 179
 180
 181 ;; (lambdamundo-window ("Lambdamundo"
 182 ;;                     :dimensions (640 480)
 183 ;;                     :colourbits (0 0 0 0)
 184 ;;                     :depthbits 32
 185 ;;                     :stencilbits 0
 186 ;;                     :mode glfw:+window+)
 187 ;;   :key-callback
 188 ;;   (:void ((key :int) (action :int)) )
 189 ;;   :resize-callback
 190 ;;   (:void ((width :int) (height :int))
 191 ;;          )
 192 ;;   :start
 193 ;;   ((glfw:enable glfw:+key-repeat+)
 194 ;;    (glfw:swap-interval 0)
 195 ;;    (begin-gl)
 196 ;;    (glfw:set-window-size-callback (cffi:callback window-size-callback))
 197 ;;    (glfw:set-key-callback (cffi:callback key-callback)))
 198 ;;   :main
 199 ;;   ;; to do -- we need to drop in and out of body forms
 200 ;;   ((draw)
 201 ;;    (cl:sleep 1)
 202 ;;    (animate))))
 203