home *** CD-ROM | disk | FTP | other *** search
/ Otherware / Otherware_1_SB_Development.iso / amiga / programm / libs / reqtools.lha / ReqTools / Glue / M2Amiga / ReqToolsDemo.mod < prev    next >
Encoding:
Text File  |  1992-06-29  |  11.1 KB  |  310 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.0m [Frank L÷mker] 24-Feb-92 Umsetzung nach Modula
  11.   :Copyright.     Freeware
  12.   :Language.      Modula
  13.   :Translator.    M2Amiga V4.0d
  14.   :Imports.       ReqTools
  15.   :Remark.        Thanks to Nico for his great library
  16.   :Bugs.          ReqTools/Arq should support each other
  17.   :Bugs.          Font-Hook: ta.name can contain odd pointer :-(
  18. ------------------------------------------------------------------------ *)
  19.  
  20. (*********************************
  21. *                                *
  22. *  reqtools.library (V37)        *
  23. *                                *
  24. *  Release 1.0                   *
  25. *                                *
  26. *  (c) 1991 Nico Franτois        *
  27. *                                *
  28. *  demo.c                        *
  29. *                                *
  30. *  This source is public domain  *
  31. *  in all respects.              *
  32. *                                *
  33. *********************************)
  34.  
  35. MODULE ReqToolsDemo;
  36. (*$ DEFINE DoHook:=FALSE *)
  37.  
  38. FROM GraphicsD IMPORT TextAttrPtr;
  39. FROM DosL IMPORT Output,Write,Delay;
  40. FROM DosD IMPORT FileInfoBlockPtr;
  41. FROM IntuitionD IMPORT IDCMPFlags,IDCMPFlagSet;
  42. FROM SYSTEM IMPORT ADDRESS,ADR,SETREG,REG,TAG,CAST,LONGSET,ASSEMBLE;
  43. FROM UtilityD IMPORT Hook,HookPtr,tagEnd,TagItemPtr;
  44. FROM ExecD IMPORT execBase,TaskPtr;
  45. FROM String IMPORT Length;
  46. IMPORT rt: ReqTools;
  47. FROM ReqToolsSupport IMPORT EZRequest,vEZRequest,EZRequestTags,vEZRequestTags;
  48.  
  49. VAR tagbuf:ARRAY [0..3] OF LONGINT;
  50.     filereq: rt.FileRequesterPtr;
  51.     fontreq: rt.FontRequesterPtr;
  52.     myhook: Hook;
  53.     buffer: ARRAY [0..127] OF CHAR;
  54.     filename: ARRAY [0..33] OF CHAR;
  55.     longnum, ret, color: LONGINT;
  56.     adr, adr2: ADDRESS;
  57.  
  58. PROCEDURE myputs (str: ARRAY OF CHAR);
  59. BEGIN
  60.   IF Output() # NIL THEN
  61.     (*$ StackParms:=TRUE *)
  62.     SETREG (0,Write (Output(), ADR(str), Length (str) ));
  63.     (*$ POP StackParms *)
  64.   END;
  65. END myputs;
  66.  
  67. (*$ IF DoHook *)
  68. (*$ StackChk:=FALSE SaveA4:=TRUE *)
  69. PROCEDURE hookfunc (hook{8}: HookPtr;
  70.                     object{10}: ADDRESS;
  71.                     message{9}: ADDRESS): ADDRESS;
  72. VAR fib: FileInfoBlockPtr;
  73.     ta: TextAttrPtr;
  74.     param: POINTER TO ARRAY [0..1] OF ADDRESS;
  75.     n:POINTER TO ARRAY [0..127] OF CHAR;
  76. BEGIN
  77.   SETREG (12,hook^.data);
  78.   param := message;
  79.   CASE CAST (LONGINT, param^[0]) OF
  80.   | rt.ReqHookWildFile:
  81.       (* param[1] holds address of a FileInfoBlock *)
  82.       fib := param^[1];
  83.       myputs (fib^.fileName); myputs ("\n");
  84.       RETURN 0;
  85.   | rt.ReqHookWildFont:
  86.       (* param[1] holds address of a TextAttr *)
  87.       ta := param^[1];
  88.       n:=ta^.name;
  89.       myputs (n^); (* May contain odd Pointer :-( *)
  90.       myputs ("\n");   (* ^ Bei mir (Frank) hat es funktioniert *)
  91.       RETURN 0;
  92.   ELSE
  93.     RETURN 0;
  94.   END;
  95. END hookfunc;
  96. (*$ POP StackChk *)
  97. (*$ ENDIF *)
  98.  
  99. BEGIN
  100.   myputs ("\nreqtools Demo\n»»»»»»»»»»»»»\n"+
  101.           "This program demonstrates what 'reqtools.library' "+
  102.           "has to offer.\n");
  103.  
  104.   Delay (60);
  105.  
  106.   vEZRequest (ADR("'reqtools.library' offers several\ndifferent types of requesters:"),
  107.                  ADR("Let's see them"), NIL, NIL,NIL);
  108.  
  109.   vEZRequest (ADR("NUMBER 1:\nThe larch :-)"),ADR("Be serious!"), NIL, NIL,NIL);
  110.  
  111.   vEZRequest (ADR("NUMBER 1:\nString requester\nfunction: rt.GetString()"),
  112.                  ADR("Show me"),NIL, NIL, NIL);
  113.  
  114.   buffer := "A bit of text";
  115.   IF NOT rt.GetString (ADR(buffer), 127,ADR("Enter anything:"), NIL,TAG(tagbuf,tagEnd)) THEN
  116.     vEZRequest (ADR("You entered nothing :-("),ADR("I'm sorry"),NIL, NIL, NIL);
  117.   ELSE
  118.     adr:=TAG(tagbuf,ADR (buffer));
  119.     vEZRequest (ADR("You entered this string:\n'%s'."),
  120.                    ADR("So I did"), NIL, NIL, adr );
  121.   END;
  122.  
  123.   vEZRequest (ADR("NUMBER 2:\nNumber requester\nfunction: rt.GetLong()"),
  124.                  ADR("Show me"),NIL, NIL, NIL);
  125.  
  126.   IF NOT rt.GetLong (longnum,ADR("Enter a number:"), NIL,
  127.                      TAG(tagbuf,rt.glShowDefault,FALSE,tagEnd)) THEN
  128.     vEZRequest (ADR("You entered nothing :-("),ADR("I'm sorry"),NIL, NIL, NIL);
  129.  
  130.   ELSE
  131.     adr:=ADR(longnum);
  132.     vEZRequest (ADR("The number you entered was:\n%ld"),
  133.                    ADR("So it was"), NIL, NIL,adr);
  134.   END;
  135.  
  136.   vEZRequest (ADR("NUMBER 3:\nNotification requester, the requester\n"+
  137.            "you've been using all the time!\nfunction: rt.EZRequest()"),
  138.            ADR("Show me more"),NIL, NIL, NIL);
  139.  
  140.   vEZRequest (ADR("Simplest usage: some body text and\na single centered gadget."),
  141.                  ADR("Got it"),NIL, NIL, NIL);
  142.  
  143.   WHILE NOT (EZRequest (ADR("You can also use two gadgets to\n"+
  144.              "ask the user something.\n"+
  145.              "Do you understand?"),ADR("Of course|Not really"),
  146.              NIL, NIL, NIL) # 0) DO
  147.     vEZRequest (ADR("You are not one of the brightest are you?\n"+
  148.                    "We'll try again..."),
  149.                    ADR("Ok"),NIL, NIL, NIL);
  150.   END; (* WHILE *)
  151.  
  152.   vEZRequest (ADR("Great, we'll continue then."),ADR("Fine"),NIL, NIL, NIL);
  153.  
  154.   CASE EZRequest (ADR("You can also put up a requester with\n"+
  155.                       "three choices.\n"+
  156.                       "How do you like the demo so far ?"),
  157.                   ADR("Great|So so|Rubbish"),NIL, NIL, NIL) OF
  158.     | 0:
  159.       vEZRequest (ADR("Too bad, I really hoped you\nwould like it better."),
  160.                      ADR("So what"),NIL, NIL, NIL);
  161.     | 1:
  162.       vEZRequest (ADR("I'm glad you like it so much."),ADR("Fine"),NIL, NIL, NIL);
  163.     | 2:
  164.       vEZRequest (ADR("Maybe if you run the demo again\n"+
  165.                      "you'll REALLY like it."),
  166.                      ADR("Perhaps"),NIL, NIL, NIL);
  167.   END; (* CASE *)
  168.  
  169.   ret := EZRequestTags (ADR("The number of responses is not limited to three\n"+
  170.                   "as you can see.  The gadgets are labeled with\n"+
  171.                   "the return code from rt.EZRequest().\n"+
  172.                   "Pressing Return will choose 4, note that\n"+
  173.                   "4's button text is printed in boldface."),
  174.                   ADR("1|2|3|4|5|0"), NIL, NIL,
  175.                   TAG(tagbuf,rt.ezDefaultResponse, 4, tagEnd));
  176.   adr:=ADR(ret);
  177.   vEZRequest (ADR("You picked '%ld'."),ADR("How true"), NIL, NIL,adr);
  178.   adr := ADR ("five");
  179.   adr:=TAG(tagbuf,5,adr);
  180.   vEZRequest (
  181.     ADR("You may also use C-style formatting codes in the body text.\n"+
  182.     "Like this:\n\n"+
  183.     "'The number %%ld is written %%s.' will give:\n\n"+
  184.     "The number %ld is written %s.\n\n"+
  185.     "if you also pass '5' and '\"five\"' to rt.EZRequest()."),
  186.     ADR("Proceed"), NIL, NIL,adr);
  187.  
  188.   IF (diskInserted IN CAST (IDCMPFlagSet,EZRequestTags
  189.              (ADR("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.               ADR("Continue"), NIL, NIL,
  194.               TAG(tagbuf,rt.IDCMPFlags,IDCMPFlagSet{diskInserted},tagEnd)))) THEN
  195.     vEZRequest (ADR("You inserted a disk."),ADR("I did"),NIL, NIL, NIL);
  196.   ELSE
  197.     vEZRequest (ADR("You used the 'Continue' gadget\n"+
  198.           "to satisfy the requester."),ADR("I did"),NIL, NIL, NIL);
  199.   END;
  200.  
  201.   vEZRequestTags (ADR("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.               ADR("Amazing"), NIL, NIL,
  206.               TAG(tagbuf,rt.ReqPos, rt.ReqPosTopLeftScr, tagEnd));
  207.  
  208.   vEZRequestTags (ADR("Alternatively, you can center the\n"+
  209.               "requester on the screen.\n"+
  210.               "Check out 'reqtools.doc' for all the possibilities."),
  211.               ADR("I'll do that"), NIL, NIL,
  212.               TAG(tagbuf,rt.ReqPos, rt.ReqPosCenterScr,tagEnd));
  213.  
  214.   vEZRequest (ADR("NUMBER 4:\nFile requester\n"+
  215.                  "function: rt.FileRequest()"),ADR("Demonstrate"),NIL, 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 := ADR (myhook);
  223.     INCL (filereq^.flags, rt.fReqDoWildFunc);
  224.  
  225.     myhook.data:=REG (8+4);
  226.  
  227.     (*$ ENDIF *)
  228.  
  229.  
  230.     filename := "";
  231.     IF rt.FileRequest (filereq, ADR(filename),ADR("Pick a file"),TAG(tagbuf,tagEnd)) THEN
  232.       adr := ADR (filename); adr2 := filereq^.dir;
  233.       adr:=TAG(tagbuf,adr,adr2);
  234.        vEZRequest (ADR("You picked the file:\n'%s'\nin directory:\n'%s'"),
  235.                ADR("Right"), NIL, NIL,adr);
  236.     ELSE
  237.       vEZRequest (ADR("You didn't pick a file."),ADR("No"),NIL, NIL, NIL);
  238.     END;
  239.  
  240.     rt.FreeRequest (filereq);
  241.   ELSE
  242.     vEZRequest (ADR("Out of memory!"),ADR("Oh boy!"),NIL, NIL, NIL);
  243.   END;
  244.  
  245.   vEZRequest (ADR("The file requester can be used\n"+
  246.                   "as a directory requester as well."),
  247.               ADR("Let'see that"),NIL, NIL, NIL);
  248.  
  249.   filereq := rt.AllocRequestA (rt.TypeFileReq, NIL);
  250.   IF filereq # NIL THEN
  251.     IF rt.FileRequest (filereq, ADR(filename),ADR("Pick a directory"),
  252.              TAG(tagbuf,rt.fiFlags,LONGSET {rt.fReqNoFiles},tagEnd)) THEN
  253.       adr := ADR(filereq^.dir);
  254.       vEZRequest (ADR("You picked the directory:\n'%s'"),
  255.                      ADR("Right"), NIL, NIL, adr);
  256.     ELSE
  257.       vEZRequest (ADR("You didn't pick a directory."),ADR("No"),NIL, NIL, NIL);
  258.     END;
  259.     rt.FreeRequest (filereq);
  260.   ELSE
  261.     vEZRequest (ADR("Out of memory!"),ADR("Oh boy!"),NIL, NIL, NIL);
  262.   END;
  263.  
  264.   vEZRequest (ADR("NUMBER 5:\nFont requester\nfunction: rt.FontRequest()"),
  265.                  ADR("Show"),NIL, NIL, NIL);
  266.  
  267.   fontreq := rt.AllocRequestA (rt.TypeFontReq, NIL);
  268.   IF fontreq # NIL THEN
  269.     fontreq^.flags := LONGSET {rt.fReqStyle, rt.fReqColorFonts};
  270.  
  271.     (*$ IF DoHook *)
  272.     myhook.entry := hookfunc;
  273.     fontreq^.hook := ADR (myhook);
  274.     INCL (fontreq^.flags, rt.fReqDoWildFunc);
  275.  
  276.     myhook.data:=REG (8+4);
  277.  
  278.     (*$ ENDIF *)
  279.  
  280.     IF rt.FontRequest (fontreq,ADR("Pick a font"),TAG(tagbuf,tagEnd)) THEN
  281.       adr := fontreq^.attr.name; adr2 := fontreq^.attr.ySize;
  282.       adr:=TAG(tagbuf,adr, adr2);
  283.       vEZRequest (ADR("You picked the font:\n'%s'\nwith size:\n'%ld'"),
  284.                      ADR("Right"), NIL, NIL, adr);
  285.     ELSE
  286.       vEZRequest (ADR("You canceled.\nWas there no font you liked ?"),
  287.                      ADR("Nope"),NIL, NIL, NIL);
  288.     END;
  289.  
  290.     rt.FreeRequest (fontreq);
  291.   ELSE
  292.     vEZRequest (ADR("Out of memory!"),ADR("Oh boy!"),NIL, NIL, NIL);
  293.   END;
  294.  
  295.   vEZRequest (ADR("NUMBER 6:\nPalette requester\nfunction: rt.PaletteRequest()"),
  296.                  ADR("Proceed"),NIL, NIL, NIL);
  297.  
  298.   color := rt.PaletteRequest (ADR("Change palette"), NIL,TAG(tagbuf,tagEnd));
  299.   IF color = -1 THEN
  300.     vEZRequest (ADR("You canceled.\nNo nice colors to be picked ?"),
  301.                    ADR("Nah"),NIL, NIL, NIL);
  302.   ELSE
  303.     adr:=ADR(color);
  304.     vEZRequest (ADR("You picked color number %ld."),ADR("Sure did"),
  305.                    NIL, NIL,adr);
  306.   END;
  307.  
  308.   myputs ("\nFinished, hope you enjoyed the demo :-)\n");
  309. END ReqToolsDemo.
  310.