home *** CD-ROM | disk | FTP | other *** search
- (* ------------------------------------------------------------------------
- :Program. ReqToolsDemo
- :Contents. Demonstrates use auf Nico François' reqtools.library
- :Author. Kai Bolay [kai] (C-Version by Nico François)
- :Address. Hoffmannstraße 168
- :Address. D-7250 Leonberg 1 (Germany)
- :Address. UUCP: ...!cbmvax!cbmehq!cbmger!depot1!amokle!kai
- :Address. FIDO: 2:247/706.3
- :History. v1.0 [kai] 22-Nov-91 (translated from C)
- :History. v1.0m [Frank Lömker] 24-Feb-92 Umsetzung nach Modula
- :History. v2.0m [Frank Lömker] 10-Aug-92 ReqTools V38
- :Copyright. Public Domain
- :Language. Modula
- :Translator. M2Amiga V4.0d
- :Imports. ReqTools, ReqToolsSupport
- :Remark. Thanks to Nico for his great library
- :Bugs. ReqTools/Arq should support each other
- :Bugs. Font-Hook: ta.name can contain odd pointer :-(
- ------------------------------------------------------------------------ *)
-
- (*********************************
- * *
- * reqtools.library (V38) *
- * *
- * Release 2.0 *
- * *
- * (c) 1991/1992 Nico François *
- * *
- * demo.c *
- * *
- * This source is public domain *
- * in all respects. *
- * *
- *********************************)
-
- MODULE ReqToolsDemo;
- (*$ DEFINE DoHook:=FALSE *)
-
- FROM GraphicsD IMPORT TextAttrPtr;
- FROM DosL IMPORT Output,Write;
- FROM DosD IMPORT FileInfoBlockPtr;
- FROM IntuitionD IMPORT IDCMPFlags,IDCMPFlagSet;
- FROM SYSTEM IMPORT ADDRESS,ADR,SETREG,REG,TAG,CAST,LONGSET;
- FROM Arts IMPORT kickVersion;
- FROM UtilityD IMPORT Hook,HookPtr,tagEnd;
- FROM String IMPORT Length;
- IMPORT rt: ReqTools;
- FROM ReqToolsSupport IMPORT EZRequest,vEZRequest,EZRequestTags,vEZRequestTags;
-
- VAR tagbuf:ARRAY [0..11] OF LONGINT;
- filereq: rt.FileRequesterPtr;
- fontreq: rt.FontRequesterPtr;
- scrmodereq: rt.ScreenModeRequesterPtr;
- myhook: Hook;
- buffer: ARRAY [0..127] OF CHAR;
- filename: ARRAY [0..33] OF CHAR;
- longnum, ret, color: LONGINT;
- adr, adr2: ADDRESS;
-
- PROCEDURE myputs (str: ARRAY OF CHAR);
- BEGIN
- IF Output() # NIL THEN
- (*$ StackParms:=TRUE *)
- SETREG (0,Write (Output(), ADR(str), Length (str) ));
- (*$ POP StackParms *)
- END;
- END myputs;
-
- (*$ IF DoHook *)
-
- (*$ StackChk:=FALSE SaveA4:=TRUE *)
- PROCEDURE FileFilterfunc (hook{8}: HookPtr;
- filereq{10}: ADDRESS;
- fib{9}: ADDRESS):ADDRESS;
- BEGIN
- SETREG (12,hook^.data);
- myputs (CAST(FileInfoBlockPtr,fib)^.fileName); myputs ("\n");
- RETURN ADDRESS(TRUE);
- END FileFilterfunc;
- (*$ POP StackChk *)
-
- (*$ StackChk:=FALSE SaveA4:=TRUE *)
- PROCEDURE FontFilterfunc (hook{8}: HookPtr;
- fontreq{10}: ADDRESS;
- textattr{9}: ADDRESS):ADDRESS;
- VAR n:POINTER TO ARRAY [0..127] OF CHAR;
- BEGIN
- SETREG (12,hook^.data);
- n:=CAST(TextAttrPtr,textattr)^.name;
- myputs (n^); (* May contain odd Pointer :-( *)
- myputs ("\n"); (* ^ Bei mir (Frank) hat es funktioniert *)
- RETURN ADDRESS(TRUE);
- END FontFilterfunc;
- (*$ POP StackChk *)
-
- (*$ StackChk:=FALSE SaveA4:=TRUE *)
- PROCEDURE VolFilterfunc (hook{8}: HookPtr;
- filereq{10}: ADDRESS;
- volentry{9}: ADDRESS):ADDRESS;
- VAR n:POINTER TO ARRAY [0..127] OF CHAR;
- BEGIN
- SETREG (12,hook^.data);
- IF CAST(rt.VolumeEntryPtr,volentry)^.type=0 THEN myputs ("(Volume) ");
- ELSE myputs ("(Assign) "); END;
- n:=CAST(rt.VolumeEntryPtr,volentry)^.name;
- myputs (n^); myputs ("\n");
- RETURN ADDRESS(TRUE);
- END VolFilterfunc;
- (*$ POP StackChk *)
-
- (*$ ENDIF *)
-
- BEGIN
- vEZRequest (ADR("ReqTools 2.0 Demo\n"+
- "~~~~~~~~~~~~~~~~~\n"+
- "'reqtools.library' offers several\ndifferent types of requesters:"),
- ADR("Let's see them"), NIL, NIL, NIL);
-
- vEZRequest (ADR("NUMBER 1:\nThe larch :-)"),ADR("Be serious!"), NIL, NIL,NIL);
-
- vEZRequest (ADR("NUMBER 1:\nString requester\nfunction: rt.GetString()"),
- ADR("Show me"),NIL, NIL, NIL);
-
- buffer := "A bit of text";
- IF NOT rt.GetString (ADR(buffer), 127,ADR("Enter anything:"), NIL,TAG(tagbuf,tagEnd)) THEN
- vEZRequest (ADR("You entered nothing :-("),ADR("I'm sorry"),NIL, NIL, NIL);
- ELSE
- adr:=TAG(tagbuf,ADR (buffer));
- vEZRequest (ADR("You entered this string:\n'%s'."),
- ADR("So I did"), NIL, NIL, adr );
- END;
- adr:=ADR(" _Ok |New _2.0 feature!|_Cancel");
- adr2:=ADR("These are two new features of ReqTools 2.0:\n"+
- "Text above the entry gadget and more than\n"+
- "one response gadget.");
- IF rt.GetString (ADR(buffer),127,ADR("Enter anything:"),NIL,
- TAG(tagbuf,rt.gsGadFmt,adr,
- rt.gsTextFmt,adr2,rt.Underscore,"_",tagEnd)) THEN END;
- adr:=ADR(" _Ok |_Abort|_Cancel");
- adr2:=ADR("New is also the ability to switch off the\n"+
- "backfill pattern. You can also center the\n"+
- "text above the entry gadget.\n"+
- "These new features are also available in\n"+
- "the rtGetLong() requester.");
- IF rt.GetString (ADR(buffer), 127,ADR("Enter anything:"),NIL,
- TAG(tagbuf,rt.gsGadFmt,adr,rt.gsTextFmt,adr2,
- rt.gsBackfill,FALSE,
- rt.gsFlags,LONGSET{rt.gsReqCenterText,rt.gsReqHighlightText},
- rt.Underscore,"_",tagEnd)) THEN END;
-
- vEZRequest (ADR("NUMBER 2:\nNumber requester\nfunction: rt.GetLong()"),
- ADR("Show me"),NIL, NIL, NIL);
-
- IF NOT rt.GetLong (longnum,ADR("Enter a number:"), NIL,
- TAG(tagbuf,rt.glShowDefault,FALSE,tagEnd)) THEN
- vEZRequest (ADR("You entered nothing :-("),ADR("I'm sorry"),NIL, NIL, NIL);
- ELSE
- adr:=ADR(longnum);
- vEZRequest (ADR("The number you entered was:\n%ld"),
- ADR("So it was"), NIL, NIL,adr);
- END;
-
- vEZRequest (ADR("NUMBER 3:\nMessage requester, the requester\n"+
- "you've been using all the time!\nfunction: rt.EZRequest()"),
- ADR("Show me more"),NIL, NIL, NIL);
-
- vEZRequest (ADR("Simplest usage: some body text and\na single centered gadget."),
- ADR("Got it"),NIL, NIL, NIL);
-
- WHILE NOT (EZRequest (ADR("You can also use two gadgets to\n"+
- "ask the user something.\n"+
- "Do you understand?"),ADR("Of course|Not really"),
- NIL, NIL, NIL) # 0) DO
- vEZRequest (ADR("You are not one of the brightest are you?\n"+
- "We'll try again..."),
- ADR("Ok"),NIL, NIL, NIL);
- END; (* WHILE *)
-
- vEZRequest (ADR("Great, we'll continue then."),ADR("Fine"),NIL, NIL, NIL);
-
- CASE EZRequest (ADR("You can also put up a requester with\n"+
- "three choices.\n"+
- "How do you like the demo so far ?"),
- ADR("Great|So so|Rubbish"),NIL, NIL, NIL) OF
- | 0:
- vEZRequest (ADR("Too bad, I really hoped you\nwould like it better."),
- ADR("So what"),NIL, NIL, NIL);
- | 1:
- vEZRequest (ADR("I'm glad you like it so much."),ADR("Fine"),NIL, NIL, NIL);
- | 2:
- vEZRequest (ADR("Maybe if you run the demo again\n"+
- "you'll REALLY like it."),
- ADR("Perhaps"),NIL, NIL, NIL);
- END; (* CASE *)
-
- ret := EZRequestTags (ADR("The number of responses is not limited to three\n"+
- "as you can see. The gadgets are labeled with\n"+
- "the return code from rt.EZRequest().\n"+
- "Pressing Return will choose 4, note that\n"+
- "4's button text is printed in boldface."),
- ADR("1|2|3|4|5|0"), NIL, NIL,
- TAG(tagbuf,rt.ezDefaultResponse, 4, tagEnd));
- adr:=ADR(ret);
- vEZRequest (ADR("You picked '%ld'."),ADR("How true"), NIL, NIL,adr);
- vEZRequestTags (ADR("New for Release 2.0 of ReqTools (V38) is\n"+
- "the possibility to define characters in the\n"+
- "buttons as keyboard shortcuts.\n"+
- "As you can see these characters are underlined.\n"+
- "Pressing shift while still holding down the key\n"+
- "will cancel the shortcut.\n"+
- "Note that in other requesters a string gadget may\n"+
- "be active. To use the keyboard shortcuts there\n"+
- "you have to keep the Right Amiga key pressed down."),
- ADR("_Great|_Fantastic|_Swell|Oh _Boy"),
- NIL,NIL,
- TAG(tagbuf,rt.Underscore, '_', tagEnd));
-
- adr := ADR ("five"); tagbuf[5]:=5; tagbuf[6]:=adr;
- adr2:=ADR(tagbuf[5]);
- vEZRequest (
- ADR("You may also use C-style formatting codes in the body text.\n"+
- "Like this:\n\n"+
- "'The number %%ld is written %%s.' will give:\n\n"+
- "The number %ld is written %s.\n\n"+
- "if you also pass '5' and '\"five\"' to rt.EZRequest()."),
- ADR("_Proceed"), NIL, TAG(tagbuf,rt.Underscore,"_",tagEnd),adr2);
-
- IF (diskInserted IN CAST (IDCMPFlagSet,EZRequestTags
- (ADR("It is also possible to pass extra IDCMP flags\n"+
- "that will satisfy rt.EZRequest(). This requester\n"+
- "has had DISKINSERTED passed to it.\n"+
- "(Try insert.ing a disk)."),
- ADR("_Continue"), NIL, NIL,
- TAG(tagbuf,rt.IDCMPFlags,IDCMPFlagSet{diskInserted},rt.Underscore,"_",tagEnd)))) THEN
- vEZRequest (ADR("You inserted a disk."),ADR("I did"),NIL, NIL, NIL);
- ELSE
- vEZRequest (ADR("You used the 'Continue' gadget\n"+
- "to satisfy the requester."),ADR("I did"),NIL, NIL, NIL);
- END;
-
- vEZRequestTags (ADR("Finally, it is possible to specify the position\n"+
- "of the requester.\n"+
- "E.g. at the top left of the screen, like this.\n"+
- "This works for all requesters, not just rt.EZRequest()!"),
- ADR("_Amazing"), NIL, NIL,
- TAG(tagbuf,rt.ReqPos, rt.ReqPosTopLeftScr,rt.Underscore,"_",tagEnd));
-
- vEZRequestTags (ADR("Alternatively, you can center the\n"+
- "requester on the screen.\n"+
- "Check out 'reqtools.doc' for all the possibilities."),
- ADR("I'll do that"), NIL, NIL,
- TAG(tagbuf,rt.ReqPos, rt.ReqPosCenterScr,tagEnd));
-
- adr:=TAG(tagbuf,rt.Underscore,"_",tagEnd);
- vEZRequest (ADR("NUMBER 4:\nFile requester\n"+
- "function: rt.FileRequest()"),ADR("_Demonstrate"),NIL,adr,NIL);
-
- filereq := rt.AllocRequestA (rt.TypeFileReq, NIL);
- IF filereq # NIL THEN
-
- (*$ IF DoHook *)
- myhook.entry := FileFilterfunc;
- myhook.data:=REG (8+4);
- (*$ ENDIF *)
-
- filename := ""; adr:=ADR(myhook);
- IF rt.FileRequest (filereq, ADR(filename),ADR("Pick a file"),TAG(tagbuf,
- (*$ IF DoHook *) rt.fiFilterFunc,adr, (*$ ENDIF *)
- tagEnd)) THEN
- adr := ADR (filename); adr2 := filereq^.dir;
- adr:=TAG(tagbuf,adr,adr2);
- vEZRequest (ADR("You picked the file:\n'%s'\nin directory:\n'%s'"),
- ADR("Right"), NIL, NIL,adr);
- ELSE
- vEZRequest (ADR("You didn't pick a file."),ADR("No"),NIL, NIL, NIL);
- END;
-
- rt.FreeRequest (filereq);
- ELSE
- vEZRequest (ADR("Out of memory!"),ADR("Oh boy!"),NIL, NIL, NIL);
- END; (* IF filereq # NIL *)
-
- adr:=TAG(tagbuf,rt.Underscore,"_",tagEnd);
- vEZRequest (ADR("The file requester can be used\n"+
- "as a directory requester as well."),
- ADR("Let's _see that"),NIL,adr,NIL);
-
- filereq := rt.AllocRequestA (rt.TypeFileReq, NIL);
- IF filereq # NIL THEN
- IF rt.FileRequest (filereq, ADR(filename),ADR("Pick a directory"),
- TAG(tagbuf,rt.fiFlags,LONGSET {rt.fReqNoFiles},tagEnd)) THEN
- adr := ADR(filereq^.dir);
- vEZRequest (ADR("You picked the directory:\n'%s'"),
- ADR("Right"), NIL, NIL, adr);
- ELSE
- vEZRequest (ADR("You didn't pick a directory."),ADR("No"),NIL, NIL, NIL);
- END;
- rt.FreeRequest (filereq);
- ELSE
- vEZRequest (ADR("Out of memory!"),ADR("Oh boy!"),NIL, NIL, NIL);
- END; (* IF filereq # NIL *)
-
- vEZRequest (ADR("NUMBER 5:\nFont requester\nfunction: rt.FontRequest()"),
- ADR("Show"),NIL, NIL, NIL);
-
- fontreq := rt.AllocRequestA (rt.TypeFontReq, NIL);
- IF fontreq # NIL THEN
- fontreq^.flags := LONGSET {rt.fReqStyle, rt.fReqColorFonts};
-
- (*$ IF DoHook *)
- myhook.entry := FontFilterfunc;
- myhook.data:=REG (8+4);
- (*$ ENDIF *)
-
- adr:=ADR(myhook);
- IF rt.FontRequest (fontreq,ADR("Pick a font"),TAG(tagbuf,
- (*$ IF DoHook *) rt.foFilterFunc,adr, (*$ ENDIF *)
- tagEnd)) THEN
- adr := fontreq^.attr.name; adr2 := fontreq^.attr.ySize;
- adr:=TAG(tagbuf,adr, adr2);
- vEZRequest (ADR("You picked the font:\n'%s'\nwith size:\n'%ld'"),
- ADR("Right"), NIL, NIL, adr);
- ELSE
- adr:=TAG(tagbuf,rt.Underscore,"_",tagEnd);
- vEZRequest (ADR("You canceled.\nWas there no font you liked ?"),
- ADR("_Nope"),NIL,adr,NIL);
- END;
-
- rt.FreeRequest (fontreq);
- ELSE
- vEZRequest (ADR("Out of memory!"),ADR("Oh boy!"),NIL, NIL, NIL);
- END; (* IF fontreq # NIL *)
-
- adr:=TAG(tagbuf,rt.Underscore,"_",tagEnd);
- vEZRequest (ADR("NUMBER 6:\nPalette requester\nfunction: rt.PaletteRequest()"),
- ADR("_Proceed"),NIL,adr,NIL);
-
- color := rt.PaletteRequest (ADR("Change palette"), NIL,TAG(tagbuf,tagEnd));
- IF color = -1 THEN
- vEZRequest (ADR("You canceled.\nNo nice colors to be picked ?"),
- ADR("Nah"),NIL, NIL, NIL);
- ELSE
- adr:=ADR(color);
- vEZRequest (ADR("You picked color number %ld."),ADR("Sure did"),
- NIL, NIL,adr);
- END;
-
- adr:=TAG(tagbuf,rt.Underscore,"_",tagEnd);
- vEZRequest (ADR("NUMBER 7: (ReqTools 2.0)\n"+
- "Volume requester\n"+
- "function: rtFileRequest() with\n"+
- " RTFI_VolumeRequest tag."),
- ADR("_Show me"), NIL,adr,NIL);
-
- filereq := rt.AllocRequestA (rt.TypeFileReq, NIL);
- IF filereq # NIL THEN
-
- (*$ IF DoHook *)
- myhook.entry := VolFilterfunc;
- myhook.data:=REG (8+4);
- (*$ ENDIF *)
-
- adr:=ADR(myhook);
- IF rt.FileRequest (filereq, NIL, ADR("Pick a volume"),
- TAG(tagbuf,
- (*$ IF DoHook *) rt.fiFilterFunc,adr, (*$ ENDIF *)
- rt.fiVolumeRequest, 0, tagEnd)) THEN
- adr := ADR(filereq^.dir);
- vEZRequest (ADR("You picked the volume:\n'%s'"),
- ADR("Right"), NIL, NIL, adr);
- ELSE
- vEZRequest (ADR("You didn't pick a volume."),ADR("I did not"),NIL,NIL,NIL);
- END;
-
- rt.FreeRequest (filereq);
-
- ELSE
- vEZRequest (ADR("Out of memory!"),ADR("Oh boy!"), NIL, NIL, NIL);
- END; (* IF filereq # NIL *)
-
- adr:=TAG(tagbuf,rt.Underscore,"_",tagEnd);
- vEZRequest (ADR("NUMBER 8: (ReqTools 2.0)\n"+
- "Screen mode requester\n"+
- "function: rtScreenModeRequest()\n"+
- "Only available on Kickstart 2.0!"),
- ADR("_Proceed"), NIL,adr,NIL);
-
- IF kickVersion < 37 THEN
- adr:=TAG(tagbuf,rt.Underscore,"_",tagEnd);
- vEZRequest (ADR("Your Amiga doesn't seem to have\n"+
- "Kickstart 2.0 in ROM so I am not\n"+
- "able to show you the Screen mode\n"+
- "requester.\n"+
- "So upgrade to 2.0 *now* :-)"),
- ADR("_Allright"), NIL,adr,NIL);
- ELSE
- scrmodereq:=rt.AllocRequestA (rt.TypeScreenModeReq, NIL);
- IF scrmodereq#NIL THEN
-
- IF rt.ScreenModeRequest (scrmodereq,ADR("Pick a screen mode:"),
- TAG(tagbuf,rt.scFlags,LONGSET{rt.scReqDepthGad,rt.scReqSizeGads,
- rt.scReqAutoscrollGad,rt.scReqOverscanGad},tagEnd)) THEN
- IF scrmodereq^.autoScroll#0 THEN adr:=ADR("On");
- ELSE adr:=ADR("Off"); END;
- adr2:=TAG(tagbuf,scrmodereq^.displayID,
- scrmodereq^.displayWidth,
- scrmodereq^.displayHeight,
- scrmodereq^.displayDepth,
- scrmodereq^.overscanType,
- adr);
- vEZRequest (ADR("You picked this mode:\n"+
- "ModeID : 0x%lx\n"+
- "Size : %ld x %ld\n"+
- "Depth : %ld\n"+
- "Overscan: %ld\n"+
- "AutoScroll %s"),
- ADR("Right"), NIL, NIL,adr2);
- ELSE
- vEZRequest (ADR("You didn't pick a screen mode."),ADR("Nope"),NIL,NIL,NIL);
- END; (*IF rt.ScreenModeRequest *)
-
- rt.FreeRequest (scrmodereq);
- ELSE
- vEZRequest (ADR("Out of memory!"),ADR("Oh boy!"),NIL,NIL,NIL);
- END; (* IF scrmodereq#NIL *)
- END; (* IF kickVersion < 37 *)
- vEZRequestTags (ADR("That's it!\nHope you enjoyed the demo"),
- ADR("_Sure did"),NIL,NIL,
- TAG(tagbuf,rt.Underscore,"_",tagEnd));
- END ReqToolsDemo.
-