set release(simpleTops.tcl) {$Header: /home/cvs/TclTutor3/simpleTop.tcl,v 1.1.1.1 2007/09/15 13:30:24 clif Exp $}

namespace eval simpleTop {
  variable done
  variable unique 0
  variable coords

################################################################
# proc TopButtonPress {top x y}--
#    Button press handler for dragable frame
# Arguments
#   top		Toplevel frame name
#   x           Cursor location in application
#   y           Cursor location in application
# Results
#   Variables are updated.
# 
proc TopButtonPress {top x y {child {}} } {
  variable coords
     foreach [list w h coords($top,x1) coords($top,y1)] \
         [split [wm geometry $top] +x] {break}

     set coords($top,xo) $x
     set coords($top,yo) $y

}

################################################################
# proc TopButtonRelease {top x y}--
#    Button release handler for dragable frame
# Arguments
#   top		Toplevel frame name
#   x           Cursor location in application
#   y           Cursor location in application
# Results
#   Variables are updated.
# 
proc TopButtonRelease {top x y} {
  variable coords
   catch {
     unset coords($top,xo)
     unset coords($top,yo)
   }
}

################################################################
# proc buttonMotion {top X Y }--
#    Move the frame
# Arguments
#  top 		Name of Frame
#  X            Cursor location in screen coords.
#  Y            Cursor location in screen coords.
# 
# Results
#   Still, it moves.
# 
proc TopButtonMotion {top x y } {
  variable coords

  if {![info exists coords($top,xo)]} {return}

    wm geometry $top +[expr $coords($top,x1)+$x-$coords($top,xo)]+[expr $coords($top,y1)+$y-$coords($top,yo)]
}


proc bindRecursive {win top} {
  foreach w [winfo children $win] {

    set class [winfo class $w]

    if {[string first rame $class] > 0} {bindRecursive $w $top}
    if {([string first Label $class] < 0) &&
        ([string first rame  $class] < 0)} {continue}
    bind $w <ButtonPress-1> "[namespace current]::TopButtonPress $top %X %Y $w"
    bind $w <ButtonRelease-1> "[namespace current]::TopButtonRelease $top %x %y"
    bind $w <B1-Motion>    "[namespace current]::TopButtonMotion $top %X %Y"
  }
}

################################################################
# proc bindNPlaceToplevel {top}--
#    Make a non-window-managed toplevel draggable
# Arguments
#   top Name of toplevel
# 
# Results
#   Frame is placed in upper left corner of parent and made
#   draggable.
# 
proc bindNPlaceToplevel {top} {
  variable coords

  bind $top <ButtonPress-1> "[namespace current]::TopButtonPress $top %X %Y"
  bind $top <ButtonRelease-1> "[namespace current]::TopButtonRelease $top %x %y"
  bind $top <B1-Motion>    "[namespace current]::TopButtonMotion $top %X %Y"
  bind $top <Enter> "focus -force .; grab $top"
  bind $top <Leave> "grab release $top"

  bindRecursive $top $top
  
  if {![info exists coords($top,x1)]} {
    set parent [winfo parent $top]

    set ww [winfo reqwidth $top]
    set wh [winfo reqheight $top]

    set px [winfo rootx $parent]
    set py [winfo rooty $parent]
    set pw [winfo width $parent]
    set ph [winfo height $parent]
    set coords($top,x1) [expr {$px + ($pw - $ww) /2}]
    set coords($top,y1) [expr {$py + ($ph - $wh) /2}]
  }

  wm geometry $top "+$coords($top,x1)+$coords($top,y1)"
}

################################################################
# proc moveableToplevel {topName title}--
#    Makes a toplevel with no windowmanager controls.  It sets
#  a couple bindings to let it be dragged but not resized
# Arguments
#   topName	The new name for the toplevel.
#   title	A title for the frame within the toplevel
# 
# Results
#   Returns the name of the labelframe for adding more 'stuff'
# 
proc moveableToplevel {topName title} {
  set t [toplevel $topName]
  wm overrideredirect $t 1
  
  set f1 [frame $t.f1 -relief raised -borderwidth 4]
  set lf [labelframe $f1.lf -text $title]
  grid $f1 -sticky news
  grid $lf -sticky news
  
  after idle "[namespace current]::bindNPlaceToplevel $t"

  return $lf
}

################################################################
# proc createRadioButtonTop {topName title lblVarList}--
#    Creates a toplevel with a set of radio buttons assigned to
#    variables
# Arguments
#   topName	The new name for the toplevel.
#   title	A title for the frame within the toplevel
#   lblVarList	A set of labels and variables to associate with them
#               The variables will toggle on/off depending on button state
# Results
#   Modifies the array and returns.  If user cancels, orginal array values
#   are retained.

proc createRadioButtonTop {topName title lblVarList {unselProc simpleTop::unsel}} {
  variable done
  variable unique 0
  set done -1

  set len [llength $lblVarList]
  
  if {$len == 0} {return}
  
  set lf [moveableToplevel $topName $title ]
  
  set ht [expr {2 * int(sqrt($len))}]

  set row 0
  set col 0
  foreach {lbl varName} $lblVarList {
    set $varName 0
    lappend varNames $varName
    set w [checkbutton $lf.b[incr unique] -text $lbl -variable $varName \
          -onvalue 1 -offvalue 0]
    grid $w -row $row -column $col  -sticky w
    incr row
    if {$row > $ht} {
      set row 0;
      incr col
    }
  }
  set row $ht
  incr row
  set bf [frame $lf.bf]
  grid $bf -row $row -column 0 -columnspan [expr {1 + $col}] -sticky ew

  button $bf.done -text "Done" -command "set [namespace current]::done 1"
  button $bf.all -text "Select All" -command "foreach v {$varNames} {set \$v 1}"
  button $bf.unall -text "UnSelect All" -command "$unselProc {$varNames}"
  button $bf.cnc -text "Cancel" -command "set [namespace current]::done 0"
  pack $bf.done $bf.all $bf.unall $bf.cnc -side left
  
  vwait [namespace current]::done
  if {$done == 0} {
   foreach {lbl varName} $lblVarList {
    eval set $varName 0
   }
  }
  destroy $topName
  return $done
}

proc unsel {varNames} {
  foreach vn $varNames {
    upvar $vn v
    set v 0
  }
}
################################################################
# proc createEntryTop {topName title prompt varName}--
#    Create a frame to prompt for user input
# Arguments
#   topName 	Name of new toplevel
#   title 	Title for Frame
#   prompt 	Prompt to display
#   varName	Name of variable associated with entry widget
# 
# Results
#   New window is created.  Taks is paused until User selects
#   Done or Cancel
# 
proc createEntryTop {topName title lblVarList} {
  variable done
  variable unique 0

  set done -1
  
  set lf [moveableToplevel $topName $title ]

  set row 0
  set col1 0
  set col2 1
  foreach {prompt varName} $lblVarList {
    lappend varNames $varName
    set w [label $lf.l${row}_${col1} -text $prompt]
    grid $w -row $row -column $col1 -sticky e

    set w [entry $lf.e${row}_${col1} -textvar $varName]
    grid $w -row $row -column $col2

    incr row
    if {$row > 20} {
      set row 0; incr col1 2; incr col2 2
    }
  }
  set row 21
  set lbf [frame $lf.bf]

  grid $lbf -row $row -column 0 -columnspan [expr {$col2+1}]
  button $lbf.done -text "Done" -command "set [namespace current]::done 1"
  button $lbf.all -text "Clear All" -command "foreach v {$varNames} {set \$v {}}"
  button $lbf.cnc -text "Cancel" -command "set [namespace current]::done 0"
  grid $lbf.done -row $row -column 1 -sticky w
  grid $lbf.all -row $row -column 2 -sticky w
  grid $lbf.cnc -row $row -column 3 -sticky w
  bind $w <KeyPress-Return> "$lbf.done invoke"

  vwait [namespace current]::done
  if {$done == 0} {
    foreach vn $varNames {
      set $vn {}
    }
  }
  destroy $topName
  return $done
}

################################################################
# proc createEntryComboTop {topName title promptVarList comboDefList} --
#    Create a frame to prompt for user input
# Arguments
#   topName 	Name of new toplevel
#   title 	Title for Frame
#   prompt 	Prompt to display
#   varName	Name of variable associated with EntryCombo widget
# 
# Results
#   New window is created.  Taks is paused until User selects
#   Done or Cancel
# 
proc createEntryComboTop {topName title promptVarList comboDefList} {
  variable done
  variable unique

  set done -1

  set lf [moveableToplevel $topName $title ]

  set row 0
  set col 0

  set row 1
  
  foreach {prompt varName} $promptVarList {
    set w [label $lf.l[incr unique] -text $prompt]
    grid $w -row $row -column 1 -sticky w

    set w [entry $lf.e[incr unique] -textvar $varName]
    grid $w -row $row -column 2 -sticky w

    incr row
  }

  foreach {comboPrompt comboVar comboList} $comboDefList {
    set w [label $lf.l[incr unique] -text $comboPrompt]
    grid $w -row $row -column 1 -sticky w

    ::combobox::create $lf.cbox[incr unique] -variable $comboVar \
     -editable 0 -choices $comboList
    
    grid $lf.cbox$unique -row $row -column 2 -sticky w
    incr row
  }
  
  set lbf [frame $lf.bf]
  grid $lbf -row $row -column 1 -columnspan 3

  button $lbf.done -text "Done" -command "set [namespace current]::done 1"
  button $lbf.cnc -text "Cancel" -command "set [namespace current]::done 0"
  grid $lbf.done -row $row -column 1 -sticky w
  grid $lbf.cnc -row $row -column 2 -sticky w

  
  vwait [namespace current]::done
  if {$done == 0} {
    set $varName {}
  }
  destroy $topName
  return $done
}

################################################################
# proc createComboTop {topName title comboPrompt comboVar comboList}
#    Create a frame to prompt for user input
# Arguments
#   topName 	Name of new toplevel
#   title 	Title for Frame
#   prompt 	Prompt to display
#   varName	Name of variable associated with Combo widget
# 
# Results
#   New window is created.  Taks is paused until User selects
#   Done or Cancel
# 
proc createComboTop {topName title promptVarList comboPrompt comboVar comboList} {
  variable done
  variable unique

  set done -1

  set lf [moveableToplevel $topName $title ]

  set row 0
  set col 0

  set row 1

  set w [label $lf.l[incr unique] -text $comboPrompt]
  grid $w -row $row -column 1 -sticky w

  ::combobox::create $lf.cbox -variable $comboVar \
    -editable 0 -choices $comboList
    
  grid $lf.cbox -row $row -column 2 -sticky w

  incr row
  button $lf.done -text "Done" -command "set [namespace current]::done 1"
  button $lf.cnc -text "Cancel" -command "set [namespace current]::done 0"
  grid $lf.done -row $row -column 1 -sticky w
  grid $lf.cnc -row $row -column 2 -sticky w

  
  vwait [namespace current]::done
  if {$done == 0} {
    set $varName {}
  }
  destroy $topName
  return $done
}


}

if {[info exists argv] && ([string first -testTOP $argv] >= 0)} {
  source combobox.tcl
  update idle
  set t1 [simpleTop::moveableToplevel .t "Test Title"]
  set w [label $t1.l -text "Test label"]
  pack $w
  simpleTop::createRadioButtonTop .t22 "Test Label" \
      {one a(val1) two a(val2) three a(val3)}

  parray a

  simpleTop::createEntryTop .t33 EntryTest {"What is your name" name}
  puts "Hello, $name"

  simpleTop::createEntryComboTop .t33 ComboTest \
      {"What is your name" b(1) "What is your Quest" b(2)} \
      {"Select favorite color" b(3) "red blue yellow"}

  parray b  

  simpleTop::createEntryComboTop .t33 ComboTest \
      {"What is your name" b(1) "What is your Quest" b(2)} \
      {"Select favorite color" b(3) "red blue yellow" \
       "Select Load of swallow" b(4) "laden unladen coconut"}
  parray b  
  exit
}
