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