#!/usr/local/bin/wishx -f
#
# WARNING: this was my first attempt at a useful tcl/tk script, so please be
# tolerant!
#
# this is a groupware/technoweenie solution to a problem we had
# in our group a dec (we are a porting center). We needed a simple way of 
# allocating machines for short periods of time (1/2 day to several weeks).
# I cooked this up to mimic the tool we were using before this: the whiteboard.
# The columns are days, the rows available machines.  The resolution is to 1/2
# a day.  I also wrote a character-cell version ('reserve_vt') for the
# X-impaired.
#
# 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 'reserve' a machine, one clicks on the machine button at the far left;
# this 'locks' the machine for two minutes to keep things consistent.  The
# lock is automatically delete is the machine isn't unlocked within that time.
# Then, one clicks MB1 on a particular day (on the left half to reserve 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 
# reservation form will immediately pop up which gets info like partner name,
# etc.  You may wish to changed this.
#
# To delete, allocate a machine and click MB3 on the reservation.
#
# The rest is, hopefully, self-explanatory.
#
# To view a reservation click MB1 on a reservation. (making and viewing
# reservations are mutually exclusive: when a machine is 'allocated', you can
# only make reservations; when *no* machine is 'allocated', you can view
# reservations.)
#
# Into the 'work_dir' goes everything except the wish script 'reserve' and the
# tcl script 'reserve_vt'. 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
#
################ EDIT THE NEXT LINE
set work_dir /ossc/local/Reserve
################
source $work_dir/common.tcl
wm iconbitmap . @${work_dir}/icon.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 35
set cwidth_cm [expr ($num_cells * $xgap) / [winfo fpix $top_win 1c]]
set c_scroll_width [expr $num_scroll_cells * $xgap]
#set cwidth_pix [winfo fpixels $top_win ${cwidth_cm}c]
set cwidth_pix [expr $num_cells * $xgap]
#set cheight_cm 10
#set cheight_pix [winfo fpixels $top_win ${cheight_cm}c]
#

proc TestFont {font} {
  toplevel .testfont
  set result 1
  if {[catch {button .testfont.b -font $font}]} {
    set result 0
  }
  destroy .testfont
  return $result
}

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_host armed_host_change dialog_button
  if {($armed_host != "")&&($armed_host_change != 0)} {
    Dialog .dialog {Save Changes?} "You haven't save your modifications to\
      host $armed_host. Do you want to?" warning -1 {Save Changes} {Throw Away}
    if {$dialog_button == 1} {
      set armed_host_change 0
    }
  }
  if {$armed_host != ""} {
    DisarmHost $armed_host
  }
  exit
}

proc SetSelectMark {x y} {
  global mc_x1 mc_x2 mc_y1 mc_y2 ygap xgap starty machines ignore_request
  global biglist armed_host select_start_half selected_machine
  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_machine [lindex $machines [expr ($mc_y1 - $starty) / $ygap]]
#  puts "$selected_machine: $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_machine) [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_machine biglist
  if {$ignore_request} {return}
  if {$y < $starty} {return}
  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]
  }
  # 
  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_machine) $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
    }
  }
#  puts "start: $select_start_half, end: $ehc"
  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]
  }
  # 
  if {($mc_x2 != $mc_x3) || ($mc_x1 != $mc_x4)} {
    .c delete select_box
#     puts "$mc_x1 $mc_y2, $mc_x2 $mc_y1, $mc_x3 $mc_y1, $mc_x4 $mc_y2"
    .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]
#    set mc_x2 $x
  }
}

proc ReserveHost {x y} {
  global mc_x1 mc_x2 mc_x3 mc_x4 mc_x2 mc_y1 machines starty
  global resconf_sonst resconf_cust resconf_user host_reservations
  global ygap xgap username
  global ignore_request armed_host_change
  if {$ignore_request} {set ignore_request 0; return}
  if {$y < $starty} {return}
  set machine [lindex $machines [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 $machine $start_halfcell $end_halfcell] > 0} {
    set armed_host_change 1
    LogIt "{$machine reserved} {from [Convert nicedate $start_halfcell] to\
      [Convert nicedate $end_halfcell]} {user: $resconf_user}\
      {customer: $resconf_cust} {sonstiges: $resconf_sonst}"
  }
}

proc DeleteReservation {x y} {
  global machines biglist starty xgap ygap username armed_host
  global resconf_sonst resconf_cust resconf_user host_reservations
  global armed_host_change username dialog_button
  if {$y < $starty} {return}
  set x [.c canvasx $x]
  set machine [lindex $machines [expr ($y - $starty) / $ygap]]
  if {$machine != $armed_host} {
    Dialog .dialog {ERROR}\
      "You can only delete reservations for host $armed_host"\
      error -1 OK
    return
  }
  set halfcell [expr $x / $xgap * 2+ [expr $x % $xgap >= 8]]
#  puts "halfcell=$halfcell, machine=$machine"
  if {[lindex $biglist($machine) $halfcell] == 0} {
    puts -nonewline "\007"
    flush stdout
    return
  }
  set tag [lindex $biglist($machine) $halfcell]
  set found 0
  set index 0
  foreach ent $host_reservations($machine) {
    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 4]
      set resconf_sonst [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 $machine $start $end] > 0} {
    if {$resconf_user != $username} {
      Dialog .dialog {Warning} "This reservation was made by $resconf_user. \
        Are you absolutely sure you want to delete it????\n\n(A mail will be\
        sent to the original reserver if you continue)" warning -1 Continue\
        Abort
      if {$dialog_button == 1} {return}
      Mail $resconf_user "$username deleted your reservation for machine\
        $machine from [Convert nicedate $start] to [Convert nicedate $end]"
      set log_comment "(made by $resconf_user) "
    } else {set log_comment ""}
    set newlist [lreplace $host_reservations($machine) $index $index]
    set host_reservations($machine) $newlist
    ZeroHostBits $machine $start $end
    UpdateHostDisplay $machine
    set armed_host_change 1
    LogIt "{$machine: reservation deleted} ${log_comment}\
      {from [Convert nicedate $start] to [Convert nicedate $end]}\
      {user: $resconf_user}\
      {customer: $resconf_cust} {sonstiges: $resconf_sonst}"
  }
}

proc DisplayReservation {x y} {
  global machines biglist starty xgap ygap username armed_host
  global resconf_sonst resconf_cust resconf_user host_reservations
  global armed_host_change
  if {$y < $starty} {return}
  set x [.c canvasx $x]
  set machine [lindex $machines [expr ($y - $starty) / $ygap]]
  set halfcell [expr $x / $xgap * 2+ [expr $x % $xgap >= 8]]
  set tag [lindex $biglist($machine) $halfcell]
  if {$tag == 0} {
    puts -nonewline "\007"
    flush stdout
    return
  }
  set found 0
  set index 0
  foreach ent $host_reservations($machine) {
    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 4]
      set resconf_sonst [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 $machine $start $end
}

proc ReserveConfirm {op host start end} {
  global machines username cell_binding resconf_button
  global resconf_cust resconf_sonst resconf_user resconf_tablist
 
  set from "[Convert nicedate $start]"
  set to "[Convert nicedate $end]"
  set w .resconf
  catch {destroy $w}
  set resconf_tablist "$w.customer.entry $w.sonst.entry"
  toplevel $w
  wm geom $w +400+400
  wm iconname $w "Confirm"
  if {$op == "confirm"} {
    wm title $w "Confirm Reservation"
    set msg_text "Confirm Reservation"
    set resconf_cust ""
    set resconf_sonst ""
    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 ent_relief "sunken"
    set dollar ""
  } elseif {$op == "display"} {
    wm title $w "Display Reservation"
    set msg_text "Display Reservation"
    set state "-state disabled"
    set user_lab "Rsvd by:"
    set wid_cmd "label"
    set text_arg "-text"
    set 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 "Rsvd by:"
    set wid_cmd "label"
    set text_arg "-text"
    set 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.host -bd 1m
  label $w.host.label -text "Hostname:" -width 10 -relief $lab_relief
  label $w.host.host -text "$host"
  pack $w.host.label -side left
  pack $w.host.host -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 "Customer:" -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.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
  ####
  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.sonst.entry" {
    bind $foo <Tab> "Tab \$resconf_tablist"
    bind $foo <Return> "Tab \$resconf_tablist"
  }

  pack $w.msg -fill x
  pack $w.host -fill x
  pack $w.from -fill x
  pack $w.to -fill x
  pack $w.user -fill x
  pack $w.customer -fill x
  pack $w.sonst -fill x
  pack $w.buttons -fill x
  set old_focus [focus]
  tkwait visibility $w
  grab $w
  focus $w
  tkwait variab resconf_button
  if {$resconf_button == "cancel"} {
    destroy $w
    focus $old_focus
    .c delete select_box
    return -1
  }
  if {$op == "confirm"} {
    ReserveBits $host $start $end "$resconf_user" "$resconf_cust"\
      "$resconf_sonst"
  }
  destroy $w
  focus $old_focus
  .c delete select_box
  UpdateHostDisplay $host
  return 1
}

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 ArmHost {host} {
  global armed_host armed_host_color_bg armed_host_color_ab
  global armed_host_change alarm_minutes
  if {$armed_host != ""} {
    DisarmHost $armed_host
  }
#  if {[CheckDate]} {return}
  UpdateIfChanged $host
  if {[RequestLock "$host"]} {
    # got request lock for host
    set lowername [string tolower ".names.$host"]
    $lowername config -bg $armed_host_color_bg\
      -activebackground $armed_host_color_ab -command "DisarmHost $host"
    set armed_host "$host"
    alarm [expr $alarm_minutes * 60]
    bind .c <ButtonRelease-1> "ReserveHost %x %y"
    bind .c <B1-Motion> "DrawSelectBox %x %y"
    bind .c <1> "VerifyClick %x %y"
    bind .c <3> "DeleteReservation %x %y"
    set armed_host_change 0
    Quickie "you now have 2 minutes to modify ${host}'s schedule" 2
  }
}

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


proc DisarmHost {host} {
  # first thing, turn off alarm
  alarm 0
  global armed_host disarmed_host_color_bg disarmed_host_color_ab
  global work_dir lock_file_extension armed_host_change
  if {$host != $armed_host} {
    Dialog .dialog {Really Screwed} "something really went wrong: trying to\
      disarm host $host but, armed_host set to $armed_host" {} -1 OK
  }
  if {$armed_host_change} {
    # something was changed
    WriteHostFile $armed_host nochgrp
  }
  set armed_host ""
  set lowername [string tolower ".names.$host"]
  $lowername config -bg $disarmed_host_color_bg\
    -activebackground $disarmed_host_color_ab -command "ArmHost $host"
  set lock_name "${work_dir}/${host}.$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.hosts -text "Hosts" -menu .menu.hosts.m -under 0
  menu .menu.hosts.m
  .menu.hosts.m add command -label "Add" -command "AddHost" -under 0
#  .menu.hosts.m add command -label "Delete" -command "DeleteHost" -under 0
  .menu.hosts.m add command -label "Change" -command "ChangeHost" -under 0
  .menu.hosts.m add command -label "Display" -command "DisplayHost" -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.hosts -side left
  pack .menu.help -side right
  tk_menuBar .menu .menu.file .menu.hosts .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 hostnames
  canvas .names -width 2c -height $mc_height;	# -bg blue
  pack .names -side left -fill y
  label .names.corner -text "systems" -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
  set font1 {-bigelow & holmes-menu-medium-r-normal--13-*}
  set font2 {-adobe-helvetica-medium-r-normal--*-100-*}
  if {[TestFont $font1]} {
    set lab_font $font1
  } else {
    set lab_font $font2
  }
  # 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"] %W]
    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}" -font $lab_font
        .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 35c $mc_height" -width 20c -height $mc_height\
#    -xscroll ".hscroll set" -scrollincre $xgap
  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_host starty ygap machines
  if {$armed_host != ""} {
    # call SetSelectMark after check
    set machine [lindex $machines [expr ($y - $starty) / $ygap]]
    if {$machine != $armed_host} {
      puts "SetOrDisplay: machine=$machine, armed_host=$armed_host, call PopErr"
      PopErr "You can only reserve $armed_host."
      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 machines xgap ygap cwidth_pix weekday_num starty
  global week_end_color free_host_color work_dir
  # draw a line of rectangles for each machine for each day
  set y $starty
  foreach machine $machines {
    set general_tag "gen_$machine"
    set lowername [string tolower ".names.$machine"]
    catch {destroy $lowername}
    button $lowername -text "$machine" -relief raised -bg DeepSkyBlue2 \
      -command "ArmHost $machine"
    .names create window 0 $y -anch nw -width 2c -height ${ygap} \
      -window $lowername
    set num 0
    set lab 0
    set x 0
    while {[expr $x + ${xgap}] <= $cwidth_pix} {
      set tag "${machine}_lab${num}"
      set weekdays_tag "${machine}_weekdays"
      set weekend_tag "${machine}_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_host_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 ZeroHostLists {} {
  global machines virgin_biglist biglist
  foreach machine $machines {
    set biglist($machine) "$virgin_biglist"
  }
}

proc UpdateDisplay {} {
  global machines
  foreach host $machines {
    UpdateHostDisplay $host
  }
}  

proc UpdateHostDisplay {host} {
  global polygons num_cells biglist
  global free_host_color week_end_color
  set looking 0
  # get rid of polygons...
  catch {
    foreach foo $polygons($host) {
      .c delete $foo
    }
  }
  catch {unset polygons($host)}
  set halfcell 0
  while {$halfcell < [expr $num_cells * 2]} {
    set tag [lindex $biglist($host) $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 $host $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 $host $this_tag $start_halfcell [expr $num_cells * 2 - 1]
  }
}

proc DrawPolygon {host tag_num start end} {
#  puts "ShowSequence: host: $host, start: $start, end: $end"
  global machines starty ygap xgap reserved_host_color
  global polygons
  set tag "${host}_poly${tag_num}"
  set host_ind [lsearch $machines $host]
  set y1 [expr $host_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_host_color]
  lappend polygons($host) $tag
}
    
proc odd {int} {
  if {[expr $int % 2]} {
    return 1
  }
  return 0
}

proc AddHost {} {
  global add_change machines host_info armed_host_change
  set add_change(hostname) ""
  set add_change(hardware) ""
  set add_change(memory) ""
  set add_change(disks) ""
  set add_change(remarks) ""
  if {[AddChangeHost add] > 0} {
    set host $add_change(hostname)
    if {[lsearch $machines $add_change(hostname)] == -1} {
      lappend machines $host
      set machines [lsort $machines]
      set host_info($host) "{$host} {$add_change(hardware)}\
        {$add_change(memory)} {$add_change(disks)} {$add_change(remarks)}"
      WriteHostFile $host chgrp
      WinInit
      LogIt "{$host: added} {hardware: $add_change(hardware)}\
             {memory: $add_change(memory)} {disks: $add_change(disks)}\
             {remarks: $add_change(remarks)}"
    } else {
      Dialog .dialog {Error} "Hostname $host is already in the system." {error}\
        -1 OK
    }
  }
}

proc DisplayHost {} {
  global machines change_host_selection host_info add_change armed_host
  set w .ch_list
  catch {destroy $w}
  toplevel $w
  wm geometry $w +400+400
  wm title $w "Display Host Information"
  wm iconname $w "Display"
  wm minsize $w 1 1
  message $w.msg -text "Choose a host" -aspect 600
  frame $w.frame -bd 5
  button $w.ok -text OK -command "set change_host_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 $machines"
  tk_listboxSingleSelect $w.frame.list
  bind $w.frame.list <Double-1> "set change_host_selection foo"
  tkwait variab change_host_selection
  set selected [$w.frame.list curselect]
  if {$selected == ""} {
    destroy $w
    return
  }
  set machine [lindex $machines $selected]
#  puts "machine=$machine"
  destroy $w
  if {$machine == ""} {
    destroy $w
    return
  } else {
    set list $host_info($machine)
    set add_change(hostname) [lindex $list 0]
    set add_change(hardware) [lindex $list 1]
    set add_change(memory) [lindex $list 2]
    set add_change(disks) [lindex $list 3]
    set add_change(remarks) [lindex $list 4]
    AddChangeHost display
  }
}

proc AddChangeHost {op} {
  global machines addchange_tablist add_change add_change_button
  set w ".addhost"
  set addchange_tablist "$w.name.hn $w.hardware.entry $w.mem.entry \
    $w.disks.entry $w.remarks.text"
  catch {destroy $w}
  toplevel $w
  wm geometry $w +400+400
  wm iconname $w "Add"
  if {$op == "add"} {
    wm title $w "New Host"
    set msg_text "Add a new host to system"
  } elseif {$op == "change"} {
    wm title $w "Change Host"
    set msg_text "Change host information"
  } else {
    wm title $w "Display Host"
    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"} {
    entry $w.name.hn -relief sunk -width 16 -textvariable add_change(hostname)
  } else {
    label $w.name.hn -relief flat -width 16 -text $add_change(hostname)\
      -bg salmon
  }
  bind $w.name.hn <Tab> "Tab \$addchange_tablist"
  bind $w.name.hn <Return> "Tab \$addchange_tablist"
  label $w.name.label -text "hostname:" -width 10
  pack $w.name.label -side left
  pack $w.name.hn -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.hardware -bd 1m
  entry $w.hardware.entry -rel sunk -width 40 -textvariable add_change(hardware)
  bind $w.hardware.entry <Tab> "Tab \$addchange_tablist"
  bind $w.hardware.entry <Return> "Tab \$addchange_tablist"
  label $w.hardware.label -text "  hardware:" -width 11
  pack $w.hardware.label -side left
  pack $w.hardware.entry -side left
  ####
  frame $w.mem -bd 1m
  entry $w.mem.entry -rel sunk -width 5 -textvariable add_change(memory)
  bind $w.mem.entry <Tab> "Tab \$addchange_tablist"
  bind $w.mem.entry <Return> "Tab \$addchange_tablist"
  label $w.mem.label -text "    memory:" -width 11
  label $w.mem.mb -text "MegaBytes" 
  pack $w.mem.label -side left
  pack $w.mem.entry  -side left
  pack $w.mem.mb  -side left
  ####
  frame $w.disks -bd 1m
  entry $w.disks.entry -rel sunk -width 40 -textvariable add_change(disks)
  bind $w.disks.entry <Tab> "Tab \$addchange_tablist"
  bind $w.disks.entry <Return> "Tab \$addchange_tablist"
  label $w.disks.label -text "     disks:" -width 11
  pack $w.disks.label -side left
  pack $w.disks.entry -side left
  ####
  frame $w.remarks -bd 1m
  frame $w.remarks.lframe
  label $w.remarks.lframe.label -text "remarks:" -width 11
  pack $w.remarks.lframe -side left -fill y
  pack $w.remarks.lframe.label -side top
  text $w.remarks.text -relief sunk -bd 2 -height 3 -width 40 -wrap word
  bind $w.remarks.text <Tab> "Tab \$addchange_tablist"
  bind $w.remarks.text <Return> "Tab \$addchange_tablist"
  pack $w.remarks.text -side left
  if {($op == "change")||($op == "display")} {
    $w.remarks.text insert 0.0 $add_change(remarks)
  }
  ####
  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.hardware -fill x
  pack $w.mem -fill x
  pack $w.disks -fill x
  pack $w.remarks
  pack $w.buttons -pady 3m -ipady 2m -fill x
  tkwait variab add_change_button
  if {($add_change_button == "cancel")||($add_change(hostname) == "")} {
    destroy $w
    return -1
  }
  set add_change(remarks) [$w.remarks.text get 0.0 end]
  destroy $w
  return 1
}

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 machines mc_height ygap starty
  set mc_height [expr [llength $machines] * $ygap + $starty]
  BuildCanvas
  MakeHeader
  MakeMatrix
  ReadAllHosts
  UpdateLists
  UpdateDisplay
}
  

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