#!/usr/bin/wish
# kleiner upn-Taschenrechner!

set pi 3.1415926535

# bringt ein Element auf den Stack:
#
proc tostack {element} {
  global Stack
  if {$element !={}} {
     $Stack insert end $element
     $Stack see end
  }
}

# entfernt (löscht) ein Element vom Stack,
# gibt dessen Wert zurück
proc fromstack {} {
  global Stack
  if {[$Stack size] == 0} {
     puts "UPNCalc: Error!"
     return }
  set tmp [$Stack get end]
  $Stack delete end
  return $tmp
}


# unbenutzt:
proc fromenter {} {
  global befehl
  set tmp $befehl
  set befehl {}
  return $tmp
}

# schreibt das Resultat einer Berechnung auf den Stack
proc put_result {element} {
 .eingabe delete 0 end
 if {$element==[expr int($element)]} {
   # wenn integer, dann ohne Komma etc.
   tostack "  [expr int($element)]"
 } else {
   tostack "  $element"
 }
}


# die einfachen Rechenarten kommen hier:

proc upn_add {} {
  global befehl
  put_result [expr [fromstack] + [fromstack]]
}

proc upn_sub {} {
  global befehl
  set b [fromstack]
  put_result [expr [fromstack] - $b]
}

proc upn_mul {} {
  global befehl
  put_result [expr [fromstack] * [fromstack]]
}

proc upn_div {} {
  global befehl
  set b [fromstack]
  set a [fromstack]
  # es muß sichergestellt werden, daß intern immer mit Komma
  # gerechnet wird, weil Tcl sonst evtl. eine Ganzzahldivision durchführt
  if {[string match *.* $a] == 1 || [string match *.* $b] == 1} {
     set result [expr $a / $b]
  } else {
     if {[string match *.* $a] == 0} {append a ".0"}
     if {[string match *.* $b] == 0} {append b ".0"}
     set result [expr $a / $b]
  }
  put_result $result
}


# Stackoperationen:

proc dup {} {
global Stack
set tmp [fromstack]
tostack $tmp
tostack $tmp
}

proc exch {} {
set tmp_a [fromstack];set tmp_b [fromstack]; tostack $tmp_a; tostack $tmp_b
}

proc pop {} {
set trash [fromstack]
}

bind . <Key-F12> {pop}
bind . <Key-F11> {exch}
bind . <Key-F10> {dup}

# Trigonometrie (Tcl rechnet intern in Radiant!)

proc upn_cos {} {
 global pi
 prep
 set a [fromstack]
 put_result [expr cos($a*2*$pi/360.0)]
}

proc upn_sin {} {
 global pi
 prep
 set a [fromstack]
 put_result [expr sin($a*2*$pi/360.0)]
}

proc upn_tan {} {
 global pi
 prep
 set a [fromstack]
 put_result [expr tan($a*2*$pi/360.0)]
}

# noch 'n bischen was nützliches:

proc upn_sqrt {} {
 prep
 set a [fromstack]
 put_result [expr sqrt($a)]
}

proc upn_sqr {} {
 prep
 set a [fromstack]
 put_result [expr pow($a,2)]
}

proc upn_inv {} {
 prep
 set a [fromstack]
 put_result [expr 1.0/$a]
}


# bereitet die Eingabe vor zum Rechnen,
# indem Zahlen von Rechenoperatoren unterschieden werden:
proc prep {} {
 global befehl
 set befehl [string trimright $befehl {+-*/}]
 if {$befehl!=""} {tostack $befehl}
 update
}


## Hauptprogramm ##

wm title . "UPN Calculator"
wm iconname . "UPN"
frame .d

set Stack [listbox .d.stack -yscrollcommand ".d.scrolly set" \
  -width 20 -height 10 -font {Helvetica 24}]
scrollbar .d.scrolly -command ".d.stack yview"
entry .eingabe -textvariable befehl \
   -background white -font {Helvetica 24}

frame .s
button .s.dup -text "dup (F10)" -command dup
button .s.exch -text "exch (F11)" -command exch
button .s.pop -text "pop (F12)" -command pop
button .s.cos -text "cos" -command upn_cos
button .s.sin -text "sin" -command upn_sin
button .s.tan -text "tan" -command upn_tan
button .s.sqrt -text sqrt -command upn_sqrt
button .s.sqr -text "x^2" -command upn_sqr
button .s.inv -text "1/x" -command upn_inv

pack .d
 pack $Stack -side left -fill x -expand yes
 pack .d.scrolly -side left -fill y -expand 1

grid rowconfigure    .s.dup  1 -weight 1
grid rowconfigure    .s.cos  2 -weight 1
grid rowconfigure    .s.sqrt 2 -weight 1
pack .s
 grid .s.dup  -row 1 -column 1 -sticky ewns
 grid .s.exch -row 1 -column 2 -sticky ewns
 grid .s.pop  -row 1 -column 3 -sticky ewns
 grid .s.cos  -row 2 -column 1 -sticky ewns
 grid .s.sin  -row 2 -column 2 -sticky ewns
 grid .s.tan  -row 2 -column 3 -sticky ewns
 grid .s.sqrt -row 3 -column 1 -sticky ewns
 grid .s.sqr  -row 3 -column 2 -sticky ewns
 grid .s.inv  -row 3 -column 3 -sticky ewns

pack .eingabe -fill x -padx 2


bind  $Stack <Double-1> \
     {set befehl [$Stack get [$Stack curselection]]}
bind . <Return> {tostack $befehl; .eingabe delete 0 end}
bind . <KP_Enter> {tostack $befehl; .eingabe delete 0 end}
bind . <KP_Add> {prep;upn_add}
bind . <plus> {prep;upn_add}
bind . <KP_Subtract> {prep; upn_sub}
bind . <minus> {prep; upn_sub}
bind . <KP_Multiply> {prep;upn_mul}
bind . <asterisk> {prep;upn_mul}
bind . <KP_Divide> {prep;upn_div}
bind . <slash> {prep;upn_div}
bind . <KP_Insert> {if {"%A" == "{}" } {.eingabe insert end 0}}
bind . <KP_End> {if {"%A" == "{}" } {.eingabe insert end 1}}
bind . <KP_Down> {if {"%A" == "{}" } {.eingabe insert end 2}}
bind . <KP_Page_Down> {if {"%A" == "{}" } {.eingabe insert end 3}}
bind . <KP_Left> {if {"%A" == "{}" } {.eingabe insert end 4}}
bind . <KP_Begin> {if {"%A" == "{}" } {.eingabe insert end 5}}
bind . <KP_Right> {if {"%A" == "{}" } {.eingabe insert end 6}}
bind . <KP_Home> {if {"%A" == "{}" } {.eingabe insert end 7}}
bind . <KP_Up> {if {"%A" == "{}" } {.eingabe insert end 8}}
bind . <KP_Page_Up> {if {"%A" == "{}" } {.eingabe insert end 9}}
bind . <KP_Delete> {if {"%A" == "{}" } {.eingabe insert end .}}


focus .eingabe