home *** CD-ROM | disk | FTP | other *** search
/ Fresh Fish 5 / FreshFish_July-August1994.bin / bbs / util / reqtools-2.2b.lha / ReqTools-2.2b / Glue / PCQ / pcq_glue.lha / PCQDemoReq.p next >
Encoding:
Text File  |  1992-09-13  |  16.3 KB  |  418 lines
  1. program reqtoolsdemo;
  2.  
  3. {
  4.  
  5.     Working ReqTools demo
  6.  
  7.     Compiled under PCQ Pascal 1.2d, Sept 12 1992        Chris Pressey
  8.  
  9.  
  10.     NB.  The font requester crashes on my system, so I have added an option
  11.          to cancel the demonstration of rtFontRequest().
  12.  
  13.     This is a rather quick and dirty port, I will clean it up when I get
  14.     around to it ;-)
  15.  
  16. }
  17.  
  18. {$I "Utility.i"}
  19. {$I "ReqTools.i"}
  20. {$I "Include:Utils/StringLib.i"}
  21.  
  22. const   DISKINSERTED=$00008000;
  23.  
  24. var     filereq         : rtFileRequesterPtr;
  25.         fontreq         : rtFontRequesterPtr;
  26.         inforeq         : rtReqInfoPtr;
  27.         scrnreq         : rtScreenModeRequesterPtr;
  28.         filterhook,
  29.         font_filterhook : Hook;
  30.         buffer          : String;
  31.         filename        : String;
  32.         longnum         : Integer;;
  33.         ret             : Integer;
  34.         color           : Integer;
  35.         mytag           : reqtaglistPtr;
  36.         values          : argarray;
  37.         ff              : FileInfoBlock;
  38.         tt              : TextAttrPtr;
  39.             
  40. function filterfunc(Hook: Hook; filereq: rtFileRequesterPtr;
  41.                     fib: FileInfoBlock): Boolean;
  42.  
  43. var naam:String;
  44.  
  45. begin
  46. {    naam:=Char(@fib^.fib_FileName);}
  47. {    writeln(naam);}
  48.     filterfunc:=TRUE;
  49. end;
  50.  
  51. function font_filterfunc(Hook: Hook; fontreq: rtFontRequesterPtr;
  52.                          textatt: TextAttrPtr): Boolean;
  53.  
  54. begin
  55. {    writeln(textatt^.ta_Name^);}
  56.     font_filterfunc:=TRUE;
  57. end;
  58.  
  59. begin
  60. RTBase:=ReqToolsBasePtr(OpenLibrary(REQTOOLSNAME,REQTOOLSVERSION));
  61.     if(RTBase=NIL) then 
  62.         begin
  63.             writeln("You need reqtools.library V38 or higher!");
  64.             writeln;
  65.             writeln("Please install it in your Libs: directory.");
  66.             exit;
  67.         end;
  68.     writeln("reqtools Demo (PCQ)");
  69.     writeln("-------------");
  70.     writeln("This program demonstrates what reqtools.library has to offer.");
  71.  
  72.     Delay (60);
  73.     ret:=rtEZRequestA("\"reqtools.library\" offers several\ndifferent types of requesters:",
  74.                      "Let's see them", NIL, NIL, NIL);
  75.  
  76.     ret:=rtEZRequestA("NUMBER 1:\nThe larch",
  77.                      "Be serious!", NIL, NIL, NIL);
  78.  
  79.     ret:=rtEZRequestA("NUMBER 1:\nString requester\nfunction: rtGetString()",
  80.                      "Show me", NIL, NIL, NIL);
  81.  
  82.     buffer:=allocstring (128);      { This should alloc'd to maxchars + 1 }
  83.  
  84.     strcpy (buffer, "Type in anything");
  85.  
  86.     ret:=rtGetStringA (buffer, 127, "Enter anything:", NIL, NIL);
  87.     values[0]:=Integer(buffer);
  88.     if (ret=0) then 
  89.         ret:=rtEZRequestA("You entered nothing","I'm sorry", NIL, NIL, NIL)
  90.     else
  91.         ret:=rtEZRequestA("You entered this string:\n%s","So I did", NIL, @values[0], NIL);
  92.         
  93.     strcpy (buffer, "It is possible to have several responses");
  94.  
  95.     new(mytag);
  96.     mytag^[0].ti_Tag:=RTGS_GadFmt;
  97.     mytag^[0].ti_Data:=Integer(" OK | New 2.0 feature | Cancel ");
  98.     mytag^[1].ti_Tag:=TAG_END;
  99.  
  100.     ret:=rtGetStringA (buffer, 127, "* New for ReqTools 2.0 *",
  101.                 NIL , mytag);
  102.  
  103.     ret:=rtEZRequestA ("NUMBER 2:\nNumber requester\nfunction: rtGetLong()",
  104.                      "Show me", NIL, NIL, NIL);
  105.  
  106.     mytag^[0].ti_Tag:=RTGL_ShowDefault;
  107.     mytag^[0].ti_Data:=Integer(FALSE);
  108.     mytag^[1].ti_Tag:=TAG_END;
  109.     
  110.     ret:=rtGetLongA (adr (longnum), "Enter a number:", NIL, mytag);
  111.  
  112.     values[0]:= longnum;
  113.  
  114.     if(ret=0) then 
  115.         ret:=rtEZRequestA("You entered nothing","I'm sorry", NIL, NIL, NIL)
  116.     else
  117.         ret:=rtEZRequestA("The number You entered was: \n%ld" ,
  118.                      "So it was", NIL, @values[0], NIL);
  119.  
  120.     mytag^[0].ti_Tag:=RTGL_ShowDefault;
  121.     mytag^[0].ti_Data:=Integer(FALSE);
  122.     mytag^[1].ti_Tag:=RTGL_GadFmt;
  123.     mytag^[1].ti_Data:=Integer("Ok|V38 feature|Cancel");
  124.     mytag^[2].ti_Tag:=TAG_END;
  125.  
  126.     ret:=rtGetLongA (adr(longnum), "* New for ReqTools 2.0 *", NIL, mytag);
  127.  
  128.     ret:=rtEZRequestA ("NUMBER 3:\nNotification requester, the requester\nyou've been using all the time!\nfunction: rtEZRequestA()",
  129.                      "Show me more", NIL, NIL, NIL);
  130.  
  131.     ret:=rtEZRequestA ("Simplest usage: some body text and\na single centered gadget.",
  132.                      "Got it", NIL, NIL, NIL);
  133.  
  134.     ret:=rtEZRequestA ("You can also use two gadgets to\nask the user something.\nDo you understand?",
  135.                         "Of course|Not really", NIL, NIL, NIL);
  136.     while ret=0 do
  137.     begin
  138.         ret:=rtEZRequestA ("You are not one of the brightest are you?\nWe'll try again...","Ok", NIL, NIL, NIL);
  139.         ret:=rtEZRequestA ("You can also use two gadgets to\nask the user something.\nDo you understand?",
  140.                          "Of course|Not really", NIL, NIL, NIL)
  141.     end;
  142.  
  143.     ret:=rtEZRequestA ("Great, we'll continue then.", "Fine", NIL, NIL, NIL);
  144.  
  145.     ret:=rtEZRequestA ("You can also put up a requester with\nthree choices.\nHow do you like the demo so far ?",
  146.                                 "Great|So so|Rubbish", NIL, NIL, NIL);
  147.     case ret of
  148.         0:    ret:=rtEZRequestA ("Too bad, I really hoped you\nwould like it better.",
  149.                              "So what", NIL, NIL, NIL);
  150.         1:
  151.             ret:=rtEZRequestA ("I'm glad you like it so much.","Fine", NIL, NIL, NIL);
  152.         2:
  153.             ret:=rtEZRequestA ("Maybe if you run the demo again\nyou'll REALLY like it.",
  154.                              "Perhaps", NIL, NIL, NIL);
  155.         end;
  156.         
  157.     mytag^[0].ti_Tag:=RTEZ_DefaultResponse;
  158.     mytag^[0].ti_Data:=4;
  159.     mytag^[1].ti_Tag:=TAG_END;
  160.  
  161.     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.",
  162.                                   "1|2|3|4|5|0", NIL, NIL,
  163.                                   mytag);
  164.     
  165.     values[0]:=Integer(ret);
  166.     
  167.     ret:=rtEZRequestA ("You picked %ld", "How true", NIL, @values[0], NIL);
  168.  
  169.     mytag^[0].ti_Tag:=RT_Underscore;
  170.     mytag^[0].ti_Data:=Integer('_');
  171.     mytag^[1].ti_Tag:=TAG_END;
  172.  
  173.     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.",
  174.                       "_Great|_Fantastic|_Swell|Oh _Boy",
  175.                           NIL, NIL, mytag);
  176.  
  177.     values[0]:=5;
  178.     values[1]:=Integer("five");
  179.     
  180.     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().",
  181.         "_Proceed", NIL, @values[0], mytag);
  182.     
  183.         mytag^[0].ti_Tag:=RT_IDCMPFlags;
  184.         mytag^[0].ti_Data:=DISKINSERTED;
  185.         mytag^[1].ti_Tag:=RT_Underscore;
  186.         mytag^[1].ti_Data:=Integer('_');
  187.         mytag^[2].ti_Tag:=TAG_END;
  188.  
  189.         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).",
  190.                                "_Continue", NIL, NIL, mytag);
  191.  
  192.     if ((ret=DISKINSERTED)) then
  193.         ret:=rtEZRequestA ("You inserted a disk.", "I did", NIL, NIL, NIL)
  194.     else
  195.         ret:=rtEZRequestA ("You used the 'Continue' gadget\nto satisfy the requester.", "I did", NIL, NIL, NIL);
  196.  
  197.     mytag^[0].ti_Tag:=RT_ReqPos;
  198.     mytag^[0].ti_Data:=Integer(REQPOS_TOPLEFTSCR);
  199.     mytag^[1].ti_Tag:=RT_Underscore;
  200.     mytag^[1].ti_Data:=Integer('_');
  201.     mytag^[2].ti_Tag:=TAG_END;
  202.  
  203.     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()!",
  204.                           "_Amazing", NIL, NIL, mytag);
  205.  
  206.     mytag^[0].ti_Tag:=RT_ReqPos;
  207.     mytag^[0].ti_Data:=Integer(REQPOS_CENTERSCR);
  208.     mytag^[1].ti_Tag:=TAG_END;
  209.  
  210.     ret:=rtEZRequestA ("Alternatively, you can center the\nrequester on the screen.\nCheck out 'reqtools.doc' for all the possibilities.",
  211.                           "I'll do that", NIL, NIL,
  212.                           mytag);
  213.  
  214.     mytag^[0].ti_Tag:=RT_Underscore;
  215.     mytag^[0].ti_Data:=Integer('_');
  216.     mytag^[1].ti_Tag:=TAG_END;
  217.  
  218.     ret:=rtEZRequestA ("NUMBER 4:\nFile requester\nfunction: rtFileRequest()",
  219.                           "_Demonstrate", NIL, NIL, mytag);
  220.  
  221.     filereq:=Address(rtAllocRequestA (RT_FILEREQ, NIL));
  222.     
  223.     if (filereq<>NIL) then
  224.     begin
  225. {        filterhook.h_Entry^ := Integer(filterfunc(filterhook,filereq,ff));
  226.         mytag^[0].ti_Tag:=RTFI_FilterFunc;
  227.         mytag^[0].ti_Data:=Integer(@filterhook);
  228.         mytag^[1].ti_Tag:=TAG_END;
  229. }        
  230.         filename := AllocString (80);
  231.         strcpy (filename, "");
  232.         ret:=rtFileRequestA (filereq, filename, "Pick a file", NIL);
  233.         if(ret<>0) then
  234.             begin
  235.                 values[0]:=Integer(filename);
  236.                 values[1]:=Integer(@filereq^.Dir^);
  237.                 ret:=rtEZRequestA ("You picked the file:\n%s\nin directory:\n%s",
  238.                                     "Right", NIL, @values[0], NIL)
  239.             end
  240.         else
  241.             ret:=rtEZRequestA ("You didn't pick a file.", "No", NIL, NIL, NIL);
  242.  
  243.         ret:=rtFreeRequest(filereq)
  244.     end
  245.     else
  246.         ret:=rtEZRequestA ("Out of memory!", "Oh boy!", NIL, NIL, NIL);
  247.  
  248.     ret:=rtEZRequestA ("The file requester can be used\nas a directory requester as well.",
  249.                        "Let's _see that", NIL, NIL, mytag);
  250.  
  251.     filereq := Address(rtAllocRequestA (RT_FILEREQ, NIL));
  252.     if (filereq<>NIL) then
  253.         begin
  254.             mytag^[0].ti_Tag:=RTFI_Flags;
  255.             mytag^[0].ti_Data:=FREQF_NOFILES;
  256.             mytag^[1].ti_Tag:=TAG_END;
  257.  
  258.             ret:=rtFileRequestA (filereq, filename, "Pick a directory",mytag);
  259.             values[0]:=Integer(@filereq^.Dir^);
  260.             if(ret=1) then
  261.                 ret:=rtEZRequestA ("You picked the directory:\n%s",
  262.                              "Right", NIL, @values[0], NIL)
  263.             else
  264.                 ret:=rtEZRequestA ("You didn't pick a directory.", "No", NIL, NIL, NIL);
  265.  
  266.             ret:=rtEZRequestA ("You can also change the Height of the requester", "Wow", NIL, NIL, NIL);
  267.  
  268.             mytag^[0].ti_Tag:=RTFI_Flags;
  269.             mytag^[0].ti_Data:=FREQF_NOFILES;
  270.             mytag^[1].ti_Tag:=RTFI_Height;
  271.             mytag^[1].ti_Data:=Integer(250);
  272.             mytag^[2].ti_Tag:=TAG_END;
  273.  
  274.             ret:=rtFileRequestA (filereq, filename, "Pick a directory",mytag);
  275.             values[0]:=Integer(@filereq^.Dir^);
  276.             if(ret=1) then
  277.                 ret:=rtEZRequestA ("You picked the directory:\n%s",
  278.                              "Right", NIL, @values[0], NIL)
  279.             else
  280.                 ret:=rtEZRequestA ("You didn't pick a directory.", "No", NIL, NIL, NIL);
  281.  
  282.             ret:=rtEZRequestA ("You can also change the OK_GADGET", "Great", NIL, NIL, NIL);
  283.  
  284.             mytag^[0].ti_Tag:=RTFI_Flags;
  285.             mytag^[0].ti_Data:=FREQF_NOFILES;
  286.             mytag^[1].ti_Tag:=RTFI_OkText;
  287.             mytag^[1].ti_Data:=Integer("_Remove");
  288.             mytag^[2].ti_Tag:=RT_UnderScore;
  289.             mytag^[2].ti_Data:=Integer('_');
  290.             mytag^[3].ti_Tag:=TAG_END;
  291.  
  292.             ret:=rtFileRequestA (filereq, filename, "Remove a directory",mytag);
  293.             values[0]:=Integer(@filereq^.Dir^);
  294.             if(ret=1) then
  295.                 ret:=rtEZRequestA ("You picked the directory:\n%s",
  296.                              "Right", NIL, @values[0], NIL)
  297.             else
  298.                 ret:=rtEZRequestA ("You didn't pick a directory.", "No", NIL, NIL, NIL);
  299.  
  300.             ret:=rtFreeRequest(filereq);
  301.             filereq := Address(rtAllocRequestA (RT_FILEREQ, NIL));            
  302.             ret:=rtEZRequestA ("You can also use it as a Disk-requester", "Perfect", NIL, NIL, NIL);
  303.  
  304.             mytag^[0].ti_Tag:=RTFI_VolumeRequest;
  305.             mytag^[0].ti_Data:=VREQF_ALLDISKS or VREQF_NOASSIGNS;
  306.             mytag^[1].ti_Tag:=RTFI_OkText;
  307.             mytag^[1].ti_Data:=Integer("Un_Mount");
  308.             mytag^[2].ti_Tag:=RT_UnderScore;
  309.             mytag^[2].ti_Data:=Integer('_');
  310.             mytag^[3].ti_Tag:=TAG_END;
  311.  
  312.             ret:=rtFileRequestA (filereq, filename, "Unmount a device",mytag);
  313.             values[0]:=Integer(@filereq^.Dir^);
  314.             if(ret=1) then
  315.                 ret:=rtEZRequestA ("You picked the device:\n%s",
  316.                              "Right", NIL, @values[0], NIL)
  317.             else
  318.                 ret:=rtEZRequestA ("You didn't pick a device.", "No", NIL, NIL, NIL);
  319.         ret:=rtFreeRequest (filereq)
  320.         end
  321.     else
  322.         ret:=rtEZRequestA ("Out of memory!", "Oh boy!", NIL, NIL, NIL);
  323.  
  324.     mytag^[0].ti_Tag:=RTEZ_DefaultResponse;
  325.     mytag^[0].ti_Data:=4;
  326.     mytag^[1].ti_Tag:=TAG_END;
  327.  
  328.     ret:=rtEZRequestA ("NUMBER 5:\nFont requester\nfunction: rtFontRequest()",
  329.                           "Show|Cancel", NIL, NIL, NIL);
  330.  
  331.     if ret <> 0 then
  332.         begin
  333.         fontreq := Address(rtAllocRequestA (RT_FONTREQ, NIL));
  334.         if (fontreq<>NIL) then
  335.         begin
  336.             fontreq^.Flags := FREQF_STYLE or FREQF_COLORFONTS;
  337.     {        font_filterhook.h_Entry^ := Integer(font_filterfunc(font_filterhook,fontreq,tt));
  338.             mytag^[0].ti_Tag:=RTFO_FilterFunc;
  339.             mytag^[0].ti_Data:=Integer(@font_filterhook);
  340.             mytag^[1].ti_Tag:=TAG_END;
  341.     }        
  342.             ret:=rtFontRequestA (fontreq, "Pick a font", NIL);
  343.             if(ret<>0) then
  344.             begin
  345.                 values[0]:=Integer(fontreq^.Attr.ta_Name);
  346.                 values[1]:=Integer(fontreq^.Attr.ta_YSize);
  347.                 ret:=rtEZRequestA ("You picked the font:\n%s\nwith size:\n%ld",
  348.                                    "Right", NIL, @values[0], NIL)
  349.             end
  350.             else
  351.                 ret:=rtEZRequestA ("You didn't pick a font","I know", NIL, NIL, NIL);
  352.             ret:=rtFreeRequest (fontreq);
  353.         end
  354.         else         ret:=rtEZRequestA ("Out of memory!", "Oh boy!", NIL, NIL, NIL);
  355.     end;
  356.  
  357.     inforeq := Address(rtAllocRequestA (RT_REQINFO, NIL));
  358.     if (inforeq<>NIL) then
  359.     begin
  360.         inforeq^.Flags := EZREQF_CENTERTEXT;
  361.         ret:=rtEZRequestA ("With rtAllocRequestA (RT_REQINFO, NIL)\nyou can center the text in the requester", "Got it", inforeq, NIL, NIL);
  362.         ret:=rtFreeRequest (inforeq);
  363.     end
  364.     else         ret:=rtEZRequestA ("Out of memory!", "Oh boy!", NIL, NIL, NIL);
  365.  
  366.     ret:=rtEZRequestA ("NUMBER 6:\nScreenMode requester\nfunction: rtScreenModeRequestA()",
  367.                           "Proceed", NIL, NIL, NIL);
  368.  
  369.     scrnreq := Address(rtAllocRequestA (RT_SCREENMODEREQ, NIL));
  370.     if (scrnreq<>NIL) then
  371.     begin
  372.         mytag^[0].ti_Tag:=RTSC_Flags;
  373.         mytag^[0].ti_Data:=SCREQF_DEPTHGAD or SCREQF_SIZEGADS or SCREQF_AUTOSCROLLGAD or SCREQF_OVERSCANGAD;
  374.         mytag^[1].ti_Tag:=RT_UnderScore;
  375.         mytag^[1].ti_Data:=Integer('_');
  376.         mytag^[2].ti_Tag:=TAG_END;
  377.  
  378.         ret:=rtScreenModeRequestA ( scrnreq, "Pick a screenmode", mytag);
  379.         values[0]:=Integer(scrnreq^.DisplayID);
  380.         values[1]:=Integer(scrnreq^.DisplayWidth);
  381.         values[2]:=Integer(scrnreq^.DisplayHeight);
  382.         values[3]:=Integer(scrnreq^.DisplayDepth);
  383.         values[4]:=Integer(scrnreq^.OverscanType);
  384.         if (Boolean(scrnreq^.AutoScroll)) then
  385.             values[5]:=Integer("On")
  386.         else values[5]:=Integer("Off");
  387.  
  388.         if(ret=1) then
  389.             ret:=rtEZRequestA ("You picked this mode:\nModeID   : 0x%lx\nSize     : %ld x %ld\nDepth    : %ld\nOverscan : %ld\nAutoScroll %s",
  390.                                "Right", NIL, @values[0], NIL)
  391.         else
  392.             ret:=rtEZRequestA ("You didn't pick a screen mode.", "Sorry", NIL, NIL, NIL);
  393.         ret:=rtFreeRequest (scrnreq);
  394.     end
  395.     else
  396.         ret:=rtEZRequestA ("Out of memory!", "Oh boy!", NIL, NIL, NIL);
  397.  
  398.     mytag^[0].ti_Tag:=RT_Underscore;
  399.     mytag^[0].ti_Data:=Integer('_');
  400.     mytag^[1].ti_Tag:=TAG_END;
  401.  
  402.     ret:=rtEZRequestA ("NUMBER 7:\nPalette requester\nfunction: rtPaletteRequest()",
  403.                           "_Proceed", NIL, NIL, mytag);
  404.  
  405.     color := rtPaletteRequestA ("Change palette", NIL, NIL);
  406.     if (color = -1) then
  407.         ret:=rtEZRequestA ("You canceled.\nNo nice colors to be picked ?",
  408.                          "Nah", NIL, NIL, NIL)
  409.     else
  410.         ret:=rtEZRequestA ("You picked color number %ld.", "Sure did",
  411.                          NIL, @color, NIL);
  412.  
  413.     CloseLibrary (LibraryPtr(RTBase));
  414.     writeln;
  415.     writeln ("Finished, hope you enjoyed the demo");
  416.     writeln;
  417. end.
  418.