Latest comments for language 'Tcl' on doukaku.org

yyamasak's comment on ミリ秒まで含んだ時刻文字列

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

[ Tcl ] [ download code ] ]

匿名's comment on クリップボードへの転送

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

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

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

[ Tcl ] [ download code ] ]

yyamasak's comment on 自分自身のファイル名を知る方法

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

1	puts [file dirname [info script]]

[ Tcl ] [ download code ] ]

ether's comment on Hello, world! PDF版

Hello, world! PDF版 (Nested Flatten)

Tk キャンバスの内容を PDF に出力する 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

[ Tcl ] [ download code ] ]

ether's comment on ウィンドウの表示

ウィンドウの表示 (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！

[ Tcl ] [ download code ] ]

ether's comment on ローカル変数の一覧を取得

ローカル変数の一覧を取得 (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

[ Tcl ] [ download code ] ]

ether's comment on Tiny MML

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

[ Tcl ] [ download code ] ]

ether's comment on メソッド名一覧の表示

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

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

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

[ Tcl ] [ download code ] ]

ether's comment on メソッド名一覧の表示

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

1	info commands target::test_*

[ Tcl ] [ download code ] ]

ether's comment on アレイのuniq

アレイの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

[ Tcl ] [ download code ] ]

ether's comment on HTTPでGET

HTTPでGET (Nested Flatten)

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

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

[ Tcl ] [ download code ] ]