home *** CD-ROM | disk | FTP | other *** search
/ Frozen Fish 1: Amiga / FrozenFish-Apr94.iso / bbs / alib / d7xx / d752 / toolmanager.lha / ToolManager / Programmers / Programmers.lha / examples / M2TMTest.mod < prev    next >
Text File  |  1992-09-26  |  4KB  |  101 lines
  1. (*-------------------------------------------------------------------------*)
  2. (*                                                                         *)
  3. (*  TMTest - Example for using toolmanager.library and hooks               *)
  4. (*                                                    Date: 17-Jul-92      *)
  5. (*                                                                         *)
  6. (*   © 1992 by Martin Horneffer                                            *)
  7. (*                                                                         *)
  8. (*  This  Module  may  freely  be copied and distributed, as long as it is *)
  9. (*  left unchanged and kept together with "toolmanager.library", © 1992 by *)
  10. (*  Stefan Becker.                                                         *)
  11. (*                                                                         *)
  12. (*  Modified M2Amiga Modula-2 version by Jürgen Weinelt.                   *)
  13. (*  Same Copyright notice as above.                                        *)
  14. (*                                                                         *)
  15. (*-------------------------------------------------------------------------*)
  16.  
  17. MODULE M2TMTest;
  18.  
  19. IMPORT A:Arts;
  20. IMPORT TMD:ToolManagerD;
  21. IMPORT TML:ToolManagerL;
  22. IMPORT IO:InOut;
  23. IMPORT UD:UtilityD;
  24. IMPORT ED:ExecD;
  25. IMPORT R;
  26. IMPORT S:SYSTEM;
  27.  
  28.  
  29.  
  30. VAR
  31.   hook: UD.Hook;
  32.   tmhandle: TMD.TMHandlePtr;
  33.   count: LONGINT;
  34.   foo: CHAR;
  35.   tagbuffer: ARRAY[0..19] OF LONGINT;
  36.  
  37.  
  38. (*$ SaveA4:=TRUE *)
  39. PROCEDURE TestHook( hook{R.A0}:UD.HookPtr; object{R.A2}:S.ADDRESS; message{R.A1}:S.ADDRESS): LONGINT;
  40.   BEGIN
  41.     S.SETREG(R.A4,object); (* get A4 *)
  42.     INC(count);
  43.     RETURN 0;
  44.   END TestHook;
  45.  
  46. BEGIN
  47.   tmhandle := TML.AllocTMHandle();
  48.   IF tmhandle=NIL THEN
  49.     IO.WriteString("\nERROR: AllocTMHandle failed\n\n");
  50.     A.Exit(20);
  51.   END;
  52.  
  53.   hook.entry := S.ADR(TestHook);
  54.   hook.data  := S.REG(R.A4); (* save A4 *)
  55.  
  56.   IF NOT TML.CreateTMObjectTagList(tmhandle,S.ADR("TMTestExec"),TMD.otExec,
  57.                                    S.TAG(tagbuffer,
  58.                                          TMD.opExecType,TMD.etHook,
  59.                                          TMD.opCommand,S.ADR(hook),
  60.                                          UD.tagEnd)) THEN
  61.     IO.WriteString("\nERROR: CreateTMObjectTagList(TMTestExec) failed\n\n");
  62.     A.Exit(10);
  63.   END;
  64.  
  65.   IF NOT TML.CreateTMObjectTagList(tmhandle,S.ADR("TMTestMenu"),TMD.otMenu,
  66.                                    S.TAG(tagbuffer,
  67.                                          TMD.opExec,S.ADR("TMTestExec"),
  68.                                          UD.tagEnd)) THEN
  69.     IO.WriteString("\nERROR: CreateTMObjectTagList(TMTestMenu) failed\n\n");
  70.     A.Exit(10);
  71.   END;
  72.  
  73.   IF NOT TML.CreateTMObjectTagList(tmhandle,S.ADR("TMTestImage"),TMD.otImage,
  74.                                    S.TAG(tagbuffer,
  75.                                          TMD.opFile,S.ADR("dh0:t/testbrush"),
  76.                                          UD.tagEnd)) THEN
  77.     IO.WriteString("\nERROR: CreateTMObjectTagList(TMTestImage) failed\n\n");
  78.     A.Exit(10);
  79.   END;
  80.  
  81.   IF NOT TML.CreateTMObjectTagList(tmhandle,S.ADR("TMTestIcon"),TMD.otIcon,
  82.                                    S.TAG(tagbuffer,
  83.                                          TMD.opExec,S.ADR("TMTestExec"),
  84.                                          TMD.opImage,S.ADR("TMTestImage"),
  85.                                          UD.tagEnd)) THEN
  86.     IO.WriteString("\nERROR: CreateTMObjectTagList(TMTestIcon) failed\n\n");
  87.     A.Exit(10);
  88.   END;
  89.  
  90.   count:=0;
  91.  
  92.   IO.WriteString("\nPress return/enter... "); IO.Read(foo);
  93.  
  94.   IO.WriteString("The hook has been called "); IO.WriteInt(count,0); IO.WriteString(" times.\n\n");
  95.  
  96. CLOSE
  97.   IF tmhandle#NIL THEN
  98.     TML.FreeTMHandle(tmhandle);
  99.   END;
  100. END M2TMTest.
  101.