game.lisp

   1 ;;; Copyright 2009 Christoph Senjak
   2
   3 (in-package :uxul-world)
   4
   5 (defparameter *cfont* nil)
   6
   7 (defun run-testing-room ()
   8   (start-game :room-function #'make-testing-room))
   9
  10 (defun run-room (item-list)
  11   (start-game :room-function
  12               #'(lambda () (create-room-from-item-list item-list))))
  13
  14 (defun start-game (&key (music nil) room-function (15-fps nil))
  15   "Start the Game: Call room-function for getting the room-object to
  16 run. Music is ignored so far. 15-fps makes only every second frame be
  17 drawn (for very slow computers)"
  18      (sdl:with-init (sdl:sdl-init-video sdl:sdl-init-audio)
  19        (sdl:window +screen-width+ +screen-height+
  20                    :title-caption "Uxul World"
  21                    :icon-caption "Uxul World"
  22                    :flags (logior sdl:sdl-hw-accel  sdl:sdl-hw-surface)
  23                    ;:flags (logior sdl:sdl-hw-surface) #| sdl:sdl-fullscreen )|#
  24 )
  25        ;;(if music (sdl-mixer:OPEN-AUDIO :frequency 44100))
  26        (let ((*graphics-table* (make-hash-table :test #'equal)))
  27          (if 15-fps
  28              (setf (sdl:frame-rate) 15)
  29              (setf (sdl:frame-rate) 30))
  30
  31          (setf *current-room* (funcall room-function))
  32
  33          (sdl:clear-display (sdl:color :r 0 :g 0 :b 0));; :update-p nil)
  34
  35          ;;(if music (sdl-mixer:play-sample levelmusic))
  36
  37          (sdl:with-events ()
  38            (:quit-event ()
  39                         #|(if music
  40                         (progn (sdl-mixer:halt-music)
  41                         (sdl-mixer:halt-sample :channel t)
  42                         (sdl-mixer:free levelmusic)
  43                         (sdl-mixer:close-audio))
  44                         t
  45                         )|# t)
  46            (:key-down-event (:key key)
  47                             (cond
  48                               ((sdl:key= key :SDL-KEY-ESCAPE)
  49                                (sdl:push-quit-event))
  50                               (T
  51                                (on-key-down *current-room* key))))
  52            (:key-up-event (:key key)
  53                           (on-key-up *current-room* key))
  54            (:idle
  55             (progn
  56               (invoke *current-room*)
  57               (when 15-fps
  58                 (invoke *current-room*))
  59               (sdl:clear-display (sdl:color :r 128 :g 128 :b 128)); :update-p nil)
  60               (draw *current-room*)
  61               (sdl:update-display)
  62          ))))))
  63
  64
  65 ;; For Debugging
  66
  67 (defun preview-animation (frameskip &rest images)
  68
  69      (sdl:with-init (sdl:sdl-init-video sdl:sdl-init-audio)
  70        (sdl:window +screen-width+ +screen-height+
  71                    :title-caption "Uxul World"
  72                    :icon-caption "Uxul World"
  73                    :flags (logior sdl:sdl-hw-accel)
  74                    #| :flags (logior sdl:sdl-hw-surface sdl:sdl-fullscreen )|#  )
  75        (let ((*graphics-table*
  76               #-ecl (trivial-garbage:make-weak-hash-table
  77                      :weakness :value
  78                      :test #'equal)
  79               #+ecl (make-hash-table :test #'equal)
  80               )
  81              (my-anim (apply #'make-animation frameskip images))
  82              )
  83
  84          (setf (sdl:frame-rate) 30)
  85          (sdl:clear-display (sdl:color :r 64 :g 64 :b 46));; :update-p nil)
  86
  87          (sdl:with-events ()
  88            (:quit-event () t)
  89            (:key-down-event (:key key)
  90                             (cond
  91                               ((sdl:key= key :SDL-KEY-ESCAPE)
  92                                (sdl:push-quit-event))))
  93            (:idle
  94             (progn
  95               (sdl:clear-display (sdl:color :r 64 :g 64 :b 46));; :update-p nil)
  96
  97
  98               (draw my-anim)
  99
 100               (sdl:update-display)
 101          ))))))