You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
322 lines
12 KiB
322 lines
12 KiB
# -*- 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) 2024 |
|
# |
|
# @@ Meta Begin |
|
# Application punk::sixel 999999.0a1.0 |
|
# Meta platform tcl |
|
# Meta license <unspecified> |
|
# @@ Meta End |
|
|
|
|
|
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
|
# doctools header |
|
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
|
#*** !doctools |
|
#[manpage_begin punkshell_module_punk::sixel 0 999999.0a1.0] |
|
#[copyright "2024"] |
|
#[titledesc {punk::sixel API}] [comment {-- Name section and table of contents description --}] |
|
#[moddesc {experimental sixel functions}] [comment {-- Description at end of page heading --}] |
|
#[require punk::sixel] |
|
#[keywords module experimental] |
|
#[description] |
|
#[para] Experimental support functions for working with sixel data |
|
#[para] For real sixel work a version written in a systems language such as c or zig may be required. |
|
|
|
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
|
|
|
#*** !doctools |
|
#[section Overview] |
|
#[para] overview of punk::sixel |
|
#[subsection Concepts] |
|
#[para] - |
|
|
|
|
|
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
|
## Requirements |
|
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
|
|
|
#*** !doctools |
|
#[subsection dependencies] |
|
#[para] packages used by punk::sixel |
|
#[list_begin itemized] |
|
|
|
package require Tcl 8.6- |
|
package require punk::args |
|
package require punk::console |
|
package require punk::ansi |
|
#*** !doctools |
|
#[item] [package {Tcl 8.6}] |
|
#[item] [package {punk::args}] |
|
#[item] [package {punk::console}] |
|
#[item] [package {punk::ansi}] |
|
|
|
|
|
# #package require frobz |
|
# #*** !doctools |
|
# #[item] [package {frobz}] |
|
|
|
#*** !doctools |
|
#[list_end] |
|
|
|
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
|
|
|
#*** !doctools |
|
#[section API] |
|
|
|
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
|
# oo::class namespace |
|
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
|
#tcl::namespace::eval punk::sixel::class { |
|
#*** !doctools |
|
#[subsection {Namespace punk::sixel::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 ---}] |
|
#} |
|
#} |
|
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
|
|
|
#reading |
|
#https://www.reddit.com/r/linux/comments/t3m7zm/quick_roundup_of_bitmap_graphics_availability_in/ |
|
|
|
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
|
# Base namespace |
|
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
|
|
|
tcl::namespace::eval punk::sixel { |
|
tcl::namespace::export {[a-z]*} ;# Convention: export all lowercase |
|
#variable xyz |
|
|
|
set sixelstart_re {\x1bP([;0-9]*)q} ;#7-bit - todo 8bit |
|
|
|
#*** !doctools |
|
#[subsection {Namespace punk::sixel}] |
|
#[para] Core API functions for punk::sixel |
|
#[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" |
|
#} |
|
|
|
|
|
|
|
#terminated by ST |
|
#some older terminals may terminate at first other esc encountered. |
|
#non-sixel characters ignored (? review) |
|
#we will for now consume all to final ST |
|
#TODO - sixel row/col info is dependent on terminal - pass in -terminalobject or -inoutchannels (for use with punk::console::cell_size) |
|
punk::args::definition { |
|
*id punk::sixel::get_info |
|
-cache -default 1 -type boolean -help\ |
|
"Cached result based on sha1 hash." |
|
-cell_size -default "" -help\ |
|
"override terminal cell_size. |
|
If left empty, attempt to use value from querying terminal." |
|
*values -min 1 -max 1 |
|
sixelstring -type string -help "A single sixel image - currently only 7-bit supported" |
|
} |
|
variable sixelinfo_cache |
|
set sixelinfo_cache [dict create] |
|
proc get_info {args} { |
|
set argd [punk::args::get_by_id punk::sixel::get_info $args] |
|
set sixelstring [dict get $argd values sixelstring] |
|
set do_cache [dict get $argd opts -cache] |
|
set cell_size_override [dict get $argd opts -cell_size] |
|
|
|
if {$do_cache} { |
|
if {[catch {package require sha1}]} { |
|
set do_cache 0 |
|
} |
|
} |
|
if {$do_cache} { |
|
variable sixelinfo_cache |
|
set cacheid ${cell_size_override}_[sha1::sha1 $sixelstring] |
|
if {[dict exists $sixelinfo_cache $cacheid]} { |
|
return [dict get $sixelinfo_cache $cacheid] |
|
} |
|
} |
|
|
|
#relatively slow because a) we parse each sixel line in case it is ragged width b) should probably be written in a systems language or be a library call |
|
set raster_lines [split $sixelstring -] |
|
set height_pixels [expr {[llength $raster_lines] * 6}] |
|
if {$cell_size_override ne ""} { |
|
lassign [split [string tolower $cell_size_override] x] cwidth cheight |
|
if {![string is integer -strict $cwidth] || ![string is integer -strict $cheight]} { |
|
error "punk::sixel::get_info -cell_sixe must be of the form WxH where W and H are positive integers" |
|
} |
|
set cell_size $cell_size_override |
|
} else { |
|
set cell_size [punk::console::cell_size] |
|
} |
|
lassign [split $cell_size x] cwidth cheight |
|
set height_cells [expr {int(ceil($height_pixels /double($cheight)))}] |
|
set sixelparams "" |
|
set sixel_extents [list] ;#number of sixes in each line taking into account retraces due to $ |
|
|
|
set line0 [lindex $raster_lines 0] |
|
if {[regexp -indices {^\x1bP([;0-9]*)q} $line0 i_match]} { |
|
#todo - 8bit |
|
#set params [string range $line0 {*}$i_params] ;#may be empty |
|
set linedata [string range $line0 [lindex $i_match 1]+1 end] |
|
if {[string index $linedata 0] eq {"}} { |
|
if {[regexp -indices {\"([;0-9]*)} $linedata i_match]} { |
|
#i_params is raster info (todo?) |
|
set linedata [string range $linedata [lindex $i_match 1]+1 end] |
|
} else { |
|
#lone quote? |
|
set linedata [string range $linedata 1 end] |
|
} |
|
} |
|
lset raster_lines 0 $linedata |
|
} else { |
|
error "punk::sixel::get_info failed to recognise first line as a sixel string" |
|
} |
|
|
|
foreach linedata $raster_lines { |
|
set line_sixelrun 0 |
|
set line_sixelrun_max 0 ;#max encountered for this line |
|
for {set s 0} {$s < [string length $linedata]} {incr s} { |
|
#set cdec [scan [string index $linedata $s] %c] ;#scanning each char and switching on cdec is slower |
|
set c [string index $linedata $s] |
|
switch -- $c { |
|
{#} { |
|
#colour palette select or set |
|
if {[regexp -start $s -indices {#([;0-9]*)} $linedata i_match]} { |
|
#set colour_info [string range $linedata {*}$i_colour] |
|
set s [lindex $i_match 1] |
|
} |
|
#if no number following.. ignore |
|
} |
|
{$} { |
|
#retrace |
|
set line_sixelrun_max [expr {max($line_sixelrun_max,$line_sixelrun)}] |
|
set line_sixelrun 0 |
|
} |
|
{!} { |
|
#repeat #<num><char> |
|
set repeat [regexp -inline -start $s+1 {[0-9]*} $linedata] |
|
if {[string is integer -strict $repeat] && $repeat >= 0} { |
|
incr s [expr {[string length $repeat]+1}] ;#add one for the repeated sixel char |
|
incr line_sixelrun $repeat |
|
} |
|
} |
|
default { |
|
#don't use escape in switch selector - ensures jump table is used. |
|
if {$c eq "\x1b"} { |
|
if {[string index $linedata $s+1] eq "\\"} { |
|
#7bit ST |
|
break |
|
} |
|
} else { |
|
incr line_sixelrun |
|
} |
|
} |
|
} |
|
} |
|
lappend sixel_extents [expr {max($line_sixelrun_max,$line_sixelrun)}] |
|
} |
|
set width_pixels [tcl::mathfunc::max 0 {*}$sixel_extents] |
|
set width_cells [expr {int(ceil($width_pixels/double($cwidth)))}] |
|
|
|
set result [dict create rasterlines [llength $raster_lines] columns $width_cells rows $height_cells cell_size $cell_size width_pixels $width_pixels height_pixels $height_pixels sixel_extents $sixel_extents] |
|
#return [dict create rasterlines [llength $raster_lines] columns $width_cells rows $height_cells width_pixels $width_pixels height_pixels $height_pixels] |
|
if {$do_cache} { |
|
dict set sixelinfo_cache $cacheid $result |
|
} |
|
return $result |
|
} |
|
|
|
|
|
#*** !doctools |
|
#[list_end] [comment {--- end definitions namespace punk::sixel ---}] |
|
} |
|
|
|
|
|
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
|
|
|
|
|
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
|
# Secondary API namespace |
|
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
|
|
|
tcl::namespace::eval punk::sixel::lib { |
|
tcl::namespace::export {[a-z]*} ;# Convention: export all lowercase |
|
tcl::namespace::path [tcl::namespace::parent] |
|
|
|
#*** !doctools |
|
#[subsection {Namespace punk::sixel::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 ascii_to_sixelvalue {a} { |
|
set dec [scan $a %c] |
|
if {$dec < 63 || $dec > 127} {error "ascii character to convert to sixel value must be from 63 to 126 (chars '?' through to '~')"} |
|
incr dec -63 |
|
} |
|
proc ascii_from_sixelvalue {sv} { |
|
if {$sv < 0 || $sv > 63} {error "sixel value must be from 0 to 63 inclusive"} |
|
format %c [expr {$sv + 63}] |
|
} |
|
|
|
|
|
|
|
#*** !doctools |
|
#[list_end] [comment {--- end definitions namespace punk::sixel::lib ---}] |
|
} |
|
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
|
|
|
|
|
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
|
## Ready |
|
package provide punk::sixel [tcl::namespace::eval punk::sixel { |
|
variable pkg punk::sixel |
|
variable version |
|
set version 999999.0a1.0 |
|
}] |
|
return |
|
|
|
#*** !doctools |
|
#[manpage_end] |
|
|
|
|