diff options
author | William Joye <wjoye@cfa.harvard.edu> | 2016-10-27 19:39:39 (GMT) |
---|---|---|
committer | William Joye <wjoye@cfa.harvard.edu> | 2016-10-27 19:39:39 (GMT) |
commit | ea28451286d3ea4a772fa174483f9a7a66bb1ab3 (patch) | |
tree | 6ee9d8a7848333a7ceeee3b13d492e40225f8b86 /tcllib/examples/math | |
parent | b5ca09bae0d6a1edce939eea03594dd56383f2c8 (diff) | |
parent | 7c621da28f07e449ad90c387344f07a453927569 (diff) | |
download | blt-ea28451286d3ea4a772fa174483f9a7a66bb1ab3.zip blt-ea28451286d3ea4a772fa174483f9a7a66bb1ab3.tar.gz blt-ea28451286d3ea4a772fa174483f9a7a66bb1ab3.tar.bz2 |
Merge commit '7c621da28f07e449ad90c387344f07a453927569' as 'tcllib'
Diffstat (limited to 'tcllib/examples/math')
-rwxr-xr-x | tcllib/examples/math/bigfloat.demo.tcl | 308 | ||||
-rw-r--r-- | tcllib/examples/math/bigfloat.help | 45 |
2 files changed, 353 insertions, 0 deletions
diff --git a/tcllib/examples/math/bigfloat.demo.tcl b/tcllib/examples/math/bigfloat.demo.tcl new file mode 100755 index 0000000..bfa98ff --- /dev/null +++ b/tcllib/examples/math/bigfloat.demo.tcl @@ -0,0 +1,308 @@ +#!/usr/bin/env tclsh +## -*- tcl -*- + +set scriptDir [file dirname [info script]] + +######################################################################## +# BigFloat for Tcl +# Copyright (C) 2003-2005 ARNOLD Stephane +# +# BIGFLOAT LICENSE TERMS +# +# This software is copyrighted by Stephane ARNOLD, (stephanearnold <at> yahoo.fr). +# The following terms apply to all files associated +# with the software unless explicitly disclaimed in individual files. +# +# The authors hereby grant permission to use, copy, modify, distribute, +# and license this software and its documentation for any purpose, provided +# that existing copyright notices are retained in all copies and that this +# notice is included verbatim in any distributions. No written agreement, +# license, or royalty fee is required for any of the authorized uses. +# Modifications to this software may be copyrighted by their authors +# and need not follow the licensing terms described here, provided that +# the new terms are clearly indicated on the first page of each file where +# they apply. +# +# IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY +# FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES +# ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY +# DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE +# POSSIBILITY OF SUCH DAMAGE. +# +# THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES, +# INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY, +# FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT. THIS SOFTWARE +# IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE +# NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR +# MODIFICATIONS. +# +# GOVERNMENT USE: If you are acquiring this software on behalf of the +# U.S. government, the Government shall have only "Restricted Rights" +# in the software and related documentation as defined in the Federal +# Acquisition Regulations (FARs) in Clause 52.227.19 (c) (2). If you +# are acquiring the software on behalf of the Department of Defense, the +# software shall be classified as "Commercial Computer Software" and the +# Government shall have only "Restricted Rights" as defined in Clause +# 252.227-7013 (c) (1) of DFARs. Notwithstanding the foregoing, the +# authors grant the U.S. Government and others acting in its behalf +# permission to use and distribute the software in accordance with the +# terms specified in this license. +# +######################################################################## + +package require Tk + +package require math::bigfloat +namespace import ::math::bigfloat::* + +set nbButtons 0 +proc addButton {command} { + global nbButtons + set ::buttons($nbButtons,command) _$command + set ::buttons($nbButtons,texte) $command + incr nbButtons +} + +proc addButtonTwo {commande} { + addButton $commande + proc _$commande {} "if {\[catch {pop a} msg\]} {tk_messageBox -message \$msg;return} + if {\[catch {pop b} msg\]} {push \$a + tk_messageBox -message \$msg;return} + if {\[catch {set result \[$commande \$a \$b\]} msg\]} { + push \$b + push \$a + tk_messageBox -message \$msg + return} + push \$result" +} + + +proc addButtonOne {commande} { + addButton $commande + proc _$commande {} "if {\[catch {pop a} msg\]} {tk_messageBox -message \$msg;return} + if {\[catch {set result \[$commande \$a\]} msg\]} {push \$a + tk_messageBox -message \$msg + return} + push \$result" +} + + +proc drawButtons {} { + global nbButtons + set nbLines [expr {int(sqrt($nbButtons))}] + for {set i 0} {$i<$nbButtons} {incr i} { + set col [expr {$i%$nbLines}] + set line [expr {$i/$nbLines}] + set commande $::buttons($i,command) + set texte $::buttons($i,texte) + button .functions.$commande -text $texte -command $commande -width 10 + grid .functions.$commande -column $col -row $line -in .functions + + } +} + +proc initStack {} { + foreach i {1 2 3 4} { + label .stack.l$i -text "[expr {5-$i}] :" -foreground #079 -width 5 + grid .stack.l$i -in .stack -row $i -column 1 + label .stack.n$i -text "Empty" -foreground #097 -width 85 + grid .stack.n$i -in .stack -row $i -column 2 + } + set ::stack [list] +} + +proc Push {} { + set x [fromstr $::bignum] + if {![isInt $x]} { + set x [fromstr $::bignum $::zeros] + } + lappend ::stack $x + set ::bignum 1.00 + set ::zeros 0 +} + + +proc toStr {n} { + set n [math::bigfloat::tostr $n] + set resultat "" + while {[string length $n]>80} { + append resultat "[string range $n 0 79]...\n" + set n [string range $n 80 end] + } + append resultat $n +} + + +proc drawStack {args} { + set l [lrange $::stack end-3 end] + for {set i 4} {$i>[llength $l]} {incr i -1} { + .stack.n[expr {5-$i}] configure -text "Empty" -foreground #097 + } + for {set i 0} {$i<[llength $l]} {incr i} { + set number [lindex $::stack end-$i] + .stack.n[expr {4-$i}] configure -text [toStr $number] -foreground #000 + } +} + +proc init {} { + wm title . "BigFloatDemo 1.2" + # the stack (for RPN) + frame .stack + pack .stack + initStack + # the commands for input + set c [frame .commands] + pack $c -padx 10 -pady 10 + set ::bignum 1.00 + entry $c.bignum -textvariable ::bignum -width 16 + pack $c.bignum -in $c -side left + label $c.labelZero -text "append zeros" + pack $c.labelZero -in $c -side left + set ::zeros 0 + entry $c.zeros -textvariable ::zeros -width 4 + pack $c.zeros -in $c -side left + button $c.fenter -text "Push" -command Push + pack $c.fenter -in $c -side left + # the functions for numbers + frame .functions + pack .functions + set f .functions + # chaque fonction est associée, d'une part, + # à un bouton portant un libellé, et d'autre part + # à une commande Tcl + # ici nous associons le bouton "add" à la commande "add" + addButtonTwo add + # toutes ces commandes se trouvent à la fin de ce fichier + addButtonTwo sub + addButtonTwo mul + addButtonTwo div + addButtonTwo mod + addButtonOne opp + addButtonOne abs + addButtonOne round + addButtonOne ceil + addButtonOne floor + addButtonTwo pow + addButtonOne sqrt + addButtonOne log + addButtonOne exp + addButtonOne cos + addButtonOne sin + addButtonOne tan + addButtonOne acos + addButtonOne asin + addButtonOne atan + addButtonOne cotan + addButtonOne cosh + addButtonOne sinh + addButtonOne tanh + addButtonOne pi + addButtonOne rad2deg + addButtonOne deg2rad + addButtonOne int2float + addButton del + addButton swap + addButton dup + addButton help + addButton save + addButton exit + drawButtons + raise . +} + +################################################################################ +# procedures that corresponds to functions (add,mul,etc.) +################################################################################ + +proc _save {} { + set fichier [tk_getSaveFile -filetypes {{{Text Files} {.txt}}} -title "Save the stack as ..."] + if {$fichier == ""} { + error "You should give a name to the file. Aborting saving operation. Sorry." + } + if {[lindex [split $fichier .] end]!="txt"} { + append fichier .txt + } + if {[catch {set file [open $fichier w]}]} { + error "Write impossible on file : '$fichier'" + } + foreach valeur $::stack { + puts $file [::math::bigfloat::tostr $valeur] + } + close $file +} + +proc ShowFile {filename buttonText} { + if {[catch {toplevel .help}]} { + tk_messageBox -message "Unable to create the window ; please close the current help window" + return + } + frame .help.licence + text .help.licence.t -yscrollcommand {.help.licence.s set} + scrollbar .help.licence.s -command {.help.licence.t yview} + grid .help.licence.t .help.licence.s -sticky nsew + grid columnconfigure .help.licence 0 -weight 1 + grid rowconfigure .help.licence 0 -weight 1 + + pack .help.licence -in .help + set fd [open $filename] + .help.licence.t insert 0.0 [read $fd] + close $fd + .help.licence.t configure -state disabled + button .help.bouton -text $buttonText -command {destroy .help;raise .} + pack .help.bouton -in .help + focus -force .help +} + +proc _help {args} { + # display some help + ShowFile [file join $::scriptDir bigfloat.help] Close +} + +proc _del {} { + if {[llength $::stack]<=1} { + set ::stack {} + } else { + set ::stack [lrange $::stack 0 end-1] + } +} + +proc _swap {} { + set last [lindex $::stack end] + lset ::stack end [lindex $::stack end-1] + lset ::stack end-1 $last +} + +# duplicate the last value +proc _dup {} { + lappend ::stack [lindex $::stack end] +} + + + +proc pop {varname} { + if {[llength $::stack]==0} { + error "too few arguments in the stack" + } + upvar $varname out + set out [lindex $::stack end] + set ::stack [lrange $::stack 0 end-1] + return +} + + +proc push {x} { + lappend ::stack $x +} + +proc _exit {} { + update + exit +} + + + +# initialize the calculator and create the widgets (GUI) +init +# chaque fois qu'une commande modifie la pile de nombres, +# la commande drawStack sera appelée pour la réactualiser +trace add variable ::stack write drawStack diff --git a/tcllib/examples/math/bigfloat.help b/tcllib/examples/math/bigfloat.help new file mode 100644 index 0000000..9b7af7b --- /dev/null +++ b/tcllib/examples/math/bigfloat.help @@ -0,0 +1,45 @@ +Welcome to the demonstration of BigFloat for Tcl ! +If you have problems with this demonstration, first see the file README.txt in the package. + +The principle of the RPN calculator is that you have a stack of numbers ; +you can push in the stack either integers or floating-point numbers, with any number of digits. +Suppose you have pushed 1.00 and 2.00 (you have to type each number in the entry field at the middle of the window) +Then the stack looks like : +4 : Empty +3 : Empty +2 : 1.0 +1 : 2.0 + +By clicking on the button named "add", the program takes the two numbers off the stack, +and pushes instead of them their sum. +The stack then looks like : +4 : Empty +3 : Empty +2 : Empty +1 : 3.0 + +Now push 5.00 into the stack, and click on the button named "sub". +The stack now looks like : +4 : Empty +3 : Empty +2 : Empty +1 : 2.0 + +The result is the difference between the last number and the last but one on the stack. +5 - 3 = 2 + +The "append zeros" label is followed by a field in which you may enter an integer. +When you want to type 1.00000000 to get much precision, it is better to type '1.' in the left field, +and to type '8' in the right field, and then to push the number on the stack. +The result is the first floating-point number followed by '8' zeros : '1.00000000'. +Some commands need an integer parameter. An integer is a number formed with digits and (optionally) +the minus sign. +Example : 12 20000 -15 are integers +Floating-point number are formed using digits, eventually a minus sign, and formally a dot or +an exponent character ('e'). +Examples of floating-point numbers : 1.23e-13 2. 0.10000000 23e54 + +Floating-point numbers are represented with an arbitrary precision, but the last, +and eventually the last but one digit(s) are truncated in the result as +they specify an uncertainty on the number. When you mean 1.3, you may have to append zeros +at the end, which can be done with the second field.
\ No newline at end of file |