#!/usr/local/bin/wish -f
set Revision_string {$Revision: 1.6 $}


proc Entry_MoveCursor {w inc} {
       set x [expr "[$w index insert] + $inc"]
       if {$x == -1} then {set x 0}
       if {$x >= [$w index end]} then {set x end}
       $w icursor $x
}

proc Text_DeleteSelection { w } {
  catch {$w delete sel.first sel.last}
}
proc Text_InsertSelection { w } {
  catch {$w insert insert [selection get]}
  $w yview -pickplace insert
}

proc Text_MoveLeft { w } {
  $w mark set insert {insert - 1 chars}
  $w yview -pickplace insert
}
proc Text_MoveRight { w } {
  $w mark set insert {insert + 1 chars}
  $w yview -pickplace insert
}
proc Text_MoveUp { w } {
  $w mark set insert {insert - 1 lines}
  $w yview -pickplace insert
}
proc Text_MoveDown { w } {
  $w mark set insert {insert + 1 lines}
  $w yview -pickplace insert
}

proc redrawSpreadsheet {name line op} {
  global Columns Colnames Colwidth Numlines prevNumlines total 
  if {$Numlines == $prevNumlines+1} {
     createLine $prevNumlines     
     set prevNumlines $Numlines
     return
  }
  if {$Numlines == $prevNumlines-1} {
     delLine $Numlines
     set prevNumlines $Numlines
     return
  }
  set prevNumlines $Numlines
  catch {destroy .sheet.spread}
  
  pack [frame .sheet.spread] -side left -fill x -expand 1
  set i 0
  foreach col $Columns {
     pack [frame .sheet.spread.$col] -side left -fill x -expand 1
     pack [label .sheet.spread.$col.label \
             -text [lindex $Colnames $i] \
          ]
     incr i
  }
  pack [frame .sheet.spread.total] -side left 
  pack [label .sheet.spread.total.label -text Total]
  
  
  
  for {set j 0} {$j<$Numlines} {incr j} {
        createLine $j
  }
  
}

proc delLine {line} {
   global Columns total
   foreach col $Columns {
      destroy .sheet.spread.$col.$line
      global $col
      unset ${col}($line)
   }
   destroy .sheet.spread.total.$line
   unset total($line)
}

proc createLine {line} {
    global Columns Colwidth total

    for {set column 0} {$column<[llength $Columns]} {incr column} {
        set col [lindex $Columns $column]
        pack [entry .sheet.spread.$col.$line \
                -relief sunken\
                -width [lindex $Colwidth $column] \
                -textvariable ${col}($line) \
             ] -fill x -expand 1
        global $col
        trace variable ${col}($line) w updateLineTotal
        bind .sheet.spread.$col.$line <Return>    "move_over $column+1 $line"
        bind .sheet.spread.$col.$line <Tab>       "move_over $column+1 $line"
        bind .sheet.spread.$col.$line <Shift-Tab> "move_over $column-1 $line"
        bind .sheet.spread.$col.$line <Up>        "move_over $column   $line-1"
        bind .sheet.spread.$col.$line <Down>      "move_over $column   $line+1"
    }
    pack [entry .sheet.spread.total.$line -relief sunken  -width 7 -textvariable total($line)]
    .sheet.spread.total.$line configure -state disabled
    trace variable total($line) wu updateTotal
}

proc move_over {col row} {
    global Columns Numlines
    set col [expr $col]
    if {$col==[llength $Columns]} {incr row}
    if {$col==-1}                 {incr row -1}
    set row [expr ($row)%$Numlines]
    set col [expr ($col)%[llength $Columns]]
    focus .sheet.spread.[lindex $Columns $col].$row
}

proc widgets2ps {w {filename ""}} {
   set Date [exec date]

   
      set BBoxMinX  30 
      set BBoxMinY 100
      set BBoxMaxX 600
      set BBoxMaxY 700
   
      set Width  [winfo width  .]  
      set Height [winfo height .]
      # to get floating point division
      set BBoxWidth  [expr 1.0*$BBoxMaxX-$BBoxMinX-20.0]
      set BBoxHeight [expr 1.0*$BBoxMaxY-$BBoxMinY]
   
      # We set X/Ycoef and tighten up BBox
      if {$Width/$Height >  $BBoxWidth/$BBoxHeight} {
        # widget wider than BBox
        set Xcoef [expr $BBoxWidth/$Width]
        set Ycoef $Xcoef
        set BBoxMaxY [expr $BBoxMinY+$Height/$Ycoef]
      } else {
        # widget taller than BBox
        set Ycoef [expr $BBoxHeight/$Height]
        set Xcoef $Ycoefx
        set BBoxMaxX [expr $BBoxMinX+$Width/$Xcoef]
      }
   
   
      append PS "%!PS-Adobe-3.0 EPSF-3.0\n"
      append PS "%%Creator: Purchase, v. 1.0\n"
      append PS "%%Title: Purchase order printout\n"
      append PS "%%CreationDate: $Date\n"
      append PS "%%BoundingBox: $BBoxMinX $BBoxMinY $BBoxMaxX $BBoxMaxY\n"
      append PS "%%Pages: 1\n"
      append PS "%%DocumentData: Clean7Bit\n"
      append PS "%%Orientation: Portrait\n"
      append PS "%%EndComments\n"
      
      append PS "\n\n 30 700 translate\n"   
      
      printwidgets $w 0 0
      append PS "showpage\n"
   

   if {$filename!=""} { 
        set PSfile [open $filename w] 
        puts $PSfile $PS
        close $PSfile
   }
   return $PS
}

proc printwidgets {w X Y} {
   upvar Xcoef Xcoef Ycoef Ycoef PS PS

   foreach widget [winfo children $w] {
        set class [winfo class $widget]
        set value ""
        set x [expr  $Xcoef*($X+[winfo x $widget])]
        set y [expr -$Ycoef*($Y+[winfo y $widget])]
#        outPSstring $x $y-10 [list Adobe Helvetica 50] \
#           [list - $w:$widget ($class) - $X $Y [winfo x $widget] [winfo y $widget] $x $y]
        if {$class=="Entry"} { 
          
                      set value [$widget get] 
                      set fontInfo [getfont $widget]
                      set txtSize [lindex $fontInfo 2]
                      set y [expr $y+$Ycoef*([winfo height $widget]-$txtSize/10.0)/2.0]
                      outPSstring $x $y $fontInfo $value
          
        }
        if {$class=="Label"} { 
            set value [lindex [$widget configure -text] 4]
            outPSstring $x $y [getfont $widget] $value
        }
        if {$class=="Text"} { 
          
                    set fontInfo [getfont $widget]
                    set first [$widget index @0,0]
                    regexp {([0-9]+)\.([0-9]+)} $first foo firstline firstchar
                    for {set i $firstline} { $i<[lindex [$widget configure -height] 3] } {incr i} {
                      set line [$widget get $i.$firstchar "$i.$firstchar lineend"]
                      outPSstring $x $y $fontInfo $line
                      set y [expr $y-[lindex $fontInfo 2]/10*1.1]
                    }
                    
        }
        if {$class=="Frame"} { 
            printwidgets $widget [expr $X+[winfo x $widget]] [expr $Y+[winfo y $widget]]
        }
   }
}

proc getfont {w} {
        set fname [lindex [$w configure -font] 4]
        regexp {[-]([^-]*)-([^-]*-[^-]*)-.*-([0-9]+)-.*} $fname foo \
                    foundry font             size
        return [list  $foundry $font $size]
}

proc outPSstring {x y font string} {
        upvar PS PS 

        # Set up font mapping for some often-used fonts
        set FontMap(Times-Medium) Times-Roman
        set FontMap(Helvetica-Medium) Helvetica

        set fontname [lindex $font 1]
        if [info exists FontMap($fontname)] {set fontname $FontMap($fontname)}
        # need slightly smaller font size; PS font metrics seem to be a little wider
        set fontsize [expr [lindex $font 2]/10.0/1.1]
        set y [expr $y-$fontsize]
        append PS "/$fontname findfont $fontsize scalefont setfont\n"
        append PS "$x $y moveto ($string) show\n"
}

proc label.entry  {wfield labeltext {initval ""} {width 20}} {
        global $wfield
        frame $wfield
        label $wfield.lab -text $labeltext -relief flat
        entry $wfield.val -relief sunken -bd 1 -width $width -textvariable $wfield
        set $wfield $initval
        pack $wfield.lab $wfield.val -side left -padx 5
        return $wfield
}

proc updateLineTotal {name line op} {
   global qty disct upric total current_file_dirty
   set total($line) [expr \
        [Flt $qty($line)]*(1.0-[Flt $disct($line)]/100.0)*[Flt $upric($line)]]
   set current_file_dirty 1
}

proc Flt {f} {if {$f==""} {return 0} ; return $f}

proc updateTotal {name line op} {
   global qty disct upric total TotalFigure Numlines 
   set TotalFigure 0
   for {set i 0} {$i<$Numlines} {incr i} {
       if [info exists total($i)] { 
           set TotalFigure [expr $TotalFigure+[Flt $total($i)]]}
   }
}

proc savefile {} {
   global Numlines Columns item descr qty disct upric total current_file  current_file_dirty

  if {[info vars current_file]=={}} {set current_file "my.order"}
  set fname [pkl_OutFileSelectorBox .f {Save file selection} $current_file]
  if {$fname != ""} {

   set current_file $fname
   set file [open $fname w]

   foreach fld { ordtype date req tel datr } {
        global .sheet.$fld
        puts $file "set .sheet.$fld [list [set .sheet.$fld]]"
   }
   puts $file  ".sheet.vendor delete 1.0 end"
   puts $file  ".sheet.shipto delete 1.0 end"
   puts $file  ".sheet.vendor insert 1.0 [list [.sheet.vendor get 1.0 end]]"
   puts $file  ".sheet.shipto insert 1.0 [list [.sheet.shipto get 1.0 end]]"

   puts $file "set Numlines $Numlines"
   for {set j 0} {$j<$Numlines} {incr j} {
      foreach col $Columns {
        set val [list [set ${col}($j)]]
        puts $file "set ${col}($j) $val"
      }
      # I don't need totals, because they will be recomputed by traces
      #puts $file "set total($j) $total($j)"
   }
   close $file
  }
  set current_file_dirty 0
}

proc pkl_OutFileSelectorBox {w title current_file} {
  global $w.t.labent

  catch {destroy $w};   toplevel $w
  wm title $w $title
  pack [frame $w.t -relief groove -bd 2] [frame $w.b -bd 2]
  pack [label.entry  $w.t.labent File $current_file]
  bind $w.t.labent.val <Return>  "destroy $w"
  bind $w.t.labent.val <KP_Enter>  "destroy $w"
  bind $w.t.labent.val <Double-Button-1>  "destroy $w"
  pack [frame $w.b.default -relief sunken -bd 1] -side left -expand 1 -padx 3m -pady 1m
  pack [button $w.b.default.ok -text OK -command "destroy $w"] -expand 1 -padx 1m -pady 1m
  pack [button $w.b.can -text Cancel -command "set $w.t.labent {}; destroy $w"] -side right -padx 3m

  set oldfocus [focus];   grab $w ;   focus $w.t.labent.val
  tkwait window $w ;                  focus $oldfocus
  return [set $w.t.labent]
}

proc getfile {} {
  global current_file
  set current_file [gp_SingleFileSelectorBox .f {Input file selection} *.order]
  if {$current_file != ""} {
     uplevel "source $current_file"
  }
}

proc printfile {} {
   widgets2ps .sheet dump.ps
   exec lpr -P5 dump.ps
   exec /bin/rm dump.ps
}

proc destroyP {} {
  global current_file_dirty

  if {$current_file_dirty} {
    set res [tk_dialog .error {File not saved} "Your work hasn't been saved" error 0 Save Exit Cancel]
    if {$res==0} {
        savefile
    } elseif {$res==2} {
        return
    }
  }
  destroy .
}

proc about {} {
  global Revision_string
  tk_dialog .about {About...} \
      "Purchase order spreadsheet\n$Revision_string\nPrzemek Klosowski\nprzemek@nist.gov" info 0 OK
}



wm minsize . 200 300

set bigfont -Adobe-Times-Medium-R-Normal-*-180-*

set current_file_dirty 0


   bind Entry <Key-Left>  {Entry_MoveCursor %W -1}
   bind Entry <Key-Right> {Entry_MoveCursor %W 1}
   bind Entry <Return>    {puts "\a"}
   bind Entry <Control-y> {catch {%W insert insert [selection get]} 
                           tk_entrySeeCaret %W }
   bind Entry <Control-w> {catch {%W delete sel.first sel.last}
                           tk_entrySeeCaret %W}
  bind Text <Left>           {Text_MoveLeft %W}
  bind Text <Up>             {Text_MoveUp %W}
  bind Text <Right>          {Text_MoveRight %W}
  bind Text <Down>           {Text_MoveDown %W}

# bindings affecting selection
  bind Text <2>              {Text_InsertSelection %W}
  bind Text <Control-y>      {Text_InsertSelection %W}
  bind Text <Control-w>      {Text_DeleteSelection %W}


set Columns  { item descr        qty  disct   upric       }
set Colnames { Item Description  Qty "%disc" "Unit Price" }
set Colwidth { 10   60           3    4       7           }


pack [frame .mbar -relief raised -bd 2] \
     [frame .sheet] -side top -fill x

set mf .mbar.file
set mo .mbar.options

menubutton $mf -menu $mf.menu -underline 0 -text File
menubutton $mo -menu $mo.menu -underline 0 -text Options 

menu $mf.menu
$mf.menu add command -label "About.." -underline 0 -command { about  }
$mf.menu add command -label "Read"    -underline 0 -command { getfile  }
$mf.menu add command -label "Print"   -underline 0 -command { printfile }
$mf.menu add command -label "Save"    -underline 0 -command { savefile }
$mf.menu add command -label "Exit"    -underline 1 -command { destroyP }

menu $mo.menu
$mo.menu add radiobutton -variable .sheet.ordtype \
        -label "PO"  -value "Procurement request"
$mo.menu add radiobutton -variable .sheet.ordtype \
        -label "BPA" -value "BPA & Credit Card Order Form"
if {[set .sheet.ordtype]==""} {
        set .sheet.ordtype "BPA & Credit Card Order Form"
}

pack $mf $mo -side left
tk_menuBar .mbar $mf $mo
focus .mbar


  
  pack [label .sheet.title -font $bigfont -textvariable .sheet.ordtype] -side top 
  set Date [exec date {+%B %d, %y}]
  pack [label.entry .sheet.date Date $Date] -anchor nw -fill x
  pack [frame .sheet.who] -fill x
    pack [label.entry .sheet.req  Requisitioner "Przemek Klosowski"] \
          -in .sheet.who -side left       
    pack [label.entry .sheet.tel  Telephone "x6249"] \
          -in .sheet.who -side right
  pack [label.entry .sheet.datr "Date required" ] -anchor nw
  pack [frame .sheet.2] -fill x
    pack [label .sheet.vendl -text Vendor] \
          -in .sheet.2 -side left
    pack [label .sheet.shiptol -text "Ship to"] \
          -in .sheet.2 -side right
  pack [frame .sheet.3] -fill x
    pack [text  .sheet.vendor -relief sunken  -bd 2 -height 4 -width 30] \
          -in .sheet.3 -side left -anchor nw
    pack [text  .sheet.shipto -relief sunken  -bd 2 -height 2 -width 20] \
          -in .sheet.3 -side right -anchor ne
  pack [label .sheet.superil -text "Supervisor initials"] -anchor ne
  
  
  pack [frame .sheet.totalframe] -side bottom -fill x -anchor se -pady 11
    label .sheet.totalfig -textvariable TotalFigure -width 7 -relief raised
    pack .sheet.totalfig \
          -in .sheet.totalframe \
          -side right -anchor n
    pack [label .sheet.totalL -text TOTAL] \
          -in .sheet.totalframe \
          -side right -anchor n -padx 20
  
    pack [button .sheet.numlinesD -relief raised  -text <  -command { incr Numlines -1 }] \
          -in .sheet.totalframe   -side left -anchor n
    pack [entry .sheet.numlines   -relief raised  -textvariable Numlines -width 3] \
          -in .sheet.totalframe   -side left -anchor n
    pack [button .sheet.numlinesI -relief raised  -text >  -command {incr Numlines}] \
          -in .sheet.totalframe   -side left -anchor n
  
  trace variable Numlines w redrawSpreadsheet
  set  prevNumlines -999 
  set     Numlines 10


  if {$argc >= 1} {
    if {$argc > 1} {
      tk_dialog .error {Command line error} "Too many arguments ($argc)" error 0 OK
    }
    set current_file [lindex $argv 0]
    if [file isfile $current_file] {
      source $current_file
    } else {
      tk_dialog .info {New file} "File $current_file doesn't exist; creating a new one" info 0 OK
    }
  }

