dyama/256colors.tcl

## 256colors.tcl
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
#!/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"
	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
	}
	#!/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"