#!/usr/local/bin/wishx -f
#
# this is my 'reserve' script with mild adaptations so that is can be used to
# indicate where someone in your group is, if not in the office.
#
# I cooked this up to mimic the tool we were using before this: the whiteboard.
# The columns are days, the rows people.  The resolution is to 1/2
# a day.
#
# When 'installing', there are (I expect) two minor things to worry about:
# the global variable 'work_dir' should be set to some public read/write
# NFS dir to which everyone in the group has access, and the permissions
# on this dir need to be such that everyone in the group can write to the
# files and the directory.  Look for 'EDIT THE NEXT LINE' at the bottom
# of this gibberish.
#
# To log an 'absence', one clicks on the person button at the far left;
# this 'locks' the person for two minutes to keep things consistent.  The
# lock is automatically deleted if the person isn't unlocked within that time.
# Then, one clicks MB1 on a particular day (on the left half to start from
# morning, on the right half to start in afternoon) and drags to the right
# until the last morning/afternoon is reached. Them MB1 is released. A 
# absence form will immediately pop up which gets info like reason, phone
# number where you can be reached, etc.  You may wish to changed this.
#
# To delete an notation, allocate a person and click MB3 on the notation.
#
# The rest is, hopefully, self-explanatory.
#
# To view a notation click MB1 on a notation. (making and viewing
# notation are mutually exclusive: when a peron is 'allocated', you can
# only make notation; when *no* peron is 'allocated', you can view
# notation.)
#
# Into the 'work_dir' goes everything except the wish script 'absence'
# They belong in a directory for scripts/executables in everyone's path.
#
# everything else is:
#	common.tcl		routines common to the tk script 'reserve', and
#				the character-cell version, reserve_vt
#	icon.bm
#	ex_screen.bm,
#	diag_stripe_thick.bm	bitmaps
#	res_help.tcl		help routines
#
# I can imagine that this might be useful to someone.  I hope so.
# -Rob Urban, urban@mfr.dec.com
#
if {[exec /bin/hostname] == "doofus"} {
  set work_dir "/usr/local/users/urban/Tcl/Wesen"
} else {
  set work_dir /ossc/local/Wesen
}
source $work_dir/common.tcl
wm iconbitmap . @${work_dir}/icon_bitmap.bm
set top_win "."

# for the main canvas...
# for select-box
set mc_x1 0
set mc_x2 0
set mc_x3 0
set mc_x4 0
set mc_y1 0
set mc_y2 0
set starty 60
#
set num_cells 120
set num_scroll_cells 50
set ygap 20
set xgap 15
set cwidth_cm [expr ($num_cells * $xgap) / [winfo fpix $top_win 1c]]
set c_scroll_width [expr $num_scroll_cells * $xgap]
set cwidth_pix [expr $num_cells * $xgap]
set autoscroll 0
set as_busy 0
#

proc Dialog {w title text bitmap default args} {
  global dialog_button
  
  toplevel $w -class Dialog
  wm geometry $w +400+400
  wm title $w $title
  wm iconname $w Dialog
  frame $w.top -relief raised -bd 1
  pack $w.top -side top -fill both
  frame $w.bot -relief raised -bd 1
  pack $w.bot -side bottom -fill both

  message $w.top.msg -width 3i -text $text \
    -font -Adobe-Times-Medium-R-Normal-*-180-*
  pack $w.top.msg -side right -expand 1 -fill both -padx 5m -pady 5m
  if {$bitmap != ""} {
    label $w.top.bitmap -bitmap $bitmap
    pack $w.top.bitmap -side left -padx 5m -pady 5m
  }
  set i 0
  foreach but $args {
    button $w.bot.button$i -text $but -command "set dialog_button $i"
    if {$i == $default} {
      frame $w.bot.default -relief sunken -bd 1
      pack $w.bot.default -side left -expand 1 -padx 5m -pady 2m
      pack $w.bot.button$i -in $w.bot.default -side left \
        -padx 3m -pady 3m -ipadx 2m -ipady 1m
    } else {
      pack $w.bot.button$i -side left -expand 1 \
        -padx 5m -pady 5m -ipadx 2m -ipady 1m
    }
    incr i
  }
  if {$default > 0} {
    bind $w <Return> "$w.bot.button$default flash; set dialog_button $default"
  }
  set oldFocus [focus]
  tkwait visibility $w
  grab $w
  focus $w
  tkwait variable dialog_button
  # wait for user to respond
  destroy $w
  focus $oldFocus
  return $dialog_button
}

proc QuitApp {} {
  global armed_person armed_person_change dialog_button
  if {($armed_person != "")&&($armed_person_change != 0)} {
    Dialog .dialog {Save Changes?} "You haven't save your modifications to\
      person $armed_person. Do you want to?" warning -1 {Save Changes} {Throw Away}
    if {$dialog_button == 1} {
      set armed_person_change 0
    }
  }
  if {$armed_person != ""} {
    DisarmPerson $armed_person
  }
  exit
}

proc SetSelectMark {x y} {
  global mc_x1 mc_x2 mc_y1 mc_y2 ygap xgap starty people ignore_request
  global biglist armed_person select_start_half selected_person
  if {$ignore_request} {set ignore_request 0}
  if {$y < $starty} {return}
  set x [.c canvasx $x]
  set y [.c canvasy $y]
  set mc_y1 [expr ($y / $ygap) * $ygap + 1]
  set selected_person [lindex $people [expr ($mc_y1 - $starty) / $ygap]]
#  puts "$selected_person: $x $y"
  set mc_y2 [expr $mc_y1 + $ygap - 2]
  set mc_x1 [expr ($x / $xgap) * $xgap]
  set start_cell [expr $mc_x1 / $xgap]
  if {[expr $x % $xgap] < 8} {
    set mc_x2 $mc_x1
    set half 0
  } else {
    set mc_x2 [expr (($x / $xgap) + 1) * $xgap]
    set half 1
  }
  set ret [lindex $biglist($selected_person) [expr ($start_cell*2)+$half]]
  if {($ret == "") || ($ret > 0)} {
    set ignore_request 1
    puts -nonewline "\007"
    flush stdout
  } else {
    .c delete select_box
    DrawSelectBox $x $y
    set select_start_half [expr $mc_x1 / $xgap * 2 + (($mc_x2 - $mc_x1)/$xgap)]
  }
}

proc DrawSelectBox {x y} {
  global mc_x1 mc_x2 mc_x3 mc_x4 mc_x2 mc_y1 mc_y2 xgap starty
  global ignore_request selectbox_color num_cells select_start_half
  global num_halfcells selected_person biglist num_scroll_cells auto_scroll
  if {$ignore_request} {return}
  if {$y < $starty} {return}
  set save_x $x
  set x [.c canvasx $x]
  if {$x < $mc_x1} {set x $mc_x1}
  set mc_x3 [expr (($x / $xgap) + 1) * $xgap]
  if {[expr $x % $xgap] >= 8} {
    set mc_x4 $mc_x3
  } else {
    set mc_x4 [expr $mc_x3 - $xgap]
  }
  # HACK_START
  # ehc == end_half_cell
  set ehc [expr $mc_x3 / $xgap * 2 - 1 - (($mc_x3 - $mc_x4)/$xgap)]
  for {set i $select_start_half} {$i <= $ehc} {incr i} {
    if {[lindex $biglist($selected_person) $i] != 0} {
      set ehc [expr $i - 1]
      set select_start_half $ehc
      set tmp [expr $ehc/2 * $xgap]
      set mc_x3 [expr $tmp + $xgap]
      set mc_x4 [expr $tmp + [expr $ehc % 2] * $xgap]
      break
    }
  }
  if {$ehc >= $num_halfcells} {
    set ehc [expr $num_halfcells - 1]
    set tmp [expr $ehc/2 * $xgap]
    set mc_x3 [expr $tmp + $xgap]
    set mc_x4 [expr $tmp + [expr $ehc % 2] * $xgap]
  }
  # HACK_END
  if {($mc_x2 != $mc_x3) || ($mc_x1 != $mc_x4)} {
    .c delete select_box
    .c addtag select_box withtag [.c create poly $mc_x1 $mc_y2 $mc_x2 $mc_y1 \
      $mc_x3 $mc_y1 $mc_x4 $mc_y2 -fill $selectbox_color]
  }
  ################
  if {$save_x >= [winfo width .c]} {
    set scroll_info [.hscroll get]
    if {[lindex $scroll_info 3] < $num_cells} {
      set scroll_inc [expr ($save_x - [winfo width .c])/10 + 1]
      set auto_scroll 1
      .c xview [expr [lindex $scroll_info 2] + $scroll_inc]
      after 200 "AutoScroll $scroll_inc"
    } else {
      set auto_scroll 0
    }
  } else {
    set auto_scroll 0
  }
}

proc AutoScroll {scroll_inc} {
  global auto_scroll num_cells as_busy
  if {(!$auto_scroll)||($as_busy)} {return}
  set as_busy 1
  set scroll_info [.hscroll get]
  if {[lindex $scroll_info 3] < $num_cells} {
    .c xview [expr [lindex $scroll_info 2] + $scroll_inc]
    after 200 "AutoScroll $scroll_inc"
  }
  set as_busy 0
}
proc ReservePerson {x y} {
  global mc_x1 mc_x2 mc_x3 mc_x4 mc_x2 mc_y1 people starty
  global ygap xgap username auto_scroll
  global ignore_request armed_person_change
  set auto_scroll 0
  if {$ignore_request} {set ignore_request 0; return}
  if {$y < $starty} {return}
  set person [lindex $people [expr ($mc_y1 - $starty) / $ygap]]

  set start_halfcell [expr $mc_x1 / $xgap * 2 + (($mc_x2 - $mc_x1)/$xgap)]

  set end_halfcell [expr $mc_x3 / $xgap * 2 - 1 - (($mc_x3 - $mc_x4)/$xgap)]
  if {$mc_x3 != $mc_x4} {set end_half morning}
  if {[ReserveConfirm confirm $person $start_halfcell $end_halfcell] > 0} {
    set armed_person_change 1
  }
  LogIt "reserved person $person from [Convert nicedate $start_halfcell] to\
    [Convert nicedate $end_halfcell]"
}

proc DeleteReservation {x y} {
  global people biglist starty xgap ygap username armed_person
  global resconf_sonst resconf_cust resconf_user resconf_fone
  global person_reservations
  global armed_person_change username dialog_button
  if {$y < $starty} {return}
  set x [.c canvasx $x]
  set person [lindex $people [expr ($y - $starty) / $ygap]]
  if {$person != $armed_person} {
    Dialog .dialog {ERROR}\
      "You can only delete reservations for person $armed_person"\
      error -1 OK
    return
  }
  set halfcell [expr $x / $xgap * 2+ [expr $x % $xgap >= 8]]
#  puts "halfcell=$halfcell, person=$person"
  if {[lindex $biglist($person) $halfcell] == 0} {
    puts -nonewline "\007"
    flush stdout
    return
  }
  set tag [lindex $biglist($person) $halfcell]
  set found 0
  set index 0
  foreach ent $person_reservations($person) {
    if {[lindex $ent 0] == $tag} {
      set start [lindex $ent 1]
      set end [lindex $ent 2]
#      set resconf_user [lindex $ent 3]
      set resconf_cust [lindex $ent 3]
      set resconf_sonst [lindex $ent 4]
      set resconf_fone [lindex $ent 5]
      set found 1
      break
    }
    incr index
  }
  # consistency check:
  if {!$found} {
    Dialog .dialog {KILLER} {DeleteReservation inconsistent, bailing}\
      error -1 OK
    exit
  }
  if {[ReserveConfirm delete $person $start $end] > 0} {
    if {$person != $username} {
      Dialog .dialog {Warning} "This entry is for $person. $person is NOT\
        you! Are you absolutely sure you want to delete it????\n\n(A mail\
        will be sent to $person if you continue)" warning -1 Continue\
        Abort
      if {$dialog_button == 1} {return}
      Mail $person "$username deleted your entry from [Convert nicedate\
        $start] to [Convert nicedate $end]"
      set log_comment "(made by $person) "
    } else {set log_comment ""}
    set newlist [lreplace $person_reservations($person) $index $index]
    set person_reservations($person) $newlist
    ZeroPersonBits $person $start $end
    UpdatePersonDisplay $person
    set armed_person_change 1
    LogIt "deleted reservation ${log_comment}for \
      $person from [Convert nicedate $start] to\
      [Convert nicedate $end]"
  }
}

proc DisplayReservation {x y} {
  global people biglist starty xgap ygap username armed_person
  global resconf_sonst resconf_cust resconf_user person_reservations
  global armed_person_change resconf_fone
  if {$y < $starty} {return}
  set x [.c canvasx $x]
  set person [lindex $people [expr ($y - $starty) / $ygap]]
  set halfcell [expr $x / $xgap * 2+ [expr $x % $xgap >= 8]]
  set tag [lindex $biglist($person) $halfcell]
  if {$tag == 0} {
    puts -nonewline "\007"
    flush stdout
    return
  }
  set found 0
  set index 0
  foreach ent $person_reservations($person) {
    if {[lindex $ent 0] == $tag} {
      set start [lindex $ent 1]
      set end [lindex $ent 2]
#      set resconf_user [lindex $ent 3]
      set resconf_cust [lindex $ent 3]
      set resconf_sonst [lindex $ent 4]
      set resconf_fone [lindex $ent 5]
      set found 1
      break
    }
    incr index
  }
  # consistency check:
  if {!$found} {
    Dialog .dialog {KILLER} {DisplayReservation inconsistent, bailing}\
      error -1 OK
    exit
  }
  ReserveConfirm display $person $start $end
}

proc ReserveConfirm {op person start end} {
  global people username cell_binding resconf_button fone_cb resconf_fone
  global resconf_cust resconf_sonst resconf_user resconf_tablist
  global prop_font
 
  set from "[Convert nicedate $start]"
  set to "[Convert nicedate $end]"
  set w .resconf
  catch {destroy $w}
  set resconf_tablist "$w.customer.entry $w.fone.entry $w.sonst.entry"
  toplevel $w
  wm geom $w +400+400
  wm iconname $w "Confirm"
  if {$op == "confirm"} {
    wm title $w "Confirm Absence"
    set msg_text "Confirm Absence"
    set resconf_cust ""
    set resconf_sonst ""
    set resconf_fone ""
    set fone_cb 0
#    set resconf_user $username
    set state "-state normal"
    set user_lab "Username:"
    set wid_cmd "entry"
    set text_arg "-textvariable"
    set width_arg "-width 40"
    set fone_width_arg "-width 15"
    set ent_relief "sunken"
    set dollar ""
  } elseif {$op == "display"} {
    wm title $w "Display Absence"
    set msg_text "Display Absence"
    set state "-state disabled"
    set user_lab "Made by:"
    set wid_cmd "label"
    set text_arg "-text"
    set width_arg ""
    set fone_width_arg ""
    set ent_relief "flat"
    set dollar "\$"
  } elseif {$op == "delete"} {
    wm title $w "Delete"
    set msg_text "Really DELETE??"
    set state "-state disabled"
    set user_lab "Made by:"
    set wid_cmd "label"
    set text_arg "-text"
    set width_arg ""
    set fone_width_arg ""
    set ent_relief "flat"
    set dollar "\$"
  } else {
    puts "ReserveConfirm: unknown operator: $op, bailing..."
    exit
  }
  set lab_relief "raised"
  set state ""
  message $w.msg -font -Adobe-times-medium-r-normal--*-180* -width 3i \
    -text $msg_text
  ####
  frame $w.person -bd 1m
  label $w.person.label -text "Person:" -width 10 -relief $lab_relief
  label $w.person.person -text "$person"
  pack $w.person.label -side left
  pack $w.person.person -side left
  ####
  frame $w.from -bd 1m
  label $w.from.label -text "From:" -width 10 -relief $lab_relief
  label $w.from.from -text "$from"
  pack $w.from.label -side left
  pack $w.from.from -side left
  ####
  frame $w.to -bd 1m
  label $w.to.label -text "To:" -width 10 -relief $lab_relief
  label $w.to.to -text "$to"
  pack $w.to.label -side left
  pack $w.to.to -side left
  ####
#  frame $w.user -bd 1m
#  label $w.user.label -text $user_lab -width 10 -relief $lab_relief
#  label $w.user.user -rel flat -text $resconf_user
#  pack $w.user.label -side left
#  pack $w.user.user -side left
  ####
  frame $w.customer -bd 1m
  label $w.customer.label -text "Cust/Desc:" -width 10 -relief $lab_relief
  eval $wid_cmd $w.customer.entry -rel sunk $width_arg $text_arg \
    "${dollar}resconf_cust" $state -relief $ent_relief
  pack $w.customer.label -side left
  pack $w.customer.entry -side left
  ####
  frame $w.fone -bd 1m
  label $w.fone.label -text "Telephone at Customer:" -width 22 -relief\
    $lab_relief
  eval $wid_cmd $w.fone.entry -rel sunk $fone_width_arg $text_arg \
    "${dollar}resconf_fone" $state -relief $ent_relief
  pack $w.fone.label $w.fone.entry -side left
  if {$op == "confirm"} {
    checkbutton $w.fone.fone_cb -text "I refuse to provide a fone number"\
      -rel raised
    pack $w.fone.fone_cb -side left
  } else {
    set fone_cb 1
  }
  ####
  frame $w.sonst -bd 1m
  label $w.sonst.label -text "Sonstiges:" -width 10 -relief $lab_relief
  eval $wid_cmd $w.sonst.entry -rel sunk $width_arg $text_arg\
    "${dollar}resconf_sonst" $state -relief $ent_relief
  pack $w.sonst.label -side left
  pack $w.sonst.entry -side left
  ####
  message $w.message -bd 1m -font $prop_font -width 4i -aspect 800
  ####
  frame $w.buttons -bd 1m -rel groove
  if {$op != "display"} {
    button $w.buttons.ok -text "Confirm" -command {set resconf_button\
      "confirm"}
    pack $w.buttons.ok -side left -expand 1 -padx 5m
  }
  button $w.buttons.cancel -text "Cancel" -command \
    {set resconf_button "cancel"}
  pack $w.buttons.cancel -side left -expand 1 -padx 5m

  #########
  foreach foo "$w.customer.entry $w.fone.entry $w.sonst.entry" {
    bind $foo <Tab> "Tab \$resconf_tablist"
    bind $foo <Return> "Tab \$resconf_tablist"
  }

  pack $w.msg -fill x
  pack $w.person -fill x
  pack $w.from -fill x
  pack $w.to -fill x
#  pack $w.user -fill x
  pack $w.customer -fill x
  pack $w.fone -fill x
  pack $w.sonst -fill x
  pack $w.message -fill x
  pack $w.buttons -fill x
  set old_focus [focus]
  tkwait visibility $w
  grab $w
  focus $w
  set done 0
  while {!$done} {
    tkwait variab resconf_button
    if {$resconf_button == "cancel"} {
#      destroy $w
#      focus $old_focus
      .c delete select_box
#      return -1
      set ret_val -1
      set done 1
      break
    } elseif {$op == "confirm"} {
      if {($resconf_fone != "")||($fone_cb)} {
        ReserveBits $person $start $end "$resconf_cust" "$resconf_sonst"\
          "$resconf_fone"
        set ret_val 1
        set done 1
      } else {
        $w.message config -text "You must suppy a telephone number" -fg red
        after 900 "$w.message config -text {}"
      }
    } else {
      set ret_val 1
      set done 1
    }
  }
  destroy $w
  focus $old_focus
  .c delete select_box
  UpdatePersonDisplay $person
  return $ret_val
}

proc Quickie {message delay} {
  global quickie_var
  catch {destroy .quickie}
  set quickie_var ""
  set w .quickie
  toplevel $w
  wm geometry $w +400+400
  message $w.msg -width 7c -text $message \
    -font -Adobe-Times-Medium-R-Normal-*-180-*
  pack $w.msg -expand 1 -fill both -padx 5m -pady 5m
  tkwait visibility $w
  grab $w
  after [expr $delay * 1000] {set quickie_var foo}
  tkwait variable quickie_var
  # wait for user to respond
  destroy $w
}
#Quickie {\"reserve\" coming up...} 30

proc ArmPerson {person} {
  global armed_person armed_person_color_bg armed_person_color_ab
  global armed_person_change alarm_minutes
  if {($armed_person != "") && ($armed_person != $person)} {
    Dialog .dialog {ERROR}\
      "You must first relinquish person $armed_person before you can reserve\
       another one." error -1 OK
    return
  }
  UpdateIfChanged $person
  if {[RequestLock "$person"]} {
    # got request lock for person
    .names.$person config -bg $armed_person_color_bg\
      -activebackground $armed_person_color_ab -command "DisarmPerson $person"
    set armed_person "$person"
    Quickie "you now have 2 minutes to modify ${person}'s schedule" 2
    alarm [expr $alarm_minutes * 60]
    bind .c <ButtonRelease-1> "ReservePerson %x %y"
    bind .c <B1-Motion> "DrawSelectBox %x %y"
    bind .c <1> "VerifyClick %x %y"
    bind .c <3> "DeleteReservation %x %y"
    set armed_person_change 0
  }
}

proc VerifyClick {x y} {
  global armed_person starty ygap people ignore_request
  # call SetSelectMark after check
  if {[CheckDate]} {return}
  set person [lindex $people [expr ($y - $starty) / $ygap]]
  if {$person != $armed_person} {
    set ignore_request 1
    Dialog .d {Verboten!} "You can only reserve $armed_person." {error} -1 OK
    return
  } else {
    SetSelectMark $x $y
  }
}


proc DisarmPerson {person} {
  # first thing, turn off alarm
  alarm 0
  global armed_person disarmed_person_color_bg disarmed_person_color_ab
  global work_dir lock_file_extension armed_person_change
  if {$person != $armed_person} {
    Dialog .dialog {Really Fucked} "something really went wrong: trying to\
      disarm person $person but, armed_person set to $armed_person" {} -1 OK
  }
  if {$armed_person_change} {
    # something was changed
    WritePersonFile $armed_person nochgrp
  }
  set armed_person ""
  .names.$person config -bg $disarmed_person_color_bg\
    -activebackground $disarmed_person_color_ab -command "ArmPerson $person"
  set lock_name "${work_dir}/${person}.$lock_file_extension"
  exec rm $lock_name
  bind .c <ButtonRelease-1> {}
  bind .c <B1-Motion> {}
  bind .c <1> "DisplayReservation %x %y"
  bind .c <3> {}
}

proc BuildMenu {} {
  catch {destroy .menu}
  frame .menu -relief raised -borderwidth 1
  pack .menu -side top -fill x
  # File Catagory
  menubutton .menu.file -text "File" -menu .menu.file.m -under 0
  menu .menu.file.m
  .menu.file.m add command -label "Quit" -command "QuitApp" -under 0
#  .menu.file.m add command -label "Reload" -command "source sched"

  # Hosts catagory
  menubutton .menu.people -text "People" -menu .menu.people.m -under 0
  menu .menu.people.m
  .menu.people.m add command -label "Add" -command "AddPerson" -under 0
#  .menu.people.m add command -label "Delete" -command "DeletePerson" -under 0
  .menu.people.m add command -label "Change" -command "ChangePerson" -under 0
  .menu.people.m add command -label "Display" -command "DisplayPerson" -under 0

  # Help 
  menubutton .menu.help -text "Help" -menu .menu.help.m
  menu .menu.help.m
  .menu.help.m add command -label "Help" -command {HelpDiagram; HelpHints}

  pack .menu.file .menu.people -side left
  pack .menu.help -side right
  tk_menuBar .menu .menu.file .menu.people .menu.help
}

proc NextColor {col} {
  set col_list {black white orange pink darkorange3 red violet}
  set tmp [lsearch $col_list $col]
  if {$tmp == [expr [llength $col_list] - 1]} {
    return [lindex $col_list 0]
  } else {
    return [lindex $col_list [expr $tmp + 1]]
  }
}

proc ModElement {x y} {
  global xgap ygap
#  puts "x=$x y=$y"
  set real_x [.c canvasx $x]
  set obj [.c find closest $real_x $y]
  puts "OBJ=$obj"
  set color [lindex [lindex [.c itemconfig $obj] 0] 4]
  set nextcolor [NextColor $color]
  .c itemconfig $obj -fill $nextcolor
}

proc BuildMisc {} {
  global mc_height
  catch {destroy .hscroll}
  catch {destroy .names}
  # now for the canvas for the people
  canvas .names -width 2c -height $mc_height;	# -bg blue
  pack .names -side left -fill y
  label .names.corner -text "people" -bg skyblue -rel raised
  .names create window 0 0 -win .names.corner -width 2c -height 60 -anch nw
  scrollbar .hscroll -relief sunk -orient horiz -command ".c xview"
  pack .hscroll -side bottom -fill x
}

proc MakeHeader {} {
  global month_names monthday_num year_num
  global xgap cwidth_pix month_num
  global week_num weekday_num
  global ygap starty
  set year $year_num
  # now for the labels at the top of the canvas...
  .c create line 0 20 $cwidth_pix 20
  .c create line 0 40 $cwidth_pix 40
  #
  set xline [expr ([MonthDays $month_num $year] - $monthday_num + 1) * $xgap]
  .c create line $xline 0 $xline 60
  if {$xline > 90} {
    .c create text [expr $xline / 2] 0 -anch n\
      -text [lindex $month_names $month_num]
  }
  #
  set disp $xline
  set month [expr "{$month_num} == {12} ? {1} : [expr {$month_num} + {1}]"]
  while {$disp < $cwidth_pix} {
    set tmp [expr [MonthDays $month $year] * $xgap]
    set xline [expr $tmp + $disp]
    if {$xline < $cwidth_pix} {
      .c create line $xline 0 $xline 60
      .c create text [expr $disp + [expr ($xline - $disp)/2]] 0 -anch n \
        -text [lindex $month_names $month] -tag [lindex $month_names $month]
    }
    set disp $xline
    incr month
    if {$month > 12} {set month 1; incr year}
  }
  incr month -1
  if {$month < 1} {set month 12; incr year -1 }
  
  if {[expr $cwidth_pix - [expr $disp - $tmp]] > $xgap} {
    set tmp2 [expr $disp - $tmp]
    .c create text [expr ($cwidth_pix - $tmp2)/2 + $tmp2] 0 -anch n \
      -text [lindex $month_names $month] -tag [lindex $month_names $month]
  }
  #
  # the following creates the "KW xx" labels between y=20 and y=40 and 
  # the "xx.yy - xx.yy" labels between y=40 and y=60
  #
  set year $year_num
  set num 0
  set find_end 0
  set curr_month $month_num
  set curr_day_of_month $monthday_num
  while {[expr $num * $xgap] < $cwidth_pix} {
    set kw [fmtclock [convertclock "$curr_month/$curr_day_of_month/$year"] %U]
    set wd_num [expr ($weekday_num + $num) % 7]
    set curr_date "$curr_day_of_month.$curr_month"
    if {$find_end == 0} {
      if {$wd_num == 1} {
        set find_end 1
        set lab_start [expr $num * $xgap]
        set date_start $curr_date
      }
    } else {
      if {$wd_num == 5} {
        set lab_width [expr ($num + 1) * $xgap - $lab_start]
        # create "KW .." label
        label .c.kw$kw -text "KW $kw" -bg salmon
        .c create window $lab_start 21 -window .c.kw$kw -width $lab_width \
          -height [expr $ygap - 1] -anch nw
        # create 'mon xx - mon yy' label
        label .c.date$kw -text "${date_start}-${curr_date}"
        .c create window $lab_start 41 -window .c.date$kw -width $lab_width \
          -height [expr $ygap - 1] -anch nw
        set find_end 0
      }
    }
    incr num
    incr curr_day_of_month
    if {$curr_day_of_month > [MonthDays $curr_month $year]} {
      if {$curr_month == 12} {
        set curr_month 1
        incr year
      } else {
        incr curr_month
      }
      set curr_day_of_month 1
    }
  }
  if {$find_end == 1} {
    set lab_width [expr ($num - 1) * $xgap - $lab_start]
    # create "KW .." label 
    label .c.kw$kw -text "KW $kw" -bg salmon
    .c create window $lab_start 21 -window .c.kw$kw -width $lab_width \
      -height [expr $ygap - 1] -anch nw
    # create 'mon xx - mon yy' label
    label .c.date$kw -text "$date_start - $curr_date"
    .c create window $lab_start 41 -window .c.date$kw -width $lab_width \
      -height [expr $ygap - 1] -anch nw
  }
  set prev_date $curr_date
}

proc BuildCanvas {} {
  global mc_height xgap c_scroll_width cwidth_pix
  catch {destroy .c}
  BuildMisc
  canvas .c -scrollregion "0c 0c $cwidth_pix $mc_height" -width $c_scroll_width\
    -height $mc_height -xscroll ".hscroll set" -scrollincre $xgap
  pack .c -expand yes; # -fill both
  bind .c <1> "DisplayReservation %x %y"
}

proc SetOrDisplay {x y} {
  global armed_person starty ygap people
  if {$armed_person != ""} {
    # call SetSelectMark after check
    set person [lindex $people [expr ($y - $starty) / $ygap]]
    if {$person != $armed_person} {
      puts "SetOrDisplay: person=$person, armed_person=$armed_person, call PopErr"
      PopErr "You can only reserve $armed_person."
      puts "SetOrDisplay: return from PopErr"
      return
    } else {
      SetSelectMark $x $y
    }
  } else {
    # do some display stuff here...
    return
  }
}
    

proc ChangeColor {tag} {
  set color [lindex [lindex [.c itemconfig $tag] 0] 4]
  set nextcolor [NextColor $color]
  .c itemconfig $tag -fill $nextcolor
}

proc MakeMatrix {} {
  global people xgap ygap cwidth_pix weekday_num starty
  global week_end_color free_person_color work_dir
  # draw a line of rectangles for each person for each day
  set y $starty
  foreach person $people {
    set general_tag "gen_$person"
    catch {destroy .names.$person}
    button .names.$person -text "$person" -relief raised -bg DeepSkyBlue2 \
      -command "ArmPerson $person"
    .names create window 0 $y -anch nw -width 2c -height ${ygap} \
      -window .names.$person
    set num 0
    set lab 0
    set x 0
    while {[expr $x + ${xgap}] <= $cwidth_pix} {
      set tag "${person}_lab${num}"
      set weekdays_tag "${person}_weekdays"
      set weekend_tag "${person}_weekend"
      set tmp [expr ($weekday_num + $num) % 7]
      if {($tmp > 0) && ($tmp < 6)} {
        .c create rect $x $y [expr $x + $xgap] [expr $y + $ygap - 1] -tag \
          "$tag $general_tag $weekdays_tag" -fill $free_person_color
      } else {
        .c create rect $x $y [expr $x + $xgap] [expr $y + $ygap - 1] -tag \
          "$tag $weekend_tag" -fill $week_end_color \
          -stipple @${work_dir}/diag_stripe_thick.bm
      }
      incr num
      set x [expr $x + $xgap]
      incr lab
      if {$lab > 9} {set lab 0}
    }
    set y [expr $y + $ygap]
  }
}

proc ZeroPersonLists {} {
  global people virgin_biglist biglist
  foreach person $people {
    set biglist($person) "$virgin_biglist"
  }
}

proc UpdateDisplay {} {
  global people
  foreach person $people {
    UpdatePersonDisplay $person
  }
}  

proc UpdatePersonDisplay {person} {
  global polygons num_cells biglist
  global free_person_color week_end_color
  set looking 0
  # get rid of polygons...
  catch {
    foreach foo $polygons($person) {
      .c delete $foo
    }
  }
  catch {unset polygons($person)}
  set halfcell 0
  while {$halfcell < [expr $num_cells * 2]} {
    set tag [lindex $biglist($person) $halfcell]
    if {!$looking} {
      if {$tag} {
        set looking 1
        set this_tag $tag
#        puts "setting start_halfcell to $halfcell"
        set start_halfcell $halfcell
      }
    } else {
      # looking for end of sequence
      if {(!$tag)||($tag != $this_tag)} {
        DrawPolygon $person $this_tag $start_halfcell [expr $halfcell - 1]
        if {$tag} {
          set this_tag $tag
          set start_halfcell $halfcell
        } else {
          set looking 0
        }
      }
    }
    incr halfcell
  }
  if {$looking} {
    DrawPolygon $person $this_tag $start_halfcell [expr $num_cells * 2 - 1]
  }
}

proc DrawPolygon {person tag_num start end} {
#  puts "ShowSequence: person: $person, start: $start, end: $end"
  global people starty ygap xgap reserved_person_color
  global polygons
  set tag "${person}_poly${tag_num}"
  set person_ind [lsearch $people $person]
  set y1 [expr $person_ind * $ygap + $starty + 1]
  set y2 [expr $y1 + $ygap - 2]
  set cell [expr $start / 2]
  set x1 [expr $cell * $xgap + 1]
  set x2 [expr ($cell + ($start % 2)) * $xgap + 1]
  set x3 [expr (($end/2) + 1) * $xgap - 1]
  set x4 [expr (($end/2) + ($end % 2)) * $xgap - 1]
  .c addtag $tag withtag [.c create poly $x1 $y2 $x2 $y1 $x3 $y1 $x4 $y2\
      -fill $reserved_person_color]
  lappend polygons($person) $tag
}
    
proc odd {int} {
  if {[expr $int % 2]} {
    return 1
  }
  return 0
}

proc AddPerson {} {
  global add_change people person_info armed_person_change
  set add_change(person) ""
  set add_change(phone) ""
  set add_change(address) ""
  if {[AddChangePerson add] > 0} {
    set person $add_change(person)
    if {[lsearch $people $add_change(person)] == -1} {
      lappend people $person
      set people [lsort $people]
      set person_info($person) "{$person} {$add_change(phone)}\
        {$add_change(address)}"
      WritePersonFile $person chgrp
      WinInit
      LogIt "added new person $person"
    } else {
      Dialog .dialog {Error} "Person $person is already in the system." {error}\
        -1 OK
    }
  }
}

proc DisplayPerson {} {
  global people change_person_selection person_info add_change armed_person
  set w .ch_list
  catch {destroy $w}
  toplevel $w
  wm geometry $w +400+400
  wm title $w "Display Person Information"
  wm iconname $w "Display"
  wm minsize $w 1 1
  message $w.msg -text "Choose a person" -aspect 600
  frame $w.frame -bd 5
  button $w.ok -text OK -command "set change_person_selection foo"
  pack $w.msg -side top -fill x
  pack $w.frame -side top -expand yes -fill y
  pack $w.ok -side bottom -fill x

  scrollbar $w.frame.scroll -rel sunken -command "$w.frame.list yview"
  listbox $w.frame.list -relief sunken -setgrid 1 -yscroll "$w.frame.scroll set"
  pack $w.frame.scroll -side right -fill y
  pack $w.frame.list -side left -expand yes -fill both
  eval "$w.frame.list insert 0 $people"
  tk_listboxSingleSelect $w.frame.list
  bind $w.frame.list <Double-1> "set change_person_selection foo"
  tkwait variab change_person_selection
  set selected [$w.frame.list curselect]
  if {$selected == ""} {
    destroy $w
    return
  }
  set person [lindex $people $selected]
#  puts "person=$person"
  destroy $w
  if {$person == ""} {
    destroy $w
    return
  } else {
    set list $person_info($person)
    set add_change(person) [lindex $list 0]
    set add_change(phone) [lindex $list 1]
    set add_change(address) [lindex $list 2]
    AddChangePerson display
  }
}

proc AddChangePerson {op} {
  global people addchange_tablist add_change add_change_button
  global username
  set w ".addperson"
  set addchange_tablist "$w.name.hn $w.phone.entry $w.address.text"
  catch {destroy $w}
  toplevel $w
  wm geometry $w +400+400
  wm iconname $w "Add"
  if {$op == "add"} {
    wm title $w "New Person"
    set msg_text "Add a new person to system"
  } elseif {$op == "change"} {
    wm title $w "Change Person"
    set msg_text "Change person information"
  } else {
    wm title $w "Display Person"
    set msg_text "Information about..."
  }
  message $w.msg -font -Adobe-times-medium-r-normal--*-180* -width 3i \
    -text $msg_text
  frame $w.name -bd 1m
  if {$op == "add"} {
    set add_change(person) $username
    entry $w.name.hn -relief sunk -width 16 -textvariable add_change(person)
  } else {
    label $w.name.hn -relief flat -width 16 -text $add_change(person)\
      -bg salmon
  }
  bind $w.name.hn <Tab> "Tab \$addchange_tablist"
  bind $w.name.hn <Return> "Tab \$addchange_tablist"
  bind $w.name.hn <FocusOut> "CheckUsername $w \$add_change(person)"
  label $w.name.label -text "person:" -width 11
  label $w.name.lab2 -text "username in system" -rel raised
  pack $w.name.label $w.name.hn $w.name.lab2 -side left
  ####
  frame $w.info -bd 1m
  label $w.info.label -text "Stammdaten" -rel groove -width 11
  pack $w.info.label -fill x
  ####
  frame $w.phone -bd 1m
  entry $w.phone.entry -rel sunk -width 16 -textvariable add_change(phone)
  if {$op == "display"} {
    $w.phone.entry config -state disabled
  }
  bind $w.phone.entry <Tab> "Tab \$addchange_tablist"
  bind $w.phone.entry <Return> "Tab \$addchange_tablist"
  label $w.phone.label -text "Telefon:" -width 11
  label $w.phone.lab2 -text "Privat (freiwillig!)" -rel raised
  pack $w.phone.label $w.phone.entry $w.phone.lab2 -side left
  ####
  frame $w.address -bd 1m
  frame $w.address.lframe
  label $w.address.lframe.label -text "address:" -width 11
  pack $w.address.lframe -side left -fill y
  pack $w.address.lframe.label -side top
  text $w.address.text -relief sunk -bd 2 -height 3 -width 40 -wrap word
  bind $w.address.text <KeyPress> "TextInput $w.address.text %A %K"
  bind $w.address.text <Tab> "Tab \$addchange_tablist"
  pack $w.address.text -side left
  if {($op == "change")||($op == "display")} {
    regsub -all {\\n} $add_change(address) "\n" tmp
    $w.address.text insert 0.0 $tmp
  }
  if {$op == "display"} {
    $w.address.text config -state disabled
  }
  ####
  frame $w.message -bd 1m
  label $w.message.label
  pack $w.message.label -fill x
  ####
  frame $w.buttons -bd 1m -rel groove
  button $w.buttons.ok -text OK -command {set add_change_button "ok"}
  button $w.buttons.cancel -text "cancel" -command \
    {set add_change_button "cancel"}
  pack $w.buttons.ok -side left -expand 1 -padx 5m
  pack $w.buttons.cancel -side left -expand 1 -padx 5m
  
  #######

  pack $w.msg -fill x
  pack $w.name -fill x
  pack $w.info -fill x
  pack $w.phone -fill x
  pack $w.address
  pack $w.message -fill x
  pack $w.buttons -pady 3m -ipady 2m -fill x
  set done 0
  while {!$done} {
    tkwait variab add_change_button
    if {$add_change_button == "ok"} {
      if {[UsernameExists $add_change(person)]} {
        set done 1
      } else {
        $w.message.label config -text "$add_change(person) invalid username"\
          -fg red
        after 1000 "$w.message.label config -text {}"
      }
    } else {set done 1}
  }
  if {($add_change_button == "cancel")||($add_change(person) == "")} {
    destroy $w
    return -1
  }
  regsub -all "\n" [$w.address.text get 0.0 end] {\n} tmp
  set add_change(address) "$tmp"
  destroy $w
  return 1
}

proc CheckUsername {w un} {
  if {![UsernameExists $un]} {
    $w.message.label config -text "$un is not a valid username" -fg red
    after 1000 "$w.message.label config -text {}"
    focus $w.name.hn
  }
}

proc UsernameExists {un} {
  if {[catch {set foo [id convert user $un]}]} {
    return 0
  }
  return 1
}

proc TextInput {w char keysym} {
  global username
  if {([ctype alnum $char])||\
      ([regexp {[.,?/'"\\|[]{}`~!@#$%^&*()_-+=><:;	]} $char])} {
    $w insert insert $char
  } else {
    switch $keysym {
      Return {$w insert insert "\n"}
      Delete {$w delete insert-1c}
      space {$w insert insert " "}
      Up {$w mark set insert insert-1l}
      Down {$w mark set insert insert+1l}
      Right {$w mark set insert insert+1c}
      Left {$w mark set insert insert-1c}
      default {
        if {[string tolower $keysym] == $keysym} {
          $w insert insert $char
        }
      }
    }
  }
}

proc Tab {list} {
  set i [lsearch $list [focus]]
  if {$i < 0} {
    set i 0
  } else {
    incr i
    if {$i >= [llength $list]} {
      set i 0
    }
  }
  focus [lindex $list $i]
}

proc WinInit {} {
  global people mc_height ygap starty
  set mc_height [expr [llength $people] * $ygap + $starty]
  BuildCanvas
  MakeHeader
  MakeMatrix
  ReadAllPeople
  UpdateLists
  UpdateDisplay
}
  

proc Init {} {
  global people mc_height ygap starty num_cells cwidth_pix xgap
#  set num_cells [Truncate [expr $cwidth_pix / $xgap]]
  CellBind
  InitVirginBiglist
  FindPeople
  set mc_height [expr [llength $people] * $ygap + $starty]
  # window stuff
  BuildMenu
  WinInit
}
source $work_dir/res_help.tcl
Init
#set quickie_var foo
signal trap SIGALRM {
  if {$armed_person != ""} {
    set this_person $armed_person
    set msg "."
    if {[info commands .resconf] == ".resconf"} {
      .resconf.buttons.cancel invoke
      set msg ", however your last change was thrown away."
    }
    if {[info command .addperson] == ".addperson"} {
      .addperson.buttons.cancel invoke
      set msg ", however any changed to person ${this_person}'s Stammdaten were\
        lost"
    }
    DisarmPerson $armed_person
    Dialog .dialog {timeout} "Your time ran out. Your changes to person\
      $this_person were saved$msg" warning -1 OK
  }
}
after [expr $scan_interval * 1000] ScanForChanges
