# cupsched - An event schedule program including budget events.
# Category 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. Jul/2008, Rick Smereka

proc vc_categories {} {
   # Display categories non-modal dialog.
   global listfont
   set dlg .vcdialog

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

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

   # create category list box
   set line "ID Description        Type"
   frame $dlg.categories -bd 0
   label $dlg.categories.lab -text $line -anchor w -font listfont
   frame $dlg.categories.frm
   listbox $dlg.categories.frm.dat -height 10 -width 28 \
      -selectmode single -exportselection false \
      -yscrollcommand "$dlg.categories.frm.scr1 set" \
      -font listfont
   scrollbar $dlg.categories.frm.scr1 -command "$dlg.categories.frm.dat yview"
   pack $dlg.categories.frm.dat -side left
   pack $dlg.categories.frm.scr1 -side right -fill y
   pack $dlg.categories.lab -pady 4 -side top -fill x
   pack $dlg.categories.frm -side bottom
   pack $dlg.categories -side left
   set fr $dlg.buttons
   frame $fr -bd 0
   button $fr.add -text "Add" -command "ac_category $dlg" -default active
   button $fr.cancel -text "Cancel" -command "destroy $dlg"
   pack $fr.add $fr.cancel $fr -side top -fill x
   bind $dlg <Key-Return> "ac_category $dlg"
   bind $dlg <Key-Escape> "destroy $dlg"
   display_categories
   update
   focus $dlg.categories
}

proc display_categories {} {
   global sched_cat_tid DBENG_OK CAT_FIELD_NUM CAT_FIELD_TYPE CAT_COUNT_REC
   global CAT_FIELD_DESC CAT_TYPE_CREDIT CAT_TYPE_DEBIT CAT_TYPE_NA
   set mname "display_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])"
      return
   }

   # error getting the first record is assumed to be no records,ok
   if {[set ret [db_next $sched_cat_tid]] != $DBENG_OK} {
      warning_error "$mname\n\nno categories([db_io_code_string $ret])"
      return
   }

   set dlg .vcdialog.categories.frm.dat
   set nitems [$dlg size]

   if {$nitems > 0} {
      $dlg delete 1 $nitems
   }

   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])"
         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 count(\
                        [db_io_code_string $ret])"
         return
      }

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

      if {![num $type]} {
         warning_error "$mname\n\ncategory($desc) type is not numeric"
         return
      }

      switch $type \
         $CAT_TYPE_CREDIT {set type_desc "credit"} \
         $CAT_TYPE_DEBIT {set type_desc "debit"} \
         $CAT_TYPE_NA {set type_desc "NA"} \
         default {warning_error "$mname\n\ncategory($desc) type code is\
                  out of range";return}

      append_category_line $num $desc $type_desc
      set ret [db_next $sched_cat_tid]
   }

   focus $dlg
}

proc ac_category {tw} {
   # Add category modal dialog box. Returns nothing.
   global catdesc catype

   set dlg .acdialog
   toplevel $dlg
   wm group $dlg $tw
   wm title $dlg "Add Category"
   wm resizable $dlg 0 0
   wm transient $dlg $tw
   grab $dlg

   set frm $dlg.cat
   frame $frm
   label $frm.label -text "Category Description:" -anchor w
   entry $frm.catdesc -textvariable catdesc -width 25
   pack $frm.label $frm.catdesc -side left

   set frm $dlg.type
   frame $frm
   label $frm.label -text "Type:" -anchor w
   set catype "Debit"
   tk_optionMenu $frm.catype catype Credit Debit NA
   pack $frm.label $frm.catype -side left

   set frm $dlg.buttons
   frame $frm
   button $frm.ok -text "Ok" -command "add_category" -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.cat $dlg.type $dlg.buttons
   bind $dlg <Key-Return> "add_category"
   bind $dlg <Key-Escape> "destroy $dlg"
   focus $dlg.cat.catdesc
}

proc append_category_line {id desc type} {
   # append a line to the end of the listbox
   set line [lpad $id " " 2]
   append line " "
   append line [rpad $desc " " 17]
   append line "  "
   append line [rpad $type " " 6]
   .vcdialog.categories.frm.dat insert end $line
}

proc add_category {} {
   # Add category records.
   global CAT_TYPE_CREDIT CAT_TYPE_DEBIT CAT_TYPE_NA CAT_FIELD_NUM
   global sched_cat_changed sched_cat_tid DBENG_OK CAT_FIELD_DESC
   global CAT_FIELD_TYPE catdesc catype
   set mname "add_category"
   set dlg .acdialog

   if {[trim $catdesc] == ""} {
      warning_error "$mname\n\nCategory description must be supplied"
      focus $dlg
      after idle [focus $dlg.cat.catdesc]
      return
   }

   switch [string range $catype 0 0] {
      C {
         set type_int $CAT_TYPE_CREDIT
      }

      D {
         set type_int $CAT_TYPE_DEBIT
      }

      N {
         set type_int $CAT_TYPE_NA
      }

      default {
         warning_error "$mname\n\ninvalid calc type"
         return
      }
   }

   if {[set cat_id [get_category_count]] == 0} {
      return
   }
            
   if {[set ret [db_put_field $sched_cat_tid $CAT_FIELD_NUM $cat_id]] \
       != $DBENG_OK} {
      warning_error "$mname\n\nerror putting category id(\
            [db_io_code_string $ret])"
      return
   }

   if {[set ret [db_put_field $sched_cat_tid $CAT_FIELD_DESC $catdesc]] \
       != $DBENG_OK} {
      warning_error "$mname\n\nerror putting category description(\
            [db_io_code_string $ret])"
      return
   }

   if {[set ret [db_put_field $sched_cat_tid $CAT_FIELD_TYPE $type_int]] \
       != $DBENG_OK} {
      warning_error "$mname\n\nerror putting category calc type(\
            [db_io_code_string $ret])"
      return
   }

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

   # close add category dialog and update category display list
   after idle {destroy .acdialog}
   display_categories
}

proc get_category_count {} {
   # Locate the category table count record, retrieve the count,
   # increment it and re-write the counter record. Returns the
   # category number upon success, zero otherwise.
   global sched_cat_tid DBENG_OK sched_cat_changed CAT_COUNT_REC
   set mname "get_category_count"

   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])"
      return 0
   }

   if {[set ret [db_find_field $sched_cat_tid 0 $CAT_COUNT_REC 1]] \
       != $DBENG_OK} {
      warning_error "$mname\n\nerror finding category count(\
            [db_io_code_string $ret])"
      return 0
   }

   if {[set ret [db_get_field $sched_cat_tid 2 buf]] != $DBENG_OK} {
      warning_error "$mname\n\nerror getting category count(\
            [db_io_code_string $ret])"
      return 0
   }

   if {![num $buf]} {
      warning_error "$mname\n\ncategory count is not numeric"
      return 0
   }

   set cnt [expr $buf + 1]
   
   if {[set ret [db_put_field $sched_cat_tid 2 $cnt]] != $DBENG_OK} {
      warning_error "$mname\n\nerror putting category count(\
            [db_io_code_string $ret])"
      return 0
   }

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

   set sched_cat_changed 1
   return $buf
}

