draw.lisp

   1 ;;; Copyright 2009 Christoph Senjak
   2
   3 ;; various draw-methods
   4
   5 (in-package :uxul-world)
   6
   7 (defun draw-background (x-trans y-trans)
   8
   9
  10   (flet ((modf (x y)
  11              (if nil ;(< x 0)
  12                  (- y (mod x y))
  13                  (mod x y))))
  14
  15
  16   #|(sdl:draw-rectangle-* (+ 100 (ceiling (/ (mod x-trans 800) 2))) (+ 100 (ceiling (/ (mod y-trans 800) 2))) 400 400
  17                         :color (sdl:color :r 255 :g 255 :b 255))|#
  18   ;; layer -1
  19
  20     ;; HAAAAAAAAAAAAACK
  21     (incf x-trans (- 10000 300))
  22     (incf x-trans (- 10000 300))
  23
  24   (dolist (i '(8 9 10 11 12 13 14 15 16 17 18 19 20))
  25     (dolist (j '(8 9 10 11 12 13 14 15 16 17 18 19 20))
  26       (sdl:draw-box-* (+ (- +screen-width+) (* 100 i) (round (/ (modf x-trans (* 2 +screen-width+)) 16))) (+ (- +screen-width+) (* 100 j) (ceiling (/ (modf y-trans (* 2 +screen-height+)) 16))) 50 50
  27                             :color (sdl:color :r (+ 128 64) :g (+ 128 64) :b (+ 128 64)))) :fill t)
  28
  29   (dolist (i '(4 5 6 7 8 9))
  30     (dolist (j '(4 5 6 7 8 9))
  31       (sdl:draw-box-* (+ (- +screen-width+) (* 200 i) (round (/ (modf x-trans (* 2 +screen-width+)) 8))) (+ (- +screen-width+) (* 200 j) (ceiling (/ (modf y-trans (* 2 +screen-height+)) 8))) 100 100
  32                             :color (sdl:color :r 128 :g 128 :b 128))) :fill t)
  33   (dolist (i '(2 3 4 5))
  34     (dolist (j '(2 3 4 5))
  35       (sdl:draw-box-* (+ (- +screen-width+) (* 400 i) (round (/ (modf x-trans (* 2 +screen-width+)) 4))) (+ (- +screen-width+) (* 400 j) (ceiling (/ (modf y-trans (* 2 +screen-height+)) 4))) 200 200
  36                             :color (sdl:color :r 64 :g 64 :b 64))) :fill t)
  37   (dotimes (i 4)
  38     (dotimes (j 4)
  39       (sdl:draw-box-* (+ (- +screen-width+) (* 800 i) (round (/ (modf x-trans (* 2 +screen-width+)) 2))) (+ (- +screen-width+) (* 800 j) (ceiling (/ (modf y-trans (* 2 +screen-height+)) 2))) 400 400
  40                             :color (sdl:color :r 0 :g 0 :b 0))) :fill t)))
  41
  42
  43
  44
  45 (defmethod draw ((obj room))
  46   (let ((*current-translation-x*
  47          #|(cond
  48            ((< (- (x (graphic-centralizer obj)) 400) 0) 0)
  49            ((> (+ (x (graphic-centralizer obj)) 400) (width obj))
  50             (- 800 (width obj)))
  51            (T
  52             (- 400 (x (graphic-centralizer obj)))))|#
  53          (- 400 (x (graphic-centralizer obj)))
  54           )
  55         (*current-translation-y*
  56          #|(cond
  57            ((< (- (y (graphic-centralizer obj)) 300) 0) 0)
  58            ((> (+ (y (graphic-centralizer obj)) 300) (height obj))
  59             (- 600 (height obj)))
  60            (T
  61             (- 300 (y (graphic-centralizer obj)))))|#
  62          (- 300 (y (graphic-centralizer obj)))
  63           ))
  64     ;;(draw-background *current-translation-x* *current-translation-y*)
  65     (dolist (image (get-objects obj 'uxul-world::game-object))
  66       (if (and (redraw image) (visible image)) (draw image)))))
  67
  68
  69 ;; FIXME
  70
  71 (defvar *player-bar-color* -255)
  72
  73 (defmethod draw ((obj player))
  74   #+nil(if (rectangle-in-screen obj)
  75            (old-draw-rectangle obj :r 255 :g 255 :b 255))
  76
  77   ;;; FIXME ************
  78   (sdl:draw-box-*
  79    10 10 (floor (* (power obj) (/ (- +screen-width+ 20) 10))) 10
  80    :color (sdl:color :r (abs *player-bar-color*) :g (abs *player-bar-color*) :b (abs *player-bar-color*)))
  81   (incf *player-bar-color* 5)
  82   (if (= *player-bar-color* 255) (setf *player-bar-color* -255))
  83
  84   (call-next-method))
  85
  86 (defmethod draw ((obj stone))
  87   (call-next-method)
  88   #+nil(if (rectangle-in-screen obj)
  89       (old-draw-rectangle obj :r 255 :g 255 :b 255)))
  90
  91 (defmethod draw ((obj simple-enemy))
  92   (call-next-method)
  93   #+nil(if (rectangle-in-screen obj)
  94       (old-draw-rectangle obj :r 255 :g 255 :b 255)))