#!/usr/bin/env wish8.5
# Copyright (c) 2010, Patrick Sturm <siyb@geekosphere.org>
# All rights reserved.

# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions are met:
# 1. Redistributions of source code must retain the above copyright
#    notice, this list of conditions and the following disclaimer.
# 2. Redistributions in binary form must reproduce the above copyright
#    notice, this list of conditions and the following disclaimer in the
#    documentation and/or other materials provided with the distribution.
# 3. All advertising materials mentioning features or use of this software
#    must display the following acknowledgement:
#    This product includes software developed by geekosphere.org / geekosphere.
# 4. Neither the name geekosphere.org / geekosphere nor the
#    names of its contributors may be used to endorse or promote products
#    derived from this software without specific prior written permission.
#
# THIS SOFTWARE IS PROVIDED BY Patrick Sturm ''AS IS'' AND ANY
# EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
# WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
# DISCLAIMED. IN NO EVENT SHALL Patrick Sturm BE LIABLE FOR ANY
# DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
# (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
# LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
# ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
# (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
# SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

#
# Config
#

# set the text to be displayed here
set text "AaBbCcDdEeFfGgHhIiJjKkLlMmNnOoPpQqRrSsTtUuVvWwXxYyZz1234567890?"


#
# Code
#
set bold 0
set italic 0
set underline 0
set overstrike 0

set families [font families]
pack [frame .boxes] -side top -anchor w
pack [ttk::combobox .boxes.fonts -values $families -state readonly] -side left
for {set i 1} {$i <= 72} {incr i} { lappend slist $i }
pack [ttk::combobox .boxes.fontsizes -values $slist -state readonly] -side left 

# font modifier
pack [frame .buttons] -side top -anchor w
pack [ttk::button .buttons.bold -text "B" -command { toggleBold } -width 1] -side left
pack [ttk::button .buttons.italic -text "I" -command { toggleItalic } -width 1] -side left
pack [ttk::button .buttons.underline -text "U" -command { toggleUnderline } -width 1] -side left
pack [ttk::button .buttons.overstrike -text "O" -command { toggleOverstrike } -width 1] -side left

# configure default font
.boxes.fontsizes set 12
set defaultFont [lindex $families 0]
.boxes.fonts set $defaultFont
set fonts($defaultFont) [font create -family $defaultFont -size 12]

# display
pack [ttk::label .display -text $text] -anchor w
.display configure -font $fonts($defaultFont)

bind .boxes.fonts <<ComboboxSelected>> {
	setFont
}
bind .boxes.fontsizes <<ComboboxSelected>> {
	setSize
}

proc setFont {} {
	global fonts bold italic underline overstrike
	set font [.boxes.fonts get]
	set size [.boxes.fontsizes get]
	if {$bold} { set bolds "bold" } { set bolds "normal" }
	if {$italic} { set italics "italic" } { set italics "roman" }
	if {![info exists fonts($font)]} {
		set fonts($font) [font create -family $font -size $size -overstrike $overstrike -underline $underline -weight $bolds -slant $italics]
	} else {
		font configure $fonts($font) -overstrike $overstrike -underline $underline -weight $bolds -slant $italics
	}
	.display configure -font $fonts($font)
}

proc setSize {} {
	set size [.boxes.fontsizes get]
	set font [lindex [.display configure -font] end]
	font configure $font -size $size 
}

proc toggleBold {} {
	global bold
	set font [lindex [.display configure -font] end]
	if {[font configure $font -weight] eq "normal"} {
		font configure $font -weight bold
		set bold 1
	} else {
		font configure $font -weight normal
		set bold 0
	}
}

proc toggleItalic {} {
	global italic
	set font [lindex [.display configure -font] end]
	if {[font configure $font -slant] eq "roman"} {
		font configure $font -slant italic
		set italic 1
	} else {
		font configure $font -slant roman
		set italic 0
	}
}

proc toggleUnderline {} {
	global underline
	set font [lindex [.display configure -font] end]
	if {[font configure $font -underline]} {
		font configure $font -underline 0
		set underline 0
	} else {
		font configure $font -underline 1
		set underline 1
	}
}

proc toggleOverstrike {} {
	global overstrike
	set font [lindex [.display configure -font] end]
	if {[font configure $font -overstrike]} {
		font configure $font -overstrike 0
		set overstrike 0
	} else {
		font configure $font -overstrike 1
		set overstrike 1
	}
}