tcl-tidy: Tcl bindings for libtidy

tcl-tidy

我在最近又試著使用 html tidy 的時候發現這個命令列工具在最近幾年改寫以後，其實只是 libtidy 的包裝。所以也許可以透過 Tcl 呼叫 libtidy 來做到相同的事（而不是 exec tidy tool），所以嘗試寫了一個 Tcl extension，看起來基本的功能和選項設定沒問題，所以我把 code 放一份到 github 了。

2021/01/01 更新
能夠設 encoding 似乎會造成問題，目前先移掉，預設編碼使用 utf8，版本升為 v0.2。

Replace e with E

Write a script to replace the character ‘e’ with ‘E’ in the string ‘Weekly Challenge’. Also print the number of times the character ‘e’ is found in the string.

#!/usr/bin/env tclsh

set times [regsub -all "e" "Weekly Challenge" "E" result]
puts "Find e $times times"
puts "Output: $result"

使用 Regular Expressions 來做替代字串的任務。

也可以使用 string map 來替代字串，下面是 Replace e with E 的其它寫法：

#!/usr/bin/env tclsh

set str "Weekly Challenge"
set count 0

foreach x [split $str {}] {
    if {$x == "e"} {
        incr count
    }
}
puts "Find e $count times"
set result [string map {e E} $str]
puts "Output: $result"

也可以在計算 e 數目的時候就同時建構字串：

#!/usr/bin/env tclsh

set str "Weekly Challenge"
set count 0
set result {}

foreach x [split $str {}] {
    if {$x == "e"} {
        incr count
        append result "E"
    } else {
        append result $x
    }
}
puts "Find e $count times"
puts "Output: $result"

Isomorphic Strings

下面是 Isomorphic Strings 使用 string first 解的結果：

#!/usr/bin/env tclsh
#
# You are given two strings $A and $B. 
# Write a script to check if the given strings are Isomorphic. 
# Print 1 if they are otherwise 0.
#

proc isIsomorphic {str1 str2} {
    set len [string length $str1]
    if {$len != [string length $str2]} {
        return 0
    }

    for {set i 0} {$i < $len} {incr i} {
        set floc1 [string first [string index $str1 $i] $str1]
        set floc2 [string first [string index $str2 $i] $str2]

        if {$floc1 != $floc2} {
            return 0
        }
    }

    return 1
}

if {$argc == 2} {
    set string1 [lindex $argv 0]
    set string2 [lindex $argv 1]
} else {
    exit    
}

puts [isIsomorphic $string1 $string2]

Count Number

下面是使用 Tcl 試著解 Count Number 的答案：

#!/usr/bin/tclsh
#
# You are given a positive number $N.
# Write a script to count number and display as you read it.
#
# For example,
# Input: $N = 1122234
# Output: 21321314
# as we read "two 1 three 2 one 3 one 4"
#

puts -nonewline "Please input a number: "
flush stdout
gets stdin number
if {$number <= 0} {
    puts "Number requires > 0."
    exit
}

array set mapping [list 1 one 2 two 3 three 4 four 5 five 6 six 7 seven 8 eight 9 nine]

set last [string index $number 0]
set index 0
set results [list]
lset results $index [list 1 $last]
for {set i 1} {$i < [string length $number]} {incr i} {
    set current [string index $number $i]

    if {$current == $last} {
        set indexlist [lindex $results $index]
        set curval [lindex $indexlist 0]
        incr curval
        set indexlist [list $curval $current]
    } else {
        incr index
        set indexlist [list 1 $current]
    }

    lset results $index $indexlist
    set last $current        
}

set answer {}
foreach r $results {
   append answer [join $r ""]
}
puts "\nOutput: $answer"

puts -nonewline "as we read \""
set nresults [list]
for {set index 0} {$index < [llength $results]} {incr index} {
   set r [lindex $results $index] 
   set key [lindex $r 0]
   set value [lindex $r 1]
   lappend nresults "$mapping($key) $value"
}
puts -nonewline [join $nresults " "]
puts "\""

DNA Sequence

下面是試著使用 Tcl 解 DNA Sequence 問題的解法：

#!/usr/bin/env tclsh
#
# DNA is a long, chainlike molecule which has two strands twisted 
# into a double helix. The two strands are made up of simpler molecules 
# called nucleotides. Each nucleotide is composed of one of the 
# four nitrogen-containing nucleobases cytosine (C), guanine (G), 
# adenine (A) and thymine (T).
# Write a script to print nucleobase count in the given DNA sequence. 
# Also print the complementary sequence where Thymine (T) on one strand 
# is always facing an adenine (A) and vice versa; guanine (G) is always 
# facing a cytosine (C) and vice versa.
#

set dna "GTAAACCCCTTTTCATTTAGACAGATCGACTCCTTATCCATTCTCAGAGATGTGTTGCTGGTCGCCG"
set ccount [llength [regexp -all -inline "C" $dna]]
set gcount [llength [regexp -all -inline "G" $dna]]
set acount [llength [regexp -all -inline "A" $dna]]
set tcount [llength [regexp -all -inline "T" $dna]]
puts "C: $ccount"
puts "G: $gcount"
puts "A: $acount"
puts "T: $tcount"
set complement ""
set length [string length $dna]
for {set i 0} {$i < $length} {incr i} {
    set substring [string index $dna $i]
    if {[string compare $substring "C"]==0} {
        append complement "G"
    } elseif {[string compare $substring "G"]==0} {
        append complement "C"
    } elseif {[string compare $substring "A"]==0} {
        append complement "T"
    } elseif {[string compare $substring "T"]==0} {
        append complement "A"
    }
}
puts ""
puts "Complement:"
puts $complement

也可以這樣寫：

#!/usr/bin/env tclsh
#
# DNA is a long, chainlike molecule which has two strands twisted 
# into a double helix. The two strands are made up of simpler molecules 
# called nucleotides. Each nucleotide is composed of one of the 
# four nitrogen-containing nucleobases cytosine (C), guanine (G), 
# adenine (A) and thymine (T).
# Write a script to print nucleobase count in the given DNA sequence. 
# Also print the complementary sequence where Thymine (T) on one strand 
# is always facing an adenine (A) and vice versa; guanine (G) is always 
# facing a cytosine (C) and vice versa.
#

set dna "GTAAACCCCTTTTCATTTAGACAGATCGACTCCTTATCCATTCTCAGAGATGTGTTGCTGGTCGCCG"
set ccount 0
set gcount 0
set acount 0
set tcount 0
set complement ""
set length [string length $dna]
for {set i 0} {$i < $length} {incr i} {
    set substring [string index $dna $i]
    if {[string compare $substring "C"]==0} {
        incr ccount
        append complement "G"
    } elseif {[string compare $substring "G"]==0} {
        incr gcount
        append complement "C"
    } elseif {[string compare $substring "A"]==0} {
        incr acount
        append complement "T"
    } elseif {[string compare $substring "T"]==0} {
        incr tcount
        append complement "A"
    }
}
puts "C: $ccount"
puts "G: $gcount"
puts "A: $acount"
puts "T: $tcount"
puts ""
puts "Complement:"
puts $complement

如果使用 array 實作，就會是下面的樣子：

#!/usr/bin/env tclsh
#
# DNA is a long, chainlike molecule which has two strands twisted 
# into a double helix. The two strands are made up of simpler molecules 
# called nucleotides. Each nucleotide is composed of one of the 
# four nitrogen-containing nucleobases cytosine (C), guanine (G), 
# adenine (A) and thymine (T).
# Write a script to print nucleobase count in the given DNA sequence. 
# Also print the complementary sequence where Thymine (T) on one strand 
# is always facing an adenine (A) and vice versa; guanine (G) is always 
# facing a cytosine (C) and vice versa.
#

set dna "GTAAACCCCTTTTCATTTAGACAGATCGACTCCTTATCCATTCTCAGAGATGTGTTGCTGGTCGCCG"
set complement ""
array set count {}
set length [string length $dna]
for {set i 0} {$i < $length} {incr i} {
    set substring [string index $dna $i]
    incr count($substring)
    switch $substring {
        "C" {
            append complement "G"
        }
        "G" {
            append complement "C"
        }
        "A" {
            append complement "T"
        } 
        "T" {
            append complement "A"
        }
    }
}
foreach {key value} [array get count] {
    puts "$key: $value"
}
puts ""
puts "Complement:"
puts $complement

GCD Sum

You are given a positive integer $N. Write a script to sum GCD of all possible unique pairs between 1 and $N.

找出來最大公因數 (greatest common divisor) 的和。這裡使用輾轉相除法寫一個取得 gcd 值的函式。

#!/usr/bin/tclsh
#
# You are given a positive integer $N.
# Write a script to sum GCD of all possible unique pairs 
# between 1 and $N.
#

proc gcd {a b} {
    while {$b > 0} {
        set r [::tcl::mathop::% $a $b]
        set a $b
        set b $r
    }

    return $a
}

puts -nonewline "Input: "
flush stdout
gets stdin number
if {$number <= 1} {
    puts "Number requires > 1."
    exit
}

set sum 0
for {set i 1} {$i <= $number} {incr i} {
    for {set j [::tcl::mathop::+ $i 1]} {$j <= $number} {incr j} {
        set value [gcd $i $j]
        set sum [expr $sum + $value]
    }
} 
puts "Output: $sum"

也可以使用 tcllib math::numtheory 套件中的 gcd 函式取得最大公因數的值再加總起來。

#!/usr/bin/tclsh
#
# You are given a positive integer $N.
# Write a script to sum GCD of all possible unique pairs 
# between 1 and $N.
#

package require math::numtheory

puts -nonewline "Input: "
flush stdout
gets stdin number
if {$number <= 1} {
    puts "Number requires > 1."
    exit
}

set sum 0
for {set i 1} {$i <= $number} {incr i} {
    for {set j [::tcl::mathop::+ $i 1]} {$j <= $number} {incr j} {
        set value [math::numtheory::gcd $i $j]
        set sum [expr $sum + $value]
    }
} 
puts "Output: $sum"

Array of Product

You are given an array of positive integers @N. Write a script to return an array @M where $M[i] is the product of all elements of @N except the index $N[i].

#!/usr/bin/env tclsh
#
# You are given an array of positive integers @N.
# Write a script to return an array @M where $M[i] is the product 
# of all elements of @N except the index $N[i].
#

if {$argc <= 1} {
    puts "Please input a list."
    exit
}

set mylist $argv
set p [tcl::mathop::* {*}$mylist]
set result [list]
foreach element $mylist {lappend result [tcl::mathop::/ $p $element]}
puts $result

使用 lmap 來尋訪串列中的每一個元素來解題，可以改寫如下：

#!/usr/bin/env tclsh
#
# You are given an array of positive integers @N.
# Write a script to return an array @M where $M[i] is the product 
# of all elements of @N except the index $N[i].
#

if {$argc <= 1} {
    puts "Please input a list."
    exit
}

set mylist $argv
set p [tcl::mathop::* {*}$mylist]
set result [lmap element $mylist {tcl::mathop::/ $p $element}]
puts $result

Longest Consecutive Sequences

試著使用 Tcl 解 Longest Consecutive Sequences 問題。

#!/usr/bin/env tclsh
#
# You are given an unsorted array of integers.
# Write a script to find the longest consecutive sequence.
# Print 0 if none sequence found.
#

if {$argc <= 1} {
    puts "Please input a list."
    exit
}

# To compare two list's length
proc mysortproc {x y} {
    set len1 [llength $x]
    set len2 [llength $y]

    if {$len1 > $len2} {
        return -1
    } elseif {$len1 < $len2} {
        return 1
    } else {
        return 0
    }
}

set len [llength $argv]
set mylist [lsort -integer $argv]
set last [lindex $mylist 0]
set index 0
set results [list]
lset results $index [list $last]
for {set count 1} {$count < $len} {incr count} {
    set current [lindex $mylist $count]

    if {$current != [expr $last + 1]} {
       incr index
    }

    set indexlist [lindex $results $index]
    set indexlist [lappend indexlist $current]
    lset results $index $indexlist

    set last $current
}

# Sort our results by using sublists's length
set results [lsort -command mysortproc $results]
if {[llength [lindex $results 0]] > 1} {
    puts [lindex $results 0]
} else {
    puts 0
}

如果要使用 anonymous function，則可以改寫如下：

#!/usr/bin/env tclsh
#
# You are given an unsorted array of integers.
# Write a script to find the longest consecutive sequence.
# Print 0 if none sequence found.
#

if {$argc <= 1} {
    puts "Please input a list."
    exit
}

set len [llength $argv]
set mylist [lsort -integer $argv]
set last [lindex $mylist 0]
set index 0
set results [list]
lset results $index [list $last]
for {set count 1} {$count < $len} {incr count} {
    set current [lindex $mylist $count]

    if {$current != [expr $last + 1]} {
       incr index
    }

    set indexlist [lindex $results $index]
    set indexlist [lappend indexlist $current]
    lset results $index $indexlist

    set last $current
}

# Sort our results by using sublists's length
set results [lsort -command {apply {{x y} {
    set len1 [llength $x]
    set len2 [llength $y]

    if {$len1 > $len2} {
        return -1
    } elseif {$len1 < $len2} {
        return 1
    } else {
        return 0
    }
}}} $results]
if {[llength [lindex $results 0]] > 1} {
    puts [lindex $results 0]
} else {
    puts 0
}

也可以使用其它的方式，直接記錄 Longest Consecutive Sequences 的排序，如下所示：

#!/usr/bin/env tclsh
#
# You are given an unsorted array of integers.
# Write a script to find the longest consecutive sequence.
# Print 0 if none sequence found.
#

if {$argc <= 1} {
    puts "Please input a list."
    exit
}

set len [llength $argv]
set mylist [lsort -integer $argv]
set last [lindex $mylist 0]
set index 0
set curresult [list $last]
set maxresult [list $last]
set curval 1
set maxval 1
for {set count 1} {$count < $len} {incr count} {
    set current [lindex $mylist $count]

    if {$current == [expr $last + 1]} {
       lappend curresult $current
       incr curval

       if {$curval > $maxval} {
           set maxresult $curresult
           set maxval $curval
       }
    } else {
       set curval 1
       set curresult [list $current]
    }

    set last $current
}

if {$maxval > 1} {
    puts $maxresult
} else {
    puts "0"
}

Memfrob

使用者在命令列輸入一個字串，使用 Memfrob 編碼（字串的每個字元 XOR 42）以後輸出結果：

#!/usr/bin/env tclsh

proc memfrob {origString} {
    set length [string length $origString]
    set resultString ""
    for {set count 0} {$count < $length} {incr count} {
        set result [string index $origString $count]
        set result [binary format c [expr [scan $result %c] ^ 42]]
        append resultString $result
    }

    return $resultString
}

if {$argc >= 1} {
    set countString [lindex $argv 0]
} elseif {$argc == 0} {
    puts "Please input a string"
    exit    
}

puts "String: $countString"
puts "Result: [memfrob $countString]"

Web Services for Tcl (tclws) 3.0.0

Web Services for Tcl (tclws) 最近釋出了 3.0.0 版，加入了 -hostProtocol 選項，同時將 Tcl 版本的要求從 8.4 升到 8.6。

在最近一個月 Web Services for Tcl 有比較多的小更新版本，從 2.7.0, 2.7.1 到 3.0.0 這幾個版本的更新。

string reverse

 只是用來測試 string reverse 的 script，用來反轉使用者輸入的數字的程式：

#!/usr/bin/tclsh

puts -nonewline "Please input a number: "
flush stdout
gets stdin number
set positive 1
if {$number < 0} {
    set positive 0
    set number [expr $number * -1]
}

set number [string reverse $number]
if {$positive > 0} {
    puts $number
} else {
    set number [expr $number * -1]
    puts $number
}

TclTLS 1.7.22

 TclTLS 釋出了一個新的版本，1.7.22。

版本更新：
add "version" element with SSL/TLS protocol version to tls::status

已經可以 在網站找到下載的檔案了。

Remove .*history* file

 最近我在試著使用 zsh 作為平常使用的 shell（還在測試中），所以試寫了一個會移除 .*history* 檔案的 zsh shell script：

#!/usr/bin/env zsh

pushd $(pwd)
cd $HOME
for file in $(ls .*history*); do
    rm $file && touch $file
done
popd

那麼如果用 Tcl 寫呢？程式應該會是這個樣子：

#!/usr/bin/env tclsh

set currdir [pwd]
cd $::env(HOME)
set files [glob -nocomplain -type f .*history*]
foreach filename $files {
    file delete -force $filename
    if {[file exists $filename]==0} {
        close [open $filename a]
    }
}
cd $currdir

Pandigital Squares

A pandigital number, like 4730825961, is a ten-digit number in which each digit from zero to nine appears exactly once. A square number, like 25² = 625, is a number with an integral square root. Your task is to write a program that finds all of the pandigital square numbers.

下面是嘗試的結果：

#!/usr/bin/env tclsh

set digital [list "0" "1" "2" "3" "4" "5" "6" "7" "8" "9"]

proc is_pandigital {n} {
    set length [string length $n]
    if {$length != 10 } {
        return 0
    }

    foreach mychar $::digital {
        if {[string first $mychar $n] == -1} {
            return 0
        }
    }

    return 1
}

set minvalue [expr int(floor(sqrt(1023456789)))]
set maxvalue [expr int(floor(sqrt(9876543210)))]

for {set n $minvalue} {$n <= $maxvalue} {incr n} {
    set num [expr $n * $n]
    if {[is_pandigital $num]==1} {
         puts $num
    }
}

tksvg 0.4

tksvg 釋出新的版本 v0.4。

要注意的是，如果是使用 source code 自己編譯，需要更新 Makefile.in 才能夠正確安裝，下面就是 github 上的修改方式：

INSTALL        = @INSTALL@
-INSTALL_FLAGS   = @INSTALL_FLAGS@
-INSTALL_PROGRAM    = @INSTALL_PROGRAM@ $(INSTALL_FLAGS)
-INSTALL_LIBRARY    = @INSTALL_PROGRAM@ $(INSTALL_FLAGS)
+INSTALL_PROGRAM    = @INSTALL_PROGRAM@
+INSTALL_LIBRARY    = @INSTALL_PROGRAM@
INSTALL_DATA    = @INSTALL_DATA@
INSTALL_SCRIPT    = @INSTALL_SCRIPT@

孫子問題

在《孫子算經》裡（共三卷，據推測約成書於西元400年左右）， 下卷的第26題，就是鼎鼎有名的「孫子問題」：
今有物不知其數，三三數之剩二，五五數之剩三，七七數之剩二，問物幾何？

下面是使用迴圈的解法：

#!/usr/bin/env tclsh

proc find {n} {
    set i 0
    set a 0

    if {$n <= 0} {
        return 0;
    }

    while {$i < $n} {
         incr a
         if {[expr ($a%3)==2 && ($a%5)==3 && ($a%7)==2]==1} {
            incr i
         }
    }

    return $a
}

for {set num 1} {$num <= 10} {incr num} {
    puts "The $num answer is [find $num]."
}

tDOM 0.9.2

tDOM 釋出了一個新的版本，0.9.2，可以在這裡找到檔案。

要注意的是，tDOM 似乎把 LICENSE 從 MPL 1.1 切換為 MPL 2.0。

Binary Concatenation

嘗試用 Tcl 解題：

#!/usr/bin/env tclsh
#
# The concatenation of the first four integers, written in binary, is 11011100; 
# that is, 1 followed by 10 followed by 11 followed by 100. That concatenated 
# number resolves to 220. A similar process can convert the concatenation of 
# the first n binary numbers to a normal decimal number.
#

proc bitcat {number} {
    # Convert decimal to binary and collect the result
    set result ""
    for {set i 1} {$i <= $number} {incr i} {
        append result [format %llb $i]
    }

    return $result
}

puts -nonewline "Please input a number: "
flush stdout
gets stdin number
if {$number <= 0} {
    puts "Number requires > 0."
    exit
}

puts [expr (0b[bitcat $number]) % ((10 ** 9) + 7)]

也可以這樣解：

#!/usr/bin/env tclsh
#
# The concatenation of the first four integers, written in binary, is 11011100; 
# that is, 1 followed by 10 followed by 11 followed by 100. That concatenated 
# number resolves to 220. A similar process can convert the concatenation of 
# the first n binary numbers to a normal decimal number.
#
proc bitcat {result index} {
    for {set counter $index} {$counter > 0} {set counter [::tcl::mathop::>> $counter 1]} {
         set result [::tcl::mathop::<< $result 1]
    }

    return [::tcl::mathop::| $result $index]
}

proc solution {number} {
    set result 0
    for {set index 1} {$index <= $number} {incr index} {
        set result [bitcat $result $index]
    }

    return [expr $result % ((10 ** 9) + 7)]
}

puts -nonewline "Please input a number: "
flush stdout
gets stdin number
if {$number <= 0} {
    puts "Number requires > 0."
    exit
}
puts [solution $number]

Trailing Zero-Bits

下面是我嘗試的答案：

#!/usr/bin/env tclsh
#
# Trailing Zero-Bits
# Given a positive integer, count the number of trailing zero-bits in its binary 
# representation. For instance, 18 = 10010, so it has 1 trailing zero-bit, 
# and 48 = 110000, so it has 4 trailing zero-bits.
#

puts -nonewline "Please input a number: "
flush stdout
gets stdin number
if {$number <= 0} {
    puts "Number requires > 0."
    exit
}

set trailing {{number} {
    set index 0
    while {[::tcl::mathop::& $number 1]!=1} {
        incr index
        set number [::tcl::mathop::>> $number 1]
    }
    return $index
}}

set count [apply $trailing $number]
puts $count

tcljsonnet v0.13

首頁：
tcljsonnet


主要更新：
將 Jsonnet code base 版本升到 v0.16.0 版。

Generate a file nv2808.xml

寫入資料到 nv-2808.xml。
Source code 搬到 github。


一個小工具。 XQCN 是 Qualcomm 使用的檔案格式，用來記錄 RF 相關的資料。其中 NV 2808 被用來設定為軟體版本的資訊（如果有使用的話）。

舉例來說，如果一個案子叫 FIREBIRD，地區是給北美 (NA) 使用的，目前的開發進度在 MP1，目前的版本是第一版，版本號就是 FIR_NA_MP1_001。這個工具就是用來產生 NV2808 的資料。

一般而言整合的方法有二個方式，第一個是將 NV-2808.xml 轉成 XQCN 檔案再使用 Qualcomm 提供的工具整合，第二個方式是將原始的 QCN 檔案轉為 NV XML 檔案，和 NV-2808.xml 整合以後再使用 Qualcomm 提供的工具轉為 XQCN 檔案。

總之，如果 XQCN 檔案也有放到版本管理中（例如 git），最終成品需要有版本號碼才行，用這樣的方式做 XQCN 檔案版本控管。

Tcl: Hidden Squares

一個 string first 的範例，用來取得 Hidden Squares 問題的解：

#!/usr/bin/tclsh
#
# Hidden Squares:
# A number n may have squares hidden among its digits. For instance, 
# in the number 1625649, the consecutive digits 1, 4, 9, 16, 25, 49, 
# 64, 256 and 625 are all squares.
#

namespace path {::tcl::mathop ::tcl::mathfunc}

puts -nonewline "Please input a number: "
flush stdout
gets stdin number
if {$number <= 0} {
    puts "Number requires > 0."
    exit
}

set max [int [sqrt $number]]
for {set i 1} {$i <= $max} {incr i} {
    set n [* $i $i]
    if {[string first $n $number] >= 0} {
        puts -nonewline "$n "
    }
}
puts ""

這裡也使用了 namespace path。

Tcl 支援 namespace 的概念，一個 namespace 是 function 和變數的集合，和  C++ 類似，透過封裝可以保證不會被其它的 namespace 的變數和命令所影響，而且你可以隨時新增、改名與刪除裡面的成員。

tcl-crc32c v0.1

tcl-crc32c: Tcl bindings for crc32c library.

只是一個練習，因為我太久沒用 C 寫 Tcl extension，剛好 Tcl 沒有這方面的實作，所以寫了一個 Tcl bindings。

PS.
crc32c 我有做一個 openSUSE RPM spec，用來產生 crc32c library 相關的檔案。

Tcl: List Rotation

#!/usr/bin/tclsh
#
# Given a length-n list like (a b c d e), the rotations of the list are
# the n lists (a b c d e), (b c d e a), (c d e a b), (d e a b c), and (e a b c d), 
# in any order.
#
if {$argc == 0} {
    puts "Please input a string"
    exit
}

set len [llength $argv]
set rorateList $argv
for {set index 0} {$index < $len} {incr index} {
    puts $rorateList
    set first [lindex $rorateList 0]
    set rorateList2 [lrange $rorateList 1 [expr $len - 1]]
    lappend rorateList2 $first
    set rorateList $rorateList2
}

使用 lindex 取得頭以後，中間部份使用 lrange 取得，然後再排列出來。

tcl.mqttc v0.7

我發現 paho.mqtt.c 有一個新的版本 1.3.2，所以我做了 tcl.mqttc 相關的更新，同時將版本設成 v0.7。

不過我只有簡單的測試 tcp 部份，使用 ActiveMQ 測試 MQTT 3.1 未加密的傳送與接收。

Tcl: loop (calculates the Harmonic series)

用來練習迴圈的問題。

#!/usr/bin/env tclsh
#
# Calculates the Harmonic series.
# h(n) = 1 + 1/2 + 1/3 + … + 1/n
#

if {$argc >= 1} {
    set N [lindex $argv 0]
} elseif {$argc == 0} {
    puts "Please input a number."
    exit    
}

if {[string is integer $N]==0} {
    puts "It is not a number."
    exit
}

set h 0.0
for {set count $N} {$count >= 1} {incr count -1} {
    set h [expr $h + 1.0 / $count]
}

puts [format "%5E" $h]

再來是使用 while 迴圈計算 Harmonic series 的程式：

#!/usr/bin/env tclsh
#
# Calculates the Harmonic series.
# h(n) = 1 + 1/2 + 1/3 + … + 1/n
#

if {$argc >= 1} {
    set N [lindex $argv 0]
} elseif {$argc == 0} {
    puts "Please input a number."
    exit    
}

if {[string is integer $N]==0} {
    puts "It is not a number."
    exit
}

set h 0.0
set I 1
while {$I <= $N} {
    set h [expr $h + 1.0 / $I]
    incr I
}

puts [format "%5E" $h]

Tcl: Nth Item In A List

假設有一個 List，

set mylist [list 2 4 6 8 10]

如果要取得 List 中 nth 的 item，可以使用 lindex，如下面的例子：

lindex $mylist 1

這樣就會得到 4 這個值。

Tcl: divmod

Given positive integers C and N, find N numbers that sum up to C and the difference between the highest and the lowest of these number should not be more than one. For example: with C = 26 and N = 7, the desired output is [4 4 4 4 4 3 3].

#!/usr/bin/tclsh

proc divmod {C N} {
    set answer [list]

    if {($C <= 0) || ($N <= 0) || ($C < $N)} {
        return $answer
    }

    set element [expr $C / $N]
    set remainder [expr $C % $N]
    
    for {set count 0} {$count < $N} {incr count} {
        lappend answer $element
    }

    if {$remainder != 0} {
        for {set count 0} {$count < $remainder} {incr count} {
            set myvalue [lindex $answer $count]
            incr myvalue 1
            lset answer $count $myvalue
        }
    }

    return $answer
}

puts -nonewline "Please input a number C: "
flush stdout
gets stdin C
puts -nonewline "Please input a number N: "
flush stdout
gets stdin N

set myanswer [divmod $C $N]
puts "The answer list: $myanswer"

Tcl: print number

Write a program that displays the digits from 1 to n then back down to 1; for instance, if n = 5, the program should display 123454321. You are permitted to use only a single for loop. The range is 0 < n < 10.

if {$argc >= 1} {
    set n [lindex $argv 0]
} elseif {$argc == 0} {
    puts "Please input a number."
    exit
}

if {[string is integer $n]==0} {
    puts "It is not a number."
    exit
}

switch $n {
    {1} {puts "1"}
    {2} {puts "121"}
    {3} {puts "12321"}
    {4} {puts "1234321"}
    {5} {puts "123454321"}
    {6} {puts "12345654321"}
    {7} {puts "1234567654321"}
    {8} {puts "123456787654321"}
    {9} {puts "12345678987654321"}
    default {puts "Please input 0 < n < 10"}
}

使用 while 實作的話：

if {$argc >= 1} {
    set n [lindex $argv 0]
} elseif {$argc == 0} {
    puts "Please input a number."
    exit
}

if {[string is integer $n]==0} {
    puts "It is not a number."
    exit
}

if {$n < 1 || $n > 9} {
    puts "Please input 0 < n < 10"
    exit    
}

set positive 1
set count 0
while {1} {
   if {$positive == 1} {
       incr count
       puts -nonewline $count
       if {$count == $n} {
            set positive 0
            continue
       }
   } else {
       incr count -1
       if {$count > 0} {
            puts -nonewline $count
       } else {
            break 
       }
   }
}
puts ""

Tcl: sha256

使用者在命令列輸入一個字串，然後程式計算字串 sha256 的值並且輸出：

#!/usr/bin/env tclsh
if {$argc >= 1} {
    set countString [lindex $argv 0]
} elseif {$argc == 0} {
    puts "Please input a string"
    exit
}

package require sha256
puts "String: $countString"
puts "Result: [string toupper [sha2::sha256 -hex $countString]]"

Tcl: MD5

使用者在命令列輸入一個字串，然後程式計算字串 MD5 的值並且輸出：

#!/usr/bin/env tclsh
if {$argc >= 1} {
    set countString [lindex $argv 0]
} elseif {$argc == 0} {
    puts "Please input a string"
    exit
}

package require md5
puts "String: $countString"
puts "Result: [md5::md5 -hex $countString]"

Tcl: file size

列出目前目錄的檔案與其檔案大小：

#!/usr/bin/env tclsh

foreach filename [glob -nocomplain -type f *] {
    puts "$filename: [file size $filename] bytes"
}

tcl-lmdb v0.4.1

檔案放置網頁

tcl-lmdb - Tcl interface to the Lightning Memory-Mapped Database

About

This is the Lightning Memory-Mapped Database (LMDB) extension for Tcl using the Tcl Extension Architecture (TEA).

LMDB is a Btree-based database management library with an API similar to BerkeleyDB. The library is thread-aware and supports concurrent read/write access from multiple processes and threads. The DB structure is multi-versioned, and data pages use a copy-on-write strategy, which also provides resistance to corruption and eliminates the need for any recovery procedures. The database is exposed in a memory map, requiring no page cache layer of its own. This extension provides an easy to use interface for accessing LMDB database files from Tcl.

Main Change

1. Update LMDB source code.
2. Makefile.in: Remove workaround for glibc.

這是一個 checkpoint 版本，只是建立 tag 追蹤從上一個版本以來的變化。tcl-lmdb 本身是沒有變動的，只有在 Makefile.in 移除關於  glibc 的 workaround，以及更新 LMDB 的 source code。

tklib 0.7

tklib 釋出了一個新的正式版 v0.7。

Overview
========

    5  new packages                in 5  modules
    11 changed packages            in 9  modules
    2  internally changed packages in 1  modules
    47 unchanged packages          in 19 modules
    79 packages, total             in 31 modules, total

New in tklib 0.7
================

    Module                Package               New Version   Comments
    --------------------- --------------------- ------------- ----------
    canvas                canvas::gradient      0.2
    notifywindow          notifywindow          1.0
    persistentSelection   persistentSelection   1.0b1
    scrollutil            scrollutil::common    1.5
    widgetPlus            widgetPlus            1.0b2
    --------------------- --------------------- ------------- ----------

Changes from tklib 0.6 to 0.7
=============================

                                         tklib 0.6     tklib 0.7
    Module          Package              Old Version   New Version   Comments
    --------------- -------------------- ------------- ------------- ----------------
    controlwidget   rdial                0.3           0.7           D EF EX
    crosshair       crosshair            1.1           1.2           B EF EX
    datefield       datefield            0.2           0.3           D EF
    mentry          mentry::common       3.6           3.10          B D EF I
    plotchart       Plotchart            2.1.0         2.4.1         B D EF I
    --------------- -------------------- ------------- ------------- ----------------
    tablelist       tablelist::common    5.7                         API B D EF I P
                    tablelist::common                  6.8           API B D EF I P
    --------------- -------------------- ------------- ------------- ----------------
    tooltip         tooltip              1.4.4         1.4.6         B D EF
    --------------- -------------------- ------------- ------------- ----------------
    wcb             Wcb                  3.4           3.6           B D EF I P
                    wcb                  3.4           3.6           B D EF I P
    --------------- -------------------- ------------- ------------- ----------------
    widgetl         widget::listentry    0.1.1         0.1.2         D I
                    widget::listsimple   0.1.1         0.1.2         D I
    --------------- -------------------- ------------- ------------- ----------------

Invisible changes (documentation, testsuites)
=============================================

                                    tklib 0.6     tklib 0.7
    Module          Package         Old Version   New Version   Comments
    --------------- --------------- ------------- ------------- ----------
    controlwidget   controlwidget   0.1           0.1           D
                    meter           1.0           1.0           EX
    --------------- --------------- ------------- ------------- ----------

critcl 3.1.18

critcl

ChangeLog:

1. Feature (Developer support). Merged pull request #96 from sebres/main-direct-invoke. Enables direct invokation of the "main.tcl" file for starkits from within a dev checkout, i.e. outside of a starkit, or starpack.
2. Feature. Added channel types to the set of builtin argument and result types. The argument types are for simple channel access, access requiring unshared channels, and taking the channel fully into the C level, away from Tcl. The result type comes in variants for newly created channels, known channels, and to return taken channels back to Tcl. The first will register the returned value in the interpreter, the second assumes that it already is.
3. Bugfix. Issue #96. Reworked the documentation around the argument type Tcl_Interp* to make its special status more visible, explain uses, and call it out from result types where its use will be necessary or at least useful.
4. Feature. Package critcl::class bumped to version 1.1. Extended with the ability to create a C API for classes, and the ability to disable the generation of the Tcl API.
5. Bugfix. Merged pull request #99 from pooryorick/master. Fixes to the target directory calculations done by the install code.
6. Merged pull request #94 from andreas-kupries/documentation. A larger documentation cleanup. The main work was done by pooryorick, followed by tweaks done by myself.
7. Extended the test suite with lots of cases based on the examples for the various generator packages. IOW the new test cases replicate/encapsulate the examples and demonstrate that the packages used by the examples generate working code.
8. Bugfix. Issue #95. Changed the field critcl_bytes.s to unsigned char* to match Tcl's type. Further constified the field to make clear that read-only usage is the common case for it.
9. Bugfix/Feature. Package critcl::cutil bumped to version 0.2. Fixed missing inclusion of header "string.h" in "critcl_alloc.h", needed for memcpy in macro STREP. Added macros ALLOC_PLUS and STRDUP. Moved documentation of STREP... macros into proper place (alloc section, not assert).
10. Merged pull request #83 from apnadkarni/vc-fixes. Removed deprecated -Gs for MSVC builds, and other Windows fixups.
11. Feature. Package critcl::iassoc bumped to version 1.1. Refactored internals to generate an include header for use by .c files. This now matches what other generator packages do. The template file is inlined and removed.
12. Merged pull request #82 from gahr/home-symlink Modified tests to handle possibility of $HOME a symlink.
13. Merged pull request #81 from gahr/test-not-installed Modified test support to find uninstalled critcl packages when running tests. Handles all but critcl::md5.
14. Merged pull request #85 from snoe925/issue-84 to fix Issue #84 breaking installation on OSX.
15. Merged pull request #87 from apnadkarni/tea-fixes to fix Issue #86, broken -tea option, generating an incomplete package.
16. Feature. New package critcl::callback providing C-level functions and data structures to manage callbacks from C to Tcl.
17. Feature. Package critcl::literals bumped to version 1.3. Added mode +list enabling the conversion of multiple literals into a list of their strings.
18. Feature. Package critcl::enum bumped to version 1.1. Added basic mode handling, supporting tcl (default) and +list (extension enabling the conversion of multiple enum values into a list of their strings).
19. Feature. Package critcl::emap bumped to version 1.2. Extended existing mode handling with +list extension enabling the conversion of multiple emap values into a list of their strings.
20. Feature. Extended the set of available types by applying a few range restrictions to the scalar types (int, long, wideint, double, float).
    Example: int > 0 is now a viable type name.
    This is actually more limited than the description might let you believe.
    See the package reference for the details.

Guess the number

因為週末沒有外出，所以寫的練習小程式，猜測一個位於 1 - 1000 內的數字。

#!/usr/bin/env tclsh

proc rand_range {min max} { 
    return [expr int(rand()*($max-$min+1)) + $min] 
}

set answer [rand_range 1 1000]
while {1} {
    puts -nonewline "Please input a number to guess (1-1000): "
    flush stdout
    gets stdin guess
    if {$guess == $answer} {
        break;
    } else {
        if {$guess < $answer} {
             puts "Please guess more higher"
        } else {
             puts "Please guess more lower"
        }
    }
}