home *** CD-ROM | disk | FTP | other *** search
/ The Fred Fish Collection 1.5 / ffcollection-1-5-1992-11.iso / ff_progs / prog_oth / reqlibr.lzh / ReqLibrary / ReqDemoModula.mod < prev    next >
Encoding:
Text File  |  1991-12-31  |  9.2 KB  |  296 lines
  1. MODULE ReqDemoModula;
  2.  
  3. IMPORT ReqD,
  4.        ReqL,
  5.        ReqSupport,
  6.        DosD,
  7.        Arts,
  8.        SYSTEM,
  9.        I:IntuitionD,
  10.        IL: IntuitionL,
  11.        E:ExecD,
  12.        EL: ExecL,
  13.        G:GraphicsD,
  14.        GL:GraphicsL,
  15.        tm:TaskMemory;
  16.  
  17. VAR freq,fontreq: ReqD.ReqFileRequester;
  18.     gadblocks: ARRAY[0..8] OF ReqD.GadgetBlock;
  19.     dirstring : ReqD.DirString;
  20.     filestring: ReqD.FileString;
  21.     wholefile : ReqD.PathString;
  22.     wholefilePtr : ReqD.PathStringPtr;
  23.     ScP: I.ScreenPtr;
  24.     oldWinP,WinP    : I.WindowPtr;
  25.     IMessPtr: I.IntuiMessagePtr;
  26.     gadgetPtr: I.GadgetPtr;
  27.     myproc : DosD.ProcessPtr;
  28.     gadgetnum : INTEGER;
  29.     x,y: LONGINT;
  30.  
  31. TYPE gadstringType = ARRAY[0..8],[0..33] OF CHAR;
  32.  
  33. VAR gadstrings: gadstringType;
  34.  
  35.  
  36. PROCEDURE OpenAll();
  37.    VAR NSc  : I.NewScreen;
  38.        Nw   : I.NewWindow;
  39.  
  40.    BEGIN
  41.       NSc.leftEdge     := 0;    NSc.topEdge      := 0;
  42.       NSc.width        := GL.graphicsBase^.normalDisplayColumns;
  43.       NSc.height       := GL.graphicsBase^.normalDisplayRows;
  44.       NSc.depth        := 3;    NSc.detailPen    := 0;
  45.       NSc.blockPen     := 1;    NSc.viewModes    :=G.ViewModeSet{G.hires};
  46.       NSc.type         := I.customScreen;
  47.       NSc.defaultTitle := SYSTEM.ADR("Show off requester library.");
  48.       NSc.font         := NIL;
  49.       NSc.gadgets      := NIL;  NSc.customBitMap := NIL;
  50.       ScP := IL.OpenScreen(NSc); Arts.Assert(ScP#NIL,SYSTEM.ADR("Couldn't open screen!"));
  51.  
  52.       Nw.leftEdge      := 0;    Nw.topEdge       := 0;
  53.       Nw.width         := NSc.width; Nw.height := NSc.height;
  54.       Nw.detailPen     := -1;    Nw.blockPen      := -1;
  55.       Nw.idcmpFlags    := I.IDCMPFlagSet{I.gadgetUp};
  56.       Nw.flags         := I.WindowFlagSet{I.activate,I.backDrop,I.borderless};
  57.       Nw.firstGadget   := NIL;  Nw.checkMark     := NIL;
  58.       Nw.screen        := ScP;  Nw.bitMap        := NIL;
  59.       Nw.minWidth      := 128;  Nw.minHeight     := 24;
  60.       Nw.maxWidth      := -1;   Nw.maxHeight     := -1;
  61.       Nw.title         := NIL;  Nw.type          := I.customScreen;
  62.  
  63.       FOR gadgetnum:=0 TO 8 DO
  64.          x := Nw.leftEdge + 20 + (gadgetnum MOD 2) * (Nw.width DIV 2);
  65.          y := (Nw.height-4*20) DIV 2 + (gadgetnum DIV 2) * 20;
  66.          ReqL.LinkGadget(SYSTEM.ADR(gadblocks[gadgetnum]),SYSTEM.ADR(gadstrings[gadgetnum]),Nw, x, y);
  67.          gadblocks[gadgetnum].gadget.gadgetID := gadgetnum;
  68.       END; (* FOR *)
  69.       gadgetPtr := SYSTEM.ADR(gadblocks[8].gadget);
  70.       gadgetPtr^.topEdge  := 20;
  71.       gadgetPtr^.leftEdge := (Nw.width-gadgetPtr^.width) DIV 2;
  72.       WinP := IL.OpenWindow(Nw);
  73.       Arts.Assert(WinP#NIL,SYSTEM.ADR("Couldn't open window!"));
  74.    END OpenAll;
  75.  
  76.  
  77. PROCEDURE ShowFileReq;
  78.  
  79.    BEGIN
  80.       freq.versionNumber:=ReqL.reqVersion;
  81.       freq.dir   := SYSTEM.ADR(dirstring);
  82.       freq.file  := SYSTEM.ADR(filestring);
  83.       freq.pathName := wholefilePtr;
  84.       freq.flags := ReqD.UmmFlagSet{ReqD.infogadget};
  85.       freq.dirnamescolor := 2;
  86.       freq.devicenamescolor := 2;
  87.       freq.show := "*";
  88.  
  89.       IF ReqL.FileRequest(SYSTEM.ADR(freq))
  90.          THEN
  91.             ReqSupport.SimpleRequest("You selected the file '%s'.",SYSTEM.ADR(wholefilePtr));
  92.          ELSE
  93.             ReqSupport.SimpleRequest("You didn't select a file.",NIL);
  94.       END; (* IF *)
  95.    END ShowFileReq;
  96.  
  97.  
  98. PROCEDURE ShowColorReq;
  99.  
  100.    BEGIN
  101.       IF (ReqL.ColorRequester(1) # 0)
  102.          THEN
  103.       END; (* IF *)
  104.    END ShowColorReq;
  105.  
  106.  
  107. PROCEDURE ShowSimpleText;
  108.  
  109.    BEGIN
  110.       ReqSupport.SimpleRequest("     SimpleRequest()  is  a  tiny bit of\n glue  code  which  passes  a single text\n string " +
  111.                                " (with  optional  printf()  style\n formatting) to the TextRequest() routine\n in  the  library. " +
  112.                                "The  SimpleRequest()\n routine  can be  easily modified to fit\n your own peculiar purposes.",NIL);
  113.    END ShowSimpleText;
  114.  
  115.  
  116. PROCEDURE ShowTwoGadText;
  117.  
  118.    TYPE yesnoType = ARRAY[0..1],[0..3] OF CHAR;
  119.  
  120.    VAR yesno : yesnoType;
  121.        result : INTEGER;
  122.        yesnoPtr : POINTER TO ARRAY[0..3] OF CHAR;
  123.  
  124.    BEGIN
  125.       yesno[0]:="no";
  126.       yesno[1]:="yes";
  127.       result := ReqSupport.TwoGadRequest("Just testing the two gadget requester.",NIL);
  128.       yesnoPtr := SYSTEM.ADR(yesno[result]);
  129.       ReqSupport.SimpleRequest("You responded with a '%s' to this requester.",SYSTEM.ADR(yesnoPtr));
  130.    END ShowTwoGadText;
  131.  
  132.  
  133. PROCEDURE ShowThreeGadText;
  134.  
  135.    TYPE responseType = ARRAY[0..2],[0..65] OF CHAR;
  136.  
  137.    VAR response : responseType;
  138.        myTextStruct : ReqD.TRStructure;
  139.        result : INTEGER;
  140.  
  141.    BEGIN
  142.       response[0]:="You really should use it.";
  143.       response[1]:="Excellent choice. You have good taste.";
  144.       response[2]:="Oh come on, make up your mind.\nYou won't regret choosing 'yes'.";
  145.  
  146.       myTextStruct.text := SYSTEM.ADR("     Would you use the requester library\nin your programs?");
  147.       myTextStruct.controls := NIL;
  148.       myTextStruct.window := NIL;
  149.       myTextStruct.middleText := SYSTEM.ADR("Perhaps...");
  150.       myTextStruct.positiveText := SYSTEM.ADR("Oh yeah, for sure!");
  151.       myTextStruct.negativeText := SYSTEM.ADR("Methinks not.");
  152.       myTextStruct.title := SYSTEM.ADR("Show off text requester.");
  153.       myTextStruct.keyMask := {0..15};
  154.       myTextStruct.textcolor := 0;
  155.       myTextStruct.detailcolor := 0;
  156.       myTextStruct.blockcolor := 0;
  157.       myTextStruct.versionnumber := ReqL.reqVersion;
  158.       myTextStruct.rfu1 := 0;
  159.       result := ReqL.TextRequest(SYSTEM.ADR(myTextStruct));
  160.       ReqSupport.SimpleRequest(response[result],NIL);
  161.    END ShowThreeGadText;
  162.  
  163.  
  164. PROCEDURE ShowFontReq;
  165.  
  166.    TYPE restype = RECORD
  167.                      fname : ReqD.FileStringPtr;
  168.                      size  : LONGINT;
  169.                      style : LONGINT;
  170.                   END; (* RECORD *)
  171.  
  172.    VAR fontname : ReqD.FileString;
  173.        dirname  : ReqD.DirString;
  174.        result   : restype;
  175.  
  176.    BEGIN
  177.       dirname := "fonts:";
  178.       fontname := "";
  179.       fontreq.versionNumber:=ReqL.reqVersion;
  180.       fontreq.dir  := SYSTEM.ADR(dirname);
  181.       fontreq.file := SYSTEM.ADR(fontname);
  182.       fontreq.fontnamescolor := 2;
  183.       fontreq.flags := ReqD.UmmFlagSet{ReqD.getfonts};
  184.       IF ReqL.FileRequest(SYSTEM.ADR(fontreq))
  185.          THEN
  186.             result.fname := fontreq.file;
  187.             result.size  := fontreq.fontYSize;
  188.             result.style := fontreq.fontStyle;
  189.             ReqSupport.SimpleRequest("You selected the font '%s',\nsize %ld, type %ld.",SYSTEM.ADR(result));
  190.          ELSE
  191.             ReqSupport.SimpleRequest("You didn't select a font.",NIL);
  192.       END; (* IF *)
  193. END ShowFontReq;
  194.  
  195.  
  196. PROCEDURE ShowGetString;
  197.  
  198.    CONST textlength = 74;
  199.  
  200.    VAR mybuffer : ARRAY[0..textlength] OF CHAR;
  201.        mybufferPtr: POINTER TO ARRAY[0..textlength] OF CHAR;
  202.  
  203.    BEGIN
  204.       mybufferPtr:=SYSTEM.ADR(mybuffer);
  205.       mybuffer := "The default text.";
  206.       IF ReqL.GetString(mybufferPtr,SYSTEM.ADR("Type anything, then hit return."),NIL,50,textlength)
  207.          THEN
  208.             ReqSupport.SimpleRequest("I'll bet you typed:\n%s",SYSTEM.ADR(mybufferPtr));
  209.          ELSE
  210.             ReqSupport.SimpleRequest("You didn't enter anything!",NIL);
  211.       END; (* IF *)
  212.    END ShowGetString;
  213.  
  214.  
  215. PROCEDURE ShowGetLong;
  216.  
  217.    VAR mygetlongstruct : ReqD.GetLongStruct;
  218.  
  219.    BEGIN
  220.       mygetlongstruct.titlebar := SYSTEM.ADR("Enter a number.");
  221.       mygetlongstruct.defaultval := 1234;
  222.       mygetlongstruct.minlimit := MIN(LONGINT);
  223.       mygetlongstruct.maxlimit := MAX(LONGINT);
  224.       mygetlongstruct.window := NIL;
  225.       mygetlongstruct.versionnumber := ReqL.reqVersion;
  226.       mygetlongstruct.flags := SYSTEM.LONGSET{};
  227.       mygetlongstruct.rfu2 := 0;
  228.  
  229.       IF ReqL.GetLong(SYSTEM.ADR(mygetlongstruct))
  230.          THEN
  231.             ReqSupport.SimpleRequest("You entered the number '%ld'.",SYSTEM.ADR(mygetlongstruct.result));
  232.          ELSE
  233.             ReqSupport.SimpleRequest("You didn't enter a number.",NIL);
  234.       END; (* IF *)
  235.    END ShowGetLong;
  236.  
  237.  
  238. BEGIN
  239.    wholefilePtr:=SYSTEM.ADR(wholefile);
  240.  
  241.    gadstrings[0]:="Show the file requester.";
  242.    gadstrings[1]:="Show the color requester.";
  243.    gadstrings[2]:="Show a simple text requester.";
  244.    gadstrings[3]:="Show a two gadget requester.";
  245.    gadstrings[4]:="Show a three gadget requester.";
  246.    gadstrings[5]:="Show the font requester.";
  247.    gadstrings[6]:="Show the 'get text' requester.";
  248.    gadstrings[7]:="Show the 'get number' requester.";
  249.    gadstrings[8]:="Exit the demo.";
  250.  
  251.    OpenAll;
  252.    myproc := SYSTEM.CAST(DosD.ProcessPtr,EL.FindTask(NIL));
  253.    oldWinP := myproc^.windowPtr;
  254.    myproc^.windowPtr := WinP;
  255.  
  256.    LOOP
  257.       EL.WaitPort(WinP^.userPort);
  258.       IMessPtr := EL.GetMsg(WinP^.userPort);
  259.       WHILE (IMessPtr # NIL) DO
  260.          gadgetPtr := IMessPtr^.iAddress;
  261.          gadgetnum := gadgetPtr^.gadgetID;
  262.  
  263.          CASE gadgetnum OF
  264.             |0: ShowFileReq;
  265.             |1: ShowColorReq;
  266.             |2: ShowSimpleText;
  267.             |3: ShowTwoGadText;
  268.             |4: ShowThreeGadText;
  269.             |5: ShowFontReq;
  270.             |6: ShowGetString;
  271.             |7: ShowGetLong;
  272.             |8: EXIT;
  273.             ELSE
  274.          END; (* CASE *)
  275.          EL.ReplyMsg(IMessPtr);
  276.       END; (* WHILE *)
  277.    END; (* LOOP *)
  278.  
  279. CLOSE
  280.    IF (myproc^.windowPtr # NIL)
  281.       THEN
  282.          myproc^.windowPtr := oldWinP;
  283.    END; (* IF *)
  284.  
  285.    IF (WinP # NIL)
  286.       THEN
  287.          IL.CloseWindow(WinP);
  288.    END; (* IF *)
  289.  
  290.    IF (ScP # NIL)
  291.       THEN
  292.          IL.CloseScreen(ScP);
  293.    END; (* IF *)
  294.  
  295. END ReqDemoModula.
  296.