# cupcalc - An expression calculator.
# Rick Smereka, Copyright (C) 2004-2005.

# 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

# Initial version Feb/2004, Rick Smereka

# Added 'exit' menu option and 'file_exit' procedure. Added 'TCLDIR'
# variable and 'source' statements from that directory.
# Oct/2005, Rick Smereka

# required path to library modules
set TCLDIR /home/rick/gpl/tcl

# menu modules
source $TCLDIR/lib/tk/menu.tcl
source $TCLDIR/lib/tk/menubar.tcl
#
# cut, copy, paste features
source $TCLDIR/lib/tk/cutcopy.tcl
#
# version number
set app(version) "1.00.04-2005.10.09"
#
# application name
set app(appname) cupcalc
#
# input expression line
set app(in_line) ""
#
# last result
set app(last_result) ""
#
global app
#
# create main window
proc app_create {} {
   global app

   wm withdraw .
   toplevel .main

   # trap close other than menu
   wm protocol .main WM_DELETE_WINDOW "file_exit"

   # set title
   wm title .main $app(appname)

   # build menus
   set frm .main.menubar   
   createmenubar .main $frm
   
   # file menu
   set menu_name [createmenu $frm \
      filemenu "File" 0]
   $menu_name add command -label "Run" \
      -underline 0 -accelerator "Ctrl+R" \
      -command {calc}
   $menu_name add separator
   $menu_name add command -label "Save" \
      -underline 0 -accelerator "Ctrl+S" \
      -command {file_save_as .main.obox.text}
   $menu_name add separator
   $menu_name add command -label "Exit" -underline 1 \
      -command "file_exit"

   # edit menu
   set menu_name [createmenu $frm \
      editmenu "Edit" 0]
   $menu_name add command -label "Cut" \
      -underline 2 -accelerator "Ctrl+X" \
      -command {edit_cut .main.obox.text}
   $menu_name add command -label "Copy" \
      -underline 0 -accelerator "Ctrl+C" \
      -command {edit_copy .main.obox.text}
   $menu_name add command -label "Paste" \
      -underline 0 -accelerator "Ctrl+V" \
      -command {edit_paste .main.ibox}
   $menu_name add separator
   $menu_name add command -label "Last Result" \
      -underline 0 -accelerator "Ctrl+L" \
      -command {insert_last_result}

   # help menu
   set menu_name [createmenu $frm \
      helpmenu "Help" 0]
   $menu_name add command -label "About" \
      -underline 0 \
      -command {help_about .main}

   # set initial font
   font create editfont -family courier -size 10
   entry .main.ibox -width 60 -textvariable $app(in_line) \
      -font editfont
   pack .main.ibox
   set frm .main.obox
   frame $frm -bd 4 -relief sunken
   text $frm.text -width 60 -height 10 -wrap word \
      -yscrollcommand "$frm.vscroll set" \
      -font editfont
   scrollbar $frm.vscroll -command "$frm.text yview"
   pack $frm.vscroll -side right -fill y
   pack $frm.text -side left -fill both -expand 1
   pack $frm -side right -fill both -expand 1

   bind $frm.text <Control-x> "edit_cut $frm.text; break"
   bind $frm.text <Control-c> "edit_copy $frm.text; break"
   bind $frm.text <Control-v> "edit_paste $frm.text; break"
   bind .main.ibox <Control-x> "edit_cut .main.ibox; break"
   bind .main.ibox <Control-c> "edit_copy .main.ibox; break"
   bind .main.ibox <Control-v> "edit_paste .main.ibox; break"
   bind .main.ibox <Key-Return> {calc}
   bind .main <Control-r> {calc}
   bind .main <Control-s> "file_save_as $frm.text; break"
   bind .main <Control-l> "insert_last_result; break"

   # popup edit menu on rightmost mouse button
   # two separate menus, one for input and one for output
   bind $frm.text <Button-3> {
      # get global X position of app
      set gx [winfo rootx %W]

      # get global Y position of app
      set gy [winfo rooty %W]

      # add to local mouse position
      set mx [expr $gx + %x]
      set my [expr $gy + %y]

      # display popup menu
      tk_popup .popupo $mx $my
   }

   bind .main.ibox <Button-3> {
      # get global X position of app
      set gx [winfo rootx %W]

      # get global Y position of app
      set gy [winfo rooty %W]

      # add to local mouse position
      set mx [expr $gx + %x]
      set my [expr $gy + %y]

      # display popup menu
      tk_popup .popupi $mx $my
   }

   # create input popup menu
   menu .popupi
   .popupi add command -label "Cut" \
      -command "edit_cut .main.ibox"
   .popupi add command -label "Copy" \
      -command "edit_copy .main.ibox"
   .popupi add command -label "Paste" \
      -command "edit_paste .main.ibox"

   # create output popup menu
   menu .popupo
   .popupo add command -label "Cut" \
      -command "edit_cut $frm.text"
   .popupo add command -label "Copy" \
      -command "edit_copy $frm.text"
   .popupo add command -label "Paste" \
      -command "edit_paste $frm.text"

   update
   focus .main.ibox
}

proc file_exit {} {
   # Exit the application.
   exit
}

proc edit_cut {textwidget} {
   # Text cut
   cut_text $textwidget
}

proc edit_copy {textwidget} {
   # Text copy
   copy_text $textwidget
}

proc edit_paste {textwidget} {
   # Text paste
   paste_text $textwidget
}

proc help_about {toplevel} {
   # Display about box
   global app
   tk_messageBox -default ok -icon info -message \
      "$app(appname) Version $app(version)

An expression calculator.
by Rick Smereka
Copyright (c) 2004-2005" \
          -parent $toplevel -title "About $app(appname)" -type ok

   focus .main.ibox
}

proc calc {} {
   global app

   set line [.main.ibox get]

   if {$line == ""} {
      return
   }

   # evaluate
   set result ""

   catch {
      set result [expr $line]
   }

   # if result is a null string, expression
   # was not valid
   if {$result == ""} {
      tk_messageBox -icon error \
         -message "That is not a valid numeric expression." \
         -parent .main -title "Numeric expression error" \
         -type ok

      focus .main.ibox
      return
   }

   # save this result
   set app(last_result) $result

   # display expression with result
   # get date and time
   set datime [clock seconds]
   set dat "("
   append dat [clock format $datime -format "%Y/%m/%d-%H:%M:%S"]
   append dat ")"
   append dat $line
   append dat " = "
   set frm .main.obox.text

   # display result
   append dat $result
   append dat "\n"
   $frm insert end $dat

   # scroll output (if necessary)
   set idx [$frm index end]
   $frm yview -pickplace $idx

   # delete expression line
   .main.ibox delete 0 end
}

proc insert_last_result {} {
   global app
   # take last result and insert it into the current
   # cursor position on the expression line
   .main.ibox insert insert $app(last_result)
}

proc file_save_as {textwidget} {
   # returns one (1) upon success, zero upon
   # cancel request
   set filename [file_save_get]

   if {$filename != ""} {
      # save file
      file_save $filename $textwidget
      return 1
   }

   return 0
}

proc file_save_get {} {
   set file_types {
      {"Log files" { .log .LOG}}
      {"Text files" {.txt .TXT}}
      {"ALL Files" *}
   }

   set filename [tk_getSaveFile -initialdir . \
      -filetypes $file_types \
      -title "Select file name to save" \
      -parent .main]

   return $filename
}

proc file_save {filename textwidget} {
   set data [$textwidget get 1.0 {end -1c}]

   # remove any ending newlines
   set text [string trimright $data]
   return [file_write $filename $data]
}

proc file_write {filename data} {
   return [catch {
      set fileid [open $filename "w"]
      puts -nonewline $fileid $data
      close $fileid
      }]
}

# app main line
tk appname $app(appname)
app_create
