2010-10-03

apply and procedure

你的程式語言可以這樣做嗎?  讀完以後,用 Tcl 實驗匿名函式能力以後的結果。


寫程式的時候,你注意到有二段 code 一模一樣,除了一個反覆呼叫一個叫 BoomBoom 的函數,另一個反覆呼叫一個喚作 PutInPot 的。

puts "get the lobster"
PutInPot "lobster"
PutInPot "water"

and

puts "get the chicken"
BoomBoom "chicken"
BoomBoom "coconut"

現在你需要一個辦法,使得你可以將一個函數用作另一個函數的參數。這是個重要的能力,因為你更容易將常用的程式碼收藏在一個函數內。而 Tcl 所具有的彈性讓我們可以這樣做:

proc Cook {arg1 arg2 func} {
   puts -nonewline "get the "
   puts $arg1
   
   $func $arg1
   $func $arg2
}

所以我們就可以這樣用:

Cook  "lobster" "water" "PutInPot"
Cook  "chicken" "coconut" "BoomBoom" 

這樣就可以將函數作為參數了。

假設你未定義 PutInPot 或 BoomBoom 這些函數。如果能直接將它寫進一行內,不是比在其他地方宣告它們更好嗎?

proc Cook {arg1 arg2 func} {
   puts -nonewline "get the "
   puts $arg1
   
   set result [info procs $func]

   if {[string length $result] == 0} {
    apply $func $arg1
    apply $func $arg2
   } else {
    $func $arg1
    $func $arg2
   }
}

所以:

Cook "chicken" "coconut" {{food} { 
    puts -nonewline "BoomBoom --- "
    puts $food}
}

這樣是不是很方便?我建立函數時,甚至不用考慮怎麼命名,直接拿起它們,丟到一個函數內就可以了。

apply - Apply an anonymous function
apply func ?arg1 arg2 ...?

其中的 func 定義了參數和 procedure 要執行的東西(procedure body),思考一下 Tcl 如何定義 procedure,就知道該怎麼做:

proc anonymous_function {food} {
    puts -nonewline "BoomBoom --- "
    puts $food}
}

所以

Cook "chicken" "coconut" {{food} {
    puts -nonewline "BoomBoom --- "
    puts $food
  }
}

2010-09-26

使用 tcom 取得 network adapter name list

proc getNetworkAdapter {} {

    package require tcom;

    if [catch {::tcom::ref getobject "winmgmts:root/CIMV2"} wmi] then {
     return -code error $wmi;
    }

    set wql {SELECT * FROM Win32_NetworkAdapter}


    if [catch {$wmi ExecQuery $wql} tmp] then {
        return -code error $tmp;
    }
    
    ::tcom::foreach instance $tmp {
        set propSet [$instance Properties_]
        set msgVal [[$propSet Item NetConnectionID] Value]
        
        if {[string equal $msgVal ::tcom::NULL] == 0} {                         
            lappend Result $msgVal
        }
    }     

    return $Result    
}

使用 tcom 透過 WMI 拿到 network adapter name 的 list。

參考資料:
Matthias Hoffmann - Tcl-Code-Snippets - tcom & wmi - Examples 

2010-09-17

ActiveTcl 8.5.9.0

ActiveTcl 8.5.9.0 已經在 ActiveState 的網站上可以下載了。


Tcl 8.5.9 的改變:

* TIP 359: new X11 option: [wm attributes -type]
- stops inappropriate Compiz animation of Tk menu & combobox.

* TIP 360: modernize menus on X11.
* New widget [ttk::spinbox].

* [lappend arr(elem)] no longer fires read traces as it inconsistently
has in some situations, but not in others.
*** POTENTIAL INCOMPATIBILITY ***

* [tk_getOpenFile] on Windows: unlimited multiple-file selection.

* [load] uses LOAD_WITH_ALTERED_SEARCH_PATH for fewer surprises when
bringing in DLLs via dependencies on Windows.
*** POTENTIAL INCOMPATIBILITY ***

* Updated [send] security rules to current Ubuntu/Fedora conventions.
* Fixed [wm iconphoto] on LP64 unix systems.
* [chan copy] of more than 2**31 bytes is now possible.
* min() and max() functions now work in safe interps.
* [$menu delete $tooBig end] now properly a no-op.
* canvas items now properly updated when canvas state changes.
* Revised [ttk::sizegrip] to accommodate Compiz.

* Revised default Text bindings for and to account;
for insertion point relationship to the selection.

* Corrected result of [tcl::mathfunc::abs 0.0].
* New version 1.432 of msgcat package.
* New version 1.0.9 of platform package.
* New version 0.8.6 of tile package.
* Changes to support building with MSVC++ 2010.
* Prevent race condition in some XIM implementations.
* Fixed bad results from [file rootname].
* Prevent consumption of all memory when [chan copy] copies to slow channel.
* [wm transient] now works even with withdrawn windows.
* $DISPLAY can now contain "::".
* Restored compatibility of [entry] validation with Itcl variable scope.
* Fixed line-sensitive matching by [regexp].
* Fixed memory corruption in complex canvas tag searches.
* Fixed crash in encoding finalization.
* Fixed crashes in widget destruction.
* Fixed crash in GetFontFamilyName().
* Fixed crash in menu deletion.
* Fixed crash in peer text dump.
* Fixed crash when bind scripts are empty.
* Fixed crash in unset traces during [array unset].
* Fixed crash deleting vars during callframe pop.
* Fixed crash in [open |noSuchFile rb].
* Fixed crash in [chan postevent].
* Fixed programming error in [clock format] in he_IL locale.
* Safe Base and Safe Tk rewrites

下載地點:
Download ActiveTcl Community Edition

2010-06-22

下載中央銀行貨幣總計數M2年增率資料

#!c:/tcl/bin/tclsh86.exe
########################################################################
# 下載中央銀行貨幣總計數M2年增率資料 
########################################################################

package require http

set url "http://www.cbc.gov.tw/np.asp?ctNode=643&mp=1"
set token [http::geturl $url -validate 1]

# create an easy-to-use array variable
upvar #0 $token head

set location "http://www.cbc.gov.tw/"
append location [dict get $head(meta) Location]

puts "### Get file: $location"
http::cleanup $token

set filename "cbc_m1b.xls"

set f [open $filename {WRONLY CREAT EXCL}]
set token [http::geturl $location -channel $f]
http::cleanup $token
close $f

exit

中央銀行貨幣總計數M2年增率資料在首頁就有,只是不是採用直接連結的方式,而是要從 head 裡取得檔案的下載位址,再從下載位址下載。在查過 Tcler's Wiki 該怎麼處理以後,我稍微改寫一下,目前可以正確的從網站下載我需要的資料。

如果中央銀行讓使用者下載資料的位址是固定的,那麼這段 code 就可以一直用下去,如果位址不固定的話,那就要想一下該怎麼做才對。

2010-06-03

下載台灣證券交易所的市值週報

#!c:/tcl/bin/tclsh86.exe
package require http
package require vfs::zip

########################################################################
# Download zip file
########################################################################
set remoteFile "http://www.twse.com.tw/ch/statistics/download/week.zip"
set localFile "week.zip"

set token [::http::geturl $remoteFile -binary 1]
set data [::http::data $token]

set channel [open $localFile w+]
fconfigure $channel -encoding binary -translation binary
puts -nonewline $channel $data
close $channel

::http::cleanup $token

########################################################################
# Now handle zip file
########################################################################
set mnt_file [vfs::zip::Mount $localFile $localFile]
file copy -force [glob $localFile/*] ./
vfs::zip::Unmount $mnt_file $localFile
file delete $localFile

exit

和之前寫的東西很像,使用 http 套件下載檔案,然後使用 vfs::zip 來解 zip 檔。要取得台灣證券交易所的市值週報資料的原因是因為我看到一篇 GDP 與市場大盤的文章,所以想要自己算看看目前的情況。

因為有可能會長期並且以季為單位的進行觀測,所以寫了這個 script,讓自己不用開瀏覽器就拿到資料,應該可以節省一些時間。

2010-05-22

ActiveTcl 8.6.0.0 beta-3

我很高興的發現 ActiveTcl 8.6 釋出了新的測試版本(beta-3),這個測試版本主要更新:將 code base 更新為 8.6b1.2 Tcl core。

Note: This release should not be deployed in a production environment.

Download ActiveTcl Community Edition

2010-04-14

Threading Support: Configuration and Package

TIP #364: Threading Support: Configuration and Package


在 [incr Tcl] , TDBC 之後,Thread package 也成為內建的 contributed package,因此 Thread package 也會成為 8.6 的一員。

節錄會有影響的地方:

This will have no effect on Windows and OSX, where threaded configurations are default anyway, but will have an impact on other Unixes (Linux, Solaris, etc.)

The main issues arising from this relate to the Expect and TclX packages. This is because they make fork and signal commands available; these APIs are troublesome because of how they interact with Tcl's notifier and the POSIX Thread system in general.

2010-01-29

使用 EXIF 的時間資料來改檔案名稱

第一版的 script 已經 OK 了,不過考慮到如果有多過於一天的照片,這樣好像還是有點麻煩,所以改寫變成為讀取 EXIF 的資料以後,再用檔案內的日期資料來改檔名。

Tcllib 有提供 jpeg 和 exif 二個套件可以使用,因為 jpeg 有提供範例,所以最後使用 jpeg 套件來實作:
#!/usr/bin/tclsh
#
# Rename script
#
# argument 1: folder location (option)
#

package require jpeg

puts "########## Start ##########"

if {$argc >= 1} {
cd [lindex $argv 0]
} elseif {$argc == 0} {
cd "c:/tmp"
}

foreach filename [glob *.jpg] {
array set exif [::jpeg::getExif $filename]
set today [clock format [clock scan $exif(DateTimeOriginal) \
-format {%Y:%m:%d %H:%M:%S}] -format %Y%m%d]

regsub -all {\mIMG} $filename $today newFileName

file rename $filename $newFileName
}

puts "########## End ##########"

exit

相關資訊:
Wiki:Exchangeable image file format

Exchangeable image file format (Exif) is a specification for the image file format used by digital cameras. The specification uses the existing JPEG, TIFF Rev. 6.0, and RIFF WAV file formats, with the addition of specific metadata tags. It is not supported in JPEG 2000, PNG, or GIF.

2010-01-16

File rename

#!/usr/bin/tclsh
#
# Rename script
#

puts "########## Start ##########"

if {$argc >= 1} {
cd [lindex $argv 0]
} elseif {$argc == 0} {
cd "c:/tmp"
}

set today [clock format [clock seconds] -format %Y%m%d]

foreach filename [glob *.jpg] {
regsub -all {\mIMG} $filename $today newFileName

file rename $filename $newFileName
}

puts "########## End ##########"

exit
會寫這個 script,是因為我的數位相機照完相以後,會是 IMG_0001.JPG, IMG_0002.JPG 這樣編號,而我習慣用日期來整理,所以要把檔名改為 20100116_0001.JPG 這種形式,而自己手動改有點浪費時間,所以寫一個改檔名的 script 來做這件事情。

使用了 glob 來列出所有 *.JPG 的檔案,再來把檔名前半部的 IMG 換成今天的日期,最後改檔名,應該就完成任務了。