/pliant/graphic/image/lazy.pli
1	module "/pliant/language/compiler.pli"
2	module "/pliant/language/stream.pli"
3	module "/pliant/graphic/color/gamut.pli"
4	submodule "prototype.pli"
5	module "/pliant/language/compiler/type/inherit.pli"
6	module "/pliant/graphic/filter/prototype.pli"
7	module "/pliant/graphic/filter/all.pli"
8
9
10	type ImageLazy
11	inherit ImagePrototype
12	field Link:Stream stream
13	field Link:ImageReadFilter filter
14	field Int current
15	field Array:Address buffers
16	field CBool crashed
17	field Sem sem
18
19	ImagePrototype maybe ImageLazy
20
21	function destroy p
22	arg_w ImageLazy p
23	if (exists p:filter)
24	p:filter close
25	for (var Int i) 0 p:buffers:size-1
26	memory_free p:buffers:i
27
28
29	method p bind filename options -> status
30	oarg_rw ImageLazy p ; arg Str filename options ; arg ExtendedStatus status
31	if (exists p:filter)
32	p:filter close
33	p:buffers size := 0
34	p filter :> image_read_filter (shunt (options option "filter") (options option "filter" Str) filename)
35	if not (exists p:filter)
36	return (failure "There is no filter for '"+filename+"' image")
37	p crashed := true
38	p stream :> new Stream
39	p:stream open filename options in+safe
40	if p:stream=failure
41	p filter :> null map ImageReadFilter
42	return (failure "Failed to open "+filename)
43	status := p:filter open p:stream options (var ImagePrototype h)
44	if status=failure
45	p filter :> null map ImageReadFilter
46	return
47	addressof:p map ImagePrototype := h
48	if status=success
49	p:buffers size := 1+(options option "backward" Int 0)
50	for (var Int i) 0 p:buffers:size-1
51	p:buffers i := memory_allocate h:line_size addressof:p
52	p crashed := false
53	p current := -1
54
55	method p bind stream options -> status
56	oarg_rw ImageLazy p ; arg_rw Stream stream ; arg Str options ; arg ExtendedStatus status
57	if (exists p:filter)
58	p:filter close
59	for (var Int i) 0 p:buffers:size-1
60	memory_free p:buffers:i
61	p:buffers size := 0
62	p crashed := true
63	p filter :> image_read_filter (options option "filter" Str)
64	if not (exists p:filter)
65	return (failure "There is no filter for '"+(options option "filter" Str)+"' image")
66	p stream :> stream
67	status := p:filter open p:stream options (var ImagePrototype h)
68	if status=failure
69	p filter :> null map ImageReadFilter
70	return
71	addressof:p map ImagePrototype := h
72	if status=success
73	p:buffers size := 1+(options option "backward" Int 0)
74	for (var Int i) 0 p:buffers:size-1
75	p:buffers i := memory_allocate h:line_size addressof:p
76	p crashed := false
77	p current := -1
78
79	method p setup image options -> status
80	oarg_rw ImageLazy p ; arg ImagePrototype image ; arg Str options ; arg ExtendedStatus status
81	var Str file := options option "file" Str
82	if file=""
83	return failure:"File name not specified"
84	status := p bind file options
85
86
87	method p read x y count adr
88	arg_rw ImageLazy p ; arg Int x y count ; arg Address adr
89	check x>=0 and count>=0 and x+count<=p:size_x and y>=0 and y<p:size_y
90	p:sem request
91	while p:current<y and not p:crashed
92	p current += 1
93	if (p:filter readline p:buffers:(p:current%p:buffers:size))=success
94	if p:current=p:size_y-1
95	p:filter close
96	p filter :> null map ImageReadFilter
97	else
98	p crashed := true
99	p:sem release
100	if p:crashed
101	memory_clear adr count*p:gamut:pixel_size
102	eif y>p:current-p:buffers:size and y<=p:current
103	memory_copy (p:buffers:(y%p:buffers:size) translate Byte x*p:gamut:pixel_size) adr count*p:gamut:pixel_size
104	else
105	error error_id_unexpected "Wrong line "+string:y+" (cursor was at "+(string p:current)+" and there is a "+(string p:buffers:size)+" lines buffer) requested from lazy image"
106
107
108	function 'cast Status' p -> status
109	arg ImageLazy p ; arg Status status
110	extension
111	status := shunt p:buffers:size<>0 success failure
112
113
114	export ImageLazy '. bind' 'cast Status'
115
116