(* ------------------------------------------------------------------------
  :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
  :History.       v2.0m [Frank Lömker] 10-Aug-92 ReqTools V38
  :Copyright.     Public Domain
  :Language.      Modula
  :Translator.    M2Amiga V4.0d
  :Imports.       ReqTools, ReqToolsSupport
  :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 (V38)        *
*                                *
*  Release 2.0                   *
*                                *
*  (c) 1991/1992 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;
FROM DosD IMPORT FileInfoBlockPtr;
FROM IntuitionD IMPORT IDCMPFlags,IDCMPFlagSet;
FROM SYSTEM IMPORT ADDRESS,ADR,SETREG,REG,TAG,CAST,LONGSET;
FROM Arts IMPORT kickVersion;
FROM UtilityD IMPORT Hook,HookPtr,tagEnd;
FROM String IMPORT Length;
IMPORT rt: ReqTools;
FROM ReqToolsSupport IMPORT EZRequest,vEZRequest,EZRequestTags,vEZRequestTags;

VAR tagbuf:ARRAY [0..11] OF LONGINT;
    filereq: rt.FileRequesterPtr;
    fontreq: rt.FontRequesterPtr;
    scrmodereq: rt.ScreenModeRequesterPtr;
    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 FileFilterfunc (hook{8}: HookPtr;
                      filereq{10}: ADDRESS;
                      fib{9}: ADDRESS):ADDRESS;
BEGIN
  SETREG (12,hook^.data);
  myputs (CAST(FileInfoBlockPtr,fib)^.fileName); myputs ("\n");
  RETURN ADDRESS(TRUE);
END FileFilterfunc;
(*$ POP StackChk *)

(*$ StackChk:=FALSE SaveA4:=TRUE *)
PROCEDURE FontFilterfunc (hook{8}: HookPtr;
                          fontreq{10}: ADDRESS;
                          textattr{9}: ADDRESS):ADDRESS;
VAR n:POINTER TO ARRAY [0..127] OF CHAR;
BEGIN
  SETREG (12,hook^.data);
  n:=CAST(TextAttrPtr,textattr)^.name;
  myputs (n^); (* May contain odd Pointer :-( *)
  myputs ("\n");   (* ^ Bei mir (Frank) hat es funktioniert *)
  RETURN  ADDRESS(TRUE);
END FontFilterfunc;
(*$ POP StackChk *)

(*$ StackChk:=FALSE SaveA4:=TRUE *)
PROCEDURE VolFilterfunc (hook{8}: HookPtr;
                         filereq{10}: ADDRESS;
                         volentry{9}: ADDRESS):ADDRESS;
VAR n:POINTER TO ARRAY [0..127] OF CHAR;
BEGIN
  SETREG (12,hook^.data);
  IF CAST(rt.VolumeEntryPtr,volentry)^.type=0 THEN myputs ("(Volume) ");
                                              ELSE myputs ("(Assign) "); END;
  n:=CAST(rt.VolumeEntryPtr,volentry)^.name;
  myputs (n^); myputs ("\n");
  RETURN ADDRESS(TRUE);
END VolFilterfunc;
(*$ POP StackChk *)

(*$ ENDIF *)

BEGIN
  vEZRequest (ADR("ReqTools 2.0 Demo\n"+
              "~~~~~~~~~~~~~~~~~\n"+
              "'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;
  adr:=ADR(" _Ok |New _2.0 feature!|_Cancel");
  adr2:=ADR("These are two new features of ReqTools 2.0:\n"+
            "Text above the entry gadget and more than\n"+
            "one response gadget.");
  IF rt.GetString (ADR(buffer),127,ADR("Enter anything:"),NIL,
                   TAG(tagbuf,rt.gsGadFmt,adr,
                   rt.gsTextFmt,adr2,rt.Underscore,"_",tagEnd)) THEN END;
  adr:=ADR(" _Ok |_Abort|_Cancel");
  adr2:=ADR("New is also the ability to switch off the\n"+
            "backfill pattern.  You can also center the\n"+
            "text above the entry gadget.\n"+
            "These new features are also available in\n"+
            "the rtGetLong() requester.");
  IF rt.GetString (ADR(buffer), 127,ADR("Enter anything:"),NIL,
                   TAG(tagbuf,rt.gsGadFmt,adr,rt.gsTextFmt,adr2,
                   rt.gsBackfill,FALSE,
                   rt.gsFlags,LONGSET{rt.gsReqCenterText,rt.gsReqHighlightText},
                   rt.Underscore,"_",tagEnd)) THEN 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:\nMessage 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);
  vEZRequestTags (ADR("New for Release 2.0 of ReqTools (V38) is\n"+
                  "the possibility to define characters in the\n"+
                  "buttons as keyboard shortcuts.\n"+
                  "As you can see these characters are underlined.\n"+
                  "Pressing shift while still holding down the key\n"+
                  "will cancel the shortcut.\n"+
                  "Note that in other requesters a string gadget may\n"+
                  "be active.  To use the keyboard shortcuts there\n"+
                  "you have to keep the Right Amiga key pressed down."),
                  ADR("_Great|_Fantastic|_Swell|Oh _Boy"),
                  NIL,NIL,
                  TAG(tagbuf,rt.Underscore, '_', tagEnd));

  adr := ADR ("five"); tagbuf[5]:=5; tagbuf[6]:=adr;
  adr2:=ADR(tagbuf[5]);
  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, TAG(tagbuf,rt.Underscore,"_",tagEnd),adr2);

  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},rt.Underscore,"_",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,rt.Underscore,"_",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));

  adr:=TAG(tagbuf,rt.Underscore,"_",tagEnd);
  vEZRequest (ADR("NUMBER 4:\nFile requester\n"+
              "function: rt.FileRequest()"),ADR("_Demonstrate"),NIL,adr,NIL);

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

    (*$ IF DoHook *)
      myhook.entry := FileFilterfunc;
      myhook.data:=REG (8+4);
    (*$ ENDIF *)

    filename := ""; adr:=ADR(myhook);
    IF rt.FileRequest (filereq, ADR(filename),ADR("Pick a file"),TAG(tagbuf,
                       (*$ IF DoHook *) rt.fiFilterFunc,adr, (*$ ENDIF *)
                       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;  (* IF filereq # NIL *)

  adr:=TAG(tagbuf,rt.Underscore,"_",tagEnd);
  vEZRequest (ADR("The file requester can be used\n"+
              "as a directory requester as well."),
              ADR("Let's _see that"),NIL,adr,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;  (* IF filereq # NIL *)

  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 := FontFilterfunc;
      myhook.data:=REG (8+4);
    (*$ ENDIF *)

    adr:=ADR(myhook);
    IF rt.FontRequest (fontreq,ADR("Pick a font"),TAG(tagbuf,
                       (*$ IF DoHook *) rt.foFilterFunc,adr, (*$ ENDIF *)
                       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
      adr:=TAG(tagbuf,rt.Underscore,"_",tagEnd);
      vEZRequest (ADR("You canceled.\nWas there no font you liked ?"),
                  ADR("_Nope"),NIL,adr,NIL);
    END;

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

  adr:=TAG(tagbuf,rt.Underscore,"_",tagEnd);
  vEZRequest (ADR("NUMBER 6:\nPalette requester\nfunction: rt.PaletteRequest()"),
              ADR("_Proceed"),NIL,adr,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;

  adr:=TAG(tagbuf,rt.Underscore,"_",tagEnd);
  vEZRequest (ADR("NUMBER 7: (ReqTools 2.0)\n"+
              "Volume requester\n"+
              "function: rtFileRequest() with\n"+
              "          RTFI_VolumeRequest tag."),
              ADR("_Show me"), NIL,adr,NIL);

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

    (*$ IF DoHook *)
      myhook.entry := VolFilterfunc;
      myhook.data:=REG (8+4);
    (*$ ENDIF *)

    adr:=ADR(myhook);
    IF rt.FileRequest (filereq, NIL, ADR("Pick a volume"),
                       TAG(tagbuf,
                       (*$ IF DoHook *) rt.fiFilterFunc,adr, (*$ ENDIF *)
                       rt.fiVolumeRequest, 0, tagEnd)) THEN
      adr := ADR(filereq^.dir);
      vEZRequest (ADR("You picked the volume:\n'%s'"),
                  ADR("Right"), NIL, NIL, adr);
    ELSE
      vEZRequest (ADR("You didn't pick a volume."),ADR("I did not"),NIL,NIL,NIL);
    END;

    rt.FreeRequest (filereq);

  ELSE
    vEZRequest (ADR("Out of memory!"),ADR("Oh boy!"), NIL, NIL, NIL);
  END;  (* IF filereq # NIL *)

  adr:=TAG(tagbuf,rt.Underscore,"_",tagEnd);
  vEZRequest (ADR("NUMBER 8: (ReqTools 2.0)\n"+
              "Screen mode requester\n"+
              "function: rtScreenModeRequest()\n"+
              "Only available on Kickstart 2.0!"),
              ADR("_Proceed"), NIL,adr,NIL);

  IF kickVersion < 37 THEN
    adr:=TAG(tagbuf,rt.Underscore,"_",tagEnd);
    vEZRequest (ADR("Your Amiga doesn't seem to have\n"+
                "Kickstart 2.0 in ROM so I am not\n"+
                "able to show you the Screen mode\n"+
                "requester.\n"+
                "So upgrade to 2.0 *now* :-)"),
                ADR("_Allright"), NIL,adr,NIL);
  ELSE
    scrmodereq:=rt.AllocRequestA (rt.TypeScreenModeReq, NIL);
    IF scrmodereq#NIL THEN

      IF rt.ScreenModeRequest (scrmodereq,ADR("Pick a screen mode:"),
                   TAG(tagbuf,rt.scFlags,LONGSET{rt.scReqDepthGad,rt.scReqSizeGads,
                   rt.scReqAutoscrollGad,rt.scReqOverscanGad},tagEnd)) THEN
        IF scrmodereq^.autoScroll#0 THEN adr:=ADR("On");
                                    ELSE adr:=ADR("Off"); END;
        adr2:=TAG(tagbuf,scrmodereq^.displayID,
                  scrmodereq^.displayWidth,
                  scrmodereq^.displayHeight,
                  scrmodereq^.displayDepth,
                  scrmodereq^.overscanType,
                  adr);
        vEZRequest (ADR("You picked this mode:\n"+
                    "ModeID  : 0x%lx\n"+
                    "Size    : %ld x %ld\n"+
                    "Depth   : %ld\n"+
                    "Overscan: %ld\n"+
                    "AutoScroll %s"),
                    ADR("Right"), NIL, NIL,adr2);
      ELSE
        vEZRequest (ADR("You didn't pick a screen mode."),ADR("Nope"),NIL,NIL,NIL);
      END;  (*IF rt.ScreenModeRequest *)

      rt.FreeRequest (scrmodereq);
    ELSE
      vEZRequest (ADR("Out of memory!"),ADR("Oh boy!"),NIL,NIL,NIL);
    END;  (* IF scrmodereq#NIL *)
  END;  (* IF kickVersion < 37 *)
  vEZRequestTags (ADR("That's it!\nHope you enjoyed the demo"),
                  ADR("_Sure did"),NIL,NIL,
                  TAG(tagbuf,rt.Underscore,"_",tagEnd));
END ReqToolsDemo.
