Menu
▾
▴
[Plplot-cvs] SF.net SVN: plplot: [8352] trunk
|
From: <arj...@us...> - 2008-04-01 07:56:06
|
Revision: 8352
http://plplot.svn.sourceforge.net/plplot/?rev=8352&view=rev
Author: arjenmarkus
Date: 2008-04-01 00:56:12 -0700 (Tue, 01 Apr 2008)
Log Message:
-----------
Implementation of plimage and plimagefr for Fortran 95 bindings
Modified Paths:
--------------
trunk/bindings/f77/plstubs.h
trunk/bindings/f77/scstubs.c
trunk/bindings/f77/sfstubs.fm4
trunk/bindings/f95/plstubs.h
trunk/bindings/f95/scstubs.c
trunk/bindings/f95/sfstubs.f90
trunk/bindings/f95/sfstubsf95.f90
trunk/bindings/tcl/tclAPI.c
trunk/bindings/tk/plframe.c
trunk/bindings/tk/tcpip.c
trunk/bindings/tk/tkMain.c
trunk/examples/c/x01c.c
trunk/examples/f77/x20f.fm4
trunk/examples/f95/CMakeLists.txt
trunk/examples/f95/Makefile.examples.in
Added Paths:
-----------
trunk/examples/f95/x20f.f90
Modified: trunk/bindings/f77/plstubs.h
===================================================================
--- trunk/bindings/f77/plstubs.h 2008-03-31 07:45:28 UTC (rev 8351)
+++ trunk/bindings/f77/plstubs.h 2008-04-01 07:56:12 UTC (rev 8352)
@@ -158,6 +158,7 @@
#define PL_SETCONTLABELFORMATa FNAME(PL_SETCONTLABELFORMAT_,pl_setcontlabelformat_)
#define PL_SETCONTLABELPARAM FNAME(PL_SETCONTLABELPARAM,pl_setcontlabelparam)
#define PL_SETCONTLABELPARAMa FNAME(PL_SETCONTLABELPARAM_,pl_setcontlabelparam_)
+#define PLABORT7 FNAME(PLABORT7,plabort7)
#define PLADV FNAME(PLADV,pladv)
#define PLAXES7 FNAME(PLAXES7,plaxes7)
#define PLBIN FNAME(PLBIN,plbin)
@@ -271,7 +272,6 @@
#define PLSDIPLT FNAME(PLSDIPLT,plsdiplt)
#define PLSDIPLZ FNAME(PLSDIPLZ,plsdiplz)
#define PLSESC FNAME(PLSESC,plsesc)
-#define PLSETMAPFORMC FNAME(PLSETMAPFORMC,plsetmapformc)
#define PLSETOPT7 FNAME(PLSETOPT7,plsetopt7)
#define PLSFAM FNAME(PLSFAM,plsfam)
#define PLSFNAM7 FNAME(PLSFNAM7,plsfnam7)
Modified: trunk/bindings/f77/scstubs.c
===================================================================
--- trunk/bindings/f77/scstubs.c 2008-03-31 07:45:28 UTC (rev 8351)
+++ trunk/bindings/f77/scstubs.c 2008-04-01 07:56:12 UTC (rev 8352)
@@ -57,6 +57,12 @@
}
void
+PLABORT7(char *text)
+{
+ plabort(text);
+}
+
+void
PLADV(PLINT *sub)
{
c_pladv(*sub);
@@ -749,6 +755,9 @@
c_plsesc((char) *esc);
}
+/* Auxiliary routine - not to be used publicly
+*/
+#define PLSETMAPFORMC FNAME(PLSETMAPFORMC,plsetmapformc)
void
PLSETMAPFORMC( void (*mapform)(PLINT *, PLFLT *, PLFLT *) )
{
Modified: trunk/bindings/f77/sfstubs.fm4
===================================================================
--- trunk/bindings/f77/sfstubs.fm4 2008-03-31 07:45:28 UTC (rev 8351)
+++ trunk/bindings/f77/sfstubs.fm4 2008-04-01 07:56:12 UTC (rev 8352)
@@ -51,6 +51,20 @@
!***********************************************************************
+ subroutine plabort(text)
+
+ implicit none
+ character*(*) text
+
+ include 'sfstubs.h'
+
+ call plstrf2c(text, string1, maxlen)
+ call plabort7(s1)
+
+ end
+
+!***********************************************************************
+
subroutine plsdev(dnam)
implicit none
Modified: trunk/bindings/f95/plstubs.h
===================================================================
--- trunk/bindings/f95/plstubs.h 2008-03-31 07:45:28 UTC (rev 8351)
+++ trunk/bindings/f95/plstubs.h 2008-04-01 07:56:12 UTC (rev 8352)
@@ -147,6 +147,7 @@
#define PL_SETCONTLABELFORMATa FNAME(PL_SETCONTLABELFORMAT_,pl_setcontlabelformat_)
#define PL_SETCONTLABELPARAM FNAME(PL_SETCONTLABELPARAM,pl_setcontlabelparam)
#define PL_SETCONTLABELPARAMa FNAME(PL_SETCONTLABELPARAM_,pl_setcontlabelparam_)
+#define PLABORT7 FNAME(PLABORT7,plabort7)
#define PLADV FNAME(PLADV,pladv)
#define PLAXES7 FNAME(PLAXES7,plaxes7)
#define PLBIN FNAME(PLBINF77,plbinf77)
@@ -168,6 +169,7 @@
#define PLEND FNAME(PLEND,plend)
#define PLEND1 FNAME(PLEND1,plend1)
#define PLENV FNAME(PLENV,plenv)
+#define PLENV0 FNAME(PLENV0,plenv0)
#define PLEOP FNAME(PLEOP,pleop)
#define PLERRX FNAME(PLERRXF77,plerrxf77)
#define PLERRY FNAME(PLERRYF77,plerryf77)
@@ -202,9 +204,11 @@
#define PLGYAX FNAME(PLGYAX,plgyax)
#define PLGZAX FNAME(PLGZAX,plgzax)
#define PLHIST FNAME(PLHISTF77,plhistf77)
-#define PLHLS FNAME(PLHLS,plhls)
-#define PLHLSRGB FNAME(PLHLSRGB,plhlsrgb)
-#define PLINIT FNAME(PLINIT,plinit)
+#define PLHLS FNAME(PLHLS,plhls)
+#define PLHLSRGB FNAME(PLHLSRGB,plhlsrgb)
+#define PLIMAGE FNAME(PLIMAGEF77,plimagef77)
+#define PLIMAGEFR FNAME(PLIMAGEFRF77,plimagefrf77)
+#define PLINIT FNAME(PLINIT,plinit)
#define PLJOIN FNAME(PLJOIN,pljoin)
#define PLLAB7 FNAME(PLLAB7,pllab7)
#define PLLIGHTSOURCE FNAME(PLLIGHTSOURCE,pllightsource)
@@ -264,7 +268,6 @@
#define PLSDIPLT FNAME(PLSDIPLT,plsdiplt)
#define PLSDIPLZ FNAME(PLSDIPLZ,plsdiplz)
#define PLSESC FNAME(PLSESC,plsesc)
-#define PLSETMAPFORMC FNAME(PLSETMAPFORMC,plsetmapformc)
#define PLSETOPT7 FNAME(PLSETOPT7,plsetopt7)
#define PLSFAM FNAME(PLSFAM,plsfam)
#define PLSFNAM7 FNAME(PLSFNAM7,plsfnam7)
Modified: trunk/bindings/f95/scstubs.c
===================================================================
--- trunk/bindings/f95/scstubs.c 2008-03-31 07:45:28 UTC (rev 8351)
+++ trunk/bindings/f95/scstubs.c 2008-04-01 07:56:12 UTC (rev 8352)
@@ -57,6 +57,12 @@
}
void
+PLABORT7(const char *text)
+{
+ plabort(*text);
+}
+
+void
PLADV(PLINT *sub)
{
c_pladv(*sub);
@@ -162,6 +168,13 @@
}
void
+PLENV0(PLFLT *xmin, PLFLT *xmax, PLFLT *ymin, PLFLT *ymax,
+ PLINT *just, PLINT *axis)
+{
+ c_plenv0(*xmin, *xmax, *ymin, *ymax, *just, *axis);
+}
+
+void
PLEOP(void)
{
c_pleop();
@@ -386,6 +399,54 @@
}
void
+PLIMAGEFR(PLFLT *idata, PLINT *nx, PLINT *ny,
+ PLFLT *xmin, PLFLT *xmax, PLFLT *ymin, PLFLT *ymax, PLFLT *zmin, PLFLT *zmax,
+ PLFLT *Dxmin, PLFLT *Dxmax, PLFLT *Dymin, PLFLT *Dymax,
+ PLFLT *valuemin, PLFLT *valuemax)
+{
+ int i, j;
+ PLFLT **pidata;
+
+ plAlloc2dGrid(&pidata, *nx, *ny);
+
+ for ( i = 0 ; i < *nx ; i ++ ) {
+ for ( j = 0 ; j < *ny ; j ++ ) {
+ pidata[i][j] = idata[i + j * (*nx)];
+ }
+ }
+
+ c_plimagefr(pidata, *nx, *ny,
+ *xmin, *xmax, *ymin, *ymax, *zmin, *zmax,
+ *Dxmin, *Dxmax, *Dymin, *Dymax,
+ *valuemin, *valuemax);
+
+ plFree2dGrid(pidata, *nx, *ny);
+}
+
+void
+PLIMAGE(PLFLT *idata, PLINT *nx, PLINT *ny,
+ PLFLT *xmin, PLFLT *xmax, PLFLT *ymin, PLFLT *ymax, PLFLT *zmin, PLFLT *zmax,
+ PLFLT *Dxmin, PLFLT *Dxmax, PLFLT *Dymin, PLFLT *Dymax)
+{
+ int i, j;
+ PLFLT **pidata;
+
+ plAlloc2dGrid(&pidata, *nx, *ny);
+
+ for ( i = 0 ; i < *nx ; i ++ ) {
+ for ( j = 0 ; j < *ny ; j ++ ) {
+ pidata[i][j] = idata[i + j * (*nx)];
+ }
+ }
+
+ c_plimage(pidata, *nx, *ny,
+ *xmin, *xmax, *ymin, *ymax, *zmin, *zmax,
+ *Dxmin, *Dxmax, *Dymin, *Dymax);
+
+ plFree2dGrid(pidata, *nx, *ny);
+}
+
+void
PLINIT(void)
{
c_plinit();
@@ -528,7 +589,7 @@
void
PLPTEX37(
- PLFLT *x, PLFLT *y, PLFLT *z,
+ PLFLT *x, PLFLT *y, PLFLT *z,
PLFLT *dx, PLFLT *dy, PLFLT *dz,
PLFLT *sx, PLFLT *sy, PLFLT *sz,
PLFLT *just, const char *text)
@@ -710,6 +771,9 @@
c_plsesc((char) *esc);
}
+/* Auxiliary routine - not to be used publicly
+*/
+#define PLSETMAPFORMC FNAME(PLSETMAPFORMC,plsetmapformc)
void
PLSETMAPFORMC( void (*mapform)(PLINT *, PLFLT *, PLFLT *) )
{
@@ -814,7 +878,7 @@
PLBOOL *y_ascl, PLBOOL *acc,
PLINT *colbox, PLINT *collab,
PLINT *colline, PLINT *styline,
- const char *legline0, const char *legline1,
+ const char *legline0, const char *legline1,
const char *legline2, const char *legline3,
const char *labx, const char *laby, const char *labtop)
{
Modified: trunk/bindings/f95/sfstubs.f90
===================================================================
--- trunk/bindings/f95/sfstubs.f90 2008-03-31 07:45:28 UTC (rev 8351)
+++ trunk/bindings/f95/sfstubs.f90 2008-04-01 07:56:12 UTC (rev 8352)
@@ -53,6 +53,21 @@
!***********************************************************************
+ subroutine plabort(text)
+
+ implicit none
+ character*(*) text
+
+ include 'sfstubs.h'
+
+ call plstrf2c(text, string1, maxlen)
+ s1 = transfer( string1, s1 )
+ call plabort7(s1)
+
+ end subroutine
+
+!***********************************************************************
+
subroutine plsdev(dnam)
implicit none
@@ -722,7 +737,7 @@
subroutine pltimefmt(fmt)
implicit none
- character*(*) fmt
+ character*(*) fmt
include 'sfstubs.h'
Modified: trunk/bindings/f95/sfstubsf95.f90
===================================================================
--- trunk/bindings/f95/sfstubsf95.f90 2008-03-31 07:45:28 UTC (rev 8351)
+++ trunk/bindings/f95/sfstubsf95.f90 2008-04-01 07:56:12 UTC (rev 8352)
@@ -940,6 +940,35 @@
call plhistf77( size(data), data, datmin, datmax, nbin, oldwin )
end subroutine plhist
+ subroutine plimagefr( idata, xmin, xmax, ymin, ymax, zmin, zmax, &
+ dxmin, dxmax, dymin, dymax, valuemin, valuemax )
+ real(kind=plflt), dimension(:,:) :: idata
+ real(kind=plflt) :: xmin, xmax, ymin, ymax, zmin, zmax
+ real(kind=plflt) :: dxmin, dxmax, dymin, dymax, &
+ valuemin, valuemax
+
+ integer :: nx, ny
+
+ nx = size(idata,1)
+ ny = size(idata,2)
+ call plimagefrf77( idata, nx, ny, xmin, xmax, ymin, ymax, zmin, zmax, &
+ dxmin, dxmax, dymin, dymax, valuemin, valuemax )
+ end subroutine plimagefr
+
+ subroutine plimage( idata, xmin, xmax, ymin, ymax, zmin, zmax, &
+ dxmin, dxmax, dymin, dymax )
+ real(kind=plflt), dimension(:,:) :: idata
+ real(kind=plflt) :: xmin, xmax, ymin, ymax, zmin, zmax
+ real(kind=plflt) :: dxmin, dxmax, dymin, dymax
+
+ integer :: nx, ny
+
+ nx = size(idata,1)
+ ny = size(idata,2)
+ call plimagef77( idata, nx, ny, xmin, xmax, ymin, ymax, zmin, zmax, &
+ dxmin, dxmax, dymin, dymax )
+ end subroutine plimage
+
subroutine plline( x, y )
real(kind=plflt), dimension(:) :: x, y
Modified: trunk/bindings/tcl/tclAPI.c
===================================================================
--- trunk/bindings/tcl/tclAPI.c 2008-03-31 07:45:28 UTC (rev 8351)
+++ trunk/bindings/tcl/tclAPI.c 2008-04-01 07:56:12 UTC (rev 8352)
@@ -367,6 +367,7 @@
"tcl_findLibrary plplot " VERSION "/tcl \"\" plplot.tcl PL_LIBRARY pllibrary";
#endif
+debug=1;
#ifdef USE_TCL_STUBS
/*
* We hard-wire 8.1 here, rather than TCL_VERSION, TK_VERSION because
@@ -374,10 +375,12 @@
* is 8.1 or newer. Otherwise if we compiled against 8.2, we couldn't
* be loaded into 8.1
*/
+printf( "Tcl_InitStubs\n");fflush(stdout);
Tcl_InitStubs(interp,"8.1",0);
#endif
#if 1
+printf( "Matrix_Init\n");fflush(stdout);
if (Matrix_Init(interp) != TCL_OK) {
if (debug) fprintf(stderr, "error in matrix init\n");
return TCL_ERROR;
@@ -391,6 +394,7 @@
* is made in pltcl.h, and should be removed only with extreme caution.
*/
#ifdef USE_MATRIX_STUBS
+printf( "Matrix_InitStubs\n");fflush(stdout);
if (Matrix_InitStubs(interp,"0.1",0) == NULL) {
if (debug) fprintf(stderr, "error in matrix stubs init\n");
return TCL_ERROR;
@@ -463,6 +467,7 @@
if (libDir == NULL) {
Tcl_DString ds;
if (debug) fprintf(stderr, "trying curdir\n");
+printf( "Tcl_Access\n");fflush(stdout);
if (Tcl_Access("plplot.tcl", 0) != 0) {
if (debug) fprintf(stderr, "couldn't find plplot.tcl in curdir\n");
return TCL_ERROR;
@@ -478,6 +483,7 @@
Tcl_DStringFree(&ds);
Tcl_SetVar(interp, "pllibrary", libDir, TCL_GLOBAL_ONLY);
+printf( "Tcl_EvalFile\n");fflush(stdout);
if (Tcl_EvalFile(interp, "plplot.tcl") != TCL_OK) {
if (debug) fprintf(stderr, "error evalling plplot.tcl\n");
return TCL_ERROR;
Modified: trunk/bindings/tk/plframe.c
===================================================================
--- trunk/bindings/tk/plframe.c 2008-03-31 07:45:28 UTC (rev 8351)
+++ trunk/bindings/tk/plframe.c 2008-04-01 07:56:12 UTC (rev 8352)
@@ -2413,10 +2413,12 @@
#define FILECAST (ClientData)
#endif
+#if !defined(MAC_TCL) && !defined(__WIN32__) && !defined(__CYGWIN__)
if (Tcl_GetOpenFile(interp, iodev->fileHandle,
0, 1, FILECAST &iodev->file) != TCL_OK) {
return TCL_ERROR;
}
+#endif
iodev->fd = fileno(iodev->file);
}
@@ -2435,13 +2437,17 @@
#if TK_MAJOR_VERSION < 4 || \
( TK_MAJOR_VERSION == 4 && TK_MINOR_VERSION == 0 ) || \
TK_MAJOR_VERSION > 7
+#if !defined(MAC_TCL) && !defined(__WIN32__) && !defined(__CYGWIN__)
Tk_CreateFileHandler(iodev->fd, TK_READABLE, (Tk_FileProc *) ReadData,
(ClientData) plFramePtr);
+#endif
#else
+#if !defined(MAC_TCL) && !defined(__WIN32__) && !defined(__CYGWIN__)
Tcl_CreateFileHandler( Tcl_GetFile( (ClientData) iodev->fd, TCL_UNIX_FD ),
TK_READABLE, (Tk_FileProc *) ReadData,
(ClientData) plFramePtr );
#endif
+#endif
return TCL_OK;
}
@@ -2470,12 +2476,16 @@
#if TK_MAJOR_VERSION < 4 || \
( TK_MAJOR_VERSION == 4 && TK_MINOR_VERSION == 0 ) || \
TK_MAJOR_VERSION > 7
+#if !defined(MAC_TCL) && !defined(__WIN32__) && !defined(__CYGWIN__)
Tk_DeleteFileHandler(iodev->fd);
+#endif
#else
/* Tk_DeleteFileHandler( iodev->file );*/
+#if !defined(MAC_TCL) && !defined(__WIN32__) && !defined(__CYGWIN__)
Tcl_DeleteFileHandler( Tcl_GetFile( (ClientData) iodev->fd,
TCL_UNIX_FD ) );
#endif
+#endif
pdf_close(plr->pdfs);
iodev->fd = 0;
Modified: trunk/bindings/tk/tcpip.c
===================================================================
--- trunk/bindings/tk/tcpip.c 2008-03-31 07:45:28 UTC (rev 8351)
+++ trunk/bindings/tk/tcpip.c 2008-04-01 07:56:12 UTC (rev 8352)
@@ -551,7 +551,9 @@
* Remove the file handler and close the file.
*/
if (iodev->type == 0) {
+#if !defined(MAC_TCL) && !defined(__WIN32__) && !defined(__CYGWIN__)
Tk_DeleteFileHandler(iodev->fd);
+#endif
close(iodev->fd);
}
pl_FreeReadBuffer(iodev->fd);
Modified: trunk/bindings/tk/tkMain.c
===================================================================
--- trunk/bindings/tk/tkMain.c 2008-03-31 07:45:28 UTC (rev 8351)
+++ trunk/bindings/tk/tkMain.c 2008-04-01 07:56:12 UTC (rev 8352)
@@ -374,7 +374,9 @@
}
Tcl_DStringFree(&buffer);
}
+#if !defined(MAC_TCL) && !defined(__WIN32__) && !defined(__CYGWIN__)
Tk_CreateFileHandler(0, TK_READABLE, StdinProc, (ClientData) 0);
+#endif
if (tty) {
Prompt(interp, 0);
}
@@ -447,7 +449,9 @@
Tcl_Eval(interp, "exit");
exit(1);
} else {
+#if !defined(MAC_TCL) && !defined(__WIN32__) && !defined(__CYGWIN__)
Tk_DeleteFileHandler(0);
+#endif
}
return;
} else {
@@ -474,10 +478,13 @@
* finished. Among other things, this will trash the text of the
* command being evaluated.
*/
-
+#if !defined(MAC_TCL) && !defined(__WIN32__) && !defined(__CYGWIN__)
Tk_CreateFileHandler(0, 0, StdinProc, (ClientData) 0);
+#endif
code = Tcl_RecordAndEval(interp, cmd, 0);
+#if !defined(MAC_TCL) && !defined(__WIN32__) && !defined(__CYGWIN__)
Tk_CreateFileHandler(0, TK_READABLE, StdinProc, (ClientData) 0);
+#endif
Tcl_DStringFree(&command);
if (*interp->result != 0) {
if ((code != TCL_OK) || (tty)) {
Modified: trunk/examples/c/x01c.c
===================================================================
--- trunk/examples/c/x01c.c 2008-03-31 07:45:28 UTC (rev 8351)
+++ trunk/examples/c/x01c.c 2008-04-01 07:56:12 UTC (rev 8352)
@@ -113,23 +113,30 @@
/* plplot initialization */
/* Divide page into 2x2 plots unless user overrides */
+ fprintf( stderr, "pllsub\n");
plssub(2, 2);
/* Parse and process command line arguments */
+ fprintf( stderr, "plMergeOpts\n");
plMergeOpts(options, "x01c options", notes);
+ fprintf( stderr, "plparseopts\n");
plparseopts(&argc, argv, PL_PARSE_FULL);
/* Get version number, just for kicks */
+ fprintf( stderr, "plgver\n");
plgver(ver);
+ fprintf( stderr, "plplot library version\n");
fprintf(stdout, "PLplot library version: %s\n", ver);
/* Initialize plplot */
+ fprintf( stderr, "plinit\n");
plinit();
/* Select font set as per input flag */
+ fprintf( stderr, "plfontld\n");
if (fontset)
plfontld(1);
else
@@ -164,18 +171,18 @@
plot3();
- /*
+ /*
* Show how to save a plot:
* Open a new device, make it current, copy parameters,
- * and replay the plot buffer
+ * and replay the plot buffer
*/
if (f_name) { /* command line option '-save filename' */
printf("The current plot was saved in color Postscript under the name `%s'.\n", f_name);
plgstrm(&cur_strm); /* get current stream */
- plmkstrm(&new_strm); /* create a new one */
-
+ plmkstrm(&new_strm); /* create a new one */
+
plsfnam(f_name); /* file name */
plsdev("psc"); /* device type */
@@ -194,7 +201,7 @@
if (gin.keysym == PLK_Escape) break;
pltext();
- if (gin.keysym < 0xFF && isprint(gin.keysym))
+ if (gin.keysym < 0xFF && isprint(gin.keysym))
printf("subwin = %d, wx = %f, wy = %f, dx = %f, dy = %f, c = '%c'\n",
gin.subwindow, gin.wX, gin.wY, gin.dX, gin.dY, gin.keysym);
else
@@ -212,7 +219,7 @@
}
/* =============================================================== */
-
+
void
plot1(int do_test)
{
@@ -235,10 +242,10 @@
ys[i] = y[i * 10 + 3];
}
-/* Set up the viewport and window using PLENV. The range in X is
- * 0.0 to 6.0, and the range in Y is 0.0 to 30.0. The axes are
- * scaled separately (just = 0), and we just draw a labelled
- * box (axis = 0).
+/* Set up the viewport and window using PLENV. The range in X is
+ * 0.0 to 6.0, and the range in Y is 0.0 to 30.0. The axes are
+ * scaled separately (just = 0), and we just draw a labelled
+ * box (axis = 0).
*/
plcol0(1);
plenv(xmin, xmax, ymin, ymax, 0, 0);
@@ -272,11 +279,11 @@
}
#else
printf("The -xor command line option can only be exercised if your "
- "system\nhas usleep(), which does not seem to happen.\n");
+ "system\nhas usleep(), which does not seem to happen.\n");
#endif
}
}
-
+
/* =============================================================== */
void
@@ -286,7 +293,7 @@
/* Set up the viewport and window using PLENV. The range in X is -2.0 to
* 10.0, and the range in Y is -0.4 to 2.0. The axes are scaled separately
- * (just = 0), and we draw a box with axes (axis = 1).
+ * (just = 0), and we draw a box with axes (axis = 1).
*/
plcol0(1);
plenv(-2.0, 10.0, -0.4, 1.2, 0, 1);
@@ -324,7 +331,7 @@
pladv(0);
/* Use standard viewport, and define X range from 0 to 360 degrees, Y range
- * from -1.2 to 1.2.
+ * from -1.2 to 1.2.
*/
plvsta();
plwind(0.0, 360.0, -1.2, 1.2);
@@ -334,7 +341,7 @@
plcol0(1);
plbox("bcnst", 60.0, 2, "bcnstv", 0.2, 2);
-/* Superimpose a dashed line grid, with 1.5 mm marks and spaces.
+/* Superimpose a dashed line grid, with 1.5 mm marks and spaces.
* plstyl expects a pointer!
*/
plstyl(1, &mark1, &space1);
Modified: trunk/examples/f77/x20f.fm4
===================================================================
--- trunk/examples/f77/x20f.fm4 2008-03-31 07:45:28 UTC (rev 8351)
+++ trunk/examples/f77/x20f.fm4 2008-04-01 07:56:12 UTC (rev 8352)
@@ -168,7 +168,7 @@
do 210 i=1,XDIM
x(i) = (i-1)*2.d0*M_PI/(XDIM-1)
210 continue
- do 220 i=0,YDIM
+ do 220 i=1,YDIM
y(i) = (i-1)*3.d0*M_PI/(YDIM-1)
220 continue
@@ -380,7 +380,7 @@
C
C
do 220 j = 1,h
- do 220 i = 1,w
+ do 210 i = 1,w
record = record + 1
read( 10, rec = record ) img
k = i + (h-j)*w
Modified: trunk/examples/f95/CMakeLists.txt
===================================================================
--- trunk/examples/f95/CMakeLists.txt 2008-03-31 07:45:28 UTC (rev 8351)
+++ trunk/examples/f95/CMakeLists.txt 2008-04-01 07:56:12 UTC (rev 8352)
@@ -41,6 +41,7 @@
"17"
"18"
"19"
+"20"
"22"
"23"
"28"
@@ -86,7 +87,7 @@
endif(BUILD_TEST)
endforeach(STRING_INDEX ${f95_STRING_INDICES})
-install(FILES ${f95_SRCS}
+install(FILES ${f95_SRCS}
DESTINATION ${DATA_DIR}/examples/f95
)
@@ -96,7 +97,7 @@
${CMAKE_CURRENT_BINARY_DIR}/Makefile.examples
)
-install(FILES ${CMAKE_CURRENT_BINARY_DIR}/Makefile.examples
+install(FILES ${CMAKE_CURRENT_BINARY_DIR}/Makefile.examples
DESTINATION ${DATA_DIR}/examples/f95
RENAME Makefile
)
Modified: trunk/examples/f95/Makefile.examples.in
===================================================================
--- trunk/examples/f95/Makefile.examples.in 2008-03-31 07:45:28 UTC (rev 8351)
+++ trunk/examples/f95/Makefile.examples.in 2008-04-01 07:56:12 UTC (rev 8352)
@@ -49,11 +49,12 @@
x17f$(EXEEXT) \
x18f$(EXEEXT) \
x19f$(EXEEXT) \
+ x20f$(EXEEXT) \
x22f$(EXEEXT) \
x23f$(EXEEXT) \
x28f$(EXEEXT) \
x29f$(EXEEXT) \
- x30f$(EXEEXT)
+ x30f$(EXEEXT)
all: $(EXECUTABLES_list)
Added: trunk/examples/f95/x20f.f90
===================================================================
--- trunk/examples/f95/x20f.f90 (rev 0)
+++ trunk/examples/f95/x20f.f90 2008-04-01 07:56:12 UTC (rev 8352)
@@ -0,0 +1,531 @@
+! $Id: x20c.c 8033 2007-11-23 15:28:09Z andrewross $
+!
+! Copyright (C) 2004 Alan W. Irwin
+!
+! This file is part of PLplot.
+!
+! PLplot is free software; you can redistribute it and/or modify
+! it under the terms of the GNU General Library Public License as
+! published by the Free Software Foundation; either version 2 of the
+! License, or (at your option) any later version.
+!
+! PLplot is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU Library General Public License for more details.
+!
+! You should have received a copy of the GNU Library General Public
+! License along with PLplot; if not, write to the Free Software
+! Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+!
+!
+! plimage demo
+!
+!
+
+!static PLOptionTable options[] = {
+!{
+! "dbg", /* extra debugging plot */
+! NULL,
+! NULL,
+! &dbg,
+! PL_OPT_BOOL,
+! "-dbg",
+! "Extra debugging plot" },
+!{
+! "nosombrero", /* Turns on test of xor function */
+! NULL,
+! NULL,
+! &nosombrero,
+! PL_OPT_BOOL,
+! "-nosombrero",
+! "No sombrero plot" },
+!{
+! "nointeractive", /* Turns on test of xor function */
+! NULL,
+! NULL,
+! &nointeractive,
+! PL_OPT_BOOL,
+! "-nointeractive",
+! "No interactive selection" },
+!{
+! "save", /* For saving in postscript */
+! NULL,
+! NULL,
+! &f_name,
+! PL_OPT_STRING,
+! "-save filename",
+! "Save sombrero plot in color postscript `filename'" },
+!{
+! NULL, /* option */
+! NULL, /* handler */
+! NULL, /* client data */
+! NULL, /* address of variable to set */
+! 0, /* mode flag */
+! NULL, /* short syntax */
+! NULL } /* long syntax */
+!};
+
+ program x20f
+ use plplot, M_PI => PL_PI
+
+ implicit none
+
+ integer, parameter :: XDIM = 260, YDIM = 260
+ real(kind=plflt), parameter :: XDIMR = XDIM, YDIMR = YDIM
+
+ real(kind=plflt) :: x(XDIM), y(YDIM), z(XDIM,YDIM), r(XDIM,YDIM)
+ real(kind=plflt) :: xi, yi, xe, ye
+ integer i, j
+ real(kind=plflt) width_r, height_r
+
+!
+! Dimensions taken from "lena.pgm"
+!
+ integer width, height, num_col
+ real(kind=plflt), dimension(:,:), pointer :: img_f
+
+!
+! Parameters from command-line
+!
+ logical dbg
+ logical nosombrero
+ logical nointeractive
+ character*80 f_name
+
+!
+! Bugs in plimage():
+! -at high magnifications, the left and right edge are ragged, try
+! ./x20c -dev xwin -wplt 0.3,0.3,0.6,0.6 -ori 0.5
+!
+! Bugs in x20c.c:
+! -if the window is resized after a selection is made on 'lena', when
+! making a new selection the old one will re-appear.
+!
+!
+! Parse and process command line arguments
+!
+! call plMergeOpts(options, 'x20c options', NULL)
+
+ dbg = .true.
+ nosombrero = .false.
+ nointeractive = .true.
+ f_name = ' '
+ call plparseopts(PL_PARSE_FULL)
+
+! Initialize plplot
+
+ call plinit
+
+! View image border pixels
+ if (dbg) then
+ call plenv(1._plflt, XDIMR, 1._plflt, YDIMR, 1, 1)
+
+ z = 0.0_plflt
+
+! Build a one pixel square border, for diagnostics
+ do i = 1,XDIM
+! Right
+ z(i,YDIM) = 1._plflt
+! Left
+ z(i,1) = 1._plflt
+ enddo
+
+ do i = 1,YDIM
+! Top
+ z(1,i) = 1._plflt
+! Bottom
+ z(XDIM,i) = 1._plflt
+ enddo
+
+ call pllab('...around a blue square.',' ', &
+ 'A red border should appear...')
+
+ call plimage(z, 1._plflt, XDIMR, 1._plflt, YDIMR, 0._plflt, 0._plflt, &
+ 1._plflt, XDIMR, 1._plflt, YDIMR)
+
+ call pladv(0)
+ endif
+
+! Sombrero-like demo
+ if (.not. nosombrero) then
+! draw a yellow plot box, useful for diagnostics! :(
+ call plcol0(2)
+ call plenv(0._plflt, 2._plflt*M_PI, 0.0_plflt, 3._plflt*M_PI, 1, -1)
+
+ do i=1,XDIM
+ x(i) = (i-1)*2._plflt*M_PI/(XDIM-1)
+ enddo
+ do i=1,YDIM
+ y(i) = (i-1)*3._plflt*M_PI/(YDIM-1)
+ enddo
+
+ do i=1,XDIM
+ do j=1,YDIM
+ r(i,j) = sqrt(x(i)*x(i)+y(j)*y(j))+1e-3
+ z(i,j) = sin(r(i,j)) / (r(i,j))
+ enddo
+ enddo
+
+ call pllab('No, an amplitude clipped ''sombrero''', '', &
+ 'Saturn?')
+ call plptex(2._plflt, 2._plflt, 3._plflt, 4._plflt, 0._plflt, 'Transparent image')
+ call plimage(z, 0._plflt, 2._plflt*M_PI, 0.0_plflt, 3._plflt*M_PI, &
+ 0.05_plflt, 1._plflt, 0._plflt, 2._plflt*M_PI, 0._plflt, 3._plflt*M_PI)
+
+! Save the plot
+ if (f_name .ne. ' ') then
+ call save_plot(f_name)
+ endif
+
+ call pladv(0)
+ endif
+
+!
+! Read Lena image
+! Note we try two different locations to cover the case where this
+! examples is being run from the test_c.sh script
+!
+ if (.not. read_img('lena.pgm', img_f, width, height, num_col)) then
+ if (.not. read_img('../lena.pgm', img_f, width, height, num_col)) then
+!C call plabort('No such file')
+ write(*,*) 'Image could not be read'
+ call plend()
+ stop
+ endif
+ endif
+
+! Set gray colormap
+ call gray_cmap(num_col)
+
+! Display Lena
+ width_r = width
+ height_r = height
+ call plenv(1._plflt, width_r, 1._plflt, height_r, 1, -1)
+
+ if (.not. nointeractive) then
+ call pllab('Set and drag Button 1 to (re)set selection, Butto&
+ &n 2 to finish.',' ','Lena...')
+ else
+ call pllab('',' ','Lena...')
+ endif
+
+ call plimage(img_f, 1._plflt, width_r, 1._plflt, &
+ height_r, 0._plflt, 0._plflt, 1._plflt, width_r, 1._plflt, height_r)
+
+! Selection/expansion demo
+ if (.not. nointeractive) then
+ xi = 200.0_plflt
+ xe = 330.0_plflt
+ yi = 280.0_plflt
+ ye = 220.0_plflt
+
+ if (get_clip(xi, xe, yi, ye)) then
+ call plend()
+ call exit(0)
+ endif
+
+!
+! I'm unable to continue, clearing the plot and advancing to the next
+! one, without hiting the enter key, or pressing the button... help!
+! Forcing the xwin driver to leave locate mode and destroying the
+! xhairs (in GetCursorCmd()) solves some problems, but I still have
+! to press the enter key or press Button-2 to go to next plot, even
+! if a pladv() is not present! Using plbop() solves the problem, but
+! it shouldn't be needed!
+!
+! plspause(0), pladv(0), plspause(1), also works,
+! but the above question remains.
+! With this approach, the previous pause state is lost,
+! as there is no API call to get its current state.
+!
+
+ call plspause(.false.)
+ call pladv(0)
+
+! Display selection only
+ call plimage(img_f, 1._plflt, width_r, 1._plflt, &
+ height_r, 0._plflt, 0._plflt, xi, xe, ye, yi)
+
+ call plspause(.true.)
+ call pladv(0)
+
+! Zoom in selection
+ call plenv(xi, xe, ye, yi, 1, -1)
+ call plimage(img_f, 1._plflt, width_r, 1._plflt, &
+ height_r, 0._plflt, 0._plflt, xi, xe, ye, yi)
+ call pladv(0)
+ endif
+
+ call plend()
+ call exit(0)
+
+ contains
+
+! Read image from file in binary ppm format
+ logical function read_img(fname, img_f, width, height, num_col)
+
+ character(*), intent(in) :: fname
+ integer, intent(out) :: width, height
+ real(kind=plflt), dimension(:,:), pointer :: img_f
+ integer num_col
+
+ character img
+ character*80 ver
+ integer i, j, k, w, h
+
+ integer ierr
+ integer count
+ integer record
+
+! Naive grayscale binary ppm reading. If you know how to, improve it
+
+ open( 10, file = fname, status = 'old', iostat = ierr )
+
+ if (ierr .ne. 0 ) then
+ read_img = .false.
+ return
+ endif
+
+!
+! Read the first lines (count them for later re-reading)
+!
+ count = 1
+ read( 10, '(a)', iostat = ierr ) ver
+
+! I only understand "P5"!
+ if (ver .ne. 'P5' .or. ierr .ne. 0) then
+ read_img = .false.
+ return
+ endif
+
+ do
+ count = count + 1
+ read( 10, '(a)', iostat = ierr ) ver
+
+ if (ierr .ne. 0) then
+ read_img = .false.
+ write(*,*) 'Error!'
+ return
+ endif
+
+ if (ver(1:1) .ne. '#' ) then
+ exit
+ endif
+ enddo
+
+! Found the line with the sizes, copy this one and the next
+
+ open( 11, status = 'scratch' )
+ write( 11, '(a)' ) ver
+
+ count = count + 1
+ read( 10, '(a)', iostat = ierr ) ver
+ write( 11, '(a)' ) ver
+
+ rewind( 11 )
+ read( 11, * ) w, h, num_col
+
+ allocate( img_f(w,h) )
+
+ close( 10 )
+ close( 11 )
+
+!
+! Read the second part - we need to do it the hard way :(
+!
+! Note:
+! The algorithm only works if the unit of record length is a byte!
+! (Some compilers _use_ a word (4 bytes) instead, but often provide
+! a compile switch to _use_ bytes)
+!
+! NOTE: _use_ is used instead of the ordinary word because of a
+! bug in CMake
+!
+ open( 10, file = fname, access = 'direct', recl = 1 )
+
+ record = 0
+ do while ( count > 0 )
+!
+! Look for the end of the line with sizes
+!
+ record = record + 1
+ read( 10, rec = record, iostat = ierr ) img
+
+ if ( img .eq. char(10) ) count = count - 1
+ if ( ierr .ne. 0 ) exit
+ enddo
+
+!
+! We have found the picture bytes!
+! The picture needs to be flipped vertically.
+! So do that rightaway
+!
+!
+ do j = 1,h
+ do i = 1,w
+ record = record + 1
+ read( 10, rec = record ) img
+ img_f(i,h-j+1) = dble(ichar(img))
+ enddo
+ enddo
+
+ width = w
+ height = h
+ read_img = .true.
+
+ end function
+
+! Save plot
+ subroutine save_plot(fname)
+
+ character*(*) fname
+
+ integer cur_strm, new_strm
+
+! Get current stream
+ call plgstrm(cur_strm)
+
+! Create a new one
+ call plmkstrm(new_strm)
+
+! New device type. _Use_ a known existing driver
+ call plsdev('psc')
+ call plsfnam(fname)
+
+! Copy old stream parameters to new stream
+ call plcpstrm(cur_strm, .false.)
+ call plreplot()
+ call plend1()
+
+! Return to previous one
+ call plsstrm(cur_strm)
+
+ end subroutine
+
+! Get selection square interactively
+ logical function get_clip(xi, xe, yi, ye)
+
+ real(kind=plflt) xi, xe, yi, ye
+
+! PLGraphicsIn gin
+ integer gin
+ real(kind=plflt) xxi, yyi, xxe, yye, t
+ logical st, start
+ real(kind=plflt) sx(5), sy(5)
+
+ xxi = xi
+ yyi = yi
+ xxe = xe
+ yye = ye
+ start = .false.
+
+! Enter xor mode to draw a selection rectangle
+ call plxormod(.true., st)
+
+! Driver has xormod capability, continue
+ if (st) then
+ 100 continue
+
+ call plxormod(.false., st)
+!C call plGetCursor(gin)
+ call plxormod(.true., st)
+
+!C if (gin.button == 1) {
+!C xxi = gin.wX
+!C yyi = gin.wY
+ if (start) then
+!C clear previous rectangle
+ call plline(sx, sy)
+ endif
+
+ start = .false.
+
+ sx(1) = xxi
+ sy(1) = yyi
+ sx(5) = xxi
+ sy(5) = yyi
+!C endif
+
+!C if (gin.state & 0x100) then
+!C xxe = gin.wX
+!C yye = gin.wY
+ if (start) then
+! Clear previous rectangle
+ call plline(sx, sy)
+ endif
+ start = .true.
+
+ sx(3) = xxe
+ sy(3) = yye
+ sx(2) = xxe
+ sy(2) = yyi
+ sx(4) = xxi
+ sy(4) = yye
+! Draw new rectangle
+ call plline(sx, sy)
+!C endif
+
+!C if (gin.button == 3 || gin.keysym == PLK_Return || gin.keysym == 'Q') then
+ if (start) then
+! Clear previous rectangle
+ call plline(sx, sy)
+ goto 110
+ endif
+!C endif
+
+ 110 continue
+! Leave xor mode
+ call plxormod(.false., st)
+
+ if (xxe .lt. xxi) then
+ t = xxi
+ xxi = xxe
+ xxe = t
+ endif
+
+ if (yyi .lt. yye) then
+ t = yyi
+ yyi = yye
+ yye = t
+ endif
+
+ xe = xxe
+ xi = xxi
+ ye = yye
+ yi = yyi
+
+!C get_clip = gin.keysym == 'Q'
+ else
+! driver has no xormod capability, just do nothing
+ get_clip = .false.
+ return
+ endif
+
+ end function
+
+! Set gray colormap
+ subroutine gray_cmap(num_col)
+
+ integer num_col
+ real(kind=plflt) r(2), g(2), b(2), pos(2)
+ logical rev(2)
+
+ r(1) = 0.0
+ g(1) = 0.0
+ b(1) = 0.0
+ r(2) = 1.0
+ g(2) = 1.0
+ b(2) = 1.0
+
+ pos(1) = 0.0
+ pos(2) = 1.0
+ rev(1) = .false.
+ rev(2) = .false.
+
+ call plscmap1n(num_col)
+ call plscmap1l(.true., pos, r, g, b, rev)
+
+ end subroutine
+
+ end program
Property changes on: trunk/examples/f95/x20f.f90
___________________________________________________________________
Name: svn:executable
+ *
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|