StdPrint.icl 5.63 KB
Newer Older
Peter Achten's avatar
Peter Achten committed
1
2
implementation module StdPrint

Peter Achten's avatar
Peter Achten committed
3
//	Clean Standard Object I/O library, version 1.2
4
5
6
7
8
9
10
11
12

import StdEnv, StdMaybe, StdPicture, osprint, commondef

::	PageDimensions
	=	{	page		::	!Size
		,	margins		::	!Rectangle
		,	resolution	::	!(!Int,!Int)
		}

13
14
15
defaultPrintSetup	::	!*env -> (!PrintSetup, !*env) | FileEnv env
defaultPrintSetup env
	= os_defaultprintsetup env
16

17
18
19
20
printSetupDialog	::	!PrintSetup !*printEnv -> (!PrintSetup, !*printEnv)
					|	PrintEnvironments printEnv
printSetupDialog printSetup env
	= os_printsetupdialog printSetup env
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47

getPageDimensions	::	!PrintSetup !Bool	->	PageDimensions
getPageDimensions printSetup emulateScreenRes
	# ((w,h),((x1,y1),(x2,y2)),resolution)	= os_getpagedimensions printSetup emulateScreenRes
	= {page={w=w,h=h}, margins={corner1={x=x1,y=y1},corner2={x=x2,y=y2}}, resolution=resolution}

instance == PageDimensions
  where
	(==) {page=page1,margins=margins1,resolution=resolution1}
		 {page=page2,margins=margins2,resolution=resolution2}
		= page1==page2 && margins1==margins2 && resolution1==resolution2


fwritePrintSetup	::	!PrintSetup !*File -> *File
fwritePrintSetup printSetup file
	#!	string	= os_printsetuptostring printSetup
		hexChars	= [ nibbleToChar (if low (lowNibble string.[i]) (highNibble string.[i]))
						\\ i<-[0..(size string)-1], low<-[True, False] ]
	= fwrites (toString hexChars+++" ") file
	where
		lowNibble ch	= (toInt ch) bitand 0xF
		highNibble ch	= ((toInt ch)>>4) bitand 0xF
		nibbleToChar nibble
			|	10<=nibble && nibble<=15	= toChar (nibble-10+(toInt 'A'))
			|	 0<=nibble && nibble<=9		= toChar (nibble+(toInt '0'))
			

48
freadPrintSetup		::	!*File !*env -> (!Bool, !PrintSetup, !*File, !*env)	| FileEnv env
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
freadPrintSetup file env
	#!	(hexChList, file)	= readline [] file
		chList				= map hexToChar (pair hexChList)
		printSetup			= os_stringtoprintsetup (toString chList)
		(valid, env)		= os_printsetupvalid printSetup env
	|	not valid
		#!	(defaultPS, env)= os_defaultprintsetup env
		= (False, defaultPS, file ,env)
	= (True, printSetup, file, env)
  where
	readline akku file
		#!	(ok, ch, file)	= freadc file
		|	ok && isMember ch (['0'..'9']++['A'..'F'])
			= readline [ch:akku] file
		= (reverse akku, file)
	pair [] = []
	pair [x] = [(x,'0')]
	pair [x,y:rest] = [(x,y): pair rest]	
	hexToChar (lowNibble,highNibble)
		= (nibbleToInt lowNibble)+16*(nibbleToInt highNibble)
	nibbleToInt ch
		|	'A'<=ch && ch<='F'	= (toInt ch) - (toInt 'A') + 10
		|	'0'<=ch && ch<='9'	= digitToInt ch
Peter Achten's avatar
Peter Achten committed
72
73
74
75


print :: !Bool !Bool
		 .(PrintInfo !*Picture -> ([IdFun *Picture],!*Picture))
76
77
         !PrintSetup !*printEnv 
      -> (!PrintSetup, !*printEnv)
Peter Achten's avatar
Peter Achten committed
78
      | PrintEnvironments printEnv
79
80
81
82
83
print doDialog emulateScreen prFun printSetup printEnv
	# (finalState,printEnv) = os_printpageperpage doDialog emulateScreen 0 initFun stateTransition printSetup printEnv
	= case finalState of
		Cancelled _						->	(printSetup,printEnv)
		StartedPrinting (_,printSetup2)	->	(printSetup2,printEnv)
Peter Achten's avatar
Peter Achten committed
84
  where
85
  	initFun _ printInfo=:{printSetup} picture
Peter Achten's avatar
Peter Achten committed
86
  		# (drawFuns,picture) = prFun printInfo picture
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
  		= ((isEmpty drawFuns,zero), ((drawFuns,printSetup),picture))
	stateTransition (([drawFun:rest],printSetup),picture)
  		=((isEmpty rest,zero), ((rest,printSetup), drawFun picture))

printUpdateFunction
		:: 	!Bool (UpdateState -> *Picture -> *Picture) [Rectangle]
			!PrintSetup !*printEnv 
		->	(!PrintSetup, !*printEnv)
		| PrintEnvironments printEnv
printUpdateFunction doDialog updateFunc rectangles printSetup printEnv
	# (result, printEnv) = os_printpageperpage doDialog True Nothing initState pageTrans printSetup printEnv
	  outPrintSetup = case result of
				StartedPrinting (outPrintSetup,_)	-> outPrintSetup
				Cancelled s							-> printSetup
	= (outPrintSetup, printEnv)
Peter Achten's avatar
Peter Achten committed
102
  where
103
104
105
	initState s printInfo=:{ printSetup, jobInfo={range=(first,last), copies} } picture
		= (	( isEmpty printedClips,(hd printedClips).corner1),
			( (printSetup, printedClips), picture )
Peter Achten's avatar
Peter Achten committed
106
107
		  )
		where
108
			{page={w=wP,h=hP}}	= getPageDimensions printSetup True
Peter Achten's avatar
Peter Achten committed
109
110
111
112
113
			printedClips = flatten (repeatn copies (allClips % (first-1,last-1)))
			allClips = flatten (map clipsOfOneRectangle rectangles)
			clipsOfOneRectangle rectangle
				= clipRectangles
				where
114
// MW11 was					(x1,y1,x2,y2) = RectangleToRect rectangle
Peter Achten's avatar
Peter Achten committed
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
					{rleft=x1,rtop=y1,rright=x2,rbottom=y2} = RectangleToRect rectangle
					wR = x2-x1+1
					hR = y2-y1+1
					columns = [0..(ceilOfRatio wR wP)-1]
					rows = [0..(ceilOfRatio hR hP)-1]
					clipRectangles = [ { corner1 = { x=c*wP+x1, y=r*hP+y1 },
										 corner2 = { x=min ((c+1)*wP+x1) x2,
										   			 y=min ((r+1)*hP+y1) y2
										 }} \\ r<-rows,c<-columns]
					ceilOfRatio num denum 		// ceil (num/denom)
						| num mod denum == 0
							= num/denum
						= num/denum + 1
					min x y
						| x>y = y
						=x
131
	pageTrans ((printSetup, [clipRect:rest]), picture)
Peter Achten's avatar
Peter Achten committed
132
		# drawFunction = updateFunc (RectangleToUpdateState clipRect)
133
134
		= ( (isEmpty rest,if (isEmpty rest) zero (hd rest).corner1),
		 	((printSetup,rest), appClipPicture (toRegion clipRect) drawFunction picture)
Peter Achten's avatar
Peter Achten committed
135
136
		  )

137
138
// MW11 changed Point into Point2
printPagePerPage ::	!Bool !Bool 
Peter Achten's avatar
Peter Achten committed
139
140
141
					.x
					.(.x -> .(PrintInfo -> .(*Picture -> ((.Bool,Point2),(.state,*Picture)))))
					((.state,*Picture) -> ((.Bool,Point2),(.state,*Picture)))
142
					!PrintSetup !*printEnv 
Peter Achten's avatar
Peter Achten committed
143
144
				-> 	(Alternative .x .state,!*printEnv)
		        | PrintEnvironments printEnv
145
146
147
148
149
150
151
printPagePerPage doDialog emulateScreen x initFun transFun printSetup printEnv
	= os_printpageperpage doDialog emulateScreen x initFun transFun printSetup printEnv

instance PrintEnvironments World
  where
	os_printpageperpage p1 p2 p3 p4 p5 p6 world
		= accFiles (os_printpageperpage p1 p2 p3 p4 p5 p6) world
152
153
	os_printsetupdialog p1 world
		= accFiles (os_printsetupdialog p1) world