;; {{{ Data types

(foreign-declare
	"#include <cd.h>\n"
	"#include <cdirgb.h>\n")

(include "canvas-draw-types.scm")

;; }}}

;; {{{ Context types

(define context:image
	(foreign-value "CD_IMAGERGB" nonnull-context))

(define context:double-buffer
	(foreign-value "CD_DBUFFERRGB" nonnull-context))

;; }}}

;; {{{ Auxiliary functions

(define canvas-image-put/rgb!
	(letrec ([canvas-image-set/rgb/raw!
	          (foreign-lambda* void ([nonnull-canvas canvas] [int dst_x] [int dst_y]
	                                 [int src_width] [int src_height] [nonnull-blob data]
	                                 [int dst_width] [int dst_height]
	                                 [int src_x0] [int src_x1] [int src_y0] [int src_y1])
	            "const int nchans = 3;\n"
	          	"unsigned char chans[nchans][src_width * src_height];\n"
	          	"int i;\n"
	          	"\n"
	          	"for (i = 0; i < nchans * src_width * src_height; ++i)\n"
	          	"	chans[i % nchans][i / nchans] = data[i];\n"
	          	"\n"
	          	"cdCanvasPutImageRectRGB(\n"
	          	"	canvas, src_width, src_height,\n"
	          	"	chans[0], chans[1], chans[2],\n"
	          	"	dst_x, dst_y, dst_width, dst_height,"
	          	"	src_x0, src_x1, src_y0, src_y1"
	          	");")])
	  (lambda (canvas dst-x dst-y src-width src-height data
	           #!key [width 0] [height 0] [x0 0] [x1 0] [y0 0] [y1 0])
	  	(unless (= (blob-size data) (* 3 src-width src-height))
	  		(error 'canvas-image-set/rgb! "bad image size" (blob-size data) (* 3 src-width src-height)))
	  	(canvas-image-set/rgb/raw!
	  		canvas dst-x dst-y src-width src-height data
	  		width height x0 x1 y0 y1))))

(define canvas-image-put/rgba!
	(letrec ([canvas-image-set/rgba/raw!
	          (foreign-lambda* void ([nonnull-canvas canvas] [int dst_x] [int dst_y]
	                                 [int src_width] [int src_height] [nonnull-blob data]
	                                 [int dst_width] [int dst_height]
	                                 [int src_x0] [int src_x1] [int src_y0] [int src_y1])
	            "const int nchans = 4;\n"
	          	"unsigned char chans[nchans][src_width * src_height];\n"
	          	"int i;\n"
	          	"\n"
	          	"for (i = 0; i < nchans * src_width * src_height; ++i)\n"
	          	"	chans[i % nchans][i / nchans] = data[i];\n"
	          	"\n"
	          	"cdCanvasPutImageRectRGBA(\n"
	          	"	canvas, src_width, src_height,\n"
	          	"	chans[0], chans[1], chans[2], chans[3],\n"
	          	"	dst_x, dst_y, dst_width, dst_height,"
	          	"	src_x0, src_x1, src_y0, src_y1"
	          	");")])
	  (lambda (canvas dst-x dst-y src-width src-height data
	           #!key [width 0] [height 0] [x0 0] [x1 0] [y0 0] [y1 0])
	  	(unless (= (blob-size data) (* 4 src-width src-height))
	  		(error 'canvas-image-set/rgba! "bad image size" (blob-size data) (* 4 src-width src-height)))
	  	(canvas-image-set/rgba/raw!
	  		canvas dst-x dst-y src-width src-height data
	  		width height x0 x1 y0 y1))))

(define canvas-image/rgb
	(getter-with-setter
		(letrec ([canvas-image/rgb/raw
							(foreign-lambda* void ([nonnull-canvas canvas] [int x] [int y]
							                       [int width] [int height]  [nonnull-blob data])
							  "const int nchans = 3;\n"
							  "unsigned char chans[nchans][width * height];\n"
							  "int i;\n"
							  "\n"
							  "cdCanvasGetImageRGB(\n"
							  "	canvas,\n"
							  "	chans[0], chans[1], chans[2],\n"
							  "	x, y, width, height\n"
							  ");\n"
							  "\n"
							  "for (i = 0; i < nchans * width * height; ++i)\n"
							  "	data[i] = chans[i % nchans][i / nchans];\n")])
			(lambda (canvas x y width height)
				(let ([data (make-blob (* 3 width height))])
					(canvas-image/rgb/raw canvas x y width height data)
					data)))
		canvas-image-put/rgb!))

;; }}}

;; vim: set ai et ts=2 sts=2 sw=2: ;;