# Create/fill etc. forms

####################
# ScrolledLB --
#
#   Scrolled listbox widget, from
#   Brent Welch, "Practical Programming in Tcl/Tk"
#
proc ScrolledLB { parent args} {
    global param

    set sbg $param(color-frame-bg)
    frame $parent
    eval {listbox $parent.lb \
            -selectmode single \
            -yscrollcommand [list $parent.sy set] \
            -xscrollcommand [list $parent.sx set]} $args
    scrollbar $parent.sy \
            -orient vertical \
            -width 12 \
            -background $sbg \
            -activebackground $sbg \
            -command [list $parent.lb yview]
    frame $parent.bottom
    scrollbar $parent.sx  \
            -orient horizontal \
            -width 12 \
            -background $sbg \
            -activebackground $sbg \
            -command [list $parent.lb xview]
    set pad [expr [$parent.sy cget -width] + 2* \
            ([$parent.sy cget -bd] + \
            [$parent.sy cget -highlightthickness])]
    frame $parent.pad \
            -width $pad \
            -height $pad \
            -bg $sbg
    pack $parent.bottom -side bottom -fill x
    pack $parent.pad -in $parent.bottom -side right
    pack $parent.sx -in $parent.bottom -side bottom -fill x
    pack $parent.sy -side right -fill y
    pack $parent.lb -side left -fill both -expand true
    return $parent.lb
}

######################################################################

proc mod_listbox { parent idx } {
    global param

    if { [catch {$parent.lbframe configure}] } {
      set f1 $parent.lbframe
      set f2 [frame $parent.ctl \
                 -bg $param(color-frame-bg) ]
      set newval [named_entry $f2 0 Value]
      set lb [ScrolledLB $f1 -bg $param(color-text-bg) \
                             -fg $param(color-text-fg) ]
      $f1 configure -bg $param(color-frame-bg)
      bind $lb <Double-Button-1> { mod_listbox_edit newval.e %W }
      bind $lb <Button-2> { mod_listbox_edit newval.e %W }
      bind $lb <Button-3> { mod_listbox_edit newval.e %W }
      set param(newval.e) $newval.e
      set wid 10
      button $f2.add -text "Add" \
          -command [list mod_listbox_add $newval.e $lb] \
          -bg $param(color-button-bg) \
          -fg $param(color-button-fg) \
          -width $wid
      button $f2.delete -text "Delete" \
          -command [list mod_listbox_delete $lb] \
	  -bg $param(color-button-bg) \
          -fg $param(color-button-fg) \
          -width $wid
      button $f2.change -text "Change" \
          -command [list mod_listbox_change $newval.e $lb] \
  	  -bg $param(color-button-bg) \
          -fg $param(color-button-fg) \
          -width $wid
    } else {
      set f1 $parent.lbframe
      set f2 $parent.ctl
      set newval $f2.ne0
      $f1.lb delete 0 end
      $newval.e delete 0 end
    }
    pack $f2.add $f2.delete $f2.change $newval \
        -side top \
        -anchor w
    pack $f1 $f2 \
        -side left

     return
}

proc mod_listbox_add { valentry lb } {
     set e [$valentry get]
     if { $e != "" } {
         $lb insert end $e
     }
}

proc mod_listbox_delete { lb } {
     set sel [$lb curselection]
     foreach index $sel {
         $lb delete $index
     }
}

proc mod_listbox_change { valentry lb } {
    set e [$valentry get]
    set sel [$lb curselection]
    if { $e != "" && [llength $sel] == 1 } {
        set sel [lindex $sel 0]
        $lb delete $sel
        $lb insert $sel $e
    }
} 

proc mod_listbox_edit { valentryPtr lb } {
    global param

    set valentry $param($valentryPtr)
    set sel [$lb curselection]
    if { [llength $sel] == 1 } {
       set sel [lindex $sel 0]
       $valentry delete 0 end
       $valentry insert 0 [$lb get $sel]
    }
}

######################################################################

proc named_entry { path index name {val ""} } {
   global param

   if { [catch {$path.ne$index configure}] } {
      set f [frame $path.ne$index]
      eval { label $f.l -text "$name" } \
        -bg $param(color-frame-bg) \
        -fg $param(color-text-fg)
      eval { entry $f.e  } \
        -bg $param(color-text-bg) \
        -fg $param(color-text-fg)
   } else {
      set f $path.ne$index
      $f.l configure -text "$name"
      $f.e delete 0 end
   }
   $f.e insert 0 "$val"
   pack $f.l $f.e -side left -fill x -expand 1
   return $f
}

######################################################################

proc create_forms { } {
    global param

    foreach w {groupalias eventset option } {
        set parent  [ frame $param(form-frame).$w \
              -bg $param(color-frame-bg) ]
        set param(form,$w) $parent
        label $parent.title \
              -bg $param(color-frame-bg) \
              -fg $param(color-menu-fg) \
              -text $w
        switch $w {
            groupalias {
                set lb [ScrolledLB $parent.f1 \
                            -background $param(color-text-bg) \
                            -foreground $param(color-text-fg) ]
            }
            eventset {
                frame $parent.f1 \
                        -bg $param(color-frame-bg)
            }
            option {
                frame $parent.f1 \
                       -bg $param(color-frame-bg)
            }
        }
        pack $parent.title $parent.f1 \
              -side top \
               -fill both \
               -expand 1
        set f [frame $parent.formbuttons]
        eval { button $f.ok \
                   -command [list form_ok $w] \
                   -text "Apply" } $param(button-opts)
        eval { button $f.cancel \
                   -command [list form_cancel $w] \
                   -text "Cancel" } $param(button-opts)
        eval { button $f.explain \
                   -command [list form_explain $w] \
                   -text "Help" } $param(button-opts)
        pack $f.ok $f.cancel $f.explain -side left \
            -fill x \
            -expand 1
        pack $f -side bottom -fill x -expand 1
    }
}

######################################################################

proc show_form { type name statePtr } {
    global param

    if { [info exists param(form,current)] } {
        pack forget $param(form,current)
    }
    pack $param(form,$type) \
        -fill both \
        -expand 1
    set param(form,current) $param(form,$type)
    fill_in_form $statePtr
    update idletasks
}

######################################################################

proc fill_in_form { statePtr } {
    global param

    set w $param(form,current)
    switch -glob $w {
        *groupalias {
            $w.f1.lb delete 0 end
            foreach alias [set $statePtr] {
                $w.f1.lb insert end "$alias"
            }
        }
        *option {
           set plist [split $statePtr ","]
           set otype [string trimright [lindex $plist 3] ")"]
           clear_option $w
           $param(form,current).title configure -text $otype
           ${otype}_form $w $statePtr
        }
    }
}  

######################################################################

proc clear_option { w } {
   global param

   if { [info exists param(form,current,numfields)] } {
      if { $param(form,current,numfields) > 0 } {
         for { set i 0 } { $i < $param(form,current,numfields) } { incr i } { 
           pack forget $w.ne$i
         }
      } else {
         pack forget $w.lbframe $w.ctl
      }
   }
}

######################################################################
#
# Annotate, group, and id forms are almost identical.
# Therefore the same procedure works for all three.
#

proc annotate_form { w statePtr } { listbox_form $w $statePtr }
proc group_form { w statePtr } { listbox_form $w $statePtr }
proc id_form { w statePtr } { listbox_form $w $statePtr }
proc events_form { w statePtr } { listbox_form $w $statePtr }

proc listbox_form { w statePtr } { 
   global param

   set s [set $statePtr]
   fill_listbox_form $w $s

   set param(form,current,numfields) 0
   $w.formbuttons.ok configure -command [list form_ok listbox $w 0 $statePtr]
   $w.formbuttons.cancel configure -command [list fill_listbox_form $w $s] 
}

proc fill_listbox_form { w state } {
    mod_listbox $w 0
    foreach item $state {
      $w.lbframe.lb insert end $item
    }
}

######################################################################
#
# Forms with named entries are different enough that they get
# separate procedures.
#


proc val_form { w statePtr } { 
   global param

   set s [set $statePtr]
   fill_val_form $w $s

   foreach i { 0 1 2 } {
      pack $w.ne$i -side top -fill x -expand 1 
   }
   set param(form,current,numfields) 3
   $w.formbuttons.ok configure -command [list form_ok val $w 3 $statePtr]
   $w.formbuttons.cancel configure -command [list fill_val_form $w $s] 
}

proc fill_val_form { w s } {

   named_entry $w 0 "field" [lindex $s 0]
   named_entry $w 1 "min" [lindex $s 1]  
   named_entry $w 2 "max" [lindex $s 2]  
}

######################################################################

proc rotateclients_form { w statePtr } { scalar_form $w $statePtr }

proc scalar_form { w statePtr } { 
   global param

   set s [set $statePtr]
   fill_scalar_form $w $s

   pack $w.ne0 -side top -fill x -expand 1 

   set param(form,current,numfields) 1
   $w.formbuttons.ok configure -command [list form_ok scalar $w 1 $statePtr]
   $w.formbuttons.cancel configure -command [list fill_scalar_form $w $s] 
}

proc fill_scalar_form { w s } {

   named_entry $w 0 "value" $s
}

######################################################################

proc type_form { w statePtr } { 
   global param

   set s [set $statePtr]
   fill_type_form $w $s

   foreach i { 0 } {
      pack $w.ne$i -side top -fill x -expand 1 
   }
   set param(form,current,numfields) 1
   $w.formbuttons.ok configure -command [list form_ok type $w 1 $statePtr]
   $w.formbuttons.cancel configure -command [list fill_type_form $w $s] 
}

proc fill_type_form { w s } {
   named_entry $w 0 "type" [lindex $s 0]
}

######################################################################

proc form_ok { opt frm num statePtr } {
   global param

   switch $opt { 
        # Named label forms
        type
              -
        val {
              set v {}
              for { set i 0 } { $i < $num } { incr i } {
                 lappend v [$frm.ne$i.e get]
              }
              puts "set $statePtr = $v"
              set $statePtr $v
        }
        scalar {
              set $statePtr [$frm.ne0.e get]
        }
        # Listboxes
        listbox {
                 set lb $frm.lbframe.lb 
                 set $statePtr [$lb get 0 end]
        }
    }
}

######################################################################

proc form_cancel { w } {
    global param

    
    return
}

