/*
 * DupObjects.ole
 *
 * USAGE: DupObjects.ole
 *
 * DupObjects.ole is the GUI for all modules that multiply objects in the
 * OLE System. Expecially dedicated to Antonello Troccola, one friend of
 * mine.
 *
 * HISTORY:
 * v1.01	eliminated the possibility to change the measure units
 *			added the ability to remember the last values inserted
 *
 * v1.02	added ActivateGadget()
 *
 * v1.03	aligned with the new server design v1.10
 *
 * $(C): (1994, Rocco Coluccelli, Bologna)
 * $VER: DupObjects.ole 1.03 (30.Nov.1994)
 */

OPTIONS RESULTS

PARSE ARG oleclip
PARSE VALUE GETCLIP(oleclip) WITH jobID modID box.left box.top char.w char.h olewin oleport olehost . . olepipe locale config .

IF ~SHOW('C',config) THEN
	memory = 1
ELSE
	PARSE VALUE GETCLIP(config) WITH memory','

	inc. = 0; num. = 0


ADDRESS VALUE oleport

/*
 *	TODO: management for the ENV variables
 */
env = 'DupObjects.ole'

clip = GETENV(env)
IF clip ~= '' THEN PARSE VAR clip num.rows inc.rows num.cols inc.cols .


IF OPENPORT(olehost) == NULL() THEN DO
	ERROR jobID modID 1 olehost
	SETJOB jobID 'end'
	EXIT 10
	END

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

	CALL WAITPKT(olehost)
	pkt = GETPKT(olehost)

	IF pkt == NULL() THEN ITERATE

	PARSE VALUE GETARG(pkt) WITH cmd argv .
	PARSE VALUE GETARG(pkt,1) WITH n0 nn .

	SELECT

		WHEN cmd = 'INC' THEN DO
			inc = GETARG(pkt,2)

			IF ~DATATYPE(inc,'N') THEN inc = 0

			inc.argv = inc; g_str.n0 = inc
		END

		WHEN cmd = 'NUM' THEN DO
			num = GETARG(pkt,2)
			IF num < 0 THEN num = 0

			num.argv = num; g_str.n0 = num
		END

		WHEN cmd = 'MEM' THEN DO
			memory = ~memory
			g_str.n0 = memory

			CALL SETCLIP(config,memory',')
		END

		WHEN cmd = 'UNICONIFY' THEN
			CALL Gadgets(8,1,g_gads)

		WHEN cmd = 'HELP' THEN
			ABOUT jobID modID 'HELP' || st

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

		OTHERWISE NOP

	END

	IF n0 ~= '' THEN DO
		CALL Gadgets(2,n0)
		IF nn ~= '' THEN CALL ActivateGadget(olewin,GAD.nn)
		END

	CALL REPLY(pkt,0)
END


CALL CLOSEPORT(olehost)

IF cmd = 'QUIT' THEN EXIT 0

IF num.rows + num.cols = 0 THEN DO
	SETJOB jobID 'end'
	EXIT 0
	END

clip = num.rows inc.rows num.cols inc.cols

IF memory THEN
	CALL SETENV(env,clip)
ELSE
	CALL SETENV(env,'')

CALL SETCLIP(olepipe,clip)

SETJOB jobID modID + 1
CALL CloseWindow(olewin)
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
	g_onoff. = 0

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

	n = 1; nmain = 1

	x = box.left; y = box.top
	CALL IniGad(3,1,0,'NUM COLS %1' n n + 2'%2%g',num.cols,4)
	CALL IniGad(1,0,1,,GetLocale(9))
	y = y + g_hei.3 + g_sy
	CALL IniGad(3,1,0,'INC COLS %1' n n + 2'%2%g',inc.cols,8)
	CALL IniGad(1,0,1,,GetLocale(4))
	y = y + g_hei.3 + 2 * g_sy
	CALL IniGad(3,1,0,'NUM ROWS %1' n n + 2'%2%g',num.rows,4)
	CALL IniGad(1,0,1,,GetLocale(10))
	y = y + g_hei.3 + g_sy
	CALL IniGad(3,1,0,'INC ROWS %1' n 1 '%2%g',inc.rows,8)
	CALL IniGad(1,0,1,,GetLocale(5))
	y = y + g_hei.3 + 2 * g_sy
	CALL IniGad(4,1,0,'MEM %1' n,memory,GetLocale(1))

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

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

	WINDOW jobID modID (box.w + 2 * g_sx) (box.h + 2 * g_sy) 1 1
	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 IF ARG(1) = 8 THEN
		DO n = ARG(2) TO ARG(3)
			IF g_onoff.n THEN CALL NewGad(n,g_type.n)
		END

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


DelGad:
PARSE ARG n,t

	g_onoff.n = 0

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

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

RETURN


NewGad:
PARSE ARG n,t

	g_onoff.n = 1

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

	ELSE IF t = 3 THEN
		CALL AddGadGet(olewin,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(olewin,g_xpos.n,g_ypos.n,GAD.n,D2C(32 + g_str.n * 183),g_msg.n)

	ELSE DO
		CALL SetAPen(olewin,1)
		CALL Move(olewin,g_xpos.n,g_ypos.n)
		CALL Text(olewin,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