#!/bin/sh
# This line continues for Tcl, but is a single line for 'sh' \
exec wish "$0" ${1+"$@"}

proc msg {} {
  global msg tmpmsg

  set top .msg
  if { [winfo exists $top] } {
       wm deiconify $top
       raise $top
       focus -force $top
       bell -displayof $top
       return;
     }
  set tmpmsg $msg
  toplevel $top
  wm title $top "Enter Message"
  pack [set w [frame $top.f]] -padx 15
  pack [frame $w.top] -side top -expand 1 -fill both -pady 10
  pack [frame $w.btm] -side bottom -pady 10
  pack [frame $w.btm2] -side bottom -pady 5
  pack [label $w.top.l -text "* Enter a phrase: "] -side left
  pack [entry $w.top.e -textvariable tmpmsg -width 40] -side left
  pack [button $w.btm.ok -text "OK" -width 8 -default active -command [list msg2 $top]] -side left -padx 5
  pack [button $w.btm.cancel -text "Cancel" -command [list destroy $top] -width 7] -side left -padx 5
  pack [label $w.btm2.l -text "* Hint: Leave the message empty to\nuse the font's names instead!"] -side top
  wm resizable [winfo toplevel $w] 0 0

  bind $top <Return> [list $w.btm.ok invoke]

  raise $top
  focus $w.top.e

};# msg

proc msg2 {w} {
  global msg tmpmsg

  set name 0
  if { [string trim $tmpmsg] == "" } {
       set name 1
     }

  set msg $tmpmsg
  catch {destroy $w}
  tk_messageBox -icon info -type ok  -title "Font Sampler" \
                -message "Please note it may take a few moments for the list to refresh."
  .top.t config -state normal
  .top.t delete 1.0 end
  set i 0
  if { $name } {
       foreach x [lsort [font families]] {
                .top.t tag configure tag$i -font [list $x 20]
                .top.t insert end "$x" tag$i "      ($x)\n\n"
                incr i
               }

     } else {
       foreach x [lsort [font families]] {
                .top.t tag configure tag$i -font [list $x 20]
                .top.t insert end "$msg" tag$i "      ($x)\n\n"
                incr i
               }
     }
  .top.t config -state disabled

};# msg2

proc chk_exit {} {

  set ans [tk_messageBox -icon question -type yesno -message "Are you sure you want to exit?" -title "Font Sampler"]
  if { $ans != "no" } {
       exit;
     }

};# chk_exit

wm title . "Font Sampler"
wm protocol . WM_DELETE_WINDOW chk_exit
bind . <F1> {console show}
wm state . zoom
pack [frame .top] -side top -expand 1 -fill both
pack [frame .btm] -side top -fill x
pack [frame .button] -side top -fill x -anchor e -padx 45 -pady 10

pack [text .top.t -yscrollcommand ".top.s set" -xscrollcommand ".btm.s set" -borderwidth 2 \
           -font [list Arial 10] -wrap none -relief sunken -state disabled] \
           -side left -expand 1 -fill both -padx 4 -pady 2
pack [scrollbar .top.s -command ".top.t yview"] -side left -fill y
# .top.t insert end "\n\nPlease click 'Change text' and enter a message to begin!\n\n"
pack [scrollbar .btm.s -command ".top.t xview" -orient horizontal] -side left -fill x -expand 1
pack [frame .btm.f -width [winfo reqwidth .top.s]] -side left -fill none -expand 0


pack [label .button.l -text "Click 'Change Text' to see the fonts displaying a different message!" -width 120] -side left
pack [button .button.x -text "Quit" -width 8 -command chk_exit] -side right -padx 5
pack [button .button.msg -text "Change text..." -width 14 -default active -command msg] -side right -padx 5

set tmpmsg ""
msg2 .foo

set msg "The quick brown fox jumps over the lazy dog  0123456789 .,:+-()!?"