# -*- 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]