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

  1. MODULE Class2 ;
  2.  
  3. (*
  4. ** Class2.mod by Olaf "Olf" Peters <olf@informatik.uni-bremen.de>
  5. **
  6. ** based upon Class2.c by Stefan Stuntz.
  7. **
  8. ** IMPORTANT: RangeChk mußt be switched off, otherwise you'll get an error
  9. ** when entering the Colorwheel-Page!
  10. **
  11. ** Updated Nov 27, 1995 by Olaf Peters:
  12. **  - does not use MUIOBSOLETE tags any longer
  13. **  - uses "the ideal input loop for an object oriented MUI application"
  14. **      (see MUI_Application.doc/MUIM_Application_NewInput)
  15. *)
  16.  
  17. (*$ RangeChk := FALSE *)
  18.  
  19. FROM SYSTEM     IMPORT  TAG, ADR, ADDRESS, LONGSET, CAST, SETREG, REG ;
  20. FROM AmigaLib   IMPORT  DoSuperMethodA ;
  21. FROM DosD       IMPORT  ctrlC ;
  22. FROM ExecL      IMPORT  Wait ;
  23.  
  24. IMPORT
  25.         R,
  26.         gd  : GraphicsD,
  27.         gl  : GraphicsL,
  28.         id  : IntuitionD,
  29.         il  : IntuitionL,
  30.         m   : MuiD,
  31.         mc  : MuiClasses,
  32.         ml  : MuiL,
  33.         mm  : MuiMacros,
  34.         ms  : MuiSupport,
  35.         ud  : UtilityD,
  36.         ul  : UtilityL ;
  37.  
  38. (***************************************************************************)
  39. (* Here is the beginning of our simple new class...                        *)
  40. (***************************************************************************)
  41.  
  42. (*
  43. ** This class is the same as within Class1.c except that it features
  44. ** a pen attribute.
  45. *)
  46.  
  47. TYPE
  48.   LongcardPtr = POINTER TO LONGCARD ;
  49.  
  50.   Data = RECORD
  51.            penspec   : m.mPenSpec ;
  52.            pen       : ADDRESS;
  53.            penchange : BOOLEAN ;
  54.          END (* RECORD *) ;
  55.  
  56. CONST
  57.   MyAttrPen = LONGCARD(8022H) ; (* tag value for the new attribute.            *)
  58.  
  59. (*/// "mNew(cl : id.IClassPtr; obj : id.ObjectPtr; msg : id.OpSetPtr) : ADDRESS" *)
  60.  
  61. PROCEDURE mNew(cl : id.IClassPtr; obj : id.ObjectPtr; msg : id.OpSetPtr) : ADDRESS ;
  62.  
  63. VAR
  64.   data  : POINTER TO Data ;
  65.   tag,
  66.   tags  : ud.TagItemPtr ;
  67.  
  68. BEGIN
  69.   obj := DoSuperMethodA(cl, obj, msg) ;
  70.   IF obj = NIL THEN RETURN NIL END ;
  71.  
  72.   data := mc.InstData(cl, obj) ;
  73.  
  74.   (* parse initial taglist *)
  75.  
  76.   tags := msg^.attrList ;
  77.   tag  := ul.NextTagItem(tags) ;
  78.   WHILE tag # NIL DO
  79.     CASE tag^.tag OF
  80.     | MyAttrPen : IF tag^.data # 0 THEN
  81.                     data^.penspec := CAST(m.mPenSpecPtr, tag^.data)^ ;
  82.                   END (* IF *) ;
  83.     ELSE
  84.     END (* CASE *) ;
  85.     tag := ul.NextTagItem(tags) ;
  86.   END (* WHILE *) ;
  87.  
  88.   RETURN obj ;
  89. END mNew ;
  90.  
  91. (*\\\*)
  92. (*/// "mDispose(cl : id.IClassPtr; obj : id.ObjectPtr; msg : ADDRESS) : ADDRESS" *)
  93.  
  94. PROCEDURE mDispose(cl : id.IClassPtr; obj : id.ObjectPtr; msg : ADDRESS) : ADDRESS ;
  95.  
  96. BEGIN
  97.   (* OM_NEW didnt allocates something, just do nothing here... *)
  98.   RETURN DoSuperMethodA(cl, obj, msg) ;
  99. END mDispose ;
  100.  
  101. (*\\\*)
  102.  
  103. (*
  104. ** OM_SET method, we need to see if someone changed the penspec attribute.
  105. *)
  106.  
  107. (*/// "mSet(cl : id.IClassPtr; obj : id.ObjectPtr; msg : id.OpSetPtr) : ADDRESS" *)
  108.  
  109. PROCEDURE mSet(cl : id.IClassPtr; obj : id.ObjectPtr; msg : id.OpSetPtr) : ADDRESS ;
  110.  
  111. VAR
  112.   data : POINTER TO Data ;
  113.   tag,
  114.   tags : ud.TagItemPtr ;
  115.  
  116. BEGIN
  117.   data := mc.InstData(cl, obj) ;
  118.  
  119.   tags := msg^.attrList ;
  120.   tag  := ul.NextTagItem(tags) ;
  121.   WHILE tag # NIL DO
  122.     CASE tag^.tag OF
  123.     | MyAttrPen : IF tag^.data # 0 THEN
  124.                     data^.penspec   := CAST(m.mPenSpecPtr, tag^.data)^ ;
  125.                     data^.penchange := TRUE ;
  126.                     IF ml.moRedraw(obj, CAST(LONGCARD, mc.MADFlagSet{mc.drawObject})) # NIL THEN END ;
  127.                   END (* IF *) ;
  128.     ELSE
  129.     END (* CASE *) ;
  130.     tag := ul.NextTagItem(tags) ;
  131.   END (* WHILE *) ;
  132.  
  133.   RETURN DoSuperMethodA(cl, obj, msg) ;
  134. END mSet ;
  135.  
  136. (*\\\*)
  137.  
  138. (*
  139. ** OM_GET method, see if someone wants to read the color.
  140. *)
  141.  
  142. (*/// "mGet(cl : id.IClassPtr; obj : id.ObjectPtr; msg : id.OpGetPtr) : ADDRES" *)
  143.  
  144. PROCEDURE mGet(cl : id.IClassPtr; obj : id.ObjectPtr; msg : id.OpGetPtr) : ADDRESS;
  145.  
  146. VAR
  147.   data  : POINTER TO Data ;
  148.   store : LongcardPtr ;
  149.  
  150. BEGIN
  151.   data := mc.InstData(cl, obj) ;
  152.   store := CAST(LongcardPtr, msg^.storage) ;
  153.  
  154.   CASE msg^.attrID OF
  155.   | MyAttrPen : store^ := ADR(data^.penspec) ;
  156.                 RETURN LONGCARD(TRUE) ;
  157.   ELSE
  158.     RETURN DoSuperMethodA(cl, obj, msg) ;
  159.   END (* CASE *) ;
  160. END mGet ;
  161.  
  162. (*\\\*)
  163. (*/// "mSetup(cl : id.IClassPtr; obj : id.ObjectPtr; msg : id.OpSetPtr) : ADDRES" *)
  164.  
  165. PROCEDURE mSetup(cl : id.IClassPtr; obj : id.ObjectPtr; msg : id.OpSetPtr) : ADDRESS;
  166.  
  167. VAR
  168.   data : POINTER TO Data ;
  169.   test : ADDRESS ;
  170.  
  171. BEGIN
  172.   data := mc.InstData(cl, obj) ;
  173.  
  174.   IF DoSuperMethodA(cl, obj, msg) = NIL THEN
  175.     RETURN LONGCARD(FALSE) ;
  176.   END (* IF *) ;
  177.  
  178.   test := mc.muiRenderInfo(obj) ;
  179.   data^.pen := ml.moObtainPen(mc.muiRenderInfo(obj), ADR(data^.penspec)) ;
  180.  
  181.   RETURN LONGCARD(TRUE) ;
  182. END mSetup ;     
  183.  
  184. (*\\\*)
  185. (*/// "mCleanup(cl : id.IClassPtr; obj : id.ObjectPtr; msg : id.OpSetPtr) : ADDRES" *)
  186.  
  187. PROCEDURE mCleanup(cl : id.IClassPtr; obj : id.ObjectPtr; msg : id.OpSetPtr) : ADDRESS;
  188.  
  189. VAR
  190.   data :POINTER TO Data ;
  191.  
  192. BEGIN
  193.   data := mc.InstData(cl, obj) ;
  194.   ml.moReleasePen(mc.muiRenderInfo(obj), data^.pen) ;
  195.   RETURN DoSuperMethodA(cl, obj, msg) ;
  196. END mCleanup ;
  197.  
  198. (*\\\*)
  199. (*/// "mAskMinMax(cl : id.IClassPtr; obj : id.ObjectPtr; msg : mc.mpAskMinMaxPtr) : ADDRES" *)
  200.  
  201. PROCEDURE mAskMinMax(cl : id.IClassPtr; obj : id.ObjectPtr; msg : mc.mpAskMinMaxPtr) : ADDRESS;
  202.  
  203. BEGIN
  204.   (*
  205.   ** let our superclass first fill in what it thinks about sizes.
  206.   ** this will e.g. add the size of frame and inner spacing.
  207.   *)
  208.  
  209.   IF DoSuperMethodA(cl, obj, msg) # NIL THEN END ;
  210.  
  211.   (*
  212.   ** now add the values specific to our object. note that we
  213.   ** indeed need to *add* these values, not just set them!
  214.   *)
  215.  
  216.   INC(msg^.MinMaxInfo^.MinWidth, 100) ;
  217.   INC(msg^.MinMaxInfo^.DefWidth, 120) ;
  218.   INC(msg^.MinMaxInfo^.MaxWidth, 500) ;
  219.  
  220.   INC(msg^.MinMaxInfo^.MinHeight, 40) ;
  221.   INC(msg^.MinMaxInfo^.DefHeight, 90) ;
  222.   INC(msg^.MinMaxInfo^.MaxHeight, 300) ;
  223.  
  224.   RETURN NIL ;
  225. END mAskMinMax ;
  226.  
  227. (*\\\*)
  228.  
  229. (*
  230. ** Draw method is called whenever MUI feels we should render
  231. ** our object. This usually happens after layout is finished
  232. ** or when we need to refresh in a simplerefresh window.
  233. ** Note: You may only render within the rectangle
  234. **       _mleft(obj), _mtop(obj), _mwidth(obj), _mheight(obj).
  235. *)
  236.  
  237. (*/// "mDraw(cl : id.IClassPtr; obj : id.ObjectPtr; msg : mc.mpDraw) : ADDRES" *)
  238.  
  239. PROCEDURE mDraw(cl : id.IClassPtr; obj : id.ObjectPtr; msg : mc.mpDrawPtr) : ADDRESS;
  240.  
  241. VAR
  242.   data : POINTER TO Data ;
  243.   i    : INTEGER ;
  244.  
  245. BEGIN
  246.   data := mc.InstData(cl, obj) ;
  247.  
  248.   (*
  249.   ** let our superclass draw itself first, area class would
  250.   ** e.g. draw the frame and clear the whole region. What
  251.   ** it does exactly depends on msg->flags.
  252.   *)
  253.  
  254.   IF DoSuperMethodA(cl, obj, msg) # NIL THEN END ;
  255.  
  256.   (*
  257.   ** if MADF_DRAWOBJECT isn't set, we shouldn't draw anything.
  258.   ** MUI just wanted to update the frame or something like that.
  259.   *)
  260.  
  261.   IF NOT (mc.drawObject IN msg^.flags) THEN RETURN NIL END ;
  262.  
  263.   (*
  264.   ** test if someone changed our pen
  265.   *)
  266.  
  267.   IF data^.penchange THEN
  268.     data^.penchange := FALSE ;
  269.     ml.moReleasePen(mc.muiRenderInfo(obj), data^.pen) ;
  270.     data^.pen := ml.moObtainPen(mc.muiRenderInfo(obj), ADR(data^.penspec)) ;
  271.   END (* IF *) ;
  272.  
  273.   (*
  274.   ** ok, everything ready to render...
  275.   ** Note that we *must* use the MUIPEN() macro before actually
  276.   ** using pens from MUI_ObtainPen() in rendering calls.
  277.   *)
  278.  
  279.   gl.SetAPen(mc.OBJ_rp(obj),mc.muiPen(data^.pen));
  280.  
  281.   FOR i := mc.OBJ_mleft(obj) TO mc.OBJ_mright(obj) BY 5 DO
  282.     gl.Move(mc.OBJ_rp(obj),mc.OBJ_mleft(obj),mc.OBJ_mtop(obj));
  283.     gl.Draw(mc.OBJ_rp(obj),i,mc.OBJ_mbottom(obj));
  284.     gl.Move(mc.OBJ_rp(obj),mc.OBJ_mright(obj),mc.OBJ_mtop(obj));
  285.     gl.Draw(mc.OBJ_rp(obj),i,mc.OBJ_mbottom(obj));
  286.   END (* FOR *) ;
  287.  
  288.   RETURN NIL ;
  289. END mDraw ;
  290.  
  291. (*\\\*)
  292.  
  293. (*
  294. ** Here comes the dispatcher for our custom class. We only need to
  295. ** care about MUIM_AskMinMax and MUIM_Draw in this simple case.
  296. ** Unknown/unused methods are passed to the superclass immediately.
  297. *)
  298.  
  299. (*/// "MyDispatcher(cl : id.IClassPtr; obj : ADDRESS; msg : ADDRESS) : ADDRESS" *)
  300.  
  301. PROCEDURE MyDispatcher(cl : id.IClassPtr; obj : ADDRESS; msg : ADDRESS) : ADDRESS ;
  302.  
  303. VAR
  304.   mid : LONGCARD ;
  305.  
  306. BEGIN
  307.   mid := CAST(id.Msg, msg)^.methodID ;
  308.  
  309.      IF mid = id.omNEW      THEN RETURN mNew(cl, obj, msg)
  310.   ELSIF mid = id.omDISPOSE  THEN RETURN mDispose(cl, obj, msg)
  311.   ELSIF mid = id.omSET      THEN RETURN mSet(cl, obj, msg)
  312.   ELSIF mid = id.omGET      THEN RETURN mGet(cl, obj, msg)
  313.   ELSIF mid = m.mmAskMinMax THEN RETURN mAskMinMax(cl, obj, msg)
  314.   ELSIF mid = m.mmSetup     THEN RETURN mSetup(cl, obj, msg)
  315.   ELSIF mid = m.mmCleanup   THEN RETURN mCleanup(cl, obj, msg)
  316.   ELSIF mid = m.mmDraw      THEN RETURN mDraw(cl, obj, msg)
  317.   ELSE
  318.     RETURN DoSuperMethodA(cl, obj, msg)
  319.   END (* CASE *) ;
  320. END MyDispatcher ;
  321.  
  322. (*\\\*)
  323.  
  324. (***************************************************************************)
  325. (* Thats all there is about it. Now lets see how things are used...        *)
  326. (***************************************************************************)
  327.  
  328. VAR
  329.   app,
  330.   window,
  331.   grp,
  332.   myObj,
  333.   pen      : id.ObjectPtr ;
  334.   mcc      : mc.mCustomClassPtr ;
  335.   signals  : LONGSET ;
  336.   startpen : m.mPenSpecPtr ;
  337.   NULL     :=ADDRESS{NIL};
  338.   myDispatcher : ADDRESS ;
  339.  
  340.   tags     : ARRAY [0..31] OF LONGINT ;
  341.   tags1    : ARRAY [0..7]  OF LONGINT ;
  342.  
  343. BEGIN
  344.   (* Create the new custom class with a call to MUI_CreateCustomClass(). *)
  345.   (* Caution: This function returns not a struct IClass, but a           *)
  346.   (* struct MUI_CustomClass which contains a struct IClass to be         *)
  347.   (* used with NewObject() calls.                                        *)
  348.   (* Note well: MUI creates the dispatcher hook for you, you may         *)
  349.   (* *not* use its h_Data field! If you need custom data, use the        *)
  350.   (* cl_UserData of the IClass structure!                                *)
  351.  
  352.   IF ml.muiMasterVersion < 12 THEN ms.fail(NULL, "You need MUI 3.1 to run this demo.") END;
  353.  
  354.   myDispatcher := ADR(myDispatcher) ;
  355.   mcc := ml.moCreateCustomClass(NIL, ADR(m.mcArea), NIL, SIZE(Data), myDispatcher) ;
  356.   IF mcc = NIL THEN ms.fail(NULL, "Could not create custom class.") END ;
  357.  
  358.   mc.MakeDispatcher(MyDispatcher, mcc^.class) ;
  359.  
  360.   pen := mm.PoppenObject(TAG(tags, m.maCycleChain, TRUE,
  361.                                    m.maWindowTitle, ADR("Custom Class Color"),
  362.                              ud.tagDone)) ;
  363.  
  364.   myObj := il.NewObjectA(mcc^.class, NIL, TAG(tags, m.maFrame,      m.mvFrameText,
  365.                                                     m.maBackground, m.miBACKGROUND,
  366.                                               ud.tagDone)) ;
  367.  
  368.   grp := mm.GroupObject(TAG(tags, m.maGroupHoriz,  FALSE,
  369.                                   mm.Child,        mm.TextObject(TAG(tags1, m.maFrame, m.mvFrameText,
  370.                                                                             m.maBackground, m.miTextBack,
  371.                                                                             m.maTextContents, ADR("\ecThis is a custom class with attributes.\nClick on the button at the bottom of\nthe window to adjust the color."),
  372.                                                                      ud.tagDone)),
  373.                                   mm.Child,        myObj,
  374.                                   mm.Child,        mm.GroupObject(TAG(tags1, m.maWeight, 10,
  375.                                                                              mm.Child, mm.FreeLabel(ADR("Custom Class Color:")),
  376.                                                                              mm.Child, pen,
  377.                                                                       ud.tagDone)),
  378.  
  379.                             ud.tagDone)) ;
  380.  
  381.   window := mm.WindowObject(TAG(tags, m.maWindowTitle, ADR("Another Custom Class"),
  382.                                       m.maWindowID,    mm.MakeID("CLS2"),
  383.                                       mm.WindowContents, grp,
  384.                                 ud.tagDone)) ;
  385.  
  386.   app := mm.ApplicationObject(TAG(tags, m.maApplicationTitle,       ADR("Class2-M2"),
  387.                                         m.maApplicationVersion,     ADR("$VER: Class2-M2 11.1 (21.9.95)"),
  388.                                         m.maApplicationCopyright,   ADR("©1995, Olaf Peters, Stefan Stuntz"),
  389.                                         m.maApplicationAuthor,      ADR("Olaf Peters, Stefan Stuntz"),
  390.                                         m.maApplicationDescription, ADR("Demonstrate the use of custom classes."),
  391.                                         m.maApplicationBase,        ADR("CLASS2M2"),
  392.                                         mm.SubWindow,               window,
  393.                                   ud.tagDone)) ;
  394.  
  395.   IF app = NIL THEN ms.fail(NULL, "Failed to create Application.") END ;
  396.  
  397.   mm.NoteClose(app, window, m.mvApplicationReturnIDQuit) ;
  398.  
  399.   ms.DoMethod(pen,TAG(tags, m.mmNotify, m.maPendisplaySpec, m.mvEveryTime,
  400.                          myObj, 3, m.mmSet, MyAttrPen, m.mvTriggerValue,
  401.                    ud.tagDone));
  402.  
  403.   mm.get(pen, m.maPendisplaySpec, ADR(startpen)) ;
  404.   mm.set(myObj, MyAttrPen, LONGCARD(startpen)) ;
  405.  
  406. (*
  407. ** Input loop...
  408. *)
  409.  
  410.   mm.set(window, m.maWindowOpen, LONGCARD(TRUE)) ;
  411.  
  412.   signals := LONGSET{} ;
  413.  
  414.   LOOP
  415.     IF ms.DOMethod(app, TAG(tags, m.mmApplicationNewInput, ADR(signals))) = m.mvApplicationReturnIDQuit THEN EXIT END ;
  416.  
  417.     IF signals # LONGSET{} THEN
  418.       INCL(signals, ctrlC) ;
  419.       signals := Wait(signals) ;
  420.       IF ctrlC IN signals THEN EXIT END ;
  421.     END (* IF *) ;
  422.   END (* WHILE *) ;
  423.  
  424.   mm.set(window, m.maWindowOpen, LONGCARD(FALSE)) ;
  425.  
  426. (*
  427. ** Shut down...
  428. *)
  429.  
  430. CLOSE
  431.   IF app # NIL THEN
  432.     ml.mDisposeObject(app) ;
  433.     app := NIL ;
  434.   END (* IF *) ;
  435.  
  436.   IF mcc # NIL THEN
  437.     IF ml.moDeleteCustomClass(mcc) THEN END ;
  438.     mcc := NIL ;
  439.   END (* IF *) ;
  440. END Class2.
  441.