graphics.icl 12.8 KB
Newer Older
Peter Achten's avatar
Peter Achten committed
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
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
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
implementation module graphics


import	StdInt, StdBool, StdReal, StdChar, StdList, StdFunc, StdEnum, StdArray, StdTuple, StdMisc, StdOrdList
import	StdControl, StdPicture
import	board, language, systemsettings


rbBoardGrey			:== RGB {r=191,g=191,b=191}			// The background colour of the board
rbLighterGrey		:== RGB {r=224,g=224,b=224}
rbBoardRed3			:== RGB {r=255,g=127,b=127}
rbBoardRed2			:== RGB {r=191,g=160,b=160}
rbBoardBlue3		:== RGB {r=127,g=127,b=255}
rbBoardBlue2		:== RGB {r=159,g=159,b=191}
rbSquare			:== RGB {r=255,g=255,b=191}
rbDarkYellow		:== RGB {r=127,g=127,b=0  }

displaywidth		:==	2+250+2
displayheight		:==	2+130+2
boardwidth			:==	391
boardheight			:==	391
squarewidth			::	Int
squarewidth			=:	boardwidth/15
squareheight		::	Int
squareheight		=:	boardheight/15

alphabet			:==	"abcdefghijklmnopqrstuvwxyz"


/*	Mapping 'Amanda-space' to 'Scrabble-space' to 'Pixel-space':
	Amanda-space	: ((-1.0,1.0),(1.0,-1.0))
	Scrabble-space	: ((0.0,0.0), (14.0,14.0))
	Pixel-space		: ((0,0), (width,height))
*/

abs2rel :: !(!Int,!Int) -> (!Int,!Int)
abs2rel (x,y) = (x/squarewidth,y/squareheight)


/*	The drawing operations.	*/

/*	The look of the board.
	It is assumed that the background is set to rbBoardGrey.
*/
boardlook :: !Board Point2 !SelectState !UpdateState !*Picture -> *Picture
boardlook (hor,_) cstate select updState=:{newFrame} picture
	# picture	= setPenColour	White picture
	# picture	= seq [ drawAt {x=squarewidth*i+1,y=0}  {zero & vy=h} \\ i<-is ] picture
	# picture	= seq [ drawAt {x=0,y=squareheight*i+1} {zero & vx=w} \\ i<-is ] picture
	# picture	= setPenColour DarkGrey picture
	# picture	= seq [ drawAt {x=squarewidth*i,y=1}  {zero & vy=h-1} \\ i<-is ] picture
	# picture	= seq [ drawAt {x=1,y=squareheight*i} {zero & vx=w-1} \\ i<-is ] picture
	# picture	= seq (map (drawsquare rbBoardBlue2) doubleletterpositions) picture
	# picture	= seq (map (drawsquare rbBoardBlue3) tripleletterpositions) picture
	# picture	= seq (map (drawsquare rbBoardRed2)  doublewordpositions)   picture
	# picture	= seq (map (drawsquare rbBoardRed3)  triplewordpositions)   picture
	# picture	= drawcenter picture
	# picture	= seq [ drawletter l (i,j) \\ i<-[0..14], j<-[0..14], l<-[(hor!!j)!!i] ] picture
	| enabled select
		= drawfocus True cstate picture
	| otherwise
		= picture
where
	{w,h}		= rectangleSize newFrame
	is			= [0..15]
	
	drawcenter :: *Picture -> *Picture
	drawcenter picture
		# picture	= drawsquare rbBoardGrey (7,7) picture
		# picture	= setPenColour Grey picture
		# picture	= fillAt (absposition (7.5,7.5)) {polygon_shape=shape} picture
		= picture
	where
		h		= (squarewidth-1)/2
		v		= (squareheight-1)/2
		shape	= [{zero & vy=0-v},{vx=h,vy=v},{vx=0-h,vy=v},{vx=0-h,vy=0-v},{vx=h,vy=0-v}]
	
	//	absposition maps a position in 'Scrabble-space' to a position in 'Pixel-space'.
		absposition :: !(!Real,!Real) -> Point2
		absposition (col,row)
			= {x=toInt (col*toReal squarewidth),y=toInt (row*toReal squareheight)}
	
	drawsquare :: !Colour !(!Int,!Int) !*Picture -> *Picture
	drawsquare colour (col,row) picture
		# picture	= setPenColour colour picture
		# picture	= fill {corner1={x=l,y=t},corner2={x=r,y=b}} picture
		= picture
	where
		l =  col    * squarewidth+2
		t =  row    * squareheight+2
		r = (col+1) * squarewidth
		b = (row+1) * squareheight

drawfocus :: !Bool !Point2 !*Picture -> *Picture
drawfocus notErase {x,y} picture
	# picture	= setPenColour	lefttopcolour                picture
	# picture	= setPenPos		{x=l,y=b}                    picture
	# picture	= draw			{vx=0,vy=0-(squareheight-1)} picture
	# picture	= draw			{vx=squarewidth-1,vy=0}      picture
	# picture	= setPenColour  rightbotcolour               picture
	# picture	= draw			{vx=0,vy=squareheight-1}     picture
	# picture	= draw			{vx=0-(squarewidth-1),vy=0}  picture
	= picture
where
	(col,row)						= abs2rel (x,y)
	l								= col*squarewidth+1
	b								= (row+1)*squareheight
	(lefttopcolour,rightbotcolour)	= if notErase (DarkGrey, White)
												  (White, DarkGrey)


drawletter :: !Char !(!Int,!Int) !*Picture -> *Picture
drawletter ' ' _ picture
	= picture
drawletter l (i,j) picture
	# ((_,sfont),picture)	= openFont smallfont picture
	# ((_,lfont),picture)	= openFont letterfont picture
	# (plen,picture)		= getFontStringWidth sfont scoretext										picture
	# picture				= setPenColour	rbSquare													picture
	# picture				= fill	{corner1={x=x+2,y=y+2},corner2={x=x+squarewidth,y=y+squareheight}}	picture
	# picture				= setPenPos		{x=x+2,y=y+squareheight-1}									picture
	# picture				= setPenColour	White														picture
	# picture				= drawLineTo	{x=x+2,y=y+2}												picture
	# picture				= drawLineTo	{x=x+squarewidth-1,y=y+2}									picture
	# picture				= setPenColour	Yellow														picture
	# picture				= drawLineTo	{x=x+squarewidth-1,y=y+squareheight-1}						picture
	# picture				= drawLineTo	{x=x+2,y=y+squareheight-1}									picture
	# picture				= setPenPos		{x=x+squarewidth/4,y=y+h-h/3}								picture
	# picture				= setPenFont	lfont														picture
	# picture				= setPenColour	Black														picture
	# picture				= draw			(toUpper l)													picture
	# picture				= setPenFont	sfont														picture
	# picture				= setPenColour	rbDarkYellow												picture
	# picture				= drawAt		{x=x+squarewidth-2-plen,y=y+h-3} scoretext					picture
	= picture
where
	x						= i*squarewidth
	y						= j*squareheight
	h						= squareheight
	scoretext				= toString (lettervalue l)


143
redrawboard :: !Id !Board Point2 !(IOSt .l) -> IOSt .l
Peter Achten's avatar
Peter Achten committed
144
redrawboard boardId board pos iostate
145
	= setControlLook boardId True (True,boardlook board pos) iostate
Peter Achten's avatar
Peter Achten committed
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194

/*	letterboxlook is the look of the set of remaining letters.
	It is assumed that it has the background colour rbBackground.
*/
letterboxlook :: ![Char] SelectState UpdateState !*Picture-> *Picture
letterboxlook letters _ {newFrame} picture
	# picture				= unfill newFrame picture
	# picture				= seq [ drawletter c (0,j) \\ (c,j)<-zip2 leftchars  js ] picture
	# picture				= seq [ drawletter c (2,j) \\ (c,j)<-zip2 rightchars js ] picture
	# ((_,lfont),picture)	= openFont letterfont picture
	# picture				= setPenFont   lfont  picture
	# picture				= setPenColour Black  picture
	# picture				= seq [ drawcount c (1,j) \\ (c,j)<-zip2 leftcounts  js ] picture
	# picture				= seq [ drawcount c (3,j) \\ (c,j)<-zip2 rightcounts js ] picture
	= picture
where
	js						= [0..14]
	counts					= countletters alphabet (sort letters)
	(left,right)			= splitAt 15 counts
	(leftchars, leftcounts)	= unzip left
	(rightchars,rightcounts)= unzip right
	
	drawcount :: !Int !(!Int,!Int) !*Picture -> *Picture
	drawcount count (i,j) picture
		= drawAt {x=x+squarewidth/4,y=y+h-h/3} (toString count) picture
	where
		x = i*squarewidth
		y = j*squareheight
		h = squareheight
	
	countletters :: !String ![Char] -> [(Char,Int)]
	countletters chars letters
		| chars==""
			= []
		| otherwise
			# c					= chars.[0]
			  (count,letters)	= countletter c letters
			= [(c,count):countletters (chars%(1,size chars-1)) letters]
	where
		countletter :: !Char ![Char] -> (Int,![Char])
		countletter c all_letters=:[letter:letters]
			| c<>letter
				= (0,all_letters)
			| otherwise
				# (count,letters)	= countletter c letters
				= (count+1,letters)
		countletter _ _
			= (0,[])

195
drawletterbox :: !Id ![Char] !(IOSt .l) -> IOSt .l
Peter Achten's avatar
Peter Achten committed
196
drawletterbox letterboxId letters iostate
197
	= setControlLook letterboxId True (True,letterboxlook letters) iostate
Peter Achten's avatar
Peter Achten committed
198

199
drawplayer1letters :: !Id ![Char] !(IOSt .l) -> IOSt .l
Peter Achten's avatar
Peter Achten committed
200
drawplayer1letters letters1Id letters iostate
201
	= setControlLook letters1Id True (True,playerletterslook letters) iostate
Peter Achten's avatar
Peter Achten committed
202

203
drawplayer2letters :: !Id ![Char] !(IOSt .l) -> IOSt .l
Peter Achten's avatar
Peter Achten committed
204
drawplayer2letters letters2Id letters iostate
205
	= setControlLook letters2Id True (True,playerletterslook letters) iostate
Peter Achten's avatar
Peter Achten committed
206
207

playerletterslook :: ![Char] SelectState UpdateState !*Picture -> *Picture
Peter Achten's avatar
Peter Achten committed
208
209
playerletterslook ws _ {newFrame} picture
	= seq [	drawletter c (i,0) \\ c<-ws & i<-[0..] ] (unfill newFrame picture)
Peter Achten's avatar
Peter Achten committed
210

211
drawplayer1score :: !Id !Int !(IOSt .l) -> IOSt .l
Peter Achten's avatar
Peter Achten committed
212
drawplayer1score player1scoreId s iostate
213
	= setControlText player1scoreId (toString s) iostate
Peter Achten's avatar
Peter Achten committed
214

215
drawplayer2score :: !Id !Int !(IOSt .l) -> IOSt .l
Peter Achten's avatar
Peter Achten committed
216
drawplayer2score player2scoreId s iostate
217
	= setControlText player2scoreId (toString s) iostate
Peter Achten's avatar
Peter Achten committed
218

219
drawcommunication :: !Id ![String] !(IOSt .l) -> IOSt .l
Peter Achten's avatar
Peter Achten committed
220
drawcommunication displayId text iostate
221
	= setControlLook displayId True (True,displaylook text) iostate
Peter Achten's avatar
Peter Achten committed
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236

displaylook :: ![String] SelectState !UpdateState !*Picture -> *Picture		// displaylook assumes PictureDomain
																			// {{-2,-2},{w+2,h+2}}
displaylook text _ {newFrame} picture
	# picture				= unfill       newFrame     picture
	# picture				= drawdisplay  size			picture
	# ((_,font12),picture)	= openFont     (font 12)	picture
	# picture				= setPenFont   font12		picture
	# picture				= setPenColour Red			picture
	# picture				= seq [ drawAt {x=2+w/20,y=2+h*y/10} l \\ (y,l)<-zip2 [2,4..] text ] picture
	= picture
where
	size					= rectangleSize newFrame
	{w,h}					= size

237
drawprogress :: !Id !Player !Progress !Placing !(IOSt .l) -> IOSt .l
Peter Achten's avatar
Peter Achten committed
238
drawprogress displayId player progress placing iostate
239
	= setControlLook displayId True (True,progresslook player progress placing {w=displaywidth,h=displayheight}) iostate
Peter Achten's avatar
Peter Achten committed
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
where
	progresslook :: !Player !Progress !Placing !Size SelectState UpdateState !*Picture -> *Picture
	progresslook player (Letter letter _) placing size=:{w,h} _ {newFrame} picture
		# picture				= unfill newFrame									picture
        # ((_,thefont),picture)	= openFont (font 12)								picture
		# (foundlength,picture)	= getFontStringWidth thefont found_upto_now			picture
		# (at_poslength,picture)= getFontStringWidth thefont at_pos					picture
		# (scorelength,picture)	= getFontStringWidth thefont score_upto_now			picture
		  rtabstop				= tekstindent+foundlength
		  atpos					= rtabstop - at_poslength
          scorepos				= rtabstop - scorelength
		# picture				= drawdisplay	size								picture
		# picture				= setPenFont	thefont								picture
		# picture				= setPenColour	Grey								picture
		# picture				= drawAt		letterspos alphabet					picture
		# picture				= setPenColour	Green								picture
		# picture				= drawAt		letterspos alphabet_l_incl			picture
		# picture				= setPenColour	Red									picture
		# picture				= drawAt		letterspos alphabet_l_excl			picture
		# picture				= setPenColour	Green								picture
		# picture				= drawAt		{x=tekstindent,y=toInt (0.15*h`)} (toString player+++determines_new_word) picture
		# picture				= setPenPos		{x=foundpos,   y=toInt (0.60*h`)}	picture
		# picture				= draw			found_upto_now						picture
		# picture				= movePenPos	{vx=10,vy=0}						picture
		# picture				= draw			placing.word						picture
		# picture				= setPenPos		{x=atpos,      y=toInt (0.75*h`)}	picture
		# picture				= draw			at_pos								picture
		# picture				= movePenPos	{vx=10,vy=0}						picture
		# picture				= draw			placingtext							picture
		# picture				= setPenPos		{x=scorepos,   y=toInt (0.90*h`)}	picture
		# picture				= draw			score_upto_now						picture
		# picture				= movePenPos	{vx=10,vy=0}						picture
		# picture				= draw			(toString placing.score)			picture
		= picture
	where
		(x,y)					= placing.pos
		foundpos				= tekstindent
		
		w`						= toReal w
		h`						= toReal h
		letterspos				= {x=tekstindent,y=toInt (0.35*h`)}
		tekstindent				= toInt (0.05*w`)
		
		alphabet_l_excl			= if (letter=='a') "" (alphabet%(0,l_index-1))
		alphabet_l_incl			= alphabet%(0,l_index)
		l_index					= toInt letter-a_index
		a_index					= toInt 'a'
		
		placingtext				= toString (x,y)+++" "+++toString placing.dir
	progresslook player (Finish _) placing {w,h} _ _ picture
		# picture				= setPenColour	Grey								picture
		# picture				= fill			{corner1=zero,corner2={x=w,y=h}}	picture
		# ((_,font12),picture)	= openFont		(font 12)							picture
		# picture				= setPenFont	font12								picture
		# picture				= setPenColour	Red									picture
		# picture				= drawAt		{x=toInt (0.05*w`),y=toInt (0.95*h`)} (toString player+++determined_new_word) picture
		= picture
	where
		w`						= toReal w
		h`						= toReal h

/*	drawdisplay draws the display. Note that in the 0.8 version, the domain was assumed to be {{-2,-2},{w+2,h+2}}.
	For this reason, at all coordinates {2,2} must be added.
*/
drawdisplay :: !Size !*Picture -> *Picture
drawdisplay {w,h} picture
	# picture	= setPenColour	Grey			picture
	# picture	= setPenPos		{x=1,  y=h-3}	picture
	# picture	= drawLineTo	{x=1,  y=1}		picture
	# picture	= drawLineTo	{x=w-2,y=1}		picture
	# picture	= setPenPos		{x=0,  y=h-2}	picture
	# picture	= drawLineTo	zero			picture
	# picture	= drawLineTo	{x=w-1,y=0}		picture
	# picture	= setPenColour	White			picture
	# picture	= setPenPos		{x=1,  y=h-2}	picture
	# picture	= drawLineTo	{x=w-2,y=h-2}	picture
	# picture	= drawLineTo	{x=w-2,y=0}		picture
	# picture	= setPenColour	rbLighterGrey	picture
	# picture	= setPenPos		{x=0,  y=h-1}	picture
	# picture	= drawLineTo	{x=w-1,y=h-1}	picture
	# picture	= drawLineTo	{x=w-1,y=0}		picture
	= picture