PROGRAM RTDemo;

(*
**  This is a straight translation from demo.c
**  in the reqtools archive.
**
**  Check this demo for tips on how to use
**  reqtools in FPC Pascal.
**
**  nils.sjoholm@mailbox.swipnet.se  (Nils Sjoholm)
**
*)

uses reqtools, strings, utility,vartags;



CONST
    DISKINSERTED=$00008000;


VAR
    filereq         : prtFileRequester;
    fontreq         : prtFontRequester;
    scrnreq         : prtScreenModeRequester;
    filelist        : prtFileList;
    buffer          : PChar;
    filename        : PChar;
    dummy           : PChar;
    dummy2          : PChar;
    longnum         : Longint;
    ret             : Longint;
    color           : Longint;
    values          : ARRAY [0..5] OF Longint;
    undertag        : Array [0..1] of tTagItem;

FUNCTION GetScrollValue(value : INTEGER): STRING;
BEGIN
    IF value = 0 THEN GetScrollValue := 'Off'
    ELSE GetScrollValue := 'On';
END;

PROCEDURE CleanUp;
BEGIN
    if assigned(dummy) then StrDispose(dummy);
    if assigned(dummy2) then StrDispose(dummy2);
    if assigned(buffer) then StrDispose(buffer);
    if assigned(filename) then StrDispose(filename);
END;

BEGIN
    dummy:= StrAlloc(400);
    dummy2 := StrAlloc(200);

    undertag[0] := TagItem(RT_UnderScore,Longint(byte('_')));
    undertag[1].ti_Tag := TAG_END;

    rtEZRequestA('ReqTools 2.0 Demo' + #10 +
           '~~~~~~~~~~~~~~~~~' + #10 +
           '''reqtools.library'' offers several' + #10 +
           'different types of requesters:','Let''s see them', NIL, NIL, NIL);

    rtEZRequestA('NUMBER 1:' + #10 + 'The larch :-)',
                     'Be serious!', NIL, NIL, NIL);

    rtEZRequestA('NUMBER 1:' + #10 + 'String requester' + #10 + 'function:rtGetString()',
                     'Show me', NIL, NIL, NIL);

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

    StrPCopy(buffer, 'A bit of text');

    ret := rtGetStringA (buffer, 127, 'Enter anything:', NIL, NIL);
    values[0] := Longint(buffer);

    IF (ret=0) THEN
        rtEZRequestA('You entered nothing','I''m sorry', NIL, NIL, NIL)
    ELSE
        rtEZRequestA('You entered this string:' + #10 + '%s','So I did', NIL, 
@values[0], NIL);

    ret := rtGetStringA(buffer, 127, 'Enter anything:', NIL,TAGS(
                RTGS_GadFmt, longstr(' _Ok |New _2.0 feature!|_Cancel'),
                RTGS_TextFmt, longstr('These are two new features of ReqTools 2.0:' + #10
                + 'Text above the entry gadget and more than' + #10 + 'one response gadget.'),
                TAG_MORE, Longint(@undertag),0));

                      

    IF ret=2 THEN
        rtEZRequestA('Yep, this is a new' + #10 + 'ReqTools 2.0 feature!',
                       'Oh boy!',NIL,NIL,NIL);

    ret := rtGetStringA(buffer, 127, 'Enter anything:',NIL,TAGS(
                        RTGS_GadFmt,longstr(' _Ok | _Abort |_Cancel'),
                        RTGS_TextFmt,longstr('New is also the ability to switch off the' + #10 +
                        'backfill pattern.  You can also center the' + #10 +
                        'text above the entry gadget.' + #10 +
                        'These new features are also available in' + #10 +
                        'the rtGetLong() requester.'),
                        RTGS_BackFill, longint(byte(FALSE)),
                        RTGS_Flags, GSREQF_CENTERTEXT + GSREQF_HIGHLIGHTTEXT,
                        TAG_MORE, longint(@undertag),0));

    IF ret = 2 THEN
        rtEZRequestA('What!! You pressed abort!?!' + #10 + 'You must be joking :-)',
                             'Ok, Continue',NIL,NIL,NIL);

    rtEZRequestA ('NUMBER 2:' + #10 + 'Number requester' + #10 + 'function:rtGetLong()',
                     'Show me', NIL, NIL, NIL);

    ret := rtGetLongA(longnum, 'Enter a number:',NIL,TAGS(
                      RTGL_ShowDefault, longint(byte(FALSE)),
                      RTGL_Min, 0,
                      RTGL_Max, 666,
                      TAG_DONE));

    values[0] := Longint(longnum);

    IF(ret=0) THEN
        rtEZRequestA('You entered nothing','I''m sorry', NIL, NIL, NIL)
    ELSE
        rtEZRequestA('The number You entered was:'  + #10 + '%ld' ,
                     'So it was', NIL, @values[0], NIL);

    rtEZRequestA ('NUMBER 3:' + #10 + 'Notification requester, the requester' + #10 +
                         'you''ve been using all the time!' + #10 +
                         'function: rtEZRequestA()','Show me more', NIL, NIL, NIL);

    rtEZRequestA ('Simplest usage: some body text and' + #10 + 'a single centered gadget.',
                         'Got it', NIL, NIL, NIL);

    ret := 0;
    WHILE ret = 0 DO BEGIN
        ret := rtEZRequestA ('You can also use two gadgets to' + #10 +
                             'ask the user something' + #10 +
                             'Do you understand?',
                             'Of course|Not really', NIL, NIL, NIL);
        IF ret = 0 THEN rtEZRequestA ('You are not one of the brightest are you?' + 
                                       #10 + 'We''ll try again...',
                                      'Ok', NIL, NIL, NIL);
    END;

    rtEZRequestA ('Great, we''ll continue then.', 'Fine', NIL, NIL, NIL);

    ret:=rtEZRequestA ('You can also put up a requester with' + #10 +
                       'three choices.' + #10 +
                       'How do you like the demo so far ?',
                       'Great|So so|Rubbish', NIL, NIL, NIL);
    CASE ret OF
        0:  rtEZRequestA ('Too bad, I really hoped you' + #10 + 'would like it better.',
                               'So what', NIL, NIL, NIL);

        1:  rtEZRequestA ('I''m glad you like it so much.','Fine', NIL, NIL, NIL);

        2:  rtEZRequestA ('Maybe if you run the demo again' + #10 + 'you''ll REALLY like it.',
                               'Perhaps', NIL, NIL, NIL);
    END;

    ret := rtEZRequestA('The number of responses is not limited to three' + #10 +
                            'as you can see.  The gadgets are labeled with' + #10 +
                            'the ''Return'' code from rtEZRequestA().' + #10 +
                            'Pressing ''Return'' will choose 4, note that' + #10 +
                            '4''s button text is printed in boldface.',
                            '1|2|3|4|5|0', NIL, NIL,TAGS(
                            RTEZ_DefaultResponse, 4,
                            TAG_DONE));
                          
    values[0] := Longint(ret);
    rtEZRequestA('You picked ''%ld''.', 'How true', NIL, @values[0],NIL);

    {
      If i used just a string for this text is will be truncated
      after 255 chars. There are no strpcat in strings so we
      have to use two buffers and then use strcat.
    }
    strpcopy(dummy,'New for Release 2.0 of ReqTools (V38) is' + #10 +
                   'the possibility to define characters in the' + #10 +
                   'buttons as keyboard shortcuts.' + #10 +
                   'As you can see these characters are underlined.' + #10 +
                   'Pressing shift while still holding down the key' + #10 +
                   'will cancel the shortcut.' + #10);
    {
      The second buffer.
    }
    strpcopy(dummy2,'Note that in other requesters a string gadget may' + #10 +
                   'be active.  To use the keyboard shortcuts there' + #10 +
                   'you have to keep the Right Amiga key pressed down.');
    {
      Now put them together
    }
    strcat(dummy,dummy2);

    rtEZRequestA(dummy,'_Great|_Fantastic|_Swell|Oh _Boy',NIL,NIL,@undertag);


    values[0]:=5;
    values[1]:=Longstr('five');
    rtEZRequestA('You may also use C-style formatting codes in the body text.' + #10 +
                        'Like this:' + #10 +  + #10 +
                        'The number %%ld is written %%s. will give:' + #10 +  + #10 +
                        'The number %ld is written %s.' + #10 +  + #10 +
                        'if you also pass ''5'' and ''five'' to rtEZRequestA().',
                        '_Proceed',NIL,@values[0],@undertag);

    ret := rtEZRequestA('It is also possible to pass extra IDCMP flags' + #10 +
                        'that will satisfy rtEZRequest(). This requester' + #10 +
                        'has had DISKINSERTED passed to it.' + #10 +
                        '(Try inserting a disk).', '_Continue', NIL,NIL,TAGS(
                        RT_IDCMPFlags, DISKINSERTED,
                        TAG_MORE, Longint(@undertag),0));

    IF ((ret = DISKINSERTED)) THEN
        rtEZRequestA('You inserted a disk.', 'I did', NIL, NIL, NIL)
    ELSE
        rtEZRequestA('You Used the ''Continue'' gadget' + #10 +
                          'to satisfy the requester.','I did', NIL, NIL, NIL);

    rtEZRequestA('Finally, it is possible to specify the position' + #10 +
                        'of the requester.' + #10 +
                        'E.g. at the top left of the screen, like this.' + #10 +
                        'This works for all requesters, not just rtEZRequest()!',
                        '_Amazing', NIL,NIL,TAGS(
                        RT_ReqPos, REQPOS_TOPLEFTSCR,
                        TAG_MORE, longint(@undertag),0));

    rtEZRequestA('Alternatively, you can center the' + #10 +
                        'requester on the screen.' + #10 +
                        'Check out ''reqtools.doc'' for all the possibilities.',
                        'I''ll do that', NIL,NIL,TAGS(
                        RT_ReqPos, REQPOS_CENTERSCR,
                        TAG_MORE, Longint(@undertag),0));


    ret := rtEZRequestA('NUMBER 4:' + #10 + 'File requester' + #10 + 'function: rtFileRequest()',
                          '_Demonstrate', NIL, NIL, @undertag);

    filereq := rtAllocRequestA(RT_FILEREQ, NIL);

    IF (filereq<>NIL) THEN BEGIN
        filename := StrAlloc(80);
        strpcopy (filename, '');
        {
          We have to cast rtFileRequester to an Longint
          to keep the compiler happy.
        }
        ret := Longint(rtFileRequestA(filereq, filename, 'Pick a file', NIL));
        IF (ret)<>0 THEN begin
            values[0] := Longint(filename);
            values[1] := Longint(filereq^.Dir);
            rtEZRequestA('You picked the file:' + #10 + '%s' + #10 + 'in directory:'
                                + #10 + '%s', 'Right', NIL, @values[0],NIL)
        END
        ELSE
            rtEZRequestA('You didn''t pick a file.', 'No', NIL, NIL, NIL);

        rtEZRequestA('The file requester has the ability' + #10 +
                     'to allow you to pick more than one' + #10 +
                     'file (use Shift to extend-select).' + #10 +
                     'Note the extra gadgets you get.',
                     '_Interesting', NIL,NIL, @undertag);

        filelist := rtFileRequestA(filereq,filename,'Pick some files',TAGS(
                                   RTFI_Flags, FREQF_MULTISELECT,
                                   TAG_END));

        IF filelist <> NIL THEN BEGIN
            values[0] := Longint(filelist^.Name);
            rtEZRequestA('You selected some files, this is' + #10 +
                          'the first one:' + #10 +
                          '"%s"' + #10 +
                          'All the files are returned as a linked' + #10 +
                          'list (see demo.c and reqtools.h).',
                          'Aha', NIL, @values[0],NIL);
            (* Traverse all selected files *)
            (*
            tempflist = flist;
            while (tempflist) {
                DoSomething (tempflist->Name, tempflist->StrLen);
                tempflist = tempflist->Next;
                }
            *)
            (* Free filelist when no longer needed! *)
            rtFreeFileList(filelist);
        END;
        rtFreeRequest(filereq);
    END
    ELSE
        rtEZRequestA('Out of memory!', 'Oh boy!', NIL, NIL, NIL);

    rtEZRequestA('The file requester can be used' + #10 + 'as a directory requester as well.',
                    'Let''s _see that', NIL, NIL, @undertag);

    filereq := rtAllocRequestA(RT_FILEREQ, NIL);
    IF (filereq<>NIL) THEN BEGIN
        
         ret := Longint(rtFileRequestA(filereq, filename, 'Pick a directory',TAGS(
                                       RTFI_Flags, FREQF_NOFILES,
                                       TAG_END)));

         IF(ret=1) THEN begin
             values[0] := Longint(filereq^.Dir);
             rtEZRequestA('You picked the directory:' + #10 +'%s',
                          'Right', NIL, @values[0], NIL);
         end ELSE
             rtEZRequestA('You didn''t pick a directory.', 'No', NIL, NIL, NIL);

         rtFreeRequest(filereq);
    END
    ELSE
         ret := rtEZRequestA('Out of memory','No',NIL,NIL,NIL);

    rtEZRequestA('NUMBER 5:' + #10 +' Font requester' + #10 + 'function:rtFontRequest()',
                          'Show', NIL, NIL, NIL);

    fontreq := rtAllocRequestA(RT_FONTREQ, NIL);
    IF (fontreq<>NIL) THEN BEGIN
         fontreq^.Flags := FREQF_STYLE OR FREQF_COLORFONTS;
         ret := rtFontRequestA (fontreq, 'Pick a font', NIL);
         IF(ret<>0) THEN begin
             values[0] := Longint(fontreq^.Attr.ta_Name);
             values[1] := Longint(fontreq^.Attr.ta_YSize);
             rtEZRequestA('You picked the font:' + #10 + '%s' + #10 + 'with size:' + 
                          #10 + '%ld',
                         'Right', NIL, @values[0],NIL);
         end ELSE
             ret := rtEZRequestA('You didn''t pick a font','I know', NIL, NIL, NIL);
         rtFreeRequest(fontreq);
    END
    ELSE
         rtEZRequestA('Out of memory!', 'Oh boy!', NIL, NIL, NIL);

    rtEZRequestA('NUMBER 6:' + #10 + 'Palette requester' + #10 + 'function:rtPaletteRequest()',
                 '_Proceed', NIL,NIL, @undertag);

    color := rtPaletteRequestA('Change palette',NIL,NIL);
    IF (color = -1) THEN
        rtEZRequestA('You canceled.' + #10 + 'No nice colors to be picked ?',
                         'Nah', NIL, NIL, NIL)
    ELSE begin
        values[0] := Longint(color);
        rtEZRequestA('You picked color number %ld.', 'Sure did',
                         NIL, @values[0], NIL);
    END;

    rtEZRequestA('NUMBER 7: (ReqTools 2.0)' + #10 +
                 'Volume requester' + #10 +
                 'function: rtFileRequest() with' + #10 +
                 'RTFI_VolumeRequest tag.',
                 '_Show me', NIL, NIL, @undertag);

    filereq := rtAllocRequestA(RT_FILEREQ,NIL);
    IF (filereq <> NIL) THEN BEGIN
        
        ret := Longint(rtFileRequestA(filereq,NIL,'Pick a volume!',TAGS(
                                      RTFI_VolumeRequest,0,
                                      TAG_END)));
        IF (ret = 1) THEN begin
            values[0] := Longint(filereq^.Dir);
            rtEZRequestA('You picked the volume:' + #10 + '%s',
                        'Right',NIL, @values,NIL);
        end
        ELSE
            rtEZRequestA('You didn''t pick a volume.','I did not',NIL,NIL,NIL);
        rtFreeRequest(filereq);
    END
    ELSE
        rtEZRequestA('Out of memory','Oh boy!',NIL,NIL,NIL);

    rtEZRequestA('NUMBER 8: (ReqTools 2.0)' + #10 +
                 'Screen mode requester' + #10 +
                 'function: rtScreenModeRequest()' + #10 +
                 'Only available on Kickstart 2.0!',
                 '_Proceed', NIL, NIL, @undertag);

    scrnreq := rtAllocRequestA (RT_SCREENMODEREQ, NIL);
    IF (scrnreq<>NIL) THEN BEGIN
        
        ret := rtScreenModeRequestA( scrnreq, 'Pick a screen mode:',TAGS(
                                     RTSC_Flags, SCREQF_DEPTHGAD OR SCREQF_SIZEGADS OR
                                     SCREQF_AUTOSCROLLGAD OR SCREQF_OVERSCANGAD,
                                     TAG_END));

        IF(ret=1) THEN BEGIN
            values[0] := Longint(scrnreq^.DisplayID);
            values[1] := Longint(scrnreq^.DisplayWidth);
            values[2] := Longint(scrnreq^.DisplayHeight);
            values[3] := Longint(scrnreq^.DisplayDepth);
            values[4] := Longint(scrnreq^.OverscanType);
            values[5] := longstr(GetScrollValue(scrnreq^.AutoScroll));

            rtEZRequestA('You picked this mode:' + #10 +
                         'ModeID  : 0x%lx' + #10 +
                         'Size    : %ld x %ld' + #10 +
                         'Depth   : %ld' + #10 +
                         'Overscan: %ld' + #10 +
                         'AutoScroll %s',
                         'Right', NIL, @values, NIL);
        END
        ELSE
            rtEZRequestA('You didn''t pick a screen mode.', 'Sorry', NIL, NIL, NIL);
        rtFreeRequest (scrnreq);
    END
    ELSE
    rtEZRequestA('Out of memory!', 'Oh boy!', NIL, NIL, NIL);


    rtEZRequestA('That''s it!' + #10 + 'Hope you enjoyed the demo', '_Sure did', NIL, 
                    NIL,@undertag);
    CleanUp;
END.