home *** CD-ROM | disk | FTP | other *** search
/ High Voltage Shareware / high1.zip / high1 / DIR19 / OBJPROB.ZIP / DICTIONA.PRG < prev    next >
Text File  |  1993-09-24  |  3KB  |  144 lines
  1. /*
  2. ╔═══════════════════════════════════════════════════════════════╗
  3. ║ Módulo: Dictiona.prg                                          ║
  4. ║ Lenguaje: Clipper 5.xx + ObjectsP                             ║
  5. ║ Fecha: Agosto  1993                                           ║
  6. ║ Compilar: Clipper Dictiona /a /n /w                           ║
  7. ║ Desc.:Demo/Test de la clase Dictionary                        ║
  8. ║                                                               ║
  9. ║ (c) 1993 Francisco Pulpón y Antonio Linares                   ║
  10. ╚═══════════════════════════════════════════════════════════════╝
  11.  
  12.   Una adaptación OOPS de dict.prg, uno de los ejemplos incluidos
  13.   en Clipper 5
  14.  
  15. */
  16.  
  17. #include "ObjectsP.ch"
  18.  
  19. #define  DEFAULT_HASH_SIZE   31
  20. #define  MAX_PAILS         4096
  21.  
  22. #define  KEY_HASH(key)       ( Bin2W(key) + Bin2W( SubStr(Trim(key), -2) ) )
  23. #define  HASH_VAL(key, size) ( ( KEY_HASH(key) % size ) + 1 )
  24.  
  25. /*************
  26. */
  27.   CLASS Dictionary
  28.  
  29.       HIDE INSTVAR  Pails AS Array
  30.  
  31.       METHOD        New      ,;
  32.                     getVal   ,;
  33.                     putAssoc ,;
  34.                     remove   ,;
  35.                     eval = DictEval
  36.  
  37.       METHOD putVal(  cKey, uVal )  INLINE ;
  38.              ::putAssoc( Association():New( cKey, uVal ) )
  39.  
  40.       HIDE METHOD   resize   ,;
  41.                     getPail
  42.  
  43.   ENDCLASS
  44.  
  45.  
  46. /*****
  47. */
  48. METHOD New( nHashSize )   CLASS Dictionary
  49.  
  50.     DEFAULT nHashSize = DEFAULT_HASH_SIZE
  51.  
  52.     ::Pails = Array( nHashSize, 0 )
  53.  
  54. Return Self
  55.  
  56. /*****
  57. */
  58. METHOD getPail( cKey, nAssoc )   CLASS Dictionary
  59.  
  60.   local Pail := ::Pails[ HASH_VAL( cKey, LEN( ::Pails ) ) ]
  61.  
  62.      nAssoc = ascan( Pail, { |oAssoc| oAssoc:cKey == cKey } )
  63.  
  64. Return Pail
  65.  
  66. /*****
  67. */
  68. METHOD getVal( cKey )  CLASS Dictionary
  69.  
  70.   local nAssoc
  71.   local Pail := ::getPail( cKey, @nAssoc )
  72.  
  73. Return if( nAssoc == 0, NIL, Pail[ nAssoc ]:uValue )
  74.  
  75. /*****
  76. */
  77. METHOD putAssoc( oAssoc )  CLASS Dictionary
  78.  
  79.   local nAssoc
  80.   local Pail := ::getPail( oAssoc:cKey, @nAssoc )
  81.  
  82.     if nAssoc == 0
  83.  
  84.        aadd( Pail, oAssoc )
  85.        nAssoc = len( Pail )
  86.  
  87.     else
  88.  
  89.        Pail[ nAssoc ] = oAssoc
  90.  
  91.     endif
  92.  
  93.     if nAssoc > 3 .AND. len( ::Pails ) < MAX_PAILS
  94.  
  95.         ::resize()  // this Pail is big, grow dict
  96.  
  97.     endif
  98.  
  99. Return nil
  100.  
  101.  
  102. /*****
  103. */
  104. METHOD Resize   CLASS Dictionary
  105.  
  106.   local oNew := Dictionary():New( min( len( ::Pails ) * 4 - 1, MAX_PAILS ) )
  107.  
  108.   aeval( ::Pails,;
  109.                 { |Pail| aeval( Pail, ;
  110.                                   { |oAssoc| oNew:putAssoc( oAssoc ) } ) } )
  111.  
  112.   ::Pails = oNew:Pails
  113.  
  114. Return nil
  115.  
  116. /*****
  117. */
  118. METHOD remove( cKey )       CLASS Dictionary
  119.  
  120.   local nAssoc
  121.   local Pail   := ::getPail( cKey, @nAssoc )
  122.  
  123.     if nAssoc != 0
  124.         adel( Pail, nAssoc )
  125.         asize( Pail, len( Pail ) - 1 )
  126.     endif
  127.  
  128. Return nil
  129.  
  130. /*****
  131. */
  132. METHOD DictEval( block )     CLASS Dictionary
  133.  
  134.   local nPail
  135.  
  136.     for nPail = 1 to  len( ::Pails )
  137.         
  138.         // El CodeBlock recibe:  Pail[ nAssoc ], nAssoc
  139.         aeval( ::Pails[ nPail ], block ) 
  140.  
  141.     next
  142.  
  143. Return nil
  144.