foto+ preview

wget 原意是 wretch get，為了擴大市場才逐漸加入支援其他相簿，現在無名都收了，那 wget 呢? 應該還是會繼續維護下去，反正一年才改版幾次，少看幾集風水世家就有了．突然想到之前停滯的 fotoplus 計劃，原來草都長這麼高了... 當兵時偷閒開發 wget 3，主要著重在操作界面上，希望能有個夠現代化的界面，花了不少時間得到的改進卻很有限，加上最近都在 osx 上工作，用 tcl/tk 實在是沒辦法寫出可以看的程式，最後也把 wget 3 抬去埋了...看看這是 tk 在 osx 下的極限．
最近因為研究需要去看了 node.js，不小心喵到 node webkit，這和我幾年前混搭的大鍋菜蠻類似的，於是花了點時間研究，還好退伍後腦袋恢復得不錯，春節期間試著寫了些程式片段後實在是太爽快了，以後又多了個工具可以拿來討生活啦．為了多練習打算把 foto+ 砍掉重練，雖然用 node webkit 還是有些缺點，但我注重的是開發時間，能快速完成工作賺到錢才是最重要的，管他程式很大或是執行很慢． 這是用 node webkit + bootstrap 在 osx 下花一晚時間牛刀小試的畫面，想不到連我這沒美工能力的工程師都可以輕易做到這樣．
最後還是要說，因為退伍後少了國家養我經濟壓力大，所以正式版釋出日期也是沒有極限...此外歡迎懂 html + css 的美工高手來幫忙設計開發．

目前已完成部分 (2014-02-11)

• 基本操作界面
• pixnet 列出相簿，抓縮圖快取

其他心得

• 改成 node webkit 後執行起來其實也沒多慢，只有開啟程式時慢個幾秒，但是在抓相簿資訊時可以一次發幾十個 ajax request，這部分就比原本 tcl/tk 快不少．
• 非同步寫法還不是很習慣，總會覺得會有哪裡會沒考慮到而出問題的不踏實感，可能過陣子上手後就好了吧．
• 打包後的執行檔很大 (37mb)，不過現在網路很快硬碟很大．應該不太需要考慮這問題，不然就得想個適合的更新方式．

Tcl upload file using HTTP PUT method

Tcl 要透過 HTTP PUT 上傳檔案可用 http 或 TclCurl，不過兩種方法送出的 header 與 body 有些不同，server 端自己寫的話要由 Content-Type 判斷 body 中資料段位置。

使用 Tcl http

package require http
set fd [open test.zip r]
set hd [::http::geturl "http://ios1.dslab.org/" -method PUT -binary 1 -querychannel $fd]
close $fd

User-Agent: Mozilla/5.0 (Windows; U; Windows NT 6.1) http/2.8.4 Tcl/8.6b3 
Accept-Encoding: deflate,gzip,compress 
Content-Type: application/x-www-form-urlencoded
Content-Length: 5538104 

使用 TclCurl

package require TclCurl
::curl::transfer -url "http://ios1.dslab.org/" -upload 1 -infile test.zip

Accept: */* 
Transfer-Encoding: chunked 
Expect: 100-continue

使用 Chrome Advanced REST client PUT 時的 header

User-Agent: Mozilla/5.0 (Windows NT 6.1; WOW64) AppleWebKit/537.31 (KHTML, like Gecko) Chrome/26.0.1410.64 Safari/537.31
Origin: chrome-extension://hgmloofddffdnphfgcellkdfbfbjeloo
Content-Type: multipart/form-data; boundary=----WebKitFormBoundaryvyHNXY3tzkHaqqv2 
Accept: */*
Accept-Encoding: gzip,deflate,sdch
Accept-Language: zh-TW,zh;q=0.8,en-US;q=0.6,en;q=0.4
Accept-Charset: Big5,utf-8;q=0.7,*;q=0.3

Tcl TLS + Nginx SSL

使用 tcl http + tls 從 nginx 取得資料。根據之前的經驗

package require http
package require tls
http::register https 443 ::tls::socket
set tok [::http::geturl "https://192.168.72.77/index.html"]

結果出現錯誤...

error reading "sock580": software caused connection abort
SSL channel "sock580": error: tls invalid ecpointformat list

用 tls 試看看，出現相同的錯誤...

set sck [tls::socket 192.168.72.77 443]
tls::handshake $sck

看起來在 handshake 就掛了，google 不到相關資料。奇怪的是 http server 改成 apache 後就沒問題，害我一開始花不少時間研究 nginx 的 ssl 設定。最後的解決方法有：
1. tls enable tls1 

http::register https 443 [list ::tls::socket -tls1 1]
set tok [::http::geturl "https://192.168.72.77/index.html"]

2. 別用 tls 1.6.1 (怒)，另一台電腦上用的是 tls 1.6 就沒問題

Tcl exec run as administrator

有些需要管理者權限的命令無法用 exec 執行，例如設定 ip

% exec netsh interface ipv4 add address 10 192.168.0.222
要求的作業需要提高的權限 (以系統管理員身分執行)。
child process exited abnormally

使用 twapi 的 shell_execute 加上 -verb runas 解決

::twapi::shell_execute -path "c:/windows/system32/netsh.exe" -params "interface ipv4 delete address 10 192.168.0.222" -verb runas

用 TreeCtrl 做 notebook widget

和上一篇的 menu widget 一樣，因為 ttk::notebook 太醜，且 tab 那行不能再放其他的 widget，只好又自己用 TreeCtrl 打造。本來想說要做 tab 並不難，定義好 tab 的 element 和 style，每個 tab 當做一個 tree item 即可，不過我想要做的是像 FireFox 3.6 一樣的 tab，花了不少時間才搞定。

tab 的底線部分：selected 的 tab item 可以用 open s，其他的 tab item 就完整 outline，但是沒有 tab 的地方也要有底線。很不幸的是 tree widget 能夠設定 border，但和其他的 widget 一樣不能指定哪些方向要有 border。我想到的解法是用貼底圖的方式，先建立一個 1x1 的灰色圖形，用 -bgimage 指定，並設定 -bgimageanchor s -bgimagetile x，這樣就可以在 tree widget 的底部畫出一條線。

與 tab 同行的 widget：直覺得想法是放一個 item，其 style 是由 window element組成，但有個麻煩的地方是這個 item 寬度必須塞滿全部剩餘的空間。目前還不知道如何抓到 item 的寬度，只能每次 resize 時用 tree 寬度減掉固定寬度的 tab 算出來再更新 item 寬度，不過這太麻煩了不考慮。另一個想到的是在其中放一個超長字串的 text element 並設定成 -draw flase，靠這字串去把寬度撐開，有興趣的可以試看看可不可行。我最後採用的是用兩個 tree widget 來做，tree2 固定寬度，tree1 塞滿 x，目前看起來還沒什麼大問題。

用 TreeCtrl 做 menu widget

Tile 中沒有 menu，Tk 的 menu 又太"老氣"，只好自己打造了。左邊是 Tile menubutton + Tk menu，右邊是 Tile label + TreeCtrl。做法是建立一個 toplevel，裡面放 tree，然後 bind 一堆 event 追蹤... 有時間再寫成 package 用起來會比較方便。

以下是大概的 TreeCtrl code

$tree state define HOVER
$tree state define OPENW
$tree state define OPENE
       
$tree column create -tag cIcon
$tree column create -tag cName -expand 1
 
$tree element create elemIcon image -image [$ibox get favicon-wretch]
$tree element create elemName text  -justify left
$tree gradient create grdHover -steps 4 -stops {{0.0 white} {1.0 #ebf3fd}} -orient vertical    
$tree element create elemRect rect -fill [list  grdHover HOVER]  
$tree element create elemRectOutline rect -rx 1 -outline [list #b8d6fb HOVER] \
  -open [list w OPENW e OPENE]  -outlinewidth 1    
$tree element create elemBorder rect -outline "#e2e3e3" -open nws  -outlinewidth 1
$tree element create elemBorderS rect -outline "#ffffff" -open nws  -outlinewidth 1 

# column icon 
set sty [$tree style create styIcon -orient horizontal]
$tree style elements $sty {elemRect elemBorder elemBorderS elemRectOutline elemIcon}
$tree style layout $sty elemRect -detach 1 -padx {2 0}  -iexpand xy
$tree style layout $sty elemRectOutline -detach 1 -iexpand xy
$tree style layout $sty elemBorder -detach 1 -iexpand y -padx {27 0}
$tree style layout $sty elemBorderS -detach 1 -iexpand y -padx {28 0}
$tree style layout $sty elemIcon -padx {6 2} -pady {2 3} -iexpand ns

# column name
set sty [$tree style create styName]
$tree style elements $sty {elemRect elemRectOutline elemName}
$tree style layout $sty elemRect -detach yes -padx 0 -iexpand xy
$tree style layout $sty elemRectOutline -detach yes -iexpand xy
$tree style layout $sty elemName -padx 6 -pady {2 3} -squeeze x -expand ns

set nsList [list moko wretch pchome pixnet xuite yam]
foreach i $nsList  {
  set item [$tree item create -parent 0]
  $tree item style set $item 0 styIcon 1 styName
  $tree item element configure $item 0 elemIcon -image [$ibox get favicon-$i]
  $tree item element configure $item 1 elemName -text $i
}
  
$tree item state forcolumn all 0 "OPENE"
$tree item state forcolumn all 1 "OPENW"

目前還遇到一個難題，就是沒有辦法做出 menu 陰影效果。

Tcl 存取 Firefox 書籤

Firefox 關於網址的記錄都存放在 places.sqlite 中，此檔案為 sqlite3 資料庫，檔案位置

Linux
/home/<user>/.mozilla/firefox/<profile>/
Win XP
C:\Documents and Settings\<user>\Application Data\Mozilla\Firefox\Profiles\<profile>\
Vista / Win7
C:\Users\<user>\AppData\Roaming\Mozilla\Firefox\Profiles\<profile>\

其中的 <profile> 格式為 "亂數.default"，例如 dhyt3gd2.default，Schema 參考 The Places database。

以下範例是讀出書籤中 wretch 與 xuite 網址，將使用者 id 與網站類型語名稱存入 array 。(註: 當 Firefox 正在執行時會 lock db，須先將其複製到 temp 後再存取)

package require sqlite3

set dirList [glob -directory [file join $::env(home) AppData/Roaming/Mozilla/Firefox/Profiles] -type d *]
foreach dir $dirList {
  set fBookmark [file join $dir places.sqlite]
  if { [file exists $fBookmark]  == 0 } { unset fBookmark }
}

if [info exists fBookmark] {
  set fDb [file join $::env(home) .wget bookmarkFF.db]
  file copy -force $fBookmark $fDb
  array set bookmarkList ""

  db eval {SELECT url, moz_bookmarks.title FROM moz_places, moz_bookmarks \
                WHERE moz_places.id = moz_bookmarks.fk and \
                (url like '%www.wretch.cc%' or url like '%xuite.net%')} result {
    regexp {http://([\w.]+)} $result(url) -> host
    foreach t {wretch xuite} {
      if {[string first $t $host] != -1} {
        set type $t
        break
      }
    }
    set uid ""
    switch $type {
      wretch {
        regexp {http://[\w.]+/[\w]+/([\w]+)} $result(url) -> uid
      }
      xuite {
        regexp {http://[\w.]+/([\w.]+)} $result(url) -> uid
      }
      set bookmarkList($type,[string tolower $uid]) $result(title)
    } 
  }
}
db close

Tk fullscreen

方法一

wm overrideredirect . 1
wm geometry . [winfo screenwidth .]x[winfo screenheight .]+0+0
wm attributes . -topmost 1

方法二 (Tk 8.5)

wm attributes . -fullscreen 1 -topmost 1

最近寫的一個程式要透過 optcl 抓 ie 來全螢幕顯示網頁，進入全螢幕時隱藏 toolbar，跳離全螢幕後顯示 toolbar。因為在全螢幕下 tk 沒辦法抓到 ie 的 event，所以設計成全螢幕時將 toolbar 高度改為1，然後在上面 bind event。以下是簡單的範例，按下放大視窗按鈕會全螢幕，在最底下滑鼠左鍵點兩下會跳離全螢幕。(註: 因 wm protocol 中沒有視窗放大的 protocol，這裡採用 bind Configure event 並判斷視窗目前狀態是否為 zoomed 來偵測按下視窗放大按鈕的動作。)

package require optcl

optcl::new -window .fmeBrowser "http://www.google.com"
frame .fmeSub -bd 0 -relief groove -height 1 
pack .fmeBrowser -fill both -expand 1
pack .fmeSub -fill x 

bind .fmeSub <Double-1> {
  wm state . normal
}

bind . <Configure> {
  if { "%W" eq [winfo toplevel "%W"] &&  [wm state . ] eq "zoomed"} {
    wm attributes . -fullscreen 1 -topmost 1
  } else {
    wm attributes . -fullscreen 0 -topmost 0
  }
}

如果要塞滿多顆螢幕的時候會發現用方法二只能在一顆螢幕上全螢幕顯示，此時得先抓出全部的長寬再用 wm geometry 設定。以下是用 twapi 取得各螢幕的位置後再拿最右和最下的值當作長寬，如果事先已知道執行時螢幕的總長寬也可以寫成變數比較簡單。

package require twapi

foreach display [::twapi::get_multiple_display_monitor_info] {
  lappend listx [lindex [lindex $display 1] 2]
  lappend listy [lindex [lindex $display 1] 3]
}

wm overrideredirect . 1
wm geometry . [lindex [lsort $listx] end]x[lindex [lsort $listy] end]+0+0
wm attributes . -topmost 1

Tcl + Tk + html + css + javascript = ?

最近在寫一個需要漂亮 GUI 的應用程式，雖然說近年來 Tk 進步很多，但看起來還是很落伍 XD 像 wget 大概就是我目前用 Tk 能做到的極限了。過去一年都在寫 web 應用程式，用 html + css + js 可以輕鬆做出很多漂亮的操作介面，回到 Tk 後實在是很不習慣。前幾天突然想到乾脆用 html 來做 GUI 好了，寫了幾天後超快樂的，用 jquery 和一堆 plugin 就可以輕鬆就做出很現代的效果~

程式大概的架構是：

• 用 optcl 把 ie 丟到一個 tk frame 中，切換不同介面只需叫 ie 載入對應的 html 即可。
• 寫一個簡單的 httpd 丟到 thread 負責 ie 和 tcl 間的通訊。
• js 透過 httpd 的 get (我用 jquery 的 jsonp) 控制 tcl (執行 procedure、取得變數等)，tcl 透過 httpd 回傳 json 格式的結果。
• tcl 透過 optcl 取得與設定 js 中變數的值或執行 function。(還沒試)

當然這樣做的結果就是把程式間的關係搞得很複雜，寫的時候要在 html、js、tcl 間跳來跳去，不過我是覺得省下很多時間 (前提是要對 html、css、js 很熟)，像光是一個 cover flow 的效果，用 Tcl/Tk 根本不知道要怎樣才能做出來，但改用 html 後就有一堆現成的 flash 或 js 程式可直接拿來用。因為我才用這方式寫幾天，還沒整理出漂亮的架構和寫法，過段時間再放個範例上來。

Tcl 配合 Tor 取得不同 ip

可以用來做什麼就自己想像吧 XD

安裝 Vidilia，到 settings -> advanced 把 authentication 改成 none (也可以單獨跑 Tor，不過在 windows 上跑 vidilia 方便就直接用了)。Tor 跑起來後要用 Tcl 控制可以透過 control port (預設 9051)，詳細內容在 Tor control protocol specification，應用可參考 Tor Control Commands 這篇文章。

以下是透過 Tor 取得不同 ip，若拿到的 ip 已經用過則再建立新 circuit。

proc get_ip {oip} {
  variable ipList
  variable sck
  set tok [http::geturl "http://whatismyip.org/" -timeout 10000 -headers [list Pragma no-cache]]
  set nip [http::data $tok]
  http::cleanup $tok
  while { $oip == $nip || $nip == "" || [string length $nip] > 15 || [lsearch $ipList $nip] != -1 } {
    set tok [http::geturl "http://whatismyip.org/" -timeout 10000 -headers [list Pragma no-cache]]
    set nip [http::data $tok]
    http::cleanup $tok            
    if { [lsearch $ipList $nip] != -1 } {
      set nip $oip
      puts $sck "signal newnym"
      after 5000
     }
  }
  lappend ipList $nip
  return $nip
}

http::config -proxyhost 127.0.0.1 -proxyport 8118
#connect to tor control port
set sck [socket 127.0.0.1 9051]
fconfigure $sck -buffering none -blocking 0 -encoding binary -translation crlf -eofchar {}
puts $sck {authenticate ""}

要更有效率可以先找出全部可用的 exit node 後再建立 two hop circuit，只是這樣得多很多很多行程式，這裡簡單的用 whatismyip.org 查看目前的 ip，若已用過再 signal newnym 要求 tor 建立一個新的 circuit。

Tcl 隨機產生身份證字號

平常都是用 javascript 或 php 檢查身分證號碼，想不到有一天會需要用到身分證號產生器 XD 規則網路上很多，用 tcl 寫也沒幾行。 

proc random_uid {sex} {
  set ret ""
  set wgt 0
  set cityList {A B C D E F G H J K L M N P Q R S T U V X Y W Z I O}
  set city [lpick $cityList]
  append ret $city
  set cityNum [expr [lsearch $cityList $city] + 10]
  set rndNum "$sex[expr {int(rand()*9000000+1000000)}]"
  append ret $rndNum
  set wgt [expr [expr [string index $cityNum 0] * 1] + [expr [string index $cityNum 1] * 9] ]
  set j 8
  for {set i 0} {$i<8} {incr i} {
    set wgt [expr $wgt + [expr [string index $rndNum $i ] * $j]]
    incr j -1
  }
  set chk [expr 10 - ($wgt % 10)]
  if {$chk == 10} {set chk 0}
  append ret $chk
  return $ret
}

TkTreeCtrl & shellicon

我幾乎每個程式都會用到 TkTreeCtrl，最常用來顯示條列式的 item，甚至還可以拿來做分頁功能的 tab。最近寫 ftp client 時想要顯示的 icon 和本機上的一樣，TkTreeCtrl 有提供 shellicon 的 package，可藉由建立 shellicon 的 element 和指定 path 來顯示檔案的 icon。

$tree element create elemImg shellicon -size small
$tree item element configure $item name elemImg -path $path

不過 ftp 的檔案在 server 上無法指定 path，所以我就先在本地端建立不同副檔名的檔案，要顯示時再依據副檔名將 path 指定到對應的檔案。在 windows 中有個 assoc 的指令可以列出目前所有副檔名，可由此資訊建立所需的檔案

C:\Documents and Settings\laby>assoc |more
.264x2pass+DvD=264x2pass+DvD_auto_file
.323=h323file
.386=vxdfile
.3g2=mplayerc.3g2
.3gp=mplayerc.3gp

在第一次啟動程式時先預先建立好對應的檔案即可

proc ::rc::create_mine_icon {mimeDir} {
   file mkdir $mimeDir
   close [open [file join $mimeDir mime.unknow] w]
   set assocList [exec cmd /c assoc]
   foreach line $assocList {
     set ext [lindex [split $line "="] 0]
     if { [string range $ext 0 0] eq "." } {
       catch {close [open [file join $mimeDir mime$ext] w]}
     }
   }
}

測試建立 840 個檔案只花了約 200ms。下圖上半為預設的 icon，下半為使用 shellicon 後的效果。