/pliant/graphic/image/convert.pli
1	module "/pliant/language/compiler.pli"
2	submodule "prototype.pli"
3	module "/pliant/language/compiler/type/inherit.pli"
4	module "/pliant/graphic/color/gamut.pli"
5	module "/pliant/graphic/misc/mtbuffer.pli"
6
7
8	type ImageConvert
9	inherit ImagePrototype
10	field Link:ImagePrototype image
11	field MtBuffer buffers
12	field Arrow speedup
13	field CBool same_gamut
14	field Array:Float32 down
15	field Array:Float32 up
16	field Link:ColorGamut switch
17	field Array:Int hachure
18
19	ImagePrototype maybe ImageConvert
20
21
22	method convert bind image gamut options -> status
23	oarg_rw ImageConvert convert ; oarg ImagePrototype image ; oarg ColorGamut gamut ; arg Str options ; arg ExtendedStatus status
24	if gamut=failure
25	return (failure "Invalid gamut '"+gamut:name+"' ("+gamut:status:message+")")
26	addressof:convert map ImagePrototype := addressof:image map ImagePrototype
27	convert gamut :> gamut
28	convert complete
29	convert image :> image
30	convert:buffers size := image line_size
31	var Link:ColorGamut g :> image gamut
32	if (exists convert:switch)
33	g :> convert switch
34	convert speedup := gamut speedup g options
35	convert same_gamut := image:gamut:name=gamut:name and (image:gamut query "options")=(gamut query "options")
36	status := success
37
38	method convert setup image options -> status
39	oarg_rw ImageConvert convert ; arg ImagePrototype image ; arg Str options ; arg ExtendedStatus status
40	var Str gamut_name := options option "gamut" Str
41	if gamut_name=""
42	return failure:"Gamut name not specified"
43	var Link:ColorGamut gamut :> color_gamut gamut_name
44	if gamut=failure
45	return (failure "Gamut '"+gamut_name+"' is not valid")
46	status := convert bind (addressof:image omap ImagePrototype) gamut options
47
48
49	method convert read x y count adr
50	oarg_rw ImageConvert convert ; arg Int x y count ; arg Address adr
51	if convert:same_gamut and not (exists convert:switch) and convert:hachure:size=0 and convert:down:size=0
52	convert:image read x y count adr
53	return
54	var Address buffer := convert:buffers allocate
55	convert:image read x y count buffer
56	var Link:ColorGamut g :> convert:image gamut
57	if (exists convert:switch)
58	g :> convert switch
59	if convert:hachure:size>0
60	var Int psize := convert:image pixel_size
61	for (var Int d) 0 convert:hachure:size-1
62	var Int h := convert:hachure d
63	var Int z := shunt ((g query "component_options "+string:d) option "negative") 255 0
64	if h=defined
65	var Address ptr := buffer
66	var Address stop := buffer translate Byte count*psize
67	var Int r := (x+y)%(2*h)
68	while ptr<>stop
69	if r<h
70	ptr map uInt8 d := z
71	r += 1
72	if r=2*h
73	r := 0
74	ptr := ptr translate Byte psize
75	if convert:down:size>0
76	var Int psize := convert:image pixel_size
77	var Int dim := min (min convert:down:size convert:up:size) psize
78	var Address downs := addressof convert:down:0
79	var Address ups := addressof convert:up:0
80	var Address ptr := buffer
81	var Address stop := buffer translate Byte count*psize
82	while ptr<>stop
83	for (var Int i) 0 dim-1
84	ptr map uInt8 i := cast (ptr map uInt8 i)*(downs map Float32 i)+255*(ups map Float32 i) Int
85	ptr := ptr translate Byte psize
86	convert:gamut convert g buffer adr count convert:speedup
87	convert:buffers free buffer
88
89	export ImageConvert '. bind' '. down' '. up' '. switch' '. hachure'
90
91
92
93
94
95
96