DouKaku? Language detail: Tcl

Tcl8.5の場合は、 clock millisecondsが使える。 clock microsecondsも使える。

Tcl8.4の場合は、最近のActiveTclにバックポートとして入っているnewclock拡張を使う。

set pit [clock milliseconds]
set sec [clock format [string range $pit 0 9] -format %Y%m%d%H%M%S]]
set msec [string range $pit 10 end]
puts $sec.$msec

クリップボードへの転送 (Nested Flatten)

Tkのclipboardコマンドで実現できます。

see: clipboard manual page - Tk Built-In Commands

package require Tk
clipboard clear
clipboard append "テキスト"; # 転送
clipboard get; # 取得
#=> テキスト

自分自身のファイル名を知る方法 (Nested Flatten)

1	puts [file dirname [info script]]

Hello, world! PDF版 (Nested Flatten)

Tk キャンバスの内容を PDF に出力する Trampoline! というライブラリを使用してみました。

see: Trampoline!

package require trampoline

. configure -menu [menu .menu]
.menu add command -label {Save as PDF} -command {::pdf::generate .c hello.pdf}

pack [canvas .c -width 297 -height 210  -bg white]
.c create text 150 105 -text "Hello,\nWorld!" -font {Helvetica 70} -justify center

ウィンドウの表示 (Nested Flatten)

wish でなく tclsh から実行するときは package require Tk を冒頭につけます。

set w 400
set h 300
set x [expr ([winfo screenwidth .] - $w) / 2]
set y [expr ([winfo screenheight .] - $h) / 2]
wm geometry . ${w}x$h+$x+$y
wm title . こんにちは、GUI！

ローカル変数の一覧を取得 (Nested Flatten)

Tcl にも info locals というずばりなコマンドがありますが Python と違って返されるのは名前のリストのみなので記述量は若干増えます。

proc foo {} {
  set x 1
  set y hello

  set locals [info locals]
  set result {}
  foreach k $locals { lappend result $k [set $k] }
  return $result
}

# % foo
# x 1 y hello

Tiny MML (Nested Flatten)

Snack という Tcl/Python 向けの音声ライブラリを使用しました。Snack は ActiveTcl のディストリビューションにも含まれています。

package require snack

set C     262
set dur   4000
set beat  5000
set amp   30000
set score cdefedcrefgagfercrcrcrcrcdefedcr

set freq $C
foreach note {c _ d _ e f _ g _ a _ b} {
  set freq [expr {$freq * pow(2, 1. / 12.)}]
  set osc  [snack::filter generator $freq $amp 0.0 sine $dur]
  snack::sound $note
  $note filter $osc
  $note length $beat
}
snack::sound r; r length $beat

snack::sound snd
foreach note [split $score {}] {
  snd concatenate $note
}
snd play -blocking yes
# snd write kaeru.wav -fileformat WAV

メソッド名一覧の表示 (Nested Flatten)

呼び出すって実行するところまでだと気づいたので修正。引数はなしで。

1	foreach cmd [info commands target::test_*] { $cmd }

1	info commands target::test_*

アレイのuniq (Nested Flatten)

特にこれが一般的な Tcl 風スタイルというわけではありませんが tcllib の struct::list を使うと fold もできますという例です。

package require struct::list

proc lappend_uniq {l e} {
  if {[lsearch $l $e] == -1} {lappend l $e}
  set l
}

proc uniq {l} {
  ::struct::list fold $l {} lappend_uniq
}

# % uniq {3 1 4 1 5 9 2 6 5 3 5 8 9 7 9}
# 3 1 4 5 9 2 6 8 7

HTTPでGET (Nested Flatten)

Tcl 標準の http パッケージで。

1 2	package require http http::geturl http://ja.doukaku.org/feeds/comments/ -channel stdout

DouKaku?

Language detail: Tcl

Unsolved challenges

codes

Index

Feed

Other

Link

Pathtraq