game.lisp

   1 ;;; Copyright 2009-2011 Christoph Senjak
   2
   3 (in-package :uxul-world)
   4
   5 (defparameter *cfont* nil)
   6 (defvar *zoomx* 1.0)
   7 (defvar *zoomy* 1.0)
   8 (defvar *offset*)
   9 (defvar *ptr*)
  10
  11 (defun run-testing-room ()
  12   (start-game :room-function #'make-testing-room))
  13
  14 (defun run-room (item-list)
  15   (start-game :room-function
  16               #'(lambda () (create-room-from-item-list item-list))))
  17
  18 (defun start-game (&key (music nil)
  19                    (room-function #'make-additional-testing-room)
  20                    (15-fps nil))
  21   (declare (ignore music))
  22   "Start the Game: Call room-function for getting the room-object to
  23 run. Music is ignored so far. 15-fps makes only every second frame be
  24 drawn (for very slow computers)"
  25 ;  (sdl:set-video-driver "directx")
  26      (sdl:with-init (sdl:sdl-init-video) ;sdl:sdl-init-video sdl:sdl-init-audio)
  27        (sdl:window +screen-width+ +screen-height+
  28                    :title-caption "Uxul World"
  29                    :icon-caption "Uxul World"
  30                    :flags sdl:sdl-opengl
  31                    ;:opengl T
  32                    ;:flags (logior sdl:sdl-hw-accel  sdl:sdl-hw-surface)
  33                    ;:flags (logior sdl:sdl-hw-surface) #| sdl:sdl-fullscreen )|#
  34                    )
  35        (setf cl-opengl-bindings:*gl-get-proc-address*
  36              #'sdl-cffi::sdl-gl-get-proc-address)
  37        ;;(if music (sdl-mixer:OPEN-AUDIO :frequency 44100))
  38
  39        (gl:hint :perspective-correction-hint :nicest)
  40
  41        (let ((*graphics-table* (make-hash-table :test #'equal))
  42              (*spritesheet-id* (load-spritesheet))
  43              (*buffer-id* (car (gl:gen-buffers 1)))
  44              (*zoomx* (/ 1.0 +screen-width+))
  45              (zoomxi (/ .01 +screen-width+))
  46              (*zoomy* (/ 1.0 +screen-height+))
  47              (zoomyi (/ .01 +screen-height+)))
  48          (if 15-fps
  49              (setf (sdl:frame-rate) 15)
  50              (setf (sdl:frame-rate) 30))
  51
  52          (setf *current-room* (funcall room-function))
  53
  54          ;(sdl:clear-display (sdl:color :r 0 :g 0 :b 0));; :update-p nil)
  55
  56          ;;(if music (sdl-mixer:play-sample levelmusic))
  57
  58          (sdl:with-events ()
  59            (:quit-event ()
  60                         #|(if music
  61                         (progn (sdl-mixer:halt-music)
  62                         (sdl-mixer:halt-sample :channel t)
  63                         (sdl-mixer:free levelmusic)
  64                         (sdl-mixer:close-audio))
  65                         t
  66                         )|# t)
  67            (:key-down-event (:key key)
  68                             (cond
  69                               ((sdl:key= key :SDL-KEY-ESCAPE)
  70                                (sdl:push-quit-event))
  71                               ((sdl:key= key :SDL-KEY-U)
  72                                (incf *zoomx* zoomxi)
  73                                (incf *zoomy* zoomyi))
  74                               ((sdl:key= key :SDL-KEY-D)
  75                                (decf *zoomx* zoomxi)
  76                                (decf *zoomy* zoomyi))
  77                               (T
  78                                (on-key-down *current-room* key))))
  79            (:mouse-button-down-event
  80             (:button btn)
  81             (cond
  82               ((= btn sdl:mouse-wheel-up)
  83                (incf *zoomx* zoomxi) (incf *zoomy* zoomyi))
  84               ((= btn sdl:mouse-wheel-down)
  85                (decf *zoomx* zoomxi) (decf *zoomy* zoomyi))))
  86            (:key-up-event (:key key)
  87                           (on-key-up *current-room* key))
  88            (:idle
  89               (invoke *current-room*)
  90               (when 15-fps
  91                 (invoke *current-room*))
  92               (let ((float-size (cffi:foreign-type-size :float))
  93                     (obj-num 0))
  94                 (dolist (i (get-objects *current-room*
  95                                         'uxul-world::game-object))
  96                   (and (redraw i) (visible i) (incf obj-num)))
  97
  98               (gl:clear :color-buffer-bit :depth-buffer-bit)
  99               (gl:enable :texture-2d :blend)
 100               (gl:blend-func :src-alpha :one-minus-src-alpha)
 101               (gl:load-identity)
 102               (gl:bind-buffer :array-buffer *buffer-id*)
 103               (%gl:buffer-data :array-buffer
 104                                (* float-size
 105                                   4 ; vertices per sprite
 106                                   4 ; components per vertice
 107                                   obj-num)
 108                                (cffi:null-pointer) :stream-draw)
 109               (gl:with-mapped-buffer
 110                   (p :array-buffer :write-only)
 111                 (let ((*ptr* p) (*offset* 0))
 112                   (draw *current-room*)))
 113               (%gl:tex-coord-pointer 2 :float
 114                                      (* 4 ; components per vertex
 115                                         float-size)
 116                                      (cffi:null-pointer))
 117               (%gl:vertex-pointer 2 :float
 118                                   (* 4  ; components per vertex
 119                                      (cffi::foreign-type-size :float))
 120                                   (cffi:make-pointer (* 2
 121                                                         float-size)))
 122               (gl:enable-client-state :texture-coord-array)
 123               (gl:enable-client-state :vertex-array)
 124               (gl:bind-texture :texture-2d *spritesheet-id*)
 125               (%gl:draw-arrays :quads 0 (* 4 obj-num))
 126               (gl:disable-client-state :vertex-array)
 127               (gl:disable-client-state :texture-coord-array)
 128               (gl:flush)
 129               (gl:bind-buffer :array-buffer 0)
 130               (sdl:update-display)))))))
 131
 132
 133
 134 ;; ;; For Debugging
 135
 136 ;; (defun preview-animation (frameskip &rest images)
 137
 138 ;;      (sdl:with-init (sdl:sdl-init-video sdl:sdl-init-audio)
 139 ;;        (sdl:window +screen-width+ +screen-height+
 140 ;;                 :title-caption "Uxul World"
 141 ;;                 :icon-caption "Uxul World"
 142 ;;                 :flags (logior sdl:sdl-hw-accel)
 143 ;;                 #| :flags (logior sdl:sdl-hw-surface sdl:sdl-fullscreen )|#  )
 144 ;;        (let ((*graphics-table*
 145 ;;            #-ecl (trivial-garbage:make-weak-hash-table
 146 ;;                   :weakness :value
 147 ;;                   :test #'equal)
 148 ;;            #+ecl (make-hash-table :test #'equal)
 149 ;;            )
 150 ;;           (my-anim (apply #'make-animation frameskip images))
 151 ;;           )
 152
 153 ;;       (setf (sdl:frame-rate) 30)
 154 ;;       (sdl:clear-display (sdl:color :r 64 :g 64 :b 46));; :update-p nil)
 155
 156 ;;       (sdl:with-events ()
 157 ;;         (:quit-event () t)
 158 ;;         (:key-down-event (:key key)
 159 ;;                          (cond
 160 ;;                            ((sdl:key= key :SDL-KEY-ESCAPE)
 161 ;;                             (sdl:push-quit-event))))
 162 ;;         (:idle
 163 ;;          (progn
 164 ;;            (sdl:clear-display (sdl:color :r 64 :g 64 :b 46));; :update-p nil)
 165
 166
 167 ;;            (draw my-anim)
 168
 169 ;;            (sdl:update-display)
 170 ;;       ))))))