#!../wafe --f
# demo script to demonstrate usage of HTML forms from wafe (Athena only)
# Gustaf Neumann                      Sun Oct 31 23:23:18 GMT 1993

mergeResources topLevel \
  *background gainsboro \
  *HTML*Toggle*borderWidth 1 \
  *HTML*Text*background gray95 \
  *HTML*Text*displayCaret false

#create the "Command center"
Form f topLevel

  Command t1 f \
    label "Form 1" \
    callback {doForm 1}
  Command t2 f \
    label "Form 2" \
    fromHoriz t1 \
    callback {doForm 2}
  Command quit f \
    fromHoriz t2 \
    callback quit
realize

# create a HTML form with the given number and pop it up
proc doForm {nr} {
  global form
  set shell s$nr
  if ![isWidget $shell] {
    mergeResources topLevel \
      *$shell.f$nr.HTML*Text*translations "#override\n\
               <Key>Return: no-op() \n\
               <Btn1Down>,<Btn1Up>:  exec(gotoField $nr %W)\n\
               <Key>Tab:      exec(nextField $nr +1)\n\
               Shift<Key>Tab: exec(nextField $nr -1)" \
      *$shell.f$nr.HTML*Toggle.translations "#replace\n\
               <Key>space:    toggle() notify()\n\
               <Key>Return:   toggle() notify()\n\
               Shift<Key>Tab: exec(nextField $nr -1)\n\
               <Key>Tab:      exec(nextField $nr +1)\n\
               <Btn1Down>:    exec(gotoField $nr %W)"
      
    TransientShell $shell topLevel
    callback $shell popupCallback position \
      f:[expr ($nr-1)*50]/[expr 30+($nr-1)*20]
    Form f$nr $shell
    HTML h$nr f$nr \
      width 300 height 350 \
      text $form($nr) \
      submitFormCallback { submit "%h" "%n" "%v" }

    Command dismiss$nr f$nr \
      label Dismiss \
      callback "popdown $shell; destroyWidget $shell" \
      fromVert h$nr
    Command entries$nr f$nr \
      label Entries \
      callback "showEntries h$nr $nr" \
      fromVert h$nr fromHoriz dismiss$nr
    Command next$nr f$nr \
      label Next \
      callback "showRecord $nr +" \
      fromVert h$nr fromHoriz entries$nr
    Command prev$nr f$nr \
      label Previous \
      callback "showRecord $nr -" \
      fromVert h$nr fromHoriz next$nr
    showRecord $nr 1
    turnOn $nr 0
  }
  popup $shell none
}

# submit should be used to enter data into a database or simliar issuis
proc submit {href names values} {
  puts stderr "the Form is submitted:"
  puts stderr "    action = <$href>"
  puts stderr "    names  = <$names>"
  puts stderr "    values = <$values>"
} 

# show entries shows how to access the items in the Form without
# using submit; note that the way how $children is computed here
# will be wrong in case a Scrollbar is added
proc showEntries {html nr} {
  set children [gV $html.View children]
  puts stderr "the names of the entry fields of form $nr are $children"
  foreach widgetId $children {
    if [string compare "" [widgetName $widgetId]] {
      case [getClass $widgetId] {
	"Text"   {set value [gV $widgetId string]}
	"Toggle" {set value [expr {[gV $widgetId state]=={true}?{on}:{off}}]}
      }
      puts stderr "the contents of [widgetName $widgetId] is <$value>"
    }
  }
}

# show record displays the nth record of the form
proc showRecord {formNr recNr} {
  global current values
  set nr [expr {[info exists current($formNr)] ? $current($formNr) : 1}]
  case $recNr {
    {+} {incr nr}
    {-} {incr nr -1}
    default {set nr $recNr}
  }
  sV next$formNr sensitive [expr {$nr==$values($formNr) ? {false} : {true}}]
  sV prev$formNr sensitive [expr {$nr==1 ? {false} : {true}}]
  fillIn $formNr $nr
  set current($formNr) $nr
}

# fill in actually fills the values of an record into the displayed form
# (could be easily combined with showRecord)
proc fillIn {formNr recNr} {
  global values content
  foreach widgetId [gV h$formNr.View children] {
    set e [widgetName $widgetId]
    if [info exists content($formNr,$e,$recNr)] {
      if {[getClass $widgetId]=={Toggle}} {
	sV $widgetId state [expr {[string match on $content($formNr,$e,$recNr)]?{true}:{false}}]
      } else {
	sV $widgetId string $content($formNr,$e,$recNr)
      }
    }
  }
}

# goto field jumps to field $f in form $formNr
proc gotoField {formNr f} {
  set children [gV h$formNr.View children]
  turnOff $formNr
  turnOn $formNr [lsearch -exact $children $f]
}

# next field jumps to the next field in form $formNr
proc nextField {formNr diff} { 
  global currentField
  set nrChildren [gV h$formNr.View numChildren]
  incr nrChildren -1
  turnOff $formNr
  turnOn $formNr \
    [expr ($currentField($formNr)$diff)%$nrChildren]
}

# hilights the specified field of form $formNr
proc turnOn {formNr index} {
   global currentField
   set currentField($formNr) $index
   set children [gV h$formNr.View children]
#puts stderr "turnOn: children=<$children> $index [lindex $children $index]"
   set widgetName [lindex $children $index]
#puts stderr "turnOn: $formNr $index $widgetName"
   case [getClass $widgetName] {
        "Text"    { sV $widgetName displayCaret true background green}
        "Toggle"  { sV $widgetName background green borderColor green }
   }
   setKeyboardFocus f$formNr $widgetName
}

# turn off turns hilight from the current field off
proc turnOff {formNr} {
   global currentField
   set index $currentField($formNr)
   set children [gV h$formNr.View children]
   set widgetId [lindex $children $index]
   case [getClass $widgetId] {
        "Text"    { sV $widgetId displayCaret false background gray95}
        "Toggle"  { sV $widgetId background gainsboro borderColor black }
   }
}

# This is the sample "Database"
# values($formNr)                         holds the number of records
# content($formNr,$fieldName,$recordNr)   holds the actual value
set values(1) 2
set content(1,t1,1) "first value"
set content(1,t1,2) "second value"

set values(2) 3
set content(2,t1,1) "this is a"
set content(2,c1,1) "on"
set content(2,t2,1) 1
set content(2,t1,2) "this is b"
set content(2,c1,2) "off"
set content(2,t2,2) 2
set content(2,t1,3) "this is c"
set content(2,c1,3) "on"
set content(2,t2,3) 3

#-----------------------------------------------------------------------
# this is sample form 1. 
# note that this firm could be easly retrieved from a file or database,
# and that also enduser should be able to modify the screen appreance
# without knowing much detail, how the data is processed. HTML text 
# processing capabilities (various fonts, lists, headings, rules etc)
# and images can be used in forms as well...

set form(1) {
<TITLE>Fill-Out Form Example #1</TITLE>
<H1>Fill-Out Form Example #1</H1>

This is a very simple fill-out Form example. <P>

<FORM>

A single text entry field goes here: <input name="t1"> <P>

Note that it has no default value, the value is supplied from 
the tcl array "content(FormNumber,FieldName,recordNumber)<P>

To submit the query, press this button: <input type="submit"
value="Submit Query">. <P>

</FORM>

That's it. <P>
}

#-----------------------------------------------------------------------
# this is sample form 2 

set form(2) {
<TITLE>Fill-Out Form Example #2</TITLE>
<H1>Fill-Out Form Example #2</H1>

This is a very simple fill-out Form example. <P>

<FORM action="print">

A single text entry field with an input length of 25 characters 
goes here:<input name=t1 size=25 maxlen=25> <P> 

This is a checkbox <input name=c1 type=checkbox> which can be in a state
"on" or in a state "off". This is just another input field <input name=t2> <P>

To submit the query, press this button: <input type="submit"
value="Submit Query">. <P>

</FORM>
}


