home *** CD-ROM | disk | FTP | other *** search
/ Graphics Plus / Graphics Plus.iso / libs / phigs / ptk.lha / ptk / fortran / source / library / hash.f < prev    next >
Encoding:
Text File  |  1992-06-18  |  8.4 KB  |  274 lines
  1.  
  2.        SUBROUTINE ptkf_inithashtables()
  3. C /*
  4. C ** \blurb{This function initialises the table in which the details of
  5. C ** hashtables created by the application are kept. This function 
  6. C ** must be called before any other hashtable functions.}
  7. C */
  8.        external ptk_inithashtables !$PRAGMA C(ptk_inithashtables)
  9.  
  10.        call ptk_inithashtables()
  11.  
  12.        RETURN
  13.        END
  14.  
  15.        LOGICAL FUNCTION ptkf_hashtableused(str)
  16. C /*
  17. C ** \parambegin
  18. C ** \param{CHARACTER*(*)}{str}{name of hashtable}{IN}
  19. C ** \paramend
  20. C ** \blurb{This function checks if a hashtable named \pardesc{str}
  21. C ** already exists in the table of
  22. C ** hashtables, returning TRUE if the hashtable exists, otherwise FALSE.}
  23. C */
  24.        CHARACTER*(*) str
  25.        LOGICAL*1 ptk_hashtableused, ans
  26.        external ptk_hashtableused !$PRAGMA C(ptk_hashtableused)
  27.       
  28.        ans = ptk_hashtableused(str)
  29.        if (ans .eq. 1) then
  30.           ptkf_hashtableused = .TRUE.
  31.        else
  32.           ptkf_hashtableused = .FALSE.
  33.        endif
  34.  
  35.        RETURN
  36.        END
  37.  
  38.        SUBROUTINE ptkf_createhashtable(tablestr, minid, maxid)
  39. C /*
  40. C ** \parambegin
  41. C ** \param{CHARACTER*(*)}{tablestr}{hashtable name}{IN}
  42. C ** \param{INTEGER}{minid}{lower limit of string-integer range}{IN}
  43. C ** \param{INTEGER}{maxid}{upper limit of string-integer range}{IN}
  44. C ** \paramend
  45. C ** \blurb{This function creates a new hashtable, with the name 
  46. C ** \pardesc{tablestr}. 
  47. C ** \pardesc{minid} and \pardesc{maxid} respectively specify the lower and 
  48. C ** upper limits of the range of 
  49. C ** integers to which strings hashed into the hashtable will be mapped.}
  50. C */
  51.        CHARACTER*(*) tablestr
  52.        INTEGER minid, maxid
  53.        external ptk_createhashtable !$PRAGMA C(ptk_createhashtable)
  54.  
  55.        call ptk_createhashtable(tablestr, %val(minid), %val(maxid))
  56.  
  57.        RETURN
  58.        END
  59.  
  60.        SUBROUTINE ptkf_inttostring(tablestr, stint, size, strbuffer, 
  61. & buffersize)
  62. C /*
  63. C ** \parambegin
  64. C ** \param{CHARACTER*(*)}{tablestr}{hashtable name}{IN}
  65. C ** \param{INTEGER}{stint}{string identifier to search hashtable for}{IN}
  66. C ** \param{INTEGER}{size}{number of bytes allocated by the user for the 
  67. C ** string}{IN}
  68. C ** \param{CHARACTER*(*)}{strbuffer}{pointer to space allocated by the user 
  69. C ** for the string}{OUT}
  70. C ** \param{INTEGER}{buffersize}{actual size of buffer required}{OUT}
  71. C ** \paramend
  72. C ** \blurb{This function returns the string in hashtable \pardesc{tablestr}
  73. C ** which has been allocated the integer
  74. C ** \pardesc{stint}. The string is returned in the buffer 
  75. C ** \pardesc{strbuffer},
  76. C ** which must be allocated by the application. The number of bytes 
  77. C ** actually used
  78. C ** in the buffer is returned in \pardesc{buffersize}, as
  79. C ** the length of string + 1 (for `\\0' character),
  80. C ** or 0 if no string was returned.}
  81. C */
  82.        CHARACTER*(*) tablestr
  83.        INTEGER stint, size
  84.        CHARACTER*(*) strbuffer
  85.        INTEGER buffersize
  86.        CHARACTER*255 inbuf
  87.        external ptk_inttostring !$PRAGMA C(ptk_inttostring)
  88.  
  89.        call ptk_inttostring(tablestr, %val(stint), 255, inbuf, 
  90. & buffersize)
  91.        buffersize = buffersize - 1
  92.        if (size .le. 255) then
  93.          strbuffer = inbuf(1:buffersize)
  94.        endif
  95.  
  96.        RETURN
  97.        END
  98.  
  99.        INTEGER FUNCTION ptkf_stringtoint(tablestr, str)
  100. C /*
  101. C ** \parambegin
  102. C ** \param{CHARACTER*(*)}{tablestr}{name of hashtable}{IN}
  103. C ** \param{CHARACTER*(*)}{str}{string to be searched for in string table}{IN}
  104. C ** \paramend
  105. C ** \blurb{This function returns the integer allocated for the string 
  106. C ** \pardesc{str}
  107. C ** in hashtable \pardesc{tablestr}.
  108. C ** If the string has not already been allocated an integer,
  109. C ** then it is allocated one and this value is 
  110. C ** returned.}
  111. C */
  112.        CHARACTER*(*) tablestr, str
  113.        INTEGER ptk_stringtoint
  114.        CHARACTER*255 inbuf
  115.        external ptk_stringtoint !$PRAGMA C(ptk_stringtoint)
  116.  
  117.        inbuf = str//'\0'
  118.        ptkf_stringtoint = ptk_stringtoint(tablestr, inbuf)
  119.  
  120.        RETURN
  121.        END
  122.  
  123.        LOGICAL FUNCTION ptkf_delstring(tablestr, str)
  124. C /*
  125. C ** \parambegin
  126. C ** \param{CHARACTER*(*)}{tablestr}{name of hashtable}{IN}
  127. C ** \param{CHARACTER*(*)}{delstr}{string to be deleted from string table}{IN}
  128. C ** \paramend
  129. C ** \blurb{This function deletes the string \pardesc{delstr} from hashtable
  130. C ** \pardesc{tablestr}. The result of the function is
  131. C **  TRUE if the string was deleted, otherwise FALSE.}
  132. C */
  133.        CHARACTER*(*) tablestr, str
  134.        LOGICAL*1 ptk_delstring, ans
  135.        CHARACTER*255 inbuf
  136.        external ptk_delstring !$PRAGMA C(ptk_delstring)
  137.  
  138.        inbuf = str//'\0'
  139.        ans = ptk_delstring(tablestr, inbuf)
  140.        if (ans .eq. 1) then
  141.           ptkf_delstring = .TRUE.
  142.        else
  143.           ptkf_delstring = .FALSE.
  144.        endif
  145.  
  146.        RETURN
  147.        END
  148.  
  149.        LOGICAL FUNCTION ptkf_delhashtable(tablestr)
  150. C /*
  151. C ** \parambegin
  152. C ** \param{CHARACTER*(*)}{tablestr}{name of table to be deleted}{IN}
  153. C ** \paramend
  154. C ** \blurb{This function deletes hashtable \pardesc{tablestr} from the
  155. C **  table of hashtables,
  156. C **  returning TRUE if the table was deleted, otherwise FALSE.}
  157. C */
  158.        CHARACTER*(*) tablestr
  159.        LOGICAL*1 ptk_delhashtable, ans
  160.        external ptk_delhashtable !$PRAGMA C(ptk_delhashtable)
  161.  
  162.        ans = ptk_delhashtable(tablestr)
  163.        if (ans .eq. 1) then
  164.           ptkf_delhashtable = .TRUE.
  165.        else
  166.           ptkf_delhashtable = .FALSE.
  167.        endif
  168.  
  169.        RETURN
  170.        END
  171.  
  172.        LOGICAL FUNCTION ptkf_stringused(tablestr, str)
  173. C /*
  174. C ** \parambegin
  175. C ** \param{CHARACTER*(*)}{tablestr}{name of hashtable}{IN}
  176. C ** \param{CHARACTER*(*)}{str}{string to search for in string table}{IN}
  177. C ** \paramend
  178. C ** \blurb{This function checks if the string \pardesc{str}
  179. C **  has already been used in hashtable \pardesc{tablestr},
  180. C ** Returning TRUE if string was used in the hashtable, otherwise FALSE.}
  181. C */
  182.        CHARACTER*(*) tablestr, str
  183.        LOGICAL*1 ptk_stringused, ans
  184.        external ptk_stringused !$PRAGMA C(ptk_stringused)
  185.  
  186.        ans = ptk_stringused(tablestr, str)
  187.        if (ans .eq. 1) then
  188.           ptkf_stringused = .TRUE.
  189.        else
  190.           ptkf_stringused = .FALSE.
  191.        endif
  192.  
  193.        RETURN
  194.        END
  195.  
  196.        SUBROUTINE ptkf_storehashtable(fileptr, tablestr)
  197. C /*
  198. C ** \parambegin
  199. C ** \param{INTEGER}{fileptr}{pointer to a file}{IN}
  200. C ** \param{CHARACTER*(*)}{table}{hashtable to store}{IN}
  201. C ** \paramend
  202. C ** \blurb{The function writes the hashtable \pardesc{tablestr} to the
  203. C ** file \pardesc{fileptr}, which should be opened for writing.}
  204. C */
  205.        INTEGER fileptr
  206.        CHARACTER*(*) tablestr
  207.        external ptk_storehashtable !$PRAGMA C(ptk_storehashtable)
  208.  
  209.        call ptk_storehashtable(getfilep(fileptr), tablestr)
  210.  
  211.        RETURN
  212.        END
  213.  
  214.        SUBROUTINE ptkf_storeallhashtables(fileptr)
  215. C /*
  216. C ** \parambegin
  217. C ** \param{INTEGER}{fileptr}{pointer to a file}{IN}
  218. C ** \paramend
  219. C ** \blurb{The function writes all the hashtables in the table of hashtables
  220. C ** to the
  221. C ** file \pardesc{fileptr}, which should be opened for writing.}
  222. C */
  223.        INTEGER fileptr
  224.        external ptk_storeallhashtables 
  225. & !$PRAGMA C(ptk_storeallhashtables)
  226.  
  227.        call ptk_storeallhashtables(getfilep(fileptr))
  228.  
  229.        RETURN
  230.        END
  231.  
  232.        SUBROUTINE ptkf_restorehashtable(fileptr, tablestr)
  233. C /*
  234. C ** \parambegin
  235. C ** \param{INTEGER}{fileptr}{pointer to a file}{IN}
  236. C ** \param{CHARACTER*(*)}{tablestr}{hashtable to insert data from file}{IN}
  237. C ** \paramend
  238. C ** \blurb{This function reads a hashtable from the file \pardesc{fileptr},
  239. C ** and creates it with the name \pardesc{tablestr}. If the hashtable
  240. C ** already exists,
  241. C ** it is deleted, and then recreated from the file. The file should be open
  242. C ** for reading when this function is called.}
  243. C */
  244.        INTEGER fileptr
  245.        CHARACTER*(*) tablestr
  246.        external ptk_restorehashtable !$PRAGMA C(ptk_restorehashtable)
  247.  
  248.        call ptk_restorehashtable(getfilep(fileptr), tablestr)
  249.  
  250.        RETURN
  251.        END
  252.  
  253.        SUBROUTINE ptkf_restoreallhashtables(fileptr)
  254. C /*
  255. C ** \parambegin
  256. C ** \param{INTEGER}{fileptr}{pointer to a file}{IN}
  257. C ** \paramend
  258. C ** \blurb{This function restores all hashtables from a file. Effectively,
  259. C ** \pardesc{ptk\_restorehashtable} (q.v.) is called for each hashtable in
  260. C ** the file. The file should 
  261. C ** be open for reading when this function is called.}
  262. C */
  263.        INTEGER fileptr
  264.        external ptk_restoreallhashtables 
  265. & !$PRAGMA C(ptk_restoreallhashtables)
  266.  
  267.        call ptk_restoreallhashtables(getfilep(fileptr))
  268.  
  269.        RETURN
  270.        END
  271.  
  272. C end of hash.f
  273.  
  274.