home *** CD-ROM | disk | FTP | other *** search
/ Amiga ISO Collection / AmigaUtilCD2.iso / Programming / E / TFF-A32R.LZX / AmigaE3.2a / RkrmSrc / Intuition / Boopsi / rkmmodel.e < prev    next >
Encoding:
Text File  |  1996-08-29  |  6.5 KB  |  144 lines
  1. -> RKMModel.e - A simple custom modelclass subclass.
  2.  
  3. OPT MODULE
  4. OPT PREPROCESS
  5.  
  6. OPT OSVERSION=37
  7.  
  8. MODULE 'utility',
  9.        'amigalib/boopsi',
  10.        'tools/installhook',
  11.        'intuition/classes',
  12.        'intuition/classusr',
  13.        'utility/hooks',
  14.        'utility/tagitem'
  15.  
  16. -> The attributes defined by this class
  17. EXPORT ENUM RKMMOD_DUMMY=TAG_USER,
  18.             RKMMOD_CURRVAL, -> This attribute is the current value of the model.
  19.             RKMMOD_UP,   -> These two are fake attributes that rkmmodelclass
  20.             RKMMOD_DOWN, -> uses as pulse values to increment/decrement the
  21.                          -> rkmmodel's RKMMOD_CURRVAL attribute.
  22.             RKMMOD_LIMIT -> This attribute contains the upper bound of the
  23.                          -> rkmmodel's RKMMOD_CURRVAL.  The rkmmodel has a
  24.                          -> static lower bound of zero.
  25.  
  26. -> If the programmer doesn't set RKMMOD_LIMIT, it defaults to this.
  27. CONST DEFAULTVALLIMIT=100
  28.  
  29. OBJECT rkmModData
  30.   currval, vallimit  -> The instance data for this class
  31. ENDOBJECT
  32.  
  33. -> Initialise the class
  34. EXPORT PROC initRKMModClass() -> Make the class and set up the dispatcher's hook
  35.   DEF cl:PTR TO iclass
  36.   IF cl:=MakeClass(NIL, 'modelclass', NIL, SIZEOF rkmModData, 0)
  37.     -> E-Note: use installhook to set up the hook
  38.     installhook(cl.dispatcher, {dispatchRKMModel})  -> Initialise the Hook
  39.   ENDIF
  40. ENDPROC cl
  41.  
  42. -> Free the class
  43. EXPORT PROC freeRKMModClass(cl) IS FreeClass(cl)
  44.  
  45. -> The class Dispatcher
  46. PROC dispatchRKMModel(cl:PTR TO iclass, o, msg:PTR TO msg)
  47.   DEF mmd:PTR TO rkmModData, id, ti:PTR TO tagitem, tstate, tag,
  48.       retval=NIL -> A generic return value used by this class's methods.  The
  49.                  -> meaning of this field depends on the method.  For example,
  50.                  -> OM_GET uses this as a boolean return value, while OM_NEW
  51.                  -> uses it as a pointer to the new object.
  52.   -> E-Note: installhook makes sure A4 is set-up properly
  53.   id:=msg.methodid
  54.   IF id=OM_SET THEN id:=OM_UPDATE -> E-Note: handled the same in this class
  55.   SELECT id
  56.   CASE OM_NEW -> Pass message onto superclass first so it can set aside memory
  57.               -> for the object and take care of superclass instance data.
  58.     IF retval:=doSuperMethodA(cl, o, msg)
  59.       -> For the OM_NEW method, the object pointer passed to the dispatcher
  60.       -> does not point to an object (how could it?  The object doesn't exist
  61.       -> yet.).  doSuperMethodA() returns a pointer to a newly created object.
  62.       -> INST_DATA() is a macro defined in 'intuition/classes' that returns a
  63.       -> pointer to the object's instance data that is local to this class. For
  64.       -> example, the instance data local to this class is the rkmModData
  65.       -> structure defined above.
  66.       mmd:=INST_DATA(cl, retval)
  67.       -> Initialise object's attributes
  68.       -> E-Note: "opnew" is really "opset"
  69.       mmd.currval:=GetTagData(RKMMOD_CURRVAL, 0, msg::opnew.attrlist)
  70.       mmd.vallimit:=GetTagData(RKMMOD_LIMIT,DEFAULTVALLIMIT,msg::opnew.attrlist)
  71.     ENDIF
  72.   CASE OM_UPDATE -> E-Note: includes OM_SET (see "IF id=.." above)
  73.     mmd:=INST_DATA(cl, o)
  74.     doSuperMethodA(cl,o,msg) -> Let the superclasses set their attributes first
  75.     tstate:=msg::opset.attrlist
  76.     -> Step through all of the attribute/value pairs in the list.  Use the
  77.     -> utility.library tag functions to do this so they can properly process
  78.     -> special tag IDs like TAG_SKIP, TAG_IGNORE, etc.
  79.     WHILE ti:=NextTagItem({tstate})
  80.       tag:=ti.tag
  81.       SELECT tag
  82.       CASE RKMMOD_CURRVAL
  83.         IF ti.data>mmd.vallimit THEN ti.data:=mmd.vallimit
  84.         mmd.currval:=ti.data
  85.         notifyCurrVal(cl, o, msg, mmd)
  86.         retval:=1 -> Changing RKMMOD_CURRVAL can cause a visual change to the
  87.                   -> gadgets in the rkmmodel's broadcast list.  The rkmmodel has
  88.                   -> to tell the application by returning a value besides zero.
  89.       CASE RKMMOD_UP
  90.         mmd.currval:=mmd.currval+1
  91.         -> Make sure the current value is not greater than value limit.
  92.         IF mmd.currval>mmd.vallimit THEN mmd.currval:=mmd.vallimit
  93.         notifyCurrVal(cl, o, msg, mmd)
  94.         retval:=1 -> Changing RKMMOD_UP can cause a visual change to the gadgets
  95.                   -> in the rkmmodel's broadcast list.  The rkmmodel has to tell
  96.                   -> the application by returning a value besides zero.
  97.       CASE RKMMOD_DOWN
  98.         mmd.currval:=mmd.currval-1
  99.         -> Make sure the currval didn't go negative
  100.         IF mmd.currval<0 THEN mmd.currval:=0
  101.         notifyCurrVal(cl, o, msg, mmd)
  102.         retval:=1 -> Changing RKMMOD_DOWN can cause a visual change to gadgets
  103.                   -> in the rkmmodel's broadcast list.  The rkmmodel has to tell
  104.                   -> the application by returning a value besides zero.
  105.       CASE RKMMOD_LIMIT
  106.         mmd.vallimit:=ti.data -> Set the limit.  Note that this does not do
  107.                               -> bounds checking on the current
  108.                               -> rkmModData.currval value.
  109.       ENDSELECT
  110.     ENDWHILE
  111.   CASE OM_GET             -> The only attribute that is "gettable" in this class
  112.     mmd:=INST_DATA(cl, o) -> or its superclasses is RKMMOD_CURRVAL.
  113.     IF msg::opget.attrid=RKMMOD_CURRVAL
  114.       msg::opget.storage[]:=mmd.currval
  115.       retval:=TRUE
  116.     ELSE
  117.       retval:=doSuperMethodA(cl, o, msg)
  118.     ENDIF
  119.   DEFAULT -> rkmmodelclass does not recognise the methodID, so let the
  120.           -> superclass's dispatcher take a look at it.
  121.     retval:=doSuperMethodA(cl, o, msg)
  122.   ENDSELECT
  123. ENDPROC retval
  124.  
  125. PROC notifyCurrVal(cl, o, msg:PTR TO opupdate, mmd:PTR TO rkmModData)
  126.   DEF notifymsg:PTR TO opnotify  -> E-Note: "opnotify" is really "opupdate"
  127.   -> If this is an OM_UPDATE method, make sure the part the OM_UPDATE message
  128.   -> adds to the OM_SET message gets added.  That lets the dispatcher handle
  129.   -> OM_UPDATE and OM_SET in the same case.
  130.   notifymsg:=[OM_NOTIFY, [RKMMOD_CURRVAL, mmd.currval, NIL], msg.ginfo,
  131.               IF msg.methodid=OM_UPDATE THEN msg.flags ELSE 0]:opnotify
  132.  
  133.   -> E-Note: A bug (?) in Intuition means that the methodid of an OM_NOTIFY
  134.   ->         message may be altered, so you can't get away with just using a
  135.   ->         constant value in the above static list...
  136.   notifymsg.methodid:=OM_NOTIFY
  137.  
  138.   -> If the RKMMOD_CurrVal changes, we want everyone to know about it.
  139.   -> Theoretically, the class is supposed to send itself a OM_NOTIFY message.
  140.   -> Because this class lets its superclass handle the OM_NOTIFY message, it
  141.   -> skips the middleman and sends the OM_NOTIFY directly to its superclass.
  142.   doSuperMethodA(cl, o, notifymsg)
  143. ENDPROC
  144.