/*
 * FontTable.fw
 *
 * USAGE: FontTable.fw
 *
 * Print a table containing each character for the current font. First
 * release for FinalWriter.
 *
 * HISTORY:
 * v1.01	add the possibility of saving user's settings
 *
 * v1.02	bug fixed for table's title
 *
 * $(C): (1994, Rocco Coluccelli, Bologna)
 * $VER: FontTable.fw 1.02 (22.Oct.1994)
 */

OPTIONS RESULTS


PARSE ARG oleargv
PARSE VALUE GETCLIP(oleargv) WITH module box.left box.top char.w char.h server olectrl remote . userport locale .

	rowgap = 30; colgap = 50
	font.lsize = 10; font.tsize = 12

IF ~SHOW('C',config) THEN DO
	font.label = 'SoftSans'
	font.table = ''
	END

ELSE
	PARSE VALUE GETCLIP(config) WITH font.label','font.table','


ADDRESS VALUE userport

SetMeasure 'MICROPOINTS'
View 50

Status 'FontPath'
fontpath = LEFT(result,LASTPOS('/',result))

CALL GetSelectedFont(font.label)
CALL GetSelectedFont(font.table)

ADDRESS VALUE olectrl

IF OPENPORT(remote) == NULL() THEN DO
	REQASK 0 'þERR_PORT,'remote
	QUIT
	EXIT 10
	END

elab = 1
st = GUIGads()
DO UNTIL st = 'end'

	CALL WAITPKT(remote)
	pkt = GETPKT(remote)

	IF pkt == NULL() THEN ITERATE

	PARSE VALUE GETARG(pkt) WITH cmd argv .

	SELECT

		WHEN cmd = 'FONT' THEN DO
			PARSE VALUE GETARG(pkt,1) WITH n0 .
			str = GETARG(pkt,2)

			IF str = '' THEN str = GetSelectedFont()

			font.argv = str
			g_str.n0 = str
			CALL Gadgets(2,n0)
			CALL SETCLIP(config,font.label','font.table',')
		END

		WHEN cmd = 'HELP' THEN
			REQASK module 'þHELP' || st

		WHEN cmd = 'START' THEN
			st = 'end'

		WHEN cmd = 'QUIT' THEN DO
			st = 'end'
			elab = 0
		END

		OTHERWISE NOP

	END

	CALL REPLY(pkt,0)
END

CALL CLOSEPORT(remote)

IF ~ elab THEN EXIT 0

title = GetLocale('S1') font.table GetLocale('S2') font.tsize

SETSTATUS 'end'

/*
 * redirect commands to FinalWriter
 */
ADDRESS VALUE userport

/*
 * Get the max dimension for the table
 */
GetPageSetup 'Width' 'Height'
PARSE VAR result maxwidth maxheight .

/*
 * Get the actual page number
 */
Status 'Page'
page = result

/*
 *	Get labels and blanks width
 */
TextBlockTypePrefs "Size" font.lsize "Font" fontpath || font.label

DrawTextBlock page 0 0 "000"
tabletitle = result
GetObjectCoords result
PARSE VAR result . . . labelwidth .

SetTextBlockText tabletitle title


fonth = font.tsize * 10
DO i = 0 TO 31
	y.i = i * (fonth + rowgap)
END

x = 0
DO j = 0 TO 7

	TextBlockTypePrefs "Size" font.lsize "Font" fontpath || font.label
	x = x + labelwidth + colgap
	DO i = 0 TO 31
		c.i = j + i * 8
		DrawTextBlock page x y.i c.i
		label.i.j = result
		c.i = '"'D2C(c.i)'"'
	END

	IF j = 0 THEN
		c.0 = '01'x
	ELSE IF j = 2 THEN DO
		c.1 = '01'x
		c.5 = '2a'x
		END

	TextBlockTypePrefs "Size" font.tsize "Font" fontpath || font.table
	x = x + labelwidth + colgap
	DO i = 0 TO 31
		DrawTextBlock page x y.i c.i
		table.i.j = result
	END

END

tablewidth  = x + labelwidth + colgap
tableheight = 32 * (fonth + rowgap)

/*
 * Group all objects
 */
SelectObject 0
DO j = 0 TO 7

	DO i = 0 TO 31
		SelectObject label.i.j 'MULTIPLE'
		SelectObject table.i.j 'MULTIPLE'
	END

END

x = (maxwidth - tablewidth) % 2
y = (maxheight - tableheight) % 2
Group
CurrentObject
SetObjectCoords result page x y tablewidth tableheight

y = y - fonth - 2 * rowgap
GetObjectCoords tabletitle
PARSE VAR result . . . wid .
SetObjectCoords tabletitle page x y wid fonth

Redraw

EXIT 0


GetSelectedFont:
PARSE ARG str

	ADDRESS VALUE userport
	IF str ~= '' THEN Font fontpath || str
	Type '  '
	Cursor 'LEFT'
	Status 'FontName'
	str = result
	Delete
	BackSpace
	ADDRESS

RETURN str

GetLocale: PROCEDURE EXPOSE locale
ARG strID

	strID = 'þ'strID'þ'; PARSE VALUE GETCLIP(locale) WITH (strID)text'Þ'

RETURN text


GUIGads:

	g_offx. = 2;	g_offx.1 = 0;			g_offx.3 = 2
	g_offy. = 2;	g_offy.1 = char.h + 1;	g_offy.3 = 3
	g_wid. = 8;				g_wid.1 = 0;			g_wid.3 = 12
	g_hei. = char.h + 4;	g_hei.1 = char.h + 1;	g_hei.3 = char.h + 6
	g_sx = char.w % 2;	g_sy = char.h % 4

	box.left = box.left + g_sx; box.top = box.top + 2 * g_sy
	box.w = 36 * char.w

	n = 1
	nmain = 1

	x = box.left; y = box.top
	CALL IniGad(2,1,0,'FONT LABEL%1' n + 1,GetLocale('S3'))
	CALL IniGad(3,0,1,'FONT LABEL%1' n '%2%g',font.label)
	y = y + g_hei.3 + 2 * g_sy
	CALL IniGad(2,1,0,'FONT TABLE%1' n + 1,GetLocale('4'))
	CALL IniGad(3,0,1,'FONT TABLE%1' n '%2%g',font.table)

	y = y + g_hei.3 + 2 * g_sy
	CALL IniGad(2,1,0,'START',GetLocale('5'))
	g_gads = IniGad(2,3,0,'HELP',GetLocale('6'))

	box.h = y + g_hei.2 + 2 * g_sy - box.top

	WINDOW module (box.w + 2 * g_sx) (box.h + 2 * g_sy) 0 0
	CALL Gadgets(4,1,g_gads)

RETURN nmain


Gadgets:

	IF ARG(1) < 4 THEN
		DO i = 2 TO ARG(); n = ARG(i)
			IF ARG(1) ~= 1 THEN CALL DelGad(n,g_type.n)
			IF ARG(1) ~= 3 THEN CALL NewGad(n,g_type.n)
		END

	ELSE IF ARG(1) < 7 THEN
		DO n = ARG(2) TO ARG(3)
			IF ARG(1) ~= 4 THEN CALL DelGad(n,g_type.n)
			IF ARG(1) ~= 6 THEN CALL NewGad(n,g_type.n)
		END

	ELSE DO
		DO n = ARG(2) TO ARG(3)
			IF g_type.n ~= 1 THEN CALL RemoveGadget(server,GAD.n)
		END
		CALL SetAPen(server,0)
		CALL RectFill(server,box.left,box.top,box.left + box.w,box.top + box.h)
		CALL RefreshGadgets(server)
		END
RETURN


DelGad:
PARSE ARG n,t

	IF t ~= 1 THEN CALL RemoveGadget(server,GAD.n)

	x = g_xpos.n - g_offx.t; y = g_ypos.n - g_offy.t
	CALL SetAPen(server,0)
	CALL RectFill(server,x,y,x + g_len.n,y + g_hei.t)

RETURN


NewGad:
PARSE ARG n,t

	IF t = 2 THEN
		CALL AddGadGet(server,g_xpos.n,g_ypos.n,GAD.n,g_str.n,g_msg.n)

	ELSE IF t = 3 THEN
		CALL AddGadGet(server,g_xpos.n,g_ypos.n,GAD.n,g_str.n,g_msg.n,g_len.n - 4,"RIDGEBORDER")

	ELSE IF t = 4 THEN
		CALL AddGadGet(server,g_xpos.n,g_ypos.n,GAD.n,D2C(32 + g_str.n * 183),g_msg.n)

	ELSE DO
		CALL SetAPen(server,1)
		CALL Move(server,g_xpos.n,g_ypos.n)
		CALL Text(server,g_str.n)
		END
RETURN


IniGad:
PARSE ARG t,na,nx,g_msg.n,g_str.n,var

	x = x + nx * g_sx

	IF t = 3 & var > 0 THEN
		g_len.n = var * char.w + g_wid.t
	ELSE IF t = 3 THEN
		g_len.n = box.left + box.w - x
	ELSE
		g_len.n = LENGTH(g_str.n) * char.w + g_wid.t

	IF na > 0 THEN x = box.left + (na - 1) * (box.w - g_len.n) % 2 + nx * g_sx

	g_xpos.n = x + g_offx.t; g_ypos.n = y + g_offy.t; g_type.n = t
	x = x + g_len.n
	n = n + 1

	IF t = 4 THEN CALL IniGad(1,0,1,,var)

RETURN n - 1