home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / mod201j.zip / modula2.exe / os2demo / animals / dog.mod < prev    next >
Text File  |  1995-05-26  |  21KB  |  847 lines
  1. IMPLEMENTATION MODULE DOG;
  2.  
  3. (*$XL+       Modula-2 extenmsions: '_' in symbol names, OOP facilities  *)
  4. (*$CDECL+    C-style procedures                                         *)
  5. (*$A         default alignment for record fields                        *)
  6.  
  7. (*$LINK
  8.   LIBRARY DOG INITINSTANCE
  9.   DESCRIPTION 'Dog class DLL, compiled with Modula-2.  (c) Juergen Neuhoff'
  10.   PROTMODE
  11.   DATA MULTIPLE NONSHARED LOADONCALL
  12. *)
  13.  
  14.  
  15. IMPORT SOM;      (* basic SOM module *)
  16. IMPORT ANIMAL;   (* module with parent class *)
  17. FROM   SOMMISC IMPORT somDebug, somWriteString, somWriteLn;
  18.  
  19.  
  20. (*************************************************************************
  21.    Passthru lines "before" if any
  22. **************************************************************************)
  23.  
  24. IMPORT OS2DEF;
  25. IMPORT Conversions;
  26. IMPORT Strings;
  27. FROM   SYSTEM IMPORT currentFile;
  28. FROM   SYSTEM IMPORT currentLine;
  29. FROM   SYSTEM IMPORT ADR;
  30.  
  31. TYPE PAnimal = ANIMAL.PAnimal;
  32.  
  33.  
  34.  
  35. (*************************************************************************
  36.    Passthru lines "after"  if any
  37. **************************************************************************)
  38.  
  39.  
  40.  
  41.  
  42. (*************************************************************************
  43.    Implementation header for SOM class Dog
  44. **************************************************************************)
  45.  
  46. CONST
  47.   Dog_MaxNoMethods = 4;                (* number of new methods *)
  48.   DogDebug         = FALSE;            (* enable/disable method debugging *)
  49.  
  50.  
  51.  
  52. (*
  53.  * Declare the C specific class data structure
  54.  *)
  55. TYPE
  56.   DogCClassDataStructure  = RECORD
  57.     parentMtab              : SOM.somMethodTabs;
  58.     instanceDataToken       : SOM.somDToken;
  59.                             END;
  60. VAR
  61.   DogCClassData           : DogCClassDataStructure;
  62.  
  63.  
  64.  
  65. (*
  66.  * Temporary class data structure used only in class creation
  67.  *)
  68. VAR
  69.   DogtempClassData        : SOM.somClassDataStructure;
  70.  
  71.  
  72.  
  73. (*
  74.  * Internal instance data
  75.  *)
  76. TYPE
  77.   DogData          = RECORD
  78.     breed            : OS2DEF.PSZ;
  79.     color            : OS2DEF.PSZ;
  80.                      END;
  81.   PDogData         = POINTER TO DogData;
  82.  
  83.  
  84.  
  85. (*
  86.  *   <class>GetData function
  87.  *)
  88. PROCEDURE DogGetData( Self : PDog ) : PDogData;
  89. BEGIN
  90.   RETURN SOM.somDataResolve( Self, DogCClassData.instanceDataToken );
  91. END DogGetData;
  92.  
  93.  
  94.  
  95.  
  96. (*
  97.  *  SOM identifiers for all the new and overridden methods
  98.  *)
  99. VAR
  100.   somId_setBreed           : SOM.somId;
  101.   somId_setColor           : SOM.somId;
  102.   somId_getBreed           : SOM.somId;
  103.   somId_getColor           : SOM.somId;
  104.   somId_getGenus           : SOM.somId;
  105.   somId_getSpecies         : SOM.somId;
  106.   somId_display            : SOM.somId;
  107.   somId_somInit            : SOM.somId;
  108.   somId_somUninit          : SOM.somId;
  109.   somId_somDumpSelfInt     : SOM.somId;
  110.  
  111.  
  112.  
  113. (*
  114.  *  Apply stubs for new methods
  115.  *)
  116. PROCEDURE somAP_setBreed
  117. (
  118.   Self     : PDog;
  119.   id       : SOM.somId;
  120.   desc     : SOM.somId;
  121.   VAR args : ARRAY OF SOM.DWORD
  122. );
  123. VAR
  124.   myBreed  : OS2DEF.PSZ;
  125. BEGIN
  126.   myBreed := args[0];
  127.   Self^.setBreed( myBreed );
  128. END somAP_setBreed;
  129.  
  130. PROCEDURE somAP_setColor
  131. (
  132.   Self     : PDog;
  133.   id       : SOM.somId;
  134.   desc     : SOM.somId;
  135.   VAR args : ARRAY OF SOM.DWORD
  136. );
  137. VAR
  138.   myColor  : OS2DEF.PSZ;
  139. BEGIN
  140.   myColor := args[0];
  141.   Self^.setColor( myColor );
  142. END somAP_setColor;
  143.  
  144. PROCEDURE somAP_getBreed
  145. (
  146.   Self     : PDog;
  147.   id       : SOM.somId;
  148.   desc     : SOM.somId;
  149.   VAR args : ARRAY OF SOM.DWORD
  150. )          : OS2DEF.PSZ;
  151. BEGIN
  152.   RETURN Self^.getBreed();
  153. END somAP_getBreed;
  154.  
  155. PROCEDURE somAP_getColor
  156. (
  157.   Self     : PDog;
  158.   id       : SOM.somId;
  159.   desc     : SOM.somId;
  160.   VAR args : ARRAY OF SOM.DWORD
  161. )          : OS2DEF.PSZ;
  162. BEGIN
  163.   RETURN Self^.getColor();
  164. END somAP_getColor;
  165.  
  166.  
  167.  
  168.  
  169. (*
  170.  *  Redispatch stubs for new methods
  171.  *)
  172. PROCEDURE somRD_setBreed
  173. (
  174.   somSelf      : PDog;
  175.   myBreed      : OS2DEF.PSZ
  176. );
  177. VAR
  178.   retBuffer    : SOM.somToken;
  179.   retValue     : SOM.somToken;
  180.   args         : SOM.ADDRESS;
  181.   dispatched   : BOOLEAN;
  182. BEGIN
  183.   retValue := ADR( retBuffer );
  184.   args := ADR( somSelf ) + SIZE( somSelf );
  185.   dispatched := somSelf^.somDispatch( retValue, somId_setBreed, args^ );
  186.   RETURN;
  187. END somRD_setBreed;
  188.  
  189. PROCEDURE somRD_setColor
  190. (
  191.   somSelf      : PDog;
  192.   myColor      : OS2DEF.PSZ
  193. );
  194. VAR
  195.   retBuffer    : SOM.somToken;
  196.   retValue     : SOM.somToken;
  197.   args         : SOM.ADDRESS;
  198.   dispatched   : BOOLEAN;
  199. BEGIN
  200.   retValue := ADR( retBuffer );
  201.   args := ADR( somSelf ) + SIZE( somSelf );
  202.   dispatched := somSelf^.somDispatch( retValue, somId_setColor, args^ );
  203.   RETURN;
  204. END somRD_setColor;
  205.  
  206. PROCEDURE somRD_getBreed
  207. (
  208.   somSelf      : PDog
  209. )              : OS2DEF.PSZ;
  210. VAR
  211.   retBuffer    : OS2DEF.PSZ;
  212.   retValue     : SOM.somToken;
  213.   args         : SOM.ADDRESS;
  214.   dispatched   : BOOLEAN;
  215. BEGIN
  216.   retValue := ADR( retBuffer );
  217.   args := ADR( somSelf ) + SIZE( somSelf );
  218.   dispatched := somSelf^.somDispatch( retValue, somId_getBreed, args^ );
  219.   RETURN retBuffer;
  220. END somRD_getBreed;
  221.  
  222. PROCEDURE somRD_getColor
  223. (
  224.   somSelf      : PDog
  225. )              : OS2DEF.PSZ;
  226. VAR
  227.   retBuffer    : OS2DEF.PSZ;
  228.   retValue     : SOM.somToken;
  229.   args         : SOM.ADDRESS;
  230.   dispatched   : BOOLEAN;
  231. BEGIN
  232.   retValue := ADR( retBuffer );
  233.   args := ADR( somSelf ) + SIZE( somSelf );
  234.   dispatched := somSelf^.somDispatch( retValue, somId_getColor, args^ );
  235.   RETURN retBuffer;
  236. END somRD_getColor;
  237.  
  238.  
  239.  
  240.  
  241. (*
  242.  *  forward declared private methods (not declared in this DEF-module)
  243.  *)
  244. PROCEDURE( Self : PDog ) somInit();
  245. FORWARD;
  246.  
  247. PROCEDURE( Self : PDog ) somUninit();
  248. FORWARD;
  249.  
  250. PROCEDURE( Self : PDog ) somDumpSelfInt
  251. (
  252.   level         : SOM.INT
  253. );
  254. FORWARD;
  255.  
  256. PROCEDURE( Self : PDog ) getGenus() : OS2DEF.PSZ;
  257. FORWARD;
  258.  
  259. PROCEDURE( Self : PDog ) getSpecies() : OS2DEF.PSZ;
  260. FORWARD;
  261.  
  262. PROCEDURE( Self : PDog ) display();
  263. FORWARD;
  264.  
  265.  
  266.  
  267.  
  268. (*
  269.  * class initialization
  270.  *)
  271. PROCEDURE DogsomInitializeClass;
  272. VAR
  273.   m : Dog;         (* needed for static method references *)
  274.   c : SOM.PSOMClass;
  275.   md : SOM.somId;
  276. BEGIN
  277.  
  278.   c := DogtempClassData.classObject;
  279.   md := SOM.somIdFromString( "----" );
  280.  
  281.   (* Add new methods, if any, to SOM class Dog *)
  282.   DogClassData.setBreed := c^.somAddStaticMethod
  283.   ( somId_setBreed, md, m.setBreed, somRD_setBreed, somAP_setBreed );
  284.   DogClassData.setColor := c^.somAddStaticMethod
  285.   ( somId_setColor, md, m.setColor, somRD_setColor, somAP_setColor );
  286.   DogClassData.getBreed := c^.somAddStaticMethod
  287.   ( somId_getBreed, md, m.getBreed, somRD_getBreed, somAP_getBreed );
  288.   DogClassData.getColor := c^.somAddStaticMethod
  289.   ( somId_getColor, md, m.getColor, somRD_getColor, somAP_getColor );
  290.  
  291.   (* Override inherited methods, if any *)
  292.   c^.somOverrideSMethod( somId_somInit, m.somInit );
  293.   c^.somOverrideSMethod( somId_somUninit, m.somUninit );
  294.   c^.somOverrideSMethod( somId_somDumpSelfInt, m.somDumpSelfInt );
  295.   c^.somOverrideSMethod( somId_getGenus, m.getGenus );
  296.   c^.somOverrideSMethod( somId_getSpecies, m.getSpecies );
  297.   c^.somOverrideSMethod( somId_display, m.display );
  298. END DogsomInitializeClass;
  299.  
  300.  
  301.  
  302.  
  303. (*
  304.  *  class creation procedure
  305.  *)
  306. PROCEDURE DogsomCreateClass
  307. (
  308.   pClsObj    : SOM.PSOMClass;
  309.   mClsObj    : SOM.PSOMClass
  310. );
  311. VAR
  312.   classObject : SOM.PSOMClass;
  313. BEGIN
  314.   classObject := mClsObj^.somNew();
  315.   DogtempClassData.classObject := classObject;
  316.   classObject^.somInitClass
  317.   (
  318.     "Dog",
  319.     pClsObj,
  320.     SIZE( DogData ),
  321.     Dog_MaxNoMethods,
  322.     Dog_MajorVersion,
  323.     Dog_MinorVersion
  324.   );
  325.   DogCClassData.instanceDataToken := classObject^.somGetInstanceToken();
  326.   DogsomInitializeClass();
  327.   DogCClassData.parentMtab := classObject^.somGetPClsMtab();
  328.   classObject^.somSetClassData( SYSTEM.ADR( DogClassData ) );
  329.   classObject^.somClassReady();
  330.   (* make newly created class object visible *)
  331.   DogClassData.classObject := classObject;
  332. END DogsomCreateClass;
  333.  
  334.  
  335.  
  336.  
  337. (*
  338.  *   public NewClass-procedure
  339.  *)
  340. PROCEDURE DogNewClass
  341. (
  342.   majorVersion  : SOM.INTEGER4;
  343.   minorVersion  : SOM.INTEGER4
  344. )               : SOM.PSOMClass;
  345. VAR
  346.   pClsObj       : SOM.PSOMClass;
  347.   mClsObj       : SOM.PSOMClass;
  348.   line          : LONGCARD;
  349.   b             : BOOLEAN;
  350. BEGIN
  351.   (* Check the version numbers *)
  352.   IF ((majorVersion <> 0) AND (majorVersion <> Dog_MajorVersion)) OR
  353.      ((minorVersion <> 0) AND (minorVersion > Dog_MinorVersion)) THEN
  354.     somWriteString( "DogNewClass: Error, bad version numbers." );
  355.     somWriteLn();
  356.     b := Conversions.StrToLongCard( currentLine(), line );
  357.     SOM.SOMError( SOM.SOMERROR_BadVersion, currentFile(), line );
  358.   END;
  359.  
  360.   (* Don't do anything if class object is already created. *)
  361.   IF DogClassData.classObject <> NIL THEN
  362.     RETURN DogClassData.classObject;
  363.   END;
  364.  
  365.   (* Make sure the environment is initialized. *)
  366.   IF SOM.SOMClassMgrObject = NIL THEN
  367.     SOM.SOMClassMgrObject := SOM.somEnvironmentNew();
  368.     IF SOM.SOMClassMgrObject = NIL THEN
  369.       b := Conversions.StrToLongCard( currentLine(), line );
  370.       SOM.SOMError( SOM.SOMERROR_CouldNotStartup, currentFile(), line );
  371.     END;
  372.     somWriteString( "DogNewClass: SOMClassMgrObject initalized..." );
  373.     somWriteLn();
  374.   END;
  375.  
  376.   (* Get the parent class object. *)
  377.   pClsObj := ANIMAL.AnimalNewClass( 0, 0 );       (* static reference *)
  378.   pClsObj := SOM.SOMClassMgrObject^.somFindClass
  379.   ( SOM.somIdFromString( "Animal" ), 0, 0 );
  380.   IF pClsObj = NIL THEN
  381.     b := Conversions.StrToLongCard( currentLine(), line );
  382.     SOM.SOMError( SOM.SOMERROR_NoParentClass, currentFile(), line );
  383.   END;
  384.  
  385.   (* Explicit metaclass, so get it *)
  386.   mClsObj := M_DogNewClass( 0, 0 );       (* static reference *)
  387.   mClsObj := SOM.SOMClassMgrObject^.somFindClass
  388.   ( SOM.somIdFromString( "M_Dog" ), 0, 0 );
  389.   IF mClsObj = NIL THEN
  390.     b := Conversions.StrToLongCard( currentLine(), line );
  391.     SOM.SOMError( SOM.SOMERROR_NoMetaClass, currentFile(), line );
  392.   END;
  393.  
  394.   SOM.somConstructClass
  395.   ( DogsomCreateClass, pClsObj, mClsObj, SYSTEM.ADR( DogtempClassData ) );
  396.  
  397.   RETURN DogClassData.classObject;
  398. END DogNewClass;
  399.  
  400.  
  401.  
  402. (*************************************************************************
  403.    method implementations for SOM class Dog
  404. **************************************************************************)
  405.  
  406.  
  407. PROCEDURE( Self : PDog ) getBreed() : OS2DEF.PSZ;
  408. VAR
  409.   somThis   : PDogData;
  410. BEGIN
  411.   somThis := DogGetData( Self );
  412.   IF DogDebug THEN
  413.     somDebug( "Dog", "getBreed", currentFile(), currentLine() );
  414.   END;
  415.   RETURN somThis^.breed;
  416. END getBreed;
  417.  
  418.  
  419. PROCEDURE( Self : PDog ) getColor() : OS2DEF.PSZ;
  420. VAR
  421.   somThis   : PDogData;
  422. BEGIN
  423.   somThis := DogGetData( Self );
  424.   IF DogDebug THEN
  425.     somDebug( "Dog", "getColor", currentFile(), currentLine() );
  426.   END;
  427.   RETURN somThis^.color;
  428. END getColor;
  429.  
  430.  
  431. PROCEDURE( Self : PDog ) setBreed( myBreed : OS2DEF.PSZ );
  432. VAR
  433.   somThis   : PDogData;
  434. BEGIN
  435.   somThis := DogGetData( Self );
  436.   IF DogDebug THEN
  437.     somDebug( "Dog", "setBreed", currentFile(), currentLine() );
  438.   END;
  439.   IF somThis^.breed <> NIL THEN
  440.     SOM.SOMFree( somThis^.breed );
  441.   END;
  442.   somThis^.breed := SOM.SOMMalloc( Strings.Length( myBreed^ )+1 );
  443.   Strings.Assign( myBreed^, somThis^.breed^ );
  444. END setBreed;
  445.  
  446.  
  447. PROCEDURE( Self : PDog ) setColor( myColor : OS2DEF.PSZ );
  448. VAR
  449.   somThis   : PDogData;
  450. BEGIN
  451.   somThis := DogGetData( Self );
  452.   IF DogDebug THEN
  453.     somDebug( "Dog", "setColor", currentFile(), currentLine() );
  454.   END;
  455.   IF somThis^.color <> NIL THEN
  456.     SOM.SOMFree( somThis^.color );
  457.   END;
  458.   somThis^.color := SOM.SOMMalloc( Strings.Length( myColor^ )+1 );
  459.   Strings.Assign( myColor^, somThis^.color^ );
  460. END setColor;
  461.  
  462.  
  463. PROCEDURE( Self : PDog ) somInit();
  464. VAR
  465.   somThis   : PDogData;
  466. BEGIN
  467.   somThis := DogGetData( Self );
  468.   IF DogDebug THEN
  469.     somDebug( "Dog", "somInit", currentFile(), currentLine() );
  470.   END;
  471.   Self^.somInit^();
  472.   somThis^.color := NIL;
  473.   somThis^.breed := NIL;
  474. END somInit;
  475.  
  476.  
  477. PROCEDURE( Self : PDog ) somUninit();
  478. VAR
  479.   somThis   : PDogData;
  480. BEGIN
  481.   somThis := DogGetData( Self );
  482.   IF DogDebug THEN
  483.     somDebug( "Dog", "somUninit", currentFile(), currentLine() );
  484.   END;
  485.   IF somThis^.color <> NIL THEN
  486.     SOM.SOMFree( somThis^.color );
  487.   END;
  488.   IF somThis^.breed <> NIL THEN
  489.     SOM.SOMFree( somThis^.breed );
  490.   END;
  491.   Self^.somUninit^();
  492. END somUninit;
  493.  
  494.  
  495. PROCEDURE( Self : PDog ) somDumpSelfInt
  496. (
  497.   level         : SOM.INT
  498. );
  499. VAR
  500.   somThis   : PDogData;
  501. BEGIN
  502.   somThis := DogGetData( Self );
  503.   IF DogDebug THEN
  504.     somDebug( "Dog", "somDumpSelfInt", currentFile(), currentLine() );
  505.   END;
  506.   Self^.somDumpSelfInt^( level );
  507. END somDumpSelfInt;
  508.  
  509.  
  510. PROCEDURE( Self : PDog ) getGenus() : OS2DEF.PSZ;
  511. CONST
  512.   Genus     : ARRAY OF CHAR = "Canis";
  513. VAR
  514.   somThis   : PDogData;
  515. BEGIN
  516.   somThis := DogGetData( Self );
  517.   IF DogDebug THEN
  518.     somDebug( "Dog", "getGenus", currentFile(), currentLine() );
  519.   END;
  520.   RETURN SYSTEM.ADR( Genus );
  521. END getGenus;
  522.  
  523.  
  524. PROCEDURE( Self : PDog ) getSpecies() : OS2DEF.PSZ;
  525. CONST
  526.   Species   : ARRAY OF CHAR = "Familiaris";
  527. VAR
  528.   somThis   : PDogData;
  529. BEGIN
  530.   somThis := DogGetData( Self );
  531.   IF DogDebug THEN
  532.     somDebug( "Dog", "getSpecies", currentFile(), currentLine() );
  533.   END;
  534.   RETURN SYSTEM.ADR( Species );
  535. END getSpecies;
  536.  
  537.  
  538. PROCEDURE( Self : PDog ) display();
  539. VAR
  540.   somThis   : PDogData;
  541.   Breed     : OS2DEF.PSZ;
  542.   Color     : OS2DEF.PSZ;
  543. BEGIN
  544.   somThis := DogGetData( Self );
  545.   IF DogDebug THEN
  546.     somDebug( "Dog", "display", currentFile(), currentLine() );
  547.   END;
  548.   somWriteString( "  Breed: " );
  549.   Breed := Self^.getBreed();
  550.   somWriteString( Breed^ );
  551.   somWriteLn();
  552.   Color := Self^.getColor();
  553.   somWriteString( "  Color : " );
  554.   somWriteString( Color^ );
  555.   somWriteLn();
  556.   Self^.display^();
  557. END display;
  558.  
  559.  
  560.  
  561.  
  562. (*************************************************************************
  563.    Implementation header for SOM class M_Dog
  564. **************************************************************************)
  565.  
  566. CONST
  567.   M_Dog_MaxNoMethods = 1;        (* number of new class factory methods *)
  568.   M_DogDebug = FALSE;            (* enable/disable method debugging *)
  569.  
  570.  
  571.  
  572. (*
  573.  * Declare the C specific class data structure
  574.  *)
  575. TYPE
  576.   M_DogCClassDataStructure  = RECORD
  577.     parentMtab                : SOM.somMethodTabs;
  578.     instanceDataToken         : SOM.somDToken;
  579.                               END;
  580. VAR
  581.   M_DogCClassData           : M_DogCClassDataStructure;
  582.  
  583.  
  584.  
  585.  
  586. (*
  587.  * Temporary class data structure used only in class creation
  588.  *)
  589. VAR
  590.   M_DogtempClassData        : SOM.somClassDataStructure;
  591.  
  592.  
  593.  
  594. (*
  595.  * Internal instance data
  596.  *)
  597. TYPE
  598.   M_DogData          = RECORD END;
  599.   PM_DogData         = POINTER TO M_DogData;
  600.  
  601.  
  602.  
  603. (*
  604.  *   <class>GetData function
  605.  *)
  606. PROCEDURE M_DogGetData( Self : PM_Dog ) : PM_DogData;
  607. BEGIN
  608.   RETURN NIL; (* no instance data *)
  609. END M_DogGetData;
  610.  
  611.  
  612.  
  613.  
  614. (*
  615.  *  SOM identifiers for all the new and overridden methods
  616.  *)
  617. VAR
  618.   somId_newDog         : SOM.somId;
  619.  
  620.  
  621.  
  622.  
  623. (*
  624.  *  Apply stubs for new methods
  625.  *)
  626. PROCEDURE somAP_newDog
  627. (
  628.   Self  : PM_Dog;
  629.   id       : SOM.somId;
  630.   desc     : SOM.somId;
  631.   VAR args : ARRAY OF SOM.DWORD
  632. )          : SYSTEM.ADDRESS;
  633. VAR
  634.   sound    : OS2DEF.PSZ;
  635.   breed    : OS2DEF.PSZ;
  636.   color    : OS2DEF.PSZ;
  637. BEGIN
  638.   sound := args[0];
  639.   breed := args[1];
  640.   color := args[2];
  641.   RETURN Self^.newDog( sound, breed, color );
  642. END somAP_newDog;
  643.  
  644.  
  645.  
  646.  
  647. (*
  648.  *  Redispatch stubs for new methods
  649.  *)
  650. PROCEDURE somRD_newDog
  651. (
  652.   somSelf      : PDog;
  653.   sound        : OS2DEF.PSZ;
  654.   breed        : OS2DEF.PSZ;
  655.   color        : OS2DEF.PSZ
  656. )              : SYSTEM.ADDRESS;
  657. VAR
  658.   retBuffer    : SYSTEM.ADDRESS;
  659.   retValue     : SOM.somToken;
  660.   args         : SOM.ADDRESS;
  661.   dispatched   : BOOLEAN;
  662. BEGIN
  663.   retValue := ADR( retBuffer );
  664.   args := ADR( somSelf ) + SIZE( somSelf );
  665.   dispatched := somSelf^.somDispatch( retValue, somId_newDog, args^ );
  666.   RETURN retBuffer;
  667. END somRD_newDog;
  668.  
  669.  
  670.  
  671.  
  672. (*
  673.  *  forward declared private methods
  674.  *)
  675.  
  676.  
  677.  
  678.  
  679. (*
  680.  * class initialization
  681.  *)
  682. PROCEDURE M_DogsomInitializeClass;
  683. VAR
  684.   m : M_Dog;         (* needed for static method references *)
  685.   c : SOM.PSOMClass;
  686.   md : SOM.somId;
  687. BEGIN
  688.  
  689.   c := M_DogtempClassData.classObject;
  690.   md := SOM.somIdFromString( "----" );
  691.  
  692.   (* Add new methods, if any, to SOM class M_Dog *)
  693.   M_DogClassData.newDog := c^.somAddStaticMethod
  694.   ( somId_newDog, md, m.newDog, somRD_newDog, somAP_newDog );
  695.  
  696.   (* overwrite inherited methods, if any *)
  697.  
  698. END M_DogsomInitializeClass;
  699.  
  700.  
  701.  
  702.  
  703. (*
  704.  *  class creation procedure
  705.  *)
  706. PROCEDURE M_DogsomCreateClass
  707. (
  708.   pClsObj    : SOM.PSOMClass;
  709.   mClsObj    : SOM.PSOMClass
  710. );
  711. VAR
  712.   classObject : SOM.PSOMClass;
  713. BEGIN
  714.   classObject := mClsObj^.somNew();
  715.   M_DogtempClassData.classObject := classObject;
  716.   classObject^.somInitClass
  717.   (
  718.     "M_Dog",
  719.     pClsObj,
  720.     SIZE( M_DogData ),
  721.     M_Dog_MaxNoMethods,
  722.     M_Dog_MajorVersion,
  723.     M_Dog_MinorVersion
  724.   );
  725.   M_DogCClassData.instanceDataToken := classObject^.somGetInstanceToken();
  726.   M_DogsomInitializeClass();
  727.   M_DogCClassData.parentMtab := classObject^.somGetPClsMtab();
  728.   classObject^.somSetClassData( SYSTEM.ADR( M_DogClassData ) );
  729.   classObject^.somClassReady();
  730.   (* make newly created class object visible *)
  731.   M_DogClassData.classObject := classObject;
  732. END M_DogsomCreateClass;
  733.  
  734.  
  735.  
  736.  
  737. PROCEDURE M_DogNewClass
  738. (
  739.   majorVersion  : SOM.INTEGER4;
  740.   minorVersion  : SOM.INTEGER4
  741. )               : SOM.PSOMClass;
  742. VAR
  743.   pClsObj       : SOM.PSOMClass;
  744.   mClsObj       : SOM.PSOMClass;
  745.   line          : LONGCARD;
  746.   b             : BOOLEAN;
  747. BEGIN
  748.   (* Check the version numbers *)
  749.   IF ((majorVersion <> 0) AND (majorVersion <> M_Dog_MajorVersion)) OR
  750.      ((minorVersion <> 0) AND (minorVersion > M_Dog_MinorVersion)) THEN
  751.     somWriteString( "M_DogNewClass: Error, bad version numbers." );
  752.     somWriteLn();
  753.     b := Conversions.StrToLongCard( currentLine(), line );
  754.     SOM.SOMError( SOM.SOMERROR_BadVersion, currentFile(), line );
  755.   END;
  756.  
  757.   (* Don't do anything if class object is already created. *)
  758.   IF M_DogClassData.classObject <> NIL THEN
  759.     RETURN M_DogClassData.classObject;
  760.   END;
  761.  
  762.   (* Make sure the environment is initialized. *)
  763.   IF SOM.SOMClassMgrObject = NIL THEN
  764.     SOM.SOMClassMgrObject := SOM.somEnvironmentNew();
  765.     IF SOM.SOMClassMgrObject = NIL THEN
  766.       b := Conversions.StrToLongCard( currentLine(), line );
  767.       SOM.SOMError( SOM.SOMERROR_CouldNotStartup, currentFile(), line );
  768.     END;
  769.   END;
  770.  
  771.   (* Get the parent class object. *)
  772.   pClsObj := ANIMAL.M_AnimalNewClass( 0, 0 ); (* static reference *)
  773.   pClsObj := SOM.SOMClassMgrObject^.somFindClass
  774.   ( SOM.somIdFromString( "M_Animal" ), 0, 0 );
  775.   IF pClsObj = NIL THEN
  776.     b := Conversions.StrToLongCard( currentLine(), line );
  777.     SOM.SOMError( SOM.SOMERROR_NoParentClass, currentFile(), line );
  778.   END;
  779.  
  780.   (* Use parent's metaclass *)
  781.   mClsObj := pClsObj^.mtab^.classObject;
  782.  
  783.   SOM.somConstructClass
  784.   ( M_DogsomCreateClass, pClsObj, mClsObj, SYSTEM.ADR( M_DogtempClassData ) );
  785.   RETURN M_DogClassData.classObject;
  786. END M_DogNewClass;
  787.  
  788.  
  789.  
  790.  
  791. (*************************************************************************
  792.    method implementations for SOM class M_Dog
  793. **************************************************************************)
  794.  
  795. PROCEDURE( Self : PM_Dog ) newDog
  796. (
  797.   sound         : OS2DEF.PSZ;
  798.   breed         : OS2DEF.PSZ;
  799.   color         : OS2DEF.PSZ
  800. )               : SYSTEM.ADDRESS;
  801. VAR
  802.   somThis       : PM_DogData;
  803.   newInstance   : PAnimal;
  804. BEGIN
  805.   (*
  806.    *  Create an instance of an Dog with a specific sound.
  807.    *)
  808.   somThis := M_DogGetData( Self );
  809.   IF M_DogDebug THEN
  810.     somDebug( "M_Dog", "newDog", currentFile(), currentLine() );
  811.   END;
  812.   newInstance := Self^.newAnimal( sound );
  813.   WITH newInstance : PDog DO
  814.     newInstance^.setBreed( breed );
  815.     newInstance^.setColor( color );
  816.     RETURN newInstance;
  817.   END;
  818. END newDog;
  819.  
  820.  
  821.  
  822.  
  823. BEGIN
  824.   IF SOM.SOMClassMgrObject = NIL THEN
  825.     SOM.SOMClassMgrObject := SOM.somEnvironmentNew();
  826.   END;
  827.  
  828.   DogCClassData.parentMtab := NIL;
  829.   DogClassData.classObject := NIL;
  830.  
  831.   somId_setBreed        := SOM.somIdFromString( "setBreed"       );
  832.   somId_setColor        := SOM.somIdFromString( "setColor"       );
  833.   somId_getBreed        := SOM.somIdFromString( "getBreed"       );
  834.   somId_getColor        := SOM.somIdFromString( "getColor"       );
  835.   somId_getGenus        := SOM.somIdFromString( "getGenus"       );
  836.   somId_getSpecies      := SOM.somIdFromString( "getSpecies"     );
  837.   somId_display         := SOM.somIdFromString( "display"        );
  838.   somId_somInit         := SOM.somIdFromString( "somInit"        );
  839.   somId_somUninit       := SOM.somIdFromString( "somUninit"      );
  840.   somId_somDumpSelfInt  := SOM.somIdFromString( "somDumpSelfInt" );
  841.  
  842.   M_DogCClassData.parentMtab := NIL;
  843.   M_DogClassData.classObject := NIL;
  844.  
  845.   somId_newDog          := SOM.somIdFromString( "newDog"         );
  846. END DOG.
  847.