home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / mod201j.zip / modula2.exe / os2demo / wpfoot / foot.mod < prev    next >
Text File  |  1995-04-14  |  9KB  |  307 lines

  1. IMPLEMENTATION MODULE FOOT;
  2.  
  3. (************************************************************************
  4.   OS/2 2.x/3.0 implementation of Workplace Shell sample class 'Foot'.
  5.  
  6.   Copyright (c) 1995 by Juergen Neuhoff
  7.  
  8.   Entry Points:
  9.  
  10.      Class Methods:
  11.  
  12.         <none>
  13.  
  14.      Overridden Class Methods:
  15.  
  16.         <none>
  17.  
  18.      Instance Methods:
  19.  
  20.         <none>
  21.  
  22.      Overridden Instance Methods:
  23.  
  24.         Foot.wpOpen
  25.  
  26.      Non-Method Functions:
  27.  
  28.  
  29.   How to compile:
  30.  
  31.      To create a class DLL run the following commands:
  32.  
  33.        MOD FOOT -o -m      <-- This Modula-2 compiler
  34.        LINK386 @FOOT.RSP   <-- 32-bit OS/2 linker
  35.  
  36. *************************************************************************)
  37.  
  38. (*$XL+       Modula-2 extensions: '_' in symbol names, OOP facilities   *)
  39. (*$XF+       Relaxed function designators                               *)
  40. (*$CDECL+    C-style procedures                                         *)
  41. (*$A         default alignment for record fields                        *)
  42.  
  43. (*$LINK
  44.   LIBRARY Foot INITINSTANCE
  45.   PROTMODE
  46.   DATA MULTIPLE NONSHARED LOADONCALL
  47. *)
  48.  
  49.  
  50.  
  51. (*************************************************************************
  52.    Common IMPORTs for a SOM-class implementation.
  53. **************************************************************************)
  54.  
  55. IMPORT SOM;             (* basic SOM module, always needed *)
  56. IMPORT WPABS;           (* module with parent class, always needed *)
  57. IMPORT Conversions;     (* data conversion support *)
  58. FROM   SOMMISC IMPORT somDebug;        (* debugging aid *)
  59. FROM   SOMMISC IMPORT somWriteString;  (* debugging aid *)
  60. FROM   SOMMISC IMPORT somWriteLn;      (* debugging aid *)
  61. FROM   SYSTEM  IMPORT currentFile;     (* debugging aid *)
  62. FROM   SYSTEM  IMPORT currentLine;     (* debugging aid *)
  63. FROM   SYSTEM  IMPORT ADR;
  64.  
  65.  
  66. (*************************************************************************
  67.    This is Modula's equivalent for the language-neutral SOM-emitter's
  68.    'passthru lines before/after'.
  69.  
  70.    It consists of further individual IMPORTs, to be followed by private
  71.    types, constants, variables and/or procedures for the implementation,
  72. **************************************************************************)
  73.  
  74. IMPORT OS2DEF;
  75.  
  76.  
  77. (*************************************************************************
  78.    Implementation header for the new SOM class 'Foot'
  79.    (constants, types and variables)
  80. **************************************************************************)
  81.  
  82. CONST
  83.   Foot_MaxNoMethods = 0;         (* number of new methods *)
  84.   FootDebug         = TRUE;      (* enable/disable method debugging *)
  85.  
  86. (*
  87.  * Temporary class data structure used only in class creation
  88.  *)
  89. VAR
  90.   FoottempClassData : SOM.somClassDataStructure;
  91.  
  92. (*
  93.  * Internal instance data fields
  94.  *)
  95. TYPE
  96.   FootData         = RECORD
  97.                      END;
  98.   PFootData        = POINTER TO FootData;
  99.  
  100.  
  101. (*
  102.  *   FootGetData function, gives access to the instance data, if any
  103.  *)
  104. PROCEDURE FootGetData( Self : PFoot ) : PFootData;
  105. BEGIN
  106.   RETURN SOM.somDataResolve( Self, FootCClassData.instanceDataToken );
  107. END FootGetData;
  108.  
  109. (*
  110.  *  SOM specific identifiers for all
  111.  *  the new and also the overridden methods
  112.  *)
  113. VAR
  114.   somId_wpOpen                   : SOM.somId;
  115.  
  116.  
  117.  
  118. (*************************************************************************
  119.   apply- and redispatch- stubs for new methods introduced by class 'Foot'
  120. *************************************************************************)
  121.  
  122.  
  123. (* none for this sample class ... *)
  124.  
  125.  
  126. (*************************************************************************
  127.   Forward declared procedures for all newly introduced private methods
  128.   and for privately overridden methods.
  129. *************************************************************************)
  130.  
  131. PROCEDURE( Self : PFoot ) wpOpen
  132. (
  133.   hwndCnr       : OS2DEF.HWND;
  134.   ulView        : LONGCARD;
  135.   param         : LONGCARD
  136. )               : OS2DEF.HWND;
  137. FORWARD;
  138.  
  139.  
  140. (*************************************************************************
  141.     SOM-class creation procedures.
  142.     Only the FootNewClass() procedure is publicly
  143.     available for client programs.
  144. **************************************************************************)
  145.  
  146. (*
  147.  * class initialization
  148.  *)
  149. PROCEDURE FootsomInitializeClass;
  150. VAR
  151.   m  : Foot;     (* needed for static method references *)
  152.   c  : SOM.PSOMClass;
  153.   md : SOM.somId;
  154. BEGIN
  155.  
  156.   c := FoottempClassData.classObject;
  157.   md := SOM.somIdFromString( "----" );
  158.  
  159.   (* Add the new methods, including apply and redispatch stubs,
  160.      to the new SOM class
  161.   *)
  162.   (* none for this sample class ... *)
  163.  
  164.   (* Override inherited methods, if any *)
  165.   c^.somOverrideSMethod( somId_wpOpen, m.wpOpen );
  166.  
  167. END FootsomInitializeClass;
  168.  
  169. (*
  170.  *  class creation procedure
  171.  *)
  172. PROCEDURE FootsomCreateClass
  173. (
  174.   pClsObj    : SOM.PSOMClass;
  175.   mClsObj    : SOM.PSOMClass
  176. );
  177. VAR
  178.   classObject : SOM.PSOMClass;
  179. BEGIN
  180.   classObject := mClsObj^.somNew();
  181.   FoottempClassData.classObject := classObject;
  182.   classObject^.somInitClass
  183.   (
  184.     "Foot",
  185.     pClsObj,
  186.     SIZE( FootData ),
  187.     Foot_MaxNoMethods,
  188.     Foot_MajorVersion,
  189.     Foot_MinorVersion
  190.   );
  191.   FootCClassData.instanceDataToken := classObject^.somGetInstanceToken();
  192.   FootsomInitializeClass();
  193.   FootCClassData.parentMtab := classObject^.somGetPClsMtab();
  194.   classObject^.somSetClassData( SYSTEM.ADR( FootClassData ) );
  195.   classObject^.somClassReady();
  196.   (* make newly created class object visible *)
  197.   FootClassData.classObject := classObject;
  198. END FootsomCreateClass;
  199.  
  200. (*
  201.  *   public NewClass-procedure
  202.  *)
  203. PROCEDURE FootNewClass
  204. (
  205.   majorVersion  : SOM.INTEGER4;
  206.   minorVersion  : SOM.INTEGER4
  207. )               : SOM.PSOMClass;
  208. VAR
  209.   pClsObj       : SOM.PSOMClass;
  210.   mClsObj       : SOM.PSOMClass;
  211.   line          : LONGCARD;
  212.   b             : BOOLEAN;
  213. BEGIN
  214.   (* Check the version numbers *)
  215.   IF ((majorVersion <> 0) AND (majorVersion <> Foot_MajorVersion)) OR
  216.      ((minorVersion <> 0) AND (minorVersion > Foot_MinorVersion)) THEN
  217.     somWriteString( "FootNewClass: Error, bad version numbers." );
  218.     somWriteLn();
  219.     b := Conversions.StrToLongCard( currentLine(), line );
  220.     SOM.SOMError( SOM.SOMERROR_BadVersion, currentFile(), line );
  221.   END;
  222.  
  223.   (* Don't do anything if class object is already created. *)
  224.   IF FootClassData.classObject <> NIL THEN
  225.     RETURN FootClassData.classObject;
  226.   END;
  227.  
  228.   (* Make sure the environment is initialized. *)
  229.   IF SOM.SOMClassMgrObject = NIL THEN
  230.     SOM.SOMClassMgrObject := SOM.somEnvironmentNew();
  231.     IF SOM.SOMClassMgrObject = NIL THEN
  232.       b := Conversions.StrToLongCard( currentLine(), line );
  233.       SOM.SOMError( SOM.SOMERROR_CouldNotStartup, currentFile(), line );
  234.     END;
  235.     (* SOMClassMgrObject initialized... *)
  236.   END;
  237.  
  238.   (* Get the parent class object. *)
  239.   pClsObj := WPABS.WPAbstractNewClass( 0, 0 ); (* static *)
  240.   pClsObj := SOM.SOMClassMgrObject^.somFindClass
  241.   ( SOM.somIdFromString( "WPAbstract" ), 0, 0 );
  242.   IF pClsObj = NIL THEN
  243.     b := Conversions.StrToLongCard( currentLine(), line );
  244.     SOM.SOMError( SOM.SOMERROR_NoParentClass, currentFile(), line );
  245.   END;
  246.  
  247.   (* Get the metaclass object. *)
  248.   (* using parent's metaclass: *)
  249.   mClsObj := pClsObj^.mtab^.classObject;
  250.   IF mClsObj = NIL THEN
  251.     b := Conversions.StrToLongCard( currentLine(), line );
  252.     SOM.SOMError( SOM.SOMERROR_NoMetaClass, currentFile(), line );
  253.   END;
  254.  
  255.   SOM.somConstructClass
  256.   ( FootsomCreateClass, pClsObj, mClsObj, SYSTEM.ADR( FoottempClassData ) );
  257.  
  258.   RETURN FootClassData.classObject;
  259. END FootNewClass;
  260.  
  261.  
  262.  
  263.  
  264. (*************************************************************************
  265.   Instance methods (possibly overridden) for class "Foot".
  266. *************************************************************************)
  267.  
  268.  
  269.  
  270. (*
  271.  *
  272.  *   METHOD: wpOpen                                         ( ) PRIVATE
  273.  *                                                          (X) PUBLIC
  274.  *   DESCRIPTION:
  275.  *
  276.  *     Opens the car window.
  277.  *
  278.  *)
  279.  
  280. PROCEDURE( Self : PFoot ) wpOpen
  281. (
  282.   hwndCnr       : OS2DEF.HWND;
  283.   ulView        : LONGCARD;
  284.   param         : LONGCARD
  285. )               : OS2DEF.HWND;
  286. VAR
  287. (*somThis       : PFootData;*)
  288. BEGIN
  289. (*somThis := FootGetData( Self );*)
  290.   IF FootDebug THEN
  291.     somDebug( "Foot", "wpOpen", currentFile(), currentLine() );
  292.   END;
  293.   RETURN Self^.wpOpen^( hwndCnr, ulView, param ); (* parent call *)
  294. END wpOpen;
  295.  
  296.  
  297.  
  298.  
  299. BEGIN (* of class module *)
  300.   (* initialize some record fields for class-supporting structures *)
  301.   FootCClassData.parentMtab := NIL;
  302.   FootClassData.classObject := NIL;
  303.  
  304.   (* find the identifier tokens for all the new or overridden methods *)
  305.   somId_wpOpen                 := SOM.somIdFromString( "wpOpen"                 );
  306. END FOOT.
  307.