(*-------------------------------------------------------------------------*)
(*                                                                         *)
(*  Amiga Oberon Library Module: Requests             Date: 02-Nov-92      *)
(*                                                                         *)
(*   © 1991 by Fridtjof Siebert                                            *)
(*                                                                         *)
(*-------------------------------------------------------------------------*)

MODULE Requests;

IMPORT sys := SYSTEM,
       str := Strings,
       I*  := Intuition,
       arg := Arguments,
       ol  := OberonLib,
              Exec,
              Dos,
       g   := Graphics;



PROCEDURE RequestWin*(head,msg,pos,neg: ARRAY OF CHAR; win: I.WindowPtr): BOOLEAN; (* $CopyArrays- *)
(* erzeugt Retry/Cancel Request.

    Beispiel:
     IF Request("MyProgram:", "What shall I do?",
                "Retry", "Abort",mywindow) THEN Retry
                                           ELSE Abort END;


  pos kann "" sein, dann wird das entsprechende Gadget weggelassen.

*)

VAR
  c: CHAR;
  body,text,ok,cl: I.IntuiText;
  okadr,cladr: I.IntuiTextPtr;
  width,w: INTEGER;
  scrn: I.ScreenPtr;

BEGIN
  body.frontPen := 0;
  body.backPen  := 1;
  body.drawMode := g.jam2;
  body.leftEdge := 12;
  body.topEdge  := 8;
  body.iTextFont:= NIL;
  body.nextText := NIL;
  text := body; ok := body;
  body.iText    := sys.ADR(head);
  body.nextText := sys.ADR(text);
  text.iText    := sys.ADR(msg); text.topEdge := 22;
  ok.leftEdge:= 6;
  ok.topEdge := 3; cl := ok;
  ok.iText := sys.ADR(pos);
  cl.iText := sys.ADR(neg);
  okadr := sys.ADR(ok);
  IF pos[0]=0X THEN okadr := NIL END;
  IF I.int.libNode.version<36 THEN
    width := SHORT(str.Length(head));
    w     := SHORT(str.Length(msg ));
    IF w>width THEN width := w END;
    width := width*8+80;
    IF width<320 THEN width := 320 END;
  ELSE
    IF win#NIL THEN scrn := win.wScreen;
               ELSE scrn := I.LockPubScreen(NIL) END;
    IF scrn#NIL THEN
      text.topEdge := scrn.font.ySize+14;
      IF win=NIL THEN I.UnlockPubScreen(NIL,scrn) END;
    END;
  END;
  RETURN I.AutoRequest(win,sys.ADR(body),okadr,sys.ADR(cl),LONGSET{},LONGSET{},width,69);
END RequestWin;


PROCEDURE Request*(head,msg,pos,neg: ARRAY OF CHAR): BOOLEAN; (* $CopyArrays- *)
BEGIN
  RETURN RequestWin(head,msg,pos,neg,NIL);
END Request;


(*-------------------------------------------------------------------------*)


PROCEDURE Assert*(cc: BOOLEAN; msg: ARRAY OF CHAR);  (* $CopyArrays- *)
(* bricht Programm mit der Meldung msg ab, wen cc nicht erfüllt ist.
   Beispiel:

    NEW(p); Assert(p#NIL,"Kein Speicher!");
*)

VAR
  myname: ARRAY 80 OF CHAR;

BEGIN
  IF ~ cc THEN
    IF ol.wbStarted THEN
      arg.GetArg(0,myname);
      IF str.Length(myname)<80 THEN str.AppendChar(myname,":") END;
      IF Request(myname,msg,"","Cancel") THEN END;
    ELSE
      IF Dos.Write(Dos.Output(),"\n",1)=0 THEN END;
      IF Dos.Write(Dos.Output(),msg,str.Length(msg))=0 THEN END;
      IF Dos.Write(Dos.Output(),"\n",1)=0 THEN END;
    END;
    HALT(20);
  END;
END Assert;


(*-------------------------------------------------------------------------*)


PROCEDURE Fail*(msg: ARRAY OF CHAR);  (* $CopyArrays- *)
(* bricht Programm mit der Meldung msg ab.
   Beispiel:

    NEW(p); Assert(p#NIL,"Kein Speicher!");
*)

BEGIN
  Assert(FALSE,msg);
END Fail;


(*-------------------------------------------------------------------------*)


PROCEDURE BreakPoint*(msg: ARRAY OF CHAR); (* $CopyArrays- *)

BEGIN
  IF ~ Request("Oberon Breakpoint:",msg,"CONTINUE","HALT") THEN HALT(10) END;
END BreakPoint;


(*-------------------------------------------------------------------------*)


PROCEDURE OOM;
VAR
  thisCommand : ARRAY 40 OF CHAR;

BEGIN
  arg.GetArg(0,thisCommand);
  (* $IF English *)
    IF ~ Request(thisCommand,"Out of memory!",
                             " Retry "," Cancel ") THEN HALT(20) END;
  (* $ELSE *)
    IF ~ Request(thisCommand,"Speichermangel",
                             " Nochmal versuchen "," Abbruch ") THEN HALT(20) END;
  (* $END *)
END OOM;


(*-------------------------------------------------------------------------*)


BEGIN
  ol.OutOfMemHandler := OOM;
END Requests.