/pliant/graphic/image/antialiasing.pli
1	module "/pliant/language/compiler.pli"
2	submodule "prototype.pli"
3	module "/pliant/graphic/color/gamut.pli"
4	module "/pliant/language/compiler/type/inherit.pli"
5	module "/pliant/graphic/misc/mtbuffer.pli"
6
7	constant smart true
8
9
10	type ImageAntiAliasing
11	inherit ImagePrototype
12	field Link:ImagePrototype image
13	field MtBuffer buffers
14	field Int tile_x tile_y shift
15
16	ImagePrototype maybe ImageAntiAliasing
17
18
19	method aa step_x -> s
20	arg ImageAntiAliasing aa ; arg Int s
21	s := aa pixel_size
22
23	method aa step_y -> s
24	arg ImageAntiAliasing aa ; arg Int s
25	s := aa:line_size*aa:tile_x
26
27
28	method aa bind image tile_x tile_y -> status
29	oarg_rw ImageAntiAliasing aa ; oarg ImagePrototype image ; arg Int tile_x tile_y ; arg ExtendedStatus status
30	if image:gamut:bits_per_component<>8
31	return (failure "Antialiasing on "+(string image:gamut:bits_per_component)+" bits per component images is not supported")
32	var Int shift := 0
33	while 2^shift<tile_x*tile_y
34	shift += 1
35	if tile_x*tile_y<>2^shift
36	return (failure "Antialiasing factor "+string:tile_x+"x"+string:tile_y+" is not supported")
37	if not smart and (image:size_x%tile_x<>0 or image:size_y%tile_y<>0)
38	return failure:"The image sampling is not suited for the requested antialiasing"
39	addressof:aa map ImagePrototype := addressof:image map ImagePrototype
40	aa image :> image
41	aa tile_x := tile_x ; aa tile_y := tile_y
42	aa shift := shift
43	aa size_x := image:size_x\tile_x
44	aa size_y := image:size_y\tile_y
45	if smart
46	aa x1 := image:x0+(image:x1-image:x0)*(aa:size_x*tile_x)/image:size_x
47	aa y1 := image:y0+(image:y1-image:y0)*(aa:size_y*tile_y)/image:size_y
48	check image:line_size>=aa:line_size*tile_x
49	aa:buffers size := aa:step_y*tile_y
50	status := success
51
52	method aa setup image options -> status
53	oarg_rw ImageAntiAliasing aa ; arg ImagePrototype image ; arg Str options ; arg ExtendedStatus status
54	if not ((options (options option_position "antialiasing" 0) options:len) parse word:"antialiasing" (var Int tile_x) (var Int tile_y) any)
55	return failure:"Antialiasing factor not specified"
56	status := aa bind (addressof:image omap ImagePrototype) tile_x tile_y
57
58
59	method aa read x y count adr
60	oarg_rw ImageAntiAliasing aa ; arg Int x y count ; arg Address adr
61	check x>=0 and count>=0 and x+count<=aa:size_x and y>=0 and y<aa:size_y
62	var Int tile_x := aa tile_x ; var Int tile_y := aa tile_y
63	var Int shift := aa shift
64	var Int step_x := aa step_x
65	var Int step_y := aa step_y
66	var Int next_tile := (tile_x-1)*step_x
67	var Address buffer := aa:buffers allocate
68	for (var Int iy) 0 tile_y-1
69	aa:image read x*tile_x y*tile_y+iy count*tile_x (buffer translate Byte iy*step_y)
70	var Address src := buffer
71	var Address dest := adr
72	var Address stop := adr translate Byte count*aa:pixel_size
73	while dest<>stop
74	for (var Int i) 0 step_x-1 # for each component of the gamut
75	var uInt total := 0
76	var Address cy := src
77	var Int iy := tile_y
78	while iy>0
79	var Address cx := cy
80	var Int ix := tile_x
81	while ix>0
82	total += cx map uInt8
83	cx := cx translate uInt8 step_x
84	ix -= 1
85	cy := cy translate uInt8 step_y
86	iy -= 1
87	src := src translate uInt8 1
88	dest map uInt8 := total\2^shift
89	dest := dest translate uInt8 1
90	src := src translate Byte next_tile
91	aa:buffers free buffer
92
93
94	export ImageAntiAliasing '. bind'
95
96