/* aqua_src.c * * The purpose of this library is to provide easy access from * a Fortran 77 program to the AquaTerm library on MacOSX. * * Aquaterm provides a native Mac OSX terminal. This can be * used as an alternative to using X11 under Mac OSX. The * advantage of Aquaterm is that is does not require the user * to have X11 installed (X11 installation is optional under * Mac OSX). The Aquaterm terminal also has the "look" of the * Mac OSX window system (the X11 windows do not). * * A few commets: * * 1) It is assumed that the Mac user has installed the * underlying Aquaterm software (in particular, the * Aquaterm library is a shared library that is expected * to be in /usr/local/lib. * * 2) Although Aquaterm provides a Fortran-based "adapter", * I am unable to take advantage of this. The Fortran * adapter requires that the Fortran code be compiled to * preserve case in names. This causes problems with * Dataplot since I do not want to do this for some other * routines that I am calling. * * 3) Aquaterm is a dynamic library. With Dataplot, I try * to link libraries statically whenever possible. * * This seems to cause a conflict with the zlib compression * library. Dataplot uses the GD library for PNG and JPEG * graphics. GD in turn uses the jpeg, png, and zlib * libraries. For the Mac OSX, I have built static versions * of these libraries. However, Aquaterm seems to need * a dynamic version of zlib. * * For these reasons, I have choosen to use the C-based version * of Aquaterm. I have provided this subroutine as an intermediate * wrapper between the Dataplot Fortran and the Aquaterm C-based * library. * * Given my problem, I have not supported the full Aquaterm library. * Instead, I have supported a basic set of calls to support a * device driver for Aquaterm. This set of routines provides * a wrapper layer between Fortran and the C based GD libraries. * That is, these routines use only integer and real arguments with * no C specific structures. This makes the calling sequence from * Fortran easy. * * Although I wrote this wrapper with a specific application in * mind, I believe it may well be useful for other Fortran * codes. This code may be used and modified by anyone without * restriction. * * A dummy version of this routine is maintained for non-Mac OSX * systems. Since the dummy library is coded in Fortran, routine * names will be limited to six characters. * * Note that calling C from Fortran is not standard. I have * provided the following compiler defintions to enhance portability. * * 1) The default is to assume that the Fortran compiler appends an * underscore to the routine name. Use -DNOUNDERSCORE if your * compiler does not append the underscore. * 2) The default is to assume that the Fortran compiler converts * routine names to lower case. Use -DUPPERCASE if your * Fortran compiler does not do this (e.g., the Cray). * 3) Many Unix compilers support a "-r8", or something similar, * to make single precision 64-bit. Use -DDOUBLE if you * compile your Fortran with this option. * 4) Character strings are the most troublesome issue for * portability. Passing character strings from Fortran to C * is very compiler dependent. I have addressed this issue * by passing character strings as arrays of ASCII Decimal * Equivalents (ADE's). That is, the Fortran converts a * character string to an array of the integer values where * the integer is the ASCII collating sequence (i.e., A = 65, * B = 66, etc.). The end of the string is denoted by setting * the value to 0. This is easily accomplished on the Fortran * side by using the ICHAR function. The C code here then * calls an internal routine to covnert the integer array to * a C string. Although a bit convoluted, this avoids a lot * of messy portability issues. * * * The following routines are included: * * aqinit - initialize Aquaterm * aqend - close Aquaterm * aqrend - render the current plot * aqeras - start a new graph (close currently open one as well) * aqdraw - draw a polyline * aqseco - set foreground color * aqsepa - set line pattern * aqpoin - draw a point (i.e., a pixel) * aqcirc - draw a circle * aqrgfl - solid fill of a region * aqtxth - draw a horizontal character string * aqtxtv - draw a vertical character string * i_to_s_4 - utility routine to convert array of ADE's to string * array * */ /* Site dependent definitions (see comments above) */ /* Default is an underscore and lower case. The compiler specified * definitions -DNOUNDERSCORE and -DUPPERCASE can be specified to * override these defaults. */ #ifdef NOUNDERSCORE #define APPEND_UNDERSCORE 0 #else #define APPEND_UNDERSCORE 1 #endif #ifdef UPPERCASE #define SUBROUTINE_CASE 0 #else #define SUBROUTINE_CASE 1 #endif #ifdef DOUBLE #define PRECISION 1 #else #define PRECISION 0 #endif /* include files */ #include #include #include #include #include /* flags for current attribute settings */ static int OPEN_FLAG = 0; /* 0 - closed, 1 - open */ #if APPEND_UNDERSCORE == 1 && SUBROUTINE_CASE == 1 void aqend_(), aqdraw_(), aqpoin_(), aqcirc_(), aqrgfl_(); void aqinit_(), aqeras_(), aqtxth_(), aqtxtv_(); void aqseco_(), aqsepa_(), aqrend()_; #elif APPEND_UNDERSCORE == 1 && SUBROUTINE_CASE == 0 void AQEND_(), AQINIT_(), AQDRAW_(), AQPOIN_(), AQCIRC_(), AQRGFL_(); void AQINIT_(), AQERAS_(), AQTXTH_(), AQTXTV_(); void AQSECO_(), AQSEPA_(), AQREND_; #elif APPEND_UNDERSCORE == 0 && SUBROUTINE_CASE == 1 void aqend(), aqdraw(), aqpoin(), aqcirc(), aqrgfl(); void aqinit(), aqeras(), aqtxth(), aqtxtv(),gdtatt(); void aqseco(), aqsepa(), aqrend(); #elif APPEND_UNDERSCORE == 0 && SUBROUTINE_CASE == 0 void AQEND(), AQDRAW(), AQPOIN(), AQCIRC(), AQRGFL(); void AQINIT(), AQERAS(), AQTXTH(), AQTXTV(); void AQSECO(), AQSEPA(); #endif void i_to_s_4(); /* AQINIT - routine to initialize Aquaterm. * */ #if APPEND_UNDERSCORE == 1 && SUBROUTINE_CASE == 1 void aqinit_(ired,igreen,iblue,maxclr) #elif APPEND_UNDERSCORE == 1 && SUBROUTINE_CASE == 0 void AQINIT_(ired,igreen,iblue,maxclr) #elif APPEND_UNDERSCORE == 0 && SUBROUTINE_CASE == 1 void aqinit(ired,igreen,iblue,maxclr) #elif APPEND_UNDERSCORE == 0 && SUBROUTINE_CASE == 0 void AQINIT(ired,igreen,iblue,maxclr) #endif int ired[]; int igreen[]; int iblue[]; #if PRECISION == 0 int *maxclr; #else int maxclr[2]; #endif int maxclr_temp; int ival1, ival2, ival3; float val1, val2, val3; { #if PRECISION == 0 maxclr_temp = *maxclr; #else maxclr_temp = *maxclr[0]; #endif if (OPEN_FLAG == 0) { /* Device currently closed */ OPEN_FLAG = 1; aqtInit(); for (i = 0; i < maxclr_temp; i++) { #if PRECISION == 0 ival1 = ired[i]; ival2 = igreen[i]; ival3 = iblue[i]; #else ival1 = ired[2*i]; ival2 = igreen[2*i]; ival3 = iblue[2*i]; #endif val1 = float(ival1)/255.0; val2 = float(ival2)/255.0; val3 = float(ival3)/255.0; aqtSetColormapEntry(i,val1,val2,val3); } } } /* AQERAS - routine to clear the screen. * * 1) Check if a plot is currently open. If yes, write * it to a file and destroy the current image. * 2) Create a new image with the specified size specified * in pixels. Note that orientation (landscape, portrait, * is implicit in the pixel dimensions). Note that * this routine does not modify the values. * 3) Set all colors to be undefined and then set * background and foreground colors. * * xpixels - width (in pixels) for graphics window * ypixels - height (in pixels) for graphics window * back_col - background color * file name - file name (in integer ascii decimal equivalents) * */ #if APPEND_UNDERSCORE == 1 && SUBROUTINE_CASE == 1 void aqeras_(nplot, anumhp, anumvp) #elif APPEND_UNDERSCORE == 1 && SUBROUTINE_CASE == 0 void AQERAS_(nplot, anumhp, anumvp) #elif APPEND_UNDERSCORE == 0 && SUBROUTINE_CASE == 1 void aqeras(nplot, anumhp, anumvp) #elif APPEND_UNDERSCORE == 0 && SUBROUTINE_CASE == 0 void AQERAS(nplot, anumhp, anumvp) #endif #if PRECISION == 0 int *nplot, *anumhp, *anumvp; #else int nplot[2], anumhp[2], anumvp[2]; #endif { int nplot_temp, anumhp_temp, anumvp_temp; #if PRECISION == 0 nplot_temp = *nplot; anumhp_temp = *anumhp; anumvp_temp = *anumvp; #else nplot_temp = nplot[0]; anumhp_temp = anumhp[0]; anumvp_temp = anumvp[0]; #endif if (OPEN_FLAG > 0) { if (OPEN_FLAG == 2) aqtClosePlot(); aqtOpenPlot(nplot_temp); aqtSetPlotSize(anumhp_temp,anumvp_temp); aqtSetPlotTitle("Dataplot Graphics Window"); } } /* AQEND - routine to end Aquaterm display and close the display * */ #if APPEND_UNDERSCORE == 1 && SUBROUTINE_CASE == 1 void aqend_() #elif APPEND_UNDERSCORE == 1 && SUBROUTINE_CASE == 0 void AQEND_() #elif APPEND_UNDERSCORE == 0 && SUBROUTINE_CASE == 1 void aqend() #elif APPEND_UNDERSCORE == 0 && SUBROUTINE_CASE == 0 void AQEND() #endif { if (OPEN_FLAG > 0) { if (OPEN_FLAG == 2) aqtClosePlot(); aqtTerminate(); OPEN_FLAG = 0; } } /* AQREND - routine to render current plot * */ #if APPEND_UNDERSCORE == 1 && SUBROUTINE_CASE == 1 void aqrend_() #elif APPEND_UNDERSCORE == 1 && SUBROUTINE_CASE == 0 void AQREND_() #elif APPEND_UNDERSCORE == 0 && SUBROUTINE_CASE == 1 void aqrend() #elif APPEND_UNDERSCORE == 0 && SUBROUTINE_CASE == 0 void AQREND() #endif { if (OPEN_FLAG > 0) { aqtRenderPlot(); } } /* AQDRAW - draw a polyline. The line attributes are set in * other routines. * * xpts - contains the x coordinates * ypts - contains the y coordinates * npts - the number of points to plot * */ #if APPEND_UNDERSCORE == 1 && SUBROUTINE_CASE == 1 void aqdraw_(xpts, ypts, npts) #elif APPEND_UNDERSCORE == 1 && SUBROUTINE_CASE == 0 void AQDRAW_(xpts, ypts, npts) #elif APPEND_UNDERSCORE == 0 && SUBROUTINE_CASE == 1 void aqdraw(xpts, ypts, npts) #elif APPEND_UNDERSCORE == 0 && SUBROUTINE_CASE == 0 void AQDRAW(xpts, ypts, npts) #endif #if PRECISION == 0 int *npts; #else int npts[2]; #endif { int npts_temp; #if PRECISION == 0 npts_temp = *npts; #else npts_temp = *npts[2]; #endif if (OPEN_FLAG > 0) { if (npts_temp > 0) { aqtAddPolyline(xpts, ypts, npts_temp); } } } /* AQSECO - set the color * * jcol - index for desired color * */ #if APPEND_UNDERSCORE == 1 && SUBROUTINE_CASE == 1 void aqseco_(jcol) #elif APPEND_UNDERSCORE == 1 && SUBROUTINE_CASE == 0 void AQSECO_(jcol) #elif APPEND_UNDERSCORE == 0 && SUBROUTINE_CASE == 1 void aqseco(jcol) #elif APPEND_UNDERSCORE == 0 && SUBROUTINE_CASE == 0 void AQSECO(jcol) #endif #if PRECISION == 0 int *jcol; #else int jcol[2]; #endif { int jcol_temp; #if PRECISION == 0 jcol_temp = *jcol; #else jcol_temp = jcol[0]; #endif if (OPEN_FLAG > 0) { aqtTakeColorFromColormapEntry(jcol_temp); } } /* AQSEPA - set line attribute (color set in AQSECO): * * jpatt - the line pattern * jthick - the line thickness * */ #if APPEND_UNDERSCORE == 1 && SUBROUTINE_CASE == 1 void aqsepa_(jpatt,jthick,iopt) #elif APPEND_UNDERSCORE == 1 && SUBROUTINE_CASE == 0 void AQSEPA_(jpatt,jthick,iopt) #elif APPEND_UNDERSCORE == 0 && SUBROUTINE_CASE == 1 void aqsepa(jpatt,jthick,iopt) #elif APPEND_UNDERSCORE == 0 && SUBROUTINE_CASE == 0 void AQSEPA(jpatt,jthick,iopt) #endif #if PRECISION == 0 int *jpatt; int *jthick; #else int jpatt[2]; int jthick[2]; #endif { int jpatt_temp; int jthick_temp; #if PRECISION == 0 jpatt_temp = *jpatt; jthick_temp = *jthick; #else jpatt_temp = jpatt[0]; jthick_temp = jthick[0]; #endif if (OPEN_FLAG > 0) { if (iopt_temp == 1} } else if (iopt_temp == 2) { aqtSetLinewidth(pthick_temp); } } } /* AQPOIN - draw a point. * * ix - contains the x coordinate * iy - contains the y coordinate * jcol - color to use in drawing the point * */ #if APPEND_UNDERSCORE == 1 && SUBROUTINE_CASE == 1 void aqpoin_(ix, iy, jcol) #elif APPEND_UNDERSCORE == 1 && SUBROUTINE_CASE == 0 void AQPOIN_(ix, iy, jcol) #elif APPEND_UNDERSCORE == 0 && SUBROUTINE_CASE == 1 void aqpoin(ix, iy, jcol) #elif APPEND_UNDERSCORE == 0 && SUBROUTINE_CASE == 0 void AQPOIN(ix, iy, jcol) #endif #if PRECISION == 0 int *ix, *iy, *jcol; #else int ix[2], iy[2], jcol[2]; #endif { #if PRECISION == 0 #else #endif } /* AQRGFL - fill a region. Rectangular regions will be filled differently * non-rectangular regions. Dataplot only handles convex polygons, * so set this (for faster performance). This routine only does * solid fills. Hatch patterns must be drawn * by the calling program (i.e., send the individual lines to * the AQDRAW routine). * * xpts - contains the x coordinates * ypts - contains the y coordinates * npts - the number of points in the polygon (if 2, assume a rectangle, * otherwise, a convex polygon) * */ #define MAX_REG_POINTS 1000 #if APPEND_UNDERSCORE == 1 && SUBROUTINE_CASE == 1 void aqrgfl_(xpts, ypts, npts) #elif APPEND_UNDERSCORE == 1 && SUBROUTINE_CASE == 0 void AQRGFL_(xpts, ypts, npts) #elif APPEND_UNDERSCORE == 0 && SUBROUTINE_CASE == 1 void aqrgfl(xpts, ypts, npts) #elif APPEND_UNDERSCORE == 0 && SUBROUTINE_CASE == 0 void AQRGFL(xpts, ypts, npts) #endif int xpts[], ypts[]; #if PRECISION == 0 int *npts; #else int npts[2]; #endif { int npts_temp; #if PRECISION == 0 npts_temp = *npts; #else npts_temp = npts[0]; #endif if (OPEN_FLAG > 0) { if (npts_temp == 2) { /* rectangle */ aqtAddFilledRect(xpts[0], xpts[1], ypts[0], ypts[1]); } else if (npts_temp > 2) { /* convex polygon */ aqtAddPolygon(xpts, ypts, npts_temp); } } } /* AQTXTH - draw a horizontal text string. * * string - text string to draw * ixpos - x position * iypos - y position * ijusth - justification (horizontal) * 0 - left justified * 1 - center justified * 2 - right justified * ijustv - justiciation (vertical) * 0 - center justified * 1 - bottom justified * 2 - top justified * jcol - color * error - error flag * */ #if APPEND_UNDERSCORE == 1 && SUBROUTINE_CASE == 1 void aqtxth_(string, ixpos, iypos, ijusth, ijustv, jcol, error) #elif APPEND_UNDERSCORE == 1 && SUBROUTINE_CASE == 0 void AQTXTH_(string, ixpos, iypos, ijusth, ijustv, jcol, error) #elif APPEND_UNDERSCORE == 0 && SUBROUTINE_CASE == 1 void aqtxth(string, ixpos, iypos, ijusth, ijustv, jcol, error) #elif APPEND_UNDERSCORE == 0 && SUBROUTINE_CASE == 0 void AQTXTH(string, ixpos, iypos, ijusth, ijustv, jcol, error) #endif int string[]; #if PRECISION == 0 int *ixpos, *iypos, *ijusth, *ijustv, *jcol, *error; #else int ixpos[2], iypos[2], ijusth[2], ijustv[2], jcol[2], error[2]; #endif { int itest, itempx, itempy; /* temporary variables */ int len; /* number of characters in string */ int string_width; /* width of string in pixels */ char string2[130]; /* converted string */ int i; int ixpos_temp, iypos_temp, ijusth_temp, ijustv_temp; int jcol_temp; #if PRECISION == 0 ixpos_temp = *ixpos; iypos_temp = *iypos; ijusth_temp = *ijusth; ijustv_temp = *ijustv; jcol_temp = *jcol; #else ixpos_temp = ixpos[0]; iypos_temp = iypos[0]; ijusth_temp = ijusth[0]; ijustv_temp = ijustv[0]; jcol_temp = jcol[0]; #endif #if PRECISION == 0 i_to_s_4(string, string2, 130, &len); #else i_to_s_4(string, string2, 260, &len); #endif /* string_width = XTextWidth(font_struct, string2, len); */ switch (ijusth_temp) { case 0: /* Left justified string */ itempx = ixpos_temp; break; case 1: /* Center justified string */ itempx = ixpos_temp - (string_width/2); break; case 2: /* Right justified string */ itempx = ixpos_temp - string_width; break; default: itempx = ixpos_temp; break; } switch (ijustv_temp) { case 0: /* Center justified string */ itempy = iypos_temp + (FONT_HEIGHT_CURRENT/2.0); break; case 1: /* Bottom justified string */ itempy = iypos_temp; break; case 2: /* Top justified string */ itempy = iypos_temp + FONT_HEIGHT_CURRENT; break; default: itempy = iypos_temp + (FONT_HEIGHT_CURRENT/2.0); break; } } /* AQTXTV - draw a horizontal text string. * * NOTE: This is not implemented on our first * pass for this driver. Issue of how * to access fonts, set sizes and * justifications need to be addressed. * * * string - text string to draw * ixpos - x position * iypos - y position * ijusth - justification (horizontal) * 0 - left justified * 1 - center justified * 2 - right justified * ijustv - justiciation (vertical) * 0 - center justified * 1 - bottom justified * 2 - top justified * jcol - color * error - error flag * */ #if APPEND_UNDERSCORE == 1 && SUBROUTINE_CASE == 1 void aqtxtv_(string, ixpos, iypos, ijusth, ijustv, jcol, error) #elif APPEND_UNDERSCORE == 1 && SUBROUTINE_CASE == 0 void AQTXTV_(string, ixpos, iypos, ijusth, ijustv, jcol, error) #elif APPEND_UNDERSCORE == 0 && SUBROUTINE_CASE == 1 void aqtxtv(string, ixpos, iypos, ijusth, ijustv, jcol, error) #elif APPEND_UNDERSCORE == 0 && SUBROUTINE_CASE == 0 void AQTXTV(string, ixpos, iypos, ijusth, ijustv, jcol, error) #endif int string[]; #if PRECISION == 0 int *ixpos, *iypos, *ijusth, *ijustv, *jcol, *error; #else int ixpos[2], iypos[2], ijusth[2], ijustv[2], jcol[2], error[2]; #endif { int itest, itempx, itempy; /* temporary variables */ int len; /* number of characters in string */ int y_pix_len; /* height of entire string */ int string_width; /* width of string in pixels */ char string2[130]; /* converted string */ int i, ijunk; #if PRECISION == 0 int string3[2]; /* one character at a time */ #else int string3[4]; /* one character at a time */ #endif int ixpos_temp, iypos_temp, ijusth_temp, ijustv_temp; int jcol_temp; #if PRECISION == 0 ixpos_temp = *ixpos; iypos_temp = *iypos; ijusth_temp = *ijusth; ijustv_temp = *ijustv; jcol_temp = *jcol; #else ixpos_temp = ixpos[0]; iypos_temp = iypos[0]; ijusth_temp = ijusth[0]; ijustv_temp = ijustv[0]; jcol_temp = ijustv[0]; #endif #if PRECISION == 0 i_to_s_4(string, string2, 130, &len); #else i_to_s_4(string, string2, 260, &len); #endif y_pix_len = len * (FONT_HEIGHT_CURRENT + FONT_GAP_CURRENT); switch (ijustv_temp) { case 0: /* Center justified string */ itempy = -(y_pix_len/2) + FONT_HEIGHT_CURRENT; break; case 1: /* Bottom justified string */ itempy = -y_pix_len + FONT_HEIGHT_CURRENT; break; case 2: /* Top justified string */ itempy = FONT_HEIGHT_CURRENT; break; default: itempy = -(y_pix_len/2) + FONT_HEIGHT_CURRENT; break; } itempy = iypos_temp + itempy; #if PRECISION == 0 string3[1] = 0; for (i = 0; i < len; i++) { /* plot each character one at a time */ string3[0] = string[i]; i_to_s_4(string3,string2, 2, &ijunk); /* string_width = XTextWidth(font_struct, string2, 1); */ switch (ijusth_temp) { case 0: /* Left justified string */ itempx = 0; break; case 1: /* Center justified string */ itempx = (string_width/2); break; case 2: /* Right justified string */ itempx = string_width; break; default: itempx = ixpos_temp; break; } itempx = ixpos_temp - itempx; itempy = itempy + (FONT_HEIGHT_CURRENT + FONT_GAP_CURRENT); } #else string3[1] = 0; string3[2] = 0; string3[3] = 0; for (i = 0; i < len; i++) { /* plot each character one at a time */ string3[0] = string[2*i]; i_to_s_4(string3,string2, 4, &ijunk); switch (ijusth_temp) { case 0: /* Left justified string */ itempx = 0; break; case 1: /* Center justified string */ itempx = (string_width/2); break; case 2: /* Right justified string */ itempx = string_width; break; default: itempx = ixpos_temp; break; } itempx = ixpos_temp - itempx; itempy = itempy + (FONT_HEIGHT_CURRENT + FONT_GAP_CURRENT); } #endif } /* i_to_s_4 - utitlity routine to convert an integer array containing * Ascii Decimal Equivalents to a character string array. The * Fortran routines pass character type data as an array of * ADE's, which this routine then converts to C's character * type. Note that the input array is assumed to be correct * (i.e., a value between 0 and 127) and no error checking is * done on it. * * string1 - input array containing ADE's. * string2 - output array in C character format. * maxlen - maximum length for string2 * ilen - length of character string * */ void i_to_s_4(string1, string2, maxlen, ilen) int string1[], maxlen, *ilen; char string2[]; { int i; int itemp; i = 0; #if PRECISION == 0 while (string1[i] != 0 && i < (maxlen - 1) ) { itemp = string1[i]; string2[i] = string1[i]; i++; } *ilen = i; string2[i]='\0'; } #else while (string1[2*i] != 0 && i < (maxlen - 1) ) { itemp = string1[2*i]; string2[i] = string1[2*i]; i++; } *ilen = i; string2[i]='\0'; } #endif