/*
 * OLE.rexx
 *
 * USAGE: "Run >NIL: Rx OLE.rexx"
 *
 * A lot of changes from the first release of my OLE Server. Read the
 * documentation for more information.
 *
 * HISTORY:
 * v1.11	added some improvements, a few bugs fixed
 *			the INFO command add the ability to read internal parameters
 *			checked all server commands
 *
 * v1.12	WaitForPort() replaced with an external Wait_For_Port.rexx
 *
 * v1.13	WaitForPort() MUST be internal
 *
 * $(C): (1994, Rocco Coluccelli, Bologna)
 *
 *	TODO: try to open this in the userscreen
 *	TODO: put up a message for libraries not founded
 *	TODO: add amigaguide.library support
 */

ver_TAG = "$VER: OLE.rexx 1.13 (10.Feb.1995)"
tit_TAG = ' OLE Server'

CALL IniLibs()
CALL PostMsg(100,100,'\' || LEFT(tit_TAG || ':',40) || '\')

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

olewin.  = 'OLE_WIN'
oleclip. = 'OLE_CLIP'
olepipe. = 'OLE_PIPE'
oleport. = 'OLE_HOST'
oleind.  = 0

userport.   = 'REXX'
userscreen. = 'Workbench'

module.0	= 0
module.0.0	= 1
module.0.1	= 'OLE.rexx'
olewin.0	= 'OLE_IDCMP'
oleport.0.1	= 'OLE_SERVER'

CALL ReadLocale(0,1)
CALL ReadConfig(0,1)
CALL PostMsg(,,'\' || tit_TAG || GetLocale(0,1,8))


IF ~OPENPORT(oleport.0.1) THEN DO
	CALL PostMsg()
	CALL RTezRequest(GetLocale(0,1,'ERR_1',oleport.0.1),GetLocale(0,1,'OK3'),tit_TAG)
	EXIT 20
	END

CALL GetServerConfig()

winw. = 120; winh. = win.bt; winl. = 130; wint. = 0; boxw. = 0; boxh. = 0
oleind.hei = 20			/* min = 18  max = 100 ? */

/*
 *	idcmp.0 and flags.0 are for the server
 */
idcmp. = "MENUPICK CLOSEWINDOW GADGETUP"
flags. = "WINDOWDRAG WINDOWDEPTH WINDOWCLOSE ACTIVATE"
idcmp.0.1 = "MENUPICK"
flags.0.1 = "WINDOWDRAG WINDOWDEPTH"


CALL PostMsg(,,GetLocale(0,1,9))
IF ~NewWindow(0,1,tit_TAG) THEN DO
	CALL PostMsg()
	EXIT 10
	END


CALL PostMsg()
rt_TAG  = 'rtez_flags=ezreqf_centertext'
DO UNTIL cmd = 'QUIT'

	CALL WAITPKT(oleport.0.1)
	pkt = GETPKT(oleport.0.1)

	IF pkt == NULL() THEN ITERATE

	PARSE VALUE GETARG(pkt) WITH cmd jobID modID argv
	SELECT

		WHEN cmd = 'COMPLETE' THEN DO

			IF oleind.jobID = 0 THEN DO
				CALL CloseWindow(olewin.jobID,"CONTINUE")
				CALL OpenWindow(olewin.jobID,winl.jobID,wint.jobID,winw.jobID,oleind.hei + win.bt + win.bb,idcmp.0,flags.0,GetLocale(jobID,modID,'TITLE'))
				CALL DrawBorder(2,2,boxw.jobID - 2,oleind.hei - 2,oleind.outer)
				CALL DrawBorder(10,6,boxw.jobID - 10,oleind.hei - 6,oleind.inner)
				END

			oleind.jobID = SetOleInd(argv)
		END

		/*
		 *	TODO: check this command when switch tasks
		 */
		WHEN cmd = 'SETJOB' THEN CALL IniModule(jobID,modID)

		WHEN cmd = 'ICONIFY' THEN DO
			PARSE VAR argv winl.jobID wint.jobID .
			CALL CloseWindow(olewin.jobID,"CONTINUE")
			CALL OpenWindow(olewin.jobID,winl.jobID,0,winw.jobID,win.bt,idcmp.0,flags.1,GetLocale(jobID,modID,'TITLE'))
			CALL SetNotify(olewin.jobID,"CLOSEWINDOW","REXX")
			INTERPRET "CALL ModifyHost(" || olewin.jobID || ",'CLOSEWINDOW'," || '2227'x || ADDRESS oleport.0.1 'UNICONIFY' jobID modID ';' ADDRESS oleport.jobID.modID 'UNICONIFY' || '2722'x || ")"
		END

		WHEN cmd = 'UNICONIFY' THEN IF ~NewWindow(jobID,modID,GetLocale(jobID,modID,'TITLE')) THEN CALL FreeJob(jobID)

		WHEN cmd = 'WINDOW' THEN DO
			PARSE VAR argv boxw.jobID boxh.jobID a1 a2 .

			winw.jobID = boxw.jobID + win.bl + win.br
			winh.jobID = boxh.jobID + win.bt + win.bb
			winl.jobID = (ScreenCols(userscreen.jobID) - winw.jobID) % 2
			wint.jobID = (ScreenRows(userscreen.jobID) - winh.jobID) % 2
			oleind.jobID = 0

			idcmp.jobID.modID = idcmp.a1; flags.jobID.modID = flags.a2

			IF ~NewWindow(jobID,modID,GetLocale(jobID,modID,'TITLE')) THEN CALL FreeJob(jobID)
		END

		WHEN cmd = 'INFO' THEN INTERPRET 'CALL SETCLIP(' || oleclip.jobID || ',' || argv || ')'

		WHEN cmd = 'CONFIG' THEN CALL WriteConfig(jobID,modID)

		WHEN cmd = 'NEWJOB' THEN DO
			DO jobID = 1 UNTIL module.jobID.0 = ''; END
			module.0 = MAX(module.0,jobID)
			DO i = 1 WHILE GETARG(pkt,i + 2) ~= ''
				oleport.jobID.i = oleport. || '.' || jobID || '.' || i
				PARSE VALUE GETARG(pkt,i + 2) WITH module.jobID.i status.jobID.i .
			END
			module.jobID.0 = i - 1
			oleclip.jobID = oleclip. || '.' || jobID
			olepipe.jobID = olepipe. || '.' || jobID
			olewin.jobID = olewin. || '.' || jobID
			olewin.jobID.0 = ''
			userport.jobID = GETARG(pkt,1)
			userscreen.jobID = GETARG(pkt,2)
			CALL IniModule(jobID,1)
		END

		WHEN cmd = 'NEWPREFS' THEN DO

			DO jobID = 0 TO module.0
				IF SHOW('P',olewin.jobID) THEN CALL CloseWindow(olewin.jobID,"CONTINUE")
			END

			CALL DELAY(delaytime * 50)
			CALL ReadLocale(0,1); CALL ReadConfig(0,1)
			CALL GetServerConfig()

			DO jobID = 0 TO module.0

				IF SHOW('P',olewin.jobID) & oleind.jobID = 0 THEN DO

					modID = olewin.jobID.0
					IF ~NewWindow(jobID,modID,GetLocale(jobID,modID,'TITLE')) THEN
						CALL FreeJob(jobID)
					ELSE
						IF jobID ~= 0 THEN INTERPRET 'ADDRESS' oleport.jobID.modID 'UNICONIFY'

					END

				oleind.jobID = 0
			END

		END

		WHEN cmd = 'ABOUT' | cmd = 'ERROR' THEN DO
			PARSE VAR argv a1 a2

			IF cmd = 'ABOUT' THEN DO
				a1 = GetLocale(jobID,modID,a1,SUBSTR(ver_TAG,7))
				a2 = GetLocale(0,1,'OK1')
				END

			ELSE DO
				a1 = GetLocale(0,1,'ERR_' || a1,STRIP(a2,'B'))
				a2 = GetLocale(0,1,'OK2')
				END

			CALL RTezRequest(a1,a2,tit_TAG,rt_TAG 'rt_pubscrname=' || userscreen.jobID)
		END

		WHEN cmd = 'QUIT' THEN IF RTezRequest(GetLocale(0,1,10),GetLocale(0,1,'OK5'),tit_TAG,rt_TAG) = 0 THEN cmd = ''

		/*
		 *	TODO: fix this section
		 */
		OTHERWISE DO

			cmd = GETARG(pkt,0)
			DO i = 1 TO 15
				cmd = cmd || '0A'x || GETARG(pkt,i)
			END
			CALL RTezRequest(GetLocale(0,1,'ERR_3',cmd),GetLocale(0,1,'OK3'),tit_TAG)
		END

	END
	CALL REPLY(pkt,0)
END

DO i = 1 TO module.0
	IF module.i.0 ~= '' THEN CALL FreeJob(i)
END

CALL CLOSEPORT(oleport.0.1)
CALL FreeJob(0)

EXIT 0


GetLocale: PROCEDURE EXPOSE locale.
ARG jobID,modID,strID

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

	DO i = 4
		PARSE VAR text text '%s' clip
		IF clip = '' THEN BREAK
		text = text || ARG(i) || clip
	END

RETURN text


DrawBorder:

	IF ARG(5) = 0 THEN RETURN

	x1 = win.bl + ARG(1); y1 = win.bt + ARG(2); x2 = win.bl + ARG(3); y2 = win.bt + ARG(4)
	CALL Move(olewin.jobID,x1,y2)
	CALL SetAPen(olewin.jobID,3 - ARG(5)); CALL Draw(olewin.jobID,x1,y1); CALL Draw(olewin.jobID,x2,y1)
	CALL SetAPen(olewin.jobID,ARG(5)); CALL Draw(olewin.jobID,x2,y2); CALL Draw(olewin.jobID,x1,y2)

RETURN


SetOleInd:

	x1 = win.bl + 12; y1 = win.bt + 8; x2 = boxw.jobID - 24; y2 = win.bt + oleind.hei - 8
	CALL SetAPen(olewin.jobID,0); CALL RectFill(olewin.jobID,x1,y1,x1 + x2,y2)
	CALL SetAPen(olewin.jobID,oleind.color); CALL RectFill(olewin.jobID,x1,y1,x1 + ARG(1) * x2 % 100,y2)

RETURN ARG(1)


ReadLocale: PROCEDURE EXPOSE module. locale.
ARG jobID,modID

	locale = module.jobID.modID || '.catalog'
	locale.jobID.modID = locale || '_' || jobID

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

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

	CALL SETCLIP(locale.jobID.modID,clip)

RETURN


ReadConfig: PROCEDURE EXPOSE module. config.
ARG jobID,modID

	config = module.jobID.modID || '.prefs'
	config.jobID.modID = config || '_' || jobID

	IF OPEN(cfg,config.path || config,'R') THEN DO
		CALL SETCLIP(config.jobID.modID,READLN(cfg))
		CALL CLOSE(cfg)
		END

RETURN


WriteConfig: PROCEDURE EXPOSE module. config. locale.
ARG jobID,modID

	IF ~SHOW('C',config.jobID.modID) THEN RETURN

	config = module.jobID.modID || '.prefs'
	IF OPEN(cfg,config.path || config,'W') THEN DO
		CALL WRITELN(cfg,GETCLIP(config.jobID.modID))
		CALL CLOSE(cfg)
		END

	ELSE CALL RTezRequest(GetLocale(0,1,'ERR_4',config),GetLocale(0,1,'OK4'),tit_TAG)

RETURN


FreeJob:
ARG jobID

	IF SHOW('P',olewin.jobID) THEN CALL Quit(olewin.jobID)

	DO i = 1 TO module.jobID.0
		IF SHOW('P',oleport.jobID.i) THEN INTERPRET 'ADDRESS' oleport.jobID.i 'QUIT'

		CALL SETCLIP(locale.jobID.i,''); CALL SETCLIP(config.jobID.i,'')
	END

	module.jobID.0 = ''
	CALL SETCLIP(oleclip.jobID,'')

RETURN


IniModule:
ARG jobID,modID

	IF module.jobID.modID = '' THEN DO
		CALL FreeJob(jobID)
		RETURN
		END

	IF SHOW('P',oleport.jobID.modID) THEN RETURN

	CALL ReadLocale(jobID,modID)
	CALL ReadConfig(jobID,modID)

	clip = jobID modID ,
	       win.bl win.bt win.fontw win.fonth ,
	       olewin.jobID oleport.0.1 oleport.jobID.modID ,
	       userscreen.jobID userport.jobID olepipe.jobID ,
	       locale.jobID.modID config.jobID.modID status.jobID.modID

	CALL RunModule(module.path || module.jobID.modID,oleclip.jobID,clip)

RETURN


RunModule:

	CALL SETCLIP(ARG(2),ARG(3))
	ADDRESS COMMAND 'Run >NIL: Rx "CALL' "'" || ARG(1) || "'" || '(' || ARG(2) || ')"'

RETURN


NewWindow:
ARG jobID,modID

	IF ~SHOW('P',olewin.jobID) THEN DO
		CALL RunModule('New_Host.rexx',oleclip.jobID,olewin.jobID','oleport.0.1','userscreen.jobID',')
		IF ~WaitForPort(olewin.jobID) THEN DO
			CALL RTezRequest(GetLocale(0,1,'ERR_2',olewin.jobID),GetLocale(0,1,'OK2'),tit_TAG)
			RETURN 0
			END

			CALL SetReqColor(olewin.jobID,"BLOCKPEN",2)
			CALL SetReqColor(olewin.jobID,"DETAILPEN",1)
		END

	ELSE CALL CloseWindow(olewin.jobID,"CONTINUE")

	CALL OpenWindow(olewin.jobID,winl.jobID,wint.jobID,winw.jobID,winh.jobID,idcmp.jobID.modID,flags.jobID.modID,ARG(3))
	CALL SetFont(olewin.jobID,win.font,win.fonth)
	CALL SetDrMd(olewin.jobID,'JAM1')
	CALL AddMenu(olewin.jobID,ARG(3))

	olewin.jobID.0 = modID
	IF jobID = 0 THEN DO
		CALL AddItem(olewin.jobID,GetLocale(0,1,1),'')
		CALL AddSubItem(olewin.jobID,GetLocale(0,1,2),'ABOUT' 0 1 'OLE','o')
		CALL AddSubItem(olewin.jobID,GetLocale(0,1,4),'ABOUT' 0 1 'ABOUT','a')
		CALL AddItem(olewin.jobID,GetLocale(0,1,11),'NEWPREFS','n')
		CALL AddItem(olewin.jobID,GetLocale(0,1,12),'NEWJOB %1' || userport.0 || '%2' || userscreen.0 || '%3Config.ole%4CatCompiler.ole','c')
		CALL AddItem(olewin.jobID,GetLocale(0,1,7),'QUIT','q')
		END

	ELSE DO
		CALL SetNotify(olewin.jobID,"CLOSEWINDOW",oleport.0.1)
		CALL ModifyHost(olewin.jobID,"CLOSEWINDOW",'SETJOB' jobID 'end')
		CALL SetNotify(olewin.jobID,"GADGETUP",oleport.jobID.modID)
		CALL SetNotify(olewin.jobID,"MENUPICK",'REXX')
		cmd = "CALL AddItem(" || olewin.jobID || ",'" || GetLocale(0,1,3) || "'," || '2227'x || ADDRESS oleport.0.1 'ABOUT' jobID modID 'ABOUT' || '2722'x || ")"
		cmd = cmd "; CALL AddItem(" || olewin.jobID || ",'" || GetLocale(0,1,5) || "'," || '2227'x || ADDRESS oleport.0.1 'CONFIG' jobID modID || '2722'x || ",'s')"
		cmd = cmd "; CALL AddItem(" || olewin.jobID || ",'" || GetLocale(0,1,6) || "'," || '2227'x || ADDRESS oleport.0.1 'ICONIFY' jobID modID '%f %e' || '2722'x || ",'i')"
		cmd = cmd "; CALL AddItem(" || olewin.jobID || ",'" || GetLocale(0,1,7) || "'," || '2227'x || ADDRESS oleport.jobID.modID 'QUIT' || '2722'x || ",'q')"
		INTERPRET cmd
		CALL ScreenToFront(userscreen.jobID)
		END

RETURN 1


IniLibs: PROCEDURE

	pri.1 = 5; lib.1 = 'rexxarplib.library'
	pri.2 = 0; lib.2 = 'rexxreqtools.library'
	pri.3 = 0; lib.3 = 'rexxsupport.library'

	DO i = 1 TO 3
		IF (ADDLIB(lib.i,pri.i,-30,0) | SHOW('L',lib.i)) = 0 THEN EXIT 20
	END

RETURN


/*
 *	TODO: all win.bx may be the same for all public screens, check this...
 */
GetServerConfig:

	IF ~SHOW('C',config.0.1) THEN DO
		win.bl = 3; win.bt = 15; win.br = 4; win.bb = 2
		win.font = 'topaz.font'; win.fonth = 8; win.fontw = 8
		oleind.outer = 0; oleind.inner = 0; oleind.color = 4
		END

	ELSE PARSE VALUE GETCLIP(config.0.1) WITH win.bl','win.bt','win.br','win.bb','win.font','win.fonth','win.fontw','oleind.outer','oleind.inner','oleind.color','

	delaytime = 2	/* secs */

RETURN


WaitForPort: PROCEDURE

	DO iter = 1 TO 5

		ADDRESS COMMAND "WaitForPort" ARG(1)
		IF SHOW('P',ARG(1)) THEN RETURN 1
	END

RETURN 0