!
! Copyright (C) 2002-2003  Simon Baldwin (simon_baldwin@yahoo.com)
!
! This program is free software; you can redistribute it and/or
! modify it under the terms of the GNU General Public License
! as published by the Free Software Foundation; either version 2
! of the License, or (at your option) any later version.
!
! This program is distributed in the hope that it will be useful,
! but WITHOUT ANY WARRANTY; without even the implied warranty of
! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
! GNU General Public License for more details.
!
! You should have received a copy of the GNU General Public License
! along with this program; if not, write to the Free Software
! Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
!
!
#Ifndef TARGET_GLULX;
Message "[GLKBOARD requires GLULX.  Sorry.]";
#Endif;

#Ifdef TARGET_GLULX;
Include "mscp.h";
Include "infglk.h";


! Colors, timeouts.
Constant	BACKGROUND_COLOR	$FFFFFF;
Constant	HIGHLIGHT_COLOR		$FF0000;
Constant	BANNER_COLOR		$E6E6FE;
Constant	GUI_TIMEOUT		200;
Constant	REFRESH_TIMEOUT		1000;
Constant	MESSAGE_TIMEOUT		5000;
Constant	TIMEOUT			50;

! Piece resource constants.
Constant	WHITE_SQUARE		 1;
Constant	BLACK_SQUARE		 2;
Constant	WHITE_KING		 3;	! White pieces 3..8
Constant	WHITE_QUEEN		 4;
Constant	WHITE_ROOK		 5;
Constant	WHITE_BISHOP		 6;
Constant	WHITE_KNIGHT		 7;
Constant	WHITE_PAWN		 8;
Constant	BLACK_OFFSET		 6;	! 3..8 + 6 = 9..14
Constant	BLACK_KING		 9;	! Black pieces 9..14
Constant	BLACK_QUEEN		10;
Constant	BLACK_ROOK		11;
Constant	BLACK_BISHOP		12;
Constant	BLACK_KNIGHT		13;
Constant	BLACK_PAWN		14;
Constant	WHITE_BACKGROUND	12;	! 3..14 + 12 = 15..26
Constant	BLACK_BACKGROUND	24;	! 3..14 + 24 = 27..38

! Label resource constants.
Constant	NUMBER_LABEL		39;	! '1'..'8' = 39..46
Constant	LETTER_LABEL		47;	! 'a'..'h' = 47..54
Constant	DASH_LABEL		55;
Constant	EQ_LABEL		56;
Constant	HASH_LABEL		57;
Constant	PLUS_LABEL		58;
Constant	X_LABEL			59;
Constant	O_LABEL			60;
Constant	KING_LABEL		61;
Constant	QUEEN_LABEL		62;
Constant	ROOK_LABEL		63;
Constant	BISHOP_LABEL		64;
Constant	KNIGHT_LABEL		65;
Constant	ERROR_LABEL		66;

! Button resource constants.
Constant	LEVEL_BUTTON		67;	! level1..level8 = 67..74
Constant	WHITE_BUTTON		75;
Constant	BLACK_BUTTON		76;
Constant	NEW_UP_BUTTON		77;
Constant	NEW_DN_BUTTON		78;
Constant	UNDO_UP_BUTTON		79;
Constant	UNDO_DN_BUTTON		80;
Constant	QUIT_UP_BUTTON		81;
Constant	QUIT_DN_BUTTON		82;
Constant	LOAD_UP_BUTTON		83;
Constant	LOAD_DN_BUTTON		84;
Constant	SAVE_UP_BUTTON		85;
Constant	SAVE_DN_BUTTON		86;
Constant	BUSY_UP_BUTTON		87;
Constant	BUSY_DN_BUTTON		88;

! Miscellaneous resource constants.
Constant	GLKCHESS_LOGO		89;
Constant	GLKCHESS_GPL		90;
Constant	CLICK_MESSAGE		91;
Constant	GAME_OVER_MESSAGE	92;
Constant	GAME_DRAWN_MESSAGE	93;
Constant	SAVING_MESSAGE		94;
Constant	LOADING_MESSAGE		95;
Constant	LOADING_FAILED_MESSAGE	96;

Constant	MAX_IMAGE		96;

Constant	NO_SQUARE		-1;
Constant	NO_BUTTON		-1;

! PGN save/load files -- the $E0...0 is Glulx voodoo wrestled from the
! bi-platform library.
Array		PGN_SAVEFILE		-> $E0 'G''L''K''C''H''E''S''S'
						'.''P''G''N' 0;
Array		PGN_BACKUPFILE		-> $E0 'G''L''K''C''H''E''S''S'
						'.''B''A''K' 0;


!  /*----------------------------------------------------------------------+
!   |      Model                                                           |
!   +----------------------------------------------------------------------*/

Array	board		-> 64;
Array	board_fen	-> 128;

Global	highlight_from	= NO_SQUARE;
Global	highlight_to	= NO_SQUARE;

Array	last_white	-> 11;
Array	last_black	-> 11;

Global	play_level	= 3;
Global	whites_move	= true;

Global	available_moves	= 0;
Global	halfmoves	= 0;

! Update board array and board FEN from FEN data at posn.
[ import_fen fen pos
	i j k;

	! Start with all empty squares and an empty FEN.
	for (j = 0: j < 64: j++)
		board->j = '-';
	board_fen->0 = 0;

	! Position each piece found in the FEN, and copy the FEN characters
	! to the board_fen string.  This loop assumes that the input FEN
	! string is 100% accurate -- it contains no error handling.
	j = 0; k = 1; i = pos;
	while (fen->i ~= ' ' && fen->i ~= '^') {
		switch (fen->i) {
		'/':		break;
		'1' to '8':	j = j + fen->i - '0';
		default:	board->j++ = fen->i;
		}
		board_fen->k++ = fen->i;
		i++;
	}

	! Wrap up the rest of the FEN.
	while (fen->i ~= '^')
		board_fen->k++ = fen->i++;
	board_fen->0 = k - 1;
];


! Refresh highlight locations from algebraic move at posn.
[ refresh_highlight an posn
	i;

	! Do nothing unless either both or neither highlight is set.  If
	! only the first is set, the player is in mid move selection.
	if ((highlight_from == NO_SQUARE) == (highlight_to == NO_SQUARE)) {

		! If no move recorded, blank highlighting.
		if (an->posn == '-') {
			highlight_from	= NO_SQUARE;
			highlight_to	= NO_SQUARE;
			return;
		}

		! Update highlighting.
		i = posn;
		highlight_from	= ((7 - (an->(i + 1) - '1')) * 8) + an->i - 'a';
		i = posn + 2;
		highlight_to	= ((7 - (an->(i + 1) - '1')) * 8) + an->i - 'a';
	}
];


! Copy a SAN move into a buffer from the san at posn.
[ refresh_san buf san posn
	i j;

	! If no SAN move recorded clear buffer.
	i = posn;
	if (san->i == '-') {
		buf->0 = 0; return;
	}

	! Transfer data from san to buffer, end on whitespace.
	j = 1;
	while (san->i ~= ' ' && san->i ~= '^') {
		buf->j++ = san->i++;
	}
	buf->0 = j - 1;
];


Array	refresh_status	-> 256;

! Refresh the model from MSCP status.
[ refresh_model
	str i;
#Ifdef DEBUG;
	print "GLKBOARD> refresh_model^";
#Endif;

	! Get the current MSCP status.
	mscp_execute (MSCP_EXEC_STATUS, refresh_status, 256);

	! Update level.
	i = 0; str = refresh_status;
	play_level = str->i - '0';
	i = i + 2;

	! Find and update who is to move next.
	while (str->i ~= ' ') i++; i++;			! skip move number
	whites_move = (str->i == 'w');
	i = i + 5;					! skip w/b assignments

	! Update the count of available moves.
	available_moves = 0;
	while (str->i ~= ' ') {
		available_moves = available_moves * 10 + str->(i++) - '0';
	}
	i++;

	! Update the count of halfmoves.
	halfmoves = 0;
	while (str->i ~= ' ') {
		halfmoves = halfmoves * 10 + str->(i++) - '0';
	}
	i++;

	! If black to move, highlight last white.
	if (~~whites_move) {
		refresh_highlight (str, i);
	}
	while (str->i ~= ' ') i++; i++;			! advance over move

	! Note last white SAN move.
	refresh_san (last_white, str, i);
	while (str->i ~= ' ') i++; i++;			! advance over move

	! If white to move, highlight last black.
	if (whites_move) {
		refresh_highlight (str, i);
	}
	while (str->i ~= ' ') i++; i++;			! advance over move

	! Note last black SAN move.
	refresh_san (last_black, str, i);
	while (str->i ~= '^') i++; i++;			! advance to line end

	! Transfer status FEN to the board.
	import_fen (str, i);
];


!  /*----------------------------------------------------------------------+
!   |      GUI states                                                      |
!   +----------------------------------------------------------------------*/

Global	running		= true;
Global	engine_busy	= false;

Global	player_white	= true;
Global	invert_board	= false;

Global	undo_pressed	= false;
Global	new_pressed	= false;
Global	load_pressed	= false;
Global	save_pressed	= false;
Global	quit_pressed	= false;
Global	busy_pressed	= false;

Global	saving_game	= false;
Global	loading_game	= false;
Global	loading_failed	= false;

Array	board_coords	--> 2;
Array	busy_coords	--> 2;
Array	color_coords	--> 2;
Array	undo_coords	--> 2;
Array	new_coords	--> 2;
Array	load_coords	--> 2;
Array	save_coords	--> 2;
Array	quit_coords	--> 2;
Array	level_coords	--> 2;


!  /*----------------------------------------------------------------------+
!   |      View                                                            |
!   +----------------------------------------------------------------------*/

! Onscreen board, highlighting, and inversion, holds current display state.
Array	onscreen_board	-> 64;
Global	onscreen_from	= NO_SQUARE;
Global	onscreen_to	= NO_SQUARE;
Global	onscreen_invert	= false;

! Onscreen button and message states, holds current display state.
Global	onscreen_player	= true;
Global	onscreen_undo	= false;
Global	onscreen_level	= 3;
Global	onscreen_save	= false;
Global	onscreen_load	= false;
Global	onscreen_new	= false;
Global	onscreen_moves	= 0;
Global	onscreen_half	= 0;
Global	onscreen_quit	= false;
Global	onscreen_saving	= false;
Global	onscreen_loading= false;
Global	onscreen_failed	= false;

! Image dimensions cache, to save excessive image queries.
Array	cached_widths	--> MAX_IMAGE + 1;
Array	cached_heights	--> MAX_IMAGE + 1;

Array	glk_view_arg_w	--> 1;
Array	glk_view_arg_h	--> 1;

! Get image width and height from the cache, adding values where absent.
[ image_width pic;
	if (cached_widths-->pic == 0) {
		glk_image_get_info (pic, glk_view_arg_w, glk_view_arg_h);
		cached_widths-->pic  = glk_view_arg_w-->0;
		cached_heights-->pic = glk_view_arg_h-->0;
	}
	return cached_widths-->pic;
];
[ image_height pic;
	if (cached_heights-->pic == 0) {
		glk_image_get_info (pic, glk_view_arg_w, glk_view_arg_h);
		cached_widths-->pic  = glk_view_arg_w-->0;
		cached_heights-->pic = glk_view_arg_h-->0;
	}
	return cached_heights-->pic;
];


! Draw banner.
[ draw_banner window orgx orgy w
	width height;
#Ifdef DEBUG;
	print "GLKBOARD> draw_banner ", window, ", ", orgx, ", ", orgy,
		", ", w, "^";
#Endif;

	! Place a banner line, with logo, at the given location.
	width = image_width (GLKCHESS_LOGO);
	height = image_height (GLKCHESS_LOGO);
	glk_image_draw (window, GLKCHESS_LOGO, orgx + w - width, orgy);
	glk_window_fill_rect (window, BANNER_COLOR, orgx, orgy,
							w - width, height);
];


! Draw the main chess board.
[ draw_board window full orgx orgy
	grid i x y px py pic bg cb;
#Ifdef DEBUG;
	print "GLKBOARD> draw_board ", window, ", ", full, ", ",
		orgx, ", ", orgy, "^";
#Endif;

	! Determine each position dimension from the width of a square.
	! Assume all squares are the same size, and, well, square.
	grid = image_width (WHITE_SQUARE);

	! Start the board one position in from the left, for labels.
	x = grid; y = 0;
	cb = false;

	! Iterate over each board position.
	for (i = 0: i < 64: i++) {

		! Calculate piece coords for board orientation.
		if (~~invert_board) {
			px = orgx + x;
			py = orgy + y;
		} else {
			px = orgx + (9 * grid) - x;
			py = orgy + (7 * grid) - y;
		}

		! Draw if the orientation or piece changed, if this position
		! is an onscreen highlight, or on full paint.
		if (full || invert_board ~= onscreen_invert
				|| board->i ~= onscreen_board->i
				|| i == onscreen_from || i == onscreen_to) {

			! Select background and default image.
			if (cb) {
				bg = BLACK_BACKGROUND;
				pic = BLACK_SQUARE;
			} else {
				bg = WHITE_BACKGROUND;
				pic = WHITE_SQUARE;
			}

			! Select an image resource for the piece.
			switch (board->i) {
			'K': pic = WHITE_KING	+ bg;
			'Q': pic = WHITE_QUEEN	+ bg;
			'R': pic = WHITE_ROOK	+ bg;
			'B': pic = WHITE_BISHOP	+ bg;
			'N': pic = WHITE_KNIGHT	+ bg;
			'P': pic = WHITE_PAWN	+ bg;
			'k': pic = BLACK_KING	+ bg;
			'q': pic = BLACK_QUEEN	+ bg;
			'r': pic = BLACK_ROOK	+ bg;
			'b': pic = BLACK_BISHOP	+ bg;
			'n': pic = BLACK_KNIGHT	+ bg;
			'p': pic = BLACK_PAWN	+ bg;
			}

			! Draw the piece image.
			glk_image_draw (window, pic, px, py);
		}

		! Highlight this location if requested.
		if (i == highlight_from || i == highlight_to) {
			glk_window_fill_rect (window, HIGHLIGHT_COLOR,
						px, py, grid, 1);
			glk_window_fill_rect (window, HIGHLIGHT_COLOR,
						px, py, 1, grid);
			glk_window_fill_rect (window, HIGHLIGHT_COLOR,
						px + grid - 1, py, 1, grid);
			glk_window_fill_rect (window, HIGHLIGHT_COLOR,
						px, py + grid - 1, grid, 1);
		}

		! Advance x and y coordinates, and checkerboard.
		if (i % 8 == 7) {
			y = y + grid;
			x = grid;
		} else {
			x = x + grid;
			cb = ~~cb;
		}
	}

	! Note board coordinates.
	board_coords-->0 = orgx + grid;
	board_coords-->1 = orgy;

	! On full paint or change of board orientation, add labels.
	if (full || invert_board ~= onscreen_invert) {

		! Add in rank labels.
		x = 0; y = 0;

		for (i = 8: i >= 1: i--) {
			if (~~invert_board)
				pic = NUMBER_LABEL + i - 1;
			else
				pic = NUMBER_LABEL + 8 - i;
			glk_image_draw (window, pic,
				orgx + x + (grid - image_width (pic)) / 2,
				orgy + y);
			y = y + grid;
		}

		! Add in file labels, positioned to align with board squares.
		x = grid;

		for (i = 1: i <= 8: i++) {
			if (~~invert_board)
				pic = LETTER_LABEL + i - 1;
			else
				pic = LETTER_LABEL + 8 - i;
			glk_image_draw (window, pic,
				orgx + x + (grid - image_width (pic)) / 2,
				orgy + y);
			x = x + grid;
		}
	}

	! Update onscreen tracking for the view.
	for (i = 0: i < 64: i++)
		onscreen_board->i = board->i;

	onscreen_from	= highlight_from;
	onscreen_to	= highlight_to;
	onscreen_invert	= invert_board;
];


! Draw a chess move.
[ draw_move window orgx orgy str iswhite
	i pic x y;
#Ifdef DEBUG;
	print "GLKBOARD> draw_move ", window, ", ", orgx, ", ", orgy, ", ",
		str, ", ", iswhite, "^";
#Endif;

	! Do nothing if no move string.
	if (str->0 == 0)
		return;

	! Get an image resource for the piece, default pawn if unidentified.
	switch (str->1) {
	'K','O': pic = WHITE_KING;
	'Q':     pic = WHITE_QUEEN;
	'R':     pic = WHITE_ROOK;
	'B':     pic = WHITE_BISHOP;
	'N':     pic = WHITE_KNIGHT;
	default: pic = WHITE_PAWN;
	}
	if (~~iswhite) {
		pic = pic + BLACK_OFFSET;
	}

	! Draw piece.
	x = orgx; y = orgy;
	glk_image_draw (window, pic, x, y);
	x = x + image_width (pic);

	! Draw remaining characters as labels.
	i = 1;
	while (i <= str->0) {
		switch (str->i) {
		'K':		pic = KING_LABEL;
		'Q':		pic = QUEEN_LABEL;
		'R':		pic = ROOK_LABEL;
		'B':		pic = BISHOP_LABEL;
		'N':		pic = KNIGHT_LABEL;
		'a' to 'h':	pic = LETTER_LABEL	+ str->i - 'a';
		'1' to '8':	pic = NUMBER_LABEL	+ str->i - '1';
		'O':		pic = O_LABEL;
		'-':		pic = DASH_LABEL;
		'=':		pic = EQ_LABEL;
		'#':		pic = HASH_LABEL;
		'+':		pic = PLUS_LABEL;
		'x':		pic = X_LABEL;
		default:	pic = ERROR_LABEL;	! Not expected.
		}

		! Draw image, and advance x.
		glk_image_draw (window, pic, x, y);
		x = x + image_width (pic);

		i++;
	}
];


! Draw the controls panel.
[ draw_controls window full wid orgx orgy
	width align x y pic;
#Ifdef DEBUG;
	print "GLKBOARD> draw_controls ", window, ", ", full, ", ", wid, ", ",
		orgx, ", ", orgy, "^";
#Endif;

	! Panel width is the level radiobutton width, alignment is board
	! squares.
	width = image_width (LEVEL_BUTTON);
	align = image_width (WHITE_SQUARE);

	! Draw moves last made, and optional busy indicator; always done.
	x = orgx;
	y = orgy;
	glk_window_erase_rect (window, x, y, wid - x, align + 1);
	draw_move (window, x, y, last_white, true);
	if (engine_busy && whites_move) {
		if (busy_pressed)
			pic = BUSY_DN_BUTTON;
		else
			pic = BUSY_UP_BUTTON;
		x = x + width - image_width (pic);
		glk_image_draw (window, pic, x, y);
		busy_coords-->0 = x;
		busy_coords-->1 = y;
	}

	x = orgx;
	y = orgy + align * 2;
	glk_window_erase_rect (window, x, y, wid - x, align + 1);
	draw_move (window, x, y, last_black, false);
	if (engine_busy && (~~whites_move)) {
		if (busy_pressed)
			pic = BUSY_DN_BUTTON;
		else
			pic = BUSY_UP_BUTTON;
		x = x + width - image_width (pic);
		glk_image_draw (window, pic, x, y);
		busy_coords-->0 = x;
		busy_coords-->1 = y;
	}

	! On full paint or change, draw color radiobutton.
	if (full || player_white ~= onscreen_player) {
		if (player_white)
			pic = WHITE_BUTTON;
		else
			pic = BLACK_BUTTON;
		x = orgx;
		y = orgy + align * 4;
		glk_image_draw (window, pic, x, y);
		color_coords-->0 = x;
		color_coords-->1 = y;
		onscreen_player = player_white;
	}

	! On full paint or change, raw undo button.
	if (full || undo_pressed ~= onscreen_undo) {
		if (undo_pressed)
			pic = UNDO_DN_BUTTON;
		else
			pic = UNDO_UP_BUTTON;
		x = orgx + width - image_width (pic);
		y = orgy + align * 4;
		glk_image_draw (window, pic, x, y);
		undo_coords-->0 = x;
		undo_coords-->1 = y;
		onscreen_undo = undo_pressed;
	}

	! On full paint or change, draw the appropriate level radiobutton.
	if (full || play_level ~= onscreen_level) {
		pic = LEVEL_BUTTON + play_level - 1;
		x = orgx;
		y = orgy + align * 6;
		glk_image_draw (window, pic, x, y);
		level_coords-->0 = x;
		level_coords-->1 = y;
		onscreen_level = play_level;
	}

	! On full paint or change of either, draw save and load buttons.
	if (full || save_pressed ~= onscreen_save
			|| load_pressed ~= onscreen_load) {
		if (save_pressed)
			pic = SAVE_DN_BUTTON;
		else
			pic = SAVE_UP_BUTTON;
		x = orgx;
		y = orgy + align * 7;
		glk_image_draw (window, pic, x, y);
		save_coords-->0 = x;
		save_coords-->1 = y;
		onscreen_save = save_pressed;

		x = x + image_width (pic);

		if (load_pressed)
			pic = LOAD_DN_BUTTON;
		else
			pic = LOAD_UP_BUTTON;
		glk_image_draw (window, pic, x, y);
		load_coords-->0 = x;
		load_coords-->1 = y;
		onscreen_load = load_pressed;
	}

	! On full paint or change, draw new button.
	if (full || new_pressed ~= onscreen_new) {
		if (new_pressed)
			pic = NEW_DN_BUTTON;
		else
			pic = NEW_UP_BUTTON;
		x = orgx + width - image_width (pic);
		y = orgy + align * 7;
		glk_image_draw (window, pic, x, y);
		new_coords-->0 = x;
		new_coords-->1 = y;
		onscreen_new = new_pressed;
	}

	! On full paint or change, draw any game over message, or saving
	! or loading message, or blank.
	if (full || available_moves ~= onscreen_moves
			|| halfmoves ~= onscreen_half
			|| saving_game ~= onscreen_saving
			|| loading_game ~= onscreen_loading
			|| loading_failed ~= onscreen_failed) {
		if (saving_game)		pic = SAVING_MESSAGE;
		else if (loading_game)		pic = LOADING_MESSAGE;
		else if (loading_failed)	pic = LOADING_FAILED_MESSAGE;
		else if (available_moves == 0)	pic = GAME_OVER_MESSAGE;
		else if (halfmoves >= 50)	pic = GAME_DRAWN_MESSAGE;
		else				pic = -1;
		x = orgx;
		y = orgy + align * 8;
		if (pic ~= -1)
			glk_image_draw (window, pic, x, y);
		else
			glk_window_erase_rect (window, x, y,
					image_width (GAME_OVER_MESSAGE),
					image_height (GAME_OVER_MESSAGE));
		onscreen_moves = available_moves;
		onscreen_half = halfmoves;
		onscreen_saving = saving_game;
		onscreen_loading = loading_game;
		onscreen_failed = loading_failed;
	}

	! On full paint or change, draw quit button.
	if (full || quit_pressed ~= onscreen_quit) {
		if (quit_pressed)
			pic = QUIT_DN_BUTTON;
		else
			pic = QUIT_UP_BUTTON;
		x = orgx + width - image_width (pic);
		y = orgy + align * 8;
		glk_image_draw (window, pic, x, y);
		quit_coords-->0 = x;
		quit_coords-->1 = y;
		onscreen_quit = quit_pressed;
	}
];


Array	glk_repaint_arg_w	--> 1;
Array	glk_repaint_arg_h	--> 1;

! GUI repaint, partial or complete.
[ repaint window full
	width height align tx ty bx by cx cy;
#Ifdef DEBUG;
	print "GLKBOARD> repaint ", window, ", ", full, "^";
#Endif;

	! Find the window dimensions.
	glk_window_get_size (window, glk_repaint_arg_w, glk_repaint_arg_h);
	width = glk_repaint_arg_w-->0;
	height = glk_repaint_arg_h-->0;

	! Determine alignment of GUI elements.
	align = image_width (WHITE_SQUARE);

	! Obtain the top left of the paint area.
	tx = (width / 2 - align * 9) / 2;
	if (tx < 0)
		tx = 0;
	ty = (height - align * 10 - image_height (GLKCHESS_LOGO)) / 2;
	if (ty < 0)
		ty = 0;

	! Position the board 2 places below top left.
	bx = tx;
	by = ty + align * 2;

	! Position the controls on the right half of the paint area, or
	! at worst, just right of the board, which is 9 places wide.
	cx = bx + width / 2;
	if (cx < bx + align * 9)
		cx = bx + align * 9;
	cy = by;

	! On full paint, clear the window, then draw top banner.
	if (full) {
		glk_window_clear (window);
		draw_banner (window, tx + align, ty, width / 2 + align * 7);
	}

	! Draw the board and buttons panel, passing the full paint flag.
	draw_board (window, full, bx, by);
	draw_controls (window, full, width, cx, cy);
];


!  /*----------------------------------------------------------------------+
!   |      PGN save/load                                                   |
!   +----------------------------------------------------------------------*/

Array	base_fen	-> 128;

Array pgnhdre  string "Event";	Array pgnhdrs  string "Site";
Array pgnhdrd  string "Date";	Array pgnhdrr  string "Round";
Array pgnhdrw  string "White";	Array pgnhdrb  string "Black";
Array pgnhdrx  string "Result";	Array pgnhdrf  string "FEN";
Array pgnhdru  string "SetUp";

Array pgnrna   string "-";	Array pgnone   string "1";
Array pgnrew   string "1-0";	Array pgnreb   string "0-1";
Array pgnreu   string "*";	Array pgnred   string "1/2-1/2";
Array pgnpgm   string "Inform MSCP";
Array pgnevt   string "MSCP chess game";
Array pgnsit   string "Computer";
Array pgndat   string "????.??.??";

Array	pgnhdrtable	table
	pgnhdre		pgnevt		pgnhdrs		pgnsit
	pgnhdrd		pgndat		pgnhdrr		pgnrna
	pgnhdrw		0		pgnhdrb		0
	pgnhdrx		0		pgnhdrf		0
	pgnhdru		pgnone;

Array pgnplr1 string "Bishop, Elvin";	Array pgnplr2 string "Knight, Gladys";
Array pgnplr3 string "King, B.B.";	Array pgnplr4 string "Checker, Chubby";

Array	pgnplrtable	table	pgnplr1 pgnplr2 pgnplr3 pgnplr4;

Array	pgn_event_buffer	--> 4;

Global	save_fd		= GLK_NULL;
Global	load_fd		= GLK_NULL;
Global	pgn_window	= GLK_NULL;
Array	pgn_buffer	-> 256;

! GUI keepalive, for lengthy load and save operations.
[ pgn_keepalive window;

	! Call glk_select() with a short timeout, to pick up and handle only
	! redraw and arrange events.
	glk_request_timer_events (TIMEOUT);
	do {
		! Get the next event.
		glk_select (pgn_event_buffer);

		! Because we're not calling the main handle_event here, this
		! makes load and save modal.  We need to remember to re-
		! request mouse events if we catch one.
		switch (pgn_event_buffer-->0) {
		evtype_MouseInput:
			glk_request_mouse_event (window);

		evtype_Redraw:
		evtype_Arrange:
			repaint (window, true);
		}
	} until (pgn_event_buffer-->0 == evtype_Timer);
	glk_request_timer_events (0);
];


! Game save buffer callback, handles a line of game history.
[ pgn_buffer_callback buffer length;

	! Call GUI keepalive.
	pgn_keepalive (pgn_window);

	! Output the buffered data, terminating with a newline.
	glk_put_buffer_stream (save_fd, buffer, length - 1);
	glk_put_char_stream (save_fd, 10);
];


! Game save busy callback, calls glk_tick and returns.
[ pgn_busy_callback;
	glk_tick ();
	return true;
];


! Save the game to a file, either full PGN or shortened (FEN only).
[ save_game_frontend file
	fref;
#Ifdef DEBUG;
	print "GLKBOARD> save_game_frontend ", file, "^";
#Endif;

	! Open save file.
	fref = glk_fileref_create_by_name
			(fileusage_Data | fileusage_TextMode, file, 0);
	if (fref == GLK_NULL)
		return false;
	save_fd = glk_stream_open_file (fref, filemode_Write, 0);
	if (save_fd == GLK_NULL) {
		glk_fileref_destroy (fref);
		return false;
	}

	! File available for save.
	glk_fileref_destroy (fref);
	return true;
];

[ save_game_backend full_pgn window
	res w b i hdr val;
#Ifdef DEBUG;
	print "GLKBOARD> save_game_backend ", full_pgn, " ,", window, "^";
#Endif;

	! Note any clear winner or stalemate, and name white and black.
	refresh_model ();
	if (last_white->(last_white->0) == '#')
		res = pgnrew;
	else if (last_black->(last_black->0) == '#')
		res = pgnreb;
	else if (available_moves == 0 || halfmoves >= 50)
		res = pgnred;
	else
		res = pgnreu;
	if (player_white) {
		w = pgnplrtable-->(random (4));
		b = pgnpgm;
	} else {
		b = pgnplrtable-->(random (4));
		w = pgnpgm;
	}

	! Write PGN header.
	for (i = 1: i <= pgnhdrtable-->0: i++) {
		glk_tick ();

		! If doing full PGN, keep the GUI alive.
		if (full_pgn)
			pgn_keepalive (window);

		! Get the PGN header and initial value.
		hdr = pgnhdrtable-->i++;
		val = pgnhdrtable-->i;

		! If doing full PGN and the base FEN is empty, don't output
		! the FEN and Setup PGN header lines.
		if (full_pgn && (hdr == pgnhdrf || hdr == pgnhdru)
				&& base_fen->0 == 0)
			continue;

		! Output the PGN header line title.
		glk_put_char_stream (save_fd, '[');
		glk_put_buffer_stream (save_fd, hdr + 1, hdr->0);
		glk_put_char_stream (save_fd, ' ');
		glk_put_char_stream (save_fd, '"');

		! Select a new value if appropriate.
		switch (hdr) {
		pgnhdrw:	val = w;
		pgnhdrb:	val = b;
		pgnhdrx:	val = res;
		pgnhdrf:	if (full_pgn)
					val = base_fen;
				else
					val = board_fen;
		}

		! Output the PGN header line data.
		glk_put_buffer_stream (save_fd, val + 1, val->0);
		glk_put_char_stream (save_fd, '"');
		glk_put_char_stream (save_fd, ']');
		glk_put_char_stream (save_fd, 10);
	}

	! Write PGN move list on full PGN only; it's covered by the FEN
	! above on short PGN saves.
	glk_put_char_stream (save_fd, 10);
	if (full_pgn) {
		pgn_window = window;
		mscp_execute (MSCP_EXEC_HISTORY,
					pgn_buffer, 256, pgn_buffer_callback,
					pgn_busy_callback);
		pgn_window = GLK_NULL;
	}

	! Write PGN terminating result.
	glk_put_buffer_stream (save_fd, res + 1, res->0);
	glk_put_char_stream (save_fd, 10);
	glk_put_char_stream (save_fd, 10);

	glk_stream_close (save_fd, GLK_NULL);
	return true;
];


Array	pgn_token	-> 256;

! Load a game from a PGN file.  There is partial support here for the lax
! input format PGN, but a full PGN parser is a lot of code; this function
! pair is more geared towards accepting well-formed output format PGN.
[ load_game_frontend file
	fref;
#Ifdef DEBUG;
	print "GLKBOARD> load_game_frontend ", file, "^";
#Endif;

	! Open load file.
	fref = glk_fileref_create_by_name
			(fileusage_Data | fileusage_TextMode, file, 0);
	if (fref == GLK_NULL)
		return false;
	! Here we should have:
	!	if (~~(glk_fileref_does_file_exist (fref))) {
	!		glk_fileref_destroy (fref);
	!		return false;
	!	}
	! A bug in gi_dispa.c, line 700, prevents glk_fileref_does_file_exist
	! from working through dispatch, and thus through glulxe.  The effect
	! of not testing file existence is an ugly library error when trying
	! to open the file, but nothing worse.
	load_fd = glk_stream_open_file (fref, filemode_Read, 0);
	if (load_fd == GLK_NULL) {
		glk_fileref_destroy (fref);
		return false;
	}

	! File available for load.
	glk_fileref_destroy (fref);
	return true;
];

[ load_game_backend window
	chars ispgn isfen i j str tstart tend comment done status;
#Ifdef DEBUG;
	print "GLKBOARD> load_game_backend ", window, "^";
#Endif;

	! Clear flags to detect Event and FEN headers.
	ispgn = false;
	isfen = false;

	! Handle file lines, stopping at file end or empty line.
	status = true;
	for (chars = glk_get_line_stream (load_fd, pgn_buffer, 255):
		chars > 0:
		chars = glk_get_line_stream (load_fd, pgn_buffer, 255)) {
		glk_tick ();

		! Keep the GUI alive.
		pgn_keepalive (window);

		! Ignore any %... escapes.
		str = pgn_buffer; if (str->0 == '%') continue;

		! Delete any trailing CRLF.
		i = chars - 1;
		while (i >= 0 && (str->i == 10 || str->i == 13)) i--;
		chars = i + 1;

		! Find first non space, break on blank line.
		i = 0; while (i < chars && str->i == ' ') i++;
		if (i >= chars)
			break;

		! Search for Event or FEN PGN headers.
		if (i >= chars || str->i ~= '[')
			continue;
		i++; while (i < chars && str->i == ' ') i++;
		if (i >= chars)
			continue;
		if (str->i == pgnhdre->1
				&& str->(i + 1) == pgnhdre->2
				&& str->(i + 2) == pgnhdre->3
				&& str->(i + 3) == pgnhdre->4
				&& str->(i + 4) == pgnhdre->5
				&& str->(i + 5) == ' ') {
			ispgn = true;
			continue;
		}
		if (str->i ~= pgnhdrf->1
				|| str->(i + 1) ~= pgnhdrf->2
				|| str->(i + 2) ~= pgnhdrf->3
				|| str->(i + 3) ~= ' ')
			continue;
		i = i + 4; while (i < chars && str->i ~= '"') i++;

		! Found FEN, transform buffer into a string.
		tstart = i + 1; tend = tstart;
		while (tend < chars && str->tend ~= '"') tend++;
		str->i = tend - tstart + 1;

		! Send FEN to MSCP, note status as validity check.
		mscp_execute (MSCP_EXEC_FORCE);
		status = mscp_execute (MSCP_EXEC_SETUP_FEN, str + i);
		if (status) {
			refresh_model ();

			! Copy MSCP's FEN to be our base.
			for (i = 1: i <= board_fen->0: i++)
				base_fen->i = board_fen->i;
			base_fen->0 = board_fen->0;
		}

		! Note PGN FEN header found.
		ispgn = true;
		isfen = true;
	}

	! Reject if no PGN header found, or if any contained FEN is invalid.
	if (~~(ispgn && status)) {
		glk_stream_close (load_fd, GLK_NULL);
		return false;
	}

	! If no FEN header found, reset MSCP and clear base.
	if (~~isfen) {
		mscp_execute (MSCP_EXEC_NEW_GAME);
		mscp_execute (MSCP_EXEC_FORCE);
		refresh_model ();

		base_fen->0 = 0;
	}

	! Handle file lines, stopping at file end or result token.
	comment = false;
	done = false;
	for (chars = glk_get_line_stream (load_fd, pgn_buffer, 255):
		chars > 0:
		chars = glk_get_line_stream (load_fd, pgn_buffer, 255)) {
		glk_tick ();

		! Keep the GUI alive.
		pgn_keepalive (window);

		! Ignore any %... escapes.
		str = pgn_buffer; if (str->0 == '%') continue;

		! Delete any trailing CRLF.
		i = chars - 1;
		while (i >= 0 && (str->i == 10 || str->i == 13)) i--;
		chars = i + 1;

		! Find first non space, break on blank line.
		i = 0; while (i < chars && str->i == ' ') i++;
		if (i >= chars)
			break;

		! Tokenize the line, and handle each token found.
		while (i < chars) {
			glk_tick ();

			! Ignore commentary, both rest-of-line and {...}.
			if (~~comment) {
				if (str->i == ';')
					break;
				else if (str->i == '{')
					comment = true;
			}
			while (comment && i < chars) {
				if (str->i == '}')
					comment = false;
				i++;
			}
			if (i >= chars)
				break;
			
			! Get the next token, and copy to token buffer.
			tstart = i; tend = tstart;
			while (tend < chars && str->tend ~= ' ') tend++;
			for (j = tstart: j < tend: j++)
				pgn_token->(j - tstart + 1) = str->j;
			pgn_token->0 = tend - tstart;

			! End loading if this looks like the game result.
			if (pgn_token->0 == pgnrew->0
					&& pgn_token->1 == pgnrew->1
					&& pgn_token->2 == pgnrew->2
					&& pgn_token->3 == pgnrew->3)
				done = true;
			else if (pgn_token->0 == pgnreb->0
					&& pgn_token->1 == pgnreb->1
					&& pgn_token->2 == pgnreb->2
					&& pgn_token->3 == pgnreb->3)
				done = true;
			else if (pgn_token->0 == pgnreu->0
					&& pgn_token->1 == pgnreu->1)
				done = true;
			else if (pgn_token->0 == pgnred->0
					&& pgn_token->1 == pgnred->1
					&& pgn_token->2 == pgnred->2
					&& pgn_token->3 == pgnred->3
					&& pgn_token->4 == pgnred->4
					&& pgn_token->5 == pgnred->5
					&& pgn_token->6 == pgnred->6
					&& pgn_token->7 == pgnred->7)
				done = true;
			if (done)
				break;

			! Ignore ply numbers.
			if (pgn_token->1 < '0' || pgn_token->1 > '9') {

				! Send the token to MSCP; it should be a move.
				mscp_execute (MSCP_EXEC_FORCE);
				status = mscp_execute (MSCP_EXEC_MOVE,
								pgn_token);

				! End loading if move is invalid.
				if (~~status) {
					done = true;
					break;
				}
			}

			! Advance to the next token.
			i = tend;
			while (i < chars && str->i == ' ') i++;
		}
		if (done)
			break;
	}
	refresh_model ();

	! Set player to be the one to move next.
	player_white =   whites_move;
	invert_board = ~~whites_move;

	glk_stream_close (load_fd, GLK_NULL);
	return status;
];


!  /*----------------------------------------------------------------------+
!   |      Controller                                                      |
!   +----------------------------------------------------------------------*/

! Create a longer timeout with shorter ones.
Global	delay_remaining	= 0;

! Test for mouse event inside the board.
[ test_board event
	grid x y mx my;
#Ifdef DEBUG;
	print "GLKBOARD> test_board ", event, "^";
#Endif;

	! Obtain grid size.
	grid = image_width (WHITE_SQUARE);

	! Test if event inside board.
	x = event-->2;
	y = event-->3;
	if (x < board_coords-->0 || x > board_coords-->0 + 8 * grid
		|| y < board_coords-->1 || y > board_coords-->1 + 8 * grid)
		return NO_SQUARE;

	! Translate click x,y into board locations.
	mx = (x - board_coords-->0) / grid;
	my = (y - board_coords-->1) / grid;

	! Return square, translated for orientation.
	if (~~invert_board)
		return (     (my * 8 + mx));
	else
		return (63 - (my * 8 + mx));
];


! Return true if x,y are inside an image.
[ xy_inside x y pic coords;

	! Return true if inside.
	return (x >= coords-->0 && x < coords-->0 + image_width (pic)
		    && y >= coords-->1 && y < coords-->1 + image_height (pic));
];


! Test for mouse event on the controls.
[ test_controls event
	x y width;
#Ifdef DEBUG;
	print "GLKBOARD> test_controls ", event, "^";
#Endif;

	! Get event coords.
	x = event-->2;
	y = event-->3;

	! Test busy, return upbutton if pressed.
	if (xy_inside (x, y, BUSY_UP_BUTTON, busy_coords))
		return BUSY_UP_BUTTON;

	! Test undo, return upbutton if pressed.
	if (xy_inside (x, y, UNDO_UP_BUTTON, undo_coords))
		return UNDO_UP_BUTTON;

	! Test save and load, return upbutton if pressed.
	if (xy_inside (x, y, SAVE_UP_BUTTON, save_coords))
		return SAVE_UP_BUTTON;
	if (xy_inside (x, y, LOAD_UP_BUTTON, load_coords))
		return LOAD_UP_BUTTON;

	! Test new, return upbutton if pressed.
	if (xy_inside (x, y, NEW_UP_BUTTON, new_coords))
		return NEW_UP_BUTTON;

	! Test quit, return upbutton if pressed.
	if (xy_inside (x, y, QUIT_UP_BUTTON, quit_coords))
		return QUIT_UP_BUTTON;

	! Test color, return white or black button if pressed.
	if (xy_inside (x, y, WHITE_BUTTON, color_coords)) {
		width = image_width (WHITE_BUTTON);
		if (x - color_coords-->0 < width / 2)	! White/black half?
			return WHITE_BUTTON;
		else
			return BLACK_BUTTON;
	}

	! Test level, return the relevant level button if pressed.
	if (xy_inside (x, y, LEVEL_BUTTON, level_coords)) {
		width = image_width (LEVEL_BUTTON);
		return (LEVEL_BUTTON + ((x - level_coords-->0) / (width / 8)));
	}

	return NO_BUTTON;
];


! Handle a timer event.
[ handle_timer_event window
	retcode;
#Ifdef DEBUG;
	print "GLKBOARD> handle_timer_event ", window, "^";
#Endif;

	retcode = false;

	! Reduce remaining delay, continue waiting if not zero.
	if (delay_remaining > 0) {
		delay_remaining = delay_remaining - TIMEOUT;
		return retcode;
	}

	! Complete button press action(s).
	if (undo_pressed) {
		mscp_execute (MSCP_EXEC_UNDO);
		refresh_model ();
		if (player_white ~= whites_move) {
			mscp_execute (MSCP_EXEC_UNDO);
			refresh_model ();
		}

		player_white =   whites_move;
		invert_board = ~~whites_move;

		undo_pressed = false;
		retcode = true;
	}

	if (new_pressed) {
		mscp_execute (MSCP_EXEC_NEW_GAME);
		mscp_execute (MSCP_EXEC_FORCE);
		refresh_model ();

		base_fen->0 = 0;

		player_white = true;
		invert_board = false;

		highlight_from	= NO_SQUARE;
		highlight_to	= NO_SQUARE;

		new_pressed = false;
		retcode = true;
	}

	if (quit_pressed) {
		running = false;

		quit_pressed = false;
		retcode = true;
	}

	if (save_pressed) {
		save_game_backend (true, window);
		saving_game = false;
		save_pressed = false;
		retcode = true;
	}

	if (loading_failed) {
		loading_failed = false;
		retcode = true;
	}
	if (load_pressed) {
		if (~~(load_game_backend (window))) {
			loading_failed = true;
			glk_request_timer_events (MESSAGE_TIMEOUT);
		}
		loading_game = false;
		load_pressed = false;
		retcode = true;
	}

	if (~~loading_failed)
		glk_request_timer_events (0);

	return retcode;
];


! Handle a mouse event while the engine is busy.
[ handle_busy_mouse_event event
	button;
#Ifdef DEBUG;
	print "GLKBOARD> handle_busy_mouse_event ", event, "^";
#Endif;

	! Look only for busy button presses.
	button = test_controls (event);
	if (button == BUSY_UP_BUTTON) {
		busy_pressed = true;
		return true;
	}
	return false;
];


Array	player_move_buf	-> 7;

! Handle a mouse event while the engine is idle.
[ handle_idle_mouse_event event
	button timer square frsq tosq buf retcode;
#Ifdef DEBUG;
	print "GLKBOARD> handle_mouse_event ", event, "^";
#Endif;

	! Handle button presses, excepting busy.
	button = test_controls (event);
	if (button ~= NO_BUTTON) {
		timer = false;
		if (button >= LEVEL_BUTTON && button <= LEVEL_BUTTON + 7) {
			mscp_execute (MSCP_EXEC_SET_DEPTH,
						button - LEVEL_BUTTON + 1);
			refresh_model ();
		} else {
			switch (button) {
			WHITE_BUTTON:
				player_white = true;
				invert_board = false;
			BLACK_BUTTON:
				player_white = false;
				invert_board = true;
			UNDO_UP_BUTTON:
				undo_pressed = true;
				timer = true;
			SAVE_UP_BUTTON:
				if (~~save_pressed) {
					if (save_game_frontend (PGN_SAVEFILE)) {
						save_pressed = true;
						saving_game = true;
						timer = true;
					}
				}
			LOAD_UP_BUTTON:
				if (~~load_pressed) {
					if (save_game_frontend (PGN_BACKUPFILE))
						save_game_backend (false,
								GLK_NULL);
					if (load_game_frontend (PGN_SAVEFILE)) {
						load_pressed = true;
						loading_game = true;
						timer = true;
					}
				}
			NEW_UP_BUTTON:
				if (save_game_frontend (PGN_BACKUPFILE))
					save_game_backend (false, GLK_NULL);
				new_pressed = true;
				timer = true;
			QUIT_UP_BUTTON:
				if (save_game_frontend (PGN_BACKUPFILE))
					save_game_backend (false, GLK_NULL);
				quit_pressed = true;
				timer = true;
			}
		}
		if (timer) {
			delay_remaining = GUI_TIMEOUT - TIMEOUT;
			glk_request_timer_events (TIMEOUT);
		}
		loading_failed = false;
		return true;
	}

	! Handle board actions.
	square = test_board (event);
	if (square ~= NO_SQUARE) {

		! Remove any highlighting remaining from last move.
		if (highlight_from ~= NO_SQUARE && highlight_to ~= NO_SQUARE) {
			highlight_from	= NO_SQUARE;
			highlight_to	= NO_SQUARE;
		}

		! First square action?
		if (highlight_from == NO_SQUARE) {
			if (player_white) {
				switch (board->square) {
				'K','Q','R','B','N','P':
					highlight_from = square;
				}
			} else {
				switch (board->square) {
				'k','q','r','b','n','p':
					highlight_from = square;
				}
			}
		}

		! Reclick on square already selected?
		else if (highlight_from == square)
			highlight_from = NO_SQUARE;

		! Click on a second square? -- move attempt.
		else {
			! Try this move.
			frsq = highlight_from; tosq = square;
			buf = player_move_buf;
			buf->1 = frsq % 8 + 'a'; buf->2 = 7 - frsq / 8 + '1';
			buf->3 = tosq % 8 + 'a'; buf->4 = 7 - tosq / 8 + '1';
			buf->0 = 4;

			! Add pawn promotion.  TODO allow promotion choice.
			if ((board->frsq == 'P' && buf->4 == '8')
				    || (board->frsq == 'p' && buf->4 == '1')) {
				buf->5 = '=';
				buf->6 = 'Q';
				buf->0 = 6;
			}

			! Pass the move to MSCP, with force for no return move
			! until we're ready.	
			mscp_execute (MSCP_EXEC_FORCE);
			retcode = mscp_execute (MSCP_EXEC_MOVE, buf);
			if (retcode)
				highlight_to = square;
		}

		! Either update for the successful move, or reinstate
		! highlighting, if unsuccessful, for the last move.
		refresh_model ();

		loading_failed = false;
		return true;
	}
	return false;
];


!  /*----------------------------------------------------------------------+
!   |      Event loop                                                      |
!   +----------------------------------------------------------------------*/

! General event buffer.
Array	event_buffer		--> 4;

! Handle a single Glk event -- central event handler for the main loop.
[ handle_event event window;
#Ifdef DEBUG;
	print "GLKBOARD> handle_event ", event, ", ", window, " [",
	event-->0, " ", event-->1, " ", event-->2, " ", event-->3, "]^";
#Endif;

	! Handle event based on type.
	switch (event-->0) {
	evtype_MouseInput:
		if (~~engine_busy) {
			if (handle_idle_mouse_event (event))
				repaint (window, false);
		} else {
			if (handle_busy_mouse_event (event))
				repaint (window, false);
		}
		glk_request_mouse_event (window);

	evtype_Timer:
		if (~~engine_busy) {
			if (handle_timer_event (window))
				repaint (window, false);
		}

	evtype_Redraw,
	evtype_Arrange:
		repaint (window, true);
	}
];


! Poll for busy presses, handle pending arrange and redraw events, flush
! pending output, generally keep the GUI alive while the engine is busy.
[ busy_callback_keepalive window;
#Ifdef DEBUG;
	print "GLKBOARD> busy_callback_keepalive ", window, "^";
#Endif;

	! Call glk_select() with a short timeout, to pick up and handle any
	! pending mouse or arrange/redraw events, and to refresh the display.
	glk_request_timer_events (TIMEOUT);
	do {
		glk_select (event_buffer);
		handle_event (event_buffer, window);
	} until (event_buffer-->0 == evtype_Timer);
	glk_request_timer_events (0);
];


! Chess engine busy callback function, called with high frequency from
! the inner chess engine loops.
[ busy_callback window;

	! Call Glk keepalive.
	glk_tick ();

	! Poll for a timeout event.  This tells us that it's time to call
	! the GUI keepalive function.
	glk_select_poll (event_buffer);
	if (event_buffer-->0 ~= evtype_None) {
#Ifdef DEBUG;
		print "GLKBOARD> busy_callback [event] ", window, "^";
#Endif;

		! Intercept timer events, handle any others normally
		! (though no other types expected).
		switch (event_buffer-->0) {
		evtype_Timer:
			busy_callback_keepalive (window);
			glk_request_timer_events (REFRESH_TIMEOUT);

		default:
			handle_event (event_buffer, window);
		}
	}

	! If busy pressed, return false to encourage speedy return.
	return ~~busy_pressed;
];


! Event dispatch loop.
[ event_loop window;
#Ifdef DEBUG;
	print "GLKBOARD> event_loop ", window, "^";
#Endif;

	! Initial display and mouse event request.
	refresh_model ();
	repaint (window, true);
	glk_request_mouse_event (window);

	! Loop until quit requested.
	while (running) {

		! Catch and handle pending event.
		glk_select (event_buffer);
		handle_event (event_buffer, window);

		! See if a computer move is required.
		if ((whites_move == ~~player_white)
				&& available_moves > 0 && halfmoves < 50) {

			! Note engine as busy, and repaint.
			engine_busy = true;
			busy_pressed = false;
			repaint (window, false);

			! Force an immediate screen update.
			busy_callback_keepalive (window);

			! Tick over on refresh timeout, then start engine.
			glk_request_timer_events (REFRESH_TIMEOUT);
			mscp_execute (MSCP_EXEC_GO, 0, 0, 0,
						busy_callback, window);
			mscp_execute (MSCP_EXEC_FORCE);
			refresh_model ();

			! Move made -- unset busy flag and repaint.
			engine_busy = false;
			busy_pressed = false;
			repaint (window, false);

			glk_request_timer_events (0);
		}
	}

	glk_cancel_mouse_event (window);
	glk_request_timer_events (0);
];


!  /*----------------------------------------------------------------------+
!   |      GUI intro                                                       |
!   +----------------------------------------------------------------------*/

! General event buffer.
Array	intro_event_buffer	--> 4;

Array	glk_intro_arg_w		--> 1;
Array	glk_intro_arg_h		--> 1;

! Display an intro screen.
[ intro_screen window
	width height align tx ty gx gy cx cy;
#Ifdef DEBUG;
	print "GLKBOARD> intro_screen ", window, "^";
#Endif;

	! Find the window dimensions.
	glk_window_get_size (window, glk_intro_arg_w, glk_intro_arg_h);
	width = glk_intro_arg_w-->0;
	height = glk_intro_arg_h-->0;

	! Determine positioning of GUI elements.
	align = image_width (WHITE_SQUARE);

	! Obtain the top left of the paint area.
	tx = (width / 2 - align * 9) / 2;
	if (tx < 0)
		tx = 0;
	ty = (height - align * 10 - image_height (GLKCHESS_LOGO)) / 2;
	if (ty < 0)
		ty = 0;

	! Position the license centered in the remaining space.
	gx = tx + (width / 2 + align * 7 - image_width (GLKCHESS_GPL)) / 2;
	if (gx < 0)
		gx = 0;
	gy = ty + align * 3;

	! Position the click message below, or above if no space.
	cx = tx + width / 2 + align * 8 - image_width (CLICK_MESSAGE);
	cy = ty + 11 * align - image_height (CLICK_MESSAGE);
	if (cy + image_height (CLICK_MESSAGE) > height) {
		cx = tx + align;
		cy = ty + image_height (GLKCHESS_LOGO);
	}

	! Clear the window, then draw top banner.
	glk_window_clear (window);
	draw_banner (window, tx + align, ty, width / 2 + align * 7);

	! Display license information and click message .
	glk_image_draw (window, GLKCHESS_GPL, gx + align, gy);
	glk_image_draw (window, CLICK_MESSAGE, cx, cy);
];


! Introductory screen loop.
[ intro_loop window;
#Ifdef DEBUG;
	print "GLKBOARD> intro_loop ", window, "^";
#Endif;

	! Initial display and mouse event request.
	intro_screen (window);
	glk_request_mouse_event (window);

	! Wait for a mouse press, redisplaying the intro as required.
	while (true) {

		! Catch and handle redraw and arrange events.
		glk_select (intro_event_buffer);
		if (intro_event_buffer-->0 == evtype_Redraw
				|| intro_event_buffer-->0 == evtype_Arrange)
			intro_screen (window);

		! Terminate on mouse press.
		if (intro_event_buffer-->0 == evtype_MouseInput)
			break;
	}
];


!  /*----------------------------------------------------------------------+
!   |      GUI main                                                        |
!   +----------------------------------------------------------------------*/

! GUI main program.
[ GUI_main
	window text; text = 0;

	! Open a single graphics window.
	window = glk_window_open (GLK_NULL, 0, 0, wintype_Graphics, 1);
	if (window == GLK_NULL)
		quit;
	glk_window_set_background_color (window, BACKGROUND_COLOR);

#Ifdef DEBUG;
	! For debugging, open a lower text window.
	text = glk_window_open (window,
			winmethod_Below | winmethod_Proportional, 20,
			wintype_TextBuffer, 2);
	glk_set_window (text);
#Endif;

	! Do introduction, then handle everything through the event loop.
	intro_loop (window);
	event_loop (window);
];


!  /*----------------------------------------------------------------------+
!   |      Non-GUI alternative interface                                   |
!   +----------------------------------------------------------------------*/

! User input line, and read event buffer.
Array	user_input_line		-> 256;
Array	read_event_buffer	--> 4;

! Explain missing interpreter features.
[ explain_missing;

	print "Your interpreter lacks one or more features needed for a";
	print " graphical interface^";
	print "(graphics ";
	if (glk_gestalt (gestalt_Graphics, 0))
				print "OKAY"; else print "MISSING";
	print "; mouse input ";
	if (glk_gestalt (gestalt_MouseInput, wintype_Graphics))
				print "OKAY"; else print "MISSING";
	print "; image drawing ";
	if (glk_gestalt (gestalt_DrawImage, wintype_Graphics))
				print "OKAY"; else print "MISSING";
	print "; timers ";
	if (glk_gestalt (gestalt_Timer, 0))
				print "OKAY"; else print "MISSING";
	print ").^For this interpreter, GlkChess will use the ~Xboard~";
	print " character interface.^";
];


! Read a line from the given window
[ readline window;

	! Request line, passing user_input_line->1 address
	glk_request_line_event (window, user_input_line + 1, 255, 0);

	! Wait for line input event
	do {
		glk_select (read_event_buffer);
	} until (read_event_buffer-->0 == evtype_LineInput);

	! Set data length, and return
	user_input_line->0 = read_event_buffer-->2;
	return user_input_line;
];


! Busy callback, just calls glk_tick and returns.  We can't pass glk_tick
! directly as the callback function because it returns 0 (false).
[ callback;
	glk_tick ();
	return true;
];


! Non-GUI main program.
[ non_GUI_main
	window line retcode;

	! Open a window, and use only fixed fonts
	window = glk_window_open (GLK_NULL, 0, 0, wintype_TextBuffer, 1);
	if (window == GLK_NULL)
		quit;
	glk_set_window (window);
	glk_set_style (style_Preformatted);

	! Explain why we are here.
	explain_missing ();

	! Xboard processing loop
	mscp_xboard ();
	do {
		line = readline (window);
		retcode = mscp_xboard (line, callback);
	} until (retcode == -1);
];


!  /*----------------------------------------------------------------------+
!   |      Main                                                            |
!   +----------------------------------------------------------------------*/

! Main program.
[ Main;

	! Set Glk as the I/O system.
	@setiosys 2 0;

	! Select interface dependent on interpreter capability.
	if (glk_gestalt (gestalt_Graphics, 0)
			&& glk_gestalt (gestalt_MouseInput, wintype_Graphics)
			&& glk_gestalt (gestalt_DrawImage, wintype_Graphics)
			&& glk_gestalt (gestalt_Timer, 0))
		GUI_main ();
	else
		non_GUI_main ();
];


!  /*----------------------------------------------------------------------+
!   |                                                                      |
!   +----------------------------------------------------------------------*/

#Endif;