Tcl/Tkの勉強がてら、簡易マップエディターを書いてみました。マップデータは0から7までの色番号が並んだテキストファイル。16色カラー端末上で表示させる為のマップを想定しています。

256colors.tcl (Gist)

set color {
  #000000
  #cd0000
  #00cd00
  #cdcd00
  #0000ee
  #cd00cd
  #00cdcd
  #e5e5e5
  #7f7f7f
  #ff0000
  #00ff00
  #ffff00
  #5c5cff
  #ff00ff
  #00ffff
  #ffffff
  #000000
  #00005f
  #000087
  #0000af
  #0000d7
  #0000ff
  #005f00
  #005f5f
  #005f87
  #005faf
  #005fd7
  #005fff
  #008700
  #00875f
  #008787
  #0087af
  #0087d7
  #0087ff
  #00af00
  #00af5f
  #00af87
  #00afaf
  #00afd7
  #00afff
  #00d700
  #00d75f
  #00d787
  #00d7af
  #00d7d7
  #00d7ff
  #00ff00
  #00ff5f
  #00ff87
  #00ffaf
  #00ffd7
  #00ffff
  #5f0000
  #5f005f
  #5f0087
  #5f00af
  #5f00d7
  #5f00ff
  #5f5f00
  #5f5f5f
  #5f5f87
  #5f5faf
  #5f5fd7
  #5f5fff
  #5f8700
  #5f875f
  #5f8787
  #5f87af
  #5f87d7
  #5f87ff
  #5faf00
  #5faf5f
  #5faf87
  #5fafaf
  #5fafd7
  #5fafff
  #5fd700
  #5fd75f
  #5fd787
  #5fd7af
  #5fd7d7
  #5fd7ff
  #5fff00
  #5fff5f
  #5fff87
  #5fffaf
  #5fffd7
  #5fffff
  #870000
  #87005f
  #870087
  #8700af
  #8700d7
  #8700ff
  #875f00
  #875f5f
  #875f87
  #875faf
  #875fd7
  #875fff
  #878700
  #87875f
  #878787
  #8787af
  #8787d7
  #8787ff
  #87af00
  #87af5f
  #87af87
  #87afaf
  #87afd7
  #87afff
  #87d700
  #87d75f
  #87d787
  #87d7af
  #87d7d7
  #87d7ff
  #87ff00
  #87ff5f
  #87ff87
  #87ffaf
  #87ffd7
  #87ffff
  #af0000
  #af005f
  #af0087
  #af00af
  #af00d7
  #af00ff
  #af5f00
  #af5f5f
  #af5f87
  #af5faf
  #af5fd7
  #af5fff
  #af8700
  #af875f
  #af8787
  #af87af
  #af87d7
  #af87ff
  #afaf00
  #afaf5f
  #afaf87
  #afafaf
  #afafd7
  #afafff
  #afd700
  #afd75f
  #afd787
  #afd7af
  #afd7d7
  #afd7ff
  #afff00
  #afff5f
  #afff87
  #afffaf
  #afffd7
  #afffff
  #d70000
  #d7005f
  #d70087
  #d700af
  #d700d7
  #d700ff
  #d75f00
  #d75f5f
  #d75f87
  #d75faf
  #d75fd7
  #d75fff
  #d78700
  #d7875f
  #d78787
  #d787af
  #d787d7
  #d787ff
  #d7af00
  #d7af5f
  #d7af87
  #d7afaf
  #d7afd7
  #d7afff
  #d7d700
  #d7d75f
  #d7d787
  #d7d7af
  #d7d7d7
  #d7d7ff
  #d7ff00
  #d7ff5f
  #d7ff87
  #d7ffaf
  #d7ffd7
  #d7ffff
  #ff0000
  #ff005f
  #ff0087
  #ff00af
  #ff00d7
  #ff00ff
  #ff5f00
  #ff5f5f
  #ff5f87
  #ff5faf
  #ff5fd7
  #ff5fff
  #ff8700
  #ff875f
  #ff8787
  #ff87af
  #ff87d7
  #ff87ff
  #ffaf00
  #ffaf5f
  #ffaf87
  #ffafaf
  #ffafd7
  #ffafff
  #ffd700
  #ffd75f
  #ffd787
  #ffd7af
  #ffd7d7
  #ffd7ff
  #ffff00
  #ffff5f
  #ffff87
  #ffffaf
  #ffffd7
  #ffffff
  #080808
  #121212
  #1c1c1c
  #262626
  #303030
  #3a3a3a
  #444444
  #4e4e4e
  #585858
  #626262
  #6c6c6c
  #767676
  #808080
  #8a8a8a
  #949494
  #9e9e9e
  #a8a8a8
  #b2b2b2
  #bcbcbc
  #c6c6c6
  #d0d0d0
  #dadada
  #e4e4e4
  #eeeeee
}

canvas.tcl (Gist)

#!/usr/bin/env wish

source 256colors.tcl

set color_grid   #333333
set color_draw   red
set color_erase  black

set sx 80   ; # 横サイズ
set sy 25   ; # 縦サイズ
set cx 5    ; # チップ横サイズ
set cy 10   ; # チップ縦サイズ
set cs 1    ; # チップサイズ倍率
set ox $cx  ; # オフセットX
set oy $cy  ; # オフセットY

set filepath "" ; #

proc num2color {num} {
  switch $num {
    0 {return #000000}
    1 {return #FF0000}
    2 {return #00FF00}
    3 {return #FFFF00}
    4 {return #0000FF}
    5 {return #FF00FF}
    6 {return #00FFFF}
    7 {return #FFFFFF}
  }
}

# ドローイベント
proc draw {key x y} {
  global c sx sy cx cy ox oy cs color_draw color_erase
  if {$x > [expr $sx * $cx * $cs] || $x < 0} {return 1}
  if {$y > [expr $sy * $cy * $cs] || $y < 0} {return 1}
  set x [expr round(($x - $ox) / ($cx * $cs))]
  set y [expr round(($y - $oy) / ($cy * $cs))]
  $c itemconfigure [expr $x + $y * $sx + 1] \
    -fill [expr $key?"$color_draw":"$color_erase"]
}

# Toggle show grid
set showGrid 1
proc toggleGrid { } {
  global c showGrid color_grid
  $c itemconfigure chip -outline [expr $showGrid?"":"$color_grid"]
  set showGrid [expr !$showGrid]
}

# マップを初期化
set enableMap 0
set c 0
proc initmap {sx sy} {
  global enableMap c cx cy ox oy
  if {$enableMap == 1} {
    set stat [tk_messageBox -type yesno -icon question \
      -message "現在のマップを破棄し、新規作成しますか？"]
    if {$stat eq "no"} {return 1}
    destroy $c ; # キャンバスを破棄
    set enableMap 0
  }

  set c [canvas .c -background black]
  pack $c -fill both -expand 1

  global color_grid cs filepath

  set fd [open a.ncmap]
  for {set y 0} {$y < $sy} {incr y} {
    set line [gets $fd]
    set ar [split $line {}]
    set i 0
    foreach x $ar {
      set a($i) $x
      incr i
    }
    set i 0
    for {set x 0} {$x < $sx} {incr x} {
      $c create rectangle \
        [expr $ox + $cx * $cs * $x] [expr $oy + $cy * $cs * $y] \
        [expr $ox + $cx * $cs * ($x + 1)] [expr $oy + $cy * $cs * ($y + 1)] \
        -fill [num2color $a($i)] -outline $color_grid
      incr i
    }
  }
  close $fd

  # チップそれぞれにイベントをバインドしたかったが、
  # 最後にバインドしたチップしか有効にならなかった為、
  # チップ全体にイベントをバインドし、イベント内で
  # 状態を変更すべきチップを算出させている。
  $c addtag chip all
  $c bind chip <ButtonPress-1>   {draw 1 %x %y}
  $c bind chip <Button1-Motion>  {draw 1 %x %y}
  $c bind chip <ButtonRelease-1> {draw 1 %x %y}
  $c bind chip <ButtonPress-3>   {draw 0 %x %y}
  $c bind chip <Button3-Motion>  {draw 0 %x %y}
  $c bind chip <ButtonRelease-3> {draw 0 %x %y}
  set enableMap 1
}

# マップデータをファイルに保存する
proc save { } {
  global enableMap c sx sy filepath
  if {$enableMap == 1} {
    if {[file exists $filepath] == 0} {
      set filepath [tk_getSaveFile]
      if {$filepath eq ""} {
        return 1
      }
    }
    set fd [open $filepath w]
    for {set y 0} {$y < $sy} {incr y} {
      for {set x 0} {$x < $sx} {incr x} {
        set item [expr $x + ($y * $sx) + 1]
        puts -nonewline $fd "[$c itemcget $item -fill],"
      }
      puts $fd ""
    }
    close $fd
  } else {
    tk_messageBox -type ok -icon warning -message "No map exists."
  }
}

# キーバインド設定
bind . <KeyPress-n> {initmap $sx $sy}
bind . <KeyPress-q> {exit}
bind . <KeyPress-s> {save}
bind . <KeyPress-g> {toggleGrid}

# メインメニュー設定
menu .mainmenu
  menu .mainmenu.files ; .mainmenu add cascade -label File -menu .mainmenu.files
    .mainmenu.files add command -label New  -accelerator "n" -command {initmap $sx $sy}
    .mainmenu.files add separator
    .mainmenu.files add command -label Open -accelerator "o" -command tk_getOpenFile
    .mainmenu.files add command -label Save -accelerator "s" -command tk_getSaveFile
    .mainmenu.files add separator
    .mainmenu.files add command -label Import\ NCMap -accelerator "i" -command tk_getOpenFile
    .mainmenu.files add separator
    .mainmenu.files add command -label Close -accelerator "q" -command exit
  menu .mainmenu.edit   ; .mainmenu add cascade -label Edit -menu .mainmenu.edit
    .mainmenu.edit add command -label Copy -accelerator "y" -command {}
    .mainmenu.edit add command -label Paste -accelerator "p" -command {}
    .mainmenu.edit add command -label Delete -accelerator "d" -command {}
    .mainmenu.edit add separator
    .mainmenu.edit add command -label Resize -accelerator "r" -command {}
  menu .mainmenu.view   ; .mainmenu add cascade -label View -menu .mainmenu.view
    .mainmenu.view add command -label Zoom\ in -accelerator "+" -command {}
    .mainmenu.view add command -label Zoom\ out -accelerator "-" -command {}
    .mainmenu.view add separator
    .mainmenu.view add command -label Show\ grid -accelerator "g" -command {}
  menu .mainmenu.option ; .mainmenu add cascade -label Option -menu .mainmenu.option
  menu .mainmenu.help   ; .mainmenu add cascade -label Help -menu .mainmenu.help
. configure -menu .mainmenu

wm geometry . "640x480"

実行結果

参考にしたサイト

  1. http://www.k5.dion.ne.jp/~minyu/script/tcltk.html
  2. http://homepage3.nifty.com/kaku-chan/tcl_tk/index.html
  3. 入門 tcl/tk 久野靖著・アスキー出版局