# - 日本語のコメントはEUCで書きました。
#   2バイト目が括弧の文字コードに偶然一致することを避けるためです。
#   この問題は本物のtclshでも同様です。
# - 改行文字はLFにしました。
#   P/ECEのファイル読み込みはCR+LF⇒LF変換を行わないからです。
#   動作上はCR+LFでも正常に動作します。
#-------------------------------------------------------------------------------
#乱数モジュールをロードする。
catch {load tclrnd}				;#tclwin.exe,又は,P/ECEならば失敗するが､無視する｡
#乱数を初期化する。
srand
#ログコマンドを登録する。
if {$tcl_platform(platform) != "piece"} then {	;#P/ECEならばC関数として登録済み
	proc log {s} {
		puts stderr $s
	}
}
#-------------------------------------------------------------------------------
#グローバル変数を定義する。
set MAP_COLS 9		;#マップの列数		定数
set MAP_ROWS 7		;#マップの行数		定数
set SHIP_NUM 4		;#宇宙船の数		定数
set nShipFound 0	;#発見した宇宙船の数	変数
#この関数を呼び出した関数の変数テーブルに、グローバル変数への参照を登録する。
#各関数の先頭で呼び出してください。
proc setGlobal {} {
	uplevel 1 {
		global tcl_version	;#Tcl変数
		global tcl_platform	;#Tcl変数
		global MAP_COLS		;#マップの列数
		global MAP_ROWS		;#マップの行数
		global SHIP_NUM		;#宇宙船の数
		global nShipFound	;#発見した宇宙船の数
		global ship		;#宇宙船の属性(x,y)
		global field		;#フィールド
		global fieldMark	;#フィールドマーク
		global axisCache0	;#軸キャッシュ(発見していない宇宙船も含む)
		global axisCache1	;#軸キャッシュ(発見した宇宙船のみ)
		global shipCache	;#宇宙船キャッシュ
	}
}
#-------------------------------------------------------------------------------
#フラグの1の数を返す。
proc popcount {f} {
	set n 0
	while {$f} {
		if {$f & 1} then {incr n}
		set f [expr {$f >> 1}]
	}
	return $n
}
#-------------------------------------------------------------------------------
#宇宙船の属性を取得する。
proc getShipX {i} {
	setGlobal
	#宇宙船の属性を取得する。
	return [dict get $ship($i) x]
}
proc getShipY {i} {
	setGlobal
	#宇宙船の属性を取得する。
	return [dict get $ship($i) y]
}
#-------------------------------------------------------------------------------
#宇宙船の属性を設定する。
proc setShipX {i x} {
	setGlobal
	#宇宙船の属性を設定する。
	dict set ship($i) x $x
}
proc setShipY {i y} {
	setGlobal
	#宇宙船の属性を設定する。
	dict set ship($i) y $y
}
#-------------------------------------------------------------------------------
#フィールドを取得する。
proc getField {x y} {
	setGlobal
	#フィールドを取得する。
	return [lindex $field $y $x]
}
#-------------------------------------------------------------------------------
#フィールドを設定する。
proc setField {x y c} {
	setGlobal
	#フィールドを設定する。
	lset field $y $x $c
}
#-------------------------------------------------------------------------------
#フィールドマークを取得する。
proc getFieldMark {x y} {
	setGlobal
	#フィールドマークを取得する。
	return [lindex $fieldMark $y $x]
}
#-------------------------------------------------------------------------------
#フィールドマークを設定する。
proc setFieldMark {x y c} {
	setGlobal
	#フィールドマークを設定する。
	lset fieldMark $y $x $c
}
#-------------------------------------------------------------------------------
#軸キャッシュ(発見していない宇宙船も含む)を取得する。
proc getAxisCache0 {x y} {
	setGlobal
	#軸キャッシュ(発見していない宇宙船も含む)を取得する。
	return [lindex $axisCache0 $y $x]
}
#-------------------------------------------------------------------------------
#軸キャッシュ(発見していない宇宙船も含む)を設定する。
proc setAxisCache0 {x y c} {
	setGlobal
	#軸キャッシュ(発見していない宇宙船も含む)を設定する。
	lset axisCache0 $y $x $c
}
#-------------------------------------------------------------------------------
#軸キャッシュ(発見した宇宙船のみ)を取得する。
proc getAxisCache1 {x y} {
	setGlobal
	#軸キャッシュ(発見した宇宙船のみ)を取得する。
	return [lindex $axisCache1 $y $x]
}
#-------------------------------------------------------------------------------
#軸キャッシュ(発見した宇宙船のみ)を設定する。
proc setAxisCache1 {x y c} {
	setGlobal
	#軸キャッシュ(発見した宇宙船のみ)を設定する。
	lset axisCache1 $y $x $c
}
#-------------------------------------------------------------------------------
#宇宙船キャッシュを取得する。
proc getShipCache {x y} {
	setGlobal
	#宇宙船キャッシュを取得する。
	return [lindex $shipCache $y $x]
}
#-------------------------------------------------------------------------------
#宇宙船キャッシュを設定する。
proc setShipCache {x y c} {
	setGlobal
	#宇宙船キャッシュを設定する。
	lset shipCache $y $x $c
}
#-------------------------------------------------------------------------------
#宇宙船の座標を初期化する。
proc initShip {} {
	setGlobal
	#宇宙船の属性を初期化する。
	#shipExistがエラーにならないように、ダミーの座標を入れておく。
	for {set iShip 0} {$iShip < $SHIP_NUM} {incr iShip} {
		setShipX $iShip -1
		setShipY $iShip -1
	}
	#各宇宙船について…
	set iShip 0
	while {$iShip < $SHIP_NUM} {
		log "INITIALIZING SHIP $iShip"
		while {1} {
			#宇宙船の座標をランダムで生成する。
			set x [expr {[rand] % $MAP_COLS}]
			set y [expr {[rand] % $MAP_ROWS}]
			#この座標に宇宙船が無ければ抜ける。
			if {[shipExist $x $y] == -1} then {break}
		}
		#宇宙船の座標を格納する。
		setShipX $iShip $x
		setShipY $iShip $y
		#宇宙船の数を増やす。
		incr iShip
	}
}
#-------------------------------------------------------------------------------
#この座標に有る宇宙船のインデクスを返す。
#この座標に宇宙船が無ければ、-1を返す。
proc shipExist {x1 y1} {
	setGlobal
	#各宇宙船について…
	for {set iShip 0} {$iShip < $SHIP_NUM} {incr iShip} {
		#宇宙船の座標を取得する。
		set x2 [getShipX $iShip]
		set y2 [getShipY $iShip]
		#この座標と宇宙船の座標が同じならば…
		if {($x1 == $x2) && ($y1 == $y2)} then {
			#この座標に有る宇宙船のインデクスを返す。
			return $iShip
		}
	}
	#この座標に宇宙船が無ければ、-1を返す。
	return -1
}
#-------------------------------------------------------------------------------
#フィールドを初期化する。
proc initField {} {
	setGlobal
	log "INITIALIZING FIELD"
	#フィールドを初期化する。
	set field [lrepeat $MAP_ROWS [lrepeat $MAP_COLS "."]]
	#フィールドマークを初期化する。
	set fieldMark [lrepeat $MAP_ROWS [lrepeat $MAP_COLS "0"]]
}
#-------------------------------------------------------------------------------
#軸キャッシュ(発見していない宇宙船も含む)を初期化する。
proc initAxisCache0 {} {
	setGlobal
	log "INITIALIZING AXISCACHE 0"
	#軸キャッシュ(発見していない宇宙船も含む)を初期化する。
	set axisCache0 [lrepeat $MAP_ROWS [lrepeat $MAP_COLS "0"]]
	#全ての座標について…
	for {set x2 0} {$x2 < $MAP_COLS} {incr x2} {
		for {set y2 0} {$y2 < $MAP_ROWS} {incr y2} {
			set fAxis [getAxisCache0 $x2 $y2]
			#各宇宙船について…
			for {set iShip 0} {$iShip < $SHIP_NUM} {incr iShip} {
				#宇宙船の座標を取得する。
				set x1 [getShipX $iShip]
				set y1 [getShipY $iShip]
				#この座標と宇宙船の座標の差を求める。
				set dx [expr {$x1 - $x2}]
				set dy [expr {$y1 - $y2}]
				#各軸上に宇宙船が有ったら、1をセットする。
				if {$dx ==    0} then {set fAxis [expr {$fAxis | 1}]}	;#縦
				if {$dx ==  $dy} then {set fAxis [expr {$fAxis | 2}]}	;#昇斜
				if {$dy ==    0} then {set fAxis [expr {$fAxis | 4}]}	;#横
				if {$dx == -$dy} then {set fAxis [expr {$fAxis | 8}]}	;#降斜
			}
			setAxisCache0 $x2 $y2 $fAxis
		}
	}
}
#-------------------------------------------------------------------------------
#軸キャッシュ(発見した宇宙船のみ)を初期化する。
proc initAxisCache1 {} {
	setGlobal
	log "INITIALIZING AXISCACHE 1"
	#軸キャッシュ(発見した宇宙船のみ)を初期化する。
	set axisCache1 [lrepeat $MAP_ROWS [lrepeat $MAP_COLS "0"]]
}
#-------------------------------------------------------------------------------
#宇宙船キャッシュを初期化する。
proc initShipCache {} {
	setGlobal
	log "INITIALIZING SHIPCACHE"
	#宇宙船キャッシュを初期化する。
	set shipCache [lrepeat $MAP_ROWS [lrepeat $MAP_COLS "0"]]
}
#-------------------------------------------------------------------------------
#フィールドを表示する。
proc printField {} {
	setGlobal
	#列ヘッダ
	puts -nonewline " "
	for {set x 0} {$x < $MAP_COLS} {incr x} {
		set c [format {%c} [expr 0x31 + $x]]
		puts -nonewline " $c"
	}
	puts ""
	#行ヘッダ
	for {set y [expr {$MAP_ROWS - 1}]} {$y >= 0} {incr y -1} {
		set c [format {%c} [expr 0x41 + $y]]
		puts -nonewline "$c"
		#フィールド
		for {set x 0} {$x < $MAP_COLS} {incr x} {
			set c [getField $x $y]
			puts -nonewline " $c"
		}
		puts ""
	}
}
#-------------------------------------------------------------------------------
#サーチする座標を入力する。
proc getSearchPos {} {
	setGlobal
	while {1} {
		if {$tcl_platform(platform) != "piece"} then {	;#P/ECEでは標準入出力に対するfeofがエラーになる。
			if {[eof stdin]} then {exit}
		}
		#プロンプトを表示する。
		puts -nonewline {[A-G][1-9]? }
		flush stdout
		#一行入力する。
		set s [gets stdin]
		set s [string toupper $s]
		#行[A-G]と列[1-9]を取得する。
		if {[scan $s { %c %c } y x] != 2} then {continue}
		#行を0ベースに変換する。
		set y [expr {$y - 0x41}]
		if {($y < 0) || ($y > $MAP_ROWS-1)} then {continue}
		#列を0ベースに変換する。
		set x [expr {$x - 0x31}]
		if {($x < 0) || ($x > $MAP_COLS-1)} then {continue}
		#列と行を返す。
		return [list $x $y]
	}
}
#-------------------------------------------------------------------------------
#軸キャッシュ(発見した宇宙船のみ)を更新する。
proc updateAxisCache1 {x1 y1} {
	setGlobal
	#全ての座標について…
	for {set x2 0} {$x2 < $MAP_COLS} {incr x2} {
		for {set y2 0} {$y2 < $MAP_ROWS} {incr y2} {
			set fAxis [getAxisCache1 $x2 $y2]
			#この座標と宇宙船の座標の差を求める。
			set dx [expr {$x1 - $x2}]
			set dy [expr {$y1 - $y2}]
			#各軸上に宇宙船が有ったら、1をセットする。
			if {$dx ==    0} then {set fAxis [expr {$fAxis | 1}]}		;#縦
			if {$dx ==  $dy} then {set fAxis [expr {$fAxis | 2}]}		;#昇斜
			if {$dy ==    0} then {set fAxis [expr {$fAxis | 4}]}		;#横
			if {$dx == -$dy} then {set fAxis [expr {$fAxis | 8}]}		;#降斜
			setAxisCache1 $x2 $y2 $fAxis
		}
	}
}
#-------------------------------------------------------------------------------
#宇宙船キャッシュを更新する。
proc updateShipCache {x1 y1} {
	setGlobal
	#全ての座標について…
	for {set x2 0} {$x2 < $MAP_COLS} {incr x2} {
		for {set y2 0} {$y2 < $MAP_ROWS} {incr y2} {
			#この座標と宇宙船の座標の差を求める。
			set dx [expr {$x1 - $x2}]
			set dy [expr {$y1 - $y2}]
			#この座標の軸上に無い宇宙船ならば、宇宙船キャッシュを+1する。
			if {($dx !=    0) &&
			    ($dx !=  $dy) &&
			    ($dy !=    0) &&
			    ($dx != -$dy)} then {
				set nShip [getShipCache $x2 $y2]
				setShipCache $x2 $y2 [incr nShip]
			}
		}
	}
}
#-------------------------------------------------------------------------------
#フィールドを更新する。
proc updateField {} {
	setGlobal
	#全ての座標について…
	for {set x2 0} {$x2 < $MAP_COLS} {incr x2} {
		for {set y2 0} {$y2 < $MAP_ROWS} {incr y2} {
			#この座標がまだサーチされていなければ、何もしない。
			set c [getField $x2 $y2]
			if {![string is digit $c]} then {continue}
			#軸キャッシュ(発見した宇宙船のみ)を取得する。
			set fAxis1 [getAxisCache1 $x2 $y2]
			#軸キャッシュ(発見した宇宙船のみ)のフラグ数を取得する。
			set nAxis1 [popcount $fAxis1]
			#宇宙船キャッシュを取得する。
			set nShip [getShipCache $x2 $y2]
			#サーチ結果と宇宙船キャッシュの和が、宇宙船の数に一致するならば、この座標の任意の軸上以外に宇宙船は存在しない。
			if {($c + $nShip) == $SHIP_NUM} then {
				markField0 $x2 $y2
			}
			#サーチ結果が、軸キャッシュ(発見した宇宙船のみ)のフラグ数に一致するならば、サーチ結果以外の軸上に宇宙船は存在しない。	この条件で'0'の軸上の塗り潰しもできる。
			if {$c == $nAxis1} then {
				markField1 $x2 $y2 $fAxis1	;#サーチ結果以外の軸上を塗り潰す。
			}
		}
	}
}
#-------------------------------------------------------------------------------
#指定された座標の軸上以外を塗り潰す。
proc markField0 {x1 y1} {
	setGlobal
	#この座標を基点として既にmarkField0が実行されていたら、何もしない。	高速化のための判断です。この判断を行わなくても結果は同じになります。
	set fMark [getFieldMark $x1 $y1]
	if {$fMark & 1} then {return}
	set fMark [expr {$fMark | 1}]
	setFieldMark $x1 $y1 $fMark
	#全ての座標について…
	for {set x2 0} {$x2 < $MAP_COLS} {incr x2} {
		for {set y2 0} {$y2 < $MAP_ROWS} {incr y2} {
			#この座標が既にサーチ,又は,塗り潰されていたら、何もしない。
			set c [getField $x2 $y2]
			if {$c != "."} then {continue}
			#指定された座標の軸上以外ならば、この座標を塗り潰す。
			set dx [expr {$x1 - $x2}]
			set dy [expr {$y1 - $y2}]
			if {($dx !=    0) &&
			    ($dx !=  $dy) &&
			    ($dy !=    0) &&
			    ($dx != -$dy)} then {setField $x2 $y2 "x"}
		}
	}
}
#-------------------------------------------------------------------------------
#指定された座標の、指定された軸以外の軸上を塗り潰す。												この条件で'0'の軸上の塗り潰しもできる。
proc markField1 {x1 y1 fAxis1} {
	setGlobal
	#この座標を基点として既にmarkField1が実行されていたら、何もしない。	高速化のための判断です。この判断を行わなくても結果は同じになります。
	set fMark [getFieldMark $x1 $y1]
	if {$fMark & 2} then {return}
	set fMark [expr {$fMark | 2}]
	setFieldMark $x1 $y1 $fMark
	#全ての座標について…
	for {set x2 0} {$x2 < $MAP_COLS} {incr x2} {
		for {set y2 0} {$y2 < $MAP_ROWS} {incr y2} {
			#この座標が既にサーチ,又は,塗り潰されていたら、何もしない。
			set c [getField $x2 $y2]
			if {$c != "."} then {continue}
			#指定された座標の、指定された軸以外の軸上を塗り潰す。
			set dx [expr {$x1 - $x2}]
			set dy [expr {$y1 - $y2}]
			set fAxis2 0
			if {$dx ==    0} then {set fAxis2 [expr {$fAxis2 | 1}]}		;#縦
			if {$dx ==  $dy} then {set fAxis2 [expr {$fAxis2 | 2}]}		;#昇斜
			if {$dy ==    0} then {set fAxis2 [expr {$fAxis2 | 4}]}		;#横
			if {$dx == -$dy} then {set fAxis2 [expr {$fAxis2 | 8}]}		;#降斜
			if {$fAxis2 && !($fAxis1 & $fAxis2)} then {setField $x2 $y2 "x"}						;#	この条件で'0'の軸上の塗り潰しもできる。
		}
	}
}
#-------------------------------------------------------------------------------
#初期化
proc init {} {
	#Tcl版の関数をC言語版の関数に置き換えた時にグローバル変数にアクセスできるよう、mainのコールフレームからもグローバル変数を参照できるようにしておく。
	setGlobal
	#発見した宇宙船の数を初期化する。
	set nShipFound 0
	#宇宙船の座標を初期化する。
	initShip
	#フィールドを初期化する。
	initField
	#軸キャッシュ(発見していない宇宙船も含む)を初期化する。
	initAxisCache0
	#軸キャッシュ(発見した宇宙船のみ)を初期化する。
	initAxisCache1
	#宇宙船キャッシュを初期化する。
	initShipCache
}
#-------------------------------------------------------------------------------
#メインループ
proc main {} {
	#Tcl版の関数をC言語版の関数に置き換えた時にグローバル変数にアクセスできるよう、mainのコールフレームからもグローバル変数を参照できるようにしておく。
	setGlobal
	while {1} {
		#フィールドを表示する。
		printField
		#宇宙船を全て発見したら、抜ける。
		if {$nShipFound == $SHIP_NUM} then {break}
		#サーチする座標を入力する。
		while {1} {
			lassign [getSearchPos] x y
			#この座標が既にサーチされていたら、何もしない。
			set c [getField $x $y]
			if {$c == "."} then {break}
		}
		#この座標に宇宙船が有るか?
		set iShip [shipExist $x $y]
		#この座標に宇宙船が有れば…
		if {$iShip != -1} then {
			#宇宙船を表示する。
			setField $x $y "S"
			#発見した宇宙船の数を増やす。
			incr nShipFound
			#軸キャッシュ(発見した宇宙船のみ)を更新する。
			updateAxisCache1 $x $y
			#宇宙船キャッシュを更新する。
			updateShipCache $x $y
		#この座標に宇宙船が無ければ…
		} else {
			#この座標から見て、宇宙船が有る軸のフラグを取得する。(発見していない宇宙船も含む)
			set fAxis0 [getAxisCache0 $x $y]
			#この座標から見て、宇宙船が有る軸の数を表示する。
			set nAxis0 [popcount $fAxis0]
			setField $x $y $nAxis0
		}
		#フィールドを更新する。
		updateField
	}
}
#-------------------------------------------------------------------------------
#P/ECEならば、Cプログラムからinit,mainを実行するので、ここでは実行しない。
if {$tcl_platform(platform) != "piece"} then {
	init
	main
}
