testing-room.lisp

   1 ;;; Copyright 2009 Christoph Senjak
   2
   3 (in-package :uxul-world)
   4
   5
   6 #|
   7 (defmethod (setf x) (new-value (obj T)))
   8 (defmethod (setf y) (new-value (obj T)))
   9 (defmethod (setf visible) (new-value (obj T)))
  10 |#
  11
  12 (defun make-testing-room ()
  13   "Create a simple room for testing. Shouldnt be used anymore. Use the
  14 level-editor instead!"
  15   (let* ((player (make-instance 'player
  16                                 :active t
  17                                 :visible t
  18                                 :redraw t
  19                                 :x 100
  20                                 :y 0))
  21          (ret (make-instance 'room
  22                              :width 0;(* 155 128)
  23                              :height 0;(* 9 128)
  24                              :key-listener player
  25                              :graphic-centralizer player
  26                              :key-up-function
  27                              #'(lambda (key) (on-key-up player key))
  28                              :key-down-function
  29                              #'(lambda (key) (on-key-down player key))
  30                              )))
  31     (add-object player ret)
  32
  33     (add-object (make-instance 'burning-marshmallow
  34                                :x (* 128 55)
  35                                :y (* 128 8)
  36                                :inner-rectangle (list (* 40 128) (* 5 128) (* 65 128) (* 9 128))
  37                                :active t
  38                                :visible t
  39                                :redraw t) ret)
  40
  41
  42     (add-object (make-instance 'burning-marshmallow
  43                                :x (* 128 60)
  44                                :y (* 128 8)
  45                                :inner-rectangle (list (* 40 128) (* 5 128) (* 65 128) (* 9 128))
  46                                :active t
  47                                :visible t
  48                                :redraw t) ret)
  49
  50     (add-object (make-instance 'burning-marshmallow
  51                                :x (* 128 45)
  52                                :y (* 128 8)
  53                                :inner-rectangle (list (* 40 128) (* 5 128) (* 65 128) (* 9 128))
  54                                :active t
  55                                :visible t
  56                                :redraw t) ret)
  57
  58     (add-object (make-instance 'burning-marshmallow
  59                                :x (* 128 34)
  60                                :y (* 128 4)
  61                                :inner-rectangle (list (* 30 128) (* 5 128) (* 41 128) (* 9 128))
  62                                :active t
  63                                :visible t
  64                                :redraw t) ret)
  65
  66     (add-object (make-instance 'simple-enemy
  67                                  :y (* 128 8)
  68                                  :x (* 128 4)
  69                                  :redraw t
  70                                  :active t
  71                                  :visible t) ret)
  72     (add-object (make-instance 'simple-enemy
  73                                  :y (* 128 8)
  74                                  :x (* 128 9)
  75                                  :redraw t
  76                                  :active t
  77                                  :visible t) ret)
  78     (add-object (make-instance 'simple-enemy
  79                                  :y (* 128 8)
  80                                  :x (* 128 15)
  81                                  :redraw t
  82                                  :active t
  83                                  :visible t) ret)
  84     (add-object (make-instance 'simple-enemy
  85                                  :y (* 128 3)
  86                                  :x (* 128 16)
  87                                  :redraw t
  88                                  :active t
  89                                  :visible t) ret)
  90     (add-object (make-instance 'simple-enemy
  91                                  :y (* 128 7)
  92                                  :x (* 128 20)
  93                                  :redraw t
  94                                  :active t
  95                                  :visible t) ret)
  96     (add-object (make-instance 'simple-enemy
  97                                  :y (* 128 6)
  98                                  :x (* 128 21)
  99                                  :redraw t
 100                                  :active t
 101                                  :visible t) ret)
 102     (add-object (make-instance 'simple-enemy
 103                                  :y (* 128 8)
 104                                  :x (* 128 34)
 105                                  :redraw t
 106                                  :active t
 107                                  :visible t) ret)
 108
 109     (dotimes (i 155)
 110       (add-object
 111        (make-instance 'stone
 112                       :y (* 128 9)
 113                       :x (* 128 i)
 114                       :active nil
 115                       :visible t
 116                       :redraw t) ret))
 117
 118     (add-object
 119      (make-instance 'stone
 120                     :y (* 128 4)
 121                     :x (* 128 14)
 122                     :active nil
 123                     :visible t
 124                     :redraw t
 125 ) ret)
 126     (add-object
 127      (make-instance 'stone
 128                     :y (* 128 4)
 129                     :x (* 128 15)
 130                     :active nil
 131                     :visible t
 132                     :redraw t
 133 ) ret)
 134
 135     (dotimes (i 7)
 136       (add-object (make-instance 'stone
 137                                  :x (* 17 128)
 138                                  :y (* i 128)
 139                                  :active nil
 140                                  :visible t
 141                                  :redraw t
 142 ) ret))
 143     (dotimes (i 4)
 144       (add-object (make-instance 'leaf
 145                                  :x (* (+ 18 i) 128)
 146                                  :y (* 7 128)) ret))
 147     (dotimes (i 4)
 148       (add-object (make-instance 'leaf
 149                                  :x (* (+ 19 i) 128)
 150                                  :y (* 6 128)) ret))
 151
 152     (add-object (make-instance 'leaf
 153                                  :x (* 21 128)
 154                                  :y (* 4 128)) ret)
 155
 156     (dotimes (i 4)
 157       (dotimes (j 6)
 158         (add-object (make-instance 'stone
 159                                    :x (* (+ 23 i) 128)
 160                                    :y (* (+ 3 j) 128)
 161                                    :active nil
 162                                    :visible t
 163                                    :redraw t) ret)))
 164
 165     (add-object (make-instance 'stone
 166                                    :x (* 37 128)
 167                                    :y (* 8 128)
 168                                    :active nil
 169                                    :visible t
 170                                    :redraw t) ret)
 171     (add-object (make-instance 'stone
 172                                    :x (* 39 128)
 173                                    :y (* 8 128)
 174                                    :active nil
 175                                    :visible t
 176                                    :redraw t) ret)
 177     (add-object (make-instance 'stone
 178                                    :x (* 39 128)
 179                                    :y (* 7 128)
 180                                    :active nil
 181                                    :visible t
 182                                    :redraw t) ret)
 183     (add-object (make-instance 'stone
 184                                    :x (* 40 128)
 185                                    :y (* 8 128)
 186                                    :active nil
 187                                    :visible t
 188                                    :redraw t) ret)
 189     (add-object (make-instance 'stone
 190                                    :x (* 41 128)
 191                                    :y (* 8 128)
 192                                    :active nil
 193                                    :visible t
 194                                    :redraw t) ret)
 195     (add-object (make-instance 'stone
 196                                    :x (* 41 128)
 197                                    :y (* 7 128)
 198                                    :active nil
 199                                    :visible t
 200                                    :redraw t) ret)
 201     (add-object (make-instance 'stone
 202                                    :x (* 41 128)
 203                                    :y (* 6 128)
 204                                    :active nil
 205                                    :visible t
 206                                    :redraw t) ret)
 207
 208     (dotimes (i 16)
 209       (add-object (make-instance 'stone
 210                                  :x (* (+ i 44) 128)
 211                                  :y (* 4 128)
 212                                  :active nil
 213                                  :visible t
 214                                  :redraw t
 215 ) ret))
 216
 217     (dotimes (i 5)
 218       (dotimes (j (1+ i))
 219         (add-object (make-instance 'stone
 220                                  :x (* (+ i 65) 128)
 221                                  :y (* (+ (- 4 i) j 4) 128)
 222                                  :active nil
 223                                  :visible t
 224                                  :redraw t
 225 ) ret)))
 226
 227     (dotimes (i 3)
 228       (dotimes (j 3)
 229         (add-object (make-instance 'stone
 230                                  :x (* (+ i 70) 128)
 231                                  :y (* (+ j 3) 128)
 232                                  :active nil
 233                                  :visible t
 234                                  :redraw t
 235 ) ret)))
 236
 237     (dotimes (j 2)
 238       (dotimes (i 8)
 239         (add-object (make-instance 'stone
 240                                  :x (* (+ i j 72) 128)
 241                                  :y (* (- 8 i) 128)
 242                                  :active nil
 243                                  :visible t
 244                                  :redraw t
 245 ) ret)))
 246     (dotimes (j 7)
 247       (dolist (i (cond
 248                    ((member j '(0 1 2)) '(83))
 249                    ((member j '(3 4 5)) '(83 84 85 86))
 250                    (T '(79 80 81 82 83 84 85 86))))
 251         (add-object (make-instance 'stone
 252                                    :x (* i 128)
 253                                    :y (* j 128)
 254                                    :active nil
 255                                    :visible t
 256                                    :redraw t
 257 ) ret)))
 258
 259     (let ((y (* 128 4)))
 260       (dolist (j '((0 0 0 0 0 1 1 1 2)
 261                    (0 0 0 1 1 1 0 0 2)
 262                    (0 0 0 0 1 1 1 1 2)
 263                    (1 1 1 1 1 0 0 0 2)
 264                    (0 0 0 1 1 1 1 1 2)))
 265         (let ((x (* 128 87)))
 266           (dolist (i j)
 267             (cond ((eql i 2)
 268                    (add-object (make-instance 'stone
 269                                               :x x
 270                                               :y y
 271                                               :active nil
 272                                               :visible t
 273                                               :redraw t
 274 ) ret))
 275                   ((eql i 1)
 276                  (add-object (make-instance 'leaf
 277                                             :x x
 278                                             :y y) ret))
 279                   (T))
 280             (incf x 128)))
 281         (incf y 128)))
 282     (add-object (make-instance 'flying-nasobem
 283                                :x (* 128 87)
 284                                :y (* 128 2)) ret)
 285     (add-object (make-instance 'flying-nasobem
 286                                :x (* 128 110)
 287                                :y (* 128 4)) ret)
 288     ret))