testing-room.lisp

   1 ;;; Copyright 2009-2011 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 'key
  43                                :x (* 128 56)
  44                                :y (* 128 8)
  45                                :dungeon :testing-room
  46                                :visible t
  47                                :redraw t) ret)
  48
  49
  50     (add-object (make-instance 'burning-marshmallow
  51                                :x (* 128 60)
  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 45)
  60                                :y (* 128 8)
  61                                :inner-rectangle (list (* 40 128) (* 5 128) (* 65 128) (* 9 128))
  62                                :active t
  63                                :visible t
  64                                :redraw t) ret)
  65
  66     (add-object (make-instance 'burning-marshmallow
  67                                :x (* 128 34)
  68                                :y (* 128 4)
  69                                :inner-rectangle (list (* 30 128) (* 5 128) (* 41 128) (* 9 128))
  70                                :active t
  71                                :visible t
  72                                :redraw t) ret)
  73
  74     (add-object (make-instance 'simple-enemy
  75                                  :y (* 128 8)
  76                                  :x (* 128 4)
  77                                  :redraw t
  78                                  :active t
  79                                  :visible t) ret)
  80     (add-object (make-instance 'simple-enemy
  81                                  :y (* 128 8)
  82                                  :x (* 128 9)
  83                                  :redraw t
  84                                  :active t
  85                                  :visible t) ret)
  86     (add-object (make-instance 'simple-enemy
  87                                  :y (* 128 8)
  88                                  :x (* 128 15)
  89                                  :redraw t
  90                                  :active t
  91                                  :visible t) ret)
  92     (add-object (make-instance 'simple-enemy
  93                                  :y (* 128 3)
  94                                  :x (* 128 16)
  95                                  :redraw t
  96                                  :active t
  97                                  :visible t) ret)
  98     (add-object (make-instance 'simple-enemy
  99                                  :y (* 128 7)
 100                                  :x (* 128 20)
 101                                  :redraw t
 102                                  :active t
 103                                  :visible t) ret)
 104     (add-object (make-instance 'simple-enemy
 105                                  :y (* 128 6)
 106                                  :x (* 128 21)
 107                                  :redraw t
 108                                  :active t
 109                                  :visible t) ret)
 110     (add-object (make-instance 'simple-enemy
 111                                  :y (* 128 8)
 112                                  :x (* 128 34)
 113                                  :redraw t
 114                                  :active t
 115                                  :visible t) ret)
 116
 117     (dotimes (i 155)
 118       (add-object
 119        (make-instance 'stone
 120                       :y (* 128 9)
 121                       :x (* 128 i)
 122                       :active nil
 123                       :visible t
 124                       :redraw t) ret))
 125
 126     (add-object
 127      (make-instance 'stone
 128                     :y (* 128 4)
 129                     :x (* 128 14)
 130                     :active nil
 131                     :visible t
 132                     :redraw t
 133 ) ret)
 134     (add-object
 135      (make-instance 'stone
 136                     :y (* 128 4)
 137                     :x (* 128 15)
 138                     :active nil
 139                     :visible t
 140                     :redraw t
 141 ) ret)
 142
 143     (dotimes (i 7)
 144       (add-object (make-instance 'stone
 145                                  :x (* 17 128)
 146                                  :y (* i 128)
 147                                  :active nil
 148                                  :visible t
 149                                  :redraw t
 150 ) ret))
 151     (dotimes (i 4)
 152       (add-object (make-instance 'leaf
 153                                  :x (* (+ 18 i) 128)
 154                                  :y (* 7 128)) ret))
 155     (dotimes (i 4)
 156       (add-object (make-instance 'leaf
 157                                  :x (* (+ 19 i) 128)
 158                                  :y (* 6 128)) ret))
 159
 160     (add-object (make-instance 'leaf
 161                                  :x (* 21 128)
 162                                  :y (* 4 128)) ret)
 163
 164     (dotimes (i 4)
 165       (dotimes (j 6)
 166         (add-object (make-instance 'stone
 167                                    :x (* (+ 23 i) 128)
 168                                    :y (* (+ 3 j) 128)
 169                                    :active nil
 170                                    :visible t
 171                                    :redraw t) ret)))
 172
 173     (add-object (make-instance 'stone
 174                                    :x (* 37 128)
 175                                    :y (* 8 128)
 176                                    :active nil
 177                                    :visible t
 178                                    :redraw t) ret)
 179     (add-object (make-instance 'stone
 180                                    :x (* 39 128)
 181                                    :y (* 8 128)
 182                                    :active nil
 183                                    :visible t
 184                                    :redraw t) ret)
 185     (add-object (make-instance 'stone
 186                                    :x (* 39 128)
 187                                    :y (* 7 128)
 188                                    :active nil
 189                                    :visible t
 190                                    :redraw t) ret)
 191     (add-object (make-instance 'stone
 192                                    :x (* 40 128)
 193                                    :y (* 8 128)
 194                                    :active nil
 195                                    :visible t
 196                                    :redraw t) ret)
 197     (add-object (make-instance 'stone
 198                                    :x (* 41 128)
 199                                    :y (* 8 128)
 200                                    :active nil
 201                                    :visible t
 202                                    :redraw t) ret)
 203     (add-object (make-instance 'stone
 204                                    :x (* 41 128)
 205                                    :y (* 7 128)
 206                                    :active nil
 207                                    :visible t
 208                                    :redraw t) ret)
 209     (add-object (make-instance 'stone
 210                                    :x (* 41 128)
 211                                    :y (* 6 128)
 212                                    :active nil
 213                                    :visible t
 214                                    :redraw t) ret)
 215
 216     (dotimes (i 16)
 217       (add-object (make-instance 'stone
 218                                  :x (* (+ i 44) 128)
 219                                  :y (* 4 128)
 220                                  :active nil
 221                                  :visible t
 222                                  :redraw t
 223 ) ret))
 224
 225     (dotimes (i 5)
 226       (dotimes (j (1+ i))
 227         (add-object (make-instance 'stone
 228                                  :x (* (+ i 65) 128)
 229                                  :y (* (+ (- 4 i) j 4) 128)
 230                                  :active nil
 231                                  :visible t
 232                                  :redraw t
 233 ) ret)))
 234
 235     (dotimes (i 3)
 236       (dotimes (j 3)
 237         (add-object (make-instance 'stone
 238                                  :x (* (+ i 70) 128)
 239                                  :y (* (+ j 3) 128)
 240                                  :active nil
 241                                  :visible t
 242                                  :redraw t
 243 ) ret)))
 244
 245     (dotimes (j 2)
 246       (dotimes (i 8)
 247         (add-object (make-instance 'stone
 248                                  :x (* (+ i j 72) 128)
 249                                  :y (* (- 8 i) 128)
 250                                  :active nil
 251                                  :visible t
 252                                  :redraw t
 253 ) ret)))
 254     (dotimes (j 7)
 255       (dolist (i (cond
 256                    ((member j '(0 1 2)) '(83))
 257                    ((member j '(3 4 5)) '(83 84 85 86))
 258                    (T '(79 80 81 82 83 84 85 86))))
 259         (add-object (make-instance 'stone
 260                                    :x (* i 128)
 261                                    :y (* j 128)
 262                                    :active nil
 263                                    :visible t
 264                                    :redraw t
 265 ) ret)))
 266
 267     (let ((y (* 128 4)))
 268       (dolist (j '((0 0 0 0 0 1 1 1 2)
 269                    (0 0 0 1 1 1 0 0 2)
 270                    (0 0 0 0 1 1 1 1 2)
 271                    (1 1 1 1 1 0 0 0 2)
 272                    (0 0 0 1 1 1 1 1 2)))
 273         (let ((x (* 128 87)))
 274           (dolist (i j)
 275             (cond ((eql i 2)
 276                    (add-object (make-instance 'stone
 277                                               :x x
 278                                               :y y
 279                                               :active nil
 280                                               :visible t
 281                                               :redraw t
 282 ) ret))
 283                   ((eql i 1)
 284                  (add-object (make-instance 'leaf
 285                                             :x x
 286                                             :y y) ret))
 287                   (T))
 288             (incf x 128)))
 289         (incf y 128)))
 290     (add-object (make-instance 'flying-nasobem
 291                                :x (* 128 87)
 292                                :y (* 128 2)) ret)
 293     ;;*******************************
 294     (add-object (make-instance 'door
 295                                :x (* 128 87)
 296                                :y (* 128 1)
 297                                :dungeon :testing-room
 298                                :visible t
 299                                :redraw t) ret)
 300     (add-object (make-instance 'door
 301                                :x (* 128 89)
 302                                :y (* 128 1)
 303                                :dungeon :testing-room
 304                                :visible t
 305                                :redraw t) ret)
 306
 307     (add-object (make-instance 'flying-nasobem
 308                                :x (* 128 110)
 309                                :y (* 128 4)) ret)
 310     ret))