Menu
▾
▴
[Plplot-cvs] SF.net SVN: plplot:[12380] trunk
|
From: <and...@us...> - 2013-06-12 20:53:21
|
Revision: 12380
http://sourceforge.net/p/plplot/code/12380
Author: andrewross
Date: 2013-06-12 20:53:18 +0000 (Wed, 12 Jun 2013)
Log Message:
-----------
Update f95 bindings to fix plcolorbar, plscmap1_range, plgcmap1_range. Update example 16 and 33 in line with C versions.
Modified Paths:
--------------
trunk/bindings/f95/plplot_parameters.h
trunk/bindings/f95/plstubs.h
trunk/bindings/f95/scstubs.c
trunk/bindings/f95/sfstubsf95.f90
trunk/examples/f95/x16f.f90
trunk/examples/f95/x33f.f90
Modified: trunk/bindings/f95/plplot_parameters.h
===================================================================
--- trunk/bindings/f95/plplot_parameters.h 2013-06-12 19:27:26 UTC (rev 12379)
+++ trunk/bindings/f95/plplot_parameters.h 2013-06-12 20:53:18 UTC (rev 12380)
@@ -81,9 +81,16 @@
integer, parameter :: PL_COLORBAR_IMAGE = 16
integer, parameter :: PL_COLORBAR_SHADE = 32
integer, parameter :: PL_COLORBAR_GRADIENT = 64
- integer, parameter :: PL_COLORBAR_CAP_LOW = 128
- integer, parameter :: PL_COLORBAR_CAP_HIGH = 256
- integer, parameter :: PL_COLORBAR_SHADE_LABEL = 512
+ integer, parameter :: PL_COLORBAR_CAP_NONE = 128
+ integer, parameter :: PL_COLORBAR_CAP_LOW = 256
+ integer, parameter :: PL_COLORBAR_CAP_HIGH = 512
+ integer, parameter :: PL_COLORBAR_SHADE_LABEL = 1024
+ integer, parameter :: PL_COLORBAR_ORIENT_RIGHT = 2048
+ integer, parameter :: PL_COLORBAR_ORIENT_TOP = 4096
+ integer, parameter :: PL_COLORBAR_ORIENT_LEFT = 8192
+ integer, parameter :: PL_COLORBAR_ORIENT_BOTTOM = 16384
+ integer, parameter :: PL_COLORBAR_BACKGROUND = 32768
+ integer, parameter :: PL_COLORBAR_BOUNDING_BOX = 65536
integer, parameter :: PLSWIN_DEVICE = 1 ! device coordinates
integer, parameter :: PLSWIN_WORLD = 2 ! world coordinates
integer, parameter :: PL_X_AXIS = 1 ! The x-axis
Modified: trunk/bindings/f95/plstubs.h
===================================================================
--- trunk/bindings/f95/plstubs.h 2013-06-12 19:27:26 UTC (rev 12379)
+++ trunk/bindings/f95/plstubs.h 2013-06-12 20:53:18 UTC (rev 12380)
@@ -185,6 +185,8 @@
#define PLCLR FNAME( PLCLR, plclr )
#define PLCOL0 FNAME( PLCOL0, plcol0 )
#define PLCOL1 FNAME( PLCOL1, plcol1 )
+#define PLCOLORBAR_CNV_TEXT FNAME( PLCOLORBAR07_CNV_TEXT, plcolorbar07_cnv_text )
+#define PLCOLORBAR FNAME( PLCOLORBAR07, plcolorbar07 )
#define PLCONFIGTIME FNAME( PLCONFIGTIME, plconfigtime )
#define PLCON07 FNAME( PLCON07, plcon07 )
#define PLCON17 FNAME( PLCON17, plcon17 )
@@ -206,6 +208,7 @@
#define PLFONT FNAME( PLFONT, plfont )
#define PLFONTLD FNAME( PLFONTLD, plfontld )
#define PLGCHR FNAME( PLGCHR, plgchr )
+#define PLGCMAP1_RANGE FNAME( PLFCMAP1_RANGE, plgcmap1_range )
#define PLGCOL0 FNAME( PLGCOL0, plgcol0 )
#define PLGCOL0A FNAME( PLGCOL0A, plgcol0a )
#define PLGCOLBG FNAME( PLGCOLBG, plgcolbg )
@@ -290,6 +293,7 @@
#define PLSCMAP1LA FNAME( PLSCMAP1LAF77, plscmap1laf77 )
#define PLSCMAP1LA2 FNAME( PLSCMAP1LA2F77, plscmap1la2f77 )
#define PLSCMAP1N FNAME( PLSCMAP1N, plscmap1n )
+#define PLSCMAP1_RANGE FNAME( PLSCMAP1_RANGE, plscmap1_range )
#define PLSCOL0 FNAME( PLSCOL0, plscol0 )
#define PLSCOL0A FNAME( PLSCOL0A, plscol0a )
#define PLSCOLBG FNAME( PLSCOLBG, plscolbg )
Modified: trunk/bindings/f95/scstubs.c
===================================================================
--- trunk/bindings/f95/scstubs.c 2013-06-12 19:27:26 UTC (rev 12379)
+++ trunk/bindings/f95/scstubs.c 2013-06-12 20:53:18 UTC (rev 12380)
@@ -47,6 +47,8 @@
static char **pllegend_text;
static char **pllegend_symbols;
+static char **plcolorbar_labels;
+static char **plcolorbar_axisopts;
// Function prototypes
static void pltransformf2c( PLFLT x, PLFLT y, PLFLT *tx, PLFLT *ty, PLPointer data );
@@ -72,6 +74,16 @@
void PLCLEAR( void );
void PLCOL0( PLINT *icol );
void PLCOL1( PLFLT *col );
+void PLCOLORBAR(PLFLT *p_colorbar_width, PLFLT *p_colorbar_height,
+ PLINT *opt, PLINT *position, PLFLT *x, PLFLT *y,
+ PLFLT *x_length, PLFLT *y_length,
+ PLINT *bg_color, PLINT *bb_color, PLINT *bb_style,
+ PLFLT *low_cap_color, PLFLT *high_cap_color,
+ PLINT *cont_color, PLFLT *cont_width,
+ PLINT *n_labels, const PLINT *label_opts,
+ PLINT *n_axes,
+ const PLFLT *ticks, const PLINT *sub_ticks,
+ const PLINT *n_values, const PLFLT *values);
void PLCONFIGTIME( PLFLT *scale, PLFLT *offset1, PLFLT *offset2, PLINT *ccontrol, PLBOOL *ifbtime_offset, PLINT *year, PLINT *month, PLINT *day, PLINT *hour, PLINT *min, PLFLT *sec );
void PLCPSTRM( PLINT *iplsr, PLBOOL *flags );
void PLCTIME( PLINT *year, PLINT *month, PLINT *day, PLINT *hour, PLINT *min, PLFLT *sec, PLFLT *ctime );
@@ -385,6 +397,53 @@
}
void
+PLCOLORBAR( PLFLT *p_colorbar_width, PLFLT *p_colorbar_height,
+ PLINT *opt, PLINT *position, PLFLT *x, PLFLT *y,
+ PLFLT *x_length, PLFLT *y_length,
+ PLINT *bg_color, PLINT *bb_color, PLINT *bb_style,
+ PLFLT *low_cap_color, PLFLT *high_cap_color,
+ PLINT *cont_color, PLFLT *cont_width,
+ PLINT *n_labels, const PLINT *label_opts,
+ PLINT *n_axes,
+ const PLFLT *ticks, const PLINT *sub_ticks,
+ const PLINT *n_values, const PLFLT *values )
+{
+ // Need to allocate 2d C array for values
+ PLFLT **a;
+ int i,j;
+
+ a = (PLFLT **) malloc( sizeof(PLFLT *) * (*n_axes) );
+ for (i=0;i<*n_axes;i++)
+ {
+ a[i] = (PLFLT *) malloc( sizeof(PLFLT)*n_values[i] );
+ for (j=0;j<n_values[i];j++)
+ {
+ a[i][j] = values[i + j * (*n_axes)];
+ }
+ }
+
+ c_plcolorbar(p_colorbar_width, p_colorbar_height,
+ *opt, *position, *x, *y,
+ *x_length, *y_length,
+ *bg_color, *bb_color, *bb_style,
+ *low_cap_color, *high_cap_color,
+ *cont_color, *cont_width,
+ *n_labels, label_opts, (const char * const *) plcolorbar_labels,
+ *n_axes, (const char * const *) plcolorbar_axisopts,
+ ticks, sub_ticks,
+ n_values, (const PLFLT * const *)a);
+ free( *plcolorbar_labels );
+ free( plcolorbar_labels );
+ free( *plcolorbar_axisopts );
+ free( plcolorbar_axisopts );
+ for (i=0;i<*n_axes;i++)
+ {
+ free(a[i]);
+ }
+ free(a);
+}
+
+void
PLCONFIGTIME( PLFLT *scale, PLFLT *offset1, PLFLT *offset2, PLINT *ccontrol, PLBOOL *ifbtime_offset, PLINT *year, PLINT *month, PLINT *day, PLINT *hour, PLINT *min, PLFLT *sec )
{
c_plconfigtime( *scale, *offset1, *offset2, *ccontrol, *ifbtime_offset, *year, *month, *day, *hour, *min, *sec );
@@ -489,6 +548,12 @@
}
void
+PLGCMAP1_RANGE( PLFLT *min_color, PLFLT *max_color )
+{
+ c_plgcmap1_range( min_color, max_color );
+}
+
+void
PLGCOL0( PLINT *icol0, PLINT *r, PLINT *g, PLINT *b )
{
c_plgcol0( *icol0, r, g, b );
@@ -796,14 +861,25 @@
p_string[j][i + 1] = '\0';
}
- if ( *id == 1 )
- {
- pllegend_text = p_string;
+ switch( *id ) {
+ case 1:
+ pllegend_text = p_string;
+ break;
+ case 2:
+ pllegend_symbols = p_string;
+ break;
+ case 3:
+ plcolorbar_labels = p_string;
+ break;
+ case 4:
+ plcolorbar_axisopts = p_string;
+ break;
+ default:
+ // Unknown
+ free(data);
+ free(p_string);
+ break;
}
- else
- {
- pllegend_symbols = p_string;
- }
}
void PLLEGEND(
@@ -1090,6 +1166,12 @@
}
void
+PLSCMAP1_RANGE( PLFLT *min_color, PLFLT *max_color )
+{
+ c_plscmap1_range( *min_color, *max_color );
+}
+
+void
PLSCOL0( PLINT *icol0, PLINT *r, PLINT *g, PLINT *b )
{
c_plscol0( *icol0, *r, *g, *b );
Modified: trunk/bindings/f95/sfstubsf95.f90
===================================================================
--- trunk/bindings/f95/sfstubsf95.f90 2013-06-12 19:27:26 UTC (rev 12379)
+++ trunk/bindings/f95/sfstubsf95.f90 2013-06-12 20:53:18 UTC (rev 12380)
@@ -202,6 +202,11 @@
end subroutine plcol1
end interface
+ interface plcolorbar
+ module procedure plcolorbar_1
+ module procedure plcolorbar_2
+ end interface
+
interface plcpstrm
module procedure plcpstrm
end interface
@@ -275,6 +280,13 @@
end interface
interface
+ subroutine plgcmap1_range( min_color, max_color )
+ use plplot_flt
+ real(kind=plflt) :: min_color, max_color
+ end subroutine plgcmap1_range
+ end interface
+
+ interface
subroutine plgcol0( icol, r, g, b )
integer :: icol, r, g, b
end subroutine plgcol0
@@ -618,6 +630,13 @@
end interface
interface
+ subroutine plscmap1_range( min_color, max_color )
+ use plplot_flt
+ real(kind=plflt) :: min_color, max_color
+ end subroutine plscmap1_range
+ end interface
+
+ interface
subroutine plscol0( icol, r, g, b )
integer :: icol, r, g, b
end subroutine plscol0
@@ -989,6 +1008,80 @@
call plbinf77( size(x), x, y, center )
end subroutine plbin
+ subroutine plcolorbar_1( p_colorbar_width, p_colorbar_height, &
+ opt, position, x, y, &
+ x_length, y_length, &
+ bg_color, bb_color, bb_style, &
+ low_cap_color, high_cap_color, &
+ cont_color, cont_width, &
+ n_labels, label_opts, labels, &
+ n_axes, axis_opts, ticks, sub_ticks, &
+ n_values, values)
+ real (kind=plflt) :: p_colorbar_width, p_colorbar_height
+ integer :: opt, position, bg_color, bb_color, bb_style, cont_color
+ integer :: n_labels, n_axes
+ real (kind=plflt) :: x, y, x_length, y_length, low_cap_color, high_cap_color, cont_width
+ integer, dimension(:) :: label_opts, sub_ticks, n_values
+ real (kind=plflt), dimension(:) :: ticks
+ real (kind=plflt), dimension(:,:) :: values
+ character(len=*), dimension(:) :: labels, axis_opts
+
+ !
+ ! Convert the text arrays and store the results in a convenient
+ ! albeit global location. This way we avoid all manner of complications.
+ ! (Though introducing a potentially nasty one: non-threadsafety)
+ !
+ call pllegend07_cnv_text( 3, n_labels, labels )
+ call pllegend07_cnv_text( 4, n_axes, axis_opts )
+
+ call plcolorbar07(p_colorbar_width, p_colorbar_height, &
+ opt, position, x, y, &
+ x_length, y_length, &
+ bg_color, bb_color, bb_style, &
+ low_cap_color, high_cap_color, &
+ cont_color, cont_width, &
+ n_labels, label_opts, n_axes, ticks, sub_ticks, &
+ n_values, values)
+ end subroutine plcolorbar_1
+
+ subroutine plcolorbar_2( p_colorbar_width, p_colorbar_height, &
+ opt, position, x, y, &
+ x_length, y_length, &
+ bg_color, bb_color, bb_style, &
+ low_cap_color, high_cap_color, &
+ cont_color, cont_width, &
+ label_opts, labels, axis_opts, ticks, sub_ticks, &
+ n_values, values)
+ real (kind=plflt) :: p_colorbar_width, p_colorbar_height
+ integer :: opt, position, bg_color, bb_color, bb_style, cont_color
+ real (kind=plflt) :: x, y, x_length, y_length, low_cap_color, high_cap_color, cont_width
+ integer, dimension(:) :: label_opts, sub_ticks, n_values
+ real (kind=plflt), dimension(:) :: ticks
+ real (kind=plflt), dimension(:,:) :: values
+ character(len=*), dimension(:) :: labels, axis_opts
+
+ integer :: n_labels, n_axes
+
+ n_labels = size(label_opts,1)
+ n_axes = size(axis_opts,1)
+ !
+ ! Convert the text arrays and store the results in a convenient
+ ! albeit global location. This way we avoid all manner of complications.
+ ! (Though introducing a potentially nasty one: non-threadsafety)
+ !
+ call pllegend07_cnv_text( 3, n_labels, labels )
+ call pllegend07_cnv_text( 4, n_axes, axis_opts )
+
+ call plcolorbar07(p_colorbar_width, p_colorbar_height, &
+ opt, position, x, y, &
+ x_length, y_length, &
+ bg_color, bb_color, bb_style, &
+ low_cap_color, high_cap_color, &
+ cont_color, cont_width, &
+ n_labels, label_opts, n_axes, ticks, sub_ticks, &
+ n_values, values)
+ end subroutine plcolorbar_2
+
subroutine plcpstrm( iplsr, flags )
integer :: iplsr
logical :: flags
Modified: trunk/examples/f95/x16f.f90
===================================================================
--- trunk/examples/f95/x16f.f90 2013-06-12 19:27:26 UTC (rev 12379)
+++ trunk/examples/f95/x16f.f90 2013-06-12 20:53:18 UTC (rev 12380)
@@ -35,6 +35,17 @@
px(PERIMETERPTS), py(PERIMETERPTS)
integer cont_color
real(kind=plflt) fill_width, cont_width
+ real(kind=plflt) colorbar_width, colorbar_height
+ integer NUM_AXES, NUM_LABELS
+ parameter(NUM_AXES=1, NUM_LABELS=1)
+ character(len=20) :: axis_opts(NUM_AXES)
+ integer num_values(NUM_AXES)
+ real(kind=plflt) values(NUM_AXES,NLEVEL+1)
+ real(kind=plflt) axis_ticks(NUM_AXES)
+ integer axis_subticks(NUM_AXES)
+ character(len=100) :: labels(NUM_LABELS)
+ integer label_opts(NUM_LABELS)
+
integer i, j
! dummy to fill argument list with something not currently used.
character(len=1) defined
@@ -114,11 +125,40 @@
fill_width = 2
cont_color = 0
cont_width = 0
+ axis_opts(1) = 'bcvtm'
+ axis_ticks(1) = 0.0_plflt
+ axis_subticks(1) = 0
+ label_opts(1) = PL_COLORBAR_LABEL_BOTTOM
+ labels(1) = 'Magnitude'
+
call plshades(z(:NX,:NY), defined, -1._plflt, 1._plflt, -1._plflt, &
1._plflt, &
shedge, fill_width, &
cont_color, cont_width )
+ ! Smaller text
+ call plschr( 0.0_plflt, 0.75_plflt )
+ ! Small ticks on the vertical axis
+ call plsmaj( 0.0_plflt, 0.5_plflt )
+ call plsmin( 0.0_plflt, 0.5_plflt )
+
+ num_values(1) = NLEVEL + 1;
+ values(1,:) = shedge;
+ call plcolorbar( colorbar_width, colorbar_height, &
+ ior(PL_COLORBAR_SHADE, PL_COLORBAR_SHADE_LABEL), 0, &
+ 0.005_plflt, 0.0_plflt, 0.0375_plflt, 0.875_plflt, 0, 1, 1, &
+ 0.0_plflt, 0.0_plflt, &
+ cont_color, cont_width, &
+ label_opts, labels, &
+ axis_opts, &
+ axis_ticks, axis_subticks, &
+ num_values, values )
+
+ ! Reset text and tick sizes
+ call plschr( 0.0_plflt, 1.0_plflt )
+ call plsmaj( 0.0_plflt, 1.0_plflt )
+ call plsmin( 0.0_plflt, 1.0_plflt )
+
call plcol0(1)
call plbox('bcnst', 0.0_plflt, 0, 'bcnstv', 0.0_plflt, 0)
call plcol0(2)
@@ -144,6 +184,29 @@
shedge, fill_width, &
cont_color, cont_width, xg1(:NX), yg1(:NY))
+ ! Smaller text
+ call plschr( 0.0_plflt, 0.75_plflt )
+ ! Small ticks on the vertical axis
+ call plsmaj( 0.0_plflt, 0.5_plflt )
+ call plsmin( 0.0_plflt, 0.5_plflt )
+
+ num_values(1) = NLEVEL + 1;
+ values(1,:) = shedge;
+ call plcolorbar( colorbar_width, colorbar_height, &
+ ior(PL_COLORBAR_SHADE, PL_COLORBAR_SHADE_LABEL), 0, &
+ 0.005_plflt, 0.0_plflt, 0.0375_plflt, 0.875_plflt, 0, 1, 1, &
+ 0.0_plflt, 0.0_plflt, &
+ cont_color, cont_width, &
+ label_opts, labels, &
+ axis_opts, &
+ axis_ticks, axis_subticks, &
+ num_values, values )
+
+ ! Reset text and tick sizes
+ call plschr( 0.0_plflt, 1.0_plflt )
+ call plsmaj( 0.0_plflt, 1.0_plflt )
+ call plsmin( 0.0_plflt, 1.0_plflt )
+
call plcol0(1)
call plbox('bcnst', 0.0_plflt, 0, 'bcnstv', 0.0_plflt, 0)
call plcol0(2)
@@ -169,6 +232,29 @@
shedge, fill_width, &
cont_color, cont_width, xg2(:NX,:NY), yg2(:NX,:NY) )
+ ! Smaller text
+ call plschr( 0.0_plflt, 0.75_plflt )
+ ! Small ticks on the vertical axis
+ call plsmaj( 0.0_plflt, 0.5_plflt )
+ call plsmin( 0.0_plflt, 0.5_plflt )
+
+ num_values(1) = NLEVEL + 1;
+ values(1,:) = shedge;
+ call plcolorbar( colorbar_width, colorbar_height, &
+ ior(PL_COLORBAR_SHADE, PL_COLORBAR_SHADE_LABEL), 0, &
+ 0.005_plflt, 0.0_plflt, 0.0375_plflt, 0.875_plflt, 0, 1, 1, &
+ 0.0_plflt, 0.0_plflt, &
+ cont_color, cont_width, &
+ label_opts, labels, &
+ axis_opts, &
+ axis_ticks, axis_subticks, &
+ num_values, values )
+
+ ! Reset text and tick sizes
+ call plschr( 0.0_plflt, 1.0_plflt )
+ call plsmaj( 0.0_plflt, 1.0_plflt )
+ call plsmin( 0.0_plflt, 1.0_plflt )
+
call plcol0(1)
call plbox('bcnst', 0.0_plflt, 0, 'bcnstv', 0.0_plflt, 0)
call plcol0(2)
@@ -195,6 +281,29 @@
shedge, fill_width, &
cont_color, cont_width, xg2(:NX,:NY), yg2(:NX,:NY) )
+ ! Smaller text
+ call plschr( 0.0_plflt, 0.75_plflt )
+ ! Small ticks on the vertical axis
+ call plsmaj( 0.0_plflt, 0.5_plflt )
+ call plsmin( 0.0_plflt, 0.5_plflt )
+
+ num_values(1) = NLEVEL + 1;
+ values(1,:) = shedge;
+ call plcolorbar( colorbar_width, colorbar_height, &
+ ior(PL_COLORBAR_SHADE, PL_COLORBAR_SHADE_LABEL), 0, &
+ 0.005_plflt, 0.0_plflt, 0.0375_plflt, 0.875_plflt, 0, 1, 1, &
+ 0.0_plflt, 0.0_plflt, &
+ 2, 3._plflt, &
+ label_opts, labels, &
+ axis_opts, &
+ axis_ticks, axis_subticks, &
+ num_values, values )
+
+ ! Reset text and tick sizes
+ call plschr( 0.0_plflt, 1.0_plflt )
+ call plsmaj( 0.0_plflt, 1.0_plflt )
+ call plsmin( 0.0_plflt, 1.0_plflt )
+
call plcol0(1)
call plbox('bcnst', 0.0_plflt, 0, 'bcnstv', 0.0_plflt, 0)
call plcol0(2)
@@ -237,6 +346,29 @@
shedge, fill_width, &
cont_color, cont_width, xg2(:NX,:NY), yg2(:NX,:NY) )
+ ! Smaller text
+ call plschr( 0.0_plflt, 0.75_plflt )
+ ! Small ticks on the vertical axis
+ call plsmaj( 0.0_plflt, 0.5_plflt )
+ call plsmin( 0.0_plflt, 0.5_plflt )
+
+ num_values(1) = NLEVEL + 1;
+ values(1,:) = shedge;
+ call plcolorbar( colorbar_width, colorbar_height, &
+ ior(PL_COLORBAR_SHADE, PL_COLORBAR_SHADE_LABEL), 0, &
+ 0.005_plflt, 0.0_plflt, 0.0375_plflt, 0.875_plflt, 0, 1, 1, &
+ 0.0_plflt, 0.0_plflt, &
+ cont_color, cont_width, &
+ label_opts, labels, &
+ axis_opts, &
+ axis_ticks, axis_subticks, &
+ num_values, values )
+
+ ! Reset text and tick sizes
+ call plschr( 0.0_plflt, 1.0_plflt )
+ call plsmaj( 0.0_plflt, 1.0_plflt )
+ call plsmin( 0.0_plflt, 1.0_plflt )
+
! Now we can draw the perimeter. (If do before, shade stuff may overlap.)
do i = 1, PERIMETERPTS
t = (2._plflt*PI/dble(PERIMETERPTS-1))*dble(i-1)
Modified: trunk/examples/f95/x33f.f90
===================================================================
--- trunk/examples/f95/x33f.f90 2013-06-12 19:27:26 UTC (rev 12379)
+++ trunk/examples/f95/x33f.f90 2013-06-12 20:53:18 UTC (rev 12380)
@@ -70,7 +70,22 @@
real(kind=plflt) :: values_uneven(9)
real(kind=plflt) :: values_even(9)
+ integer, parameter :: COLORBAR_KINDS = 4
+ integer :: colorbar_option_kinds(COLORBAR_KINDS)
+ character(len=100) :: colorbar_option_kind_labels(COLORBAR_KINDS)
+ integer, parameter :: COLORBAR_POSITIONS = 4
+ integer :: colorbar_position_options(COLORBAR_POSITIONS)
+ character(len=100) :: colorbar_position_option_labels(COLORBAR_POSITIONS)
+
+ integer, parameter :: COLORBAR_LABELS = 4
+ integer :: colorbar_label_options(COLORBAR_LABELS)
+ character(len=100) :: colorbar_label_option_labels(COLORBAR_LABELS)
+
+ integer, parameter :: COLORBAR_CAPS = 4
+ integer :: colorbar_cap_options(COLORBAR_CAPS)
+ character(len=100) :: colorbar_cap_option_labels(COLORBAR_CAPS)
+
! Pick 5 arbitrary UTF-8 symbols useful for plotting points (✠✚✱✪✽✺✰✴✦).
data special_symbols / &
'✰', &
@@ -79,11 +94,15 @@
'✽', &
'✦' /
- data values_small / 0.0_plflt, 1.0_plflt /
+ data values_small / -1.0e-200_plflt, 1.0e-200_plflt /
data values_uneven &
- / 0.0_plflt, 2.0_plflt, 2.6_plflt, 3.4_plflt, 6.0_plflt, 7.0_plflt, 8.0_plflt, 9.0_plflt, 10.0_plflt /
+ / -1.0e-200_plflt, 2.0e-200_plflt, 2.6e-200_plflt, 3.4e-200_plflt, &
+ 6.0e-200_plflt, 7.0e-200_plflt, 8.0e-200_plflt, 9.0e-200_plflt, &
+ 10.0e-200_plflt /
data values_even &
- / 0.0_plflt, 1.0_plflt, 2.0_plflt, 3.0_plflt, 4.0_plflt, 5.0_plflt, 6.0_plflt, 7.0_plflt, 8.0_plflt /
+ / -2.0e-200_plflt, -1.0e-200_plflt, 0.0e-200_plflt, 1.0e-200_plflt, &
+ 2.0e-200_plflt, 3.0e-200_plflt, 4.0e-200_plflt, 5.0e-200_plflt, &
+ 6.0e-200_plflt /
position_options(1) = PL_POSITION_LEFT + PL_POSITION_TOP + PL_POSITION_OUTSIDE
position_options(2) = PL_POSITION_TOP + PL_POSITION_OUTSIDE
@@ -102,6 +121,52 @@
position_options(15) = PL_POSITION_LEFT + PL_POSITION_BOTTOM + PL_POSITION_INSIDE
position_options(16) = PL_POSITION_LEFT + PL_POSITION_INSIDE
+ ! plcolorbar options
+
+ ! Colorbar type options
+ colorbar_option_kinds(1) = PL_COLORBAR_SHADE
+ colorbar_option_kinds(2) = PL_COLORBAR_SHADE + PL_COLORBAR_SHADE_LABEL
+ colorbar_option_kinds(3) = PL_COLORBAR_IMAGE
+ colorbar_option_kinds(4) = PL_COLORBAR_GRADIENT
+
+ colorbar_option_kind_labels(1) = "Shade colorbars"
+ colorbar_option_kind_labels(2) = "Shade colorbars with custom labels"
+ colorbar_option_kind_labels(3) = "Image colorbars"
+ colorbar_option_kind_labels(4) = "Gradient colorbars"
+
+ ! Which side of the page are we positioned relative to?
+ colorbar_position_options(1) = PL_POSITION_LEFT
+ colorbar_position_options(2) = PL_POSITION_RIGHT
+ colorbar_position_options(3) = PL_POSITION_TOP
+ colorbar_position_options(4) = PL_POSITION_BOTTOM
+
+ colorbar_position_option_labels(1) = "Left"
+ colorbar_position_option_labels(2) = "Right"
+ colorbar_position_option_labels(3) = "Top"
+ colorbar_position_option_labels(4) = "Bottom"
+
+ ! Colorbar label positioning options
+ colorbar_label_options(1) = PL_COLORBAR_LABEL_LEFT
+ colorbar_label_options(2) = PL_COLORBAR_LABEL_RIGHT
+ colorbar_label_options(3) = PL_COLORBAR_LABEL_TOP
+ colorbar_label_options(4) = PL_COLORBAR_LABEL_BOTTOM
+
+ colorbar_label_option_labels(1) = "Label left"
+ colorbar_label_option_labels(2) = "Label right"
+ colorbar_label_option_labels(3) = "Label top"
+ colorbar_label_option_labels(4) = "Label bottom"
+
+ ! Colorbar cap options
+ colorbar_cap_options(1) = PL_COLORBAR_CAP_NONE
+ colorbar_cap_options(2) = PL_COLORBAR_CAP_LOW
+ colorbar_cap_options(3) = PL_COLORBAR_CAP_HIGH
+ colorbar_cap_options(4) = PL_COLORBAR_CAP_LOW + PL_COLORBAR_CAP_HIGH
+
+ colorbar_cap_option_labels(1) = "No caps"
+ colorbar_cap_option_labels(2) = "Low cap"
+ colorbar_cap_option_labels(3) = "High cap"
+ colorbar_cap_option_labels(4) = "Low and high caps"
+
! Parse and process command line arguments
call plparseopts(PL_PARSE_FULL)
@@ -644,186 +709,165 @@
! Color bar examples
-!
-! Note: commented until plcolorbar is ready!
-!
-! call plcolorbar_example_1( PL_COLORBAR_IMAGE, 0.0_plflt, 0, 2,
-! & values_small, 'Image Color Bars' )
-! call plcolorbar_example_1(
-! & PL_COLORBAR_SHADE + PL_COLORBAR_SHADE_LABEL,
-! & 0.0_plflt, 0, 9, values_uneven,
-! & 'Shade Color Bars - Uneven Steps' )
-! call plcolorbar_example_2( PL_COLORBAR_SHADE, 3.0_plflt, 3, 9,
-! & values_even, 'Shade Color Bars - Even Steps' )
-! call plcolorbar_example_1( PL_COLORBAR_GRADIENT, 0.5_plflt, 5, 2,
-! & values_small, 'Gradient Color Bars' )
-! call plcolorbar_example_2( PL_COLORBAR_GRADIENT, 0.5_plflt, 5, 2,
-! & values_small, 'Gradient Color Bars' )
+ ! Use unsaturated green background colour to contrast with black caps.
+ call plscolbg( 70, 185, 70 )
+ ! Cut out the greatest and smallest bits of the color spectrum to
+ ! leave colors for the end caps.
+ call plscmap1_range( 0.01_plflt, 0.99_plflt )
+ ! We can only test image and gradient colorbars with two element arrays
+ do i = 2,COLORBAR_KINDS-1
+ call plcolorbar_example( "cmap1_blue_yellow.pal", i, 0, 0._plflt, 2, values_small )
+ enddo
+ ! Test shade colorbars with larger arrays
+ do i = 0,1
+ call plcolorbar_example( "cmap1_blue_yellow.pal", i, 4, 2._plflt, 9, values_even )
+ enddo
+ do i = 0,1
+ call plcolorbar_example( "cmap1_blue_yellow.pal", i, 0, 0._plflt, 9, values_uneven )
+ enddo
+
call plend()
-! contains
+ contains
+ subroutine plcolorbar_example_page( kind_i, label_i, cap_i, cont_color, cont_width, n_values, values )
-! Color bar routines
-!
-! subroutine plcolorbar_example_1( bar_type, ticks, sub_ticks, n,
-! & values, title )
-!
-! integer bar_type, position
-! real(kind=plflt) ticks
-! integer sub_ticks
-! integer n
-! real(kind=plflt) values(*)
-! character(*) title
-!
-!
-! FORTRAN 77: array fixed
-!
-! real(kind=plflt) colors(20)
-! real(kind=plflt) color_step
-! integer i
-! integer opt
-! character(10) axis_opts_1, axis_opts_2
-!
-! call pladv( 0 )
-!
-! Setup color palette 1
-! call plspal1( 'cmap1_blue_red.pal', 1 )
-!
-! color_step = 1.0_plflt / ( n - 1 )
-! do 110 i = 1,n
-! colors(i) = 0.0_plflt + color_step * i
-! 110 continue
-!
-! position = PL_POSITION_LEFT
-! opt = bar_type + PL_COLORBAR_LABEL_LEFT +
-! & PL_COLORBAR_CAP_HIGH
-!
-! if ( mod( bar_type, 2*PL_COLORBAR_SHADE_LABEL ) /
-! & PL_COLORBAR_SHADE_LABEL .eq. 1 ) then
-! axis_opts_1 = 'iv'
-! axis_opts_2 = 'i'
-! else
-! axis_opts_1 = 'stv'
-! axis_opts_2 = 'st'
-! else
-! axis_opts_1 = 'tv'
-! axis_opts_2 = 't'
-! endif
-! endif
-!
-! call plcolorbar( opt, 0.1_plflt, 0.1_plflt, 0.5_plflt, 0.1_plflt,
-! & ticks, sub_ticks,
-! & axis_opts_1, 'Test label - Left, High Cap',
-!
-! position = PL_POSITION_RIGHT
-! opt = bar_type + PL_COLORBAR_LABEL_RIGHT +
-! & PL_COLORBAR_CAP_LOW
-!
-! call plcolorbar( opt, 0.1_plflt, 0.4_plflt, 0.5_plflt, 0.1_plflt,
-! & ticks, sub_ticks,
-! & n, colors, values )
-!
-! position = PL_POSITION_TOP
-! opt = bar_type + PL_COLORBAR_LABEL_TOP +
-! & PL_COLORBAR_CAP_HIGH
-!
-! call plcolorbar( opt, 0.1_plflt, 0.1_plflt, 0.5_plflt, 0.1_plflt,
-! & ticks, sub_ticks,
-! & axis_opts_2, 'Test label - Upper, High Cap',
-! & n, colors, values )
-!
-! position = PL_POSITION_TOP
-! opt = bar_type + PL_COLORBAR_LABEL_BOTTOM +
-! & PL_COLORBAR_CAP_LOW
-!
-! call plcolorbar( opt, 0.4_plflt, 0.1_plflt, 0.5_plflt, 0.1_plflt,
-! & ticks, sub_ticks,
-! & axis_opts_2, 'Test label - Lower, Low Cap',
-! & n, colors, values )
-!
-! call plvpor( 0.0_plflt, 1.0_plflt, 0.0_plflt, 1.0_plflt )
-! call plwind( 0.0_plflt, 1.0_plflt, 0.0_plflt, 1.0_plflt )
-! call plptex( 0.5_plflt, 0.5_plflt, 0.0_plflt, 0.0_plflt, 0.5_plflt, title )
-! end
-!
-! subroutine plcolorbar_example_2( bar_type, ticks, sub_ticks, n,
-! & values, title )
-!
-! integer bar_type, position
-! real(kind=plflt) ticks
-! integer sub_ticks
-! integer n
-! real(kind=plflt) values(*)
-! character(*) title
-!
-! real(kind=plflt) colors(20)
-! integer i
-! real(kind=plflt) color_step
-! integer opt
-! character(10) axis_opts_1, axis_opts_2
-!
-! call pladv( 0 )
-! Setup color palette 1
-! call plspal1( 'cmap1_blue_yellow.pal', 1 )
-!
-! color_step = 1.0_plflt / ( n - 1 )
-! do 110 i = 1,n
-! colors(i) = 0.0_plflt + color_step * i
-! 110 continue
-!
-! position = PL_POSITION_LEFT
-! opt = bar_type + PL_COLORBAR_LABEL_LEFT +
-! & PL_COLORBAR_CAP_LOW
-!
-! if ( bar_type .eq. PL_COLORBAR_SHADE_LABEL ) then
-! axis_opts_1 = ''
-! axis_opts_2 = ''
-! else
-! if ( sub_ticks .ne. 0 ) then
-! axis_opts_1 = 'stv'
-! axis_opts_2 = 'st'
-! else
-! axis_opts_1 = 'tv'
-! axis_opts_2 = 't'
-! endif
-! endif
-!
-! call plcolorbar( opt, 0.1_plflt, 0.1_plflt, 0.5_plflt, 0.1_plflt,
-! & ticks, sub_ticks,
-! & axis_opts_1, 'Test label - Left, Low Cap',
-! & n, colors, values )
-!
-! position = PL_POSITION_RIGHT
-! opt = bar_type + PL_COLORBAR_LABEL_RIGHT +
-! & PL_COLORBAR_CAP_HIGH
-!
-! call plcolorbar( opt, 0.1_plflt, 0.4_plflt, 0.5_plflt, 0.1_plflt,
-! & ticks, sub_ticks,
-! & axis_opts_1, 'Test label - Right, High Cap',
-! & n, colors, values )
-!
-! position = PL_POSITION_TOP
-! opt = bar_type + PL_COLORBAR_LABEL_TOP +
-! & PL_COLORBAR_CAP_LOW
-!
-! call plcolorbar( opt, 0.1_plflt, 0.1_plflt, 0.5_plflt, 0.1_plflt,
-! & ticks, sub_ticks,
-! & axis_opts_2, 'Test label - Upper, Low Cap',
-! & n, colors, values )
-!
-! position = PL_POSITION_BOTTOM
-! opt = bar_type + PL_COLORBAR_LABEL_BOTTOM +
-! & PL_COLORBAR_CAP_HIGH
-!
-! call plcolorbar( opt, 0.4_plflt, 0.1_plflt, 0.5_plflt, 0.1_plflt,
-! & ticks, sub_ticks,
-! & axis_opts_2, 'Test label - Lower, High Cap',
-! & n, colors, values )
-!
-! call plvpor( 0.0_plflt, 1.0_plflt, 0.0_plflt, 1.0_plflt )
-! call plwind( 0.0_plflt, 1.0_plflt, 0.0_plflt, 1.0_plflt )
-! call plptex( 0.5_plflt, 0.5_plflt, 0.0_plflt, 0.0_plflt, 0.5_plflt, title )
-! end
+ use plplot
+
+ implicit none
+
+ integer :: kind_i, label_i, cap_i, cont_color, n_values
+ real(kind=plflt) :: cont_width
+ real(kind=plflt), dimension(:) :: values
+
+ ! Parameters for the colorbars on this page
+ integer :: position_i, position, opt
+ real(kind=plflt) :: x, y, x_length, y_length;
+ real(kind=plflt) :: ticks(1)
+ integer :: sub_ticks(1)
+ real(kind=plflt) :: low_cap_color, high_cap_color
+ logical :: vertical, ifn
+ integer, parameter :: n_axes = 1
+ character(len=20) :: axis_opts(1)
+ integer, parameter :: n_labels = 1
+ integer :: label_opts(1)
+ character(len=200) :: labels(1)
+ character(len=200) :: title
+ real(kind=plflt) :: colorbar_width, colorbar_height
+ integer :: n_values_array(1);
+ real(kind=plflt), allocatable, dimension(:,:) :: values_array
+
+ ticks(1) = 0.0_plflt
+ sub_ticks(1) = 0
+ label_opts(1) = 0
+
+ n_values_array(1) = n_values
+ allocate(values_array(1,n_values))
+ values_array(1,:) = values(:)
+
+ low_cap_color = 0.0_plflt;
+ high_cap_color = 1.0_plflt;
+
+ ! Start a new page
+ call pladv( 0 )
+
+ ! Draw one colorbar relative to each side of the page
+ do position_i = 0,COLORBAR_POSITIONS-1
+ position = colorbar_position_options(position_i+1);
+ opt = ior( &
+ colorbar_option_kinds(kind_i+1), &
+ ior(colorbar_label_options(label_i+1), &
+ colorbar_cap_options(cap_i+1) ) )
+
+ vertical = (iand(position, PL_POSITION_LEFT) > 0 .or. iand(position, PL_POSITION_RIGHT) > 0 )
+ ifn = (iand(position, PL_POSITION_LEFT) > 0 .or. iand(position, PL_POSITION_BOTTOM) > 0 )
+
+ ! Set the offset position on the page
+ if (vertical .eqv. .true.) then
+ x = 0.0_plflt
+ y = 0.0_plflt
+ x_length = 0.05_plflt
+ y_length = 0.5_plflt
+ else
+ x = 0.0_plflt
+ y = 0.0_plflt
+ x_length = 0.5_plflt
+ y_length = 0.05_plflt
+ endif
+
+ ! Set appropriate labelling options.
+ if (ifn .eqv. .true.) then
+ if ( cont_color .eq. 0 .or. cont_width .eq. 0._plflt ) then
+ axis_opts(1) = "uwtivn"
+ else
+ axis_opts(1) = "uwxvn"
+ endif
+ else
+ if ( cont_color .eq. 0 .or. cont_width .eq. 0._plflt ) then
+ axis_opts(1) = "uwtivm"
+ else
+ axis_opts(1) = "uwxvm"
+ endif
+ endif
+
+ write(labels(1), '(3A)') trim(colorbar_position_option_labels(position_i+1)), &
+ ', ', trim(colorbar_label_option_labels(label_i+1))
+
+ ! Smaller text
+ call plschr( 0.0_plflt, 0.75_plflt )
+ ! Small ticks on the vertical axis
+ call plsmaj( 0.0_plflt, 0.5_plflt )
+ call plsmin( 0.0_plflt, 0.5_plflt )
+
+ call plvpor( 0.20_plflt, 0.80_plflt, 0.20_plflt, 0.80_plflt )
+ call plwind( 0.0_plflt, 1.0_plflt, 0.0_plflt, 1.0_plflt )
+ ! Set interesting background colour.
+ call plscol0a( 15, 0, 0, 0, 0.20_plflt )
+ call plcolorbar( colorbar_width, colorbar_height, &
+ ior(opt, ior(PL_COLORBAR_BOUNDING_BOX, PL_COLORBAR_BACKGROUND)), position, &
+ x, y, x_length, y_length, &
+ 15, 1, 1, &
+ low_cap_color, high_cap_color, &
+ cont_color, cont_width, &
+ label_opts, labels, &
+ axis_opts, ticks, sub_ticks, &
+ n_values_array, values_array )
+
+ ! Reset text and tick sizes
+ call plschr( 0.0_plflt, 1.0_plflt )
+ call plsmaj( 0.0_plflt, 1.0_plflt )
+ call plsmin( 0.0_plflt, 1.0_plflt )
+ enddo
+
+
+ ! Draw a page title
+ write(title, '(3A)') trim(colorbar_option_kind_labels(kind_i+1)), ' - ', &
+ trim(colorbar_cap_option_labels(cap_i+1))
+ call plvpor( 0.0_plflt, 1.0_plflt, 0.0_plflt, 1.0_plflt )
+ call plwind( 0.0_plflt, 1.0_plflt, 0.0_plflt, 1.0_plflt )
+ call plptex( 0.5_plflt, 0.5_plflt, 0.0_plflt, 0.0_plflt, 0.5_plflt, title )
+
+ deallocate(values_array)
+
+ end subroutine plcolorbar_example_page
+
+ subroutine plcolorbar_example( palette, kind_i, cont_color, cont_width, n_values, values )
+ character(*) :: palette
+ integer :: kind_i, label_i, cap_i, cont_color, n_values
+ real(kind=plflt) :: cont_width
+ real(kind=plflt), dimension(:) :: values
+
+ ! Load the color palette
+ call plspal1( palette, 1 )
+
+ do label_i = 0,COLORBAR_LABELS-1
+ do cap_i = 0,COLORBAR_CAPS-1
+ call plcolorbar_example_page( kind_i, label_i, cap_i, &
+ cont_color, cont_width, &
+ n_values, values )
+ enddo
+ enddo
+ end subroutine plcolorbar_example
+
end program
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
