Syntax20b.Scn.Fnt
ParcElems
Alloc
Syntax24b.Scn.Fnt
Syntax10.Scn.Fnt
Syntax10b.Scn.Fnt
Syntax10i.Scn.Fnt
FoldElems
Syntax16.Scn.Fnt
Syntax12.Scn.Fnt
(* AMIGA *)
MODULE Amiga;
	Data types, constants, variables, and procedures used to interface
	to the Amiga OS, and to link various high-level modules together.
IMPORT
	SYSTEM,  A:=AmigaAsl, D:=AmigaDos, E:=AmigaExec, G:=AmigaGraphics,
	I:=AmigaIntuition, U:=AmigaUtility, T:=AmigaTimer;
CONST
		These default values are used, if no Oberon4Amiga environment
		variable was found.
	defaultHeight =800;
	defaultWidth = 1024;
	defaultDepth = 4;
	maxDepth = 8;
		The name of the environment variable used. envarcName is
		used for pre V39 AmigaOS, where the copy in the ENVARC:
		directory is not made automatically by SetEnv.
	envName = "Oberon4Amiga";
	envarcName = "ENVARC:Oberon4Amiga";
		The first value of the environment variable contains a version
		field. This is the current version.
	infoVersion = 6;
	pointerSize = 16*4;
		The title of the screen, and also the copyright notice appearing
		in the Log on system startup.
	screenTitle = "Oberon System V4 for Amiga V1.3";
	TrapErr* = 0; ExceptionErr* = 1; SystemErr* = 2;	(** values for ErrorFrame.type *)
		The sizes for the ChipMemPool
 	PoolPuddleSize = 32768; PoolThreshSize = PoolPuddleSize DIV 2;
	Absolute=LONGINT;
	Module=LONGINT;
	NewProc*=PROCEDURE(tag:LONGINT):LONGINT;
		The content of the environment varibale. Currently it is
		stored binary, as is. All but the version field contain values
		needed for opening the initial screen.
	Info=RECORD
		version:LONGINT;
		displayID:LONGINT;
		height:INTEGER;
		width:INTEGER;
		depth:INTEGER;
		oscan:LONGINT;
		autoScroll:BOOLEAN;
		useWBWindow: BOOLEAN;
		modifyColors: BOOLEAN
	END;
		Real pointers declarations. The Amiga* modules only
		export these pointer types as LONGINT, to avoid
		problems with the garbage collection.
	ProcessPtr=POINTER TO D.Process;
	ScreenPtr=POINTER TO I.Screen;
	WindowPtr=POINTER TO I.Window;
	BitmapPtr=POINTER TO G.BitMap;
	RPPtr=POINTER TO G.RastPort;
	IOExtTimerPtr = POINTER TO T.TimeRequest;
		This is the Amiga specific way to store an Oberon
		pattern.
	PatternInfoPtr*= POINTER TO PatternInfo;
	PatternInfo*= RECORD
		modulo*: INTEGER;
		w*, h*: SHORTINT;
		data*: LONGINT; (* Pointer to individual pattern in chip mem. This pointer is used for patterns and Oberon fonts. *)
		offset*: INTEGER; (* Offset to individual pattern in chip mem. This offset is used for Amiga fonts. *)
	END;
		characters are patterns with additional informations needed by the
		Display.GetChar routine. They are not part of Patterns, because they are
		of now use as soon, as the character was "transformed" into a
		simple pattern by Display.GetChar.
	CharInfo*=RECORD (PatternInfo) (* Font related character info *)
		dx*, x*, y*: SHORTINT
	END;
		This is the Amiga specific representation of a font. Data and size point
		to a contiguos memory block which contains all character data (as they
		are build by the diskfont.library).
	Font*= POINTER TO FontInfo;
	FontInfo*= RECORD
		data*: LONGINT; (* Pointer to character data block in chip mem. *)
		size*: LONGINT; (* size of data block *)
		info*: ARRAY 256 OF CharInfo;
		amigaFont*: G.TextFontPtr;
	END;
		This contains the information needed as starting point to
		build a trap viewer.
	ErrorFrame*= RECORD
		PC-: LONGINT;	(** PC value *)
		SP-: LONGINT;	(** Stack Pointer *)
		FP-: LONGINT;	(** Frame Pointer *)
		type-: LONGINT;	(** type of error: TrapErr, ExceptionErr, SystemErr, 3 = Assertion, 4 = BreakPoint, 5 = Explicit *)
		val-: LONGINT	(** type = TrapErr => trap number; type = ExceptionErr => exception mask (SET) *)
	END;
		Through this procedure variables, the routines from OLoad are called.
		For this to work, OLoad will patch in the address of a procedure into
		this variable. This can obviously work only, if the offset in memory
		of this variable is known.
		Therefore it is VERY IMPORTANT, that these variables remains the first
		declared variables in the module, and thus start at offset -4.
		The two guard variables are filled with some predefined values by OLoad
		so that on module initialisation it can be verifyed, if the variables have
		moved in respect to what OLoad expects .
	guard1:LONGINT;
	loaderCall:PROCEDURE();
	guard2:LONGINT;
		These variables export the window and rast port which have to be used
		for the Oberon screen, as well as their dimensions.
	Depth-, OberonDepth-, ColorOffset-: INTEGER;
	Height-:INTEGER;
	Width-:INTEGER;
	window-: I.WindowPtr;
	WBWindow-: BOOLEAN;
	ModifyColors-: BOOLEAN;
	PensObtained: BOOLEAN;
		The next two variables allow the customization of two Amiga specific
		behaviours.
		dontConvert inhibits the conversion of ISO-Latin1-Input to the Oberon
		character set convention. This is needed, if an Latin1 document has to be
		edited. This variable is initialised to FALSE.
		useLAltAsMouse enables the usage of the left alt key as a replacement
		for a middle mouse button, when only a two button mouse is available.
		This variable is initialised to TRUE.
	dontConvert*:BOOLEAN;
	useLAltAsMouse*:BOOLEAN;
		This varible is initialised to the screen title. A read only variable is
		exported instead of the screenTitle constant, to avoid the generation
		of a new symbol file just because the string content has changed.
	version-:ARRAY 64 OF CHAR;
	idlePri*:SHORTINT;
	normalPri*:SHORTINT;
		This is the stack pointer to which the trap handler has to
		return. It is remembered in Amiga.Loop and used in ???.
	stackPtr-: LONGINT;
		thinks for the Timer Device
	TimerOpen*: BOOLEAN;
	TimerMP: E.MsgPortPtr;
	TimerIOPtr: E.MessagePtr;
	TicsToWait*: LONGINT;
		Name of the current printer. Will be send to the OberonPrint script
	PrinterName*: ARRAY 64 OF CHAR;
		Threshold for the Color of Pictures to be printed as white, 0<=n<=256
	PictPrintThresh*: INTEGER;
		Define the Type of the Main Loop
	MainLoopType*: BOOLEAN;
		Pointer to Chip-Memory-Pool (used only if exeVersion>=39
	ChipMemPool-: E.MemPoolPtr;
		Flag for the Requester of System.Quit
	UseQuitRequester*: BOOLEAN;
		Arrays for Character Conversion Amiga <-> Oberon
	AtoO, OtoA: ARRAY 256 OF CHAR;
		???
	oldProcessWindow:I.WindowPtr;
	screen:I.ScreenPtr;
	pointerData:LONGINT;
	Procedures of OLoad are called with register D3 containing the
	address of a variable of type CallData. The first long word of CallData
	contains a function code. The following  long words contain
	parameters as requested by the specific function. Addresses are
	passed whenever a VAR parameter is requested.
	CallData=ARRAY 8 OF LONGINT;
(* Close Timer Device *)
PROCEDURE CloseTimerDevice;
BEGIN
	IF TimerOpen THEN
		E.CloseDevice(TimerIOPtr)
	END;
	IF TimerIOPtr#0 THEN
		E.DeleteIORequest(TimerIOPtr)
	END;
	IF TimerMP#0 THEN
		E.DeleteMsgPort(TimerMP)
	END;
	TimerOpen:=FALSE; TimerMP:=0; TimerIOPtr:=0
END CloseTimerDevice;
(* Open Timer Device *)
PROCEDURE OpenTimerDevice;
BEGIN
	IF ~TimerOpen THEN
		TimerMP:=E.CreateMsgPort();
		IF TimerMP#0 THEN
			TimerIOPtr:=E.CreateIORequest(TimerMP, SIZE(T.TimeRequest));
			IF TimerIOPtr#0 THEN
				IF E.OpenDevice(T.timerName, T.microHz, TimerIOPtr, {})=0 THEN TimerOpen:=TRUE END
			END
		END;
		IF ~TimerOpen THEN CloseTimerDevice() END
END OpenTimerDevice;
(* Wait sec and micro/1000000 seconds using Timer Device *)
PROCEDURE WaitTime*(sec, micro: LONGINT);
		TimerIO: IOExtTimerPtr;
		r: SHORTINT;
BEGIN
	TimerIO:=SYSTEM.VAL(IOExtTimerPtr, TimerIOPtr);
	TimerIO.command:=T.addRequest;
	TimerIO.time.secs:=sec;
	TimerIO.time.micro:=micro;
	r:=E.DoIO(TimerIOPtr)
END WaitTime;
PROCEDURE -SaveRegs 048H,0E7H,0FFH,0FEH,02AH,04EH;
(* MOVEM D0-D7/A0-A6,-(A7) MOVEA.L A6,A5 *)
PROCEDURE -LoadRegs 04CH,0DFH,07FH,0FFH;
(* MOVEM.L (A7)+,D0-D7/A0-A6 *)
PROCEDURE CallModula(VAR data:CallData);
BEGIN
	SaveRegs;
	SYSTEM.PUTREG(3,SYSTEM.ADR(data));
	loaderCall(); (* The code for this is in OLoad. *)
	LoadRegs
END CallModula;
PROCEDURE Allocate*(VAR adr:LONGINT; size:LONGINT);
	Allocates an Amiga OS memory block. Used by Kernel and Fonts.
	cd:CallData;
BEGIN
	cd[0]:=7;
	cd[1]:=SYSTEM.ADR(adr);
	cd[2]:=size;
	CallModula(cd)
END Allocate;
PROCEDURE Assert*(cond:BOOLEAN; msg:ARRAY OF CHAR);
	Perform an Arts.Assert.
	cd:CallData;
BEGIN
	cd[0]:=10;
	IF cond THEN cd[1]:=1 ELSE cd[1]:=0 END;
	cd[2]:=SYSTEM.ADR(msg);
	CallModula(cd)
END Assert;
PROCEDURE Deallocate*(adr:LONGINT; size:LONGINT);
	Deallocates an Amiga OS memory block. Used by Kernel and Fonts.
	cd:CallData;
BEGIN
	cd[0]:=12;
	cd[1]:=adr;
	cd[2]:=size;
	CallModula(cd)
END Deallocate;
PROCEDURE GetSearchPath*(VAR searchPath: ARRAY OF CHAR);
	Returns the search path which the loader received as
	parameter.
	cd:CallData;
BEGIN
	cd[0]:=17;
	cd[1]:=SYSTEM.ADR(searchPath);
	cd[2]:=LEN(searchPath);
	CallModula(cd)
END GetSearchPath;
PROCEDURE ThisMod*(name:ARRAY OF CHAR; VAR module:Module; VAR res:INTEGER; VAR modules:Module; VAR imported:ARRAY OF CHAR);
	With this routine, Modules.ThisMod accesses the loaders ThisMod
	instead of reimplementing it.
	cd:CallData;
BEGIN
	cd[0]:=4;
	cd[1]:=SYSTEM.ADR(name);
	cd[2]:=SYSTEM.ADR(module);
	cd[3]:=SYSTEM.ADR(res);
	cd[4]:=SYSTEM.ADR(modules);
	cd[5]:=SYSTEM.ADR(imported);
	CallModula(cd)
END ThisMod;
PROCEDURE ThisCommand*(mod:Module; cmdname:ARRAY OF CHAR; VAR adr:Absolute; VAR res:INTEGER);
	With this routine, Modules.ThisCommand accesses the loaders ThisCommand
	instead of reimplementing it.
	cd:CallData;
BEGIN
	cd[0]:=5;
	cd[1]:=mod;
	cd[2]:=SYSTEM.ADR(cmdname);
	cd[3]:=SYSTEM.ADR(adr);
	cd[4]:=SYSTEM.ADR(res);
	CallModula(cd)
END ThisCommand;
PROCEDURE Free*(name:ARRAY OF CHAR; all:BOOLEAN; VAR res:INTEGER; VAR modules:Module);
	With this routine, Modules.Free accesses the loaders Free
	instead of reimplementing it.
	cd:CallData;
BEGIN
	cd[0]:=6;
	cd[1]:=SYSTEM.ADR(name);
	IF all THEN cd[2]:=1 ELSE cd[2]:=0 END;
	cd[3]:=SYSTEM.ADR(res);
	cd[4]:=SYSTEM.ADR(modules);
	CallModula(cd)
END Free;
PROCEDURE Terminate*();
	Calls Arts.Terminate to bringdown Oberon. Show Requester bevor quitting, if Amiga.UseQuitRequester is TRUE.
	cd:CallData;
BEGIN
	IF ~WBWindow THEN I.ClearPointer(window) END;
	IF (~UseQuitRequester) OR
	(I.CallEasyRequest(window, {}, "Oberon System V4 for Amiga", "Do you really want to quit ?","Yes|No")#0) THEN
		cd[0]:=3;
		CallModula(cd)
	END;
	IF ~WBWindow THEN I.SetPointer(window,pointerData,2,16,0,0) END;
END Terminate;
PROCEDURE InstallNew*(proc:NewProc);
	Passes the address of Kernel.SysNew to OLoad, so that
	it can use it to fixx all NEW references.
	cd:CallData;
BEGIN
	cd[0]:=0;
	cd[1]:=SYSTEM.VAL(LONGINT,proc);
	CallModula(cd)
END InstallNew;
PROCEDURE InstallSysNew*(proc:NewProc);
	Passes the address of Kernel.SysNew to OLoad, so that
	it can use it to fixx all SYSTEM.NEW references.
	cd:CallData;
BEGIN
	cd[0]:=1;
	cd[1]:=SYSTEM.VAL(LONGINT,proc);
	CallModula(cd)
END InstallSysNew;
PROCEDURE InstallModuleList*(modList:LONGINT);
	Passes the address of Kernel.module to OLoad, so that
	it can update it, whenever it is needed (ThisMod/Free).
	cd:CallData;
BEGIN
	cd[0]:=13;
	cd[1]:=modList;
	CallModula(cd)
END InstallModuleList;
PROCEDURE TermProcedure*(proc:PROCEDURE);
	Passes the address of Kernel.FinalizeAll to OLoad, so that
	it can call it on termination.
	cd:CallData;
BEGIN
	cd[0]:=8;
	cd[1]:=SYSTEM.VAL(LONGINT,proc);
	CallModula(cd)
END TermProcedure;
PROCEDURE InstallTrapHandler*(p: PROCEDURE);
	Installs trap handler in Arts.TrapStub
	cd:CallData;
BEGIN
	cd[0]:=14;
	cd[1]:=SYSTEM.VAL(LONGINT,p);
	CallModula(cd)
END InstallTrapHandler;
PROCEDURE RestoreTrapHandler*;
	restores old trap handler in Arts.TrapStub
	cd:CallData;
BEGIN
	cd[0]:=15;
	CallModula(cd)
END RestoreTrapHandler;
PROCEDURE GetErrorFrame*(VAR err: ErrorFrame);
	gets trap information from Arts.errorFrame
	cd:CallData;
BEGIN
	cd[0]:=16;
	cd[1]:=SYSTEM.ADR(err);
	CallModula(cd)
END GetErrorFrame;
PROCEDURE SystemHere*;
	Tells loader, that system has come up to the point, that
	it can display itself any error messages.
	cd:CallData;
BEGIN
	cd[0]:=18;
	CallModula(cd)
END SystemHere;
PROCEDURE Turbo*;
	Set task priority high. Used before starting a command.
VAR task: E.TaskPtr; dummy: LONGINT;
BEGIN
	task := E.FindTask(0);
	dummy := E.SetTaskPri(task, normalPri)
END Turbo;
PROCEDURE Idle*;
	Set task priority low. Used after a command finishes and Oberon.Loop resumes.
VAR task: E.TaskPtr; dummy: LONGINT;
BEGIN
	task := E.FindTask(0);
	dummy := E.SetTaskPri(task, idlePri)
END Idle;
PROCEDURE Close*;
	Free the custom (= blank) pointer sprite.
	Restore the original window in the process structure.
	Close Oberon window and screen.
	Free Chip-Mem-Pool.
	Close Timer Device
	proc:ProcessPtr;
	scr:ScreenPtr;
	win:WindowPtr;
	i: INTEGER;
BEGIN
	IF pointerData#0 THEN
		I.ClearPointer(window);
		IF E.execVersion<39 THEN E.FreeMem(pointerData,pointerSize) END;
		pointerData:=0
	END;
	IF oldProcessWindow#0 THEN
		proc:=SYSTEM.VAL(ProcessPtr,E.FindTask(0));
		proc.windowPtr:=oldProcessWindow;
		oldProcessWindow:=0
	END;
	win := SYSTEM.VAL(WindowPtr, window); scr := SYSTEM.VAL(ScreenPtr, screen);
	IF PensObtained THEN
		FOR i:=0 TO SHORT(ASH(1, OberonDepth))-1 DO
			G.ReleasePen(scr.viewPort.colorMap, i+ColorOffset)
		END;
	END;
	IF win#NIL THEN I.CloseWindow(window); win := NIL END;
	IF scr#NIL THEN I.CloseScreen(screen); scr := NIL END;
	window := SYSTEM.VAL(LONGINT, win); screen := SYSTEM.VAL(LONGINT, scr);
	IF ChipMemPool#0 THEN E.DeletePool(ChipMemPool) END;
	IF TimerOpen THEN CloseTimerDevice() END
END Close;
PROCEDURE GetDefaultMode(VAR info:Info; VAR fromEnv:BOOLEAN);
	Initialise info with the values from the environment. If this is not
	possible, use the default sizes, and the screen mode of the workbench
	screen (if available). fromEnv returns FALSE, if the environment wasn't
	found.
	key:LONGINT;
	len:LONGINT;
	scr:ScreenPtr;
	DosV36: BOOLEAN;
BEGIN
	DosV36:=D.dosVersion<=37; (* docu said 36, but testing said 37 *)
	len:=D.GetVar(envName,SYSTEM.ADR(info),SIZE(Info),{D.globalOnly,D.binaryVar,D.dontNullTerm});
	fromEnv:=((DosV36 & (len=SIZE(Info)-1)) OR ((~DosV36) & (len=SIZE(Info)))) & (info.version=infoVersion);
	IF ~fromEnv THEN
		scr:=SYSTEM.VAL(ScreenPtr,I.LockPubScreen(0));
		IF scr#NIL THEN
			key:=G.GetVPModeID(SYSTEM.ADR(scr.viewPort));
			I.UnlockPubScreen(0,SYSTEM.VAL(I.ScreenPtr,scr))
		ELSE
			key:=G.hiresLaceKey
		END;
		info.version:=infoVersion;
		info.displayID:=key;
		info.width:=defaultWidth;
		info.height:=defaultHeight;
		info.depth:=defaultDepth;
		info.oscan:=I.oScanText;
		info.autoScroll:=TRUE;
		info.useWBWindow:=FALSE;
		info.modifyColors:=FALSE;
END GetDefaultMode;
PROCEDURE ReadScreenMode*(VAR displayID:LONGINT;
		VAR height, width, depth: INTEGER; VAR oscan:LONGINT; VAR autoScroll, WBWindow, PrivateColors: BOOLEAN);
	Read the environment variable, and extract from it all values
	needed for screen initialization. Use the default values, if the
	environment variable doesn't exist, or has a wrong version.
	dummy:BOOLEAN;
	info:Info;
BEGIN
	GetDefaultMode(info,dummy);
	displayID:=info.displayID;
	width:=info.width;
	height:=info.height;
	depth:=info.depth;
	oscan:=info.oscan;
	autoScroll:=info.autoScroll;
	WBWindow:=info.useWBWindow;
	PrivateColors:=info.modifyColors;
END ReadScreenMode;
PROCEDURE WriteScreenMode*(displayID:LONGINT;
		height, width, depth: INTEGER; oscan:LONGINT; autoScroll, useWBWindow, modifyColors:BOOLEAN);
	Store the screen values into the environment variable. On pre 3.0 Amigas
	write them also to the envarc: files as SetVar won't do it for you.
	dummy:LONGINT;
	dummyB:BOOLEAN;
	f:D.FileHandlePtr;
	info:Info;
BEGIN
	info.version:=infoVersion;
	info.displayID:=displayID;
	info.width:=width;
	info.height:=height;
	info.depth:=depth;
	info.oscan:=oscan;
	info.autoScroll:=autoScroll;
	info.useWBWindow:=useWBWindow;
	info.modifyColors:=modifyColors;
	dummyB:=D.SetVar(
		envName,SYSTEM.ADR(info),SIZE(Info),{D.globalOnly,D.saveVar,D.binaryVar,D.dontNullTerm}
	IF A.aslVersion<39 THEN
		f:=D.Open(envarcName,D.readWrite);
		IF f#0 THEN
			dummy:=D.Write(f,info,SIZE(Info));
			dummyB:=D.Close(f)
		END
END WriteScreenMode;
PROCEDURE ChangeMode2(info:Info);
	Present a screen mode requester prefilled with the values from info.
	Store the returned values into the environment.
	ScreenModeRequesterPtr=POINTER TO A.ScreenModeRequester;
	ok, useWBWindow, modifyColors: BOOLEAN;
	screenRequest:ScreenModeRequesterPtr;
	tags:ARRAY 15 OF U.TagItem;
BEGIN
	IF ~WBWindow THEN I.ClearPointer(window) END;
	tags[0].tag:=A.tsmDoAutoScroll;
	tags[0].data:=SYSTEM.VAL(LONGINT,TRUE);
	tags[1].tag:=A.tsmDoDepth;
	tags[1].data:=SYSTEM.VAL(LONGINT,TRUE);
	tags[2].tag:=A.tsmDoHeight;
	tags[2].data:=SYSTEM.VAL(LONGINT,TRUE);
	tags[3].tag:=A.tsmDoOverscanType;
	tags[3].data:=SYSTEM.VAL(LONGINT,TRUE);
	tags[4].tag:=A.tsmDoWidth;
	tags[4].data:=SYSTEM.VAL(LONGINT,TRUE);
	tags[5].tag:=A.tsmInitialAutoScroll;
	IF info.autoScroll THEN
		tags[5].data:=-1
	ELSE
		tags[5].data:=0
	END;
	tags[6].tag:=A.tsmInitialDisplayDepth;
	tags[6].data:=info.depth;
	tags[7].tag:=A.tsmInitialDisplayHeight;
	tags[7].data:=info.height;
	tags[8].tag:=A.tsmInitialDisplayID;
	tags[8].data:=info.displayID;
	tags[9].tag:=A.tsmInitialDisplayWidth;
	tags[9].data:=info.width;
	tags[10].tag:=A.tsmInitialOverscanType;
	tags[10].data:=info.oscan;
	tags[11].tag:=A.tsmScreen;
	tags[11].data:=screen;
	tags[12].tag:=A.tsmMaxDepth;
	tags[12].data:=maxDepth;
	tags[13].tag:=U.done;
	screenRequest:=SYSTEM.VAL(ScreenModeRequesterPtr,A.AllocAslRequest(A.aslScreenModeRequest,tags));
	Assert(screenRequest#NIL,"No ScreenModeRequester");
	tags[0].tag:=U.done;
	ok:=A.AslRequest(SYSTEM.VAL(LONGINT,screenRequest),tags);
	IF ok THEN
		useWBWindow:=
			I.CallEasyRequest(window, {}, "Oberon System V4 for Amiga", "Use Custom Screen ?","Yes|No")=0;
		modifyColors:=FALSE;
		IF useWBWindow THEN
			modifyColors:=I.CallEasyRequest(window, {}, "Oberon System V4 for Amiga",
				"Modify Default Colors If Necessary ?", "Yes|No")#0;
		END;
		WriteScreenMode(
			screenRequest.displayID,SHORT(screenRequest.displayHeight),SHORT(screenRequest.displayWidth)
			,screenRequest.displayDepth,screenRequest.overscanType,screenRequest.autoScroll#0
			,useWBWindow, modifyColors
	END;
	A.FreeAslRequest(SYSTEM.VAL(LONGINT,screenRequest));
	screenRequest:=NIL;
	IF ~WBWindow THEN I.SetPointer(window,pointerData,2,16,0,0) END
END ChangeMode2;
PROCEDURE ChangeMode*(VAR res:INTEGER);
	Present screen mode requester if the OS version
	supports it. Used by System.ChangeMode.
	dummy:BOOLEAN;
	info:Info;
BEGIN
	IF A.aslVersion>=38 THEN
		GetDefaultMode(info,dummy);
		ChangeMode2(info);
		res:=0
	ELSE
		res:=1
END ChangeMode;
PROCEDURE DosCmd*(cmd, outName:ARRAY OF CHAR; VAR res:INTEGER);
	Run a program with STDIN set to NIL: and STDOUT set to output.
	in,out:D.FileHandlePtr;
	tags:ARRAY 4 OF U.TagItem;
BEGIN
	in:=D.Open("NIL:",D.oldFile);
	ASSERT(in#0);
	out:=D.Open(outName,D.newFile);
	ASSERT(out#0);
	tags[0].tag:=D.sysInput;
	tags[0].data:=in;
	tags[1].tag:=D.sysOutput;
	tags[1].data:=out;
	tags[2].tag:=D.npCloseOutput;
	tags[2].data:=SYSTEM.VAL(LONGINT,FALSE);
	tags[3].tag:=U.done;
	res:=SHORT(D.System(cmd,tags));
	IF D.Close(out) THEN END;
	IF D.Close(in) THEN END
END DosCmd;
PROCEDURE SwapBits*(b: SYSTEM.BYTE):SYSTEM.BYTE;
	Swaps the bits within a byte [76543210] -> [01234567]
	i:INTEGER;
	in,res:LONGINT;
BEGIN
	res:=0;
	in:=ORD(SYSTEM.VAL(CHAR,b));
	FOR i:=0 TO 7 DO
		res:=res*2+in MOD 2;
		in:=in DIV 2
	END;
	RETURN CHR(res)
END SwapBits;
PROCEDURE ConvertAnsiToOberon*(VAR buf:ARRAY OF CHAR; len:LONGINT);
	Convert ANSI (ISO latin1) Codes to the Oberon font. This conversion
	can be switched off by setting dontConvert:=TRUE.
	i:LONGINT;
BEGIN
	IF dontConvert THEN RETURN END;
	FOR i:=0 TO len-1 DO
		buf[i]:=AtoO[ORD(buf[i])]
END ConvertAnsiToOberon;
PROCEDURE Loop*;
	This is the loop, which the loader calls instead of Oberon.Loop.
	It remembers the current stack pointer before calling Oberon.Loop,
	so the trap handler can return us into the loop, and we can restart
	Oberon.Loop after each trap.
	imported:ARRAY 32 OF CHAR;
	mod,modules:Module;
	oberonLoop:PROCEDURE;
	res:INTEGER;
BEGIN
	ThisMod("Oberon",mod,res,modules,imported);
	Assert(res=0,"Amiga.Loop: Oberon not found");
	ThisCommand(mod,"Loop",SYSTEM.VAL(Absolute,oberonLoop),res);
	Assert(res=0,"Amiga.Loop: Oberon.Loop not found");
	LOOP
		SaveRegs;
		SYSTEM.GETREG(15,stackPtr);
		DEC(stackPtr,4); (* stack pointer value after call of oberonLoop. *)
		oberonLoop;
		LoadRegs
END Loop;
PROCEDURE ConvAtoO*(ch: CHAR): CHAR;	(*<<RD*)
	Convert Char Amiga->Oberon
BEGIN
	IF dontConvert THEN
		RETURN ch
	ELSE
		RETURN AtoO[ORD(ch)]
END ConvAtoO;
PROCEDURE ConvOtoA*(ch: CHAR): CHAR;	(*<<RD*)
	Convert Char Oberon->Amiga
BEGIN
	IF dontConvert THEN
		RETURN ch
	ELSE
		RETURN OtoA[ORD(ch)]
END ConvOtoA;
PROCEDURE InitCharConv;	(*<<RD*)
	Init Arrays for Character Conversion
VAR i: INTEGER;
BEGIN
	(* no conversion for Ascii *)
	FOR i:=0 TO 127 DO
		AtoO[i]:=CHR(i); OtoA[i]:=CHR(i)
	END;
	(* Amiga to Oberon *)
	AtoO[00AH]:=00DX;	AtoO[01CH]:=" ";	AtoO[0B4H]:="'";
	AtoO[0C4H]:="
";	AtoO[0D6H]:="
";	AtoO[0DCH]:="
";	AtoO[0E4H]:="
	AtoO[0EBH]:="
";	AtoO[0EFH]:="
";	AtoO[0F6H]:="
";	AtoO[0FCH]:="
	AtoO[0E2H]:="
";	AtoO[0EAH]:="
";	AtoO[0EEH]:="
";	AtoO[0F4H]:="
	AtoO[0FBH]:="
";	AtoO[0E0H]:="
";	AtoO[0E8H]:="
";	AtoO[0ECH]:="
	AtoO[0F2H]:="
";	AtoO[0F9H]:="
";	AtoO[0E1H]:="
";	AtoO[0E9H]:="
	AtoO[0E7H]:="
";	AtoO[0F1H]:="
";	AtoO[0DFH]:="
	(* Oberon to Amiga*)
	OtoA[00DH]:=00AX;	OtoA[01CH]:=000X;
	OtoA[ORD("
")]:=0C4X;	OtoA[ORD("
")]:=0D6X;	OtoA[ORD("
")]:=0DCX;	OtoA[ORD("
")]:=0E4X;
	OtoA[ORD("
")]:=0EBX;	OtoA[ORD("
")]:=0EFX;	OtoA[ORD("
")]:=0F6X;	OtoA[ORD("
")]:=0FCX;
	OtoA[ORD("
")]:=0E2X;	OtoA[ORD("
")]:=0EAX;	OtoA[ORD("
")]:=0EEX;	OtoA[ORD("
")]:=0F4X;
	OtoA[ORD("
")]:=0FBX;	OtoA[ORD("
")]:=0E0X;	OtoA[ORD("
")]:=0E8X;	OtoA[ORD("
")]:=0ECX;
	OtoA[ORD("
")]:=0F2X;	OtoA[ORD("
")]:=0F9X;	OtoA[ORD("
")]:=0E1X;	OtoA[ORD("
")]:=0E9X;
	OtoA[ORD("
")]:=0E7X;	OtoA[ORD("
")]:=0F1X;	OtoA[ORD("
")]:=0DFX;
END InitCharConv;
PROCEDURE Init;
	Get the screen infos and initialize the Oberon screen and window.
	Install a blank sprite as pointer. Install the termination procedure for
	all this.
	Initialise the gloabl variables for character conversion and middle
	mouse button replacement.
	fromEnv:BOOLEAN;
	info:Info;
	proc:ProcessPtr;
	scr:ScreenPtr;
	scrrp:RPPtr;
	tags:ARRAY 13 OF U.TagItem;
	win:WindowPtr;
	bm: BitmapPtr;
	i: INTEGER;
	PROCEDURE OpenScreen();
	BEGIN
		Depth:=info.depth; OberonDepth:=Depth;
		Height:=info.height;
		Width:=(info.width DIV 8)*8;
		tags[0].tag:=I.saDepth;
		tags[0].data:=info.depth;
		tags[1].tag:=I.saHeight;
		tags[1].data:=Height;
		tags[2].tag:=I.saWidth;
		tags[2].data:=Width;
		tags[3].tag:=I.saDisplayID;
		tags[3].data:=info.displayID;
		tags[4].tag:=I.saQuiet;
		tags[4].data:=-1;
		tags[5].tag:=I.saAutoScroll;
		tags[5].data:=-1;
		tags[6].tag:=I.saOverscan;
		tags[6].data:=info.oscan;
		tags[7].tag:=I.saBehind;
		tags[7].data:=-1;
		tags[8].tag:=I.saDetailPen;
		tags[8].data:=0;
		tags[9].tag:=I.saBlockPen;
		tags[9].data:=SYSTEM.LSH(1,Depth)-1;
		tags[10].tag:=I.saTitle;
		tags[10].data:=SYSTEM.ADR(screenTitle);
		tags[11].tag:=I.saInterleaved;
		tags[11].data:=-1;
		tags[11].tag:=U.done;
		screen:=I.OpenScreenTags(0(*NIL*),tags); scr := SYSTEM.VAL(ScreenPtr, screen);
		Assert(scr#NIL,"No screen");
		tags[0].tag:=I.waCustomScreen;
		tags[0].data:= screen;
		tags[1].tag:=I.waIDCMP;
		tags[1].data:=SYSTEM.VAL(LONGINT, {I.rawKey,I.mouseButtons(*,I.mouseMove*)});
		tags[2].tag:=I.waFlags;
		tags[2].data:=SYSTEM.VAL(LONGINT, {I.backDrop,I.borderless,I.activate,I.rmbTrap,I.noCareRefresh});
		tags[3].tag:=U.done;
		window:=I.OpenWindowTags(0(*NIL*),tags); win := SYSTEM.VAL(WindowPtr, window);
		Assert(win#NIL,"No window");
		I.ShowTitle(screen,FALSE);
		I.ScreenToFront(screen);
		ModifyColors:=TRUE
	END OpenScreen;
	PROCEDURE OpenWBWindow();
		VAR image: ARRAY 16 OF SET; i, OberonCols, AmigaCols: INTEGER;
		PROCEDURE FindColors(): BOOLEAN;
			VAR i, j: INTEGER;
		BEGIN
			i:=0;
			WHILE i<AmigaCols DO
				j:=0;
				WHILE G.ObtainPen(scr.viewPort.colorMap, i+j, 0, 0, 0, {G.penbExclusive, G.penbNoSetcolor})#-1 DO
					INC(j);
					IF j=OberonCols THEN
						ColorOffset:=i;
						PensObtained:=TRUE;
						ModifyColors:=TRUE;
						RETURN TRUE;
					END;
				END;
				WHILE j#0 DO
					DEC(j);
					G.ReleasePen(scr.viewPort.colorMap, i+j);
				END;
				INC(i, OberonCols)
			END;
			RETURN FALSE
		END FindColors;
	BEGIN
		screen:=I.LockPubScreen(0);
		scr:=SYSTEM.VAL(ScreenPtr, screen);
		Assert(scr#NIL,"No screen");
		scrrp:=SYSTEM.VAL(RPPtr, SYSTEM.ADR(scr.rastPort));
		bm:=SYSTEM.VAL(BitmapPtr, scrrp.bitMap);
		AmigaCols:=SHORT(ASH(1, bm.depth));
		OberonCols:=SHORT(ASH(1, info.depth));
		IF (E.execVersion<39) OR (~FindColors()) THEN
			IF ModifyColors & (OberonCols<AmigaCols) THEN
				ColorOffset:=AmigaCols DIV 2;
			END;
		END;
		tags[0].tag:=I.waIDCMP;
		tags[0].data:=SYSTEM.VAL(LONGINT, {I.closeWindow, I.rawKey,I.mouseButtons(*,I.mouseMove*)});
		tags[1].tag:=I.waFlags;
		tags[1].data:=SYSTEM.VAL(LONGINT, {I.windowClose, I.windowDrag, I.windowDepth,I.rmbTrap,I.noCareRefresh});
		tags[2].tag:=I.waInnerWidth;
		tags[2].data:=(info.width DIV 8)* 8;
		tags[3].tag:=I.waInnerHeight;
		tags[3].data:=info.height;
		tags[4].tag:=I.waTitle;
		tags[4].data:=SYSTEM.ADR(screenTitle);
		tags[5].tag:=I.waScreenTitle;
		tags[5].data:=SYSTEM.ADR(screenTitle);
		tags[6].tag:=I.waAutoAdjust;
		tags[6].data:=1;
		tags[7].tag:=I.waPubScreen;
		tags[7].data:=screen;
		tags[8].tag:=U.done;
		window:=I.OpenWindowTags(0(*NIL*),tags); win := SYSTEM.VAL(WindowPtr, window);
		Assert(win#NIL,"No window");
		I.UnlockPubScreen(0, screen);
		Height:=win.height-win.borderTop-win.borderBottom;
		Width:=((win.width-win.borderLeft-win.borderRight)DIV 8)*8;
		image[14] := {13};	(* Create Pointer *)
		image[13] := {12..14};
		image[12] := {11..13};
		image[11] := {10..12};
		image[10] := {9..11};
		image[9] := {8..10};
		image[8] := {7..9};
		image[7] := {0, 6..8};
		image[6] := {0, 1, 5..7};
		image[5] := {0..2, 4..6};
		image[4] := {0..5};
		image[3] := {0..4};
		image[2] := {0..5};
		image[1] := {0..6};
		image[0] := {0..7};
		FOR i:=0 TO 14 DO
			SYSTEM.PUT(pointerData+4*i+2, SwapBits(CHR(SYSTEM.VAL(LONGINT, image[i]) MOD 256)));
			SYSTEM.PUT(pointerData+4*i+3, SwapBits(CHR(ASH(SYSTEM.VAL(LONGINT, image[i]), -8))));
			SYSTEM.PUT(pointerData+4*i, CHR(0));
			SYSTEM.PUT(pointerData+4*i+1, CHR(0));
		END;
	END OpenWBWindow;
BEGIN
	ColorOffset:=0; PensObtained:=FALSE;
	IF E.execVersion>=39 THEN
		ChipMemPool:=E.CreatePool({E.memChip}, PoolPuddleSize, PoolThreshSize);
		Assert(ChipMemPool#0, "Can not create memory pool for fonts")
	ELSE
		ChipMemPool:=0
	END;
	IF ChipMemPool#0 THEN
		pointerData:=E.AllocPooled(ChipMemPool, pointerSize);
		FOR i:=0 TO pointerSize-1 DO SYSTEM.PUT(pointerData+i, CHR(0)) END
	ELSE
		pointerData:=E.AllocMem(pointerSize,{E.memChip,E.memClear})
	END;
	version:=screenTitle;
	IF A.aslVersion>=38 THEN
		GetDefaultMode(info,fromEnv);
		IF ~fromEnv THEN
			ChangeMode2(info);
			GetDefaultMode(info,fromEnv)
		END
	ELSE
		GetDefaultMode(info,fromEnv)
	END;
	WBWindow:=info.useWBWindow; ModifyColors:=info.modifyColors;
	IF WBWindow THEN OpenWBWindow() ELSE OpenScreen() END;
	proc:=SYSTEM.VAL(ProcessPtr,E.FindTask(0));
	oldProcessWindow:=proc.windowPtr;
	proc.windowPtr:=window;
	I.SetPointer(window,pointerData,15,16,0,0);
	I.ActivateWindow(window);
	scrrp:=SYSTEM.VAL(RPPtr, SYSTEM.ADR(scr.rastPort));
	bm:=SYSTEM.VAL(BitmapPtr, scrrp.bitMap);
	Depth:=bm.depth;
	IF info.depth<=Depth THEN OberonDepth:=info.depth ELSE OberonDepth:=Depth END;
	TermProcedure(Close);
	dontConvert:=FALSE;
	useLAltAsMouse:=TRUE;
	idlePri:=-128;
	normalPri:=0;
	OpenTimerDevice();
	TicsToWait:=20000;
	MainLoopType:=TimerOpen; (* Use AmigaLoop if Timer Device is open *)
	PrinterName:="PrinterOut.ps";
	PictPrintThresh:=128;
	UseQuitRequester:=FALSE;
	InitCharConv
END Init;
BEGIN
	TimerOpen:=FALSE; TimerMP:=0; TimerIOPtr:=0;
	stackPtr:=0;
		Ensure, that OLoad probably guessed right, when patching in loaderCall.
	Assert((guard1=002468ACEH) & (guard2=013579BDFH),"Amiga: wrong loader call guards.");
	Init
END Amiga.