util.ss
(module util mzscheme

  (require (lib "foreign.ss")) (unsafe!)
  (require (prefix a: "private/allegro.ss"))
  (require (prefix image- "image.ss"))

  (provide makeColor)
  (define makeColor
    (case-lambda
      ((sym)
       (let-values (((r g b) (cond
			       ((eq? 'RED sym) (values 255 0 0))
			       ((eq? 'DARK-RED sym) (values 128 0 0))
			       ((eq? 'GREEN sym) (values 0 255 0))
			       ((eq? 'DARK-GREEN sym) (values 0 128 0))
			       ((eq? 'BLUE sym) (values 0 0 255))
			       ((eq? 'DARK-BLUE sym) (values 0 0 128))
			       ((eq? 'WHITE sym) (values 255 255 255))
			       (else (values 0 0 0)))))
		   (makeColor r g b)))
      ((r g b)
       (image-color r g b))))

  (provide blend-palette)
  (define (blend-palette start-color end-color num-color)
    (let-values ([(sr sg sb) (image-get-rgb start-color)]
                 [(er eg eb) (image-get-rgb end-color)])
      (let loop ([q 0])
        (if (< q num-color)
          (let* ([j (/ q num-color)]
                 [f_r (round (+ sr (* (- er sr) j)))]
                 [f_g (round (+ sg (* (- eg sg) j)))]
                 [f_b (round (+ sb (* (- eb sb) j)))])
            (cons (image-color f_r f_g f_b) (loop (+ q 1))))
          null))))

  (provide (rename a:set-gfx-mode set-gfx-mode)
	   (rename a:set-trans-blender set-trans-blender!)
	   (rename a:set-color-conversion set-color-conversion!)
	   (rename a:set-projection-viewport set-projection-viewport)
	   (rename a:get-transformation-matrix get-transformation-matrix)
	   (rename a:apply-matrix apply-matrix)
	   (rename a:persp-project persp-project)
	   (rename a:set-color-depth set-color-depth))

  (provide (rename a:polygon-z-normal polygon-z-normal))

  (provide (rename a:DITHER DITHER)
	   (rename a:TOTAL TOTAL))

  (provide allegro-init)
  (define (allegro-init)
    (a:install_allegro 0))

  (provide Cosine Sine)
  (provide M-PI)
  (define M-PI 3.14159265358979323846)
  (define (Cosine x) (cos (/ (* x M-PI) 180)))
  (define (Sine x) (sin (/ (* x M-PI) 180)))

  (provide calculate-angle)
  (define (calculate-angle x1 y1 x2 y2)
    (if (eq? x1 x2)
      (atan 9999999999)
      (let-values ([(rx1 rx2) (if (> x2 x1) (values x2 x1) (values x1 x2))])
                  (atan (/ (- y1 y2) (- rx1 rx2))))))

  (provide calculate-normal-angle)
  (define (calculate-normal-angle x1 y1 x2 y2)
    (let ((ang (if (eq? x1 x2)
                 (atan 9999999999)
                 (cond
                   ((and (< x1 x2) (<= y1 y2)) (* 180 (/ (atan (/ (- y1 y2) (- x1 x2))) M-PI)))
                   ((and (< x1 x2) (> y1 y2)) (+ 360 (* 180 (/ (atan (/ (- y1 y2) (- x1 x2))) M-PI))))
                   ((and (> x1 x2) (<= y1 y2)) (+ 180 (* 180 (/ (atan (/ (- y1 y2) (- x1 x2))) M-PI))))
                   ((and (> x1 x2) (> y1 y2)) (+ 180 (* 180 (/ (atan (/ (- y1 y2) (- x1 x2))) M-PI))))))))
    ang))

  (define current-start 0)
  (define GetTicks current-milliseconds)

  (define screen-x 0)
  (define screen-y 0)

  (provide screen-x screen-y)

  (provide easy-init easy-exit)
  (define easy-init
    (case-lambda
      ((width height depth)
       (easy-init width height depth 'WINDOWED))
      ((width height depth mode)
       (begin
	 (allegro-init)
	 (a:install-keyboard)
	 (a:install-mouse)
	 (a:install-sound 'AUTODETECT 'AUTODETECT #f)
	 (a:set-color-depth depth)
	 (a:set-gfx-mode mode width height 0 0)
	 (set! screen-x width)
	 (set! screen-y height)))))
    
  (define (easy-exit)
    (a:allegro-exit))

  ; (define mouse-x 0)
  ; (define mouse-y 0)
  (provide game-loop)
  (define (game-loop logic! draw! game-delay)
    (let ([buffer (image-create screen-x screen-y)])
      (let loop ([game-time (GetTicks)]
			    [done? #f])
        (when (not done?)
          (let ([now (GetTicks)])
            (if (< (- now game-time) game-delay)
              (begin
                (sleep 0.01)
                (loop game-time done?))
              (let loop2 ([diff (- now game-time)]
                                [xtime game-time]
                                [end? done?]
                                [draw? #f])
                (if (or (< diff game-delay) end?)
                  (begin
                    (when draw?
		      (draw! buffer)
		      (image-copy-screen buffer)
		      (image-clear buffer))
                    (loop xtime end?))
		  (loop2 (- diff game-delay)
			 (+ xtime game-delay)
			 (logic!)
			 #t)))))))
      (image-destroy buffer)))

  (provide fps frames-per-second)
  (define (fps num)
    (/ 1000 num))
  (define frames-per-second fps)

)