program reqtoolsdemo;

{

    Working ReqTools demo

    Compiled under PCQ Pascal 1.2d, Sept 12 1992        Chris Pressey


    NB.  The font requester crashes on my system, so I have added an option
         to cancel the demonstration of rtFontRequest().

    This is a rather quick and dirty port, I will clean it up when I get
    around to it ;-)

}

{$I "Utility.i"}
{$I "ReqTools.i"}
{$I "Include:Utils/StringLib.i"}

const   DISKINSERTED=$00008000;

var     filereq         : rtFileRequesterPtr;
        fontreq         : rtFontRequesterPtr;
        inforeq         : rtReqInfoPtr;
        scrnreq         : rtScreenModeRequesterPtr;
        filterhook,
        font_filterhook : Hook;
        buffer          : String;
        filename        : String;
        longnum         : Integer;;
        ret             : Integer;
        color           : Integer;
        mytag           : reqtaglistPtr;
        values          : argarray;
        ff              : FileInfoBlock;
        tt              : TextAttrPtr;
            
function filterfunc(Hook: Hook; filereq: rtFileRequesterPtr;
                    fib: FileInfoBlock): Boolean;

var naam:String;

begin
{    naam:=Char(@fib^.fib_FileName);}
{    writeln(naam);}
    filterfunc:=TRUE;
end;

function font_filterfunc(Hook: Hook; fontreq: rtFontRequesterPtr;
                         textatt: TextAttrPtr): Boolean;

begin
{    writeln(textatt^.ta_Name^);}
    font_filterfunc:=TRUE;
end;

begin
RTBase:=ReqToolsBasePtr(OpenLibrary(REQTOOLSNAME,REQTOOLSVERSION));
    if(RTBase=NIL) then 
        begin
            writeln("You need reqtools.library V38 or higher!");
            writeln;
            writeln("Please install it in your Libs: directory.");
            exit;
        end;
    writeln("reqtools Demo (PCQ)");
    writeln("-------------");
    writeln("This program demonstrates what reqtools.library has to offer.");

    Delay (60);
    ret:=rtEZRequestA("\"reqtools.library\" offers several\ndifferent types of requesters:",
                     "Let's see them", NIL, NIL, NIL);

    ret:=rtEZRequestA("NUMBER 1:\nThe larch",
                     "Be serious!", NIL, NIL, NIL);

    ret:=rtEZRequestA("NUMBER 1:\nString requester\nfunction: rtGetString()",
                     "Show me", NIL, NIL, NIL);

    buffer:=allocstring (128);      { This should alloc'd to maxchars + 1 }

    strcpy (buffer, "Type in anything");

    ret:=rtGetStringA (buffer, 127, "Enter anything:", NIL, NIL);
    values[0]:=Integer(buffer);
    if (ret=0) then 
        ret:=rtEZRequestA("You entered nothing","I'm sorry", NIL, NIL, NIL)
    else
        ret:=rtEZRequestA("You entered this string:\n%s","So I did", NIL, @values[0], NIL);
        
    strcpy (buffer, "It is possible to have several responses");

    new(mytag);
    mytag^[0].ti_Tag:=RTGS_GadFmt;
    mytag^[0].ti_Data:=Integer(" OK | New 2.0 feature | Cancel ");
    mytag^[1].ti_Tag:=TAG_END;

    ret:=rtGetStringA (buffer, 127, "* New for ReqTools 2.0 *",
                NIL , mytag);

    ret:=rtEZRequestA ("NUMBER 2:\nNumber requester\nfunction: rtGetLong()",
                     "Show me", NIL, NIL, NIL);

    mytag^[0].ti_Tag:=RTGL_ShowDefault;
    mytag^[0].ti_Data:=Integer(FALSE);
    mytag^[1].ti_Tag:=TAG_END;
    
    ret:=rtGetLongA (adr (longnum), "Enter a number:", NIL, mytag);

    values[0]:= longnum;

    if(ret=0) then 
        ret:=rtEZRequestA("You entered nothing","I'm sorry", NIL, NIL, NIL)
    else
        ret:=rtEZRequestA("The number You entered was: \n%ld" ,
                     "So it was", NIL, @values[0], NIL);

    mytag^[0].ti_Tag:=RTGL_ShowDefault;
    mytag^[0].ti_Data:=Integer(FALSE);
    mytag^[1].ti_Tag:=RTGL_GadFmt;
    mytag^[1].ti_Data:=Integer("Ok|V38 feature|Cancel");
    mytag^[2].ti_Tag:=TAG_END;

    ret:=rtGetLongA (adr(longnum), "* New for ReqTools 2.0 *", NIL, mytag);

    ret:=rtEZRequestA ("NUMBER 3:\nNotification requester, the requester\nyou've been using all the time!\nfunction: rtEZRequestA()",
                     "Show me more", NIL, NIL, NIL);

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

    ret:=rtEZRequestA ("You can also use two gadgets to\nask the user something.\nDo you understand?",
                        "Of course|Not really", NIL, NIL, NIL);
    while ret=0 do
    begin
        ret:=rtEZRequestA ("You are not one of the brightest are you?\nWe'll try again...","Ok", NIL, NIL, NIL);
        ret:=rtEZRequestA ("You can also use two gadgets to\nask the user something.\nDo you understand?",
                         "Of course|Not really", NIL, NIL, NIL)
    end;

    ret:=rtEZRequestA ("Great, we'll continue then.", "Fine", NIL, NIL, NIL);

    ret:=rtEZRequestA ("You can also put up a requester with\nthree choices.\nHow do you like the demo so far ?",
                                "Great|So so|Rubbish", NIL, NIL, NIL);
    case ret of
        0:    ret:=rtEZRequestA ("Too bad, I really hoped you\nwould like it better.",
                             "So what", NIL, NIL, NIL);
        1:
            ret:=rtEZRequestA ("I'm glad you like it so much.","Fine", NIL, NIL, NIL);
        2:
            ret:=rtEZRequestA ("Maybe if you run the demo again\nyou'll REALLY like it.",
                             "Perhaps", NIL, NIL, NIL);
        end;
        
    mytag^[0].ti_Tag:=RTEZ_DefaultResponse;
    mytag^[0].ti_Data:=4;
    mytag^[1].ti_Tag:=TAG_END;

    ret :=rtEZRequestA ("The number of responses is not limited to three\nas you can see.  The gadgets are labeled with\nthe 'Return' code from rtEZRequestA().\nPressing 'Return' will choose 4, note that\n'4's button text is printed in boldface.",
                                  "1|2|3|4|5|0", NIL, NIL,
                                  mytag);
    
    values[0]:=Integer(ret);
    
    ret:=rtEZRequestA ("You picked %ld", "How true", NIL, @values[0], NIL);

    mytag^[0].ti_Tag:=RT_Underscore;
    mytag^[0].ti_Data:=Integer('_');
    mytag^[1].ti_Tag:=TAG_END;

    ret:=rtEZRequestA ("New for Release 2.0 of ReqTools (V38) is\nthe possibility to define characters in the\nbuttons as keyboard shortcuts.\nAs you can see these characters are underlined.\nNote that pressing shift while still holding\ndown the key will cancel the shortcut.",
                      "_Great|_Fantastic|_Swell|Oh _Boy",
                          NIL, NIL, mytag);

    values[0]:=5;
    values[1]:=Integer("five");
    
    ret:=rtEZRequestA ("You may also use C-style formatting codes in the body text.\nLike this:\n\nThe number %%ld is written %%s. will give:\n\nThe number %ld is written %s.\n\nif you also pass '5' and 'five' to rtEZRequestA().",
        "_Proceed", NIL, @values[0], mytag);
    
        mytag^[0].ti_Tag:=RT_IDCMPFlags;
        mytag^[0].ti_Data:=DISKINSERTED;
        mytag^[1].ti_Tag:=RT_Underscore;
        mytag^[1].ti_Data:=Integer('_');
        mytag^[2].ti_Tag:=TAG_END;

        ret:=rtEZRequestA ("It is also possible to pass extra IDCMP flags\nthat will satisfy rtEZRequestA(). This requester\nhas had DISKINSERTED passed to it.\n(Try inserting a disk).",
                               "_Continue", NIL, NIL, mytag);

    if ((ret=DISKINSERTED)) then
        ret:=rtEZRequestA ("You inserted a disk.", "I did", NIL, NIL, NIL)
    else
        ret:=rtEZRequestA ("You used the 'Continue' gadget\nto satisfy the requester.", "I did", NIL, NIL, NIL);

    mytag^[0].ti_Tag:=RT_ReqPos;
    mytag^[0].ti_Data:=Integer(REQPOS_TOPLEFTSCR);
    mytag^[1].ti_Tag:=RT_Underscore;
    mytag^[1].ti_Data:=Integer('_');
    mytag^[2].ti_Tag:=TAG_END;

    ret:=rtEZRequestA ("Finally, it is possible to specify the position\nof the requester.\nE.g. at the top left of the screen, like this.\nThis works for all requesters, not just rtEZRequestA()!",
                          "_Amazing", NIL, NIL, mytag);

    mytag^[0].ti_Tag:=RT_ReqPos;
    mytag^[0].ti_Data:=Integer(REQPOS_CENTERSCR);
    mytag^[1].ti_Tag:=TAG_END;

    ret:=rtEZRequestA ("Alternatively, you can center the\nrequester on the screen.\nCheck out 'reqtools.doc' for all the possibilities.",
                          "I'll do that", NIL, NIL,
                          mytag);

    mytag^[0].ti_Tag:=RT_Underscore;
    mytag^[0].ti_Data:=Integer('_');
    mytag^[1].ti_Tag:=TAG_END;

    ret:=rtEZRequestA ("NUMBER 4:\nFile requester\nfunction: rtFileRequest()",
                          "_Demonstrate", NIL, NIL, mytag);

    filereq:=Address(rtAllocRequestA (RT_FILEREQ, NIL));
    
    if (filereq<>NIL) then
    begin
{        filterhook.h_Entry^ := Integer(filterfunc(filterhook,filereq,ff));
        mytag^[0].ti_Tag:=RTFI_FilterFunc;
        mytag^[0].ti_Data:=Integer(@filterhook);
        mytag^[1].ti_Tag:=TAG_END;
}        
        filename := AllocString (80);
        strcpy (filename, "");
        ret:=rtFileRequestA (filereq, filename, "Pick a file", NIL);
        if(ret<>0) then
            begin
                values[0]:=Integer(filename);
                values[1]:=Integer(@filereq^.Dir^);
                ret:=rtEZRequestA ("You picked the file:\n%s\nin directory:\n%s",
                                    "Right", NIL, @values[0], NIL)
            end
        else
            ret:=rtEZRequestA ("You didn't pick a file.", "No", NIL, NIL, NIL);

        ret:=rtFreeRequest(filereq)
    end
    else
        ret:=rtEZRequestA ("Out of memory!", "Oh boy!", NIL, NIL, NIL);

    ret:=rtEZRequestA ("The file requester can be used\nas a directory requester as well.",
                       "Let's _see that", NIL, NIL, mytag);

    filereq := Address(rtAllocRequestA (RT_FILEREQ, NIL));
    if (filereq<>NIL) then
        begin
            mytag^[0].ti_Tag:=RTFI_Flags;
            mytag^[0].ti_Data:=FREQF_NOFILES;
            mytag^[1].ti_Tag:=TAG_END;

            ret:=rtFileRequestA (filereq, filename, "Pick a directory",mytag);
            values[0]:=Integer(@filereq^.Dir^);
            if(ret=1) then
                ret:=rtEZRequestA ("You picked the directory:\n%s",
                             "Right", NIL, @values[0], NIL)
            else
                ret:=rtEZRequestA ("You didn't pick a directory.", "No", NIL, NIL, NIL);

            ret:=rtEZRequestA ("You can also change the Height of the requester", "Wow", NIL, NIL, NIL);

            mytag^[0].ti_Tag:=RTFI_Flags;
            mytag^[0].ti_Data:=FREQF_NOFILES;
            mytag^[1].ti_Tag:=RTFI_Height;
            mytag^[1].ti_Data:=Integer(250);
            mytag^[2].ti_Tag:=TAG_END;

            ret:=rtFileRequestA (filereq, filename, "Pick a directory",mytag);
            values[0]:=Integer(@filereq^.Dir^);
            if(ret=1) then
                ret:=rtEZRequestA ("You picked the directory:\n%s",
                             "Right", NIL, @values[0], NIL)
            else
                ret:=rtEZRequestA ("You didn't pick a directory.", "No", NIL, NIL, NIL);

            ret:=rtEZRequestA ("You can also change the OK_GADGET", "Great", NIL, NIL, NIL);

            mytag^[0].ti_Tag:=RTFI_Flags;
            mytag^[0].ti_Data:=FREQF_NOFILES;
            mytag^[1].ti_Tag:=RTFI_OkText;
            mytag^[1].ti_Data:=Integer("_Remove");
            mytag^[2].ti_Tag:=RT_UnderScore;
            mytag^[2].ti_Data:=Integer('_');
            mytag^[3].ti_Tag:=TAG_END;

            ret:=rtFileRequestA (filereq, filename, "Remove a directory",mytag);
            values[0]:=Integer(@filereq^.Dir^);
            if(ret=1) then
                ret:=rtEZRequestA ("You picked the directory:\n%s",
                             "Right", NIL, @values[0], NIL)
            else
                ret:=rtEZRequestA ("You didn't pick a directory.", "No", NIL, NIL, NIL);

            ret:=rtFreeRequest(filereq);
            filereq := Address(rtAllocRequestA (RT_FILEREQ, NIL));            
            ret:=rtEZRequestA ("You can also use it as a Disk-requester", "Perfect", NIL, NIL, NIL);

            mytag^[0].ti_Tag:=RTFI_VolumeRequest;
            mytag^[0].ti_Data:=VREQF_ALLDISKS or VREQF_NOASSIGNS;
            mytag^[1].ti_Tag:=RTFI_OkText;
            mytag^[1].ti_Data:=Integer("Un_Mount");
            mytag^[2].ti_Tag:=RT_UnderScore;
            mytag^[2].ti_Data:=Integer('_');
            mytag^[3].ti_Tag:=TAG_END;

            ret:=rtFileRequestA (filereq, filename, "Unmount a device",mytag);
            values[0]:=Integer(@filereq^.Dir^);
            if(ret=1) then
                ret:=rtEZRequestA ("You picked the device:\n%s",
                             "Right", NIL, @values[0], NIL)
            else
                ret:=rtEZRequestA ("You didn't pick a device.", "No", NIL, NIL, NIL);
        ret:=rtFreeRequest (filereq)
        end
    else
        ret:=rtEZRequestA ("Out of memory!", "Oh boy!", NIL, NIL, NIL);

    mytag^[0].ti_Tag:=RTEZ_DefaultResponse;
    mytag^[0].ti_Data:=4;
    mytag^[1].ti_Tag:=TAG_END;

    ret:=rtEZRequestA ("NUMBER 5:\nFont requester\nfunction: rtFontRequest()",
                          "Show|Cancel", NIL, NIL, NIL);

    if ret <> 0 then
        begin
        fontreq := Address(rtAllocRequestA (RT_FONTREQ, NIL));
        if (fontreq<>NIL) then
        begin
            fontreq^.Flags := FREQF_STYLE or FREQF_COLORFONTS;
    {        font_filterhook.h_Entry^ := Integer(font_filterfunc(font_filterhook,fontreq,tt));
            mytag^[0].ti_Tag:=RTFO_FilterFunc;
            mytag^[0].ti_Data:=Integer(@font_filterhook);
            mytag^[1].ti_Tag:=TAG_END;
    }        
            ret:=rtFontRequestA (fontreq, "Pick a font", NIL);
            if(ret<>0) then
            begin
                values[0]:=Integer(fontreq^.Attr.ta_Name);
                values[1]:=Integer(fontreq^.Attr.ta_YSize);
                ret:=rtEZRequestA ("You picked the font:\n%s\nwith size:\n%ld",
                                   "Right", NIL, @values[0], NIL)
            end
            else
                ret:=rtEZRequestA ("You didn't pick a font","I know", NIL, NIL, NIL);
            ret:=rtFreeRequest (fontreq);
        end
        else         ret:=rtEZRequestA ("Out of memory!", "Oh boy!", NIL, NIL, NIL);
    end;

    inforeq := Address(rtAllocRequestA (RT_REQINFO, NIL));
    if (inforeq<>NIL) then
    begin
        inforeq^.Flags := EZREQF_CENTERTEXT;
        ret:=rtEZRequestA ("With rtAllocRequestA (RT_REQINFO, NIL)\nyou can center the text in the requester", "Got it", inforeq, NIL, NIL);
        ret:=rtFreeRequest (inforeq);
    end
    else         ret:=rtEZRequestA ("Out of memory!", "Oh boy!", NIL, NIL, NIL);

    ret:=rtEZRequestA ("NUMBER 6:\nScreenMode requester\nfunction: rtScreenModeRequestA()",
                          "Proceed", NIL, NIL, NIL);

    scrnreq := Address(rtAllocRequestA (RT_SCREENMODEREQ, NIL));
    if (scrnreq<>NIL) then
    begin
        mytag^[0].ti_Tag:=RTSC_Flags;
        mytag^[0].ti_Data:=SCREQF_DEPTHGAD or SCREQF_SIZEGADS or SCREQF_AUTOSCROLLGAD or SCREQF_OVERSCANGAD;
        mytag^[1].ti_Tag:=RT_UnderScore;
        mytag^[1].ti_Data:=Integer('_');
        mytag^[2].ti_Tag:=TAG_END;

        ret:=rtScreenModeRequestA ( scrnreq, "Pick a screenmode", mytag);
        values[0]:=Integer(scrnreq^.DisplayID);
        values[1]:=Integer(scrnreq^.DisplayWidth);
        values[2]:=Integer(scrnreq^.DisplayHeight);
        values[3]:=Integer(scrnreq^.DisplayDepth);
        values[4]:=Integer(scrnreq^.OverscanType);
        if (Boolean(scrnreq^.AutoScroll)) then
            values[5]:=Integer("On")
        else values[5]:=Integer("Off");

        if(ret=1) then
            ret:=rtEZRequestA ("You picked this mode:\nModeID   : 0x%lx\nSize     : %ld x %ld\nDepth    : %ld\nOverscan : %ld\nAutoScroll %s",
                               "Right", NIL, @values[0], NIL)
        else
            ret:=rtEZRequestA ("You didn't pick a screen mode.", "Sorry", NIL, NIL, NIL);
        ret:=rtFreeRequest (scrnreq);
    end
    else
        ret:=rtEZRequestA ("Out of memory!", "Oh boy!", NIL, NIL, NIL);

    mytag^[0].ti_Tag:=RT_Underscore;
    mytag^[0].ti_Data:=Integer('_');
    mytag^[1].ti_Tag:=TAG_END;

    ret:=rtEZRequestA ("NUMBER 7:\nPalette requester\nfunction: rtPaletteRequest()",
                          "_Proceed", NIL, NIL, mytag);

    color := rtPaletteRequestA ("Change palette", NIL, NIL);
    if (color = -1) then
        ret:=rtEZRequestA ("You canceled.\nNo nice colors to be picked ?",
                         "Nah", NIL, NIL, NIL)
    else
        ret:=rtEZRequestA ("You picked color number %ld.", "Sure did",
                         NIL, @color, NIL);

    CloseLibrary (LibraryPtr(RTBase));
    writeln;
    writeln ("Finished, hope you enjoyed the demo");
    writeln;
end.