game.lisp

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