#!@WISH@

###################################################################
# QuFontSelecter v.05
# 
# This program co-exists with QuEdit, and is under the same license
# As QuEdit and QuIRC. If any problems are found, email me at 
# axe@crown.net or axe@killinghand.org
#
# This program can be used outside of QuEdit, as it's in no way
# dependant on any input from QuEdit to operate properly.
#
# QuEdit's homepage is at: www.crown.net/~axe/quedit
#
# Build 200010070
###################################################################
wm title . "QuFont Selector"
wm geometry . 612x175

#### Set some beginner variables, just to make a complete font name. ####
set ::foundry "-*"
set ::fontfamily "*"
set ::weight "*"
set ::slant "*"
set ::widthname "*"
set ::style "-*"
set ::pixel "*"
set ::point "-*"
set ::dpix "*"
set ::dpiy "*"
set ::space "-*"
set ::awidth "-*"
set ::regis "-*"
set ::currentfont "-*-*-*-*-*-*-*-*-*-*-*-*-*"
set ::families [font families]

#### If there is a command line font set, let's use it.  If not, we'll set a nice default. ####

if { $argc > 1 } { 
	puts "--QuFontSelector only takes a single command line arguement--" ; exit 
} elseif { $argv != "" } { 
	set ::fontdisplay $argv
} elseif { $argv == "" } {
	set ::fontdisplay "-adobe-courier-bold-r-normal-sans-0-0-0-0-m-0-iso8859-1" 
}

#### Okay, now that we've done that, let's setup the frames and whatnot. ####

frame .top 
frame .middle -relief groove -border 2
frame .bottom 
label .top.fon1 -text "Font Family "
label .top.wei1 -text "Weight "
label .top.sla1 -text "Slant "
label .top.wid1 -text "Width "
label .top.pix1 -text "Pixel size "
label .top.dpi1 -text "DPI-X "
label .top.dpy1 -text "DPI-Y"
button .top.fon -text $::fontfamily -command { proc_fontfamily } -relief flat
button .top.wei -text $::weight -command { proc_weight } -relief flat
button .top.sla -text $::slant -command { proc_slant } -relief flat
button .top.wid -text $::widthname -command { proc_widthname } -relief flat
button .top.pix -text $::pixel -command { proc_pixel } -relief flat
button .top.dpi -text $::dpix -command { proc_dpix } -relief flat
button .top.dpy -text $::dpiy -command { proc_dpiy } -relief flat
label .middle.tex -text "Origional font:" 
label .middle.exa -text "abcdefghijklmnopqrstuvwxyz ABCDEFGHIJKLMNOPQRSTUVWXYZ" -font $::fontdisplay -relief sunken
label .middle.cur -text "New font:"
label .middle.exm -text "abcdefghijklmnopqrstuvwxyz ABCDEFGHIJKLMNOPQRSTUVWXYZ" -font "$::currentfont" -relief sunken
button .bottom.use -text "OK" -command { puts $::currentfont ; exit }
button .bottom.exi -text "Cancel" -command { puts $::fontdisplay ; exit }

#### Great, now let's grid and pack those three sections. ####

grid .top.fon1 -column 1 -row 1
grid .top.wei1 -column 2 -row 1
grid .top.sla1 -column 3 -row 1
grid .top.wid1 -column 4 -row 1
grid .top.pix1 -column 5 -row 1
grid .top.dpi1 -column 6 -row 1
grid .top.dpy1 -column 7 -row 1
grid .top.fon -column 1 -row 2
grid .top.wei -column 2 -row 2
grid .top.sla -column 3 -row 2
grid .top.wid -column 4 -row 2
grid .top.pix -column 5 -row 2
grid .top.dpi -column 6 -row 2
grid .top.dpy -column 7 -row 2
pack .top
pack .middle.tex
pack .middle.exa -fill x
pack .middle.cur
pack .middle.exm -fill x
pack .middle -fill x
pack .bottom.use .bottom.exi -side left
pack .bottom -side bottom

#### Processes for the submenu displays ####

proc proc_fontfamily { } {
	set hei 10
        toplevel .c
        frame .c.1 -relief raised -bd 2
		canvas .c.1.canvas -width 130 -height 200 -yscrollcommand ".c.1.scroll set"
		scrollbar .c.1.scroll -command ".c.1.canvas yview"
        set x [ winfo rootx .top.fon ]
        set y [ winfo rooty .top.fon ]
        set y [ expr $y + [ winfo height .top.fon ] ]
        wm overrideredirect .c 1
        wm geometry .c "+$x+$y"
	grab .c
        foreach ::tem $::families {
                radiobutton .c.1.canvas.$::tem -text $::tem -variable ::fontfamily -relief flat -value $::tem -command { proc_closeing .top.fon $::fontfamily }
		.c.1.canvas create window 0 $hei -window .c.1.canvas.$::tem -anchor w
                incr hei 18
        }
	pack .c.1.scroll -side right -fill y
	pack .c.1.canvas -side right -expand 1
	pack .c.1
	.c.1.canvas configure -scrollregion "0 0 500 $hei"
}

proc proc_weight { } {
        toplevel .c
	frame .c.1 -relief raised -bd 2
        set x [ winfo rootx .top.wei ]
        set y [ winfo rooty .top.wei ]
        set y [ expr $y + [ winfo height .top.wei ] ]
        wm overrideredirect .c 1
        wm geometry .c "+$x+$y"	
	grab .c
        foreach ::tem { bold medium regular } {
                radiobutton .c.1.$::tem -text $::tem -variable ::weight -relief flat -value $::tem
                pack .c.1.$::tem -anchor w
        }
	pack .c.1
        bind .c <ButtonRelease-1> { proc_closeing .top.wei $::weight }
}

proc proc_slant { } {
        toplevel .c
        frame .c.1 -relief raised -bd 2
        set x [ winfo rootx .top.sla ]
        set y [ winfo rooty .top.sla ]
        set y [ expr $y + [ winfo height .top.sla ] ]
        wm overrideredirect .c 1
        wm geometry .c "+$x+$y"
	grab .c
        foreach ::tem { i r o } {
                radiobutton .c.1.$::tem -text $::tem -variable ::slant -relief flat -value $::tem
                pack .c.1.$::tem -anchor w
        }
	pack .c.1
        bind .c <ButtonRelease-1> { proc_closeing .top.sla $::slant }
}

proc proc_widthname { } {
	toplevel .c
        frame .c.1 -relief raised -bd 2
	set x [ winfo rootx .top.wid ]
	set y [ winfo rooty .top.wid ]
	set y [ expr $y + [ winfo height .top.wid ] ]
	wm overrideredirect .c 1
	wm geometry .c "+$x+$y"
	grab .c
	foreach ::tem { normal condensed semicondensed } {
		radiobutton .c.1.$::tem -text $::tem -variable ::widthname -relief flat -value $::tem
		pack .c.1.$::tem -anchor w
	}
	pack .c.1
	bind .c <ButtonRelease-1> { proc_closeing .top.wid $::widthname }
}

proc proc_pixel { } {
        toplevel .c
        frame .c.1 -relief raised -bd 2
        set x [ winfo rootx .top.pix ]
        set y [ winfo rooty .top.pix ]
        set y [ expr $y + [ winfo height .top.pix ] ]
        wm overrideredirect .c 1
        wm geometry .c "+$x+$y"
        grab .c
        foreach ::tem { 8 10 12 14 16 } {
                radiobutton .c.1.$::tem -text $::tem -variable ::pixel -relief flat -value $::tem
                pack .c.1.$::tem -anchor w
        }
	pack .c.1
        bind .c <ButtonRelease-1> { proc_closeing .top.pix $::pixel }
}

proc proc_dpix { } {
        toplevel .c
        frame .c.1 -relief raised -bd 2
        set x [ winfo rootx .top.dpi ]
        set y [ winfo rooty .top.dpi ]
        set y [ expr $y + [ winfo height .top.dpi ] ]
        wm overrideredirect .c 1
        wm geometry .c "+$x+$y"
        grab .c
        foreach ::tem { 75 100 } {
                radiobutton .c.1.$::tem -text $::tem -variable ::dpix -relief flat -value $::tem
                pack .c.1.$::tem -anchor w
        }
	pack .c.1
        bind .c <ButtonRelease-1> { proc_closeing .top.dpi $::dpix }
}

proc proc_dpiy { } {
        toplevel .c
        frame .c.1 -relief raised -bd 2
        set x [ winfo rootx .top.dpy ]
        set y [ winfo rooty .top.dpy ]
        set y [ expr $y + [ winfo height .top.dpy ] ]
        wm overrideredirect .c 1
        wm geometry .c "+$x+$y"
        grab .c
        foreach ::tem { 75 100 } {
                radiobutton .c.1.$::tem -text $::tem -variable ::dpiy -relief flat -value $::tem 
                pack .c.1.$::tem -anchor w
        }
	pack .c.1
        bind .c <ButtonRelease-1> { proc_closeing .top.dpy $::dpiy }
}

#### Processes for post-selection of the fonts  ####

proc proc_fontredo { } {
        set ::currentfont "$::foundry-$::fontfamily-$::weight-$::slant-$::widthname$::style-$::pixel$::point-$::dpix-$::dpiy$::space$::awidth$::regis"
        .middle.exm configure -font $::currentfont
}

proc proc_closeing { frame variable } {
        set $variable $::tem
        $frame configure -text $variable
	destroy .c
        proc_fontredo
}

# EOF