#!
# Simplified font selection dialog for TkSTEP
#
# Copyright (c) 1996 by Alfredo Kojima
#


set tksFWeight(o) Oblique
set tksFWeight(i) Italic
set tksFWeight(r) Roman
set tksFWeight(Oblique) o
set tksFWeight(Italic)	i
set tksFWeight(Roman)	r

#
# Updates global font database
#
proc tksUpdateFontDB {} {
	global tksFontDB
	
#get font path
	set fp [exec /bin/sh -c "xset q | grep \"Font Path\" -A 1"]
#split to a list of paths	
	set fp [split [string trim [lindex [split $fp \n] 1]] ,]
#gets all fonts in each font dir
	set tksFontDB(idx) {}
	foreach dir "$fp" {
		set f [open $dir/fonts.dir]
		set entries [gets $f]
		for {set i 0} {$i < $entries} {incr i} {
		#list of font data
			set font [split [lrange [gets $f] 1 end] -]
			if {[llength $font]!=15 || [lindex $font 5]!="normal"}\
				continue
			set enc "[lindex $font 13]-[lindex $font 14]"
			set fam [lindex $font 2]
			set sty [lindex $font 3]
			set wei [lindex $font 4]			
			set siz [lindex $font 7]
			if {![info exists tksFontDB($enc)]} {
				lappend tksFontDB(idx) $enc
				set tksFontDB($enc) {} 
			}
			if {![info exists tksFontDB($enc,$fam)]} {
				lappend tksFontDB($enc) $fam
				set tksFontDB($enc,$fam) {} 
			}
			if {![info exists tksFontDB($enc,$fam,$sty)]} {
				lappend tksFontDB($enc,$fam) $sty
				set tksFontDB($enc,$fam,$sty) {} 
			}
			if {![info exists tksFontDB($enc,$fam,$sty,$wei)]} {
				lappend tksFontDB($enc,$fam,$sty) $wei
				set tksFontDB($enc,$fam,$sty,$wei) {} 
			}
			if {[lsearch -exact "$tksFontDB($enc,$fam,$sty,$wei)" \
				$siz] < 0} {
				lappend tksFontDB($enc,$fam,$sty,$wei) $siz 
			}
		}
		close $f
	}
}

#
# Displays a Font Selection Dialog
#
proc tksFontChooser {} {
	global tksFontDB tksSelection tksFOK

# Only one instance of this dialog may be active at any moment
	if {[winfo exists .tksFC]} {
		return
	}

	toplevel .tksFC
	.tksFC configure -width 425 -height 375
	wm title .tksFC "Font Chooser"
	wm protocol .tksFC WM_DELETE_WINDOW {set tksSelection {}}
	entry .tksFC.sample -bd 2 -relief sunken
	label .tksFC.lenc -text "Encoding" -fg white -bg gray30 -bd 2 \
		-relief sunken -font "-adobe-helvetica-bold-r-normal--12-120-75-75-p-70-iso8859-1"
	label .tksFC.lfam -text "Family" -fg white -bg gray30 -relief sunken \
		-bd 2 -font "-adobe-helvetica-bold-r-normal--12-120-75-75-p-70-iso8859-1"
	label .tksFC.ltpf -text "Typeface" -fg white -bg gray30 -relief sunken\
		-bd 2 -font "-adobe-helvetica-bold-r-normal--12-120-75-75-p-70-iso8859-1"
	label .tksFC.lsiz -text "Size" -fg white -bg gray30 -relief sunken \
		-bd 2 -font "-adobe-helvetica-bold-r-normal--12-120-75-75-p-70-iso8859-1"
	frame .tksFC.enc -bd 2 -relief sunken
	frame .tksFC.fam -bd 2 -relief sunken
	frame .tksFC.tpf -bd 2 -relief sunken
	frame .tksFC.siz -bd 2 -relief sunken
	listbox .tksFC.enc.lb -relief flat -yscrollcommand ".tksFC.enc.sb set"\
		-exportselection 0
	listbox .tksFC.fam.lb -relief flat -yscrollcommand ".tksFC.fam.sb set"\
		-exportselection 0
	listbox .tksFC.tpf.lb -relief flat -yscrollcommand ".tksFC.tpf.sb set"\
		-exportselection 0
	listbox .tksFC.siz.lb -relief flat -yscrollcommand ".tksFC.siz.sb set"\
		-exportselection 0
	scrollbar .tksFC.enc.sb -command ".tksFC.enc.lb yview"		
	scrollbar .tksFC.fam.sb -command ".tksFC.fam.lb yview"
	scrollbar .tksFC.tpf.sb -command ".tksFC.tpf.lb yview"
	scrollbar .tksFC.siz.sb -command ".tksFC.siz.lb yview"
	entry .tksFC.esiz -justify center -exportselection 0
#layout	
	.tksFC.sample insert 0 "Sample Text"
	place .tksFC.sample -x 10 -y 10 -width 404 -height 50
#encoding
	place .tksFC.lenc -x 10 -y 70 -width 98 -height 20
	place .tksFC.enc.sb -in .tksFC.enc -x -1 -y -1 -width 20 -height 173
	place .tksFC.enc.lb -in .tksFC.enc -x 20 -y 0 -width 75 -height 172
	place .tksFC.enc -x 10 -y 92 -width 98 -height 175
#family	
	place .tksFC.lfam -x 110 -y 70 -width 124 -height 20
	place .tksFC.fam.sb -in .tksFC.fam -x -1 -y -1 -width 20 -height 173
	place .tksFC.fam.lb -in .tksFC.fam -x 20 -y 0 -width 100 -height 172
	place .tksFC.fam -x 110 -y 92 -width 124 -height 175
#typeface
	place .tksFC.ltpf -x 236 -y 70 -width 122 -height 20
	place .tksFC.tpf.sb -in .tksFC.tpf -x -1 -y -1 -width 20 -height 173
	place .tksFC.tpf.lb -in .tksFC.tpf -x 20 -y 0 -width 98 -height 172
	place .tksFC.tpf -x 236 -y 92 -width 122 -height 175
#size	
	place .tksFC.lsiz -x 360 -y 70 -width 54 -height 20
	place .tksFC.esiz -x 360 -y 92 -width 54 -height 20
	place .tksFC.siz.sb -in .tksFC.siz -x -1 -y -1 -width 20 -height 151
	place .tksFC.siz.lb -in .tksFC.siz -x 20 -y 0 -width 30 -height 150
	place .tksFC.siz -x 360 -y 114 -width 54 -height 153
#display other stuff
	entry .tksFC.font -exportselection 0 
	checkbutton .tksFC.sel -text "Select" -variable select -command {
		.tksFC.font configure -exportselection $select }
	place .tksFC.font -x 10 -y 290 -width 334 -height 20
	place .tksFC.sel -x 350 -y 290

#buttons
	frame .tksFC.sep -bd 1 -relief sunken
	place .tksFC.sep -x 0 -y 330 -width 435 -height 2
	button .tksFC.preview -text Preview -command {tks_action preview}
	place .tksFC.preview -x 257 -y 340 -width 75 -height 25
	button .tksFC.setf -text Set -indicatoron 1 -command {
		global tksSelection
		set tmp [tks_action get]
		if {$tmp!={}} {set tksSelection $tmp}
	}
	place .tksFC.setf -x 340 -y 340 -width 75 -height 25
	button .tksFC.rebuild -text Rescan  -command {tksUpdateFontDB }
	place .tksFC.rebuild -x 174 -y 340 -width 75 -height 25
#build font DB if not already done
	if {![info exists tksFontDB(idx)] || [llength $tksFontDB(idx)]<=0} {
		label .tksFC.msg -text "Building font database..."
		place .tksFC.msg -x 10 -y 340 
		.tksFC configure -cursor watch
		update
		tksUpdateFontDB
		.tksFC configure -cursor {}
		destroy .tksFC.msg
	}
#aux procs
	#preview font
	proc tks_action {action} {
		global tksFontDB tksFWeight
		set fam [.tksFC.fam.lb get [.tksFC.fam.lb curselection]]
		set tpf [.tksFC.tpf.lb get [.tksFC.tpf.lb curselection]]
		set siz [.tksFC.esiz get]
		if {$siz!={}} {
			tks_usiz 1
		}
		set font [.tksFC.font get]		
		if {$action=="preview"} { 
			set text "$fam $tpf $siz.0 pt."
			.tksFC.sample configure -font $font
			.tksFC.sample delete 0 end
			.tksFC.sample insert 0 $text
		} else {
			return $font
		}
	}	
	#update size listbox
	proc tks_usiz {{lb 0}} {
		global tksFontDB tksFWeight
		set tmp [.tksFC.siz.lb curselection]
		set enc [.tksFC.enc.lb get [.tksFC.enc.lb curselection]]
		set fam [.tksFC.fam.lb get [.tksFC.fam.lb curselection]]
		set tpf [.tksFC.tpf.lb get [.tksFC.tpf.lb curselection]]
		set wei $tksFWeight([lindex $tpf 0])
		set sty [lindex $tpf 1]
		if {!$lb} {
			.tksFC.siz.lb delete 0 end
			foreach i [lsort -integer "$tksFontDB($enc,$fam,$sty,$wei)"] {
				.tksFC.siz.lb insert end $i
			}
			.tksFC.esiz delete 0 end
			if {$tmp!={}} {
				.tksFC.siz.lb selection set $tmp
				set siz [.tksFC.siz.lb get $tmp]
				.tksFC.esiz insert 0 $siz
				.tksFC.esiz selection range 0 end
			} else {
				.tksFC.siz.lb selection clear 0 end
				.tksFC.siz.lb selection set 0
				set siz [.tksFC.siz.lb get 0]
				.tksFC.esiz delete 0 end
				.tksFC.esiz insert 0 $siz
				.tksFC.esiz selection range 0 end
			}
		} else {
			set siz [.tksFC.esiz get]
		}
		.tksFC.font delete 0 end
		.tksFC.font insert 0 "-*-$fam-$sty-$wei-*-*-$siz-*-*-*-*-*-$enc"
		.tksFC.font selection range 0 end
		set cursel [.tksFC.siz.lb curselection]
		if {$cursel==""} return
		.tksFC.siz.lb see $cursel
	}
	#update typeface listbox
	proc tks_utpf {} {
		global tksFontDB tksFWeight
		
		set enc [.tksFC.enc.lb get [.tksFC.enc.lb curselection]]
		set fam [.tksFC.fam.lb get [.tksFC.fam.lb curselection]]
		.tksFC.tpf.lb delete 0 end
		foreach i "$tksFontDB($enc,$fam)" {
			foreach w "$tksFontDB($enc,$fam,$i)" {
				.tksFC.tpf.lb insert end "$tksFWeight($w) $i"
			}
		}
		.tksFC.siz.lb delete 0 end
		.tksFC.tpf.lb selection set 0
		tks_usiz		
	}
	#update family listbox
	proc tks_ufam {} {
		global tksFontDB

		set enc [.tksFC.enc.lb get [.tksFC.enc.lb curselection]]
		.tksFC.fam.lb delete 0 end
		foreach i "$tksFontDB($enc)" {
			.tksFC.fam.lb insert end $i
		}
		.tksFC.tpf.lb delete 0 end
		.tksFC.siz.lb delete 0 end
		
		.tksFC.fam.lb selection set 0
		tks_utpf
	}
	#handle drags
	proc tksfc_handledrag {} {
		set text [.tksFC.font get]
		if {$text=={}} return
		dnd_setdata Text $text
		dnd_handledrag
	}	
#bindings
	global DNDPos
	set DNDPos {}
	bind .tksFC.font <3> {set DNDPos 1}
	bind .tksFC.font <Drag> {if {$DNDPos==1} {tksfc_handledrag;set DNDPos {}}}
	bind .tksFC.enc.lb <ButtonRelease> {
		tks_ufam
	}	
	bind .tksFC.fam.lb <ButtonRelease> {
		tks_utpf 
	}
	bind .tksFC.tpf.lb <ButtonRelease> {
		tks_usiz
	}
	bind .tksFC.siz.lb <ButtonRelease> {
		tks_usiz
	}
	bind .tksFC.esiz <KeyRelease> {
		set size [.tksFC.esiz get]
		# don't know how to check if a string is a number...
		if {[catch {expr [expr $size]}]} {
			.tksFC.esiz delete 0 end
		} else {
			.tksFC.siz.lb selection clear 0 end
		}
	}
	bind .tksFC <Return> {
		if {[.tksFC.setf cget -indicatoron]} {
			.tksFC.setf configure -relief sunken
			update idletasks
			after 100
			.tksFC.setf configure -relief raised		
			.tksFC.setf invoke
		}
	}
	#ready to set font?
	set tksFOK 0
	bind .tksFC <FocusIn> {
		if  {$tksFOK} {
			.tksFC.setf configure -indicatoron 1
		}
	}
	bind .tksFC <FocusOut> {
		set tksFOK [.tksFC.setf cget -indicatoron]
		.tksFC.setf configure -indicatoron 0
	}
#update lists
	foreach i "$tksFontDB(idx)" {
		.tksFC.enc.lb insert end $i
	}
	.tksFC.enc.lb selection set 0
	tks_ufam
	
	tkwait variable tksSelection
	destroy .tksFC
	return $tksSelection	
}

