1 ;;; Copyright 2009 Christoph Senjak
3 (in-package :uxul-world)
5 (defparameter *cfont* nil)
7 (defun run-testing-room ()
8 (start-game :room-function #'make-testing-room))
10 (defun run-room (item-list)
11 (start-game :room-function
12 #'(lambda () (create-room-from-item-list item-list))))
14 (defun start-game (&key (music nil)
15 (room-function #'make-additional-testing-room)
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"
26 :flags (logior sdl:sdl-hw-accel sdl:sdl-hw-surface)
27 :flags (logior sdl:sdl-hw-surface) #| sdl:sdl-fullscreen )|#
29 ;;(if music (sdl-mixer:OPEN-AUDIO :frequency 44100))
30 (let ((*graphics-table* (make-hash-table :test #'equal)))
32 (setf (sdl:frame-rate) 15)
33 (setf (sdl:frame-rate) 30))
35 (setf *current-room* (funcall room-function))
37 (sdl:clear-display (sdl:color :r 0 :g 0 :b 0));; :update-p nil)
39 ;;(if music (sdl-mixer:play-sample levelmusic))
44 (progn (sdl-mixer:halt-music)
45 (sdl-mixer:halt-sample :channel t)
46 (sdl-mixer:free levelmusic)
47 (sdl-mixer:close-audio))
50 (:key-down-event (:key key)
52 ((sdl:key= key :SDL-KEY-ESCAPE)
53 (sdl:push-quit-event))
54 ((sdl:key= key :SDL-KEY-O)
56 (max -3 (1- *zoom-ash*))))
57 ((sdl:key= key :SDL-KEY-I)
59 (min 0 (1+ *zoom-ash*))))
61 (on-key-down *current-room* key))))
62 (:key-up-event (:key key)
63 (on-key-up *current-room* key))
66 (invoke *current-room*)
68 (invoke *current-room*))
69 (sdl:clear-display (sdl:color :r 128 :g 128 :b 128)); :update-p nil)
77 (defun preview-animation (frameskip &rest images)
79 (sdl:with-init (sdl:sdl-init-video sdl:sdl-init-audio)
80 (sdl:window +screen-width+ +screen-height+
81 :title-caption "Uxul World"
82 :icon-caption "Uxul World"
83 :flags (logior sdl:sdl-hw-accel)
84 #| :flags (logior sdl:sdl-hw-surface sdl:sdl-fullscreen )|# )
85 (let ((*graphics-table*
86 #-ecl (trivial-garbage:make-weak-hash-table
89 #+ecl (make-hash-table :test #'equal)
91 (my-anim (apply #'make-animation frameskip images))
94 (setf (sdl:frame-rate) 30)
95 (sdl:clear-display (sdl:color :r 64 :g 64 :b 46));; :update-p nil)
99 (:key-down-event (:key key)
101 ((sdl:key= key :SDL-KEY-ESCAPE)
102 (sdl:push-quit-event))))
105 (sdl:clear-display (sdl:color :r 64 :g 64 :b 46));; :update-p nil)