; Copyright (C) 2010 Dave Griffiths : See LICENCE file

(include "../io/ppm.sc")
(include "image.sc")

(define (sprite x y w h data) (list x y w h data))
(define (sprite-x sprite) (list-ref sprite 0))
(define (sprite-y sprite) (list-ref sprite 1))
(define (sprite-w sprite) (list-ref sprite 2))
(define (sprite-h sprite) (list-ref sprite 3))
(define (sprite-image sprite) (list-ref sprite 4))

(define (make-sprite x y filename)
	(let ((dim (read-ppm-dim filename)))
		(sprite x y (car dim) (cadr dim) (read-ppm filename))))
	
(define (sprite-ref sprite x y)
	(cond ; clip
		((and (> x (sprite-x sprite)) (< x (+ (sprite-x sprite) (sprite-w sprite)))
			  (> y (sprite-y sprite)) (< y (+ (sprite-y sprite) (sprite-h sprite))))
			(let ((x (- x (sprite-x sprite)))
		   		  (y (- y (sprite-y sprite))))
				(rgb-image-ref (sprite-image sprite) x y)))
		(else (vector 0 0 0))))

(define (unsafe-sprite-ref sprite x y)
	(unsafe-rgb-image-ref (sprite-image sprite) x y))

(define (sprite-blitter! sprite x y image thunk)
	(define (blit-row r n)
		(cond 
			((not (zero? n))				
				(rgb-image-set! image (+ x n) (+ y r) 
					(thunk (rgb-image-ref image (+ x n) (+ y r)) (sprite-ref sprite n r)))
				(blit-row r (- n 1)))))
	(define (blit-rows n)
		(cond 
			((not (zero? n))
				(blit-row n (sprite-w sprite))
				(blit-rows (- n 1)))))
	(blit-rows (sprite-h sprite)))
		
(define (sprite-blit-copy! sprite x y image)
	(sprite-blitter! sprite x y image 
		(lambda (src dst)
			dst)))

(define (sprite-blit-add! sprite x y image)
	(sprite-blitter! sprite x y image 
		(lambda (src dst)
			(vadd src dst))))
	
(define (sprite-blit-add-strength! sprite strength x y image)
	(sprite-blitter! sprite x y image 
		(lambda (src dst)
			(vadd src (vmul dst strength)))))
	
;(define (sprite-blit-add-col! sprite col x y image)
;	(sprite-blitter! sprite x y image 
;		(lambda (src dst)
;			(vadd src (vector (* (vx dst) (vx col)) 
;			                  (* (vy dst) (vy col))
;			                  (* (vz dst) (vz col)))))))
	
(define (sprite-blit-add-col! sprite col x y image)		
	(define (_ n)
		(cond ((not (zero? n))
			(let* ((sx (modulo n (sprite-w sprite)))
				   (sy (quotient n (sprite-w sprite)))
				   (src (unsafe-rgb-image-ref image (+ x sx) (+ y sy)))
				   (dst (unsafe-sprite-ref sprite sx sy)))
			;(display (list n sx sy))(newline)
			(unsafe-rgb-image-set! image (+ x sx) (+ y sy)
					  (vadd src (vector (* (vx dst) (vx col)) 
			                            (* (vy dst) (vy col))
			                            (* (vz dst) (vz col))))))
			(_ (- n 1)))))
	(cond ((and (> x 0) (< x (- (image-w image) (sprite-w sprite)))
				(> y 0) (< y (- (image-h image) (sprite-w sprite))))
		(_ (- (* (sprite-w sprite) (sprite-h sprite)) 1)))))