window.lisp

   1 (in-package :lambdamundo)
   2
   3 ;; called when window is resized
   4 (cffi:defcallback lambdamundo-resize-callback
   5     :void ((width :int) (height :int))
   6          (let* ((ar (/ height width)))
   7            (gl:viewport 0 0 width height)
   8            (gl:with-setup-projection
   9              (glu:perspective 45.0 ar 0.1 50.0))))
  10
  11
  12 (defmacro lambdamundo-window ((title &key
  13                                     (dimensions '(0 0))
  14                                     (colourbits '(:redbits 0 :greenbits 0 :bluebits 0 :alphabits 0))
  15                                     (depthbits 32)
  16                                     (stencilbits 0)
  17                                     (mode glfw:+window+))
  18                              &body forms)
  19   "Top level form for managing our window."
  20   (destructuring-bind (width height)
  21       dimensions
  22     (destructuring-bind (redbits greenbits bluebits alphabits)
  23         colourbits
  24       (destructuring-bind (&key pre start main end
  25                                 key-callback
  26                                 resize-callback
  27                                 char-callback
  28                                 mouse-callback)
  29           forms
  30         `(progn
  31            ,(when pre
  32                   `(progn ,@pre))
  33            (glfw:with-init-window (,title ,width ,height ,redbits ,greenbits ,bluebits ,alphabits ,depthbits ,stencilbits ,mode)
  34              ,@start
  35              ,(when mouse-callback
  36                     `(glfw:set-mouse-button-callback (cffi:callback ,mouse-callback)))
  37              ,(when key-callback
  38                     `(glfw:set-key-callback (cffi:callback ,key-callback)))
  39              ,(when resize-callback
  40                     `(glfw:set-window-size-callback (cffi:callback ,resize-callback)))
  41              ,(when char-callback
  42                     `(glfw:set-char-callback (cffi:callback ,char-callback)))
  43              (iterate
  44                ,@main
  45                (glfw:swap-buffers)
  46                (while (eql (glfw:get-window-param glfw:+opened+) gl:+true+)))
  47              ,@end))))))