1# File: charflags-canvas.tcl
2
3# Purpose: the Character Flags canvas and related commands
4
5#
6# Copyright (c) 1997-2001 Tim Baker
7#
8# This software may be copied and distributed for educational, research, and
9# not for profit purposes provided that this copyright and statement are
10# included in all such copies.
11#
12
13namespace eval NSCharFlagsCanvas {
14
15	variable Priv
16
17# namespace eval NSCharFlagsCanvas
18}
19
20# NSCharFlagsCanvas::InitModule --
21#
22#	One-time-only-ever initialization.
23#
24# Arguments:
25#	arg1					about arg1
26#
27# Results:
28#	What happened.
29
30proc NSCharFlagsCanvas::InitModule {} {
31
32	variable Priv
33
34	NSModule::LoadIfNeeded NSBalloon
35
36	set Priv(slots) [list \
37		INVEN_WIELD \
38		INVEN_BOW \
39		INVEN_LEFT \
40		INVEN_RIGHT \
41		INVEN_NECK \
42		INVEN_LITE \
43		INVEN_BODY \
44		INVEN_OUTER \
45		INVEN_ARM \
46		INVEN_HEAD \
47		INVEN_HANDS \
48		INVEN_FEET \
49	]
50
51	set Priv(flags) [list \
52		STR \
53		INT \
54		WIS \
55		DEX \
56		CON \
57		CHR \
58		SUST_STR \
59		SUST_INT \
60		SUST_WIS \
61		SUST_DEX \
62		SUST_CON \
63		SUST_CHR \
64		IM_ACID \
65		IM_ELEC \
66		IM_FIRE \
67		IM_COLD \
68		RACE_IM_CUT \
69		RACE_IM_DARK \
70		RACE_IM_STUN \
71		RES_ACID \
72		RES_ELEC \
73		RES_FIRE \
74		RES_COLD \
75		RES_POIS \
76		RES_FEAR \
77		RES_LITE \
78		RES_DARK \
79		RES_BLIND \
80		RES_CONF \
81		RES_SOUND \
82		RES_SHARDS \
83		RES_NEXUS \
84		RES_NETHER \
85		RES_CHAOS \
86		RES_DISEN \
87		RACE_RES_SANITY \
88		SLOW_DIGEST \
89		FEATHER \
90		LITE \
91		REGEN \
92		TELEPATHY \
93		SEE_INVIS \
94		REFLECT \
95		FREE_ACT \
96		HOLD_LIFE \
97		RACE_EAT_NETHER \
98		STEALTH \
99		SEARCH \
100		INFRA \
101		TUNNEL \
102		SPEED \
103		BLOWS \
104		XTRA_SHOTS \
105		XTRA_MIGHT \
106		SLAY_ANIMAL \
107		SLAY_EVIL \
108		SLAY_UNDEAD \
109		SLAY_DEMON \
110		SLAY_ORC \
111		SLAY_TROLL \
112		SLAY_GIANT \
113		SLAY_DRAGON \
114		KILL_DRAGON \
115		BRAND_POIS \
116		BRAND_ACID \
117		BRAND_ELEC \
118		BRAND_FIRE \
119		BRAND_COLD \
120		SH_FIRE \
121		SH_ELEC \
122		VORPAL \
123		IMPACT \
124		CHAOTIC \
125		VAMPIRIC \
126		WRAITH \
127		NO_MAGIC \
128		TELEPORT \
129		NO_TELE \
130		AGGRAVATE \
131		DRAIN_EXP \
132		BLESSED \
133		CURSED \
134		HEAVY_CURSE \
135		PERMA_CURSE \
136		TY_CURSE \
137	]
138
139	set font [Global font,sys,large]
140	set lineHgt [font metrics $font -linespace]
141
142	set Priv(font,font) $font
143	set Priv(font,height) $lineHgt
144
145	return
146}
147
148# NSCharFlagsCanvas::NSCharFlagsCanvas --
149#
150#	Description.
151#
152# Arguments:
153#	arg1					about arg1
154#
155# Results:
156#	What happened.
157
158proc NSCharFlagsCanvas::NSCharFlagsCanvas {oop parent} {
159
160	variable Priv
161
162	set canvas $parent.header
163	set width 100
164	set height 40
165	canvas $canvas \
166		-scrollregion "0 0 $width $height" -width $width -height $height \
167		-relief flat -highlightthickness 0 -background gray40
168
169	Info $oop header,canvas $canvas
170
171	set lineHgt $Priv(font,height)
172
173	set canvas $parent.canvas
174	set width 100
175	set height [expr {$lineHgt * 22}]
176	canvas $canvas \
177		-scrollregion "0 0 $width [expr {($lineHgt + 3) * 32}]" \
178		-width $width -height $height -yscrollincrement [expr {$lineHgt + 3}] \
179		-highlightthickness 0 -background #000022 \
180		-yscrollcommand "$parent.yscroll set" \
181		-xscrollcommand "$parent.xscroll set"
182	scrollbar $parent.yscroll \
183		-orient vertical -command "$canvas yview"
184	scrollbar $parent.xscroll \
185		-orient horizontal -command "$canvas xview"
186
187	bind $canvas <Configure> \
188		"+NSCharFlagsCanvas::Configure $oop"
189	bind $canvas <Map> \
190		"+NSCharFlagsCanvas::Configure $oop"
191#	bind $parent.yscroll <Map> \
192#		"eval %W set \[$canvas yview]"
193	NSUtils::SynchScrollBar $canvas $parent.yscroll
194
195	Info $oop canvas $canvas
196	Info $oop frame $parent
197
198	# So it is drawn first
199	raise $parent.header
200
201	grid rowconfigure $parent 0 -weight 0
202	grid rowconfigure $parent 1 -weight 1
203	grid rowconfigure $parent 2 -weight 0
204	grid columnconfigure $parent 0 -weight 1
205	grid columnconfigure $parent 1 -weight 0
206
207	grid $parent.header \
208		-row 0 -column 0 -rowspan 1 -columnspan 2 -sticky ew
209	grid $parent.canvas \
210		-row 1 -column 0 -rowspan 1 -columnspan 1 -sticky news
211	grid $parent.yscroll \
212		-row 1 -column 1 -rowspan 1 -columnspan 1 -sticky ns
213	grid $parent.xscroll \
214		-row 2 -column 0 -rowspan 1 -columnspan 1 -sticky ew
215	grid remove $parent.yscroll
216	grid remove $parent.xscroll
217	Info $oop scrollbar,vert 0
218	Info $oop scrollbar,horz 0
219
220	NSUtils::DestroyObjectWithWidget NSCharFlagsCanvas $oop $canvas
221
222	InitLayout $oop
223
224	return
225}
226
227# NSCharFlagsCanvas::Info --
228#
229#	Query and modify info.
230#
231# Arguments:
232#	arg1					about arg1
233#
234# Results:
235#	What happened.
236
237proc NSCharFlagsCanvas::Info {oop info args} {
238
239	global NSCharFlagsCanvas
240
241	# Verify the object
242	NSObject::CheckObject NSCharFlagsCanvas $oop
243
244	# Set info
245	if {[llength $args]} {
246		switch -- $info {
247			default {
248				set NSCharFlagsCanvas($oop,$info) [lindex $args 0]
249			}
250		}
251
252	# Get info
253	} else {
254		switch -- $info {
255			default {
256				return $NSCharFlagsCanvas($oop,$info)
257			}
258		}
259	}
260
261	return
262}
263
264# NSCharFlagsCanvas::InitLayout --
265#
266#	Create all the canvas items.
267#
268# Arguments:
269#	arg1					about arg1
270#
271# Results:
272#	What happened.
273
274proc NSCharFlagsCanvas::InitLayout {oop} {
275
276	variable Priv
277
278	set canvas [Info $oop header,canvas]
279
280	# Calculate the width of the row labels
281	# Width = Text Width + 2 pixels + 2 * 3
282	set labelWidth 0
283	set labels {}
284	foreach flag $Priv(flags) {
285		set label $flag
286		set width [font measure $Priv(font,font) $label]
287		if {$width > $labelWidth} {
288			set labelWidth $width
289		}
290		lappend labels $label
291	}
292	incr labelWidth [expr {2 + (2 * 3)}]
293	if {$labelWidth < 100} {
294		set labelWidth 100
295	}
296
297	# Calculate the width of the canvas
298	set width [expr {$labelWidth + (32 + 2) * ([llength $Priv(slots)] + 1)}]
299	$canvas configure -width [expr {$width + 16}]
300
301if 0 {
302
303	# One icon per equipment slot
304	set x [expr {$labelWidth + 16}]
305	set y 20
306	foreach slot $Priv(slots) {
307		$canvas create widget $x $y -anchor center \
308			-tags $slot
309		$canvas bind $slot <Enter> \
310			"NSCharFlagsCanvas::StatusBar_Slot $oop $slot"
311		$canvas bind $slot <Leave> \
312			"\[NSCharFlagsCanvas::Info $oop statusBar] itemconfigure t1 -text {}"
313
314if 0 {
315		# Focus ring (really only one is needed)
316		set x2 [expr {$x - [icon size] / 2 - 2}]
317		set y2 [expr {$y - [icon size] / 2 - 2}]
318		$canvas create rectangle $x2 $y2 [expr {$x2 + [icon size] + 4}] \
319			[expr {$y2 + [icon size] + 4}] -outline Gray60 -fill "" \
320			-tags $slot,focus
321}
322
323		incr x [expr {32 + 2}]
324	}
325
326	# Character icon
327	$canvas create widget $x $y -anchor center -tags py
328	$canvas bind py <Leave> \
329		"\[NSCharFlagsCanvas::Info $oop statusBar] itemconfigure t1 -text {}"
330}
331	NSBalloon::Delay $canvas 10
332
333	set canvas [Info $oop canvas]
334	$canvas configure -width $width
335
336	set x 2 ; set y 0
337	foreach flag $Priv(flags) label $labels {
338
339		$canvas create rectangle $x $y [expr {$labelWidth - 2}] \
340			[expr {$y + $Priv(font,height) + 2}] -fill gray40 -tags $flag
341		$canvas create rectangle $labelWidth $y $width \
342			[expr {$y + $Priv(font,height) + 2}] -fill "" -outline "" \
343			-tags "rect $flag $flag,rect"
344		$canvas create text [expr {$labelWidth / 2}] [expr {$y + 1}] -anchor n \
345			-text $label -font $Priv(font,font) -fill White \
346			-tags [list $flag $flag,text text]
347
348		$canvas bind $flag <Enter> \
349			"%W itemconfigure $flag,rect -fill #333366 -outline #333366"
350		$canvas bind $flag <Leave> \
351			"%W itemconfigure $flag,rect -fill {} -outline {}"
352
353		# Dot for each slot
354		set x2 [expr {$labelWidth + 16}]
355		foreach slot $Priv(slots) {
356			$canvas create oval [expr {$x2 - 2}] [expr {$y + 9 - 2}] \
357				[expr {$x2 + 2}] [expr {$y + 9 + 2}] -fill "" -outline "" \
358				-tags "$flag,$slot $flag $flag,dot dot"
359			incr x2 34
360		}
361
362		# Dot for character
363		$canvas create oval [expr {$x2 - 2}] [expr {$y + 9 - 2}] \
364			[expr {$x2 + 2}] [expr {$y + 9 + 2}] -fill "" -outline "" \
365			-tags "$flag,py $flag $flag,dot dot"
366
367		incr y [expr {$Priv(font,height) + 3}]
368	}
369
370	return
371}
372
373# NSCharFlagsCanvas::SetInfo --
374#
375#	Set text of character-specific items.
376#
377# Arguments:
378#	arg1					about arg1
379#
380# Results:
381#	What happened.
382
383proc NSCharFlagsCanvas::SetInfo {oop} {
384
385	variable Priv
386
387	set header [Info $oop header,canvas]
388	set canvas [Info $oop canvas]
389
390	set rowHgt [expr {$Priv(font,height) + 3}]
391
392	$canvas itemconfigure dot -fill "" -outline ""
393	$canvas itemconfigure text -fill White
394	foreach flag $Priv(flags) {
395		set visible($flag) 0
396	}
397	set y [expr {$rowHgt * [llength $Priv(flags)]}]
398
399	foreach slot $Priv(slots) {
400		angband equipment info $slot attrib
401		if {$attrib(k_idx)} {
402			NSBalloon::Set_Canvas $header \
403				$slot "$attrib(char)\) $attrib(name)"
404		} else {
405			set attrib(icon) "icon none 0"
406			NSBalloon::Set_Canvas $header $slot ""
407		}
408		$header itemconfigure $slot -assign $attrib(icon)
409
410		foreach flag [angband equipment flags $slot] {
411			$canvas itemconfigure $flag,$slot -fill White -outline White
412			set visible($flag) 1
413		}
414	}
415
416	foreach flag [angband player flags] {
417		$canvas itemconfigure $flag,py -fill White -outline White
418		set visible($flag) 1
419	}
420	set desc "name, the race and class"
421	NSBalloon::Set_Canvas $header py $desc
422
423
424	foreach flag $Priv(flags) {
425		if {!$visible($flag)} {
426			$canvas itemconfigure $flag,text -fill gray60
427		}
428	}
429
430	$canvas configure -scrollregion [list 0 0 [winfo reqwidth $canvas] $y]
431	$canvas yview moveto 0
432
433	Configure $oop
434
435	# Hack -- Fix scroll glitch
436	set frame [Info $oop frame]
437	set scrollHgt $y
438	set winHgt [expr {[winfo height $frame] - [winfo y $canvas]}]
439	if {$winHgt % $rowHgt} {
440		incr scrollHgt [expr {$rowHgt - ($winHgt % $rowHgt) - 1}]
441		$canvas configure -scrollregion [list 0 0 [winfo reqwidth $canvas] $scrollHgt]
442	}
443
444	return
445}
446
447# NSCharFlagsCanvas::StatusBar_Slot --
448#
449#	Put the name of the item in the given slot in the status bar.
450#	Also displays item recall.
451#
452# Arguments:
453#	arg1					about arg1
454#
455# Results:
456#	What happened.
457
458proc NSCharFlagsCanvas::StatusBar_Slot {oop slot} {
459
460	angband equipment info $slot attrib
461	if {$attrib(k_idx)} {
462
463		# Show name in statusbar
464		[Info $oop statusBar] itemconfigure t1 -text $attrib(name)
465	}
466
467	return
468}
469
470
471# NSCharFlagsCanvas::Configure --
472#
473#	Description.
474#
475# Arguments:
476#	arg1					about arg1
477#
478# Results:
479#	What happened.
480
481proc NSCharFlagsCanvas::Configure {oop} {
482
483	set frame [Info $oop frame]
484	set canvas [Info $oop canvas]
485
486	set doVert 0
487	set doHorz 0
488	if {[string compare [$canvas yview] "0 1"]} {
489		set doVert 1
490	}
491	if {[string compare [$canvas xview] "0 1"]} {
492		set doHorz 1
493	}
494	if {$doVert != [Info $oop scrollbar,vert]} {
495		if {$doVert} {
496			grid $frame.yscroll
497		} else {
498			grid remove $frame.yscroll
499		}
500		Info $oop scrollbar,vert $doVert
501	}
502	if {$doHorz != [Info $oop scrollbar,horz]} {
503		if {$doHorz} {
504			grid $frame.xscroll
505		} else {
506			grid remove $frame.xscroll
507		}
508		Info $oop scrollbar,horz $doHorz
509	}
510
511	return
512}
513
514