DouKaku?beta

Language detail: Tcl

Coverage: 7.11%
number of '+' ratings
 contribution for coverage

Unsolved challenges

show all

codes

Feed

Used modules

Hello, world! (Nested Flatten) 

	

	
	
	
    

      
1
puts "Hello, world!"




    

	

  
  





    
    


    

    
指定コマンドを別プロセスで起動
(Nested 
 Flatten)

    
    






  
  

	

	  
使い方は
tclsh popen.tcl ipconfig /all


余計な改行が入る理由が分からない。。。


	

	
	
	
    

      
1
2
3
4
5
6
7
8
9
# popen.tcl
if {[catch {open "|$argv"} ch]} {
    error $ch
} else {
    while {![eof $ch]} {
        gets $ch line
        puts -nonewline $line
    }
}




    

	

  
  





    
    


    

    
小町算
(Nested 
 Flatten)

    
    






  
  

	

	  
Tcl8.6b からcoroutine が導入されたので練習も兼ねて。


	

	
	
	
    

      
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
package require Tcl 8.6

proc A {} {
    foreach x {{{}} + - * /} { B [list $x] }
}

proc cat coro {
    while 1 {
        set input [yield]
        foreach x {{{}} + - * /} { $coro [concat $input $x] }
    }
}

coroutine B cat C
coroutine C cat D
coroutine D cat E
coroutine E cat F
coroutine F cat G
coroutine G cat H
coroutine H cat print

coroutine print apply {{} {
    while 1 {
        lassign [yield] a b c d e f g h
        set exp [join "1 $a 2 $b 3 $c 4 $d 5 $e 6 $f 7 $g 8 $h 9" {}]
        set num [expr [string map {/ *1.0/} $exp]]
        if {$num == 100.0} { puts "$exp = 100" }
    }
}}

puts [time A]




    

	

  
  





    
    


    

    
文字列の反転
(Nested 
 Flatten)

    
    






  
  

	

	  
8.4だとごく普通にやるしかないですが、8.5なら関数作る必要すらない。


	

	
	
	
    

      
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
# 8.4まで
proc reverse_string {str} {
  set rstr ""
  foreach s [split $str ""] {set rstr "$s$rstr"}
  return $rstr
}

# 8.5
proc reverse_string {str} {
  string reverse $str
}




    

	

  
  





    
    


    

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

    
    






  
  

	

	  
間違えました。


	

	
	
	
    

      
1
puts [file tail [info script]]




    

	

  
  





    
    


    

    
ミリ秒まで含んだ時刻文字列
(Nested 
 Flatten)

    
    






  
  

	

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


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


	

	
	
	
    

      
1
2
3
4
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
	
  
	
	
	
    

      
1
2
3
4
5
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!
	
  
	
	
	
    

      
1
2
3
4
5
6
7
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 を冒頭につけます。

	

	
	
	
    

      
1
2
3
4
5
6
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 と違って返されるのは名前のリストのみなので記述量は若干増えます。
	

	
	
	
    

      
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
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 のディストリビューションにも含まれています。
	

	
	
	
    

      
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
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 もできますという例です。
	

	
	
	
    

      
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
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




    

	

  
  





    
    



















Index





Feed










Other





Link




Pathtraq



loading...














Creative Commons License
このサイトの内容は、
クリエイティブ・コモンズ・ライセンスの下でライセンスされています。
[詳細]