# cupsched - An event schedule program including budget events.
# Event module.
# Rick Smereka, Copyright (C) 2008.

# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.

# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.

# You should have received a copy of the GNU General Public License
# along with this program; if not, get a copy via the Internet at
# http://gnu.org/copyleft/gpl.html or write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston,
# MA 02111-1307 USA

# You can contact the author via email at rsmereka@future-lab.com

# Orginal tcl version. Aug/2008, Rick Smereka

proc ac_event {event} {
   # Add or change event non-modal dialog. Upon change, 'event' is
   # expected to be loaded with the event number, upon add 'event' should
   # be an empty string.
   global event_dom event_desc event_cat event_planned event_actual
   global sched_cat_tid DBENG_OK CAT_COUNT_REC CAT_FIELD_NUM SCHED_FIELD_CAT
   global CAT_FIELD_DESC sched_tid SCHED_FIELD_DATE SCHED_FIELD_DESC
   global CAT_FIELD_TYPE SCHED_FXP_SCALE SCHED_FIELD_PLANNED CAT_TYPE_NA
   global SCHED_FIELD_ACTUAL
   set mname "ac_event"
   set dlg .acedialog
   set newevent 1

   # check for already existing open event window
   if {[winfo exists $dlg] == 1} {
      focus $dlg.desc
      return
   }

   if {$event != ""} {
      set newevent 0
   }

   # if changing an existing event record, point to it
   if {!$newevent} {
      if {[set ret [db_top $sched_tid]] != $DBENG_OK} {
         warning_error "$mname\n\nerror going to top of schedule table(\
                       [db_io_code_string $ret])"
         return
      }

      if {[set ret [db_find_field $sched_tid 0 $event $SCHED_FIELD_DATE]] != \
          $DBENG_OK} {
         warning_error "$mname:\n\nunable to find existing event($event)"
         return
      }
   } 

   # create window
   toplevel $dlg
   wm protocol $dlg WM_DELETE_WINDOW "destroy $dlg"

   if {$newevent} {
      wm title $dlg "Add Event"
   } else {
      wm title $dlg "Modify Event"
   }

   # day of month option menu
   set frm $dlg.fdom
   frame $frm
   label $frm.label -text "Day of Month:" -anchor w

   # get day of month string
   set dom_string [get_dom]

   # I cannot find a way to supply a list to 'tk_optionMenu'
   # so I am using 'eval'
   set stmt "tk_optionMenu $frm.dom event_dom $dom_string"
   eval $stmt

   if {!$newevent} {
      if {![ll_word $event tmp 1 "."]} {
         warning_error "$mname\n\nerror getting event date($event)"
         return
      }

      set event_dom [int_remove_lz [string range $event 2 3]]
   } else {
      set event_dom [int_remove_lz [string range [get_time] 6 7]]
   }

   pack $frm.label $frm.dom -side left

   # build a space delimited string of all categories
   if {[set ret [db_top $sched_cat_tid]] != $DBENG_OK} {
      warning_error "$mname\n\nerror going to top of category table(\
            [db_io_code_string $ret])"
      destroy $dlg
      return
   }

   # error if no categories
   if {[set ret [db_next $sched_cat_tid]] != $DBENG_OK} {
      warning_error "$mname\n\nno categories([db_io_code_string $ret])"
      destroy $dlg
      return
   }

   set cat_list ""
   set cat_count 1

   while {$ret == $DBENG_OK} {
      if {[set ret [db_get_field $sched_cat_tid $CAT_FIELD_NUM num]] != \
          $DBENG_OK} {
         warning_error "$mname\n\nerror getting category count(\
                        [db_io_code_string $ret])"
         destroy $dlg
         return
      }

      # ignore counter record
      if {$num == $CAT_COUNT_REC} {
         set ret [db_next $sched_cat_tid]
         continue
      }

      if {[set ret [db_get_field $sched_cat_tid $CAT_FIELD_DESC desc]] != \
          $DBENG_OK} {
         warning_error "$mname\n\nerror getting category desc(\
                        [db_io_code_string $ret])"
         destroy $dlg
         return
      }

      if {$cat_count > 1} {
         append cat_list " "
      }

      append cat_list "\"$num $desc\""
      set ret [db_next $sched_cat_tid]
      incr cat_count
   }

   # category option menu
   set frm $dlg.fcat
   frame $frm
   label $frm.label -text "Category:" -anchor w
   set stmt "tk_optionMenu $frm.cat event_cat $cat_list"
   eval $stmt

   # set current category (number, description and type) if changing an 
   # existing event
   if {!$newevent} {
      # get the current event records category number
      if {[set ret [db_get_field $sched_tid $SCHED_FIELD_CAT num]] != \
          $DBENG_OK} {
         warning_error "$mname\n\nerror getting category number(\
                        [db_io_code_string $ret])"
         destroy $dlg
         return
      }

      if {[set ret [db_top $sched_cat_tid]] != $DBENG_OK} {
         warning_error "$mname\n\nerror going to top of category table(\
                        [db_io_code_string $ret])"
         destroy $dlg
         return
      }

      if {[set ret [db_find_field $sched_cat_tid 0 $num $CAT_FIELD_NUM]] != \
          $DBENG_OK} {
         warning_error "$mname:\n\nunable to find category record($cat_num)(\
                       [db_io_code_string $ret])"
         destroy $dlg
         return
      }

      if {[set ret [db_get_field $sched_cat_tid $CAT_FIELD_DESC desc]] != \
          $DBENG_OK} {
         warning_error "$mname\n\nerror getting category desc(\
                        [db_io_code_string $ret])"
         destroy $dlg
         return
      }

      if {[set ret [db_get_field $sched_cat_tid $CAT_FIELD_TYPE cat_typ]] != \
          $DBENG_OK} {
         warning_error "$mname\n\nerror getting category type(\
                        [db_io_code_string $ret])"
         destroy $dlg
         return
      }

      set event_cat "$num $desc"
   }

   pack $frm.label $frm.cat -side left

   # event description
   set frm $dlg.fdesc
   frame $frm
   label $frm.label -text "Description:" -anchor w
   
   # load description from existing event (if any)
   if {!$newevent} {
      if {[set ret [db_get_field $sched_tid $SCHED_FIELD_DESC event_desc]] \
          != $DBENG_OK} {
         warning_error "$mname:\n\nerror getting event desc(\
                        [db_io_code_string $ret])"
         destroy $dlg
         return
      }
   } else {
      set event_desc ""
   }

   entry $frm.desc -textvariable event_desc -width 25
   pack $frm.label $frm.desc -side left

   # planned amount
   set frm $dlg.fplanned
   frame $frm
   label $frm.label -text "Planned Amount:" -anchor w

   # load planned amount from existing event (if any)
   # do not load if category type is 'NA'
   if {!$newevent} {
      if {$cat_typ != $CAT_TYPE_NA} {
         if {[set ret [dbfxp_get $sched_tid $SCHED_FIELD_PLANNED \
              $SCHED_FXP_SCALE result]] != $DBENG_OK} {
            warning_error "$mname:\n\nerror getting event planned amount(\
                           [db_io_code_string $ret])"
            destroy $dlg
            return
         }

         if {![fxp_oconv $result $SCHED_FXP_SCALE event_planned]} {
            warning_error "$mname\n\nerror converting planned amount"
            destroy $dlg
            return
         }
      } else {
         set event_planned ""
      }
   } else {
      set event_planned ""
   }

   entry $frm.planned -textvariable event_planned -width 9
   pack $frm.label $frm.planned -side left

   # actual amount
   set frm $dlg.factual
   frame $frm
   label $frm.label -text "Actual Amount:" -anchor w

   # load actual amount from existing event (if any)
   # do not load if category type is 'NA'
   if {!$newevent} {
      if {$cat_typ != $CAT_TYPE_NA} {
         if {[set ret [dbfxp_get $sched_tid $SCHED_FIELD_ACTUAL \
              $SCHED_FXP_SCALE result]] != $DBENG_OK} {
            warning_error "$mname:\n\nerror getting event actual amount(\
                           [db_io_code_string $ret])"
            destroy $dlg
            return
         }

         if {![fxp_oconv $result $SCHED_FXP_SCALE event_actual]} {
            warning_error "$mname\n\nerror converting planned amount"
            destroy $dlg
            return
         }
      } else {
         set event_actual ""
      }
   } else {
      set event_actual ""
   }

   entry $frm.actual -textvariable event_actual -width 9
   pack $frm.label $frm.actual -side left

   # buttons
   set frm $dlg.buttons
   frame $frm

   if {$newevent} {
      set com "ac_event_save \"\""
   } else {
      set com "ac_event_save $event"
   }

   button $frm.ok -text "Ok" -command $com -default active
   button $frm.cancel -text "Cancel" -command "destroy $dlg"
   pack $frm.ok -fill x -side left -expand 1
   pack $frm.cancel -fill x -side left -expand 1
   pack $dlg.fdom $dlg.fcat $dlg.fdesc $dlg.fplanned $dlg.factual $dlg.buttons
   bind $dlg <Key-Return> $com
   bind $dlg <Key-Escape> "destroy $dlg"
   focus $dlg.fdesc.desc
}

proc ac_event_change {} {
   # Attempt to get the selected event and paas the event number to 'ac_event'.
   # Called upon modify/change event.
   set mname "ac_event_change"
   
   if {[set the_event [get_selected_event]] == ""} {
      return
   }

   ac_event $the_event
}

proc ac_event_save {event} {
   # Validate and the event data. If 'event' is not an empty string,
   # it is assumed that we are re-writing an existing event record.
   global month_num sched_tid SCHED_FIELD_DATE DBENG_OK event_desc
   global SCHED_FIELD_DESC event_cat SCHED_FIELD_CAT sched_cat_tid
   global CAT_FIELD_NUM CAT_FIELD_TYPE CAT_TYPE_NA event_planned
   global SCHED_FIELD_PLANNED SCHED_FXP_SCALE event_actual SCHED_FIELD_ACTUAL
   global SCHED_FILTER_ALL sched_changed event_dom
   set mname "ac_event_save"
   set newevent 1

   if {$event != ""} {
      set newevent 0
   }

   # setup a new event record (if new event)
   if {$newevent} {
      db_new $sched_tid
      set ret $event_dom
      set seq [get_next_seq $ret]
      set date [format "%02d%02d.%d" [int_remove_lz $month_num] $ret $seq]
   } else {
      # point to existing record if changing
      if {[set ret [db_top $sched_tid]] != $DBENG_OK} {
         warning_error "$mname\n\nerror going to top of schedule table(\
                       [db_io_code_string $ret])"
         return
      }

      if {[set ret [db_find_field $sched_tid 0 $event $SCHED_FIELD_DATE]] != \
          $DBENG_OK} {
         warning_error "$mname:\n\nunable to find existing event($event)"
         return
      }

      # if day was changed, generate a new key
      set rec_dom [int_remove_lz [string range $event 2 3]]
      set ret $event_dom

      if {$ret != $rec_dom} {
         set seq [get_next_seq $ret]
         set date [format "%02d%02d.%d" [int_remove_lz $month_num] $ret $seq]
      } else {
         set date $event
      }
   }

   if {[set ret [db_put_field $sched_tid $SCHED_FIELD_DATE \
       $date]] != $DBENG_OK} {
      warning_error "$mname\n\nerror putting date field into record(\
                     [db_io_code_string $ret])"
      return
   }
  
   if {[set ret [db_put_field $sched_tid $SCHED_FIELD_DESC $event_desc]] != \
       $DBENG_OK} {
      warning_error "$mname\n\nerror putting desc field into record(\
                     [db_io_code_string $ret])"
      return
   }

   # strip only the category number from dialog
   if {![word $event_cat cat_num 1]} {
      warning_error "$mname\\n\nerror getting category number"
      return
   }

   if {[set ret [db_put_field $sched_tid $SCHED_FIELD_CAT $cat_num]] != \
       $DBENG_OK} {
      warning_error "$mname\n\nerror putting category field into record(\
                     [db_io_code_string $ret])"
      return
   }

   # get category type based on the category number
   if {![xref_category $cat_num cat_typ tmp]} {
      return 0
   }

   # if the event is not a type 'NA', save planned and actual amounts
   if {$cat_typ != $CAT_TYPE_NA} {
      if {[set result [fxp_iconv $event_planned]] == ""} {
         warning_error "$mname\n\nerror converting planned value to fxp"
         return
      }

      if {[set ret [dbfxp_put $sched_tid $SCHED_FIELD_PLANNED \
          $SCHED_FXP_SCALE $result]] != $DBENG_OK} {
         warning_error "$mname\n\nerror putting event planned amount(\
                        [db_io_code_string])"
         return
      }

      if {[set result [fxp_iconv $event_actual]] == ""} {
         warning_error "$mname\n\nerror converting actual value to fxp"
         return
      }

      if {[set ret [dbfxp_put $sched_tid $SCHED_FIELD_ACTUAL \
          $SCHED_FXP_SCALE $result]] != $DBENG_OK} {
         warning_error "$mname\n\nerror putting event actual amount(\
                        [db_io_code_string])"
         return
      }
   }


   if {[set ret [db_write $sched_tid]] != $DBENG_OK} {
      warning_error "$mname\n\nerror writing event record(\
                     [db_io_code_string $ret])"
      return
   }

   # close add/modify dialog and update event display list
   after idle {destroy .acedialog}
   set sched_changed 1
   display_events $SCHED_FILTER_ALL
}

proc delete_event {} {
   # Delete a single event. The specific event is assumed to be
   # currently selected.
   global event_list
   global sched_tid DBENG_OK SCHED_FIELD_DATE SCHED_FILTER_ALL sched_changed

   set mname "delete_event"
   
   if {[set the_event [get_selected_event]] == ""} {
      return
   }

   if {[set ret [db_top $sched_tid]] != $DBENG_OK} {
      warning_error "$mname\n\nerror going to top of table(\
                     [db_io_code_string $ret])"
      return
   }

   # locate the event record in the schedule table
   if {[set ret [db_find_field $sched_tid 0 $the_event\
       $SCHED_FIELD_DATE]] != $DBENG_OK} {
      warning_error "$mname\n\nerror locating event record(\
                     [db_io_code_string $ret])"
      return
   }
         
   if {[set ret [db_delete $sched_tid]] != $DBENG_OK} {
      warning_error "$mname\n\nerror deleteing schedule record(\
                     [db_io_code_string $ret])"
      return
   }

   set sched_changed 1
   display_events $SCHED_FILTER_ALL
}

proc get_dom {} {
   # Build and return a space word delimited string of days
   # in the currently selected month ('month_num').
   global month_num year_num

   set mname "get_dom"
   set dom "1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 "
   append dom "23 24 25 26 27 28"
   set tmp [int_remove_lz $month_num]

   switch $tmp {
      1 {
         append dom " 29 30 31"
      }

      2 {
         if {[isleap $year_num]} {
            append dom " 29"
         }
      }

      3 {
         append dom " 29 30 31"
      }

      4 {
         append dom " 29 30"
      }

      5 {
         append dom " 29 30 31"
      }

      6 {
         append dom " 29 30"
      }

      7 {
         append dom " 29 30 31"
      }

      8 {
         append dom " 29 30 31"
      }

      9 {
         append dom " 29 30"
      }

      10 {
         append dom " 29 30 31"
      }

      11 {
         append dom " 29 30"
      }

      12 {
         append dom " 29 30 31"
      }
   }

   return $dom
}

proc get_event_aplanned {actplan} {
   # Validate and possibly convert a planned or actual amount.
   # Returns the converted number upon success, an empty string
   # otherwise.
   set mname "get_event_aplanned"
   set buf $actplan

   if {[ll_words $buf "."] > 1} {
      ll_word $buf tmp 1 "."

      if {![num $tmp]} {
         warning_error "$mname\n\nInteger portion not numeric."
         return ""
      }

      ll_word $buf tmp 2 "."

      if {![num $tmp]} {
         warning_error "$mname\n\nFractional portion is not numeric"
         return ""
      }

      # one decimal place eg: 50.5
      if {[string length $tmp] == 1} {
         set tmp [format "%s0" $buf]
         set buf $tmp
      }
   } else {
      # whole dollars
      if {![num $buf]} {
         warning_error "$mname\n\nAmount is not numeric"
         return ""
      }

      set tmp [format "%s.00" $buf]
      set buf $tmp
   }

   return $buf
}

proc get_next_seq {day} {
   # Calc the next event sequence number. Returns the
   # sequence number upon success, zero otherwise.
   global event_list month_num
   set seq_int 0

   set nitems [llength $event_list]

   # if the event list is empty, start at one
   if {!$nitems} {
      return 1
   }

   set date [format "%02d%02d" [int_remove_lz $month_num] $day]

   for {set i 0} {$i < $nitems} {incr i} {
      set id [lindex $event_list $i]

      if {[string range $date 0 3] == [string range $id 0 3]} {
         ll_word $id tmp 2 "."

         if {$tmp > $seq_int} {
            set seq_int $tmp
         }
      }
   }

   incr seq_int
   return $seq_int
}



