Thursday, June 23, 2022

Text chopping and glueing.


 

 

 

# !/bin/sh
# the next line restarts using tclsh \
exec tclsh "$0" "$@"

package require Gnocl

namespace eval text {}

## split text into enumerated list of paragraphs
# @param    txt        block of text to split
# @returns    enumerated list of paragraphs.

proc text::paras { txt } {
    set i 0
    foreach line [split $txt \n] {
        if { [string is space $line] } {
            incr i
        } else {
            dict append res $i "$line "
        }  
    }

    return $res
}

## split text into blocks based upon puncutation marks
# @param    txt        block of text to split
# @param    marks    valid list of punctuation marks
# @returns    enumerated list of blocks.

proc text::blocks {txt marks} {
    set i 0
    foreach ch [split $txt ""] {
        if { [string first $ch $marks] != -1 } { incr i}
        dict append res $i $ch
        if { [string first $ch $marks] != -1 } { incr i}
    }
    return $res
}

## concatenate enumerated list of text blocks
# @param    str
# @returns    concated text

proc text::recombine {str} {
    for {set k 0} {$k < [dict size $str]} {incr k} {
        append res [dict get $str $k]
    }
    return $res
}

## convenience wrapper around namespace procs
# @param    cmd
# @param    args
# @returns    formatted string
proc text {cmd args} {
    # check for valid command
    if { [lsearch [namespace eval ::text:: info procs] $cmd] < 0 } {
        set distanceToTop [info level]
        for {set i 0} {$i < $distanceToTop} {incr i} {
            set callerlevel [expr {$distanceToTop - $i}]
            append res [info level $callerlevel]\n
        }
        puts stderr "Error! No such command $cmd:\n$res"
        exit 0 }
    
    # call required command
    return [text::$cmd {*}$args]
}


#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# demo
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~


set txt(EN) \
{It was the best of times, it was the worst of times, it was the age of
wisdom, it was the age of foolishness, it was the epoch of belief, it
was the epoch of incredulity, it was the season of Light, it was the
season of Darkness, it was the spring of hope, it was the winter of
despair, we had everything before us, we had nothing before us, we were
all going direct to Heaven, we were all going direct the other way--in
short, the period was so far like the present period, that some of its
noisiest authorities insisted on its being received, for good or for
evil, in the superlative degree of comparison only.

There were a king with a large jaw and a queen with a plain face, on the
throne of England; there were a king with a large jaw and a queen with
a fair face, on the throne of France. In both countries it was clearer
than crystal to the lords of the State preserves of loaves and fishes,
that things in general were settled for ever.

It was the year of Our Lord one thousand seven hundred and seventy-five.
Spiritual revelations were conceded to England at that favoured period,
as at this. Mrs. Southcott had recently attained her five-and-twentieth
blessed birthday, of whom a prophetic private in the Life Guards had
heralded the sublime appearance by announcing that arrangements were
made for the swallowing up of London and Westminster. Even the Cock-lane
ghost had been laid only a round dozen of years, after rapping out its
messages, as the spirits of this very year last past (supernaturally
deficient in originality) rapped out theirs. Mere messages in the
earthly order of events had lately come to the English Crown and People,
from a congress of British subjects in America: which, strange
to relate, have proved more important to the human race than any
communications yet received through any of the chickens of the Cock-lane
brood.}

set txt(ZH) \
{大哉智度!萬聖資通,咸宗以成也。地合日照,無法不周,不恃不處,累彼有名,既外有名,亦病無形,兩忘玄莫,喟然無主,此智之紀也。

夫永壽莫美乎上乾,而齊之殤子;神偉莫美於凌虛,而同之[仁-二+肙]滯;至德莫大乎真人,而比之朽種;高妙莫大乎世雄,而喻之幻夢。

由此論之,亮為眾聖宗矣。何者?執道御有,卑高有差,此有為之域耳;非據真如、遊法性、冥然無名也。據真如、遊法性、冥然無名者,智度之奧室也。

名教遠想者,智度之蘧廬也。然在乎證者,莫不[貝*賓]其生無而惶胘;存乎邇者,莫不忿其蕩冥而誕誹。

道動必反,優劣致殊,眩誹不其宜乎!

不其宜乎!}


set marks(EN) [list .,\;:!?()]
set marks(ZH) [list ,。(;)?!]

set buff [text::paras $txt(EN)]

set blocks [text::blocks [dict get $buff 1] $marks(EN) ]

puts [dict get $buff 1]\n~~~~~
puts $blocks\n~~~~~
puts [text::recombine $blocks]\n~~~~~

# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
set paras [text paras $txt(ZH)]
set blocs [text blocks [dict get $paras 1] $marks(ZH) ]
puts $blocs
puts [text recombine $blocs]
text xx
 

Sunday, June 12, 2022

ToggleButton Background Colour Changes

Earlier versions of the Gtk2 libraries allowed for the runtime setting/overriding of default widget colour properties. Legacy Tcl/Gnocl scripts can't rely on such settings to work with later release perhaps because of the shift towards the use of CSS to define widget style properties.

Saturday, June 04, 2022

Converting Between Colour Formats: hex, 8-bit, 16-bit and float.

The gnocl package has its own C-based conversion commands but here are the pure Tcl equivalents.

 

 

# !/bin/sh
# the next line restarts using tclsh \
exec tclsh "$0" "$@"
package require Gnocl
# colour in hexadecimal
set clr #8B6914
puts $clr
proc hex2rgb { hex {opt -8bit} } {
    if { [lsearch "-8bit -16bit -float" $opt] == -1 } {
        set msg "Error. Wrong option $opt.\nValid options are: -8bit (default) -16bit, or -float."
        return -code error $msg
    }
    # convert to 8bit values
    scan $hex "#%02x%02x%02x" r g b
    switch $opt {
        -16bit {
            # convert to 0-65535
            if {$r eq 0} {set r 0} {set r [expr int ( ($r.0/255)*65535 )]}
            if {$g eq 0} {set g 0} {set g [expr int ( ($g.0/255)*65535 )]}
            if {$b eq 0} {set b 0} {set b [expr int ( ($b.0/255)*65535 )]}
            }
        -float {
            # convert 0-1.0
            if {$r eq 0} {set r 0.0} {set r [expr $r.0/255]}
            if {$g eq 0} {set g 0.0} {set g [expr $g.0/255]}
            if {$b eq 0} {set b 0.0} {set b [expr $b.0/255]}
            }
    }
    return [list $r $g $b]
}
puts [hex2rgb $clr]
puts [hex2rgb $clr -16bit]
puts [hex2rgb $clr -float]
proc rgb2hex { clr {opt -8bit} } {
    lassign $clr r g b
    if { [lsearch "-8bit -16bit -float" $opt] == -1 } {
        set msg "Error. Wrong option $opt.\nValid options are: -8bit (default) -16bit, or -float."
        return -code error $msg
    }
    switch $opt {
        -16bit {
            # convert to 0-65535
            set d [expr 255.0/65535]
            if {$r eq 0} {set r 0} {set r [expr int ( $r.0*$d )]}
            if {$g eq 0} {set g 0} {set g [expr int ( $g.0*$d )]}
            if {$b eq 0} {set b 0} {set b [expr int ( $b.0*$d )]}
            }
        -float {
            # convert 0-1.0
            if {$r eq 0} {set r 0} {set r [expr int ( $r*255.0 )]}
            if {$g eq 0} {set g 0} {set g [expr int ( $g*255.0 )]}
            if {$b eq 0} {set b 0} {set b [expr int ( $b*255.0 )]}
            }
    }
    return [format "#%02X%02X%02X" $r $g $b]
}
puts [rgb2hex {139 105 20} ]
puts [rgb2hex {35723 26985 5140} -16bit]
puts [rgb2hex {0.5450980392156862 0.4117647058823529 0.0784313725490196} -float]
proc rgba2hex { clr {opt -8bit} } {
    lassign $clr r g b a
    if { [lsearch "-8bit -16bit -float" $opt] == -1 } {
        set msg "Error. Wrong option $opt.\nValid options are: -8bit (default) -16bit, or -float."
        return -code error $msg
    }
    switch $opt {
        -16bit {
            # convert to 0-65535
            if {$a == ""} {set a 65535}
            set d [expr 255.0/65535]
            if {$r eq 0} {set r 0} {set r [expr int ( $r.0*$d )]}
            if {$g eq 0} {set g 0} {set g [expr int ( $g.0*$d )]}
            if {$b eq 0} {set b 0} {set b [expr int ( $b.0*$d )]}
            if {$a eq 0} {set a 0} {set a [expr int ( $a.0*$d )]}
            }
        -float {
            # convert 0-1.0
            if {$a == ""} {set a 1.0}
            if {$r eq 0} {set r 0} {set r [expr int ( $r*255.0 )]}
            if {$g eq 0} {set g 0} {set g [expr int ( $g*255.0 )]}
            if {$b eq 0} {set b 0} {set b [expr int ( $b*255.0 )]}
            if {$a eq 0} {set a 0} {set a [expr int ( $a*255.0 )]}
            }
        default {
            if {$a == ""} {set a 255}
            }
    }
    return [format "#%02X%02X%02X%02X" $r $g $b $a]
}
puts [rgba2hex {255 255 255}]
puts [rgba2hex {255 255 255 255}]

 

Converting a Pango Markup String into an Enumerated List

Needed something to breakup a string into  a simple list.  My first thought was to use arrays but then thought about using the dict command. This will produce an enumerated list maintaining the creation order of the extracted text markup substrings.



set str "abc deg ghi <b>Bold</b> italic <i>italic</i>"

## parse markup string string into an enumerated list of text and tags
# @param   str
# @returns enumerated list


proc parseMarkupStr {str} {
    set idx 0
    set res ""
    set t 0
    foreach ch [split $str {}] {
        # detect markup start and end
        if { $ch == "&lt;" } {
            set t 1
            incr idx }
        if { $ch == "&gt;" } {
            set res [dict append res $idx $ch]
            set t 0
            incr idx
            continue }
        set res [dict append res $idx $ch]
    }
    return $res
}


puts [parseMarkup $str]


0 {abc deg ghi } 1 <b> 2 Bold 3 </b> 4 { italic } 5 <i> 6 italic 7 </i>

Retrieving Invisible Text

 One of the many options of the text widget tag is the boolean -invisible property. When used, it must be born in mind that it doesn't merely affect the on-screen visibility of the contents of the text buffer to which the tag set with this option applies, but to the retrieval of the text too. The text widget get comment, returns the visible contents of the text view, if the actual contents of the displayed text buffer are needed, then the dump command should be used. 

So, to return the visible contents of the text view use:

$wid get

But to return the entire text content of the text buffer, use:

$wid dump text start end



Wednesday, June 01, 2022

Tabulate

 Simple way of inserting beautified tables into the gnocl::text widget.



# !/bin/sh
# the next line restarts using tclsh \
exec tclsh "$0" "$@"

package require Gnocl

## insert the list contents as in text widget as a formatted table
#
# @param    wid        text widget-id
# @param    lst        tcl list
# @param    id        table id
# @param    args    additional tag parameters
#
proc tabulate {wid lst {id 1} args} {

    if {$args == ""} { set args "-tabs 100" }

    foreach row $lst { append res [join $row \t]\n }

    $wid tag create _tab_table_$id {*}$args
    $wid insert end $res -tags _tab_table_$id

}

set txt [gnocl::text]
gnocl::window -child $txt -setSize 0.4

set lst(1) {{red orange yellow green blue indigo violet} {magenta cyan yellow brown grey black white}}
set lst(2) {{how now brown cow} {she sells sea shells by the sea shore}}
set lst(3) {{peter piper picked a peck of pickled peppers} {the peck of peppers peter piper picked}}

tabulate $txt $lst(1) 1 -tabs 120 -paragraph red -font {12}
tabulate $txt $lst(2) 2 -tabs 80 -foreground magenta
tabulate $txt $lst(3) 3 -tabs 80 -foreground white -paragraph #000000 -font {10}