3 changed files with 649 additions and 0 deletions
@ -0,0 +1,642 @@ |
|||||||
|
# -*- tcl -*- |
||||||
|
# Maintenance Instruction: leave the 999999.xxx.x as is and use punkshell 'dev make' or bin/punkmake to update from <pkg>-buildversion.txt |
||||||
|
# module template: shellspy/src/decktemplates/vendor/punk/modules/template_module-0.0.3.tm |
||||||
|
# |
||||||
|
# Please consider using a BSD or MIT style license for greatest compatibility with the Tcl ecosystem. |
||||||
|
# Code using preferred Tcl licenses can be eligible for inclusion in Tcllib, Tklib and the punk package repository. |
||||||
|
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||||
|
# (C) 2025 |
||||||
|
# |
||||||
|
# @@ Meta Begin |
||||||
|
# Application picalc 999999.0a1.0 |
||||||
|
# Meta platform tcl |
||||||
|
# Meta license MIT |
||||||
|
# @@ Meta End |
||||||
|
|
||||||
|
|
||||||
|
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||||
|
# doctools header |
||||||
|
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||||
|
#*** !doctools |
||||||
|
#[manpage_begin shellspy_module_picalc 0 999999.0a1.0] |
||||||
|
#[copyright "2025"] |
||||||
|
#[titledesc {Module API}] [comment {-- Name section and table of contents description --}] |
||||||
|
#[moddesc {-}] [comment {-- Description at end of page heading --}] |
||||||
|
#[require picalc] |
||||||
|
#[keywords module] |
||||||
|
#[description] |
||||||
|
#[para] - |
||||||
|
|
||||||
|
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||||
|
|
||||||
|
#*** !doctools |
||||||
|
#[section Overview] |
||||||
|
#[para] overview of picalc |
||||||
|
#[subsection Concepts] |
||||||
|
#[para] - |
||||||
|
|
||||||
|
|
||||||
|
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||||
|
## Requirements |
||||||
|
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||||
|
|
||||||
|
#*** !doctools |
||||||
|
#[subsection dependencies] |
||||||
|
#[para] packages used by picalc |
||||||
|
#[list_begin itemized] |
||||||
|
|
||||||
|
package require Tcl 8.6- |
||||||
|
package require punk::lib |
||||||
|
package require punk::args |
||||||
|
#*** !doctools |
||||||
|
#[item] [package {Tcl 8.6}] |
||||||
|
#[item] [package {punk::lib}] |
||||||
|
#[item] [package {punk::args}] |
||||||
|
|
||||||
|
# #package require frobz |
||||||
|
# #*** !doctools |
||||||
|
# #[item] [package {frobz}] |
||||||
|
|
||||||
|
#*** !doctools |
||||||
|
#[list_end] |
||||||
|
|
||||||
|
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||||
|
|
||||||
|
#*** !doctools |
||||||
|
#[section API] |
||||||
|
|
||||||
|
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||||
|
# oo::class namespace |
||||||
|
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||||
|
#tcl::namespace::eval picalc::class { |
||||||
|
#*** !doctools |
||||||
|
#[subsection {Namespace picalc::class}] |
||||||
|
#[para] class definitions |
||||||
|
#if {[tcl::info::commands [tcl::namespace::current]::interface_sample1] eq ""} { |
||||||
|
#*** !doctools |
||||||
|
#[list_begin enumerated] |
||||||
|
|
||||||
|
# oo::class create interface_sample1 { |
||||||
|
# #*** !doctools |
||||||
|
# #[enum] CLASS [class interface_sample1] |
||||||
|
# #[list_begin definitions] |
||||||
|
|
||||||
|
# method test {arg1} { |
||||||
|
# #*** !doctools |
||||||
|
# #[call class::interface_sample1 [method test] [arg arg1]] |
||||||
|
# #[para] test method |
||||||
|
# puts "test: $arg1" |
||||||
|
# } |
||||||
|
|
||||||
|
# #*** !doctools |
||||||
|
# #[list_end] [comment {-- end definitions interface_sample1}] |
||||||
|
# } |
||||||
|
|
||||||
|
#*** !doctools |
||||||
|
#[list_end] [comment {--- end class enumeration ---}] |
||||||
|
#} |
||||||
|
#} |
||||||
|
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
tcl::namespace::eval picalc { |
||||||
|
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||||
|
# Base namespace |
||||||
|
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||||
|
#*** !doctools |
||||||
|
#[subsection {Namespace picalc}] |
||||||
|
#[para] Core API functions for picalc |
||||||
|
#[list_begin definitions] |
||||||
|
|
||||||
|
variable PUNKARGS |
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
#proc sample1 {p1 n args} { |
||||||
|
# #*** !doctools |
||||||
|
# #[call [fun sample1] [arg p1] [arg n] [opt {option value...}]] |
||||||
|
# #[para]Description of sample1 |
||||||
|
# #[para] Arguments: |
||||||
|
# # [list_begin arguments] |
||||||
|
# # [arg_def tring p1] A description of string argument p1. |
||||||
|
# # [arg_def integer n] A description of integer argument n. |
||||||
|
# # [list_end] |
||||||
|
# return "ok" |
||||||
|
#} |
||||||
|
|
||||||
|
#a known value for the _test functions |
||||||
|
variable pifrac [string map {" " ""} "1415926535 8979323846 2643383279 5028841971"] |
||||||
|
|
||||||
|
#10k approx 2s |
||||||
|
#20k approx 18s |
||||||
|
#100k approx 1519s (25+minutes) |
||||||
|
proc fast {dp} { |
||||||
|
package require math::bigfloat |
||||||
|
#math::bigfloat calculates using 'precision' |
||||||
|
# -------------- |
||||||
|
#Faster for large values - but timing variable on same values!! |
||||||
|
#After running on large values becomes - slower than calc and spigot for small values (somewhere around <1k) |
||||||
|
catch {unset ::math::bigfloat::_pi0} |
||||||
|
#this is due to the caching mechanism - for the purposes of comparison/testing and consistent results, we'll 'wreck' that caching here. |
||||||
|
# -------------- |
||||||
|
set answer [math::bigfloat::tostr [math::bigfloat::pi [expr {$dp+3}]]] ;#we need to calculate with +3 precision to avoid rounding at the tail of chosen number of dp in all cases |
||||||
|
return [string range $answer 0 end-2] |
||||||
|
} |
||||||
|
proc fast_test {max} { |
||||||
|
variable pifrac |
||||||
|
set pi 3.$pifrac |
||||||
|
set result "" |
||||||
|
set k 0 |
||||||
|
while {$k <= $max} { |
||||||
|
set answer [fast $k] |
||||||
|
set lcp [punk::lib::longestCommonPrefix [list $pi $answer]] |
||||||
|
set lcplen [string length $lcp] |
||||||
|
set tail [string range $answer $lcplen end] |
||||||
|
set greenanswer [a+ green]$lcp[a]$tail |
||||||
|
|
||||||
|
package require overtype ;#can't use 'format' for ANSI coloured strings |
||||||
|
set col1 [string repeat " " [expr {$max + 3}]] |
||||||
|
append result "[format %3s $k]-> [overtype::left $col1 $greenanswer]" \n |
||||||
|
incr k |
||||||
|
} |
||||||
|
return $result |
||||||
|
} |
||||||
|
|
||||||
|
|
||||||
|
lappend PUNKARGS [list { |
||||||
|
@id -id ::picalc::spigot |
||||||
|
@cmd -name picalc::spigot -help\ |
||||||
|
"Return digits of pi to dp decimal places. |
||||||
|
|
||||||
|
'classic' Rabinowitz and Wagon spigot algorithm. |
||||||
|
https://www.cs.williams.edu/~heeringa/classes/cs135/s15/readings/spigot.pdf |
||||||
|
relatively straight port from pascal algorithm |
||||||
|
|
||||||
|
This algorithm for generating digits of pi uses a long list relative to the number of required digits |
||||||
|
Performance doesn't seem to be spectacular, |
||||||
|
(seems to be around 7-8secs for 1000 digits |
||||||
|
93s for 10K digits) |
||||||
|
|
||||||
|
The 'fast' (math::bigfloat based) function is much faster, |
||||||
|
but also becomes extremely slow at a few 10's of thousands of digits. |
||||||
|
" |
||||||
|
@leaders -min 0 -max 0 |
||||||
|
@opts |
||||||
|
-channel -choices {none stdout stderr} -default none -choicerestricted 0 -choicelabels { |
||||||
|
none\ |
||||||
|
" Return as result string" |
||||||
|
} |
||||||
|
@values -min 0 -max 1 |
||||||
|
dp -type int -default 32 -help\ |
||||||
|
"Number of decimal places |
||||||
|
(final digit is not rounded)" |
||||||
|
}] |
||||||
|
# 5K approx 25s |
||||||
|
#10K approx 93s |
||||||
|
proc spigot_emit {c chan countvar dp} { |
||||||
|
upvar $countvar count |
||||||
|
incr count |
||||||
|
if {$chan eq "none"} { |
||||||
|
upvar result r |
||||||
|
append r $c ;#leave chars beyond dp to be trimmed by caller |
||||||
|
return |
||||||
|
} else { |
||||||
|
if {$count > 2} { |
||||||
|
if {$count <= $dp + 2} { |
||||||
|
puts -nonewline $chan $c |
||||||
|
} |
||||||
|
} else { |
||||||
|
if {$count == 1} { |
||||||
|
puts -nonewline $chan 3 |
||||||
|
} else { |
||||||
|
puts -nonewline $chan "." |
||||||
|
} |
||||||
|
} |
||||||
|
} |
||||||
|
} |
||||||
|
proc spigot {args} { |
||||||
|
set argd [punk::args::parse $args withid ::picalc::spigot] |
||||||
|
lassign [dict values $argd] leaders opts values received |
||||||
|
set dp [dict get $values dp] |
||||||
|
set channel [dict get $opts -channel] |
||||||
|
|
||||||
|
if {$dp < 1} {return 3} |
||||||
|
set n [expr {$dp +2}] ;#dp +1 can get rounding errors |
||||||
|
set len [expr {(10 * $n) / 3}] |
||||||
|
set a [lrepeat [expr {$len+1}] 2] |
||||||
|
set nines 0 |
||||||
|
set predigit 0 |
||||||
|
set result "" |
||||||
|
set countvar 0 |
||||||
|
if {$channel eq "none"} { |
||||||
|
set dpextra 2 |
||||||
|
} else { |
||||||
|
set dpextra 2 |
||||||
|
} |
||||||
|
for {set j 1} {$j <= $len} {incr j} { |
||||||
|
set q 0 |
||||||
|
for {set i $len} {$i > 0} {incr i -1} { |
||||||
|
set ai [lindex $a $i] |
||||||
|
set x [expr {(10 * $ai) + ($q * $i)}] |
||||||
|
lset a $i [expr {$x % (2*$i-1)}] |
||||||
|
set q [expr {$x / (2*$i-1)}] |
||||||
|
} |
||||||
|
lset a 1 [expr {$q % 10}] |
||||||
|
set q [expr {$q / 10}] |
||||||
|
if {$q == 9} { |
||||||
|
incr nines |
||||||
|
} else { |
||||||
|
if {$q == 10} { |
||||||
|
#append result [expr {$predigit + 1}] |
||||||
|
spigot_emit [expr {$predigit + 1}] $channel countvar $dp |
||||||
|
if {$countvar == $dp +$dpextra} { |
||||||
|
break |
||||||
|
} |
||||||
|
for {set k 1} {$k <= $nines} {incr k} { |
||||||
|
#append result 0 |
||||||
|
spigot_emit 0 $channel countvar $dp |
||||||
|
if {$countvar == $dp +$dpextra} { |
||||||
|
break |
||||||
|
} |
||||||
|
} |
||||||
|
if {$countvar == $dp +$dpextra} { |
||||||
|
break |
||||||
|
} |
||||||
|
|
||||||
|
set predigit 0 |
||||||
|
set nines 0 |
||||||
|
} else { |
||||||
|
#append result $predigit |
||||||
|
spigot_emit $predigit $channel countvar $dp |
||||||
|
if {$countvar == $dp +$dpextra} { |
||||||
|
#+2 for leading 03 |
||||||
|
break |
||||||
|
} |
||||||
|
set predigit $q |
||||||
|
if {$nines != 0} { |
||||||
|
for {set k 1} {$k <= $nines} {incr k} { |
||||||
|
#append result 9 |
||||||
|
spigot_emit 9 $channel countvar $dp |
||||||
|
if {$countvar == $dp +$dpextra} { |
||||||
|
break |
||||||
|
} |
||||||
|
} |
||||||
|
if {$countvar == $dp +$dpextra} { |
||||||
|
break |
||||||
|
} |
||||||
|
set nines 0 |
||||||
|
} |
||||||
|
} |
||||||
|
} |
||||||
|
} |
||||||
|
#append result $predigit |
||||||
|
spigot_emit $predigit $channel countvar $dp |
||||||
|
#eg result 0314159 |
||||||
|
if {$channel eq "none"} { |
||||||
|
set result 3.[string range $result 2 $dp+1] ;#always trim to dp+1 (= $dp+2-1) - longer answer can have erroneous digits |
||||||
|
#set result 3.[string range $result 2 end] |
||||||
|
return $result |
||||||
|
} else { |
||||||
|
flush $channel |
||||||
|
#review |
||||||
|
return "emitted $countvar chars to channel $channel" |
||||||
|
} |
||||||
|
} |
||||||
|
|
||||||
|
|
||||||
|
proc spigot_test {max} { |
||||||
|
variable pifrac |
||||||
|
set pi 3.$pifrac |
||||||
|
set result "" |
||||||
|
set k 0 |
||||||
|
while {$k <= $max} { |
||||||
|
set answer [spigot $k] |
||||||
|
set lcp [punk::lib::longestCommonPrefix [list $pi $answer]] |
||||||
|
set lcplen [string length $lcp] |
||||||
|
set tail [string range $answer $lcplen end] |
||||||
|
set greenanswer [a+ green]$lcp[a]$tail |
||||||
|
|
||||||
|
package require overtype ;#can't use 'format' for ANSI coloured strings |
||||||
|
set col1 [string repeat " " [expr {$max + 3}]] |
||||||
|
append result "[format %3s $k]-> [overtype::left $col1 $greenanswer]" \n |
||||||
|
incr k |
||||||
|
} |
||||||
|
return $result |
||||||
|
} |
||||||
|
|
||||||
|
|
||||||
|
#def f(n): |
||||||
|
# numerator, denominator = 1, 1 |
||||||
|
# # i/(2i + 1) = n/(2n + 1), ..., 3/7, 2/5, 1/3 |
||||||
|
# for i in range(n, 0, -1): |
||||||
|
# # multiply by i/(2i + 1) |
||||||
|
# numerator *= i |
||||||
|
# denominator *= 2 * i + 1 |
||||||
|
# # add 1 (p/q -> (p + q)/q = p/q + q/q = p/q + 1) |
||||||
|
# numerator += denominator |
||||||
|
# return 2 * numerator, denominator |
||||||
|
#for n in range(20): |
||||||
|
# p, q = f(n) |
||||||
|
# print(Fraction(p, q)) |
||||||
|
|
||||||
|
#an approx of pi that rapidly creates a fraction too big to calculate with standard Tcl doubles.. |
||||||
|
proc fraction {dp} { |
||||||
|
if {$dp < 1} {return 3} |
||||||
|
#determine an n big enough to give dp valid digits |
||||||
|
set n [expr {$dp +1}] |
||||||
|
set n [expr {(10 * $n) / 3}] |
||||||
|
return [fraction_iteration $n] |
||||||
|
} |
||||||
|
# 5k approx 27s |
||||||
|
# 10k approx 127s |
||||||
|
proc calc {dp} { |
||||||
|
if {$dp < 1} {return 3} |
||||||
|
set n [expr {$dp +1}] |
||||||
|
set n [expr {(10 * $n) / 3}] |
||||||
|
package require math::bigfloat |
||||||
|
lassign [fraction_iteration $n] a b |
||||||
|
set bigfloat [math::bigfloat::div [math::bigfloat::int2float $a] [math::bigfloat::int2float $b]] |
||||||
|
set answer [math::bigfloat::tostr $bigfloat] |
||||||
|
#10*$d/3 == $n |
||||||
|
#set trustdigits [expr {(3*$n)/10}] ;#?? |
||||||
|
return [string range $answer 0 $dp+1] ;#= +2-1 |
||||||
|
return $answer |
||||||
|
} |
||||||
|
proc calc_test {max} { |
||||||
|
variable pifrac |
||||||
|
set pi 3.$pifrac |
||||||
|
set k 0 |
||||||
|
set result "" |
||||||
|
set last_lcplen 0 |
||||||
|
set got "" |
||||||
|
while {$k <= $max} { |
||||||
|
set answer [calc $k] |
||||||
|
|
||||||
|
set lcp [punk::lib::longestCommonPrefix [list $pi $answer]] |
||||||
|
set lcplen [string length $lcp] |
||||||
|
if {$lcplen > $last_lcplen} { |
||||||
|
set last_lcplen $lcplen |
||||||
|
set got [string index $lcp end] |
||||||
|
set c red |
||||||
|
} else { |
||||||
|
set c yellow |
||||||
|
} |
||||||
|
set tail [string range $answer $lcplen end] |
||||||
|
set greenanswer [a+ green]$lcp[a]$tail |
||||||
|
|
||||||
|
package require overtype |
||||||
|
set col1 [string repeat " " [expr {$max + 3}]] |
||||||
|
append result "[overtype::left " " [a+ $c $got]] [format %3s $k]-> [overtype::left $col1 $greenanswer]" \n |
||||||
|
incr k |
||||||
|
} |
||||||
|
return $result |
||||||
|
} |
||||||
|
|
||||||
|
proc fraction_iteration {n} { |
||||||
|
set numerator 1; set denominator 1 |
||||||
|
for {set i $n} {$i > 0} {incr i -1} { |
||||||
|
set numerator [expr {$numerator * $i}] |
||||||
|
set denominator [expr {$denominator * (2 * $i + 1)}] |
||||||
|
incr numerator $denominator |
||||||
|
} |
||||||
|
return [list [expr {$numerator * 2}] $denominator] |
||||||
|
} |
||||||
|
proc fraction_iteration_test {max} { |
||||||
|
variable pifrac |
||||||
|
set pi 3.$pifrac |
||||||
|
set k 0 |
||||||
|
set result "" |
||||||
|
set last_lcplen 0 |
||||||
|
set got "" |
||||||
|
package require math::bigfloat |
||||||
|
while {$k <= $max} { |
||||||
|
set s [fraction_iteration $k] |
||||||
|
lassign $s a b |
||||||
|
#set answer [expr {$a / double($b)}] ;limited range |
||||||
|
set bigfloat [math::bigfloat::div [math::bigfloat::int2float $a] [math::bigfloat::int2float $b]] |
||||||
|
set answer [math::bigfloat::tostr $bigfloat] |
||||||
|
|
||||||
|
|
||||||
|
set lcp [punk::lib::longestCommonPrefix [list $pi $answer]] |
||||||
|
set lcplen [string length $lcp] |
||||||
|
if {$lcplen > $last_lcplen} { |
||||||
|
set last_lcplen $lcplen |
||||||
|
set got [string index $lcp end] |
||||||
|
set c red |
||||||
|
} else { |
||||||
|
set c yellow |
||||||
|
} |
||||||
|
|
||||||
|
set tail [string range $answer $lcplen end] |
||||||
|
set greenanswer [a+ green]$lcp[a]$tail |
||||||
|
#math::numtheory::gcd |
||||||
|
#set gcd [punk::lib::gcd {*}$s] |
||||||
|
#if {$gcd > 1} { |
||||||
|
# set a [expr {$a/$gcd}] |
||||||
|
# set b [expr {$b/$gcd}] |
||||||
|
#} |
||||||
|
|
||||||
|
set ax [string map [list $got [a+ $c]$got[a]] $a] |
||||||
|
set bx [string map [list $got [a+ $c]$got[a]] $b] |
||||||
|
set m [expr {$a % $b}] |
||||||
|
set mx [string map [list $got [a+ $c]$got[a]] $m] |
||||||
|
|
||||||
|
package require overtype |
||||||
|
set sp40 [string repeat " " 40] |
||||||
|
set sp60 [string repeat " " 60] |
||||||
|
append result "[format %1s $got] [format %3s $k]-> [overtype::left $sp40 $greenanswer] [overtype::left $sp60 $ax] [overtype::left $sp60 $bx] [overtype::left $sp60 $mx]" \n |
||||||
|
incr k |
||||||
|
} |
||||||
|
return $result |
||||||
|
} |
||||||
|
|
||||||
|
#an experiment |
||||||
|
proc slow_approx {{m 1000}} { |
||||||
|
set pi 0 |
||||||
|
set d [expr {1.0}] |
||||||
|
for {set i 1} {$i <= $m} {incr i} { |
||||||
|
set a [expr {2 * ($i % 2) - 1}] |
||||||
|
set pi [expr {$pi + ($a * 4 / $d)}] |
||||||
|
set d [expr {$d + 2.0}] |
||||||
|
} |
||||||
|
return $pi |
||||||
|
} |
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
#*** !doctools |
||||||
|
#[list_end] [comment {--- end definitions namespace picalc ---}] |
||||||
|
} |
||||||
|
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||||
|
|
||||||
|
|
||||||
|
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||||
|
# Secondary API namespace |
||||||
|
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||||
|
tcl::namespace::eval picalc::lib { |
||||||
|
tcl::namespace::export {[a-z]*} ;# Convention: export all lowercase |
||||||
|
tcl::namespace::path [tcl::namespace::parent] |
||||||
|
#*** !doctools |
||||||
|
#[subsection {Namespace picalc::lib}] |
||||||
|
#[para] Secondary functions that are part of the API |
||||||
|
#[list_begin definitions] |
||||||
|
|
||||||
|
#proc utility1 {p1 args} { |
||||||
|
# #*** !doctools |
||||||
|
# #[call lib::[fun utility1] [arg p1] [opt {?option value...?}]] |
||||||
|
# #[para]Description of utility1 |
||||||
|
# return 1 |
||||||
|
#} |
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
#*** !doctools |
||||||
|
#[list_end] [comment {--- end definitions namespace picalc::lib ---}] |
||||||
|
} |
||||||
|
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||||
|
#*** !doctools |
||||||
|
#[section Internal] |
||||||
|
#tcl::namespace::eval picalc::system { |
||||||
|
#*** !doctools |
||||||
|
#[subsection {Namespace picalc::system}] |
||||||
|
#[para] Internal functions that are not part of the API |
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
#} |
||||||
|
|
||||||
|
|
||||||
|
# == === === === === === === === === === === === === === === |
||||||
|
# Sample 'about' function with punk::args documentation |
||||||
|
# == === === === === === === === === === === === === === === |
||||||
|
tcl::namespace::eval picalc { |
||||||
|
tcl::namespace::export {[a-z]*} ;# Convention: export all lowercase |
||||||
|
variable PUNKARGS |
||||||
|
variable PUNKARGS_aliases |
||||||
|
|
||||||
|
lappend PUNKARGS [list { |
||||||
|
@id -id "(package)picalc" |
||||||
|
@package -name "picalc" -help\ |
||||||
|
"Package |
||||||
|
Description" |
||||||
|
}] |
||||||
|
|
||||||
|
namespace eval argdoc { |
||||||
|
#namespace for custom argument documentation |
||||||
|
proc package_name {} { |
||||||
|
return picalc |
||||||
|
} |
||||||
|
proc about_topics {} { |
||||||
|
#info commands results are returned in an arbitrary order (like array keys) |
||||||
|
set topic_funs [info commands [namespace current]::get_topic_*] |
||||||
|
set about_topics [list] |
||||||
|
foreach f $topic_funs { |
||||||
|
set tail [namespace tail $f] |
||||||
|
lappend about_topics [string range $tail [string length get_topic_] end] |
||||||
|
} |
||||||
|
#Adjust this function or 'default_topics' if a different order is required |
||||||
|
return [lsort $about_topics] |
||||||
|
} |
||||||
|
proc default_topics {} {return [list Description *]} |
||||||
|
|
||||||
|
# ------------------------------------------------------------- |
||||||
|
# get_topic_ functions add more to auto-include in about topics |
||||||
|
# ------------------------------------------------------------- |
||||||
|
proc get_topic_Description {} { |
||||||
|
punk::args::lib::tstr [string trim { |
||||||
|
package picalc |
||||||
|
experiments in calculating pi in Tcl |
||||||
|
} \n] |
||||||
|
} |
||||||
|
proc get_topic_License {} { |
||||||
|
return "MIT" |
||||||
|
} |
||||||
|
proc get_topic_Version {} { |
||||||
|
return "$::picalc::version" |
||||||
|
} |
||||||
|
proc get_topic_Contributors {} { |
||||||
|
set authors {<unspecified>} |
||||||
|
set contributors "" |
||||||
|
foreach a $authors { |
||||||
|
append contributors $a \n |
||||||
|
} |
||||||
|
if {[string index $contributors end] eq "\n"} { |
||||||
|
set contributors [string range $contributors 0 end-1] |
||||||
|
} |
||||||
|
return $contributors |
||||||
|
} |
||||||
|
proc get_topic_notes {} { |
||||||
|
punk::args::lib::tstr -return string { |
||||||
|
A playground for evaluating performance and testing methods to calculate |
||||||
|
the digits pi in Tcl. |
||||||
|
|
||||||
|
A precalculated value of enough precision for almost any |
||||||
|
usecase is available at $::math::constants::pi after loading |
||||||
|
the math::constants package. |
||||||
|
|
||||||
|
Note that this package is focused on calculating the digits of pi so |
||||||
|
there is no rounding of the final digit. |
||||||
|
|
||||||
|
For large values of pi using the mathematical concept of 'precision' |
||||||
|
rather than decimal places - consider math::bigfloat::pi |
||||||
|
} |
||||||
|
} |
||||||
|
# ------------------------------------------------------------- |
||||||
|
} |
||||||
|
|
||||||
|
# we re-use the argument definition from punk::args::standard_about and override some items |
||||||
|
set overrides [dict create] |
||||||
|
dict set overrides @id -id "::picalc::about" |
||||||
|
dict set overrides @cmd -name "picalc::about" |
||||||
|
dict set overrides @cmd -help [string trim [punk::args::lib::tstr { |
||||||
|
Experiments in calculating the digits of pi |
||||||
|
}] \n] |
||||||
|
dict set overrides topic -choices [list {*}[picalc::argdoc::about_topics] *] |
||||||
|
dict set overrides topic -choicerestricted 1 |
||||||
|
dict set overrides topic -default [picalc::argdoc::default_topics] ;#if -default is present 'topic' will always appear in parsed 'values' dict |
||||||
|
set newdef [punk::args::resolved_def -antiglobs -package_about_namespace -override $overrides ::punk::args::package::standard_about *] |
||||||
|
lappend PUNKARGS [list $newdef] |
||||||
|
proc about {args} { |
||||||
|
package require punk::args |
||||||
|
#standard_about accepts additional choices for topic - but we need to normalize any abbreviations to full topic name before passing on |
||||||
|
set argd [punk::args::parse $args withid ::picalc::about] |
||||||
|
lassign [dict values $argd] _leaders opts values _received |
||||||
|
punk::args::package::standard_about -package_about_namespace ::picalc::argdoc {*}$opts {*}[dict get $values topic] |
||||||
|
} |
||||||
|
} |
||||||
|
# end of sample 'about' function |
||||||
|
# == === === === === === === === === === === === === === === |
||||||
|
|
||||||
|
|
||||||
|
# ----------------------------------------------------------------------------- |
||||||
|
# register namespace(s) to have PUNKARGS,PUNKARGS_aliases variables checked |
||||||
|
# ----------------------------------------------------------------------------- |
||||||
|
# variable PUNKARGS |
||||||
|
# variable PUNKARGS_aliases |
||||||
|
namespace eval ::punk::args::register { |
||||||
|
#use fully qualified so 8.6 doesn't find existing var in global namespace |
||||||
|
lappend ::punk::args::register::NAMESPACES ::picalc |
||||||
|
} |
||||||
|
# ----------------------------------------------------------------------------- |
||||||
|
|
||||||
|
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||||
|
## Ready |
||||||
|
package provide picalc [tcl::namespace::eval picalc { |
||||||
|
variable pkg picalc |
||||||
|
variable version |
||||||
|
set version 999999.0a1.0 |
||||||
|
}] |
||||||
|
return |
||||||
|
|
||||||
|
#*** !doctools |
||||||
|
#[manpage_end] |
||||||
|
|
||||||
@ -0,0 +1,3 @@ |
|||||||
|
0.1.0 |
||||||
|
#First line must be a semantic version number |
||||||
|
#all other lines are ignored. |
||||||
Loading…
Reference in new issue