(* ------------------------------------------------------------------------
  :Program.       ReqToolsDemo
  :Contents.      Demonstrates use auf Nico François' reqtools.library
  :Author.        Kai Bolay [kai] (C-Version by Nico François)
  :Address.       Hoffmannstraße 168
  :Address.       D-7250 Leonberg 1 (Germany)
  :Address.       UUCP: ...!cbmvax!cbmehq!cbmger!depot1!amokle!kai
  :Address.       FIDO: 2:247/706.3
  :History.       v1.0 [kai] 22-Nov-91 (translated from C)
  :History.       v1.0 Nico  29-Nov-91 (comment added about ta.name bug)
  :Copyright.     Freeware
  :Language.      Oberon
  :Translator.    AMIGA OBERON v2.12e, A+L AG
  :Imports.       ReqTools
  :Remark.        Thanks to Nico for his great library
  :Bugs.          ReqTools/Arq should support each other
  :Bugs.          Font-Hook: ta.name can contain odd pointer :-(
------------------------------------------------------------------------ *)

(*********************************
*                                *
*  reqtools.library (V37)        *
*                                *
*  Release 1.0                   *
*                                *
*  (c) 1991 Nico François        *
*                                *
*  demo.c                        *
*                                *
*  This source is public domain  *
*  in all respects.              *
*                                *
*********************************)

MODULE ReqToolsDemo;

IMPORT
  rt: ReqTools, I: Intuition, d: Dos, e: Exec, g: Graphics, u: Utility,
  y: SYSTEM;

VAR
  filereq: rt.FileRequesterPtr;
  fontreq: rt.FontRequesterPtr;
  myhook: u.Hook;
  buffer: ARRAY 128 OF CHAR;
  filename: ARRAY 34 OF CHAR;
  longnum, ret, color: LONGINT;
  adr, adr2: y.ADDRESS;
  (* $IF SmallCode *)
  olduser: LONGINT;
  (* $END *)

PROCEDURE myputs (str: ARRAY OF CHAR);
BEGIN
  IF d.Output() # NIL THEN
    y.SETREG (0, d.Write (d.Output(), str, LEN (str)-1));
  END;
END myputs;

(* $IF DoHook *)
(* $StackChk- $SaveRegs+ *)
PROCEDURE *hookfunc (hook{8}: u.HookPtr;
                     object{10}: e.APTR;
                     message{9}: e.APTR): LONGINT;
VAR
  fib: d.FileInfoBlockPtr;
  ta: g.TextAttrPtr;
  param: POINTER TO ARRAY 2 OF e.ADDRESS;
BEGIN
  (* $IF SmallCode *)
  y.SETREG (8+5, e.exec.thisTask^.userData);
  (* $END *)
  param := message;
  CASE y.VAL (LONGINT, param[0]) OF
  | rt.ReqHookWildFile:
      (* param[1] holds address of a FileInfoBlock *)
      fib := param[1];
      myputs (fib^.fileName); myputs ("\n");
      RETURN 0;
  | rt.ReqHookWildFont:
      (* param[1] holds address of a TextAttr *)
      ta := param[1];
      (* myputs (ta^.name^); May contain odd Pointer :-( *)
      (* <odd Pointer is fault of AvailFonts function (DiskFont)> - Nico *)
      myputs ("\n");
      RETURN 0;
  ELSE
    RETURN 0;
  END;
END hookfunc;
(* $StackChk= *)
(* $END *)

BEGIN
  myputs ("\nreqtools Demo\n¯¯¯¯¯¯¯¯¯¯¯¯¯\n\
This program demonstrates what 'reqtools.library' \
has to offer.\n");

  d.Delay (60);

  rt.vEZRequest ("'reqtools.library' offers several\ndifferent types of requesters:",
                "Let's see them", NIL, NIL);

  rt.vEZRequest ("NUMBER 1:\nThe larch :-)", "Be serious!", NIL, NIL);

  rt.vEZRequest ("NUMBER 1:\nString requester\nfunction: rt.GetString()",
                "Show me", NIL, NIL);

  buffer := "A bit of text";
  IF NOT rt.GetString (buffer, 127, "Enter anything:", NIL, u.end) THEN
    rt.vEZRequest ("You entered nothing :-(", "I'm sorry", NIL, NIL);
  ELSE
    adr := y.ADR (buffer);
    rt.vEZRequest ("You entered this string:\n'%s'.",
                  "So I did", NIL, NIL, adr);
  END;

  rt.vEZRequest ("NUMBER 2:\nNumber requester\nfunction: rt.GetLong()",
                "Show me", NIL, NIL);

  IF NOT rt.GetLong (longnum, "Enter a number:", NIL,
             rt.glShowDefault, I.LFALSE, u.end) THEN
    rt.vEZRequest ("You entered nothing :-(", "I'm sorry", NIL, NIL);

  ELSE
    rt.vEZRequest ("The number you entered was:\n%ld",
             "So it was", NIL, NIL, longnum);
  END;

  rt.vEZRequest ("NUMBER 3:\nNotification requester, the requester\n\
you've been using all the time!\nfunction: rt.EZRequest()",
           "Show me more", NIL, NIL);

  rt.vEZRequest ("Simplest usage: some body text and\na single centered gadget.",
           "Got it", NIL, NIL);

  WHILE NOT (rt.EZRequest ("You can also use two gadgets to\n\
ask the user something.\n\
Do you understand?", "Of course|Not really",
                NIL, NIL) # 0) DO
    rt.vEZRequest ("You are not one of the brightest are you?\n\
We'll try again...",
             "Ok", NIL, NIL);
  END; (* WHILE *)

  rt.vEZRequest ("Great, we'll continue then.", "Fine", NIL, NIL);

  CASE rt.EZRequest ("You can also put up a requester with\n\
three choices.\n\
How do you like the demo so far ?",
                "Great|So so|Rubbish", NIL, NIL) OF
    | 0:
      rt.vEZRequest ("Too bad, I really hoped you\nwould like it better.",
               "So what", NIL, NIL);
    | 1:
      rt.vEZRequest ("I'm glad you like it so much.", "Fine", NIL, NIL);
    | 2:
      rt.vEZRequest ("Maybe if you run the demo again\n\
you'll REALLY like it.",
               "Perhaps", NIL, NIL);
  END; (* CASE *)

  ret := rt.EZRequestTags ("The number of responses is not limited to three\n\
as you can see.  The gadgets are labeled with\n\
the return code from rt.EZRequest().\n\
Pressing Return will choose 4, note that\n\
4's button text is printed in boldface.",
                  "1|2|3|4|5|0", NIL, NIL,
                  rt.ezDefaultResponse, 4, u.end);
  rt.vEZRequest ("You picked '%ld'.", "How true", NIL, NIL, ret);

  adr := y.ADR ("five");
  rt.vEZRequest (
    "You may also use C-style formatting codes in the body text.\n\
Like this:\n\n\
'The number %%ld is written %%s.' will give:\n\n\
The number %ld is written %s.\n\n\
if you also pass '5' and '\"five\"' to rt.EZRequest().",
    "Proceed", NIL, NIL, 5, adr);

  IF (I.diskInserted IN y.VAL (LONGSET, rt.EZRequestTags ("It is also possible to pass extra IDCMP flags\n\
that will satisfy rt.EZRequest(). This requester\n\
has had DISKINSERTED passed to it.\n\
(Try insert.ing a disk).",
                 "Continue", NIL, NIL,
                 rt.IDCMPFlags, y.VAL (LONGINT, LONGSET {I.diskInserted}), u.end))) THEN
    rt.vEZRequest ("You inserted a disk.", "I did", NIL, NIL);
  ELSE
    rt.vEZRequest ("You used the 'Continue' gadget\n\
to satisfy the requester.", "I did", NIL, NIL);
  END;

  rt.vEZRequestTags ("Finally, it is possible to specify the position\n\
of the requester.\n\
E.g. at the top left of the screen, like this.\n\
This works for all requesters, not just rt.EZRequest()!",
              "Amazing", NIL, NIL,
              rt.ReqPos, rt.ReqPosTopLeftScr, u.end);

  rt.vEZRequestTags ("Alternatively, you can center the\n\
requester on the screen.\n\
Check out 'reqtools.doc' for all the possibilities.",
              "I'll do that", NIL, NIL,
              rt.ReqPos, rt.ReqPosCenterScr, u.end);

  rt.vEZRequest ("NUMBER 4:\nFile requester\n\
function: rt.FileRequest()", "Demonstrate", NIL, NIL);

  filereq := rt.AllocRequestA (rt.TypeFileReq, NIL);
  IF filereq # NIL THEN

    (* $IF DoHook *)
    myhook.entry := hookfunc;
    filereq.hook := y.ADR (myhook);
    INCL (filereq.flags, rt.fReqDoWildFunc);

    (* $IF SmallCode *)
    olduser := e.exec.thisTask^.userData;
    e.exec.thisTask^.userData := y.REG (8+5);
    (* $END *)

    (* $END *)


    filename := "";
    IF rt.FileRequest (filereq, filename, "Pick a file", u.end) THEN
      adr := y.ADR (filename); adr2 := filereq.dir;
       rt.vEZRequest ("You picked the file:\n'%s'\nin directory:\n'%s'",
               "Right", NIL, NIL, adr, adr2);
    ELSE
      rt.vEZRequest ("You didn't pick a file.", "No", NIL, NIL);
    END;

    (* $IF DoHook *)
    (* $IF SmallCode *)
    e.exec.thisTask^.userData := olduser;
    (* $END *)
    (* $END *)

    rt.FreeRequest (filereq);
  ELSE
    rt.vEZRequest ("Out of memory!", "Oh boy!", NIL, NIL);
  END;

  rt.vEZRequest ("The file requester can be used\n\
as a directory requester as well.",
           "Let'see that", NIL, NIL);

  filereq := rt.AllocRequestA (rt.TypeFileReq, NIL);
  IF filereq # NIL THEN
    IF rt.FileRequest (filereq, filename, "Pick a directory",
                 rt.fiFlags, y.VAL (LONGINT, LONGSET {rt.fReqNoFiles}), u.end) THEN
      adr := filereq.dir;
      rt.vEZRequest ("You picked the directory:\n'%s'",
               "Right", NIL, NIL, adr);
    ELSE
      rt.vEZRequest ("You didn't pick a directory.", "No", NIL, NIL);
    END;

    rt.FreeRequest (filereq);
  ELSE
    rt.vEZRequest ("Out of memory!", "Oh boy!", NIL, NIL);
  END;

  rt.vEZRequest ("NUMBER 5:\nFont requester\nfunction: rt.FontRequest()",
           "Show", NIL, NIL);

  fontreq := rt.AllocRequestA (rt.TypeFontReq, NIL);
  IF fontreq # NIL THEN
    fontreq.flags := LONGSET {rt.fReqStyle, rt.fReqColorFonts};

    (* $IF DoHook *)
    myhook.entry := hookfunc;
    fontreq.hook := y.ADR (myhook);
    INCL (fontreq.flags, rt.fReqDoWildFunc);

    (* $IF SmallCode *)
    olduser := e.exec.thisTask^.userData;
    e.exec.thisTask^.userData := y.REG (8+5);
    (* $END *)

    (* $END *)

    IF rt.FontRequest (fontreq, "Pick a font", u.end) THEN
      adr := fontreq.attr.name; adr2 := fontreq.attr.ySize;
      rt.vEZRequest ("You picked the font:\n'%s'\nwith size:\n'%ld'",
               "Right", NIL, NIL,
               adr, adr2);
    ELSE
      rt.vEZRequest ("You canceled.\nWas there no font you liked ?",
               "Nope", NIL, NIL);
    END;

    (* $IF DoHook *)
    (* $IF SmallCode *)
    e.exec.thisTask^.userData := olduser;
    (* $END *)
    (* $END *)

    rt.FreeRequest (fontreq);
  ELSE
    rt.vEZRequest ("Out of memory!", "Oh boy!", NIL, NIL);
  END;

  rt.vEZRequest ("NUMBER 6:\nPalette requester\nfunction: rt.PaletteRequest()",
           "Proceed", NIL, NIL);

  color := rt.PaletteRequest ("Change palette", NIL, u.end);
  IF color = -1 THEN
    rt.vEZRequest ("You canceled.\nNo nice colors to be picked ?",
             "Nah", NIL, NIL);
  ELSE
    rt.vEZRequest ("You picked color number %ld.", "Sure did",
             NIL, NIL, color);
  END;

  myputs ("\nFinished, hope you enjoyed the demo :-)\n");
END ReqToolsDemo.
