/*
 * OLE.rexx
 *
 * USAGE: OLE(object)
 *
 * First release of my OLE server implementing some commands to drive
 * the GUI.
 *
 * HISTORY:
 * v1.01	all objects used by the OLE system now have an index
 *			to prevent conflicts of names.
 *
 * v1.02	bug fixed in WriteConfig()
 *
 * v1.03	added commands "ICONIFY", "UNICONIFY" and "INFO"
 *
 * $(C): (1994, Rocco Coluccelli, Bologna)
 * $VER: OLE.rexx 1.03 (25.Oct.1994)
 *
 */

/*
 *	Load external libraries
 */
IF ~Add_libs('ARP','SUPP') THEN EXIT 20

/*
 *	Default window's dimension
 */
win.w = 320; win.h = 256; win.l = 100; win.t = 100

idcmp.  = "CLOSEWINDOW MENUPICK GADGETUP"
idcmp.1 = idcmp.0 "MOUSEBUTTONS"
flags.  = "WINDOWCLOSE WINDOWDRAG WINDOWDEPTH"

module. = ''
module.path = 'OLE:'
locale. = ''
locale.path = 'OLE:Catalogs/'
config. = ''
config.path = 'OLE:Prefs/'

module.0 = 'OLE.rexx'

/*
 *	Get the arguments from the USER MODULE
 */
PARSE ARG oleargv
PARSE VALUE GETCLIP(oleargv) WITH userport','userscreen','module.1','module.2 .
CALL SETCLIP(oleargv,'')

/*
 *	Specify ports and objects ALWAYS in uppercase.
 *
 *	server		the server message port used by Intuition
 *	olectrl		server control port where will be sent commands
 *	remote.		is the port that external modules will use
 *	oleargv		arguments' clip
 *	oleobj		"object" will be used to exchange data by the modules
 */
DO oleindex = 1 UNTIL ~SHOW('P','OLE_SERVER' || oleindex)
	END

locale.0 = ReadLocale(module.0)
config.0 = ReadConfig(module.0)

server   = 'OLE_SERVER' || oleindex
olectrl  = 'OLE_CTRL' || oleindex
remote.1 = 'OLE_INPUT' || oleindex
remote.2 = 'OLE_OUTPUT' || oleindex
oleargv  = 'OLE_ARGV' || oleindex
oleobj   = 'OLE_PIPE' || oleindex


/*
 *	Configuration: window's borders, font, paths
 */
IF ~SHOW('C',config.0) THEN DO
	win.bl = 3; win.bt = 15; win.br = 4; win.bb = 2
	win.font = 'topaz.font'
	win.fonth = 8; win.fontw = 8
	END

ELSE
	PARSE VALUE GETCLIP(config.0) WITH win.bl','win.bt','win.br','win.bb','win.font','win.fonth','win.fontw','

/*
 *	Create the host port for Intuition.
 *
 *	To build the command line:	'22'X = "	'27'X = '
 */
cmd = 'ADDRESS AREXX' '2227'X || 'CALL CreateHost('server','olectrl','userscreen')' || '2722'X
INTERPRET cmd

CALL ScreenToFront(userscreen)
IF ~WaitForPort(server) THEN
	CALL ReqAsk(0,,,'þERR_PORT',,'þOK2',,userscreen,1,10,1,server)

/*
 *	Open the server control port
 */
IF OPENPORT(olectrl) == NULL() THEN DO
	CALL Quit(server)
	CALL ReqAsk(0,,,'þERR_PORT',,'þOK3',,userscreen,1,20,1,olectrl)
	END


/*
 *	Wait for messages at control port until the end
 */
status = RunModule(1)
DO UNTIL status = 'end'

	CALL WAITPKT(olectrl)
	pkt = GETPKT(olectrl)

	IF pkt == NULL() THEN ITERATE

	/*
	 *	Extract command name, arguments, caller number
	 */
	PARSE VALUE GETARG(pkt) WITH cmd argv

	/*
	 *	Execute the command request:
	 */
	SELECT

		/*
		 *	REQASK mod msg,(%s)
		 */
		WHEN cmd = 'REQASK' THEN DO
			PARSE VAR argv mod a1','a2
			CALL SETCLIP(oleargv,ReqAsk(mod,,,a1,,,,userscreen,,,1,a2))
			END

		/*
		 *	REQFILE mod path,hail
		 */
		WHEN cmd = 'REQFILE' THEN DO
			PARSE VAR argv mod a1','a2
			CALL SETCLIP(oleargv,ReqFile(mod,,,a1,a2,userscreen))
			END

		/*
		 *	SETSTATUS status
		 */
		WHEN cmd = 'SETSTATUS' THEN
			status = RunModule(argv)

		/*
		 *	ABOUT mod
		 */
		WHEN cmd = 'ABOUT' THEN DO
			PARSE VAR argv mod a1 .
			CALL ReqAsk(mod,,,'þ' || a1,,'þOK1',,userscreen,,,1)
			END

		/*
		 *	CONFIG mod
		 */
		WHEN cmd = 'CONFIG' THEN DO
			PARSE VAR argv mod .
			IF SHOW('C',config.mod) THEN CALL WriteConfig(mod)
			END

		/*
		 *	ICONIFY mod
		 */
		WHEN cmd = 'ICONIFY' THEN DO
			PARSE VAR argv mod .
			CALL CloseWindow(server,"CONTINUE")
			CALL OpenWindow(server,win.l,0,win.w,win.bt,idcmp,flags,GetLocale(mod,'TITLE'))
			CALL SetNotify(server,"CLOSEWINDOW",remote.mod)
			CALL ModifyHost(server,"CLOSEWINDOW","UNICONIFY")
		END

		/*
		 *	UNICONIFY
		 */
		WHEN cmd = 'UNICONIFY' THEN
			CALL IniWindow(win.l,win.t,win.w,win.h)

		/*
		 *	INFO mod
		 */
		WHEN cmd = 'INFO' THEN DO
			PARSE VAR argv mod .
			CALL SETCLIP(oleargv,module.mod config.mod)
		END

		/*
		 *	WINDOW mod width height nidcmp nflags
		 */
		WHEN cmd = 'WINDOW' THEN DO
			PARSE VAR argv mod box.w box.h a1 a2 .

			win.w = box.w + win.bl + win.br
			win.h = box.h + win.bt + win.bb
			win.l = (ScreenCols(userscreen) - win.w) % 2
			win.t = (ScreenRows(userscreen) - win.h) % 2
			idcmp = idcmp.a1; flags = flags.a2

			CALL IniWindow(win.l,win.t,win.w,win.h)
			END

		/*
		 *	QUIT
		 */
		WHEN cmd = 'QUIT' THEN
			status = 'end'

		OTHERWISE DO
			cmd = GETARG(pkt,0)
			DO i = 1 TO 15
				cmd = cmd || '\' || GETARG(pkt,i)
			END
			CALL ReqAsk(0,,,'þERR_CMD',,'þOK3',,userscreen,,,1,cmd)
		END

	END	/* end select commands */

	CALL REPLY(pkt,0)

END	/* end do forever */

CALL CLOSEPORT(olectrl)

DO i = 1 TO 2
	IF SHOW('P',remote.i) THEN DO
		ADDRESS VALUE remote.i
		QUIT
		END
END

DO i = 0 TO 2
	CALL SETCLIP(locale.i,'')
	CALL SETCLIP(config.i,'')
END

CALL SETCLIP(oleargv,'')
CALL SETCLIP(oleobj,'')
CALL Quit(server)

EXIT 0



/*
 *	Window initialization
 *
 *	IniWindow(left,top,width,height,idcmp,flags)
 */
IniWindow:

	CALL CloseWindow(server,"CONTINUE")
	CALL OpenWindow(server,ARG(1),ARG(2),ARG(3),ARG(4),idcmp,flags,GetLocale(mod,'TITLE'))

	CALL ModifyHost(server,"CLOSEWINDOW","QUIT")
	CALL SetNotify(server,"GADGETUP",remote.mod)

	CALL SetDrMd(server,'JAM1')
	CALL SetFont(server,win.font,win.fonth)

	CALL AddMenu(server,GetLocale(mod,'TITLE'))
	CALL AddItem(server,GetLocale(0,'M1'),'')
	CALL AddSubItem(server,GetLocale(0,'M2'),'ABOUT' 0 'OLE')
	CALL AddSubItem(server,GetLocale(0,'M3'),'ABOUT' mod 'ABOUT')
	CALL AddSubItem(server,GetLocale(0,'M4'),'ABOUT' 0 'ABOUT')
	CALL AddItem(server,GetLocale(0,'M5'),'CONFIG' mod)
	CALL AddItem(server,GetLocale(0,'M6'),'QUIT','q')

RETURN

/*
 *	Draw a 3D border.
 */
DrawBorder: PROCEDURE
PARSE ARG port,x0,y0,x1,y1,inout,clean

	IF clean THEN DO
		CALL SetAPen(port,0); CALL RectFill(port,x0,y0,x1,y1)
		END

	p1 = 2 - inout; p2 = 1 + inout

	CALL Move(port,x0,y1)
	CALL SetAPen(port,p1); CALL Draw(port,x0,y0); CALL Draw(port,x1,y0)
	CALL SetAPen(port,p2); CALL Draw(port,x1,y1); CALL Draw(port,x0,y1)

RETURN


/*
 *	Extract messages from the LOCALE clip.
 */
GetLocale: PROCEDURE EXPOSE locale.
ARG mod,strID

	IF strID = '' THEN RETURN ''
	strID = 'þ'strID'þ'; PARSE VALUE GETCLIP(locale.mod) WITH (strID)text'Þ'

RETURN text


ReadLocale:
PARSE ARG module

	locale = module || '.catalog'
	clip = ''

	IF ~OPEN(loc,locale.path || 'english/' || locale,'R')  &  module > 0 THEN
		CALL ReqAsk(0,,,'þERR_FILE',,'þOK4',,userscreen,,,1,locale)

	ELSE DO
		clip = READCH(loc,20000)
		CALL CLOSE(loc)
		END

	lang = GETENV('language')
	IF lang ~= 'english' THEN
		IF OPEN(loc,locale.path || lang'/' || locale,'R') THEN DO
		clip = READCH(loc,20000) || clip
		CALL CLOSE(loc)
		END

	CALL SETCLIP(locale || oleindex,clip)

RETURN locale || oleindex


ReadConfig:
PARSE ARG module

	config = module || '.prefs'

	clip = ''
	IF OPEN(cfg,config.path || config,'R') THEN
		clip = READLN(cfg)

	CALL SETCLIP(config || oleindex,clip)
	CALL CLOSE(cfg)

RETURN config || oleindex


WriteConfig:
PARSE ARG mod

	IF ~OPEN(cfg,config.path || module.mod || '.prefs','W') THEN DO
		CALL ReqAsk(0,,,'þERR_WRITE',,'þOK4',,userscreen,,,1,module.mod || '.prefs')
		RETURN
		END

	CALL WRITELN(cfg,GETCLIP(config.mod))
	CALL CLOSE(cfg)

RETURN


/*
 *	result = ReqAsk(mod,x,y,body,string,okay,cancel,screen,back,ret,align,...)
 *
 *	(mod) 0 for the server, 1 or 2 are the modules
 *	(x,y) requester position
 *	(body) formatted string with %s substitution
 *	(string) default string in the string requester
 *	(okay,cancel) buttons text
 *	(screen) where we need the requester to appear
 *	(back) BOOLEAN send (screen) to back
 *	(ret) exit code, if provided
 *	(align) BOOLEAN body text center aligned
 *	(...) strings to insert in %s
 *
 *	specifing 'þIDENTIFIER' will search in the LOCALE clip
 */
ReqAsk: PROCEDURE EXPOSE win. locale.

	DO i = 1 TO 4
		text.i = STRIP(ARG(3 + i),'B')

		DO UNTIL right = ''
			PARSE VAR text.i left 'þ'strID right
			text.i = left || GetLocale(ARG(1),strID) || right
		END
	END

	DO i = 12 UNTIL right = ''
		PARSE VAR text.1 left '%s' right
		text.1 = left || ARG(i) || right
	END

	IF ARG(11) = 1 & text.1 ~= '' THEN DO
		text.1 = CenterText(text.1)

		IF text.3 ~= '' & text.4 = '' THEN
			text.3 = CENTER(text.3,MIN(LENGTH(text.1),POS('\',text.1) - 1))
		END

	x = ARG(2); IF x = '' THEN x = win.l % 2
	y = ARG(3); IF y = '' THEN y = win.t % 2

	cmd = 'string = Request(' || x','y','
	DO i = 1 TO 4
		IF text.i = '' THEN
			cmd = cmd','
		ELSE
			cmd = cmd'"'text.i'",'
	END
	INTERPRET cmd || ARG(8)')'

	IF ARG(9) = 1 THEN CALL ScreenToBack(ARG(8))

	IF ARG(10) >= 0 THEN EXIT ARG(10)

RETURN string


/*
 *	result = ReqFile(mod,x,y,path,hail,screen)
 *
 *	(mod) 0 for the server, 1 or 2 are the modules
 *	(x,y) requester position
 *	(path) the original full path
 *	(hail) request title 'þIDENTIFIER' or string
 *	(screen) where we need the requester to appear
 */
ReqFile: PROCEDURE EXPOSE win. locale.
PARSE ARG mod,x,y,path,hail,screen

	IF x = '' THEN x = win.l % 2
	IF y = '' THEN y = win.t % 2

	dir = ''; file = ''; path = STRIP(path,'B')
	IF path ~= '' THEN DO
		pos = LASTPOS('/',path)

		IF pos = 0 THEN DO
			pos = POS(':',path)
			dir = LEFT(path,pos)
			END
		ELSE
			dir = LEFT(path,pos - 1)

		file = SUBSTR(path,pos + 1)
		END

	hail = STRIP(hail,'B')
	DO UNTIL right = ''
		PARSE VAR hail left 'þ'strID right
		hail = left || GetLocale(mod,strID) || right
	END

	file = GetFile(x,y,dir,file,hail,screen,"DOARP")

RETURN file


CenterText: PROCEDURE
PARSE ARG text

	len = 0
	DO n = 1 UNTIL text = ''
		PARSE VAR text line.n '\' text
		len = MAX(len,LENGTH(line.n))
	END

	len = len + 2
	lines = n
	DO n = 1 TO lines - 1
		text = text || CENTER(line.n,len) || '\'
	END

RETURN text || CENTER(line.n,len)


RunModule:
PARSE ARG mod .

	IF module.mod = '' THEN RETURN 'end'

	locale.mod = ReadLocale(module.mod)
	config.mod = ReadConfig(module.mod)

	clip = mod ,
	       win.bl win.bt win.fontw win.fonth ,
	       server olectrl remote.mod ,
	       userscreen userport ,
	       locale.mod config.mod oleobj

	CALL SETCLIP(oleargv,clip)

	cmd = 'Run >NIL: Rx "CALL' "'" || module.path || module.mod || "'" || '('oleargv')"'
	ADDRESS COMMAND cmd

RETURN mod


WaitForPort: PROCEDURE
PARSE ARG port

	DO iter = 1 TO 10
		ADDRESS COMMAND "WaitForPort" port
		IF SHOW('P',port) THEN RETURN 1
	END

RETURN 0