(*
  :Program.       RCTTest.mod
  :Contents.      Demo-program for the module RCT
  :Author.        Volker Rudolph
  :Address.       Lettow-Vorbeck-Str. 11 / 6750 Kaiserslautern 26
  :Phone.         06301/8566
  :Copyright.     Freeware
  :Language.      Oberon
  :Translator.    Oberon V1.17.1
  :Imports.       RCT,RCTInterface
  :History.       Version 1.0 - first public release
  :Bugs.          No known Bugs.
*)
MODULE RCTTest;

IMPORT e:Exec,I:Intuition,
       io,Break,n:NoGuru,s:SYSTEM,
       ri:RCTInterface,RCT;

CONST
  WINDOW = I.NewWindow(0,0,311,75,-1,-1,
                        LONGSET{I.menuPick,I.gadgetUp},
                        LONGSET{I.windowDrag,I.windowDepth},
                        NIL,NIL,
                        s.ADR("RCTTest"),
                        NIL,NIL,0,0,0,0,{I.wbenchScreen});

VAR
  window: I.WindowPtr;
  nw: I.NewWindow;
  reqOpen:BOOLEAN;
  ok:BOOLEAN;

(* Reads a message from the IDCMP-port and replies it *)
PROCEDURE GetMessage( VAR class:LONGSET;
                      VAR code:INTEGER;
                      VAR item:I.GadgetPtr);
VAR
  intuiMsg:I.IntuiMessagePtr;
  signal:LONGSET;
BEGIN
  signal := e.Wait(LONGSET{window.userPort.sigBit});
  intuiMsg := e.GetMsg(window.userPort);
  WHILE intuiMsg # NIL DO
    class := intuiMsg.class;
    code := intuiMsg.code;
    item := intuiMsg.iAddress;
    e.ReplyMsg(intuiMsg);
    intuiMsg := e.GetMsg(window.userPort);
  END; (* WHILE *)
END GetMessage;

(* Reads menu events and prints the names of the menu-entries *)
PROCEDURE MenuLoop;
VAR
  msgClass:LONGSET;
  msgCode:INTEGER;
  gadget:I.GadgetPtr;
  ok:BOOLEAN;
BEGIN
  (* Set the menu, which is defined in the c-source-code *)
  ok := I.SetMenuStrip(window,s.ADR(ri.menu));
  n.Assert(ok,"Kann Menüleiste nicht setzen");

  LOOP
    GetMessage(msgClass,msgCode,gadget);
    IF I.menuPick IN msgClass THEN
      CASE I.MenuNum(msgCode) OF
        0:io.WriteString("Menü - ");
          CASE I.ItemNum(msgCode) OF
            0:io.WriteString("Eisbein\n");
           |1:io.WriteString("Sauerkraut\n");
           |2:io.WriteString("Rotkohl\n");
           |3:io.WriteString("Kroketten\n");
          ELSE
              io.WriteString("Kenn ich nich\n");
          END; (* CASE *)
       |1:io.WriteString("Nachtisch - ");
          CASE I.ItemNum(msgCode) OF
            0:io.WriteString("Eis\n");
           |1:io.WriteString("Apfelmus\n");
           |2:io.WriteString("Pudding\n");
          ELSE
              io.WriteString("Kenn ich nich\n");
          END; (* CASE *)
       |2:io.WriteString("\nOK - Es geht weiter\n");
          EXIT;
        ELSE
      END; (* CASE *)
    END; (* IF *)
  END; (* LOOP *)

  I.ClearMenuStrip(window);

END MenuLoop;

(* Reads the gadget-events of the requester and prints the gadget's *)
(* names. *)
PROCEDURE ReqLoop;
VAR
  msgClass:LONGSET;
  msgCode:INTEGER;
  gadget:I.GadgetPtr;
  strInfo:I.StringInfoPtr;
  str:POINTER TO ARRAY 40 OF CHAR;
BEGIN
  (* Open the requester, which is defined in the c-source code.   *)
  (* The requester is intialized by a c-function, which is called *)
  (* via RCT.CCall *)
  reqOpen := RCT.CCall(ri.StartRequest,window) # 0;
  n.Assert(reqOpen,"Kann Requester nicht öffnen");

  LOOP
    GetMessage(msgClass,msgCode,gadget);
    IF I.gadgetUp IN msgClass THEN
      io.WriteString("Gadget - ");
      CASE gadget.gadgetID OF
        ri.PIC1:
          io.WriteString("PIC1\n");
       |ri.PIC2:
          io.WriteString("PIC2 ... ENDE\n\nTschüß\n");
          EXIT;
       |ri.STRING:
          io.WriteString("STRING:");
          strInfo := gadget.specialInfo;
          str := strInfo.buffer;
          io.WriteString(str^);
          io.WriteLn;
        ELSE
          io.WriteString("Kenn ich nich\n");
      END; (* CASE *)
    END; (* IF *)
  END; (* LOOP *)

END ReqLoop;

BEGIN
  nw := WINDOW;
  window := I.OpenWindow(nw);
  n.Assert(window # NIL,"Kann Fenster nicht öffnen");

  ok := RCT.ImagesToChip(s.ADR(ri.image),ri.IMAGENUM);
  n.Assert(ok,"Zu wenig Chip-Memory");

  MenuLoop;
  ReqLoop;

CLOSE
  IF window # NIL THEN
    IF reqOpen THEN
      I.EndRequest(s.ADR(ri.req),window);
    END; (* IF *)
    I.CloseWindow(window);
  END; (* IF *)
END RCTTest.