functions.lisp

   1 ;;; Copyright 2009-2011 Christoph Senjak
   2
   3 (in-package :uxul-world)
   4
   5 (declaim (optimize (speed 3))
   6          (inline rectangles-overlap is-horizontal is-vertical turn90
   7                  turn270))
   8
   9 (defun rectangles-overlap (x1 y1 x2 y2 x3 y3 x4 y4)
  10   "Does the rectangle with diagonal points (x1,y1) and (x2, y2)
  11 overlap with (x3, y3),(x4,y4)? Assuming x1<x2, x3<x4, y same. We dont
  12 add the limits to the rectangle, we only see the interior points."
  13   (and
  14     (> x2 x3)
  15     (> x4 x1)
  16     (> y2 y3)
  17     (> y4 y1)))
  18
  19
  20 (defun symbol-prename (symbol &optional (charnum 1))
  21   "Returns just the first <charnum> Characters of the name of that symbol"
  22   (subseq (symbol-name symbol) 0 charnum))
  23
  24 (defun symbol-index (symbol &optional (charnum 1))
  25   "Removes the first (or charnum) character(s) of a Symbol and parses
  26 the rest into an integer, i.e. makes 1 out of :R1"
  27   (parse-integer (subseq (symbol-name symbol) charnum)))
  28
  29 (defun is-horizontal (direction)
  30   (or (eq direction :LEFT) (eq direction :RIGHT)))
  31
  32 (defun is-vertical (direction)
  33   (or (eq direction :UP) (eq direction :DOWN)))
  34
  35 (defun turn90 (direction)
  36   (cond
  37     ((eq direction :LEFT) :UP)
  38     ((eq direction :RIGHT) :DOWN)
  39     ((eq direction :UP) :RIGHT)
  40     ((eq direction :DOWN) :LEFT)))
  41
  42 (defun turn270 (direction)
  43   (cond
  44     ((eq direction :LEFT) :DOWN)
  45     ((eq direction :RIGHT) :UP)
  46     ((eq direction :UP) :LEFT)
  47     ((eq direction :DOWN) :RIGHT)))
  48
  49 (defun string-ends-with (str1 str2)
  50   (let ((length1 (length str1))
  51         (length2 (length str2)))
  52     (and (>= length1 length2)
  53          (string= (subseq str1 (- length1 length2)) str2))))
  54
  55 (defun lower-interval-bound (x1 x2 y1 y2)
  56   "Find the lower interval-bound of [x1, x2] /\ [y1, y2] or - if
  57 disjoint - return NIL."
  58   (let ((xmin (min x1 x2))
  59         (xmax (max x1 x2))
  60         (ymin (min y1 y2))
  61         (ymax (max y1 y2)))
  62     (if (<= xmin ymin xmax) ymin
  63         (if (<= ymin xmin ymax) xmin NIL))))
  64
  65 (defmacro swapsort (a b)
  66   `(if (> ,a ,b)
  67        (rotatef ,a ,b)))
  68
  69 (defun move-collision-rectangle-about-x (moving-object delta-x)
  70   "this function is only a helper for a special case of the method
  71 move-about for collision-objects, which is invoked iff there is no
  72 movement in y-direction AND x is not zero"
  73   (let ((current-time 1)
  74         (current-collision NIL)
  75         (current-standing-object NIL))
  76     (dolist (standing-object (listen-to moving-object))
  77       (when (and (colliding standing-object) (not (eq standing-object moving-object)))
  78         (when (< (* 2 (abs (- (mid-y moving-object) (mid-y standing-object))))
  79                  (+ (height moving-object) (height standing-object)))
  80                                         ;are the y-coordinates near enough such that a collision *can* occur?
  81           (let* ((x-minimal-distance (+ (half-width moving-object) (half-width standing-object)))
  82                  (x-distance (- (mid-x standing-object) (mid-x moving-object)))
  83                  (x-collide-time-1
  84                   (/ (+ x-minimal-distance x-distance) delta-x))
  85                  (x-collide-time-2
  86                   (/ (- x-distance x-minimal-distance) delta-x))
  87                  (x-minimal-collide-time (min x-collide-time-1 x-collide-time-2)))
  88             (when (<= 0 x-minimal-collide-time current-time)
  89                                         ;an earlier collision can only
  90                                         ;occur between 0 and the
  91                                         ;current-time which is <1 and
  92                                         ;maybe was set before.
  93               (setf current-time x-minimal-collide-time)
  94               (setf current-collision
  95                     (make-instance
  96                      'collision
  97                      :desired-movement (make-xy delta-x 0)
  98                      :pos (make-xy (+ (truncate (* current-time delta-x)) (x moving-object)) (y moving-object))
  99                      :collision-time current-time
 100                      :direction (if (> delta-x 0) :right :left)))
 101               (setf current-standing-object standing-object))))))
 102       (if current-collision ;if a collision occured, this must be the first now
 103           (on-collision moving-object current-standing-object current-collision)
 104           (incf (x moving-object) delta-x)))
 105 ;;  (move-collision-rectangle-about-xy moving-object delta-x 0)
 106 )
 107
 108
 109 (defun move-collision-rectangle-about-y (moving-object delta-y)
 110   "this function is only a helper for a special case of the method
 111 move-about for collision-objects, which is invoked iff there is no
 112 movement in y-direction AND x is not zero"
 113   (let ((current-time 1)
 114         (current-collision NIL)
 115         (current-standing-object NIL))
 116     (dolist (standing-object (listen-to moving-object))
 117       (when (and (colliding standing-object) (not (eq standing-object moving-object)))
 118         (when (< (abs (* 2 (- (mid-x moving-object) (mid-x standing-object))))
 119                  (+ (width moving-object) (width standing-object)))
 120                                         ;are the y-coordinates near enough such that a collision *can* occur?
 121           (let* ((y-minimal-distance (+ (half-height moving-object) (half-height standing-object)))
 122                  (y-distance (- (mid-y standing-object) (mid-y moving-object)))
 123                  (y-collide-time-1
 124                   (/ (+ y-minimal-distance y-distance) delta-y))
 125                  (y-collide-time-2
 126                   (/ (- y-distance y-minimal-distance) delta-y))
 127                  (y-minimal-collide-time (min y-collide-time-1 y-collide-time-2)))
 128             (when (<= 0 y-minimal-collide-time current-time)
 129                                         ;an earlier collision can only occur between 0 and the current-time
 130                                         ;which is <1 and maybe was set before.
 131               (setf current-time y-minimal-collide-time)
 132               (setf current-collision
 133                     (make-instance
 134                      'collision
 135                      :desired-movement (make-xy 0 delta-y)
 136                      :pos (make-xy (x moving-object) (+ (truncate (* current-time delta-y)) (y moving-object)))
 137                      :collision-time current-time
 138                      :direction (if (> delta-y 0) :down :up)))
 139               (setf current-standing-object standing-object))))))
 140       (if current-collision ;if a collision occured, this must be the first now
 141           (on-collision moving-object current-standing-object current-collision)
 142           (incf (mid-y moving-object) delta-y)))
 143 ;;  (move-collision-rectangle-about-xy moving-object 0 delta-y)
 144 )
 145
 146
 147 ;; Temporarily
 148
 149 (defun rational-= (n1 d1 n2 d2)
 150   (= (* n1 d2) (* n2 d1)))
 151
 152 #|(defun rational-< (n1 d1 n2 d2 &rest args)
 153   "Compare rationals even if the denominators are zero. Behaviour for
 154 0/0 is not specified and may change."
 155   (and (if (zerop d1)
 156            (if (zerop d2)
 157                (< (signum n1) (signum n2))
 158                (< n1 0))
 159            (< (* n1 (abs d2) (signum d1)) (* n2 (abs d1) (signum d2))))
 160        (or (not args)
 161            (apply #'rational-< n2 d2 args))))|#
 162
 163
 164 #|(defun rational-<= (n1 d1 n2 d2 &rest args)
 165   "Compare rationals even if the denominators are zero. Behaviour for
 166 0/0 is not specified and may change."
 167   (and (if (zerop d1)
 168            (if (zerop d2)
 169                (<= (signum n1) (signum n2))
 170                (< n1 0))
 171            (<= (* n1 (abs d2) (signum d1)) (* n2 (abs d1) (signum d2))))
 172        (or (not args)
 173            (apply #'rational-<= n2 d2 args))))|#
 174
 175 (defun rational-<= (n1 d1 n2 d2 &rest args)
 176   (and
 177    (<= (* n1 (abs d2) (signum d1)) (* n2 (abs d1) (signum d2)))
 178    (or
 179     (not args)
 180     (apply #'rational-<= n2 d2 args))))
 181
 182 (defun rational-< (n1 d1 n2 d2 &rest args)
 183   (and
 184    (< (* n1 (abs d2) (signum d1)) (* n2 (abs d1) (signum d2)))
 185    (or
 186     (not args)
 187     (apply #'rational-< n2 d2 args))))
 188
 189 (defun rational-> (n1 d1 n2 d2 &rest args)
 190   (and (rational-< n2 d2 n1 d1)
 191        (or (not args)
 192            (apply #'rational-> n2 d2 args))))
 193
 194 (defun rational->= (n1 d1 n2 d2 &rest args)
 195   (and (rational-<= n2 d2 n1 d1)
 196        (or (not args)
 197            (apply #'rational->= n2 d2 args))))
 198
 199 #|FIIIIIIIIXMEEEEEEEEEEE!!!!!!!!!1111111!!!!!!!!!111
 200
 201 (defun move-collision-rectangle-about-xy (moving-object x y)
 202   "GIANT ugly but faster implementation than before..."
 203   (declare (type fixnum x y)
 204            (type game-object moving-object))
 205   (let* ((current-time-num 1)
 206          (current-time-denom 1)
 207          (collision-with-x nil)
 208          (collision-with-y nil)
 209          (current-standing-object nil)
 210          (wm (width moving-object))
 211          (hm (height moving-object))
 212          (x1 (x moving-object))
 213          (y1 (y moving-object))
 214          (x2 (+ x1 wm))
 215          (y2 (+ y1 hm)))
 216     (declare (type fixnum current-time-num current-time-denom wm x1
 217                            y1 x2 y2)
 218              (type boolean collision-with-x collision-with-y))
 219     (dolist (standing-object (listen-to moving-object))
 220       (let* ((ws (width standing-object))
 221              (hs (height standing-object))
 222              (x3 (x standing-object))
 223              (y3 (y standing-object))
 224              (x4 (+ x3 ws))
 225              (y4 (+ y3 hs))
 226              (y-enter (- (sgn y))) ;; gain negative infty for y-enter/0
 227              (y-leave y)
 228              (x-enter (- (sgn x))) ;; gain negative infty for x-enter/0
 229              (x-leave x))
 230         (declare (type fixnum ws hs x3 y3 x4 y4 y-enter y-leave
 231                        x-enter x-leave))
 232         (and
 233          ;; is the object colliding? does the standing object overlap a (huge enough)
 234          ;; rectangle around the moving object?
 235
 236          (colliding standing-object)
 237 #|       (rectangles-overlap (- x1 absx)
 238                              (- y1 absy)
 239                              (+ x2 absx 1)
 240                              (+ y2 absy 1)
 241                              x3 y3 (1+ x4) (1+ y4))|#
 242          (cond
 243            ((> x2 x3)
 244             (cond
 245               ((> x4 x1)
 246                ;;x-enter = -1
 247 ;;             (format t "x-inside")
 248                (macrolet ((calc-x ()
 249                             `(progn
 250                                (if (> x 0)
 251                                    (setf x-leave (- x4 x1))
 252                                    (setf x-leave (- x3 x2))))))
 253                  (cond
 254                    ((> y2 y3)
 255                     (cond
 256                       ((> y4 y1)
 257                        ;; rectangles do overlap before movement ... do
 258                        ;; nothing.
 259                        nil)
 260                       (T ; y4 <= y1
 261                        ;; standing-object is over moving-object
 262                        (cond
 263                          ((>= y 0)
 264                           ;; no collision - wrong direction, or no
 265                           ;; movement at all.
 266                           nil)
 267                          (T
 268                           ;; collision may occur
 269                           (setf y-enter (- y1 y4))
 270                           (setf y-leave (- y3 y2))
 271                           (calc-x)
 272                           T)))))
 273                    (T ; y2 <= y3
 274                     ;; standing-object is below moving-object
 275                     (cond
 276                       ((<= y 0)
 277                        ;; no collision - wrong direction, or no movement
 278                        ;; at all.
 279                        nil)
 280                       (T
 281                        ;; collision may occur
 282                        (setf y-enter (- y3 y2))
 283                        (setf y-leave (- y4 y1))
 284                        (calc-x)
 285                        T))))))
 286               (T ; x4 <= x1
 287                ;; standing-rectangle left of moving-rectangle
 288                (macrolet ((calc-x ()
 289                             ;; x will be <= 0
 290                             `(progn (setf x-enter (- x3 x2))
 291                                     (setf x-leave (- x4 x1)))))
 292                  (cond
 293                    ((> x 0)
 294                     ;; no collision - wrong direction, or no movement at
 295                     ;; all.
 296                     nil)
 297                    (T
 298                     ;; collision may occur - check y
 299                     (cond
 300                       ((> y2 y3)
 301                        (cond
 302                          ((> y4 y1)
 303                           ;; y-enter = 0
 304                           (setf y-leave (if (> y 0) (- y2 y3) (- y1 y4)))
 305                           (calc-x)
 306                           T)
 307                          (T ; y4 <= y1
 308                           ;; standing-object is over moving-object
 309                           (cond
 310                             ((>= y 0)
 311                              ;; no collision - wrong direction, or no
 312                              ;; movement at all.
 313                              nil)
 314                             (T
 315                              ;; collision may occur
 316                              (setf y-enter (- y4 y1))
 317                              (setf y-leave (- y3 y2))
 318                              (calc-x)
 319                              T)))))
 320                       (T ; y2 < y3
 321                        ;; standing-object is below moving-object
 322                        (cond
 323                          ((<= y 0)
 324                           ;; no collision - wrong direction, or no movement
 325                           ;; at all.
 326                           nil)
 327                          (T
 328                           ;; collision may occur
 329                           (setf y-enter (- y3 y2))
 330                           (setf y-leave (- y4 y1))
 331                           (calc-x)
 332                           T))))))))))
 333            (T ; x2 <= x3
 334             ;; standing-rectangle right of moving-rectangle
 335             (macrolet ((calc-x ()
 336                          ;; will be x > 0
 337                          '(progn
 338                            (setf x-leave (- x2 x3))
 339                            (setf x-enter (- x1 x4)))))
 340             (cond
 341               ((<= x 0)
 342                ;; no collision - wrong direction, or no movement at
 343                ;; all.
 344                nil)
 345               (T
 346                ;; collision may occur - check y
 347                (cond
 348                  ((> y2 y3)
 349                   (cond
 350                     ((> y4 y1)
 351                      ;; y-bounds of standing-object lie completely
 352                      ;; inside y-bounds of moving-object.
 353                      (setf y-leave (if (> y 0) (- y1 y4) (- y2 y3)))
 354                      (calc-x)
 355                      T)
 356                     (T ; y4 < y1
 357                      ;; standing-object is over moving-object
 358                      (cond
 359                           ((>= y 0)
 360                            ;; no collision - wrong direction, or no
 361                            ;; movement at all.
 362                            nil)
 363                           (T
 364                            ;; collision may occur
 365                            (setf y-enter (- y1 y4))
 366                            (setf y-leave (- y3 y2))
 367                            (calc-x)
 368                            T)))))
 369                  (T ; y2 < y3
 370                   ;; standing-object is below moving-object
 371                   (cond
 372                     ((<= y 0)
 373                      ;; no collision - wrong direction, or no movement
 374                      ;; at all.
 375                      nil)
 376                     (T
 377                      ;; collision may occur
 378                      (setf y-enter (- y3 y2))
 379                      (setf y-leave (- y1 y4))
 380                      (calc-x)
 381                      T)))))))))
 382
 383          ;; collision could occure - find the smallest collision-time
 384
 385          (progn (format t "---~%could occure.~%current ~d/~d~%x-enter ~d/~d~%x-leave ~d/~d~%y-enter ~d/~d~%y-leave ~d/~d~%---~%"
 386                         current-time-num current-time-denom
 387                         x-enter x x-leave x y-enter y y-leave y) t)
 388
 389          (cond
 390            ((rational-<= x-enter x y-enter y x-leave x)
 391             ;; first collision-time is y-enter/y - check if this is
 392             ;; smaller (earlier) than current-time-num/current-time-denom
 393             ;; and later than 0
 394             (when (rational-< y-enter y current-time-num current-time-denom)
 395               (setf current-standing-object standing-object)
 396               (setf current-time-denom y)
 397               (setf current-time-num y-enter)
 398               (setf collision-with-y t)
 399               (setf collision-with-x (rational-<= y-enter y y-enter x y-leave y))))
 400            ((rational-<= y-enter y x-enter x y-leave y) ;; first collision-time is x-enter/y
 401             (when (rational-< x-enter x current-time-num current-time-denom)
 402               (setf current-standing-object standing-object)
 403               (setf current-time-denom x)
 404               (setf current-time-num x-enter)
 405               (setf collision-with-x t)
 406               (setf collision-with-y nil)))
 407            (T nil)))))
 408     (cond
 409       (current-standing-object
 410        (format t "occured~d~%" current-time-num)
 411 ;       (write (cons current-time-num current-time-denom))
 412        ;; a collision occured
 413        (on-collision moving-object current-standing-object
 414                      (make-instance 'collision
 415                                     :desired-movement (make-xy x y)
 416                                     :collision-time
 417                                     (the rational (/ current-time-num
 418                                                      current-time-denom))
 419                                     :pos (make-xy
 420                                           (+ (truncate (* current-time-num x) current-time-denom) x1)
 421                                           (+ (truncate (* current-time-num y) current-time-denom) y1))
 422                                     :direction (if collision-with-x
 423                                                    (if collision-with-y
 424                                                        :diagonal
 425                                                        (if (> y 0) :down :up))
 426                                                    (if (> x 0) :right :left)))))
 427       (T
 428        (setf (x moving-object) (+ x1 x))
 429        (setf (y moving-object) (+ y1 y))))))|#
 430
 431
 432
 433
 434 (defun move-collision-rectangle-about-xy (moving-object x y)
 435   "this function is only a helper for a special case of the method
 436 move-about for collision-objects, which is invoked iff both x and y
 437 are not zero"
 438   (declare (optimize (debug 0) (safety 0) (space 0) (compilation-speed 0) (speed 3))
 439            (type fixnum x y)
 440            (type game-object moving-object))
 441   (let ((absx (abs x))
 442         (absy (abs y))
 443               (xm (x moving-object))
 444               (ym (y moving-object))
 445               (wm (width moving-object))
 446               (hm (height moving-object))
 447               (2*current-time-num 2)
 448               (current-time-denom 1)
 449               (current-standing-object NIL)
 450               (current-direction nil))
 451           (declare (type fixnum xm ym wm hm 2*current-time-num
 452                          current-time-denom absx absy)
 453                    (type symbol current-direction)
 454                    )
 455           (let ((2*mid-x-moving (the fixnum (+ xm xm wm)))
 456                 (2*mid-y-moving (the fixnum (+ ym ym hm))))
 457             (declare (type fixnum 2*mid-x-moving 2*mid-y-moving))
 458             (dolist (standing-object (listen-to moving-object))
 459               (when (and
 460
 461              ;;;;;;;;;;;;; BEEEEEEEEEEETTTTTTTTTTEEEEEEEEEEEEEEEEEERRRRRRRRRRRRRRRR!!!!!!!!!!!!!!!!!!
 462
 463                      (colliding standing-object)
 464
 465 #|                   (rectangles-overlap (- xm absx) (- ym absy) (+ xm wm absy) (+ ym hm absx)
 466                                          (- xs absx) (- ys absy) (+ xs ws absx) (+ ys hs absy))
 467
 468                      (not
 469                       (rectangles-overlap xm ym (+ xm wm) (+ ym hm)
 470                                           xs ys (+ xs hs) (+ ys hs)))|#
 471
 472                      (not (eq moving-object standing-object))
 473
 474                      )
 475                 (let* ((xs (x standing-object))
 476                        (ys (y standing-object))
 477                        (ws (width standing-object))
 478                        (hs (height standing-object))
 479                        (temporary-direction nil)
 480                        (2*x-minimal-distance (the fixnum (+ wm ws)))
 481                        (2*y-minimal-distance (the fixnum (+ hm hs)))
 482                        (2*x-distance (the fixnum (- (+ xs xs ws) 2*mid-x-moving)))
 483                        (2*y-distance (the fixnum (- (+ ys ys hs) 2*mid-y-moving)))
 484                        (2*x-collide-time-1 (the fixnum (+ 2*x-minimal-distance 2*x-distance)))
 485                        (2*x-collide-time-2 (the fixnum (- 2*x-distance 2*x-minimal-distance)))
 486                        (2*y-collide-time-1 (the fixnum (+ 2*y-minimal-distance 2*y-distance)))
 487                        (2*y-collide-time-2 (the fixnum (- 2*y-distance 2*y-minimal-distance)))
 488                        (minimal-collide-time-denom 0)
 489                        (2*minimal-collide-time-num
 490                         (progn
 491                           (if (> x 0)
 492                               (if (> 2*x-collide-time-1 2*x-collide-time-2)
 493                                   (rotatef 2*x-collide-time-1 2*x-collide-time-2))
 494                               (if (< 2*x-collide-time-1 2*x-collide-time-2)
 495                                   (rotatef 2*x-collide-time-1 2*x-collide-time-2)))
 496                           (if (> y 0)
 497                               (if (> 2*y-collide-time-1 2*y-collide-time-2)
 498                                   (rotatef 2*y-collide-time-1 2*y-collide-time-2))
 499                               (if (< 2*y-collide-time-1 2*y-collide-time-2)
 500                                   (rotatef 2*y-collide-time-1 2*y-collide-time-2)))
 501                           (cond
 502                             ((rational-<= 2*x-collide-time-1 x 2*y-collide-time-1 y 2*x-collide-time-2 x)
 503                              (setf minimal-collide-time-denom y)
 504                              (setf temporary-direction (if (> y 0) :down :up))
 505                              2*y-collide-time-1)
 506                             ((rational-<= 2*y-collide-time-1 y 2*x-collide-time-1 x 2*y-collide-time-2 y)
 507                              (setf minimal-collide-time-denom x)
 508                              (setf temporary-direction (if (> x 0) :right :left))
 509                              2*x-collide-time-1)
 510                             (T 0)))))
 511                   (declare (type fixnum xs ys ws hs 2*x-minimal-distance
 512                                  2*y-minimal-distance 2*x-distance
 513                                  2*y-distance 2*x-collide-time-1
 514                                  2*x-collide-time-2 2*y-collide-time-1
 515                                  2*y-collide-time-2
 516                                  2*minimal-collide-time-num
 517                                  minimal-collide-time-denom)
 518                            (type symbol temporary-direction))
 519                   (when (and (not (zerop minimal-collide-time-denom))
 520                              (rational-<= 0 1
 521                                           2*minimal-collide-time-num minimal-collide-time-denom
 522                                           2*current-time-num current-time-denom))
 523                     (setf 2*current-time-num 2*minimal-collide-time-num)
 524                     (setf current-time-denom minimal-collide-time-denom)
 525                     (setf current-direction
 526                           (cond
 527                             ((or (eq temporary-direction :right)
 528                                  (eq temporary-direction :left))
 529                              (if (or (rational-= 2*minimal-collide-time-num
 530                                                  minimal-collide-time-denom
 531                                                  2*y-collide-time-1
 532                                                  y)
 533                                      (rational-= 2*minimal-collide-time-num
 534                                                  minimal-collide-time-denom
 535                                                  2*y-collide-time-2
 536                                                  y))
 537                                  :diagonal
 538                                  temporary-direction))
 539                             ((or (eq temporary-direction :up)
 540                                  (eq temporary-direction :down))
 541                              (if (or (rational-= 2*minimal-collide-time-num
 542                                                  minimal-collide-time-denom
 543                                                  2*x-collide-time-1
 544                                                  x)
 545                                      (rational-= 2*minimal-collide-time-num
 546                                                  minimal-collide-time-denom
 547                                                  2*x-collide-time-2
 548                                                  x))
 549                                  :diagonal
 550                                  temporary-direction))))
 551                     (setf current-standing-object standing-object)))))
 552             (if current-direction
 553                 (on-collision moving-object current-standing-object
 554                               (make-instance 'collision
 555                                              :desired-movement (make-xy x y)
 556                                              :collision-time (the rational (/ 2*current-time-num (* 2 current-time-denom)))
 557                                              :pos (make-xy
 558                                                    (+
 559                                                     (truncate (the fixnum (* 2*current-time-num x))
 560                                                               (the fixnum (* 2 current-time-denom)))
 561                                                     (x moving-object))
 562                                                    (+ (truncate (the fixnum (* 2*current-time-num y))
 563                                                                 (the fixnum (* 2 current-time-denom)))
 564                                                       (y moving-object)))
 565                                              :direction current-direction))
 566                 (progn
 567                   (setf (x moving-object) (the fixnum (+ (x moving-object) x)))
 568                   (setf (y moving-object) (the fixnum (+ (y moving-object) y)))
 569                   )))))
 570
 571
 572 (defun old-draw-rectangle (obj &key (r 0) (g 0) (b 0))
 573   (declare (type game-object obj))
 574   (sdl:draw-rectangle-* (zoom-trans (+ *current-translation-x* (x obj)))
 575                         (zoom-trans (+ *current-translation-y* (y obj)))
 576                         (zoom-trans (width obj))
 577                         (zoom-trans (height obj))
 578                         :color (sdl:color :r r :g g :b b)))