home *** CD-ROM | disk | FTP | other *** search
/ Fresh Fish 5 / FreshFish_July-August1994.bin / bbs / util / reqtools-2.2b.lha / ReqTools-2.2b / Glue / Oberon / oberon_glue.lha / ReqToolsDemo.mod < prev   
Encoding:
Text File  |  1992-07-12  |  10.3 KB  |  327 lines
  1. (* ------------------------------------------------------------------------
  2.   :Program.       ReqToolsDemo
  3.   :Contents.      Demonstrates use auf Nico François' reqtools.library
  4.   :Author.        Kai Bolay [kai] (C-Version by Nico François)
  5.   :Address.       Hoffmannstraße 168
  6.   :Address.       D-7250 Leonberg 1 (Germany)
  7.   :Address.       UUCP: ...!cbmvax!cbmehq!cbmger!depot1!amokle!kai
  8.   :Address.       FIDO: 2:247/706.3
  9.   :History.       v1.0 [kai] 22-Nov-91 (translated from C)
  10.   :History.       v1.0 Nico  29-Nov-91 (comment added about ta.name bug)
  11.   :Copyright.     Freeware
  12.   :Language.      Oberon
  13.   :Translator.    AMIGA OBERON v2.12e, A+L AG
  14.   :Imports.       ReqTools
  15.   :Remark.        Thanks to Nico for his great library
  16.   :Bugs.          ReqTools/Arq/MagicFileRequester should support each other
  17.   :Bugs.          Font-Hook: ta.name can contain odd pointer :-(
  18.   :Bugs.          Doesn't demonstrate ReqTools v38 :-( I'm too lazy!
  19. ------------------------------------------------------------------------ *)
  20.  
  21. (*********************************
  22. *                                *
  23. *  reqtools.library (V37)        *
  24. *                                *
  25. *  Release 1.0                   *
  26. *                                *
  27. *  (c) 1991 Nico François        *
  28. *                                *
  29. *  demo.c                        *
  30. *                                *
  31. *  This source is public domain  *
  32. *  in all respects.              *
  33. *                                *
  34. *********************************)
  35.  
  36. MODULE ReqToolsDemo;
  37.  
  38. IMPORT
  39.   rt: ReqTools, I: Intuition, d: Dos, e: Exec, g: Graphics, u: Utility,
  40.   y: SYSTEM;
  41.  
  42. VAR
  43.   filereq: rt.FileRequesterPtr;
  44.   fontreq: rt.FontRequesterPtr;
  45.   myhook: u.Hook;
  46.   buffer: ARRAY 128 OF CHAR;
  47.   filename: ARRAY 34 OF CHAR;
  48.   longnum, ret, color: LONGINT;
  49.   adr, adr2: y.ADDRESS;
  50.   (* $IF SmallCode *)
  51.   olduser: LONGINT;
  52.   (* $END *)
  53.  
  54. PROCEDURE myputs (str: ARRAY OF CHAR);
  55. BEGIN
  56.   IF d.Output() # NIL THEN
  57.     y.SETREG (0, d.Write (d.Output(), str, LEN (str)-1));
  58.   END;
  59. END myputs;
  60.  
  61. (* $IF DoHook *)
  62. (* $StackChk- $SaveRegs+ *)
  63. PROCEDURE *hookfunc (hook{8}: u.HookPtr;
  64.                      object{10}: e.APTR;
  65.                      message{9}: e.APTR): LONGINT;
  66. TYPE
  67.   ParamType = UNTRACED POINTER TO STRUCT
  68.     type: LONGINT;
  69.     data: e.ADDRESS;
  70.   END;
  71. VAR
  72.   fib: d.FileInfoBlockPtr;
  73.   ta: g.TextAttrPtr;
  74.   param: ParamType;
  75.   HelpMe: ARRAY 30 OF CHAR;
  76. BEGIN
  77.   (* $IF SmallCode *)
  78.   y.SETREG (8+5, e.exec.thisTask^.userData);
  79.   (* $END *)
  80.   param := y.VAL (ParamType, message);
  81.   CASE param.type OF
  82.   | rt.ReqHookWildFile:
  83.       (* param.data holds address of a FileInfoBlock *)
  84.       fib := param.data;
  85.       myputs (fib^.fileName); myputs ("\n");
  86.       RETURN 0;
  87.   | rt.ReqHookWildFont:
  88.       (* param.data holds address of a TextAttr *)
  89.       ta := param.data;
  90.       COPY (ta^.name^, HelpMe); (* May contain odd Pointer :-( *)
  91.       (* <odd Pointer is fault of AvailFonts function (DiskFont)> - Nico *)
  92.       myputs (HelpMe); myputs ("\n");
  93.  
  94.       RETURN 0;
  95.   ELSE
  96.     RETURN 0;
  97.   END;
  98. END hookfunc;
  99. (* $StackChk= *)
  100. (* $END *)
  101.  
  102. BEGIN
  103.   myputs ("\nreqtools Demo\n¯¯¯¯¯¯¯¯¯¯¯¯¯\n\
  104. This program demonstrates what 'reqtools.library' \
  105. has to offer.\n");
  106.  
  107.   d.Delay (60);
  108.  
  109.   rt.vEZRequest ("'reqtools.library' offers several\ndifferent types of requesters:",
  110.                 "Let's see them", NIL, NIL);
  111.  
  112.   rt.vEZRequest ("NUMBER 1:\nThe larch :-)", "Be serious!", NIL, NIL);
  113.  
  114.   rt.vEZRequest ("NUMBER 1:\nString requester\nfunction: rt.GetString()",
  115.                 "Show me", NIL, NIL);
  116.  
  117.   buffer := "A bit of text";
  118.   IF NOT rt.GetString (buffer, 127, "Enter anything:", NIL, u.end) THEN
  119.     rt.vEZRequest ("You entered nothing :-(", "I'm sorry", NIL, NIL);
  120.   ELSE
  121.     adr := y.ADR (buffer);
  122.     rt.vEZRequest ("You entered this string:\n'%s'.",
  123.                   "So I did", NIL, NIL, adr);
  124.   END;
  125.  
  126.   rt.vEZRequest ("NUMBER 2:\nNumber requester\nfunction: rt.GetLong()",
  127.                 "Show me", NIL, NIL);
  128.  
  129.   IF NOT rt.GetLong (longnum, "Enter a number:", NIL,
  130.              rt.glShowDefault, I.LFALSE, u.end) THEN
  131.     rt.vEZRequest ("You entered nothing :-(", "I'm sorry", NIL, NIL);
  132.  
  133.   ELSE
  134.     rt.vEZRequest ("The number you entered was:\n%ld",
  135.              "So it was", NIL, NIL, longnum);
  136.   END;
  137.  
  138.   rt.vEZRequest ("NUMBER 3:\nNotification requester, the requester\n\
  139. you've been using all the time!\nfunction: rt.EZRequest()",
  140.            "Show me more", NIL, NIL);
  141.  
  142.   rt.vEZRequest ("Simplest usage: some body text and\na single centered gadget.",
  143.            "Got it", NIL, NIL);
  144.  
  145.   WHILE NOT (rt.EZRequest ("You can also use two gadgets to\n\
  146. ask the user something.\n\
  147. Do you understand?", "Of course|Not really",
  148.                 NIL, NIL) # 0) DO
  149.     rt.vEZRequest ("You are not one of the brightest are you?\n\
  150. We'll try again...",
  151.              "Ok", NIL, NIL);
  152.   END; (* WHILE *)
  153.  
  154.   rt.vEZRequest ("Great, we'll continue then.", "Fine", NIL, NIL);
  155.  
  156.   CASE rt.EZRequest ("You can also put up a requester with\n\
  157. three choices.\n\
  158. How do you like the demo so far ?",
  159.                 "Great|So so|Rubbish", NIL, NIL) OF
  160.     | 0:
  161.       rt.vEZRequest ("Too bad, I really hoped you\nwould like it better.",
  162.                "So what", NIL, NIL);
  163.     | 1:
  164.       rt.vEZRequest ("I'm glad you like it so much.", "Fine", NIL, NIL);
  165.     | 2:
  166.       rt.vEZRequest ("Maybe if you run the demo again\n\
  167. you'll REALLY like it.",
  168.                "Perhaps", NIL, NIL);
  169.   END; (* CASE *)
  170.  
  171.   ret := rt.EZRequestTags ("The number of responses is not limited to three\n\
  172. as you can see.  The gadgets are labeled with\n\
  173. the return code from rt.EZRequest().\n\
  174. Pressing Return will choose 4, note that\n\
  175. 4's button text is printed in boldface.",
  176.                   "1|2|3|4|5|0", NIL, NIL,
  177.                   rt.ezDefaultResponse, 4, u.end);
  178.   rt.vEZRequest ("You picked '%ld'.", "How true", NIL, NIL, ret);
  179.  
  180.   adr := y.ADR ("five");
  181.   rt.vEZRequest (
  182.     "You may also use C-style formatting codes in the body text.\n\
  183. Like this:\n\n\
  184. 'The number %%ld is written %%s.' will give:\n\n\
  185. The number %ld is written %s.\n\n\
  186. if you also pass '5' and '\"five\"' to rt.EZRequest().",
  187.     "Proceed", NIL, NIL, 5, adr);
  188.  
  189.   IF (I.diskInserted IN y.VAL (LONGSET, rt.EZRequestTags ("It is also possible to pass extra IDCMP flags\n\
  190. that will satisfy rt.EZRequest(). This requester\n\
  191. has had DISKINSERTED passed to it.\n\
  192. (Try insert.ing a disk).",
  193.                  "Continue", NIL, NIL,
  194.                  rt.IDCMPFlags, y.VAL (LONGINT, LONGSET {I.diskInserted}), u.end))) THEN
  195.     rt.vEZRequest ("You inserted a disk.", "I did", NIL, NIL);
  196.   ELSE
  197.     rt.vEZRequest ("You used the 'Continue' gadget\n\
  198. to satisfy the requester.", "I did", NIL, NIL);
  199.   END;
  200.  
  201.   rt.vEZRequestTags ("Finally, it is possible to specify the position\n\
  202. of the requester.\n\
  203. E.g. at the top left of the screen, like this.\n\
  204. This works for all requesters, not just rt.EZRequest()!",
  205.               "Amazing", NIL, NIL,
  206.               rt.ReqPos, rt.ReqPosTopLeftScr, u.end);
  207.  
  208.   rt.vEZRequestTags ("Alternatively, you can center the\n\
  209. requester on the screen.\n\
  210. Check out 'reqtools.doc' for all the possibilities.",
  211.               "I'll do that", NIL, NIL,
  212.               rt.ReqPos, rt.ReqPosCenterScr, u.end);
  213.  
  214.   rt.vEZRequest ("NUMBER 4:\nFile requester\n\
  215. function: rt.FileRequest()", "Demonstrate", NIL, NIL);
  216.  
  217.   filereq := rt.AllocRequestA (rt.TypeFileReq, NIL);
  218.   IF filereq # NIL THEN
  219.  
  220.     (* $IF DoHook *)
  221.     myhook.entry := hookfunc;
  222.     filereq.hook := y.ADR (myhook);
  223.     INCL (filereq.flags, rt.fReqDoWildFunc);
  224.  
  225.     (* $IF SmallCode *)
  226.     olduser := e.exec.thisTask^.userData;
  227.     e.exec.thisTask^.userData := y.REG (8+5);
  228.     (* $END *)
  229.  
  230.     (* $END *)
  231.  
  232.  
  233.     filename := "";
  234.     IF rt.FileRequest (filereq, filename, "Pick a file", u.end) THEN
  235.       adr := y.ADR (filename); adr2 := filereq.dir;
  236.        rt.vEZRequest ("You picked the file:\n'%s'\nin directory:\n'%s'",
  237.                "Right", NIL, NIL, adr, adr2);
  238.     ELSE
  239.       rt.vEZRequest ("You didn't pick a file.", "No", NIL, NIL);
  240.     END;
  241.  
  242.     (* $IF DoHook *)
  243.     (* $IF SmallCode *)
  244.     e.exec.thisTask^.userData := olduser;
  245.     (* $END *)
  246.     (* $END *)
  247.  
  248.     rt.FreeRequest (filereq);
  249.   ELSE
  250.     rt.vEZRequest ("Out of memory!", "Oh boy!", NIL, NIL);
  251.   END;
  252.  
  253.   rt.vEZRequest ("The file requester can be used\n\
  254. as a directory requester as well.",
  255.            "Let'see that", NIL, NIL);
  256.  
  257.   filereq := rt.AllocRequestA (rt.TypeFileReq, NIL);
  258.   IF filereq # NIL THEN
  259.     IF rt.FileRequest (filereq, filename, "Pick a directory",
  260.                  rt.fiFlags, y.VAL (LONGINT, LONGSET {rt.fReqNoFiles}), u.end) THEN
  261.       adr := filereq.dir;
  262.       rt.vEZRequest ("You picked the directory:\n'%s'",
  263.                "Right", NIL, NIL, adr);
  264.     ELSE
  265.       rt.vEZRequest ("You didn't pick a directory.", "No", NIL, NIL);
  266.     END;
  267.  
  268.     rt.FreeRequest (filereq);
  269.   ELSE
  270.     rt.vEZRequest ("Out of memory!", "Oh boy!", NIL, NIL);
  271.   END;
  272.  
  273.   rt.vEZRequest ("NUMBER 5:\nFont requester\nfunction: rt.FontRequest()",
  274.            "Show", NIL, NIL);
  275.  
  276.   fontreq := rt.AllocRequestA (rt.TypeFontReq, NIL);
  277.   IF fontreq # NIL THEN
  278.     fontreq.flags := LONGSET {rt.fReqStyle, rt.fReqColorFonts};
  279.  
  280.     (* $IF DoHook *)
  281.     myhook.entry := hookfunc;
  282.     fontreq.hook := y.ADR (myhook);
  283.     INCL (fontreq.flags, rt.fReqDoWildFunc);
  284.  
  285.     (* $IF SmallCode *)
  286.     olduser := e.exec.thisTask^.userData;
  287.     e.exec.thisTask^.userData := y.REG (8+5);
  288.     (* $END *)
  289.  
  290.     (* $END *)
  291.  
  292.     IF rt.FontRequest (fontreq, "Pick a font", u.end) THEN
  293.       adr := fontreq.attr.name; adr2 := fontreq.attr.ySize;
  294.       rt.vEZRequest ("You picked the font:\n'%s'\nwith size:\n'%ld'",
  295.                "Right", NIL, NIL,
  296.                adr, adr2);
  297.     ELSE
  298.       rt.vEZRequest ("You canceled.\nWas there no font you liked ?",
  299.                "Nope", NIL, NIL);
  300.     END;
  301.  
  302.     (* $IF DoHook *)
  303.     (* $IF SmallCode *)
  304.     e.exec.thisTask^.userData := olduser;
  305.     (* $END *)
  306.     (* $END *)
  307.  
  308.     rt.FreeRequest (fontreq);
  309.   ELSE
  310.     rt.vEZRequest ("Out of memory!", "Oh boy!", NIL, NIL);
  311.   END;
  312.  
  313.   rt.vEZRequest ("NUMBER 6:\nPalette requester\nfunction: rt.PaletteRequest()",
  314.            "Proceed", NIL, NIL);
  315.  
  316.   color := rt.PaletteRequest ("Change palette", NIL, u.end);
  317.   IF color = -1 THEN
  318.     rt.vEZRequest ("You canceled.\nNo nice colors to be picked ?",
  319.              "Nah", NIL, NIL);
  320.   ELSE
  321.     rt.vEZRequest ("You picked color number %ld.", "Sure did",
  322.              NIL, NIL, color);
  323.   END;
  324.  
  325.   myputs ("\nFinished, hope you enjoyed the demo :-)\n");
  326. END ReqToolsDemo.
  327.