home *** CD-ROM | disk | FTP | other *** search
/ Aminet 10 / aminetcdnumber101996.iso / Aminet / dev / gui / mui31mod.lha / MUI / Developer / Modula / Demo / Class3.mod < prev    next >
Encoding:
Text File  |  1995-11-27  |  11.3 KB  |  355 lines

  1. MODULE Class3 ;
  2.  
  3. (*
  4. ** Class3.mod by Olaf "Olf" Peters <olf@informatik.uni-bremen.de>
  5. **
  6. ** based upon Class3.c by Stefan Stuntz.
  7. **
  8. ** Updated Nov 27, 1995 by Olaf Peters:
  9. **  - does not use MUIOBSOLETE tags any longer
  10. **  - uses "the ideal input loop for an object oriented MUI application"
  11. **      (see MUI_Application.doc/MUIM_Application_NewInput)
  12. *)
  13.  
  14. (*$ RangeChk := FALSE *)
  15.  
  16. FROM SYSTEM     IMPORT  TAG, ADR, ADDRESS, LONGSET, CAST, SETREG, REG ;
  17. FROM AmigaLib   IMPORT  DoSuperMethodA ;
  18. FROM DosD       IMPORT  ctrlC ;
  19. FROM ExecL      IMPORT  Wait ;
  20.  
  21. IMPORT
  22.         R,
  23.         gd  : GraphicsD,
  24.         gl  : GraphicsL,
  25.         id  : IntuitionD,
  26.         il  : IntuitionL,
  27.         m   : MuiD,
  28.         mc  : MuiClasses,
  29.         ml  : MuiL,
  30.         mm  : MuiMacros,
  31.         ms  : MuiSupport,
  32.         ud  : UtilityD,
  33.         ul  : UtilityL ;
  34.  
  35. (***************************************************************************)
  36. (* Here is the beginning of our new class...                               *)
  37. (***************************************************************************)
  38.  
  39. (*
  40. ** This is the instance data for our custom class.
  41. *)
  42.  
  43. TYPE
  44.   Data  = RECORD
  45.             x,
  46.             y,
  47.             sx,
  48.             sy : INTEGER ;
  49.           END (* RECORD *) ;
  50.  
  51. (*
  52. ** AskMinMax method will be called before the window is opened
  53. ** and before layout takes place. We need to tell MUI the
  54. ** minimum, maximum and default size of our object.
  55. *)
  56.  
  57. (*/// "mAskMinMax(cl : id.IClassPtr; obj : id.ObjectPtr; msg : mc.mpAskMinMaxPtr) : ADDRES" *)
  58.  
  59. PROCEDURE mAskMinMax(cl : id.IClassPtr; obj : id.ObjectPtr; msg : mc.mpAskMinMaxPtr) : ADDRESS;
  60.  
  61. BEGIN
  62.   (*
  63.   ** let our superclass first fill in what it thinks about sizes.
  64.   ** this will e.g. add the size of frame and inner spacing.
  65.   *)
  66.  
  67.   IF DoSuperMethodA(cl, obj, msg) # NIL THEN END ;
  68.  
  69.   (*
  70.   ** now add the values specific to our object. note that we
  71.   ** indeed need to *add* these values, not just set them!
  72.   *)
  73.  
  74.   INC(msg^.MinMaxInfo^.MinWidth, 100) ;
  75.   INC(msg^.MinMaxInfo^.DefWidth, 120) ;
  76.   INC(msg^.MinMaxInfo^.MaxWidth, 500) ;
  77.  
  78.   INC(msg^.MinMaxInfo^.MinHeight, 40) ;
  79.   INC(msg^.MinMaxInfo^.DefHeight, 90) ;
  80.   INC(msg^.MinMaxInfo^.MaxHeight, 300) ;
  81.  
  82.   RETURN NIL ;
  83. END mAskMinMax ;
  84.  
  85. (*\\\*)
  86.  
  87. (*
  88. ** Draw method is called whenever MUI feels we should render
  89. ** our object. This usually happens after layout is finished
  90. ** or when we need to refresh in a simplerefresh window.
  91. ** Note: You may only render within the rectangle
  92. **       _mleft(obj), _mtop(obj), _mwidth(obj), _mheight(obj).
  93. *)
  94.  
  95. (*/// "mDraw(cl : id.IClassPtr; obj : id.ObjectPtr; msg : mc.mpDrawPtr) : ADDRES" *)
  96.  
  97. PROCEDURE mDraw(cl : id.IClassPtr; obj : id.ObjectPtr; msg : mc.mpDrawPtr) : ADDRESS;
  98.  
  99. VAR
  100.   data : POINTER TO Data ;
  101.  
  102. BEGIN
  103.   data := mc.InstData(cl, obj) ;
  104.  
  105.   (*
  106.   ** let our superclass draw itself first, area class would
  107.   ** e.g. draw the frame and clear the whole region. What
  108.   ** it does exactly depends on msg->flags.
  109.   **
  110.   ** Note: You *must* call the super method prior to do
  111.   ** anything else, otherwise msg->flags will not be set
  112.   ** properly !!!
  113.   *)
  114.  
  115.   IF DoSuperMethodA(cl, obj, msg) # NIL THEN END ;
  116.  
  117.   (*
  118.   ** if MADF_DRAWOBJECT isn't set, we shouldn't draw anything.
  119.   ** MUI just wanted to update the frame or something like that.
  120.   *)
  121.  
  122.   IF mc.drawUpdate IN msg^.flags THEN
  123.     IF (data^.sx # 0) OR (data^.sy # 0) THEN
  124.       gl.SetBPen(mc.OBJ_rp(obj),mc.OBJ_dri(obj)^.pens^[id.shinePen]) ;
  125.       gl.ScrollRaster(mc.OBJ_rp(obj),data^.sx,data^.sy,mc.OBJ_mleft(obj),mc.OBJ_mtop(obj),mc.OBJ_mright(obj),mc.OBJ_mbottom(obj));
  126.       gl.SetBPen(mc.OBJ_rp(obj),0);
  127.       data^.sx := 0;
  128.       data^.sy := 0;
  129.     ELSE
  130.       gl.SetAPen(mc.OBJ_rp(obj),mc.OBJ_dri(obj)^.pens^[id.shadowPen]);
  131.       IF gl.WritePixel(mc.OBJ_rp(obj),data^.x,data^.y) THEN END ;
  132.     END (* IF *) ;
  133.   ELSIF mc.drawObject IN msg^.flags THEN
  134.     gl.SetAPen(mc.OBJ_rp(obj),mc.OBJ_dri(obj)^.pens^[id.shinePen]);
  135.     gl.RectFill(mc.OBJ_rp(obj),mc.OBJ_mleft(obj),mc.OBJ_mtop(obj),mc.OBJ_mright(obj),mc.OBJ_mbottom(obj));
  136.   END (* IF *) ;
  137.  
  138.   RETURN NIL ;
  139. END mDraw ;
  140.  
  141. (*\\\*)
  142. (*/// "mSetup(cl : id.IClassPtr; obj : id.ObjectPtr; msg : mc.mpHandleInputPtr) : ADDRES" *)
  143.  
  144. PROCEDURE mSetup(cl : id.IClassPtr; obj : id.ObjectPtr; msg : mc.mpHandleInputPtr) : ADDRESS;
  145.  
  146. BEGIN
  147.   IF DoSuperMethodA(cl, obj, msg) = NIL THEN RETURN LONGINT(FALSE) END ;
  148.  
  149.   ml.moRequestIDCMP(obj,id.IDCMPFlagSet{id.mouseButtons, id.rawKey}) ;
  150.   RETURN LONGINT(TRUE) ;
  151. END mSetup ;
  152.  
  153. (*\\\*)
  154. (*/// "mCleanup(cl : id.IClassPtr; obj : id.ObjectPtr; msg : mc.mpHandleInputPtr) : ADDRES" *)
  155.  
  156. PROCEDURE mCleanup(cl : id.IClassPtr; obj : id.ObjectPtr; msg : mc.mpHandleInputPtr) : ADDRESS;
  157.  
  158. BEGIN
  159.   ml.moRejectIDCMP(obj,id.IDCMPFlagSet{id.mouseButtons, id.rawKey}) ;
  160.  
  161.   RETURN DoSuperMethodA(cl, obj, msg) ;
  162. END mCleanup;
  163.  
  164. (*\\\*)
  165. (*/// "mHandleInput(cl : id.IClassPtr; obj : id.ObjectPtr; msg : mc.mpHandleInputPtr) : ADDRES" *)
  166.  
  167. PROCEDURE mHandleInput(cl : id.IClassPtr; obj : id.ObjectPtr; msg : mc.mpHandleInputPtr) : ADDRESS;
  168.  
  169.   PROCEDURE Between(a, x, b : LONGINT) : BOOLEAN ;
  170.   BEGIN
  171.     RETURN (x >= a) AND (x <= b) ;
  172.   END Between ;
  173.  
  174.   PROCEDURE IsInObject(x, y : LONGINT) : BOOLEAN ;
  175.   BEGIN
  176.     RETURN Between(mc.OBJ_mleft(obj), x, mc.OBJ_mright(obj)) AND Between(mc.OBJ_mtop(obj), y, mc.OBJ_mbottom(obj)) ;
  177.   END IsInObject;
  178.  
  179. VAR
  180.   data : POINTER TO Data ;
  181.  
  182. BEGIN
  183.   data := mc.InstData(cl, obj) ;
  184.  
  185.   IF msg^.muikey # 0 THEN
  186.     CASE msg^.muikey OF
  187.     | mc.MUIKEYLEFT  : data^.sx := -1 ; IF ml.moRedraw(obj, CAST(LONGCARD, mc.MADFlagSet{mc.drawUpdate})) # NIL THEN END ;
  188.     | mc.MUIKEYRIGHT : data^.sx :=  1 ; IF ml.moRedraw(obj, CAST(LONGCARD, mc.MADFlagSet{mc.drawUpdate})) # NIL THEN END ;
  189.     | mc.MUIKEYUP    : data^.sy := -1 ; IF ml.moRedraw(obj, CAST(LONGCARD, mc.MADFlagSet{mc.drawUpdate})) # NIL THEN END ;
  190.     | mc.MUIKEYDOWN  : data^.sy :=  1 ; IF ml.moRedraw(obj, CAST(LONGCARD, mc.MADFlagSet{mc.drawUpdate})) # NIL THEN END ;
  191.     ELSE
  192.     END (* CASE *) ;
  193.   END (* IF *) ;
  194.  
  195.   IF msg^.imsg # NIL THEN
  196.     IF id.mouseButtons IN msg^.imsg^.class THEN
  197.       IF msg^.imsg^.code = id.selectDown THEN
  198.         IF IsInObject(msg^.imsg^.mouseX, msg^.imsg^.mouseY) THEN
  199.           data^.x := msg^.imsg^.mouseX ;
  200.           data^.y := msg^.imsg^.mouseY ;
  201.           IF ml.moRedraw(obj, CAST(LONGCARD, mc.MADFlagSet{mc.drawUpdate})) # NIL THEN END ;
  202.           ml.moRequestIDCMP(obj, id.IDCMPFlagSet{id.mouseMove}) ;
  203.         END (* IF *) ;
  204.       ELSE
  205.         ml.moRejectIDCMP(obj, id.IDCMPFlagSet{id.mouseMove}) ;
  206.       END (* IF *) ;
  207.     ELSIF id.mouseMove IN msg^.imsg^.class THEN
  208.       IF IsInObject(msg^.imsg^.mouseX, msg^.imsg^.mouseY) THEN
  209.         data^.x := msg^.imsg^.mouseX ;
  210.         data^.y := msg^.imsg^.mouseY ;
  211.         IF ml.moRedraw(obj, CAST(LONGCARD, mc.MADFlagSet{mc.drawUpdate})) # NIL THEN END ;
  212.       END (* IF *) ;
  213.     END (* IF *)
  214.   END (* IF *) ;
  215.  
  216.   RETURN DoSuperMethodA(cl, obj, msg) ;
  217. END mHandleInput ;
  218.  
  219. (*\\\*)
  220.  
  221. (*
  222. ** Here comes the dispatcher for our custom class. 
  223. ** Unknown/unused methods are passed to the superclass immediately.
  224. *)
  225.  
  226. (*/// "MyDispatcher(cl : id.IClassPtr; obj : ADDRESS; msg : ADDRESS) : ADDRESS" *)
  227.  
  228. PROCEDURE MyDispatcher(cl : id.IClassPtr; obj : ADDRESS; msg : ADDRESS) : ADDRESS ;
  229.  
  230. VAR
  231.   mid : LONGCARD ;
  232.  
  233. BEGIN
  234.   mid := CAST(id.Msg, msg)^.methodID ;
  235.  
  236.      IF mid = m.mmAskMinMax   THEN RETURN mAskMinMax(cl, obj, msg)
  237.   ELSIF mid = m.mmSetup       THEN RETURN mSetup(cl, obj, msg)
  238.   ELSIF mid = m.mmCleanup     THEN RETURN mCleanup(cl, obj, msg)
  239.   ELSIF mid = m.mmDraw        THEN RETURN mDraw(cl, obj, msg)
  240.   ELSIF mid = m.mmHandleInput THEN RETURN mHandleInput(cl, obj, msg)
  241.   ELSE
  242.     RETURN DoSuperMethodA(cl, obj, msg)
  243.   END (* CASE *) ;
  244. END MyDispatcher ;
  245.  
  246. (*\\\*)
  247.  
  248. (***************************************************************************)
  249. (* Thats all there is about it. Now lets see how things are used...        *)
  250. (***************************************************************************)
  251.  
  252. VAR
  253.   app,
  254.   window,
  255.   grp,
  256.   myObj,
  257.   text     :  id.ObjectPtr ;
  258.   mcc      :  mc.mCustomClassPtr ;
  259.   signals  :  LONGSET ;
  260.   running  := BOOLEAN{TRUE} ;
  261.   myDispatcher : ADDRESS ;
  262.   NULL     := ADDRESS{NIL} ;
  263.  
  264.   tags     :  ARRAY [0..31] OF LONGINT ;
  265.  
  266. BEGIN
  267.  
  268.   (* Create the new custom class with a call to MUI_CreateCustomClass(). *)
  269.   (* Caution: This function returns not a struct IClass, but a           *)
  270.   (* struct MUI_CustomClass which contains a struct IClass to be         *)
  271.   (* used with NewObject() calls.                                        *)
  272.   (* Note well: MUI creates the dispatcher hook for you, you may         *)
  273.   (* *not* use its h_Data field! If you need custom data, use the        *)
  274.   (* cl_UserData of the IClass structure!                                *)
  275.  
  276.   IF ml.muiMasterVersion < 11 THEN ms.fail(NULL, "You need MUI 3 to run this demo.") END;
  277.  
  278.   myDispatcher := ADR(MyDispatcher) ;
  279.   mcc := ml.moCreateCustomClass(NIL, ADR(m.mcArea), NIL, SIZE(Data), myDispatcher) ;
  280.   IF mcc = NIL THEN ms.fail(NULL, "Could not create custom class.") END ;
  281.  
  282.   mc.MakeDispatcher(MyDispatcher, mcc^.class) ;
  283.  
  284.   myObj := il.NewObjectA(mcc^.class, NIL, TAG(tags, m.maFrame,       m.mvFrameText,
  285.                                               ud.tagDone)) ;
  286.  
  287.   text := mm.TextObject(TAG(tags, m.maFrame,        m.mvFrameText,
  288.                                   m.maBackground,   m.miTextBack,
  289.                                   m.maTextContents, ADR("\ecPaint with mouse,\nscroll with cursor keys."),
  290.                             ud.tagDone)) ;
  291.  
  292.   grp := mm.GroupObject(TAG(tags, m.maGroupHoriz, FALSE,
  293.                                   mm.Child,       text,
  294.                                   mm.Child,       myObj,
  295.                             ud.tagDone)) ;
  296.  
  297.  
  298.   window := mm.WindowObject(TAG(tags, m.maWindowTitle, ADR("A rather complex custom class"),
  299.                                       m.maWindowID,    mm.MakeID("CLS3"),
  300.                                       mm.WindowContents, grp,
  301.                                 ud.tagDone)) ;
  302.  
  303.   app := mm.ApplicationObject(TAG(tags, m.maApplicationTitle,       ADR("Class3-M2"),
  304.                                         m.maApplicationVersion,     ADR("$VER: Class3-M2 11.1 (22.9.95)"),
  305.                                         m.maApplicationCopyright,   ADR("©1995, Olaf Peters, Stefan Stuntz"),
  306.                                         m.maApplicationAuthor,      ADR("Olaf Peters, Stefan Stuntz"),
  307.                                         m.maApplicationDescription, ADR("Demonstrate the use of custom classes."),
  308.                                         m.maApplicationBase,        ADR("CLASS3M2"),
  309.                                         mm.SubWindow,               window,
  310.                                   ud.tagDone)) ;
  311.  
  312.   IF app = NIL THEN ms.fail(NULL, "Failed to create Application.") END ;
  313.  
  314.   mm.set(window,m.maWindowDefaultObject, LONGCARD(myObj)) ;
  315.  
  316.   mm.NoteClose(app, window, m.mvApplicationReturnIDQuit) ; 
  317.  
  318.  
  319. (*
  320. ** Input loop...
  321. *)
  322.  
  323.   mm.set(window, m.maWindowOpen, LONGCARD(TRUE)) ;
  324.  
  325.   signals := LONGSET{} ;
  326.  
  327.   LOOP
  328.     IF ms.DOMethod(app, TAG(tags, m.mmApplicationNewInput, ADR(signals))) = m.mvApplicationReturnIDQuit THEN EXIT END ;
  329.  
  330.     IF signals # LONGSET{} THEN
  331.       INCL(signals, ctrlC) ;
  332.       signals := Wait(signals) ;
  333.       IF ctrlC IN signals THEN EXIT END ;
  334.     END (* IF *) ;
  335.   END (* WHILE *) ;
  336.  
  337.   mm.set(window, m.maWindowOpen, LONGCARD(FALSE)) ;
  338.  
  339.  
  340. (*
  341. ** Shut down...
  342. *)
  343.  
  344. CLOSE
  345.   IF app # NIL THEN
  346.     ml.mDisposeObject(app) ;
  347.     app := NIL ;
  348.   END (* IF *) ;
  349.  
  350.   IF mcc # NIL THEN
  351.     IF ml.moDeleteCustomClass(mcc) THEN END ;
  352.     mcc := NIL ;
  353.   END (* IF *) ;
  354. END Class3.
  355.