1#! /bin/sh 2# the next line restarts with tclsh \ 3exec tclsh "$0" ${1+"$@"} 4 5set scriptDir [file dirname [info script]] 6 7######################################################################## 8# BigFloat for Tcl 9# Copyright (C) 2003-2005 ARNOLD Stephane 10# 11# BIGFLOAT LICENSE TERMS 12# 13# This software is copyrighted by Stephane ARNOLD, (stephanearnold <at> yahoo.fr). 14# The following terms apply to all files associated 15# with the software unless explicitly disclaimed in individual files. 16# 17# The authors hereby grant permission to use, copy, modify, distribute, 18# and license this software and its documentation for any purpose, provided 19# that existing copyright notices are retained in all copies and that this 20# notice is included verbatim in any distributions. No written agreement, 21# license, or royalty fee is required for any of the authorized uses. 22# Modifications to this software may be copyrighted by their authors 23# and need not follow the licensing terms described here, provided that 24# the new terms are clearly indicated on the first page of each file where 25# they apply. 26# 27# IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY 28# FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES 29# ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY 30# DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE 31# POSSIBILITY OF SUCH DAMAGE. 32# 33# THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES, 34# INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY, 35# FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT. THIS SOFTWARE 36# IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE 37# NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR 38# MODIFICATIONS. 39# 40# GOVERNMENT USE: If you are acquiring this software on behalf of the 41# U.S. government, the Government shall have only "Restricted Rights" 42# in the software and related documentation as defined in the Federal 43# Acquisition Regulations (FARs) in Clause 52.227.19 (c) (2). If you 44# are acquiring the software on behalf of the Department of Defense, the 45# software shall be classified as "Commercial Computer Software" and the 46# Government shall have only "Restricted Rights" as defined in Clause 47# 252.227-7013 (c) (1) of DFARs. Notwithstanding the foregoing, the 48# authors grant the U.S. Government and others acting in its behalf 49# permission to use and distribute the software in accordance with the 50# terms specified in this license. 51# 52######################################################################## 53 54package require Tk 55 56package require math::bigfloat 57namespace import ::math::bigfloat::* 58 59set nbButtons 0 60proc addButton {command} { 61 global nbButtons 62 set ::buttons($nbButtons,command) _$command 63 set ::buttons($nbButtons,texte) $command 64 incr nbButtons 65} 66 67proc addButtonTwo {commande} { 68 addButton $commande 69 proc _$commande {} "if {\[catch {pop a} msg\]} {tk_messageBox -message \$msg;return} 70 if {\[catch {pop b} msg\]} {push \$a 71 tk_messageBox -message \$msg;return} 72 if {\[catch {set result \[$commande \$a \$b\]} msg\]} { 73 push \$b 74 push \$a 75 tk_messageBox -message \$msg 76 return} 77 push \$result" 78} 79 80 81proc addButtonOne {commande} { 82 addButton $commande 83 proc _$commande {} "if {\[catch {pop a} msg\]} {tk_messageBox -message \$msg;return} 84 if {\[catch {set result \[$commande \$a\]} msg\]} {push \$a 85 tk_messageBox -message \$msg 86 return} 87 push \$result" 88} 89 90 91proc drawButtons {} { 92 global nbButtons 93 set nbLines [expr {int(sqrt($nbButtons))}] 94 for {set i 0} {$i<$nbButtons} {incr i} { 95 set col [expr {$i%$nbLines}] 96 set line [expr {$i/$nbLines}] 97 set commande $::buttons($i,command) 98 set texte $::buttons($i,texte) 99 button .functions.$commande -text $texte -command $commande -width 10 100 grid .functions.$commande -column $col -row $line -in .functions 101 102 } 103} 104 105proc initStack {} { 106 foreach i {1 2 3 4} { 107 label .stack.l$i -text "[expr {5-$i}] :" -foreground #079 -width 5 108 grid .stack.l$i -in .stack -row $i -column 1 109 label .stack.n$i -text "Empty" -foreground #097 -width 85 110 grid .stack.n$i -in .stack -row $i -column 2 111 } 112 set ::stack [list] 113} 114 115proc Push {} { 116 set x [fromstr $::bignum] 117 if {![isInt $x]} { 118 set x [fromstr $::bignum $::zeros] 119 } 120 lappend ::stack $x 121 set ::bignum 1.00 122 set ::zeros 0 123} 124 125 126proc toStr {n} { 127 set n [math::bigfloat::tostr $n] 128 set resultat "" 129 while {[string length $n]>80} { 130 append resultat "[string range $n 0 79]...\n" 131 set n [string range $n 80 end] 132 } 133 append resultat $n 134} 135 136 137proc drawStack {args} { 138 set l [lrange $::stack end-3 end] 139 for {set i 4} {$i>[llength $l]} {incr i -1} { 140 .stack.n[expr {5-$i}] configure -text "Empty" -foreground #097 141 } 142 for {set i 0} {$i<[llength $l]} {incr i} { 143 set number [lindex $::stack end-$i] 144 .stack.n[expr {4-$i}] configure -text [toStr $number] -foreground #000 145 } 146} 147 148proc init {} { 149 wm title . "BigFloatDemo 1.2" 150 # the stack (for RPN) 151 frame .stack 152 pack .stack 153 initStack 154 # the commands for input 155 set c [frame .commands] 156 pack $c -padx 10 -pady 10 157 set ::bignum 1.00 158 entry $c.bignum -textvariable ::bignum -width 16 159 pack $c.bignum -in $c -side left 160 label $c.labelZero -text "append zeros" 161 pack $c.labelZero -in $c -side left 162 set ::zeros 0 163 entry $c.zeros -textvariable ::zeros -width 4 164 pack $c.zeros -in $c -side left 165 button $c.fenter -text "Push" -command Push 166 pack $c.fenter -in $c -side left 167 # the functions for numbers 168 frame .functions 169 pack .functions 170 set f .functions 171 # chaque fonction est associ�e, d'une part, 172 # � un bouton portant un libell�, et d'autre part 173 # � une commande Tcl 174 # ici nous associons le bouton "add" � la commande "add" 175 addButtonTwo add 176 # toutes ces commandes se trouvent � la fin de ce fichier 177 addButtonTwo sub 178 addButtonTwo mul 179 addButtonTwo div 180 addButtonTwo mod 181 addButtonOne opp 182 addButtonOne abs 183 addButtonOne round 184 addButtonOne ceil 185 addButtonOne floor 186 addButtonTwo pow 187 addButtonOne sqrt 188 addButtonOne log 189 addButtonOne exp 190 addButtonOne cos 191 addButtonOne sin 192 addButtonOne tan 193 addButtonOne acos 194 addButtonOne asin 195 addButtonOne atan 196 addButtonOne cotan 197 addButtonOne cosh 198 addButtonOne sinh 199 addButtonOne tanh 200 addButtonOne pi 201 addButtonOne rad2deg 202 addButtonOne deg2rad 203 addButtonOne int2float 204 addButton del 205 addButton swap 206 addButton dup 207 addButton help 208 addButton save 209 addButton exit 210 drawButtons 211 raise . 212} 213 214################################################################################ 215# procedures that corresponds to functions (add,mul,etc.) 216################################################################################ 217 218proc _save {} { 219 set fichier [tk_getSaveFile -filetypes {{{Text Files} {.txt}}} -title "Save the stack as ..."] 220 if {$fichier == ""} { 221 error "You should give a name to the file. Aborting saving operation. Sorry." 222 } 223 if {[lindex [split $fichier .] end]!="txt"} { 224 append fichier .txt 225 } 226 if {[catch {set file [open $fichier w]}]} { 227 error "Write impossible on file : '$fichier'" 228 } 229 foreach valeur $::stack { 230 puts $file [::math::bigfloat::tostr $valeur] 231 } 232 close $file 233} 234 235proc ShowFile {filename buttonText} { 236 if {[catch {toplevel .help}]} { 237 tk_messageBox -message "Unable to create the window ; please close the current help window" 238 return 239 } 240 frame .help.licence 241 text .help.licence.t -yscrollcommand {.help.licence.s set} 242 scrollbar .help.licence.s -command {.help.licence.t yview} 243 grid .help.licence.t .help.licence.s -sticky nsew 244 grid columnconfigure .help.licence 0 -weight 1 245 grid rowconfigure .help.licence 0 -weight 1 246 247 pack .help.licence -in .help 248 set fd [open $filename] 249 .help.licence.t insert 0.0 [read $fd] 250 close $fd 251 .help.licence.t configure -state disabled 252 button .help.bouton -text $buttonText -command {destroy .help;raise .} 253 pack .help.bouton -in .help 254 focus -force .help 255} 256 257proc _help {args} { 258 # display some help 259 ShowFile [file join $::scriptDir bigfloat.help] Close 260} 261 262proc _del {} { 263 if {[llength $::stack]<=1} { 264 set ::stack {} 265 } else { 266 set ::stack [lrange $::stack 0 end-1] 267 } 268} 269 270proc _swap {} { 271 set last [lindex $::stack end] 272 lset ::stack end [lindex $::stack end-1] 273 lset ::stack end-1 $last 274} 275 276# duplicate the last value 277proc _dup {} { 278 lappend ::stack [lindex $::stack end] 279} 280 281 282 283proc pop {varname} { 284 if {[llength $::stack]==0} { 285 error "too few arguments in the stack" 286 } 287 upvar $varname out 288 set out [lindex $::stack end] 289 set ::stack [lrange $::stack 0 end-1] 290 return 291} 292 293 294proc push {x} { 295 lappend ::stack $x 296} 297 298proc _exit {} { 299 update 300 exit 301} 302 303 304 305# initialize the calculator and create the widgets (GUI) 306init 307# chaque fois qu'une commande modifie la pile de nombres, 308# la commande drawStack sera appel�e pour la r�actualiser 309trace add variable ::stack write drawStack 310