# TCL source code follows # pretty print from autoindent and ased editor # Biological Dinosaur Trackway Mass calculator V2 # written on Windows XP on TCL # working under TCL version 8.6 # gold on TCL Club, 12Feb2020 package require Tk package require math::numtheory namespace path {::tcl::mathop ::tcl::mathfunc math::numtheory } set tcl_precision 17 frame .frame -relief flat -bg aquamarine4 pack .frame -side top -fill y -anchor center set names {{} {Dinosaur Trackway Mass ( N) :} } lappend names {number of females:} lappend names {offspring per female: } lappend names {geologic interval years : } lappend names {mutation years:} lappend names {mutation years: } lappend names {mutation years: } lappend names {mutations per geologic interval: } foreach i {1 2 3 4 5 6 7 8} { label .frame.label$i -text [lindex $names $i] -anchor e entry .frame.entry$i -width 35 -textvariable side$i grid .frame.label$i .frame.entry$i -sticky ew -pady 2 -padx 1 } proc about {} { set msg "Calculator for Biological Dinosaur Trackway Mass from TCL # gold on TCL Club, 12Dec2019 " tk_messageBox -title "About" -message $msg } proc self_help {} { set msg " Biological Dinosaur Trackway Mass V2 from TCL , # self help listing # problem, Biological Dinosaur Trackway Mass V2 # Recommended procedure is push # testcase and fill frame, # change first three entries etc, push solve, # and then push report. Report allows copy and paste # from console to conventional texteditor. # For testcases, the # testcase number is internal to the calculator and # will not be printed until the report button is pushed # for the current result numbers. # >>> copyright notice <<< # This posting, screenshots, and TCL source code is # copyrighted under the TCL/TK license terms. # Editorial rights and disclaimers # retained under the TCL/TK license terms # and will be defended as necessary in court. Conventional text editor formulas or grabbed from internet screens can be pasted into green console. # gold on TCL Club, 12Feb2020 " tk_messageBox -title "Self_Help" -message $msg } proc calculate { } { global answer2 global side1 side2 side3 side4 side5 global side6 side7 side8 global testcase_number incr testcase_number set side1 [* $side1 1. ] set side2 [* $side2 1. ] set side3 [* $side3 1. ] set side4 [* $side4 1. ] set side5 [* $side5 1. ] set side6 [* $side6 1. ] set side7 [* $side7 1. ] set side8 [* $side8 1. ] set generation_interval_years $side1 set females $side2 set offspring $side3 set geologic_interval $side4 set offspring_over_interval [* $females $offspring ] set mutation_instance [ expr { (1.0 * $generation_interval_years)/( $females * $offspring ) } ] set mutation_instance2 [ expr { (1.0 * $geologic_interval)/ $mutation_instance } ] set side6 $mutation_instance set side7 $mutation_instance set side8 $mutation_instance2 } proc fillup {aa bb cc dd ee ff gg hh} { .frame.entry1 insert 0 "$aa" .frame.entry2 insert 0 "$bb" .frame.entry3 insert 0 "$cc" .frame.entry4 insert 0 "$dd" .frame.entry5 insert 0 "$ee" .frame.entry6 insert 0 "$ff" .frame.entry7 insert 0 "$gg" .frame.entry8 insert 0 "$hh" } proc clearx {} { foreach i {1 2 3 4 5 6 7 8 } { .frame.entry$i delete 0 end } } proc reportx {} { global answer2 global side1 side2 side3 side4 side5 global side6 side7 side8 global testcase_number global wavelength wavelength2 global wavelength6 wavelength10 global wavelengthsq surfacearea global megafrequency console eval {.console config -bg palegreen} console eval {.console config -font {fixed 20 bold}} console eval {wm geometry . 40x20} console eval {wm title . " Biological Dinosaur Trackway Mass Report V2, screen grab and paste from console 2 to texteditor"} console eval {. configure -background orange -highlightcolor brown -relief raised -border 30} console show; puts "%|table $testcase_number |printed in| tcl format|% " puts "&| quantity| value| comment, if any|& " puts "&| $testcase_number :|testcase_number | |&" puts "&| $side1 :|Dinosaur Trackway Mass years (1/N): | |&" puts "&| $side2 :|number of females: | |& " puts "&| $side3 :|offspring per female: | |& " puts "&| $side4 :|geologic interval years: | |&" puts "&| $side5 :|mutation years: | |&" puts "&| $side6 :|mutation years: | |&" puts "&| $side7 :|mutation years: | |&" puts "&| $side8 :|mutations per geologic interval: | |&" } frame .buttons -bg aquamarine4 ::ttk::button .calculator -text "Solve" -command { set side8 0 ; calculate } ::ttk::button .test2 -text "Testcase1" -command {clearx;fillup 25E6 5000. 5. 1.7E6 1000. 1000. 1000. 1700. } ::ttk::button .test3 -text "Testcase2" -command {clearx;fillup 20E6 7000. 5. 0.6E6 1000. 570. 570. 1050. } ::ttk::button .test4 -text "Testcase3" -command {clearx;fillup 10E6 9000. 5. 0.8E6 1000. 222. 222. 3600. } ::ttk::button .clearallx -text clear -command {clearx } ::ttk::button .about -text about -command {about} ::ttk::button .self_help -text self_help -command { self_help } ::ttk::button .cons -text report -command { reportx } ::ttk::button .exit -text exit -command {exit} pack .calculator -in .buttons -side top -padx 10 -pady 5 pack .clearallx .cons .self_help .about .exit .test4 .test3 .test2 -side bottom -in .buttons grid .frame .buttons -sticky ns -pady {0 10} . configure -background aquamarine4 -highlightcolor brown -relief raised -border 30 wm title . "Biological Dinosaur Trackway Mass Calculator V2"