(module simple mzscheme

(require "../game.ss")
(require (prefix image- "../image.ss"))
(require (lib "etc.ss"))
;; (require (lib "errortrace.ss" "errortrace"))


(define-object bullet (x y) (dx dy shape)

  (define (create)
    (set! shape (make circle% (radius 2))))

  (define (can-collide obj)
    (if (is-a? obj bullet)
      #f
      #t))

  (define (touch world obj)
    (say world remove me))

  (define (shapes)
    (list shape))

  (define (draw world buffer)
    (image-circle-fill my-buffer (real->int x) (real->int y)
		       2 (image-color 0 255 0)))

  (define (tick world)
    (set! x (+ x dx))
    (set! y (+ y dy))
    (when (or (< x 0)
	      (> x WIDTH)
	      (< y 0)
	      (> y HEIGHT))
      (say world remove me)))
  )

(define-object player (x y) (dx dy)

  (define (set-coordinates mx my)
    (set! x mx)
    (set! y my))

  (define (can-collide obj)
    (not (is-a? obj bullet)))

  (define (shapes)
    (list (make circle% (radius 4))))

  (define (create)
    (set! dx 0)
    (set! dy 0))

  (define (tick world)
    (call-with-values
      (lambda () (get-mouse-movement))
      (lambda (mx my)
	(set! dx (+ (/ mx 6.0) dx))
	(set! dy (+ (/ my 6.0) dy))))
    (set! x (+ x dx))
    (set! y (+ y dy))
    (when (left-clicking?)
      (add-object world (make bullet (x x) (y y)
			      (dx (* 1.2 dx)) (dy (* 1.2 dy)))))
    )

  (define (draw world buffer)
    (image-circle my-buffer (real->int x) (real->int y)
		  4 (image-color 255 0 0)))
)

(define-object crystal (x y) (ang size)

  (define (create)
    (set! size 8)
    (set! ang (random 360)))

  (define (shapes)
    (list (make circle% (radius size))))

  (define (can-collide obj)
    (is-a? obj player))

  (define (touch world obj)
    (say world remove me))

  (define (tick world)
    (set! ang (modulo (+ ang 4) 360)))

  (define (draw world buffer)
    (let ((draw-side (lambda (xang)
		       (let ((x2 (real->int (+ x (* size (Cosine (+ xang ang))))))
			     (color (real->int (- 158 (* 50 (Cosine (+ 90 xang ang)))))))
			 (image-line my-buffer x (+ y size) x2 y 
				     (image-color color color color))
			 (image-line my-buffer x (- y size) x2 y 
				     (image-color color color color))))))
      (for-each (lambda (x) (draw-side x)) (list 0 90 180 270))))

  )

(define-object star (x y) (color)

   (define (create)
     (set! color (random 255)))

   (define (can-collide obj) #f)

   (define (draw world buffer)
     (image-circle-fill my-buffer x y 1 (image-color color color color)))

   )

(define-object enemy (x y) (ang speed)

  (define (create)
    (set! speed (/ (+ 1 (random 10)) 3))
    (set! ang (random 360)))

  (define (can-collide obj)
    (is-a? obj bullet))

  (define (shapes)
    (list (make circle% (radius 5))))

  (define (draw world buffer)
    (image-circle-fill my-buffer (real->int x) (real->int y)
		       5 (image-color 255 32 0)))

  (define (touch world obj)
    (say world remove me))

  (define (tick world)
    (let ((dx (* (Cosine ang) speed))
	  (dy (* (Sine ang) speed)))
      (set! x (+ x dx))
      (set! y (+ y dy))
      (set! ang (modulo (- (random 5) 2) 360))
      (when (eq? (random 30) 0)
	(set! ang (random 360)))
      (when (or (< x 0)
		(> x WIDTH)
		(< y 0)
		(> y HEIGHT))
	(set! ang (modulo (+ ang 180) 360)))))
  )

(define player* (make player))

(define WIDTH 1000)
(define HEIGHT 1000)
(define my-buffer #f)

(define-object level () (player buffer border)

  (define (can-collide obj) #f)

  (define (create)
    (set! border 5))

  (define (tick world)
    (when (eq? 0 (random 30))
      (add-object world (make enemy (x (random WIDTH))
			      (y (random HEIGHT))))))

  (define (draw world buffer)
    (let loop ((x 0))
      (when (< x border)
	(let* ((c (- 255 (* x (real->int (/ 255 border)))))
	       (col (image-color c c c)))
	  (image-line my-buffer x x (- WIDTH x 1) x col)
	  (image-line my-buffer x (- HEIGHT x 1) (- WIDTH x 1) (- HEIGHT x 1) col)
	  (image-line my-buffer (- WIDTH x 1) x (- WIDTH x 1) (- HEIGHT x 1) col)
	  (image-line my-buffer x x x (- HEIGHT x 1) col))
	(loop (+ x 1)))))

  )

;; these two objects only show the part of the screen currently displayed
(define-object clear (phase) (player)
   (define (create)
     (set! phase -100))

   (define (draw world buffer)
     (let ((x (real->int (let ((min-x (/ 640 2))
			       (max-x (- WIDTH (/ 640 2))))
			   (min (max (say player get-x) min-x) max-x))))
	   (y (real->int (let ((min-y (/ 480 2))
			       (max-y (- HEIGHT (/ 480 2))))
			   (min (max (say player get-y) min-y) max-y)))))
       (image-rectangle-fill my-buffer (- x 320) (- y 240)
			     (+ x -320 (image-width buffer))
			     (+ y -240 (image-height buffer))
			     (image-color 0 0 0))))
   )

(define-object show (phase) (player)

   (define (create)
     (say player set-coordinates (/ WIDTH 2) (/ HEIGHT 2))
     (set! phase 100))

   (define (draw world buffer)
     (let ((x (real->int (let ((min-x (/ 640 2))
			       (max-x (- WIDTH (/ 640 2))))
			   (min (max (say player get-x) min-x) max-x))))
	   (y (real->int (let ((min-y (/ 480 2))
			       (max-y (- HEIGHT (/ 480 2))))
			   (min (max (say player get-y) min-y) max-y)))))
       (image-copy buffer my-buffer (- x 320) (- y 240) (image-width buffer) (image-height buffer))))

   )

(define (make-level player)
  (make level (player player)))

(provide run)
(define (run)
  (define world (make-world))
  (start world (lambda (world)
		 (set! my-buffer (image-create WIDTH HEIGHT))
		 (add-object world player*)
		 (add-object world (make-level player*))
		 (for-each (lambda (n)
			     (add-object world (make crystal
						     (x (random WIDTH))
						     (y (random HEIGHT)))))
			   (build-list (+ 20 (random 10)) (lambda (n) n)))
		 (for-each (lambda (n)
			     (add-object world (make star
						     (x (random WIDTH))
						     (y (random HEIGHT)))))
			   (build-list 250 (lambda (x) x)))
		 (add-object world (make show (player player*)))
		 (add-object world (make clear (player player*))))))

)