/*
 * DrawTable.fw
 *
 * USAGE: DrawTable.fw(ArgObject)
 *
 * The second module of my OLE system. This take the description of a
 * table placed in the ClipList and draw a table into FinalWriter. The
 * second important function implemented is to write all those information
 * necessary to update the imported table later.
 *
 * TODO: columns at the same size
 *
 * HISTORY:
 * v1.01	Drop the PIPE: before quit
 *
 *
 * $(C): (1994, Rocco Coluccelli, Bologna)
 * $VER: DrawTable.fw 1.01 (21.Oct.1994)
 */

OPTIONS RESULTS

/*
 *	Read the startup clip
 *	start point for gadgets, font dimension, commands ports, ...
 */
PARSE ARG oleargv
PARSE VALUE GETCLIP(oleargv) WITH module box.left box.top char.w char.h server olectrl remote . userport locale config oleobj .

	fwobold.    = 100
	fwoitalic.  = 0

IF ~SHOW('C',config) THEN DO
	rowgap = 15; colgap = 35; measure = 2
	fwobold.1   = 130
	fwoitalic.1 = 2
	pref.box  = 1
	pref.line = 1
	pref.link = 0
	END

ELSE
	PARSE VALUE GETCLIP(config) WITH rowgap','colgap','measure','fwobold.1','fwoitalic.1','pref.box','pref.line','pref.link','

	ms.1 = 1;			ms.type.1 = GetLocale('S1')
	ms.2 = 0.035278;	ms.type.2 = GetLocale('S2')
	ms.3 = 0.001389;	ms.type.3 = GetLocale('S3')

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
	PARSE VALUE GETARG(pkt,1) WITH n0 .

	SELECT

		WHEN cmd = 'GAP' THEN DO
			gap = GETARG(pkt,2)

			IF gap < 0 THEN gap = 0
			gap = gap % ms.measure

			IF argv = 'COLS' THEN
				colgap = gap
			ELSE
				rowgap = gap

			g_str.n0 = gap * ms.measure
		END

		WHEN cmd = 'PREFS' THEN DO
			PARSE VAR argv cmd .

			pref.cmd = ~pref.cmd
			g_str.n0 = pref.cmd
		END

		WHEN cmd = 'MEASURE' THEN DO
			PARSE VALUE GETARG(pkt,2) WITH n1 n2 .

			measure = measure + 1; IF measure > 3 THEN measure = 1

			g_str.n0 = ms.type.measure
			g_str.n1 = colgap * ms.measure; g_str.n2 = rowgap * ms.measure
			CALL Gadgets(2,n1,n2)
		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

	IF n0 ~= '' THEN DO
		CALL Gadgets(2,n0)
		CALL SETCLIP(config,rowgap','colgap','measure','fwobold.1','fwoitalic.1','pref.box','pref.line','pref.link',')
		END

	CALL REPLY(pkt,0)

END

CALL CLOSEPORT(remote)

IF ~OPEN(pip,'PIPE:' || oleobj,'R') THEN DO
	SETSTATUS 'end'
	EXIT 0
	END

/*
 *	Drop the PIPE: if we are going to quit
 */
IF ~ elab THEN DO
	DO UNTIL EOF(pip)
		READCH(pip,20000)
	END
	EXIT 0
	END

CALL Gadgets(7,1,g_gads)

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

SetMeasure 'MICROPOINTS'
View 50

/*
 * Get the actual page number and the font path
 */
Status 'Page'
page = result
Status 'FontPath'
fontpath = LEFT(result,LASTPOS('/',result))

/*
 * Get the max dimension for the table
 */
GetPageSetup 'Width' 'Height' 'Top' 'Bottom' 'Left' 'Right'
PARSE VAR result maxwidth maxheight top bottom left right .

maxwidth  = (maxwidth - left - right)
maxheight = (maxheight - top - bottom)

/*
 * Get the user preferences over lines and boxes
 * Draw a box around the table
 */
IF pref.line THEN LinePrefs 'PROMPT'
IF pref.box  THEN BoxPrefs  'PROMPT'

DrawBox page left top maxwidth maxheight
line.0 = result

/*
 * get spreadname and ranges
 *
 * TODO: write these information into the linkfile
 */
spreadname = READLN(pip)
ranges = READLN(pip)

/*
 * Table of font equivalents
 */
fwofont.        = fontpath || 'SoftSans'
fwofont.SYMBOL  = fontpath || 'Symbol'
fwofont.COURIER = fontpath || 'Courier'
fwofont.TIMES   = fontpath || 'SoftSerif'

bold.    = ''
bold.1   = 'Bold'
italic.  = ''
italic.1 = 'Italic'

palette. = 'Black'

colborder. = 0
rowborder. = 0
height.	= 0
width.	= 0
cell. = 0

PARSE VALUE READLN(pip) WITH rows cols .

/*
 * Read data from the clip, draw all cell excluding empty cells.
 * Find the dimension of each row and column and calculate how
 * large will be the table to fit page.
 *
 * HEADER:
 * spreadfile
 * ranges
 * rows cols
 *
 * DATAS:
 * row col align bold italic underline color len 'þ'text'Þ' 'þ'font'Þ' size lleft lright lup ldown
 *
 * (row col) of the cell, (len) length in chars of (text)
 * (align) aligned with (bold italic underline) style
 * typed in (color) with (font) of (size)
 * with borders (lineleft lineright lineup linedown)
 */
DO FOREVER

	PARSE VALUE READLN(pip) WITH i j align.i.j bo it under.i.j . . 'þ'text'Þ' 'þ'font'Þ' size lleft lright lup ldown .

	IF i = '' THEN LEAVE

	fwofont = fwofont.font
	font = fwofont || '_' || bold.bo || italic.it

	IF EXISTS(font) THEN
		TextBlockTypePrefs "Size" size "Color" palette.0 "Font" font
	ELSE
		TextBlockTypePrefs "Size" size "Width" fwobold.bo "Oblique" fwoitalic.it "Color" palette.0 "Font" fwofont

	DrawTextBlock page left top '"'text'"'
	cell.i.j = result

	GetObjectCoords result
	PARSE VAR result . . . width.i.j height.i.j .

	height.i = MAX(height.i,height.i.j)
	width.j  = MAX(width.j,width.i.j)

	IF lleft THEN colborder.i.j = 1
	IF lup THEN rowborder.i.j = 1
	IF lright THEN INTERPRET 'colborder.'i'.'j + 1' = 1'
	IF ldown THEN INTERPRET 'rowborder.'i + 1'.'j' = 1'
END

CALL CLOSE(pip)


/*
 * calculate the position of rows and columns
 * centering the table in the current page
 */
col.1 = left
DO j = 2 TO cols + 1
	i = j - 1
	col.j = col.i + width.i + 2 * colgap
END

row.1 = top
DO i = 2 TO rows + 1
	j = i - 1
	row.i = row.j + height.j + 2 * rowgap
END


/*
 * move each cell to its correct position
 *
 * fix vertical and horizontal alignement
 * draw the "underline"
 */
n = 0
DO j = 1 TO cols
	DO i = 1 TO rows

		IF cell.i.j ~= 0 THEN DO

			top = row.i + height.i - height.i.j

			SELECT
				WHEN align.i.j = '010' THEN
					left = col.j + width.j - width.i.j
				WHEN align.i.j = '001' THEN
					left = col.j + (width.j - width.i.j) % 2
				OTHERWISE
					left = col.j
			END

			SetObjectCoords cell.i.j page left top width.i.j height.i.j

			IF under.i.j THEN DO
				n = n + 1
				top = top + 5 * height.i.j % 6
				DrawLine page left top (left + width.i.j) top
				line.n = result
				END
		END

	END
END

Redraw


/*
 * calculate table's dimension to redraw the box
 */
boxwidth = col.j - col.1
boxheight = row.i - row.1

top = row.1 - rowgap
bottom = row.i - rowgap
left = col.1 - colgap
right  = col.j - colgap

SetObjectCoords line.0 page left top boxwidth boxheight

/*
 * draw borders around cells
 */
DO j = 1 TO cols + 1

	left = col.j - colgap
	DO i = 1 TO rows + 1

		DO WHILE ~colborder.i.j
			IF i > rows THEN ITERATE j
			i = i + 1
			END

		top = row.i - rowgap
		DO WHILE colborder.i.j & i <= rows
			i = i + 1
			END

		n = n + 1
		DrawLine page left top left (row.i - rowgap)
		line.n = result
	END

END

DO i = 1 TO rows + 1

	top = row.i - rowgap
	DO j = 1 TO cols + 1

		DO WHILE ~rowborder.i.j
			IF j > cols THEN ITERATE i
			j = j + 1
			END

		left = col.j - colgap
		DO WHILE rowborder.i.j & j <= cols
			j = j + 1
			END

		n = n + 1
		DrawLine page left top (col.j - colgap) top
		line.n = result
	END

END

lines = n

Redraw

/*
 * Group all lines
 */
SelectObject 0
DO n = 1 TO lines
	SelectObject line.n 'MULTIPLE'
END

Group
CurrentObject
lines = result

/*
 * Group all cells
 */
SelectObject 0
DO j = 1 TO cols
	DO i = 1 TO rows
		IF cell.i.j ~= 0 THEN SelectObject cell.i.j 'MULTIPLE'
	END
END

Group
CurrentObject
cells = result

/*
 * Group all object with box
 */
SelectObject line.0
SelectObject cells 'MULTIPLE'

IF lines > 0 THEN
	SelectObject lines 'MULTIPLE'

Group
CurrentObject
table = result

/*
 * check if table fit page
 */
n = boxwidth / boxheight
IF boxwidth > maxwidth THEN DO
	boxwidth = maxwidth
	boxheight = maxwidth % n
	END

IF boxheight > maxheight THEN DO
	boxheight = maxheight
	boxwidth = maxheight * n
	END

left = col.1 + (maxwidth - boxwidth) % 2
top = row.1 + (maxheight - boxheight) % 2

SetObjectCoords table page left top boxwidth boxheight

Redraw

ADDRESS VALUE olectrl
SETSTATUS (module + 1)

EXIT 0



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

	n1.nmain = n
	x = box.left; y = box.top
	n1 = IniGad(3,1,0,'GAP COLS %1' n '%2%g',colgap * ms.measure,8)
	CALL IniGad(1,0,1,,GetLocale('S4'))
	y = y + g_hei.3 + 2 * g_sy
	n2 = IniGad(3,1,0,'GAP ROWS %1' n '%2%g',rowgap * ms.measure,8)
	CALL IniGad(1,0,1,,GetLocale('S5'))
	y = y + g_hei.3 + 2 * g_sy
	CALL IniGad(2,1,0,'MEASURE %1' n + 1 '%2' n1 n2,GetLocale('S6'))
	CALL IniGad(1,0,1,,ms.type.measure)
	y = y + g_hei.3 + 2 * g_sy
	CALL IniGad(4,1,0,'PREFS BOX%1' n,pref.box,GetLocale('S7'))
	x = box.left + box.w % 2
	CALL IniGad(4,0,0,'PREFS LINE%1' n,pref.line,GetLocale('S8'))
	y = y + g_hei.3 + g_sy
	CALL IniGad(4,1,0,'PREFS LINK%1' n,pref.link,GetLocale('S9'))
	n2.nmain = n - 1

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

	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