#!/usr/lib/scadalisp/bin/phslang

/*
 * A mines game.
 *
 * syntax:
 *
 *	mines [rows [cols [n-mines]]]
 *
 * default:
 *
 *	mines 10 10 20
 *
 * For a challenge, try 'mines 15 25 100'
 *
 * This file looks better with a tab width of 4.
 */

PtInit (nil);

/*
 * Define a convenience method for all widgets because setting an area is
 * a pain.	You cannot write directly to the area.pos.x fields, etc.
 */

method PtWidget.SetArea (x, y, w, h)
{
	local	a;

	a = new (PhArea);

	if (x) a.pos.x = x;
	else a.pos.x = .pos.x;

	if (y) a.pos.y = y;
	else a.pos.y = .pos.y;

	if (w) a.size.w = w;
	else a.size.w = .dim.w;

	if (h) a.size.h = h;
	else a.size.h = .dim.h;

	.area = a;
}

/*
 * Global variables.
 */

argv = cdr (argv);		/* strip the program name */
if (car(argv))
	mine-rows = number(car(argv));
else
	mine-rows = 10;

if (cadr(argv))
	mine-cols = number(cadr(argv));
else
	mine-cols = 10;

if (caddr(argv))
	mine-count = number(caddr(argv));
else
	mine-count = 20;

start-mine-count = mine-count;
mine-array = nil;
mine-window = nil;
mine-seconds = 0;
win-timer = nil;
AllScores = nil;
ScoreWindow = nil;

/*
 * Set up a timer which just counts off the seconds and updates a variable.
 * Set up a timer which fires at one second intervals and adds one to the
 * current value of mine-seconds.  Set up an active value on mine-seconds
 * to write a new string into the label widget, LTime.
 */

function update-time ()
{
	if (LTime && !destroyed-p(LTime))
	{
		LTime.text_string = string (mine-seconds);
	}
}

LTime = nil;

add-set-function (#mine-seconds, #update-time());
every (1, #(mine-seconds = mine-seconds + 1));

/*
 * Seed the randomizer.
 */

set-random (clock());

/*
 * Convenience functions for checking the mine array.  We keep an array
 * of 4 values for each position on the board:
 *	  0 - number of mines around position, or t if mine is here
 *	  1 - label widget for this position
 *	  2 - button widget for this position
 *	  3 - t or nil depending on whether this position is marked.
 */

function near (minearray, row, col)
{
	minearray[row][col][0];
}

function label (minearray, row, col)
{
	minearray[row][col][1];
}

function button (minearray, row, col)
{
	local	b;

	b = minearray[row][col][2];
	if ((b.flags & Pt_REALIZED) == 0)
		nil;
	else
		b;
}

function mark (minearray, row, col)
{
	minearray[row][col][3];
}

/*
 * Set up functions which count the neighbours for various interesting
 * properties.	SCADALisp has no macros, so we write a function instead.
 * We can do this because we can pass function pointers freely.	 The
 * 'around' function applies a function to all neighbours of a spot.
 */

function around (minearray, row, col, func)
{
	if (row > 0)
	{
		if (col > 0)
			func (minearray, row - 1, col - 1);
		func (minearray, row - 1, col);
		if (col < mine-cols - 1)
			func (minearray, row - 1, col + 1);
	}
	if (col > 0)
		func (minearray, row, col - 1);
	if (col < mine-cols - 1)
		func (minearray, row, col + 1);
	if (row < mine-rows - 1)
	{
		if (col > 0)
			func (minearray, row + 1, col - 1);
		func (minearray, row + 1, col);
		if (col < mine-cols - 1)
			func (minearray, row + 1, col + 1);
	}
}

function known (minearray, row, col)
{
	!button (minearray, row, col) || mark (minearray, row, col);
}

function marked (minearray, row, col)
{
	mark (minearray, row, col);
}

/*
 * Actual counting functions.  The variable 'sum' is a local to these
 * functions, but thanks to dynamic scoping, looks like a global to
 * the lambda expression being used as the passed function.
 */

function add-known (m, r, c)
{
	if (known (m, r, c)) sum = sum + 1;
}

function count-nearby-known (minearray, row, col)
{
	local	sum;

	sum = 0;
	around (minearray, row, col, add-known);
	sum;
}

function add-marked (m, r, c)
{
	if (marked (m, r, c)) sum = sum + 1;
}

function count-nearby-marked (minearray, row, col)
{
	local	sum;

	sum = 0;
	around (minearray, row, col, add-marked);
	sum;
}

function add-mines (m, r, c)
{
	if (true-p (mear (m, r, c))) sum = sum + 1;
}

function count-nearby-mines (minearray, row, col)
{
	local	sum;

	sum = 0;
	around (minearray, row, col, add-mines);
	sum;
}

/*
 * Set up the mine array as a 3-dimensional array of [rows][cols][info]
 */

function add1 (m, r, c)
{
	local	old;

	if (!true-p (old = near(m, r, c)))
	{
		if (!old) old = 0;
		m[r][c][0] = old + 1;
	}
}

function reset-mine-array (ma, rows, cols, mines)
{
	local	x, y;

	PtContainerHold (mine-window);

	for (i=0; i<rows; i = i + 1)
	{
		for (j=0; j<cols; j = j + 1)
		{
			x = ma[i][j];
			x[0] = x[3] = nil;
			x[2].fill_color = 0xc0c0c0;
			PtRealizeWidget (x[2]);
		}
	}

	for (i=0; i<mines; i = i + 1)
	{
		for (ok=nil; !ok;)
		{
			x = floor (random() * cols);
			y = floor (random() * rows);
			if (!true-p (ma[y][x][0]))
			{
				ma[y][x][0] = t;
				around (ma, y, x, add1);
				ok = t;
			}
		}
	}

	for (i=0; i<rows; i = i + 1)
	{
		for (j=0; j<cols; j = j + 1)
		{
			x = ma[i][j];
			if (x[0])
				x[1].text_string = string (x[0]);
			else
				x[1].text_string = "";
			x[1].fill_color = 0xc0c0c0;
		}
	}
	PtContainerRelease (mine-window);
}

function create-mine-array (rows, cols)
{
	local	ma, x, y;

	ma = make-array (rows);
	for (i=0; i<rows; i = i + 1)
	{
		ma[i] = make-array (cols);
		for (j=0; j<cols; j = j + 1)
		{
			ma[i][j] = make-array (4);
		}
	}
	ma;
}

/*
 * Build the mine window.  This is all manual for now, but it really isn't
 * that much of an effort.
 */

function create-mine-window (rows, cols, mines)
{
	local	w, lab, but, yoff, butsize, outsize;
	
	if (!mine-window)
	{
		yoff = 25;
		butsize = 20;
		outsize = butsize + 4;

		mine-array = create-mine-array (rows, cols);
		w = new (PtWindow);
		w.SetArea (0, 0, outsize * cols, yoff + outsize * rows);
		w.title = "Macro Bomb-O-Rama";
		MineWindow = w;

		for (i=0; i<rows; i = i + 1)
		{
			for (j=0; j<cols; j = j + 1)
			{
				lab = new (PtLabel);
				lab.SetArea (j * outsize, yoff + i * outsize,
							 outsize, outsize);
				if (near (mine-array, i, j) > 0)
					lab.text_string = string (near (mine-array, i, j));
				else
					lab.text_string = "";
				lab.horizontal_alignment = Pt_CENTER;
				lab.flags = Pt_HIGHLIGHTED | Pt_SELECTABLE;
				lab.bot_border_color = 0x00;
				lab.top_border_color = 0x00;
				lab.border_width = 1;
				PtAttachCallback (lab, Pt_CB_ACTIVATE,
								  list (#uncover-adjacent, i, j));
				mine-array[i][j][1] = lab;

				but = new (PtButton);
				but.SetArea (j * outsize, yoff + i * outsize,
							 butsize, butsize);
				but.text_string = "";
				but.flags = Pt_ALL_BUTTONS;
				PtAttachCallback (but, Pt_CB_ACTIVATE, list (#click, i, j));
				
				mine-array[i][j][2] = but;
			}
		}

		/* Place a counter for the number of mines remaining in the top left */
		lab = new (PtLabel);
		lab.SetArea (2, 2, 0, 0);
		lab.text_string = string (mines);
		lab.flags = Pt_HIGHLIGHTED | Pt_SET;
	
		/* Place a seconds timer in the top right. */
		LTime = new (PtLabel);
		LTime.SetArea (outsize * cols - 50, 2, 44, 0);
		LTime.text_string = "0";
		LTime.flags = Pt_HIGHLIGHTED | Pt_SET;
		LTime.horizontal_alignment = Pt_CENTER;
	
		/* Place a restart button in the middle.  I didn't try to be exact. */
		but = new (PtButton);
		but.SetArea ((outsize * cols) / 2 - 30, 2, 0, 0);
		BRestart = but;

		PtAttachCallback (but, Pt_CB_ACTIVATE,
						  #restart-game (mine-rows, mine-cols,
										 start-mine-count));
	
		/* Whenever the number of mines remaining or the number of spots still
		 * covered changes, check to see if we have won yet.
		 */

		add-set-function (#mine-count, list (#update-and-check-win, lab));
		add-set-function (#mine-covered, #check-win());
	
		mine-window = w;
	}

	reset-mine-array (mine-array, rows, cols, mines);
	BRestart.text_string = "Restart";
	PtRealizeWidget (mine-window);
	mine-seconds = 0;
}

/*
 * If called from within a button callback, will return t if the callback
 * was generated by a right button click.
 */

function right-button ()
{
	if (event_data.pointer_event.buttons & Ph_BUTTON_MENU != 0)
		t;
	else
		nil;
}

/*
 * If it was a right button click, toggle the mark on the button.  If it
 * was a left click, destroy the button and check to see if there was
 * a mine underneath.
 */

function click (row, col)
{
	if (right-button())
	{
		if (mark (mine-array, row, col))
		{
			mine-array[row][col][3] = nil;
			button (mine-array, row, col).fill_color = 0xa0a0a0;
			mine-count = mine-count + 1;
		}
		else
		{
			mine-array[row][col][3] = t;
			button (mine-array, row, col).fill_color = 0xff;
			mine-count = mine-count - 1;
		}
	}
	else
	{
		if (!mark (mine-array, row, col))
		{
			if (true-p (near (mine-array, row, col)))
			{
				BRestart.text_string = "You lose";
				highlight-all-mines (mine-array, mine-rows, mine-cols);
			}
			else
				remove-cover (mine-array, row, col);
		}
	}
}

/*
 * You lost.  Where were the mines?	 Mark mines in red, mis-marked ones
 * in green.
 */

function highlight-all-mines (marray, rows, cols)
{
	for (i=0; i<rows; i = i + 1)
	{
		for (j=0; j<cols; j = j + 1)
		{
			if (true-p (near (marray, i, j)))
			{
				button (marray, i, j).fill_color = 0xff;
			}
			else if (mark (marray, i, j))
			{
				button (marray, i, j).fill_color = 0xff00;
			}
		}
	}
}

/*
 * Pretend the user clicked on a button at a position if there is a button
 * there to click on.
 */

function maybe-remove-cover (marray, row, col)
{
	if (button (marray, row, col))
		click (row, col);
}

/*
 * Uncover all adjacent unmarked spots.	 This is the action performed by
 * a left click on a label.
 */

function uncover-adjacent (row, col)
{
	if (near (mine-array, row, col) ==
		count-nearby-marked (mine-array, row, col) &&
		!right-button())
	{
		around (mine-array, row, col, maybe-remove-cover);
	}
}

/*
 * Change the color of a random spot to a random color.	 Causes things to
 * flash when you attach this function to a fast timer.
 */

function flip-color ()
{
	local	x, y, c, which;

	x = floor (random() * mine-rows);
	y = floor (random() * mine-cols);
	c = floor (random() * 0x100) +
		floor (random() * 0x100) * 0x100 +
			floor (random() * 0x100) * 0x10000;

	if (!(which = button (mine-array, x, y)))
		which = label (mine-array, x, y);
	if (which)
		which.fill_color = c;
}

/*
 * Did you win?
 */

function update-and-check-win (lab)
{
	lab.text_string = string (mine-count);
	check-win();
}

function check-win ()
{
	if (mine-count == 0 && mine-covered == 0)
	{
		BRestart.text_string = "You WIN!";
		if (!win-timer)
			win-timer = every (0.025, #flip-color());
		new-score (mine-rows, mine-cols, start-mine-count, mine-seconds);
	}
}

/*
 * Uncover a button if it is not marked and it is not uncovered, nor
 * flagged to be uncovered.
 */

function maybe-uncover (marray, row, col)
{
	if (!mark (marray, row, col) &&
		button (marray, row, col) &&
		!find-equal (cons (row, col), uncover-list))
	{
		uncover-list = cons (cons (row, col), uncover-list);
	}
}

/*
 * Actually remove a button from a spot.  If the underlying mine count
 * is zero, remove all adjacent buttons.  We use an iterative approach
 * with a home-grown stack here to eliminate the possibility of running
 * out of C stack.	Is it QNX or Watcom which does not allow the
 *	$ stack unlimited
 * shell command?
 */

function remove-cover (marray, row, col)
{
	local	uncover-list;

	uncover-list = list (cons (row, col));
	for (next = car(uncover-list); uncover-list; next = car(uncover-list))
	{
		uncover-list = cdr (uncover-list);
		row = car (next);
		col = cdr (next);

		if (button (marray, row, col))
		{
			PtUnrealizeWidget (button (marray, row, col));
			mine-covered = mine-covered - 1;
			PtFlush ();
		}
		if (!near (marray, row, col))
			around (marray, row, col, maybe-uncover);
	}
	#! PtFlush ();
}

/*
 * Restart the game.  Destroy the game window if it exists, and reset all
 * counters and things to zero.
 */

function restart-game (rows, cols, count)
{
	mine-rows = rows;
	mine-cols = cols;
	mine-count = count;
	mine-covered = mine-rows * mine-cols - mine-count;
	if (win-timer)
	{
		cancel (win-timer);
		win-timer = nil;
	}
	PtSetParentWidget (nil);
	create-mine-window (mine-rows, mine-cols, mine-count);
}

/*
 * Handle the high-score list.
 * Scores are maintained:
 *	  ((rows cols mines time name) ()...)
 */

function read-scores ()
{
	local		file, retval;

	if (file = open ("minescores.dat", "r"))
	{
		retval = read (file);
		close (file);
	}
	retval;
}

function write-scores (scores)
{
	local		file;

	if (file = open ("minescores.dat", "w"))
	{
		pretty-write (file, scores);
		terpri (file);
		close (file);
	}
}

function new-score (rows, cols, mines, time)
{
	local		found, prevtime;
	
	for (i=AllScores; i; i=cdr(i))
	{
		if (rows == caar(i) && cols == cadar(i) && mines == car(cddar(i)))
			found = car (i);
	}
	if (!found)
	{
		found = list (rows, cols, mines, time+1, "");
		AllScores = cons (found, AllScores);
	}
	prevtime = car (cdddr (found));
	if (prevtime > time)
	{
		rplaca (cdddr (found), time);
		enter-name (found, cadr(cdddr(found)));
	}
}

function enter-name (scorelist, prev)
{
	local		win, txt, lab, str;

	PtSetParentWidget (MineWindow);
	win = new (PtWindow);
	win.SetArea (100, 50, 220, 40);
	win.title = "New Best Time!";
	lab = new (PtLabel);
	lab.text_string = "Enter your name:";
	lab.SetArea (5, 10, 0, 0);
	txt = new (PtText);
	txt.SetArea (120, 10, 90, 0);
	txt.text_string = prev;
	PtAttachCallback (txt, Pt_CB_ACTIVATE, list (name-done, win, txt,
												 list(#quote, scorelist)));
	PtRealizeWidget (win);
	PtSetParentWidget (MineWindow);
}

function name-done (win, txt, scorelist)
{
	local		name;
	
	name = txt.text_string;
	rplaca (cdr (cdddr (scorelist)), name);
	PtDestroyWidget (win);
	write-scores (AllScores);
	show-scores (AllScores);
}

function show-scores (scores)
{
	local		win, lab, list, nscores, words, score;

	if (!ScoreWindow || destroyed-p (ScoreWindow))
	{
		win = new (PtWindow);
		win.SetArea (100, 50, 310, 220);
		win.title = "Low Scores";
		ScoreWindow = win;

		nscores = length (scores);
		list = new (PtList);
		list.list_font = "cour12b";

		for (i=scores; i; i=cdr(i))
		{
			score = car(i);
			words = cons (format ("%4d %4d %5d %5d	%-s", car(score),
								  cadr(score), caddr(score), car(cdddr(score)),
								  cadr(cdddr(score))), words);
		}

		list.items = words;
		list.SetArea (2, 20, 300, 200);

		lab = new (PtLabel);
		lab.text_string = format ("%4s %4s %5s %5s	%s", "rows", "cols",
								  "mines", "time", "Player");
		lab.SetArea (6, 0, 0, 0);
		lab.text_font = "cour12b";
	
		PtRealizeWidget (win);
		PtSetParentWidget (MineWindow);
	}
	PtWidgetToFront (ScoreWindow);
}

/*
 * Start the game for the first time.
 */

AllScores = read-scores();

restart-game (mine-rows, mine-cols, start-mine-count);

/*
 * Loop forever.
 */

PtMainLoop();

