home *** CD-ROM | disk | FTP | other *** search
/ Education Sampler 1992 [NeXTSTEP] / Education_1992_Sampler.iso / Programming / Source / HippoDraw / hippo / fhippo.c < prev    next >
Encoding:
C/C++ Source or Header  |  1992-04-28  |  4.4 KB  |  200 lines
  1. /*
  2.  * Support functions for FORTRAN interface to Hippo
  3.  * by Paul Kunz, SLAC, June 1991
  4.  
  5.  * Copyright (C)  1991  The Board of Trustees of
  6.  * The Leland Stanford Junior University.  All Rights Reserved.
  7.  *
  8.  * $Id: fhippo.c,v 1.5 1992/01/24 02:31:42 pavel Rel $
  9.  *
  10.  * This set of functions is the second level interface between the
  11.  * FORTRAN user and the Hippo package which is written in C.
  12.  * All the functions the user sees are in FORTRAN and defined in
  13.  * hippof.f.   At this level, one has C functions to support that
  14.  * FORTRAN.   System dependencies on how to make C callable from
  15.  * FORTRAN will be found here.   Each function has two versions,
  16.  * for example, with and with out a trailing '_' because some
  17.  * FORTRAN compilers adds the underscore and it can not be turned
  18.  * off.
  19.  *
  20.  * Report bugs to hippo_bug@ebnextk.slac.stanford.edu
  21.  *
  22.  */
  23.  
  24. #include <stdlib.h>
  25. #include <string.h>
  26. #include "hippo.h"
  27.  
  28. #ifdef VMS
  29. /* Special stuff to deal with descriptors in VMS Fortran: */
  30. #include descrip
  31. #endif /* VMS */
  32.  
  33. /*
  34.  * Interfaces to h_arrayFill() from hparrayFill()
  35.  */
  36. int hfarrayfill( int *ntaddr, float *data )
  37. {
  38.     return h_arrayFill( (ntuple) *ntaddr, data );
  39. }
  40. int hfarrayfill_( int *ntaddr, float *data)
  41. {
  42.     return hfarrayfill( ntaddr, data );
  43. }
  44.  
  45. /*
  46.  * Interfaces to h_clrNt() from hpclrNt()
  47.  */
  48. int hfclrnt( int *ntaddr )
  49. {
  50.     return h_clrNt( (ntuple) *ntaddr );
  51. }
  52. int hfclrnt_( int *ntaddr )
  53. {
  54.     return hfclrnt( ntaddr );
  55. }
  56.  
  57. /*
  58.  * Interfaces to h_freeNt() from hpfreeNt()
  59.  */
  60. int hffreent( int *ntaddr )
  61. {
  62.     return h_freeNt( (ntuple) *ntaddr );
  63. }
  64. int hffreent_( int *ntaddr )
  65. {
  66.     return hffreent( ntaddr );
  67. }
  68.  
  69. /*
  70.  * Interfaces to h_new() from hpnew()
  71.  */
  72. ntuple hfnew( int *ndim )
  73. {
  74.     return h_new( *ndim);
  75. }
  76. ntuple hfnew_( int *ndim )
  77. {
  78.     return hfnew( ndim );
  79. }
  80.  
  81. /* 
  82.  * Interfaces to h_setNtLabel() from hpsetNtLabel()
  83.  */
  84. #ifndef VMS
  85. int hfsetntlabel( int *ntaddr, int *dim, char *label, int *lenchar )
  86. #else 
  87. int hfsetntlabel( int *ntaddr, int *dim, struct dsc$descriptor *label_d,
  88.           int *lenchar )
  89. #endif /* VMS */
  90. {
  91.     char                *name;
  92.     int                 i, len, ret_val;
  93.  
  94.     len = *lenchar;
  95.     name = (char *)malloc( (len+1)*sizeof(char) );
  96. #ifndef VMS
  97.     strncpy(name, label, len);
  98. #else 
  99.     strncpy(name, label_d->dsc$a_pointer, len);
  100. #endif /* VMS */
  101.     
  102.  /* Trim the trailing blanks */
  103.     for ( i = (len-1); i >= 0; i-- ) {
  104.         if ( name[i] != ' ' ) {
  105.         name[i+1] = '\0';
  106.         break;
  107.     }
  108.     }
  109.     ret_val = h_setNtLabel( (ntuple) *ntaddr, *dim, name);
  110.  
  111.     free(name);
  112.     return ret_val;
  113. }
  114.  
  115. int hfsetntlabel_( int *ntaddr, int *dim, char *label, int *lenchar )
  116. {
  117.     return hfsetntlabel( ntaddr, dim, label, lenchar );
  118. }
  119.  
  120.  
  121. /* 
  122.  * Interfaces to h_setNtTitle() from hpsetNtTitle()
  123.  */
  124. #ifndef VMS
  125. int hfsetnttitle( int *ntaddr, char *title, int *lenchar )
  126. #else 
  127. int hfsetnttitle( int *ntaddr, struct dsc$descriptor *title_d, int *lenchar )
  128. #endif /* VMS */
  129. {
  130.     char               *name;
  131.     int                 i, len, ret_val;
  132.  
  133.     len = *lenchar;
  134.     name = (char *)malloc( (len+1)*sizeof(char) );
  135. #ifndef VMS
  136.     strncpy(name, title, len );
  137. #else 
  138.     strncpy(name, title_d->dsc$a_pointer, len);
  139. #endif /* VMS */
  140.     
  141.  /* Trim the trailing blanks */
  142.     for ( i = (len-1); i >= 0; i-- ) {
  143.         if ( name[i] != ' ' ) {
  144.         name[i+1] = '\0';
  145.         break;
  146.     }
  147.     }
  148.  
  149.     ret_val = h_setNtTitle( (ntuple) *ntaddr, name);
  150.  
  151.     free(name);
  152.     return ret_val;
  153. }
  154. int hfsetnttitle_( int *ntaddr, char *title, int *lenchar )
  155. {
  156.     return hfsetnttitle( ntaddr, title, lenchar );
  157. }
  158.  
  159.  
  160.  
  161. /*
  162.  * Interfaces to h_write() from hpwrite()
  163.  */
  164. #ifndef VMS
  165. int hfwrite( char *filename, int *daddr, int *ntaddr, int *lenchar )
  166. #else 
  167. int hfwrite( struct dsc$descriptor *filename_d, int *daddr, int *ntaddr,
  168.          int *lenchar )
  169. #endif /* VMS */
  170. {
  171.     char           *name;
  172.     int                 i, len, ret_val;
  173.  
  174.     len = *lenchar;
  175.     name = (char *) malloc( (len+1)*sizeof(char) );
  176. #ifndef VMS
  177.     strncpy( name, filename, len );
  178. #else 
  179.     strncpy( name, filename_d->dsc$a_pointer, len);
  180. #endif /* VMS */
  181.     
  182.  /* Trim the trailing blanks */
  183.     for ( i = (len-1); i >= 0; i-- ) {
  184.         if ( name[i] != ' ' ) {
  185.         name[i+1] = '\0';
  186.         break;
  187.     }
  188.     }
  189.  
  190.     ret_val =  h_write(name, (display *) daddr, (ntuple *) ntaddr );
  191.     
  192.     free(name);
  193.     return ret_val;
  194. }
  195. int hfwrite_( char *filename, int *daddr, int *ntaddr, int *lenchar )
  196. {
  197.     return hfwrite( filename, daddr, ntaddr, lenchar );
  198. }
  199.  
  200.