# tiles.icn

# tiles puzzle

# $Id: X-Tiles.icn,v 3.9 1997/02/21 11:35:38 espie Exp espie $
# minor mods 2000/12/23 gmt

link graphics


$define SMILEY_SIZE 40

$define DEFAULT_TSIZE 35
$define MIN_TSIZE 10
$define MAX_TSIZE 100
$define MINSIZE 256

# we use globals as this is mostly a hack



# individual tiles size (in pixels)

global tile_width, tile_height




# total playfield size
global n, m





global tiles_win, tiles_bw_win	# graphics context used to draw tiles


# tiles can be shown as normal, highlighted or shadowed border,
# or even patterned b&w if /normal
record color_set(normal, highlight, shadow, pattern, name)




global colors			# color array to map tiles colors
global black, white, bgcolor


global smiley1, smiley2, smiley3	# smiley images in the lower-right corner

global bgimage			# image to put in as background




#################################################################
#
#  graphics rendering
#
#################################################################

# replaces background with my own Image
procedure my_erase_area(win, x, y, w, h)
	/x := 0
	/y := 0
	/w := WAttrib(win, "width") - x
	/h := WAttrib(win, "height") - y
	CopyArea(bgimage, win, x, y, w, h, x, y)
end

procedure my_draw_string(win, x, y, s)
	Fg(white)
	DrawString(win, x+1, y+1, s)
	Fg(black)
	DrawString(win, x, y, s)
end


procedure write_score(score)
	Fg(black)
		# erase old score, that means the lower band of the window
		# except the SMILEY_SIZE x SMILEY_SIZE lower-right smiley
	EraseArea(&window, 0, m * tile_height, 
		n * tile_width-SMILEY_SIZE, SMILEY_SIZE)
	my_draw_string(&window, 10, m * tile_height + 15, score)
end


procedure draw_smiley(image)
	DrawImage(&window, n * tile_width-SMILEY_SIZE, m*tile_height, 
		SMILEY_SIZE||",c1,"||image)
end


# ask the user if he wants to replay, new, quit
procedure user_entry()
	static buttons
	initial
		{
		buttons := ["(r)eplay ", "(n)ew ", "(q)uit "]
		}

		# write the button and record corresponding areas
	leading := WAttrib("ascent") + 5
	s1 := TextWidth(buttons[1])
	s2 := TextWidth(buttons[2])
	s3 := TextWidth(buttons[3])
	my_draw_string(&window, 5, leading, buttons[1]||buttons[2]||buttons[3])
	repeat
		{
		e := Event()
		case e of
			{
		&lrelease | &mrelease | &rrelease:
			{
				# hardcoded button area check
			if 0 <= &y <= WAttrib("fheight") + 10 then
				{
				if (5 <= &x < 5 + s1) then return "r"
				if (5 + s1 <= &x < 5 + s1 + s2) then return "n"
				if (5 + s1 + s2 <= &x < 5 + s1 + s2 + s3) then return "q"
				}
			if (WAttrib("height")-SMILEY_SIZE < &y < WAttrib("height") &
				WAttrib("width")-SMILEY_SIZE < &x < WAttrib("width")) then
					return "u"
			}
		"q"|"n"|"r"|"u": 
			{
			return e
			}
			}
		}
end


# setup tiles color mapping 
procedure setup_colors(color_mode)

		# setup color mode correctly
	if WAttrib("depth") = 1 then
		insert(color_mode, "bw")
	every member(color_mode, "bw") & 
		member(color_mode, m <- "pastel"|"reduced"|"lighter"|"darker") do
			write("Warning: "||m||" makes no sense in black and white mode")
	if member(color_mode, "darker") & member(color_mode, "lighter") then
		write("Warning: lighter and darker specified both, uses darker")
		# establish possible set of colors/patterns
	color_names := set([
		["red", "darkgray"],
		["green", "gray"],
		["blue", "lightgray"],
		["yellow", "vertical"],
		["grey", "diagonal"],
		["purple", "horizontal"],
		["orange", "grid"],
		["magenta", "trellis"],
		["cyan", "checkers"],
		["blue-cyan", "grains"],
		["brown", "scales"],
		["bluish green", "waves"]
		])

	colors := []
		# create randomized mapping
	if member(color_mode, "pastel") then saturation := "moderate "
	else saturation := ""
	lightness := ["pale", "light ", "medium ", "dark ", "deep "]
	if member(color_mode, "darker") then 
		correction := 1
	else if member(color_mode, "lighter") then
		correction := -1
	else
		correction := 0
	while c := ?color_names do
		{
		delete(color_names, c)
		put(colors, color_set(&null, white, black, c[2], saturation||c[1]) )
		member(color_mode, "bw") |
			{
			colors[-1].normal := 
				ColorValue(lightness[3+correction]||colors[-1].name)
			}
	   }
	member(color_mode, "bw" | "reduced") |
		every c := !colors do
			{
			c.highlight := \ColorValue(lightness[2+correction]||\c.name) | white
			c.shadow := \ColorValue(lightness[4+correction]||\c.name) | black
			}
	return ColorValue(lightness[3+correction]||"gray")
end

procedure setup_graphics(color_mode)

	if /bgimage then dummy := WOpen("canvas=hidden", "width=1", "height=1")
			# assume the background image first pixel is background
	if /&window then
		stop("Error: could not open window. Check your display/xauth.")
	bgcolor := ColorValue(Pixel(\bgimage))
	black := ColorValue("black") | stop()
	white := ColorValue("white") | stop()
	if \bgcolor == black then black :=: white
		# These sizes MUST be real to match the background image size
	tile_width := (MINSIZE < WAttrib(\bgimage, "width"))/real(n)  | 
		DEFAULT_TSIZE
	tile_height := 
		((MINSIZE < WAttrib(\bgimage, "height"))+SMILEY_SIZE)/real(m) | 
		DEFAULT_TSIZE
	tile_width >:= MAX_TSIZE
	tile_height >:= MAX_TSIZE

		# compute and adjust window width/tiles width
	dwidth := WAttrib(&window, "displaywidth")
	if dwidth < n * tile_width then
			# leave one tile margin
		tile_width := dwidth / (n+1)

		# compute and adjust window height/tiles height
	dheight := WAttrib(&window, "displayheight")
	if dheight < m * tile_height + SMILEY_SIZE then
			# leave one tile margin
		tile_height := (dheight - SMILEY_SIZE) / (m+1)

	tile_width <:= MIN_TSIZE
	tile_height <:= MIN_TSIZE

	width := n * tile_width
	height := m * tile_height + SMILEY_SIZE

	tile_width := integer(tile_width)
	tile_height := integer(tile_height)

	&window := WOpen("label=the X-Tiles", 
							"bg="||(\bgcolor|white),
							"font=sans,bold,proportional",
							"width="||width, "height="||height)

	WClose(\dummy)
	if bsize := MINSIZE > WAttrib(\bgimage, "width") then
		{
		WAttrib(bgimage, "width="||width)
		every dest := bsize to width by bsize do
			CopyArea(bgimage, bgimage, 0, 0, bsize, &null, dest, 0)
		}
	if bsize := MINSIZE > WAttrib(\bgimage, "height") then
		{
		WAttrib(bgimage, "height="||height - SMILEY_SIZE)
		every dest := bsize to height by bsize do
			CopyArea(bgimage, bgimage, 0, 0, &null, bsize, 0, dest)
		}

	tiles_bw_win := Clone(&window, "fillstyle=textured", 
		"fg="||white,"bg="||black)
	newbg := setup_colors(color_mode)
	/bgcolor := newbg
	Bg(bgcolor)
	EraseArea(&window)
	tiles_win := Clone(&window)

   smiley1 := 
$include "smiley1.icn"
   smiley2 := 
$include "smiley2.icn"
   smiley3 := 
$include "smiley3.icn"
end


#################################################################
#
#  tiles and tiles rendering
#
#################################################################



# Tiles are saved in a 2-dimensional array
# Each tile is a unique individual (useful for set entries)
# that records its own position column/line as well as color
# /color for empty tiles


record tile_square(column, line, color, connect)

procedure t(i, j)
	static h, empty
	initial 
		{
		h := list(n)
		every h[1 to n] := list(m)
		every a := 1 to n do
			every b := 1 to m do
				h[a][b] := tile_square(a, b, &null)
		empty := tile_square()
		}
	if (1 <= i <= n) & (1 <= j <= m) then
		return h[i][j]
	else
		return empty
end


# compute the connectivity of a given tile (north, south, east, west)
# suspends with neighboring tiles whose connectivity may have changed
# PLEASE NOTE: compute_connectivity is definitily NOT purely functional
# For the computation to be correct, the generator MUST suspends ALL its
# results
procedure compute_connectivity(p)
	/p.connect := ''
	"ewsn" ?
		{
		every q := neighbor(p) do
			{
			if \p.color = \q.color | (/p.color & /q.color) then
				{
				if not any(p.connect) then
					{
					p.connect ++:= move(1)
					suspend q
					}
				else
					move(1)
				}
			else
				{
				if any(p.connect) then
					{
					p.connect --:= move(1)
					suspend q
					}
				else
					move(1)
				}
			}
		}
end
	

# draw bevel around a tile, recessed if /bevel
procedure draw_bevel(tile, bevel)
	if /tile.color then fail
	x := (tile.column - 1) * tile_width
	y := (m - tile.line) * tile_height
	x1 := x + tile_width - 1
	y1 := y + tile_height - 1
	c1 := colors[tile.color].highlight
	c2 := colors[tile.color].shadow 
	if \bevel then 
		c1 :=: c2

		# draw bevel areas only if the corresponding connectivity does
		# NOT exist
	Fg(c1)
	"n" ? any(tile.connect) |
		DrawRectangle(x, y, tile_width-1, 1)
	"e" ? any(tile.connect) |
		DrawRectangle(x, y, 1, tile_height-1)
	Fg(c2)
	"s" ? any(tile.connect) |
		DrawRectangle(x, y1-1, tile_width-1, 1)
	"w" ? any(tile.connect) |
		DrawRectangle(x1-1, y, 1, tile_height-1)
end


# draw tile itself, including bevel
procedure draw_tile(tile, bevel)
	x := (\tile.column - 1) * tile_width | fail
	y := (m - tile.line) * tile_height
	if /tile.color then
		{
		EraseArea(&window, x, y, tile_width, tile_height)
		}
	else
		{
		if Fg(tiles_win, \colors[tile.color].normal) then
			FillRectangle(tiles_win, x, y, tile_width, tile_height)
		else
			{
			WAttrib(tiles_bw_win, 
			"pattern="||colors[tile.color].pattern)|stop(colors[tile.color].pattern)
			FillRectangle(tiles_bw_win, x, y, tile_width, tile_height)
			}
		draw_bevel(tile, bevel)
		}
	return
end


procedure draw_bevel_set(s, bevel)
	if *s <= 1 then fail
	every draw_bevel(!s, bevel)
end

#################################################################
#
#  the game
#
#################################################################


# suspend a tile's neighbors

procedure neighbor(p)
	suspend t(\p.column - 1 | \p.column + 1, p.line) | 
		t(\p.column, p.line - 1 | p.line + 1)
end
	
# suspend a tile's upwards neighbors, enough for checking that moves remain
procedure up_neighbor(p)
	suspend t(p.column + 1, p.line) | t(p.column, p.line + 1)
end



# Ye old connected component algorithm
# start at t(i, j) and maps connected component.
# return &null if set is empty,
# and the old set if it is the same set

procedure connected_set(old, i, j)
	p := t(i, j)
	if member(\old, p) then return old
	c := \p.color | return &null
	s := set()
	l := [p]
	while p := pop(l) do
		if not member(s, p) then
			{
			insert(s, p)
			every q := neighbor(p) & \q.color = c do
				put(l, q)
			}
	return s
end


# suspends all current columns. Assumes a stable game, stops
# at first empty column
procedure columns()
	every i := seq() do
		{
		if /t(i, 1).color then fail
		suspend i
		}
end

# suspend all current lines for column c. Stops at first empty line
# Note that the game is always stable: the first empty tile means the
# top of the column
procedure lines(c)
	every j := seq() do
		{
		if /t(c, j).color then fail
		suspend j
		}
end
	
procedure used_tiles()
	suspend t(c := columns(), lines(c))
end

# check whether you can still play
procedure remains_move()
	every p := used_tiles() do
		if \p.color = \up_neighbor(p).color then return
	fail
end


# compute the interval of columns spanned by a set
# Note that all columns must be present as the set if 4-connected
procedure columns_of_set(s)
	local cmin, cmax

		# you can check that the following test does indeed set up cmin
		# and cmax correctly
	every c := (!s).column do
		(/cmin := c & /cmax := c) | (cmin >:= c) | (cmax <:= c)
	return [cmin, cmax]
end


# make tiles fall down in individual columns
procedure remove_individual_tiles(remember, saved, to_draw, s, cmin, cmax)
		# for each involved column
	every col := cmin to cmax do
		{
			# j: tile line # to replace, k: tile line # to replace it with
			# find the lowest removable tile
		if member(s, t(col, j := lines(col))) then
			{
			k := j
				# as long as we did not get outside
			while \t(col, j).color do
				{
					# find non erased tile
				k +:= 1
				while member(s, t(col, k)) do
					k +:= 1

					# and replace it
				p := t(col, j)
				put(remember, copy(p))
				insert(saved, p)
				put(to_draw, p)
				p.color := t(col, k).color 
				j +:= 1
				}
			}
		}
end

# remove empty columns
procedure remove_columns(remember, saved, to_draw, cmin, cmax)
		# now check for empty columns in known range
	if /t(col := cmin to cmax, 1).color then
			{
				# if we did find one, we have to check all columns
			colp := col
			while col <= n do
				{
				colp +:= 1
					# skip over empty columns... well stop when you get outside
				while /t(colp, 1).color & colp <= cmax do
					colp +:= 1

					# copy one column: do every line
				every j := seq() do
					{
					p := t(col, j)
					q := t(colp, j)
						# stop when BOTH columns (src and dest) are empty
					if /p.color & /q.color then break
					member(saved, p) | 
						{
						put(remember, copy(p))
						insert(saved, p)
						put(to_draw, p)
						}
					p.color := q.color
					}
				col +:= 1
				}
			}

end

procedure remove_tiles(s)
	cols := columns_of_set(s)

		# first we move tiles around
	backtrack := []	# copy of tiles that where changed
	to_draw := []		# list of tiles to draw
	saved := set()		# tiles that changed
		# note that to_draw and saved hold the same tiles.
		# saved is used for membership, and to_draw to display tiles
		# in linear order, which is less confusing
	remove_individual_tiles(backtrack, saved, to_draw, s, cols[1], cols[2])
	remove_columns(backtrack, saved, to_draw, cols[1], cols[2])

		# then we update needed connectivities
	other := rebuild_connectivity(saved)
		# and finally we redraw tiles
	redraw_tiles(to_draw, other)
	return backtrack
end


# redraw the list in order, followed by the set. 
procedure redraw_tiles(l, s)
	every p := !l do
		{
			# there may be duplicates
		delete(s, p)
		draw_tile(p)
		}
	every draw_tile(!s)
end


# rebuild the connectivity of the whole game, knowing the set of tiles
# that changed colors
procedure rebuild_connectivity(s)
	changed := set()
	neigh := set()

		# for each tile of the set
	every p := !s do 
		{
		q := &null
			# recompute its connectivity and mark its neighbors that have
			# changed
		every q := compute_connectivity(p) do
			member(s, q) | insert(neigh, q)

			# connectivity changed iff there was such a neighbor !
		if \q then 
			insert(changed, p)
		}

		# neighbors are simpler, as we just have to update their connectivity
		# watch out ! we have to use ALL the results of the generator
		# compute_connectivity for the computation to be correct
	every compute_connectivity(!neigh)
	changed ++:= neigh
	return changed
end

procedure undo(changes)
	c := set()
	l := []

		# backtrack changes, remember what to draw
	every p := !changes do
		{
		q := t(p.column, p.line)
		q.color := p.color
			# easier to build BOTH the list (for non confusing redraw)
			# and the set (needed by rebuild_connectivity)
		insert(c, q)
		put(l, q)
		}
	other := rebuild_connectivity(c)
	redraw_tiles(l, other)
end

procedure usage()
	return "Usage: X-Tiles [-v] [-h] _
[-bw] [-pastel] [-reduced] [-darker] [-lighter] _
[colors] [columns] [lines] [seed] [bg]"
end


procedure whoami()
# $Id: X-Tiles.icn,v 3.9 1997/02/21 11:35:38 espie Exp espie $
	name := ""
	"$Id: X-Tiles.icn,v 3.9 1997/02/21 11:35:38 espie Exp espie $" ? 
		{
		="$Id: "
		name ||:= tab(find(".icn,v"))
		=".icn,v "
		name ||:= " version "||tab(upto(' '))||move(1)||tab(upto(' '))
		}
	return name||" by Marc Espie (Marc.Espie@ens.fr)"
end


procedure new_game(r)

		# build a playable game
	repeat
		{
		every t(1 to n, 1 to m).color := ?r
		if remains_move() then
			break
		}

	every compute_connectivity(t(1 to n, 1 to m))

		# draw initial setup
	EraseArea(&window)
	draw_smiley(smiley1)
	every draw_tile(used_tiles())


		# remove left over events from last game
	while *Pending() > 0 do
		Event()
end


procedure adjust_end_score()
	# adjust end score
	count := 0
	every used_tiles() do
		count +:= 1
	if count > 0 then 
		{
		draw_smiley(smiley2)
		return -count
		}
	else
		{
		draw_smiley(smiley3)
		return 1000
		}
end



procedure main(L)
	parms := []
	color_mode := set()

		# process all options
	every p := !L do
		map(p) ?
		{
		{=("-bw"|"-reduced"|"-pastel"|"-lighter"|"-darker") & pos(0) & insert(color_mode, tab(2)) }|
		{=("-help"|"-h") & pos(0) & stop(usage())} |
		{=("-v"|"-version") & pos(0) & stop(whoami())} |
		{i := integer(tab(0)) & put(parms, i)} |
		{any('-') & stop("Unknown option "||tab(0)||"\n"||usage())} |
			# if we have a background image
		{bgimage := WOpen("canvas=hidden", "image="||p, "gamma=1.0") &
				# use our own flavour of EraseArea
			EraseArea := my_erase_area} |
		{stop("Can't load background image "||tab(0))}

		}


	r := get(parms) | 4
	n := get(parms) | 10
	m := get(parms) | n
	last_random := get(parms) | map(&clock, ':', '9')
	r <:= 2
	n <:= 4 
	n >:= 40
	m <:= 4 
	m >:= 40
	&random := map(&clock, ':', '9')

		# we have the game size and the background image, 
		# so we can open the window
	setup_graphics(color_mode)
	r >:= *colors
	&random := last_random

	while not (\last == "q") do
		{
			# setup for new game or replay
		if \last == "r" then
			{
			/best_score := \score
			&random := last_random
			}
		else
			{
			last_random := &random
			best_score := &null
			}
		writes("Playing tiles ", r, " ", n, " ", m, " ",
		   left(&random, 12))

		new_game(r)
		lasti := &null
		s := &null
		changes := []
		log := []
		score := 0
		write_score(score)

		repeat
			{
				# either get pending event, or busy-peek the mouse pointer position
			if *Pending() > 0 then
				{
				e := Event()
				i := &x/tile_width+1
				j := m - &y/tile_height
				}
			else
				{
				e := &null
				i := WAttrib("pointerx")/tile_width+1
				j := m - WAttrib("pointery")/tile_height
				}

				# check whether tile position changed
			if (i = \lasti) & (j = \lastj)  then 
				{
					# if busy-peeking, add suitable delay
				if /e then delay(50) 
				}
			else
				{
				lasti := i
				lastj := j
					# build new connected set
				sp := connected_set(s, i, j)

					# if a new set
				if sp ~=== s then
					{
						# un highlight old set (if needed)
					draw_bevel_set(\s)
					s := sp
						# highlight new set
					draw_bevel_set(\s, 1)
					if *\s > 2 then
						write_score(score||" (+"||(*s-2)*(*s-2)||")")
					else
						write_score(score)
					}
				}

			if e === "c" then
				{
				setup_colors(color_mode)
				if *\s < 2 then s := &null
				every p := used_tiles() do
					draw_tile(p, member(\s, p) | &null)
				}

				# check whether actually zapping
			if e === (&lrelease | &mrelease | &rrelease) & *\s >= 2 then
				{
				push(changes, [score, remove_tiles(s)])
				put(log, [i, j])
					# adjust score
				score +:= (*s-2)*(*s-2)
				write_score(score)

					# setup `virgin' highlighted set/position
				lasti := &null
				s := &null
				e := &null

					# check for end
				if not remains_move() then
					{
					score +:= adjust_end_score()
					if \best_score <:= score then
						{
						prompt := "Best "
						best_log := log
						}
					else
						prompt := "End "

					write_score(prompt||score)
					write("  Final score ", score)
					last := user_entry()
					if last == "u" then
						{
						EraseArea(0, 0, &null, WAttrib("leading")+10)
						to_undo := pop(changes)
						score := to_undo[1]
						write_score(score)
						draw_smiley(smiley1)
						undo(to_undo[2])
						}
					else
						break
					}
				}
			if (
				(e === (&lrelease | &mrelease | &rrelease) &
				WAttrib("height")-SMILEY_SIZE < &y < WAttrib("height") &
				WAttrib("width")-SMILEY_SIZE < &x < WAttrib("width")) |
				e === "u"
				) & *changes > 0 then
				{
				draw_bevel_set(\s)
				s := &null
				lasti := &null
				to_undo := pop(changes)
				score := to_undo[1]
				write_score(score)
				undo(to_undo[2])
				}
				# check if user wants to quit prematurely
			if e === "q" then
				{
				write_score("Sure ?")
				e := Event()
				if (e == ("o" | "y" | "q")) then 
					{
					last := "q"
					write()
					break
					}
				else
					write_score(score)
				}
			}
		}
end
