(* ------------------------------------------------------------------------
  :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.0m [Frank Lömker] 24-Feb-92 Umsetzung nach Modula
  :Copyright.     Freeware
  :Language.      Modula
  :Translator.    M2Amiga V4.0d
  :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;
(*$ DEFINE DoHook:=FALSE *)

FROM GraphicsD IMPORT TextAttrPtr;
FROM DosL IMPORT Output,Write,Delay;
FROM DosD IMPORT FileInfoBlockPtr;
FROM IntuitionD IMPORT IDCMPFlags,IDCMPFlagSet;
FROM SYSTEM IMPORT ADDRESS,ADR,SETREG,REG,TAG,CAST,LONGSET,ASSEMBLE;
FROM UtilityD IMPORT Hook,HookPtr,tagEnd,TagItemPtr;
FROM ExecD IMPORT execBase,TaskPtr;
FROM String IMPORT Length;
IMPORT rt: ReqTools;
FROM ReqToolsSupport IMPORT EZRequest,vEZRequest,EZRequestTags,vEZRequestTags;

VAR tagbuf:ARRAY [0..3] OF LONGINT;
    filereq: rt.FileRequesterPtr;
    fontreq: rt.FontRequesterPtr;
    myhook: Hook;
    buffer: ARRAY [0..127] OF CHAR;
    filename: ARRAY [0..33] OF CHAR;
    longnum, ret, color: LONGINT;
    adr, adr2: ADDRESS;

PROCEDURE myputs (str: ARRAY OF CHAR);
BEGIN
  IF Output() # NIL THEN
    (*$ StackParms:=TRUE *)
    SETREG (0,Write (Output(), ADR(str), Length (str) ));
    (*$ POP StackParms *)
  END;
END myputs;

(*$ IF DoHook *)
(*$ StackChk:=FALSE SaveA4:=TRUE *)
PROCEDURE hookfunc (hook{8}: HookPtr;
                    object{10}: ADDRESS;
                    message{9}: ADDRESS): ADDRESS;
VAR fib: FileInfoBlockPtr;
    ta: TextAttrPtr;
    param: POINTER TO ARRAY [0..1] OF ADDRESS;
    n:POINTER TO ARRAY [0..127] OF CHAR;
BEGIN
  SETREG (12,hook^.data);
  param := message;
  CASE CAST (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];
      n:=ta^.name;
      myputs (n^); (* May contain odd Pointer :-( *)
      myputs ("\n");   (* ^ Bei mir (Frank) hat es funktioniert *)
      RETURN 0;
  ELSE
    RETURN 0;
  END;
END hookfunc;
(*$ POP StackChk *)
(*$ ENDIF *)

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

  Delay (60);

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

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

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

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

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

  IF NOT rt.GetLong (longnum,ADR("Enter a number:"), NIL,
                     TAG(tagbuf,rt.glShowDefault,FALSE,tagEnd)) THEN
    vEZRequest (ADR("You entered nothing :-("),ADR("I'm sorry"),NIL, NIL, NIL);

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

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

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

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

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

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

  ret := EZRequestTags (ADR("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."),
                  ADR("1|2|3|4|5|0"), NIL, NIL,
                  TAG(tagbuf,rt.ezDefaultResponse, 4, tagEnd));
  adr:=ADR(ret);
  vEZRequest (ADR("You picked '%ld'."),ADR("How true"), NIL, NIL,adr);
  adr := ADR ("five");
  adr:=TAG(tagbuf,5,adr);
  vEZRequest (
    ADR("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()."),
    ADR("Proceed"), NIL, NIL,adr);

  IF (diskInserted IN CAST (IDCMPFlagSet,EZRequestTags
             (ADR("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)."),
              ADR("Continue"), NIL, NIL,
              TAG(tagbuf,rt.IDCMPFlags,IDCMPFlagSet{diskInserted},tagEnd)))) THEN
    vEZRequest (ADR("You inserted a disk."),ADR("I did"),NIL, NIL, NIL);
  ELSE
    vEZRequest (ADR("You used the 'Continue' gadget\n"+
          "to satisfy the requester."),ADR("I did"),NIL, NIL, NIL);
  END;

  vEZRequestTags (ADR("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()!"),
              ADR("Amazing"), NIL, NIL,
              TAG(tagbuf,rt.ReqPos, rt.ReqPosTopLeftScr, tagEnd));

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

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

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

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

    myhook.data:=REG (8+4);

    (*$ ENDIF *)


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

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

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

  filereq := rt.AllocRequestA (rt.TypeFileReq, NIL);
  IF filereq # NIL THEN
    IF rt.FileRequest (filereq, ADR(filename),ADR("Pick a directory"),
             TAG(tagbuf,rt.fiFlags,LONGSET {rt.fReqNoFiles},tagEnd)) THEN
      adr := ADR(filereq^.dir);
      vEZRequest (ADR("You picked the directory:\n'%s'"),
                     ADR("Right"), NIL, NIL, adr);
    ELSE
      vEZRequest (ADR("You didn't pick a directory."),ADR("No"),NIL, NIL, NIL);
    END;
    rt.FreeRequest (filereq);
  ELSE
    vEZRequest (ADR("Out of memory!"),ADR("Oh boy!"),NIL, NIL, NIL);
  END;

  vEZRequest (ADR("NUMBER 5:\nFont requester\nfunction: rt.FontRequest()"),
                 ADR("Show"),NIL, 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 := ADR (myhook);
    INCL (fontreq^.flags, rt.fReqDoWildFunc);

    myhook.data:=REG (8+4);

    (*$ ENDIF *)

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

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

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

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

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