/pliant/graphic/filter/gimpprint.pli
1	abstract
2	[Gimp-print (free color inkjet printers driver) interface]
3
4	# Copyright  Hubert Tonneau  hubert.tonneau@pliant.cx
5	#
6	# This program is free software; you can redistribute it and/or
7	# modify it under the terms of the GNU General Public License version 2
8	# as published by the Free Software Foundation.
9	#
10	# This program is distributed in the hope that it will be useful,
11	# but WITHOUT ANY WARRANTY; without even the implied warranty of
12	# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
13	# GNU General Public License for more details.
14	#
15	# You should have received a copy of the GNU General Public License
16	# version 2 along with this program; if not, write to the Free Software
17	# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
18
19
20	module "/pliant/language/unsafe.pli"
21	module "/pliant/language/context.pli"
22	module "/pliant/language/compiler.pli"
23	module "/pliant/language/os.pli"
24	module "/pliant/language/stream.pli"
25	module "prototype.pli"
26	module "/pliant/graphic/color/gamut.pli"
27
28	if (constant (file_query "file:/lib/libgimpprint.so" standard)=defined)
29	constant gp_dll "/lib/libgimpprint.so"
30	eif (constant (file_query "file:/lib/libgimpprint.so.1" standard)=defined)
31	constant gp_dll "/lib/libgimpprint.so.1"
32	eif (constant (file_query "file:/usr/lib/libgimpprint.so.1" standard)=defined)
33	constant gp_dll "/usr/lib/libgimpprint.so.1"
34	else
35	constant gp_dll "libgimpprint.so"
36	constant trace false
37	constant debug false
38
39
40
41
42
43	function stp_init
44	external gp_dll "stp_init"
45	if debug
46	console "  Gimp-print stp_init is at " (cast the_function:stp_init:executable Int) eol
47
48	function stp_get_printer_by_driver driver -> printer
49	arg CStr driver ; arg Address printer
50	external gp_dll "stp_get_printer_by_driver"
51
52	function stp_printer_get_printvars printer -> vars
53	arg Address printer ; arg Address vars
54	external gp_dll "stp_printer_get_printvars"
55
56	function stp_allocate_copy vars -> newvars
57	arg Address vars newvars
58	external gp_dll "stp_allocate_copy"
59
60	function stp_merge_printvars vars printer
61	arg Address vars printer
62	external gp_dll "stp_merge_printvars"
63
64	function stp_free_vars vars
65	arg Address vars
66	external gp_dll "stp_free_vars"
67
68
69	function stp_set_page_width vars val
70	arg Address vars ; arg Int val
71	external gp_dll "stp_set_page_width"
72
73	function stp_set_page_height vars val
74	arg Address vars ; arg Int val
75	external gp_dll "stp_set_page_height"
76
77	constant ORIENT_PORTRAIT 0
78
79	function stp_set_orientation vars val
80	arg Address vars ; arg Int val
81	external gp_dll "stp_set_orientation"
82
83	function stp_set_left vars val
84	arg Address vars ; arg Int val
85	external gp_dll "stp_set_left"
86
87	function stp_set_top vars val
88	arg Address vars ; arg Int val
89	external gp_dll "stp_set_top"
90
91
92	function stp_set_media_type vars val
93	arg Address vars ; arg CStr val
94	external gp_dll "stp_set_media_type"
95
96	function stp_set_media_source vars val
97	arg Address vars ; arg CStr val
98	external gp_dll "stp_set_media_source"
99
100	function stp_set_ink_type vars val
101	arg Address vars ; arg CStr val
102	external gp_dll "stp_set_ink_type"
103
104	function stp_set_resolution vars val
105	arg Address vars ; arg CStr val
106	external gp_dll "stp_set_resolution"
107
108	function stp_set_scaling vars f
109	arg Address vars ; arg Int f
110	external gp_dll "stp_set_scaling"
111
112
113	function stp_set_dither_algorithm vars val
114	arg Address vars ; arg CStr val
115	external gp_dll "stp_set_dither_algorithm"
116
117	constant OUTPUT_COLOR 1
118	constant OUTPUT_RAW_CMYK  3
119
120	function stp_set_output_type vars val
121	arg Address vars ; arg Int val
122	external gp_dll "stp_set_output_type"
123
124	constant IMAGE_CONTINUOUS 2
125
126	function stp_set_image_type vars val
127	arg Address vars ; arg Int val
128	external gp_dll "stp_set_image_type"
129
130	function stp_set_brightness vars f
131	arg Address vars ; arg Int f
132	external gp_dll "stp_set_brightness"
133
134	function stp_set_contrast vars f
135	arg Address vars ; arg Int f
136	external gp_dll "stp_set_contrast"
137
138	function stp_set_cyan vars f
139	arg Address vars ; arg Int f
140	external gp_dll "stp_set_cyan"
141
142	function stp_set_magenta vars f
143	arg Address vars ; arg Int f
144	external gp_dll "stp_set_magenta"
145
146	function stp_set_yellow vars f
147	arg Address vars ; arg Int f
148	external gp_dll "stp_set_yellow"
149
150	function stp_set_saturation vars f
151	arg Address vars ; arg Int f
152	external gp_dll "stp_set_saturation"
153
154	function stp_set_density vars f
155	arg Address vars ; arg Int f
156	external gp_dll "stp_set_density"
157
158	function stp_set_gamma vars f
159	arg Address vars ; arg Int f
160	external gp_dll "stp_set_gamma"
161
162	function stp_set_app_gamma vars f
163	arg Address vars ; arg Int f
164	external gp_dll "stp_set_app_gamma"
165
166
167	function stp_set_outfunc vars func
168	arg Address vars func
169	external gp_dll "stp_set_outfunc"
170
171	function stp_set_outdata vars file
172	arg Address vars file
173	external gp_dll "stp_set_outdata"
174
175	function stp_set_errfunc vars func
176	arg Address vars func
177	external gp_dll "stp_set_errfunc"
178
179	function stp_set_errdata vars file
180	arg Address vars file
181	external gp_dll "stp_set_errdata"
182
183
184	type stp_image
185	field Address init
186	field Address reset
187	field Address transpose
188	field Address hflip
189	field Address vflip
190	field Address crop
191	field Address rotate_ccw
192	field Address rotate_cw
193	field Address rotate_180
194	field Address bpp
195	field Address width
196	field Address height
197	field Address get_row
198	field Address get_appname
199	field Address progress_init
200	field Address note_progress
201	field Address progress_conclude
202	field Address notused
203	field Int size_x size_y
204	field Array:Address lines ; field Int line_size line_count
205	field Int line_drop
206	field CBool cmyk
207	field (Array uInt16 256) cmyk_table
208	field Float noise <- 0
209
210
211	type stp_printfuncs
212	field Address parameters
213	field Address media_size
214	field Address imageable_area
215	field Address limit
216	field Address print
217	field Address default_parameters
218	field Address describe_resolution
219	field Address verify
220
221	function stp_printer_get_printfuncs printer -> funcs
222	arg Address printer ; arg_R stp_printfuncs funcs
223	external gp_dll "stp_printer_get_printfuncs"
224
225	function verify_prototype printer vars f -> ok
226	arg Address printer vars ; arg Function f ; arg Function f ; arg CBool ok
227	external_calling_convention
228	indirect
229
230	function print_prototype printer image vars f
231	arg Address printer ; arg stp_image image ; arg Address vars ; arg Function f
232	external_calling_convention
233	indirect
234
235
236
237
238
239	function image_do_nothing image
240	arg stp_image image
241	external_calling_convention
242
243	function image_bpp image -> bpp
244	arg stp_image image ; arg Int bpp
245	external_calling_convention
246	bpp := shunt image:cmyk 8 3 # bytes per pixel
247
248	function image_width image -> size_x
249	arg stp_image image ; arg Int size_x
250	external_calling_convention
251	size_x := image size_x
252
253	function image_height image -> size_y
254	arg stp_image image ; arg Int size_y
255	external_calling_convention
256	size_y := image size_y
257
258	function image_get_row image data y -> err
259	arg_rw stp_image image ; arg Address data ; arg Int y ; arg Int err
260	external_calling_convention
261	check y>=image:line_drop
262	while image:line_drop<y
263	while (image:lines image:line_drop)=null
264	os_yield
265	memory_free (image:lines image:line_drop)
266	atomic_add image:line_count -1
267	image line_drop += 1
268	while image:lines:y=null
269	os_yield
270	if image:cmyk
271	var Address src := image:lines y ; var Address stop := src translate Byte image:line_size
272	var Address dest := data
273	var Pointer:(Array uInt16 256) table :> image cmyk_table
274	while src<>stop
275	var Int l := src map uInt8
276	if image:noise<>0
277	memory_random addressof:(var Int r) Int:size
278	l += r % (max (cast (min l 255-l)*image:noise Int) 1)
279	dest map uInt16 := table l
280	src := src translate uInt8 1 ; dest := dest translate uInt16 1
281	else
282	memory_copy image:lines:y data image:line_size
283	err := 0
284
285	function image_get_appname image -> name
286	arg stp_image image ; arg Address name
287	external_calling_convention
288	name := "Pliant[0]" characters
289
290	function image_progress_init image
291	arg stp_image image
292	external_calling_convention
293	if trace
294	console "("
295
296	function image_note_progress image f1 f2
297	arg stp_image image ; arg Int f1 f2
298	external_calling_convention
299	if trace
300	console "."
301
302	function image_progress_conclude image
303	arg stp_image image
304	external_calling_convention
305	if trace
306	console ")" eol
307
308
309	function writebytes file buf size
310	arg Address file buf ; arg Int size
311	external_calling_convention
312	(file map Stream) raw_write buf size
313
314	if debug
315	(gvar Stream log) open "file:/tmp/gimpprint.log" out+safe
316
317	function errorbytes file buf size
318	arg Address file buf ; arg Int size
319	external_calling_convention
320	(var Str s) set buf size false
321	if debug
322	log writechars s
323	log flush anytime
324	else
325	file map Str += s
326
327
328
329
330
331	type ImageWriteFilterGimpPrint
332	field stp_image image
333	field Address vars
334	field FastSem tsem
335	field Int current
336
337	ImageWriteFilter maybe ImageWriteFilterGimpPrint
338
339	stp_init
340
341	method o float_option name -> i
342	arg Str o name ; arg Int i
343	var Float32 float := o option name Float
344	if float=undefined
345	float := 1
346	i := (addressof:float map Int)
347
348	method f open stream options h -> status
349	arg_rw ImageWriteFilterGimpPrint f ; arg_rw Stream stream ; arg Str options ; arg ImagePrototype h ; arg ExtendedStatus status
350
351	var Address printer := stp_get_printer_by_driver (options option "model" Str (options option "driver" Str))
352	if printer=null
353	return failure:"no driver"
354	var Address vars := stp_allocate_copy stp_printer_get_printvars:printer
355	f vars := vars
356
357	if not ((options (options option_position "page" options:len) options:len) parse word:"page" (var Float page_x) (var Float page_y) any)
358	page_x := 210 ; page_y := 297
359	var Float delta_y := 0
360	stp_set_page_width vars (cast page_x/25.4*72 Int)
361	stp_set_page_height vars (cast (page_y+delta_y)/25.4*72 Int)
362	stp_set_orientation vars ORIENT_PORTRAIT
363	if not ((options (options option_position "offset" options:len) options:len) parse word:"offset" (var Float offset_x) (var Float offset_y) any)
364	offset_x := 0 ; offset_y := 0
365	stp_set_left vars (cast offset_x/25.4*72 Int)
366	stp_set_top vars (cast (offset_y+delta_y)/25.4*72 Int)
367
368	stp_set_media_type vars (options option "paper" Str)
369	if (options option "roll")
370	stp_set_media_source vars "Roll"
371	var Str ink_type := options option "gimpprint_ink_type" Str
372	if ink_type<>""
373	stp_set_ink_type vars ink_type
374	stp_set_resolution vars (options option "resolution" Str)
375	var Float scale := options option "scale" Float
376	if scale=undefined
377	scale := 1
378	var Float r := h:size_x/(h:x1-h:x0)*25.4/scale
379	var Float32 float := -r ; stp_set_scaling vars (addressof:float map Int)
380	var Str dithering := options option "dithering" Str
381	if dithering=""
382	dithering :=  "Adaptive" # "Ordered"
383	stp_set_dither_algorithm vars dithering
384
385	var CBool cmyk := h:gamut:name<>"rgb"
386	stp_set_output_type vars (shunt cmyk OUTPUT_RAW_CMYK OUTPUT_COLOR)
387	stp_set_image_type vars IMAGE_CONTINUOUS
388	stp_set_brightness vars (options float_option "brightness")
389	stp_set_contrast vars (options float_option "contrast")
390	stp_set_cyan vars (options float_option "cyan")
391	stp_set_magenta vars (options float_option "magenta")
392	stp_set_yellow vars (options float_option "yellow")
393	stp_set_saturation vars (options float_option "saturation")
394	stp_set_density vars (options float_option "density")
395	stp_set_gamma vars (options float_option "gamma")
396	float := 2.4 ; stp_set_app_gamma vars (addressof:float map Int)
397
398	stp_set_outfunc vars (the_function writebytes Address Address Int):executable
399	stp_set_outdata vars addressof:stream
400	stp_set_errfunc vars (the_function errorbytes Address Address Int):executable
401	stp_set_errdata vars (addressof status:message)
402
403	memory_clear (addressof f:image) stp_image:size
404	f:image init := (the_function image_do_nothing stp_image) executable
405	f:image reset := (the_function image_do_nothing stp_image) executable
406	f:image rotate_ccw := (the_function image_do_nothing stp_image) executable
407	f:image rotate_cw := (the_function image_do_nothing stp_image) executable
408	f:image rotate_180 := (the_function image_do_nothing stp_image) executable
409	f:image bpp := (the_function image_bpp stp_image -> Int) executable
410	f:image width := (the_function image_width stp_image -> Int) executable
411	f:image height := (the_function image_height stp_image -> Int) executable
412	f:image get_row := (the_function image_get_row stp_image Address Int -> Int) executable
413	f:image get_appname := (the_function image_get_appname stp_image -> Address) executable
414	f:image progress_init := (the_function image_progress_init stp_image) executable
415	f:image note_progress := (the_function image_note_progress stp_image Int Int) executable
416	f:image progress_conclude := (the_function image_progress_conclude stp_image) executable
417	f:image size_x := h size_x ; f:image size_y := h size_y
418	f:image cmyk := cmyk
419	if cmyk
420	console "  Gimp-print"+(shunt (options option "roll") " roll" "")+" CMYK output" eol
421	for (var Int i) 0 255
422	f:image:cmyk_table i := i*i+2*i
423	if ((h:gamut query "noise") parse (var Float noise))
424	f:image noise := noise
425
426	stp_merge_printvars vars stp_printer_get_printvars:printer
427	var stp_printfuncs funcs := stp_printer_get_printfuncs printer
428	var Function fun ; fun executable := funcs verify
429	if (verify_prototype printer vars fun)
430	f:image line_size := h line_size
431	f:image:lines size := h size_y
432	for (var Int i) 0 h:size_y-1
433	f:image:lines i := null
434	f:image line_drop := 0
435	f:image line_count := 0
436	f current := 0
437	f:tsem request
438	thread
439	share f
440	var Function fun2 ; fun2 executable := funcs print
441	print_prototype printer f:image vars fun2
442	f:tsem release
443	status := success
444	else
445	stp_free_vars f:vars
446	status := failure status:message
447
448	method f writeline adr -> status
449	arg_rw ImageWriteFilterGimpPrint f ; arg Address adr ; arg Status status
450	# console f:image:line_count "/" f:current " (" (max 4*2^20\f:image:line_size 16) ")" eol
451	var Int forward := max 4*2^20\f:image:line_size 16
452	if f:image:line_count>forward
453	while f:image:line_count>forward\2
454	os_yield
455	var Address buf := memory_allocate f:image:line_size (addressof f:image:lines)
456	memory_copy adr buf f:image:line_size
457	atomic_add f:image:line_count 1 ; f:image:lines f:current := buf
458	f current += 1
459	status := success
460
461	method f close -> status
462	arg_rw ImageWriteFilterGimpPrint f ; arg ExtendedStatus status
463	f:tsem request ; f:tsem release
464	for (var Int y) f:image:line_drop f:image:size_y-1
465	memory_free f:image:lines:y
466	stp_free_vars f:vars
467	status := success
468
469
470	image_record_filters ".gimpprint" Void false ImageWriteFilterGimpPrint false
471
472
473
474
475
476	type ImageWriteFilterTestPattern
477	field Pointer:Stream stream
478	field CBool cmyk
479	field Int line_size
480	field (Array uInt16 256) cmyk_table
481
482	ImageWriteFilter maybe ImageWriteFilterTestPattern
483
484	stp_init
485
486	method o float_option name -> i
487	arg Str o name ; arg Int i
488	var Float32 float := o option name Float
489	if float=undefined
490	float := 1
491	i := (addressof:float map Int)
492
493	function gp_float f -> s
494	arg Float f ; arg Str s
495	s := string f
496	if (s search "." -1)=(-1)
497	s += ".0"
498
499	method f open stream options h -> status
500	arg_rw ImageWriteFilterTestPattern f ; arg_rw Stream stream ; arg Str options ; arg ImagePrototype h ; arg ExtendedStatus status
501	stream writeline "printer "+(options option "model" Str (options option "driver" Str))
502	stream writeline "resolution "+(options option "resolution" Str)
503	stream writeline "media_type "+(options option "paper" Str)
504
505	var Str ink_type := options option "gimpprint_ink_type" Str
506	if ink_type<>""
507	stream writeline "ink_type "+ink_type
508
509	var Float page_x page_y
510	if not ((options (options option_position "page" options:len) options:len) parse word:"page" (var Float page_x) (var Float page_y) any)
511	page_x := 210 ; page_y := 297
512	var Float offset_x offset_y
513	if not ((options (options option_position "offset" options:len) options:len) parse word:"offset" (var Float offset_x) (var Float offset_y) any)
514	offset_x := 0 ; offset_y := 0
515
516	stream writeline "media_size A4" ; page_x := 210 ; page_y := 297
517	var Str dithering := options option "dithering" Str
518	if dithering=""
519	dithering :=  "Adaptive" # "Ordered"
520	stream writeline "dither_algorithm "+dithering
521
522	stream writeline "hsize "+(gp_float (h:x1-h:x0)/page_x)
523	stream writeline "vsize "+(gp_float (h:y1-h:y0)/page_y)
524	stream writeline "left "+(gp_float offset_x/page_x)
525	stream writeline "top "+(gp_float offset_y/page_y)
526
527	stream writeline "density 1.0"
528	stream writeline "image "+(string h:size_x)+" "+(string h:size_y)
529	f stream :> stream
530	f cmyk := h:gamut:name<>"rgb"
531	if f:cmyk
532	for (var Int i) 0 255
533	f:cmyk_table i := i*i+2*i
534	f line_size := h line_size
535	status := success
536
537	method f writeline adr -> status
538	arg_rw ImageWriteFilterTestPattern f ; arg Address adr ; arg Status status
539	if f:cmyk
540	var Address ptr := adr
541	var Address stop := adr translate Byte f:line_size
542	var Pointer:(Array uInt16 256) table :> f cmyk_table
543	while ptr<>stop
544	var uInt16 v16 := table (ptr map uInt8)
545	f:stream raw_write addressof:v16 uInt16:size
546	ptr := ptr translate uInt8 1
547	else
548	f:stream raw_write adr f:line_size
549	status := success
550
551	method f close -> status
552	arg_rw ImageWriteFilterTestPattern f ; arg ExtendedStatus status
553	status := success
554
555
556	image_record_filters ".gptp" Void false ImageWriteFilterTestPattern false