19 changed files with 2395 additions and 1651 deletions
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
@ -0,0 +1,501 @@ |
|||||||
|
# -*- tcl -*- |
||||||
|
# Maintenance Instruction: leave the 999999.xxx.x as is and use punkshell 'pmix make' or bin/punkmake to update from <pkg>-buildversion.txt |
||||||
|
# module template: shellspy/src/decktemplates/vendor/punk/modules/template_module-0.0.2.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) 2024 |
||||||
|
# |
||||||
|
# @@ Meta Begin |
||||||
|
# Application punk::experiment 999999.0a1.0 |
||||||
|
# Meta platform tcl |
||||||
|
# Meta license <unspecified> |
||||||
|
# @@ Meta End |
||||||
|
|
||||||
|
|
||||||
|
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||||
|
# doctools header |
||||||
|
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||||
|
#*** !doctools |
||||||
|
#[manpage_begin shellspy_module_punk::experiment 0 999999.0a1.0] |
||||||
|
#[copyright "2024"] |
||||||
|
#[titledesc {Module API}] [comment {-- Name section and table of contents description --}] |
||||||
|
#[moddesc {-}] [comment {-- Description at end of page heading --}] |
||||||
|
#[require punk::experiment] |
||||||
|
#[keywords module] |
||||||
|
#[description] |
||||||
|
#[para] - |
||||||
|
|
||||||
|
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||||
|
|
||||||
|
#*** !doctools |
||||||
|
#[section Overview] |
||||||
|
#[para] overview of punk::experiment |
||||||
|
#[subsection Concepts] |
||||||
|
#[para] - |
||||||
|
|
||||||
|
|
||||||
|
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||||
|
## Requirements |
||||||
|
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||||
|
|
||||||
|
#*** !doctools |
||||||
|
#[subsection dependencies] |
||||||
|
#[para] packages used by punk::experiment |
||||||
|
#[list_begin itemized] |
||||||
|
|
||||||
|
package require Tcl 8.6- |
||||||
|
#*** !doctools |
||||||
|
#[item] [package {Tcl 8.6}] |
||||||
|
|
||||||
|
# #package require frobz |
||||||
|
# #*** !doctools |
||||||
|
# #[item] [package {frobz}] |
||||||
|
|
||||||
|
#*** !doctools |
||||||
|
#[list_end] |
||||||
|
|
||||||
|
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||||
|
|
||||||
|
#*** !doctools |
||||||
|
#[section API] |
||||||
|
|
||||||
|
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||||
|
# oo::class namespace |
||||||
|
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||||
|
namespace eval punk::experiment::class { |
||||||
|
#*** !doctools |
||||||
|
#[subsection {Namespace punk::experiment::class}] |
||||||
|
#[para] class definitions |
||||||
|
if {[info commands [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 ---}] |
||||||
|
} |
||||||
|
} |
||||||
|
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||||
|
|
||||||
|
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||||
|
# Base namespace |
||||||
|
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||||
|
namespace eval punk::experiment { |
||||||
|
namespace export {[a-z]*} ;# Convention: export all lowercase |
||||||
|
#variable xyz |
||||||
|
|
||||||
|
#*** !doctools |
||||||
|
#[subsection {Namespace punk::experiment}] |
||||||
|
#[para] Core API functions for punk::experiment |
||||||
|
#[list_begin definitions] |
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
#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" |
||||||
|
#} |
||||||
|
|
||||||
|
variable o_opts_table [dict create\ |
||||||
|
] |
||||||
|
variable o_opts_table_defaults [dict create\ |
||||||
|
-test 1\ |
||||||
|
-test2 etc\ |
||||||
|
-test3 333\ |
||||||
|
-test4 444\ |
||||||
|
] |
||||||
|
set topt_keys [dict keys $o_opts_table_defaults] |
||||||
|
set topt_switchkeys [list -test - -test2 - -test3 - -test4] |
||||||
|
|
||||||
|
proc configure args [string map [list %topt_keys% $topt_keys %topt_switchkeys% $topt_switchkeys] { |
||||||
|
variable o_opts_table |
||||||
|
variable o_opts_table_defaults |
||||||
|
if {![llength $args]} { |
||||||
|
return $o_opts_table |
||||||
|
} |
||||||
|
if {[llength $args] == 1} { |
||||||
|
if {[lindex $args 0] in [list %topt_keys%]} { |
||||||
|
#query single option |
||||||
|
set k [lindex $args 0] |
||||||
|
set val [dict get $o_opts_table $k] |
||||||
|
set returndict [dict create option $k value $val ansireset "\x1b\[m"] |
||||||
|
set infodict [dict create] |
||||||
|
switch -- $k { |
||||||
|
-ansibase_header - -ansibase_body - -ansiborder_header - -ansiborder_body - -ansiborder_footer { |
||||||
|
dict set infodict debug [ansistring VIEW $val] |
||||||
|
} |
||||||
|
-framemap_body - -framemap_header - -framelimits_body - -framelimits_header { |
||||||
|
dict set returndict effective [dict get $o_opts_table_effective $k] |
||||||
|
} |
||||||
|
} |
||||||
|
dict set returndict info $infodict |
||||||
|
return $returndict |
||||||
|
#return [dict create option $k value $val ansireset "\x1b\[m" info $infodict] |
||||||
|
} else { |
||||||
|
error "textblock::table configure - unrecognised option '[lindex $args 0]'. Known values [dict keys $o_opts_table_defaults]" |
||||||
|
} |
||||||
|
} |
||||||
|
if {[llength $args] %2 != 0} { |
||||||
|
error "[namespace current]::table configure - unexpected argument count. Require name value pairs" |
||||||
|
} |
||||||
|
foreach {k v} $args { |
||||||
|
switch -- $k { |
||||||
|
%topt_switchkeys% {} |
||||||
|
default { |
||||||
|
error "[namespace current]::table configure - unrecognised option '$k'. Known values [dict keys $o_opts_table_defaults]" |
||||||
|
} |
||||||
|
} |
||||||
|
#if {$k ni [dict keys $o_opts_table_defaults]} { |
||||||
|
# error "[namespace current]::table configure - unrecognised option '$k'. Known values [dict keys $o_opts_table_defaults]" |
||||||
|
#} |
||||||
|
} |
||||||
|
set checked_opts [list] |
||||||
|
foreach {k v} $args { |
||||||
|
switch -- $k { |
||||||
|
-ansibase_header - -ansibase_body - -ansiborder_header - -ansiborder-body - -ansiborder_footer { |
||||||
|
set parts [punk::ansi::ta::split_codes_single $v] ;#caller may have supplied separated codes eg "[a+ Yellow][a+ red]" |
||||||
|
set ansi_codes [list] ; |
||||||
|
foreach {pt code} $parts { |
||||||
|
if {$pt ne ""} { |
||||||
|
#we don't expect plaintext in an ansibase |
||||||
|
error "Unable to interpret $k value as ansi SGR codes. Plaintext detected. Consider using for example: '\[punk::ansi::a+ green]' (or alias '\[a+ green]') to build ansi. debug view: [punk::ansi::ansistring VIEW $v]" |
||||||
|
} |
||||||
|
if {$code ne ""} { |
||||||
|
lappend ansi_codes $code |
||||||
|
} |
||||||
|
} |
||||||
|
set ansival [punk::ansi::codetype::sgr_merge_singles $ansi_codes] |
||||||
|
lappend checked_opts $k $ansival |
||||||
|
} |
||||||
|
-frametype - -frametype_header - -frametype_body { |
||||||
|
#frametype will raise an error if v is not a valid custom dict or one of the known predefined types such as light,heavy,double etc |
||||||
|
lassign [textblock::frametype $v] _cat category _type ftype |
||||||
|
lappend checked_opts $k $v |
||||||
|
} |
||||||
|
-framemap_body - -framemap_header { |
||||||
|
#upvar ::textblock::class::opts_table_defaults tdefaults |
||||||
|
#set default_bmap [dict get $tdefaults -framemap_body] |
||||||
|
#todo - check keys and map |
||||||
|
if {[llength $v] == 1} { |
||||||
|
if {$v eq "default"} { |
||||||
|
upvar ::textblock::class::opts_table_defaults tdefaults |
||||||
|
set default_map [dict get $tdefaults $k] |
||||||
|
lappend checked_opts $k $default_map |
||||||
|
} else { |
||||||
|
error "textblock::table::configure invalid $k value $v. Expected the value 'default' or a dict e.g topleft {hl *}" |
||||||
|
} |
||||||
|
} else { |
||||||
|
foreach {subk subv} $v { |
||||||
|
switch -- $subk { |
||||||
|
topleft - topinner - topright - topsolo - middleleft - middleinner - middleright - middlesolo - bottomleft - bottominner - bottomright - bottomsolo - onlyleft - onlyinner - onlyright - onlysolo {} |
||||||
|
default { |
||||||
|
error "textblock::table::configure invalid $subk. Known values {topleft topinner topright topsolo middleleft middleinner middleright middlesolo bottomleft bottominner bottomright bottomsolo onlyleft onlyinner onlyright onlysolo}" |
||||||
|
} |
||||||
|
} |
||||||
|
dict for {seg subst} $subv { |
||||||
|
switch -- $seg { |
||||||
|
hl - hlt - hlb - vl - vll - vlr - trc - tlc - blc - brc {} |
||||||
|
default { |
||||||
|
error "textblock::table::configure invalid $subk value $seg. Known values {hl hlt hlb vl vll vlr trc tlc blc brc}" |
||||||
|
} |
||||||
|
} |
||||||
|
} |
||||||
|
|
||||||
|
} |
||||||
|
lappend checked_opts $k $v |
||||||
|
} |
||||||
|
|
||||||
|
} |
||||||
|
-framelimits_body - -framelimits_header { |
||||||
|
set specific_framelimits [list] |
||||||
|
foreach fl $v { |
||||||
|
switch -- $fl { |
||||||
|
"default" { |
||||||
|
lappend specific_framelimits trc hlt tlc vll blc hlb brc vlr |
||||||
|
} |
||||||
|
hl { |
||||||
|
lappend specific_framelimits hlt hlb |
||||||
|
} |
||||||
|
vl { |
||||||
|
lappend specific_framelimits vll vlr |
||||||
|
} |
||||||
|
hlt - hlb - vll - vlr - trc - tlc - blc - brc { |
||||||
|
lappend specific_framelimits $fl |
||||||
|
} |
||||||
|
default { |
||||||
|
error "textblock::table::configure invalid $k '$fl'. Known values {hl hlb hlt vl vll vlr trc tlc blc brc} (or default for all)" |
||||||
|
} |
||||||
|
} |
||||||
|
} |
||||||
|
lappend checked_opts $k $specific_framelimits |
||||||
|
} |
||||||
|
-ansireset { |
||||||
|
if {$v eq "\uFFEF"} { |
||||||
|
set RST "\x1b\[m" ;#[a] |
||||||
|
lappend checked_opts $k $RST |
||||||
|
} else { |
||||||
|
error "textblock::table::configure -ansireset is read-only. It is present only to prevent unwanted colourised output in configure commands" |
||||||
|
} |
||||||
|
} |
||||||
|
-show_hseps { |
||||||
|
if {![string is boolean $v]} { |
||||||
|
error "textblock::table::configure invalid $k '$v'. Must be a boolean or empty string" |
||||||
|
} |
||||||
|
lappend checked_opts $k $v |
||||||
|
#these don't affect column width calculations |
||||||
|
} |
||||||
|
-show_edge { |
||||||
|
if {![string is boolean $v]} { |
||||||
|
error "textblock::table::configure invalid $k '$v'. Must be a boolean or empty string" |
||||||
|
} |
||||||
|
lappend checked_opts $k $v |
||||||
|
#these don't affect column width calculations - except if table -minwidth/-maxwidth come into play |
||||||
|
set o_calculated_column_widths [list] ;#invalidate cached column widths - a recalc will be forced when needed |
||||||
|
} |
||||||
|
-show_vseps { |
||||||
|
#we allow empty string - so don't use -strict boolean check |
||||||
|
if {![string is boolean $v]} { |
||||||
|
error "textblock::table::configure invalid $k '$v'. Must be a boolean or empty string" |
||||||
|
} |
||||||
|
#affects width calculations |
||||||
|
set o_calculated_column_widths [list] |
||||||
|
lappend checked_opts $k $v |
||||||
|
} |
||||||
|
-minwidth - -maxwidth { |
||||||
|
set o_calculated_column_widths [list] |
||||||
|
lappend checked_opts $k $v |
||||||
|
} |
||||||
|
default { |
||||||
|
lappend checked_opts $k $v |
||||||
|
} |
||||||
|
} |
||||||
|
} |
||||||
|
#all options checked - ok to update o_opts_table and o_opts_table_effective |
||||||
|
|
||||||
|
#set o_opts_table [dict merge $o_opts_table $checked_opts] |
||||||
|
foreach {k v} $args { |
||||||
|
#yes in safe |
||||||
|
switch -- $k { |
||||||
|
-framemap_header - -framemap_body { |
||||||
|
#framemaps don't require setting every key to update. |
||||||
|
#e.g configure -framemaps {topleft <map>} |
||||||
|
#needs to merge with existing unspecified keys such as topright middleleft etc. |
||||||
|
if {$v eq "default"} { |
||||||
|
dict set o_opts_table $k default |
||||||
|
} else { |
||||||
|
if {[dict get $o_opts_table $k] eq "default"} { |
||||||
|
dict set o_opts_table $k $v |
||||||
|
} else { |
||||||
|
dict set o_opts_table $k [dict merge [dict get $o_opts_table $k] $v] |
||||||
|
} |
||||||
|
} |
||||||
|
} |
||||||
|
default { |
||||||
|
dict set o_opts_table $k $v |
||||||
|
} |
||||||
|
} |
||||||
|
} |
||||||
|
#use values from checked_opts for the effective opts |
||||||
|
dict for {k v} $checked_opts { |
||||||
|
switch -- $k { |
||||||
|
-framemap_body - -framemap_header { |
||||||
|
set existing [dict get $o_opts_table_effective $k] |
||||||
|
#set updated $existing |
||||||
|
#dict for {subk subv} $v { |
||||||
|
# dict set updated $subk $subv |
||||||
|
#} |
||||||
|
#dict set o_opts_table_effective $k $updated |
||||||
|
dict set o_opts_table_effective $k [dict merge $existing $v] |
||||||
|
} |
||||||
|
-framelimits_body - -framelimits_header { |
||||||
|
#my Set_effective_framelimits |
||||||
|
dict set o_opts_table_effective $k $v |
||||||
|
} |
||||||
|
default { |
||||||
|
dict set o_opts_table_effective $k $v |
||||||
|
} |
||||||
|
} |
||||||
|
} |
||||||
|
#ansireset exception |
||||||
|
dict set o_opts_table -ansireset [dict get $o_opts_table_effective -ansireset] |
||||||
|
return $o_opts_table |
||||||
|
}] |
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
proc test1 {args} { |
||||||
|
set result [list] |
||||||
|
dict for {k v} $args { |
||||||
|
switch -- $k { |
||||||
|
-a - -b - -c - -d - -e - -f - -g - -h - -i - -j - -k - -l - -m - -n - -o - -p - -q - -r - -s - -t - -u - -v - -w - -x - -y - -z { |
||||||
|
switch -- $k { |
||||||
|
-a - -b - -c { |
||||||
|
lappend result "dfor-switcharm1-switcharm1-$k" |
||||||
|
} |
||||||
|
default { |
||||||
|
lappend result "dfor-switcharm1-switchdefault-$k" |
||||||
|
} |
||||||
|
} |
||||||
|
} |
||||||
|
default { |
||||||
|
switch -- $k { |
||||||
|
-1 - -2 - -3 - -4 - -5 - -6 - -7 - -8 - -9 { |
||||||
|
lappend result "dfor-switchdefault-switcharm1-$k" |
||||||
|
} |
||||||
|
default { |
||||||
|
lappend result "dfor-switchdefault-switchdefault-$k" |
||||||
|
} |
||||||
|
} |
||||||
|
} |
||||||
|
} |
||||||
|
} |
||||||
|
return $result |
||||||
|
} |
||||||
|
|
||||||
|
proc test2 {args} { |
||||||
|
set result [list] |
||||||
|
foreach {k v} $args { |
||||||
|
switch -- $k { |
||||||
|
-a - -b - -c - -d - -e - -f - -g - -h - -i - -j - -k - -l - -m - -n - -o - -p - -q - -r - -s - -t - -u - -v - -w - -x - -y - -z { |
||||||
|
switch -- $k { |
||||||
|
-a - -b - -c { |
||||||
|
lappend result "dfor-switcharm1-switcharm1-$k" |
||||||
|
} |
||||||
|
default { |
||||||
|
lappend result "dfor-switcharm1-switchdefault-$k" |
||||||
|
} |
||||||
|
} |
||||||
|
} |
||||||
|
default { |
||||||
|
switch -- $k { |
||||||
|
-1 - -2 - -3 - -4 - -5 - -6 - -7 - -8 - -9 { |
||||||
|
lappend result "dfor-switchdefault-switcharm1-$k" |
||||||
|
} |
||||||
|
default { |
||||||
|
lappend result "dfor-switchdefault-switchdefault-$k" |
||||||
|
} |
||||||
|
} |
||||||
|
} |
||||||
|
} |
||||||
|
} |
||||||
|
return $result |
||||||
|
} |
||||||
|
|
||||||
|
proc test3 {args} { |
||||||
|
set result [list] |
||||||
|
for {set i 0} {$i < [llength $args]} {incr i} { |
||||||
|
set k [lindex $args $i] |
||||||
|
switch -- $k { |
||||||
|
-a - -b - -c - -d - -e - -f - -g - -h - -i - -j - -k - -l - -m - -n - -o - -p - -q - -r - -s - -t - -u - -v - -w - -x - -y - -z { |
||||||
|
switch -- $k { |
||||||
|
-a - -b - -c { |
||||||
|
lappend result "dfor-switcharm1-switcharm1-$k" |
||||||
|
} |
||||||
|
default { |
||||||
|
lappend result "dfor-switcharm1-switchdefault-$k" |
||||||
|
} |
||||||
|
} |
||||||
|
} |
||||||
|
default { |
||||||
|
switch -- $k { |
||||||
|
-1 - -2 - -3 - -4 - -5 - -6 - -7 - -8 - -9 { |
||||||
|
lappend result "dfor-switchdefault-switcharm1-$k" |
||||||
|
} |
||||||
|
default { |
||||||
|
lappend result "dfor-switchdefault-switchdefault-$k" |
||||||
|
} |
||||||
|
} |
||||||
|
} |
||||||
|
} |
||||||
|
} |
||||||
|
return $result |
||||||
|
} |
||||||
|
|
||||||
|
oo::class create c1 { |
||||||
|
method test1 args [info body ::punk::experiment::test1] |
||||||
|
method test2 args [info body ::punk::experiment::test2] |
||||||
|
method test3 args [info body ::punk::experiment::test2] |
||||||
|
} |
||||||
|
c1 create obj1 |
||||||
|
|
||||||
|
|
||||||
|
#*** !doctools |
||||||
|
#[list_end] [comment {--- end definitions namespace punk::experiment ---}] |
||||||
|
} |
||||||
|
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||||
|
|
||||||
|
|
||||||
|
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||||
|
# Secondary API namespace |
||||||
|
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||||
|
namespace eval punk::experiment::lib { |
||||||
|
namespace export {[a-z]*} ;# Convention: export all lowercase |
||||||
|
namespace path [namespace parent] |
||||||
|
#*** !doctools |
||||||
|
#[subsection {Namespace punk::experiment::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 punk::experiment::lib ---}] |
||||||
|
} |
||||||
|
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||||
|
#*** !doctools |
||||||
|
#[section Internal] |
||||||
|
namespace eval punk::experiment::system { |
||||||
|
#*** !doctools |
||||||
|
#[subsection {Namespace punk::experiment::system}] |
||||||
|
#[para] Internal functions that are not part of the API |
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
} |
||||||
|
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||||
|
## Ready |
||||||
|
package provide punk::experiment [namespace eval punk::experiment { |
||||||
|
variable pkg punk::experiment |
||||||
|
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