# This contains routines for the H viewer that deal with fonts.

global basefont FF opt

set basefont $opt(BASEFONT)

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# Determine the font name for a widget.  If it isn't in the global Font table,
# we use our default font name.

proc FontName w {
	global V me Font Tfont
	if [info exists Font($w)] {sset f $Font($w)}
	if [catch {$w config -font} f] {
		set f $Tfont
	}
	if {$V>2} {puts "FontName: $w is {$f}"}
	return [lindex $f end]
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #

proc tagTT {t a} {
	global V me 
	if {$V>1} {puts "$me/tagTT: t=\"$t\" a={$a}"}
	incT TT
	PushFont {} f r m
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #

proc endTT {} {
	global V me in
	if {$V>1} {puts "$me/endTT: in(TT)=$in(TT)."}
	if {$in(TT)} {decT TT; PopFont}
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
#proc dec0 v {
#	set x [uplevel 1 "incr $v -1"]
#	if {$x < 0} {uplevel "set $v 0"}
#}
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# Font initialization:

array set FF {
	foundry	adobe
	fmlyf	Courier
	fmlyv	Helvetica
	wghtm	normal
	wghtb	bold
	slntr	roman
	slnti	italic
	size1	6
	size2	8
	size3	10
	size4	12
	size5	14
	size6	16
	size7	18
}
proc FontInit {} {
	global V me basefont FF gotfont
	global FontFoundry FontFamily FontHeight
	set FontFoundry $FF(foundry)
	set FontFamily  $FF(fmlyv)
	set FontHeight  $FF(size3)
	if {$V>1} {puts "$me/FontInit: Font Foundry=$FontFoundry Family=$FontFamily Height=$FontHeight."}
	set Fdsc "-family $FF(fmlyv) -weight $FF(wghtm) -slant $FF(slntr) -size $FF(size3)"
	eval font create F3vrm $Fdsc; set gotfont(3vrm) 1
	set Fdsc "-family $FF(fmlyv) -weight $FF(wghtb) -slant $FF(slntr) -size $FF(size3)"
	eval font create F3vrb $Fdsc; set gotfont(3vrb) 1
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# Get the list of fonts from the system.
proc FontList {} {
	global V me FontFoundries FontFamilies
	set cmd "xlsfonts"
	if [catch {open "| $cmd"} fd] {
		Msg "Can't run \"$cmd\" ($fd)"
		return
	}
	fileevent $fd readable "FontRdr $fd"
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
proc FontRdr fd {
	global V me FontFoundries FontFamilies
	if {[gets $fd line] < 0} {
		if {$V>2} {puts "$me/FontRdr: End of font list"}
		close $fd
		return
	}
	if {$V>2} {puts "$me/FontRdr: Font: $line"}
	set list [split $line -]
	if {[llength $list] > 2} {
		set fndry [lindex $list 1]
		set famly [lindex $list 2]
		if {$V>2} {puts "$me/FontRdr: Font: foundry=\"$fndry\" family=\"$famly\""}
		set FontFoundries($fndry) 1
		set FontFamilies($famly) 1
	} else {
		if {$V>2} {puts "$me/FontRdr: Drop: $line"}
	}
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
proc tagDefs w {
	global V me C ts 
	$w tag config F3vsr -font F3vsr
	$w tag config F3vsb -font F3vsb
	$w tag config Lnorm -foreground $C(fg) -background $C(bg) -underline 0
	$w tag config Llink -foreground $C(hl) -background $C(bg) -underline 1
	$w tag config Lname -foreground $C(nm) -background $C(bg) -underline 1
	$w tag config Mtab0 -lmargin1 0m -lmargin2 0 -tabs $ts
	$w tag config HR -font {fixed -4} -borderwidth 2 -relief raised -background $C(fg)
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
proc tagFONT {w T a} {
	global V me in Fsize Fspce Fslnt Fwght
	set l $in(FONT)
	incT FONT
	set size {}; set Fsize($l$w) $Fsize($w)
	set spce {}; set Fspce($l$w) $Fspce($w)
	set slnt {}; set Fslnt($l$w) $Fslnt($w)
	set wght {}; set Fwght($l$w) $Fwght($w)
	if [regexp -nocase {size="*([-+]*)([0-9]+)} $a {} sgn siz] {
		if {$V>2} {puts "$me/tagFONT: SIZE '$sgn' '$siz'"}
		if {$sgn == {-}} {
			set size [expr $Fsize($l$w)-$siz]
			if {$V>2} {puts "$me/tagFONT: SIZE decr from $Fsize($l$w) by $siz to $size."}
		} elseif {$sgn == {+}} {
			set size [expr $Fsize($l$w)+$siz]
			if {$V>2} {puts "$me/tagFONT: SIZE incr from $Fsize($l$w) by $siz to $size."}
		} else {
			set size $siz
			if {$V>2} {puts "$me/tagFONT: SIZE set from $Fsize($l$w) to $size"}
		}
		if {$size < 1} {set size 1} elseif {$size > 7} {set size 7}
		if {$V>2} {puts "$me/tagFONT: SIZE is '$size'"}
	}
	PushFont $size $spce $slnt $wght
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
proc endFONT {w T a} {global in; if {$in(FONT)} {PopFont}}