(*---------------------------------------------------------------------------
    :Program.    Interrupt.mod
    :Author.     Fridtjof Siebert
    :Address.    Nobileweg 67, D-7-Stgt-40
    :Phone.      0711/822509
    :Shortcut.   [fbs]
    :Version.    1.0
    :Date.       22-May-88
    :Copyright.  PD
    :Language.   Modula-II
    :Translator. M2Amiga
    :Imports.    none.
    :UpDate.     none.
    :Contents.   DemoProgramm, daß zeigt, wie man einen Interrupt von Modula
    :Contents.   aus anlegen kann.
    :Remark.     Sorry, daß ich INLINE() benutze. Wer möchte, kann die
    :Remark.     Register auch mit REG() in Variablen speichern und mit
    :Remark.     SETREG() zurückschreiben.
---------------------------------------------------------------------------*)

MODULE Interrupt;

FROM SYSTEM IMPORT ADR,ADDRESS,SHIFT,SETREG,REG,INLINE;

FROM Intuition IMPORT NewWindow,OpenWindow,CloseWindow,WindowPtr,
       ViewPortAddress,WindowFlags,WindowFlagSet,IDCMPFlags,IDCMPFlagSet,
       IntuiMessagePtr,ScreenFlags,ScreenFlagSet;
FROM Exec IMPORT GetMsg,ReplyMsg,Interrupt,NodeType,AddIntServer,
       RemIntServer,WaitPort;
FROM Graphics IMPORT ViewPortPtr,SetRGB4;
FROM Hardware IMPORT vertb;

CONST
    MOVEMS = 48E7H; (* that's the 68000-Instruction MOVEM to save Registers*)
    MOVEML = 4CDFH; (* that's MOVEM to load Registers                      *)

VAR
  NuWindow: NewWindow;
  Window: WindowPtr;
  VP: ViewPortPtr;          (* ViewPort des WB-Screens *)
  Msg : IntuiMessagePtr;    (* Message für WindowClose-Gadget *)
  VertBIntr: Interrupt;     (* Meine Interrupt-Struktur *)
  ColCount,Wait: INTEGER;   (* Variablen für Interrupt-Prozedur *)
  Increase: BOOLEAN;        (* Wird Farbe heller oder dunkler ? *)

(*-------------------  Die Interrupt-Prozedur:  ---------------------------*)
(* bei eigenen Prozeduren darauf achten, daß sie möglichst schnell abgear- *)
(* beitet werden !!!                                                       *)

PROCEDURE MyIntProc();

BEGIN

(*------  Register auf Stack retten:  ------*)

  INLINE(MOVEMS,3F3EH); (* this is MOVEM d2-d7/a2-a6,-(sp) *)

(*------  Farbe verändern:  ------*)

  INC(Wait);
  IF Wait>2 THEN        (* nur jeden 3. Interrupt die Farbe ändern *)
    Wait:=0;
    IF Increase THEN    (* erhöhen/erniedrigen *)
      INC(ColCount);
    ELSE
      DEC(ColCount);
    END;
    (* evt. Richtung ändern: *)
    IF (ColCount=15) OR (ColCount=0) THEN Increase:=NOT(Increase); END;
    SetRGB4(VP,1,ColCount,ColCount,ColCount); (* Farbe setzten *)
  END;

(*------  Register zurückholen:  ------*)

  INLINE(MOVEML,7CFCH); (* this is MOVEM (sp)+,d2-d7/a2-a6 *)

END MyIntProc;

(*-------------------------  Hauptprogramm:  ------------------------------*)

BEGIN

(*------  Fenster öffnen:  ------*)

  WITH NuWindow DO
    leftEdge := 100;
    topEdge := 75;
    width := 250;
    height := 32;
    detailPen := 0;
    blockPen := 1;
    idcmpFlags := IDCMPFlagSet{closeWindow};
    flags := WindowFlagSet{windowSizing,windowDrag,windowDepth,windowClose};
    firstGadget := NIL;
    checkMark := NIL;
    title := ADR("Fridi's Interrupts");
    screen := NIL;
    bitMap := NIL;
    minWidth := 40;
    minHeight := 20;
    maxWidth := 640;
    maxHeight := 256;
    type := ScreenFlagSet{wbenchScreen};
  END;
  Window := OpenWindow(NuWindow);
  IF Window=NIL THEN HALT END;
  VP := ViewPortAddress(Window);

(*------  Interrupt-Struktur initialisieren:  ------*)

  WITH VertBIntr DO
    node.type := interrupt;      (* Typ ist Interrupt                *)
    node.pri := -60;
    node.name := ADR("VertB-Interrupt");  (* Name (nur für Debugging *)
    data := NIL;     (* keine Daten. data ist beim Interrupt in A1   *)
    code := ADR(MyIntProc);      (* Zeiger auf InterruptProzedur     *)
  END;

(*------  Variable für Interrupt initialisieren:  ------*)

  Increase:= TRUE; ColCount := 0; Wait := 0;

(*------  Interrupt starten:  ------*)

  AddIntServer(vertb,ADR(VertBIntr));

(*------  Auf Closing-Gadget warten:  ------*)

  WaitPort(Window^.userPort);
  Msg := GetMsg(Window^.userPort);
  ReplyMsg(Msg);

(*------  Interrupt beenden:  ------*)

  RemIntServer(vertb,ADR(VertBIntr));

(*------  Fenster schließen:  ------*)

  CloseWindow(Window);
END Interrupt.