Syntax10.Scn.Fnt
Syntax10b.Scn.Fnt
ParcElems
Alloc
MODULE Input;   (*cn/shml 5 May 93 Amiga*)
 IMPORT
   O:=Console, SYSTEM, Amiga, Exec := AmigaExec, I := AmigaIntuition, IE := AmigaInputEvent, Console := AmigaConsole;
 CONST
  TimeUnit*= 1000;  (*resolution of Time() is one millisecond*)
  ESC = 1BX; SETUP = 0A4X; FF = 0CX; Quit = 0EFX;
  QueueLen = 128;
  MR = 0; MM = 1; ML = 2;
  CUP=0C1X; CDOWN=0C2X; CLEFT=0C4X; CRIGHT=0C3X;
  BREAK1=0ACX; BREAK2=0ADX;
  DEL = 07FX; BS=08X;
 TYPE
   IntuiMessagePtr=POINTER TO I.IntuiMessage;
   WindowPtr=POINTER TO I.Window;
  mouseKeys: SET;
  keyIn, keyOut: INTEGER;
  keyQueue: ARRAY QueueLen OF CHAR;
  micros0,sec0:LONGINT;
  mouseX, mouseY: INTEGER;
  R2O: ARRAY 256 OF CHAR;
 PROCEDURE InitConsole;
  VAR ir: Exec.IOStdReq;
 BEGIN
  IF Exec.OpenDevice(Console.consoleName, -1, SYSTEM.VAL(Exec.MessagePtr,SYSTEM.ADR(ir)), {}) # 0 THEN HALT(99) END;
  Console.consoleBase := ir.device
 END InitConsole;
 PROCEDURE DeadKeyConvert(msg: IntuiMessagePtr; VAR buf: ARRAY OF CHAR): LONGINT;
 TYPE
  LPtr=POINTER TO RECORD l:LONGINT END;
  ie: IE.InputEventAdr;
  len: LONGINT;
  p:LPtr;
 BEGIN
   IF ODD(ASH(msg.class,-I.rawKey)) & ~ODD(msg.code DIV IE.upPrefix) THEN
     ie.nextEvent := NIL; ie.subClass := 0; ie.class := IE.rawkey;
     ie.code := msg.code; ie.qualifier := msg.qualifier;
     p:=SYSTEM.VAL(LPtr,msg.iAddress);
     ie.addr := p.l;
     len:=Console.RawKeyConvert(SYSTEM.ADR(ie), buf, LEN(buf), 0(*NIL*))
   ELSE
    len:=0
   END;
   RETURN len
 END DeadKeyConvert;
 PROCEDURE AddKeyToQueue(buf:ARRAY OF CHAR; len:LONGINT);
  i:LONGINT;
 BEGIN
  i := 0;
  WHILE (len > 0) & ((keyIn-keyOut) MOD QueueLen # QueueLen-1) DO
   keyQueue[keyIn] := buf[i];
   keyIn := (keyIn+1) MOD QueueLen;
   INC(i);
   DEC(len)
  END
 END AddKeyToQueue;
 PROCEDURE PollIDCMP(wait:BOOLEAN);
  VAR
   msg: IntuiMessagePtr;
   len, dummy: LONGINT;
   Qualis: SET;
   buf: ARRAY 32 OF CHAR;
   win: WindowPtr;
 BEGIN
  win := SYSTEM.VAL(WindowPtr, Amiga.window);
  LOOP
   IF wait THEN Exec.WaitPort(win.userPort) END;
   msg := SYSTEM.VAL(IntuiMessagePtr, Exec.GetMsg(win.userPort));
   IF msg = NIL THEN
   	mouseX:=win.mouseX; mouseY:=win.mouseY;
    	EXIT
   END;
   IF ODD(ASH(msg.class,-I.mouseButtons)) THEN
    CASE msg.code OF
    | I.selectDown: INCL(mouseKeys, ML)
    | I.selectUp: EXCL(mouseKeys, ML)
    | I.menuDown: INCL(mouseKeys, MR)
    | I.menuUp: EXCL(mouseKeys, MR)
    | I.middleDown: INCL(mouseKeys, MM)
    | I.middleUp: EXCL(mouseKeys, MM)
    END;
    mouseX:=msg.mouseX; mouseY:=msg.mouseY;
    EXIT
   ELSIF ODD(ASH(msg.class,-I.rawKey)) THEN
    dummy:=msg.qualifier; Qualis:=SYSTEM.VAL(SET, dummy);
    IF (msg.code = 64H) & Amiga.useLAltAsMouse THEN  (* left alt key pressed *)
     INCL(mouseKeys, MM)
    ELSIF (msg.code = 64H+IE.upPrefix) & Amiga.useLAltAsMouse THEN (* left alt key released *)
     EXCL(mouseKeys, MM)
    ELSIF msg.code = 52H THEN  (* F3 key pressed *)
     IF (msg.qualifier MOD 4)#0 THEN (* one of the shift keys pressed *)
      AddKeyToQueue(BREAK2, 1)
     ELSE
      AddKeyToQueue(BREAK1, 1)
     END;
     wait:=FALSE
    ELSIF R2O[msg.code]#CHR(0) THEN (* map Raw-Key to Oberon Char *)
      buf[0]:=R2O[msg.code];
      AddKeyToQueue(buf, 1);
      wait:=FALSE
    ELSIF (IE.rCommand IN Qualis) & (msg.code>=32H) & (msg.code<=34H) THEN
      buf[0]:=CHR(msg.code-32H+0FCH);
      AddKeyToQueue(buf, 1);
      wait:=FALSE
    ELSE											(* normal Keys *)
     len := DeadKeyConvert(msg, buf);
     Amiga.ConvertAnsiToOberon(buf,len);
     AddKeyToQueue(buf,len);
     IF len>0 THEN
      (*
       We now have gotten some keys, so Read, which is the only procedure
       calling PollIDCMP with wait=TRUE, will surely get it's character,
       so no further waiting is needed.
      *)
      wait:=FALSE
     END
    END
   ELSIF ODD(ASH(msg.class,-I.closeWindow)) THEN
     AddKeyToQueue(Quit, 1);
     wait:=FALSE
   END;
   Exec.ReplyMsg(SYSTEM.VAL(Exec.MessagePtr, msg))
  END
 END PollIDCMP;
 PROCEDURE Available*(): INTEGER;
  len:INTEGER;
 BEGIN
  PollIDCMP(FALSE);
  len:= (keyIn-keyOut) MOD QueueLen;
  RETURN len
 END Available;
 PROCEDURE Read*(VAR ch: CHAR);
 BEGIN
  PollIDCMP(keyIn=keyOut); (* wait if keyboard queue empty *)
  ch := keyQueue[keyOut];
  keyOut := (keyOut+1) MOD QueueLen;
 END Read;
 PROCEDURE Mouse*(VAR keys: SET; VAR x, y: INTEGER);
  VAR win: WindowPtr;
 BEGIN
  PollIDCMP(FALSE);
  win := SYSTEM.VAL(WindowPtr, Amiga.window);
  x := (*win.*)mouseX-win.borderLeft;
  y := win.height-(*win.*)mouseY-1-win.borderBottom;
  keys := mouseKeys;
  IF y>=Amiga.Height THEN y:=Amiga.Height-1 ELSIF y<0 THEN y:=0 END;
  IF x>=Amiga.Width THEN x:=Amiga.Width-1 ELSIF x<0 THEN x:=0 END
 END Mouse;
 PROCEDURE SetMouseLimits*(w, h: INTEGER);
 END SetMouseLimits;
 PROCEDURE Time*(): LONGINT;
  VAR sec, micros: LONGINT;
 BEGIN
  I.CurrentTime(sec, micros);
  DEC(sec,sec0); DEC(micros,micros0);
  RETURN sec*TimeUnit + micros DIV (1000000 DIV TimeUnit)
 END Time;
	PROCEDURE InitRAWtoOberon;	(* Map RAW-Key to Oberon Char *)
		VAR i: INTEGER;
	BEGIN
	FOR i:=0 TO 255 DO R2O[i]:=CHR(0) END;
	R2O[50H]:=SETUP;	(* F1 *)
	R2O[51H]:=ESC;	(* F2 *)
	R2O[53H]:=SETUP;	(* F4 *)
	R2O[54H]:=0F5X;	(* F5 *)
	R2O[55H]:=0F6X;	(* F6 *)
	R2O[56H]:=0F7X;	(* F7 *)
	R2O[57H]:=0F8X;	(* F8 *)
	R2O[58H]:=0F9X;	(* F9 *)
	R2O[59H]:=0FAX;	(* F10 *)
	R2O[5FH]:=0FBX;	(* HELP *)
	R2O[46H]:=BS;	(* DEL *)
	R2O[41H]:=DEL;	(* BackSpace *)
	R2O[4CH]:=CUP;	(* Cursor UP *)
	R2O[4DH]:=CDOWN;	(* Cursor DOWN *)
	R2O[4FH]:=CLEFT;	(* Cursor LEFT *)
	R2O[4EH]:=CRIGHT;	(* Cursor RIGHT *)
	END InitRAWtoOberon;
BEGIN
 I.CurrentTime(sec0,micros0);
 InitConsole;
 keyIn := 0; keyOut := 0; mouseKeys := {};
 InitRAWtoOberon
END Input.