# -*- tcl -*- # Maintenance Instruction: leave the 999999.xxx.x as is and use punkshell 'dev make' or bin/punkmake to update from -buildversion.txt # module template: punkshell/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) 2024 # # @@ Meta Begin # Application punk::blockletter 0.1.0 # Meta platform tcl # Meta license # @@ Meta End # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ # doctools header # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ #*** !doctools #[manpage_begin punkshell_module_punk::blockletter 0 0.1.0] #[copyright "2024"] #[titledesc {punk::blockletter frame-based large lettering test/logo}] [comment {-- Name section and table of contents description --}] #[moddesc {-}] [comment {-- Description at end of page heading --}] #[require punk::blockletter] #[keywords module] #[description] #[para] This is primarily designed to test large lettering using the block2 frametype which requires the right font support #[para] More reasonably sized block-lettering could be obtained using unicode half-blocks instead - but that doesn't allow the frame outline effect that block2 gives. #[para] Individual blocks have a minimum width of 4 columns and a minimum height of 2 rows (smallest element that can be fully framed) # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ #*** !doctools #[section Overview] #[para] overview of punk::blockletter #[subsection Concepts] #[para] - # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ ## Requirements # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ #*** !doctools #[subsection dependencies] #[para] packages used by punk::blockletter #[list_begin itemized] package require Tcl 8.6- package require textblock #*** !doctools #[item] [package {Tcl 8.6}] #[item] [package {textblock}] # #package require frobz # #*** !doctools # #[item] [package {frobz}] #*** !doctools #[list_end] # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ #*** !doctools #[section API] # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ # oo::class namespace # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ #tcl::namespace::eval punk::blockletter::class { #*** !doctools #[subsection {Namespace punk::blockletter::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 ---}] #} #} # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ # Base namespace # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ tcl::namespace::eval punk::blockletter { tcl::namespace::export {[a-z]*} ;# Convention: export all lowercase #variable xyz #*** !doctools #[subsection {Namespace punk::blockletter}] #[para] Core API functions for punk::blockletter #[list_begin definitions] #A 3x4 block font variable default_frametype set default_frametype {vl \u00a0 hl \u00a0 tlc \u00a0 trc \u00a0 blc \u00a0 brc \u00a0} # colours in order for T c l T k set logo_letter_colours [list Web-red Web-green Web-royalblue Web-purple Web-orange] set logo_letter_colours [list Red Green Blue Purple Yellow] proc logo {args} { variable logo_letter_colours variable default_frametype set argd [punk::args::get_dict [tstr -return string { -frametype -default {${$default_frametype}} -outlinecolour -default "web-white" -backgroundcolour -default {} -help "e.g Web-white This argument is the name as accepted by punk::ansi::a+" *values -min 0 -max 0 }] $args] set f [dict get $argd opts -frametype] set bd [dict get $argd opts -outlinecolour] set bgansi [dict get $argd opts -backgroundcolour] ;#we use ta::detect to see if already ansi and apply as necessary #standard red green blue purple yellow lassign $logo_letter_colours c_0 c_1 c_2 c_3 c_4 set tc [merge_left_block [T -bg $c_0 -border $bd -frametype $f] [c -bg $c_1 -border $bd -frametype $f]] set tk [merge_left_block [T -bg $c_3 -border $bd -frametype $f] [k_short -bg $c_4 -border $bd -frametype $f]] set logo [textblock::join_basic -- $tc [l -bg $c_2 -border $bd -frametype $f] [textblock::block 2 8 " "] $tk] if {$bgansi ne ""} { lassign [textblock::size_as_list $logo] lwidth lheight set w [expr {$lwidth + 2}] set h [expr {$lheight + 2}] if {![punk::ansi::ta::detect $bgansi]} { set bgansi [punk::ansi::a+ $bgansi] } set logobg $bgansi[textblock::block $w $h " "][punk::ansi::a] set topmargin [string repeat " " $w] set lmargin [textblock::block 1 [expr {$h + 1}] " "] set logo [overtype::left -transparent " " $logobg [textblock::join_basic -- $lmargin $topmargin\n$logo]] } return $logo } #for characters where it makes sense - offset left by 4 (1 'block' width) proc merge_left {charleft textright} { if {[string length $charleft] != 1} { error "merge_left requires a single character as the charleft argument" } if {[textblock::height $charleft$textright] > 1} { error "merge_left only operates on a plain char and a plain string with no newlines" } set rhs [textblock::join_basic -- [textblock::block 8 8 " "] [text $textright]] #important to explicitly use -transparent " " (ordinary space) rather than -transparent 1 (any space?) #This is because our frames have NBSP as filler to be non-transparent return [overtype::left -transparent " " -overflow 1 [text $charleft] $rhs] } proc merge_left_block {blockleft blockright} { set rhs [textblock::join_basic -- [textblock::block 8 8 " "] $blockright] return [overtype::left -transparent " " -overflow 1 $blockleft $rhs] } proc T {args} { set args [dict remove $args -width -height] append out [lib::hbar {*}$args]\n append out [textblock::join -- " " [lib::vbar {*}$args] " "] } proc c {args} { set args [dict remove $args -width -height] append out [textblock::block 12 2 " "]\n append out [lib::hbar {*}$args]\n append out [textblock::join -- [lib::block {*}$args] " "]\n append out [lib::hbar {*}$args] } proc l {args} { set args [dict remove $args -width -height] append out [lib::vbar {*}[dict merge {-height 8} $args]] } #full height lower k proc k {args} { set args [dict remove $args -width -height] set left [lib::vbar {*}[dict merge {-height 8} $args]] set centre [textblock::block 4 4 " "]\n append centre [lib::block {*}$args]\n append centre [textblock::block 4 2 " "] set right [textblock::block 4 2 " "]\n append right [lib::block {*}$args]\n append right [textblock::block 4 2 " "]\n append right [lib::block {*}$args] append out [textblock::join_basic -- $left $centre $right] } proc k_short {args} { set args [dict remove $args -width -height] append left [textblock::block 4 2 " "]\n append left [lib::vbar {*}[dict merge {-height 6} $args]] append centre [textblock::block 4 4 " "]\n append centre [lib::block {*}$args]\n append centre [textblock::block 4 2 " "] append right [textblock::block 4 2 " "]\n append right [lib::block {*}$args]\n append right [textblock::block 4 2 " "]\n append right [lib::block {*}$args] append out [textblock::join_basic -- $left $centre $right] } proc text {args} { variable default_frametype set argd [punk::args::get_dict [tstr -return string { -bgcolour -default "Web-red" -bordercolour -default "web-white" -frametype -default {${$default_frametype}} *values -min 1 -max 1 str -help "Text to convert to blockletters Requires terminal font to support relevant block characters" " }] $args] set opts [dict get $argd opts] set str [dict get $argd values str] set str [string map {\r\n \n} $str] set outblocks [list] set literals [list \n] foreach char [split $str ""] { if {$char in $literals} { lappend outblocks $char continue } if {$char in [list \t \r]} { lappend outblocks [textblock::block 1 8 $char] continue } if {[info commands ::punk::blockletter::$char] ne ""} { lappend outblocks [::punk::blockletter::$char {*}$opts] } else { lappend outblocks [textblock::block 12 8 $char] } } return [textblock::join_basic -- {*}$outblocks] } #*** !doctools #[list_end] [comment {--- end definitions namespace punk::blockletter ---}] } # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ # Secondary API namespace # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ tcl::namespace::eval punk::blockletter::lib { tcl::namespace::export {[a-z]*} ;# Convention: export all lowercase tcl::namespace::path [tcl::namespace::parent] #*** !doctools #[subsection {Namespace punk::blockletter::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 #} proc block {args} { upvar ::punk::blockletter::default_frametype ft set argd [punk::args::get_dict [tstr -return string { -height -default 2 -width -default 4 -frametype -default {${$ft}} -bgcolour -default "Web-red" -bordercolour -default "web-white" *values -min 0 -max 0 }] $args] set bg [dict get $argd opts -bgcolour] set bd [dict get $argd opts -bordercolour] set h [dict get $argd opts -height] set w [dict get $argd opts -width] set f [dict get $argd opts -frametype] #a frame will usually be filled with empty spaces if content not specified #fill the frame with a non-space so we can do transparent overtypes using ordinary space as the transparency character set w_in [expr {$w -2}] set h_in [expr {$h -2}] if {$w_in > 0 && $h_in > 0} { set inner [textblock::block $w_in $h_in \u00a0] ;#NBSP textblock::frame -checkargs 0 -type $f -height $h -width $w -ansiborder [a+ $bd $bg] -ansibase [a+ $bg] $inner } else { #important to use no content arg - as empty string has 'height' of 1 in the textblock context (min height of any string is 1 row in the console) textblock::frame -checkargs 0 -type $f -height $h -width $w -ansiborder [a+ $bd $bg] -ansibase [a+ $bg] } } proc hbar {args} { upvar ::punk::blockletter::default_frametype ft set defaults [dict create\ -height 2\ -width 12\ -frametype $ft\ ] set opts [dict merge $defaults $args] block {*}$opts } proc vbar {args} { upvar ::punk::blockletter::default_frametype ft #default height a multiple of default hbar/block height set defaults [dict create\ -height 6\ -width 4\ -frametype $ft\ ] set opts [dict merge $defaults $args] [namespace current]::block {*}$opts } #*** !doctools #[list_end] [comment {--- end definitions namespace punk::blockletter::lib ---}] } # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ #*** !doctools #[section Internal] #tcl::namespace::eval punk::blockletter::system { #*** !doctools #[subsection {Namespace punk::blockletter::system}] #[para] Internal functions that are not part of the API #} # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ ## Ready package provide punk::blockletter [tcl::namespace::eval punk::blockletter { variable pkg punk::blockletter variable version set version 0.1.0 }] return #*** !doctools #[manpage_end]