/*
 * ReadTable.pcalc
 *
 * This script read a selected range of cells from ProCalc and put it into
 * the cliplist in order to use with other external modules. My first OLE
 * module.
 *
 * USAGE: ReadTable.pcalc(ArgObject)
 *
 * TODO: exclude hided rows and columns
 *		 write filename in the update info
 *
 * $(C): (1994, Rocco Coluccelli, Bologna)
 * $VER: ReadTable.pcalc 1.00 (19.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 userscreen . locale config oleobj .

/*
 *	Configuration
 */
IF ~SHOW('C',config) THEN DO
	host.path = 'Work:ProCalc/Procalc'
	host.port = 'PCALC'
	host.file = 'Work:Procalc/PCF/'
	range = 'A1:B2'
	launch = 0
	END

ELSE
	PARSE VALUE GETCLIP(config) WITH host.path','host.port','host.file','range','launch','


/*
 *	Send commands to OLE server
 */
ADDRESS VALUE olectrl

/*
 *	Open the module commands port
 */
IF OPENPORT(remote) == NULL() THEN DO
	REQASK 0 'þERR_PORT,'remote
	QUIT		/* send quit command to the server */
	EXIT 10		/* abort operation */
	END

/*
 *	Wait for messages at control port until the end
 */
elab = 1
st = GUIGads()
DO UNTIL st = 'end'

	CALL WAITPKT(remote)
	pkt = GETPKT(remote)

	IF pkt == NULL() THEN ITERATE

	/*
	 *	Extract and execute each command.
	 */
	PARSE VALUE GETARG(pkt) WITH cmd argv
	PARSE VALUE GETARG(pkt,1) WITH n0 .

	SELECT

		WHEN cmd = 'REQFILE' THEN DO
			PARSE VAR argv t .
			str = GETARG(pkt,2)

			IF str = '' THEN DO
				cmd module host.t || ',þ' t
				str = GETCLIP(oleargv)
				END

			IF t = 'FILE' THEN str = CheckFAFF(str)

			IF str ~= '' THEN host.t = str
			g_str.n0 = host.t
		END

		WHEN cmd = 'PORT' THEN DO

			str = GETARG(pkt,2)
			IF str ~= '' THEN host.port = str
			g_str.n0 = host.port
		END

		WHEN cmd = 'LOMEM' THEN DO

			launch = ~launch
			g_str.n0 = launch
		END

		WHEN cmd = 'RANGE' THEN DO
			str = UPPER(GETARG(pkt,2))

			IF argv = 'DEL' THEN
				str = ''
			ELSE IF argv = 'ADD' THEN DO
				CALL HostCmd('Current')
				str = range result
				END
			ELSE IF argv = 'SUB' THEN DO
				CALL HostCmd('Current')
				str = range '-'result
				END

			range = ''
			DO WHILE str ~= ''
				PARSE VAR str firstcell':'lastcell str
				IF lastcell ~= '' THEN range = range firstcell':'lastcell
			END

			range = SPACE(range,1)
			elab = (range ~= '')
			g_str.n0 = range
		END

		WHEN cmd = 'START' THEN DO

			IF st = nmain & launch THEN DO
				IF ~Run_Host(host.path,host.port) THEN DO
					REQASK module 'can´t find' host.path || '¸\' || host.port 'don´t responde...'
					elab = 0
					QUIT
					END

				ELSE CALL HostCmd('Open' host.file)

				CALL WindowToFront(server)
				END

			IF st = nmain THEN DO
				CALL Gadgets(7,n1.st,n2.st)
				g_str.nokay = GetLocale('11'); CALL Gadgets(2,nokay)
				st = nrange; CALL Gadgets(4,n1.st,n2.st)
				IF launch THEN CALL Gadgets(4,n1.nlaunch,n2.nlaunch)
				END

			ELSE st = 'end'

		END

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

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

		OTHERWISE NOP

	END	/* end select commands */

	IF n0 ~= '' THEN DO
		CALL SETCLIP(config,host.path','host.port','host.file','range','launch',')
		CALL Gadgets(2,n0)
		END

	CALL REPLY(pkt,0)

END	/* end do until */

CALL CLOSEPORT(remote)

IF launch THEN CALL HostCmd('Close')

/*
 *	Quit command from the server, abort operations
 */
IF ~elab THEN EXIT 0

/*
 *	Let the server launch the next module
 */
SETSTATUS (module + 1)

IF 'OLE:Parse_PCF'(oleobj,host.file,range) ~= 0 THEN DO
	QUIT
	EXIT 10
	END

EXIT 0


GetLocale: PROCEDURE EXPOSE locale
ARG strID

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

RETURN text


/*
 *	Send commands to host program
 */
HostCmd:
PARSE ARG cmd

	ADDRESS VALUE host.port
	cmd
	ADDRESS

RETURN result


/*
 *	Check if FAFF
 */
CheckFAFF: PROCEDURE EXPOSE module
PARSE ARG file

	IF file = '' THEN RETURN ''

	IF OPEN(pcf,file,'R') THEN DO
		head  = C2D(READCH(pcf,1))
		len   = C2D(READCH(pcf,2))
		magic = C2D(READCH(pcf,4))
		CALL CLOSE(pcf)
		END

	IF head = 1 & len = 4 & magic = 681281268 THEN RETURN file

	REQASK module 'þBADFILE'

RETURN ''


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; nrange = 2; nlaunch = 3

	n1.nmain = n
	x = box.left; y = box.top
	CALL IniFileGad('REQFILE PATH',host.path,GetLocale('1'))
	y = y + g_hei.3 + g_sy
	CALL IniGad(1,1,0,,GetLocale('2'))
	CALL IniGad(3,0,1,'PORT %1' n '%2%g',host.port,12)
	y = y + g_hei.3 + 2 * g_sy
	CALL IniGad(4,1,0,'LOMEM %1' n,launch,GetLocale('3'))
	y = y + g_hei.3 + 2 * g_sy
	CALL IniFileGad('REQFILE FILE',host.file,GetLocale('4'))
	box.h = y
	n2.nmain = n - 1

	n1.nrange = n
	y = box.top
	CALL IniGad(1,1,0,,GetLocale('5')); x0 = x
	CALL IniGad(2,3,0,'RANGE DEL %1' n + 1,GetLocale('6'))
	x = box.left; y = y + g_hei.3 + g_sy
	n1 = IniGad(3,1,0,'RANGE %1' n '%2%g',range)
	box.h = MAX(box.h,y)
	n2.nrange = n - 1

	n1.nlaunch = n
	x = x0; y = box.top
	CALL IniGad(2,0,1,'RANGE ADD %1' n1,GetLocale('7'))
	CALL IniGad(2,0,0,'RANGE SUB %1' n1,GetLocale('8'))
	n2.nlaunch = n - 1

	y = box.h + g_hei.3 + 2 * g_sy
	nokay = IniGad(2,1,0,'START',GetLocale('9'))
	g_gads = IniGad(2,3,0,'HELP',GetLocale('10'))

	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(1,g_gads,g_gads - 1)
	CALL Gadgets(4,n1.nmain,n2.nmain)

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


IniFileGad:
PARSE ARG msg,str,txt

	CALL IniGad(1,1,0,,txt)
	y = y + g_hei.1 + 2 * g_sy
	CALL IniGad(2,1,0,msg '%1' (n + 1),'F')
	CALL IniGad(3,0,1,msg '%1' n '%2%g',str)

RETURN n - 1


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