Menu
▾
▴
[Plplot-cvs] SF.net SVN: plplot:[8702] trunk
|
From: <jb...@us...> - 2008-08-23 04:30:02
|
Revision: 8702
http://plplot.svn.sourceforge.net/plplot/?rev=8702&view=rev
Author: jbauck
Date: 2008-08-23 04:30:07 +0000 (Sat, 23 Aug 2008)
Log Message:
-----------
Add Ada examples x20a.adb and xthick20a.adb. This is the final Ada example of the existing 30.
Modified Paths:
--------------
trunk/bindings/ada/plplot.adb.cmake
trunk/bindings/ada/plplot.ads.cmake
trunk/bindings/ada/plplot_thin.ads.cmake
trunk/bindings/ada/plplot_traditional.adb.cmake
trunk/bindings/ada/plplot_traditional.ads.cmake
trunk/examples/ada/CMakeLists.txt
trunk/examples/ada/Makefile.examples.in
trunk/plplot_test/test_ada.sh.in
Added Paths:
-----------
trunk/examples/ada/x20a.adb.cmake
trunk/examples/ada/xthick20a.adb.cmake
Modified: trunk/bindings/ada/plplot.adb.cmake
===================================================================
--- trunk/bindings/ada/plplot.adb.cmake 2008-08-21 21:46:56 UTC (rev 8701)
+++ trunk/bindings/ada/plplot.adb.cmake 2008-08-23 04:30:07 UTC (rev 8702)
@@ -2783,8 +2783,25 @@
-- plots a 2d image (or a matrix too large for plshade() )
+ -- plimagefr
+ procedure Draw_Image_Color_Map_1
+ (Data : Real_Matrix;
+ x_Min, x_Max : Long_Float;
+ y_Min, y_Max : Long_Float;
+ z_Min, z_Max : Long_Float;
+ Value_Min, Value_Max : Long_Float;
+ Transformation_Procedure_Pointer : Transformation_Procedure_Pointer_Type;
+ Transformation_Data_Pointer : PLpointer) is
+ begin
+ plimagefr(Matrix_To_Pointers(Data), Data'Length(1), Data'Length(2),
+ x_Min, x_Max, y_Min, y_Max, z_Min, z_Max, Value_Min, Value_Max,
+ Transformation_Procedure_Pointer, Transformation_Data_Pointer);
+ end Draw_Image_Color_Map_1;
+
+
+ -- plots a 2d image (or a matrix too large for plshade() )
-- plimage
- procedure Draw_Image -- No documentation in Chapter 17 of Programmer's Reference Manual
+ procedure Draw_Image_Color_Map_1_Automatic
(Data : Real_Matrix;
x_Min, x_Max : Long_Float;
y_Min, y_Max : Long_Float;
@@ -2792,8 +2809,8 @@
Dxmin, Dxmax : Long_Float;
Dymin, Dymax : Long_Float) is
begin
- plimage(Matrix_To_Pointers(Data), Data'Length(2), Data'Length(1), x_Min, x_Max, y_Min, y_Max, z_Min, z_Max, Dxmin, Dxmax, Dymin, Dymax);
- end Draw_Image;
+ plimage(Matrix_To_Pointers(Data), Data'Length(1), Data'Length(2), x_Min, x_Max, y_Min, y_Max, z_Min, z_Max, Dxmin, Dxmax, Dymin, Dymax);
+ end Draw_Image_Color_Map_1_Automatic;
-- Set up a new line style
@@ -3091,8 +3108,15 @@
begin
pltr2(x_Grid, y_Grid, x_World, y_World, Data_Pointer);
end Plot_Transformation_2;
+
+ -- Wait for graphics input event and translate to world coordinates.
+ procedure Get_Cursor(Graphics_Input : out PLGraphicsIn) is
+ begin
+ plGetCursor(Graphics_Input);
+ end Get_Cursor;
+
begin -- package body for PLplot
-- NOTE: One would ordinarily call the initialization procedure at this point.
Modified: trunk/bindings/ada/plplot.ads.cmake
===================================================================
--- trunk/bindings/ada/plplot.ads.cmake 2008-08-21 21:46:56 UTC (rev 8701)
+++ trunk/bindings/ada/plplot.ads.cmake 2008-08-23 04:30:07 UTC (rev 8702)
@@ -44,8 +44,10 @@
-- good to remove "use PLplot_Thin" for clarity since it is used in only
-- a few places.
subtype PLPointer is PLplot_Thin.PLpointer;
+ subtype Unsigned_Int is Interfaces.C.unsigned;
subtype Transformation_Data_Type is Plplot_Thin.Transformation_Data_Type;
subtype Transformation_Data_Type_2 is Plplot_Thin.Transformation_Data_Type_2;
+ subtype Graphics_Input_Record_Type is Plplot_Thin.PLGraphicsIn;
-- "Rename" the unicode type for characters.
subtype Unicode is PLplot_Thin.PLUNICODE;
@@ -1316,7 +1318,7 @@
-- intensity [0,1] (cmap 1 index) and position in HLS or RGB color space.
-- plscmap1l
procedure Set_Color_Map_1_Piecewise
- (Color_Model : Color_Model_Type; -- HLS or RGB
+ (Color_Model : Color_Model_Type; -- HLS or RGB
Control_Points : Real_Vector; -- range 0.0 .. 1.0; not checked here
H_Or_R : Real_Vector; -- range 0.0 .. 1.0; not checked here
L_Or_G : Real_Vector; -- range 0.0 .. 1.0; not checked here
@@ -1329,7 +1331,7 @@
-- Will also linear interpolate alpha values.
-- plscmap1la
procedure Set_Color_Map_1_Piecewise_And_Alpha
- (Color_Model : Color_Model_Type; -- HLS or RGB
+ (Color_Model : Color_Model_Type; -- HLS or RGB
Control_Points : Real_Vector; -- range 0.0 .. 1.0; not checked here
H_Or_R : Real_Vector; -- range 0.0 .. 1.0; not checked here
L_Or_G : Real_Vector; -- range 0.0 .. 1.0; not checked here
@@ -1629,8 +1631,20 @@
-- plots a 2d image (or a matrix too large for plshade() )
+ -- plimagefr
+ procedure Draw_Image_Color_Map_1
+ (Data : Real_Matrix;
+ x_Min, x_Max : Long_Float;
+ y_Min, y_Max : Long_Float;
+ z_Min, z_Max : Long_Float;
+ Value_Min, Value_Max : Long_Float;
+ Transformation_Procedure_Pointer : Transformation_Procedure_Pointer_Type;
+ Transformation_Data_Pointer : PLpointer);
+
+
+ -- plots a 2d image (or a matrix too large for plshade() )
-- plimage
- procedure Draw_Image -- No documentation in Chapter 17 of Programmer's Reference Manual
+ procedure Draw_Image_Color_Map_1_Automatic
(Data : Real_Matrix;
x_Min, x_Max : Long_Float;
y_Min, y_Max : Long_Float;
@@ -1798,11 +1812,11 @@
-- I wonder if this is approaching "wrapper bloat" since these procedures
-- get called a lot of times during the making of a contour plot.
-- The way to eliminate one level of calling would be to move the bodies
- -- of pltrx from plplot_thin.adb into plplot_traditional.adb and
+ -- of pltr? from plplot_thin.adb into plplot_traditional.adb and
-- plplot.adb, then optionally eliminating the bodies from plplot_thin.adb
-- on the idea that nobody is going to use them anyway. But even if the
-- bodies were left in plplot_thin.adb, having them here would still
- -- remove the extra call level. The argument for the currend arrangement is
+ -- remove the extra call level. The argument for the current arrangement is
-- easier code maintainence.
-- Identity transformation.
@@ -1832,6 +1846,8 @@
Data_Pointer : PLpointer);
pragma Convention(Convention => C, Entity => Plot_Transformation_2);
-
+ -- Wait for graphics input event and translate to world coordinates.
+ procedure Get_Cursor(Graphics_Input : out Graphics_Input_Record_Type);
+
end PLplot;
Modified: trunk/bindings/ada/plplot_thin.ads.cmake
===================================================================
--- trunk/bindings/ada/plplot_thin.ads.cmake 2008-08-21 21:46:56 UTC (rev 8701)
+++ trunk/bindings/ada/plplot_thin.ads.cmake 2008-08-23 04:30:07 UTC (rev 8702)
@@ -59,7 +59,8 @@
PLtrue : constant Integer := 1;
subtype PLBOOL is Integer range PLfalse..PLtrue;
type PLUNICODE is mod 2**32;
- type Unsigned_Int is mod 2**32; -- for e.g. plseed
+-- subtype Unsigned_Int is mod 2**32; -- for e.g. plseed
+-- subtype Unsigned_Int is Integer range 0 .. 2**31 - 1; -- for e.g. plseed fix this
subtype PL_Integer_Array is Integer_Array_1D;
subtype PL_Float_Array is Real_Vector;
@@ -273,21 +274,22 @@
-- PLplot Graphics Input structure
+
PL_MAXKEY : constant Integer := 16;
+
+ type PLGraphicsIn is
+ record
+ Event_Type : Integer; -- of event (CURRENTLY UNUSED)
+ state : unsigned; -- key or button mask
+ keysym : unsigned; -- key selected
+ button : unsigned; -- mouse button selected
+ subwindow : PLINT; -- subwindow (alias subpage, alias subplot) number
+ T_String : String(1 .. PL_MAXKEY);
+ pX, pY : integer; -- absolute device coordinates of pointer
+ dX, dY : PLFLT; -- relative device coordinates of pointer
+ wX, wY : PLFLT; -- world coordinates of pointer
+ end record;
- -- fix this
- --type PLGraphicsIn is
- -- record
- -- PLGraphicsIn_type : integer; -- of event (CURRENTLY UNUSED); Renamed to un-clobber Ada reserved word.
- -- state : unsigned; -- key or button mask
- -- keysym : unsigned; -- key selected
- -- button : unsigned; -- mouse button selected
- -- subwindow : PLINT; -- subwindow (alias subpage, alias subplot) number
- -- char string[PL_MAXKEY]; -- translated string
- -- pX, pY : integer; -- absolute device coordinates of pointer
- -- dX, dY : PLFLT; -- relative device coordinates of pointer
- -- wX, wY : PLFLT; -- world coordinates of pointer
- -- end record;
-- Structure for describing the plot window
@@ -304,7 +306,7 @@
type PLDisplay is
record
- x, y : unsigned; -- upper left hand corner
+ x, y : unsigned; -- upper left hand corner
width, height : unsigned; -- window dimensions
end record;
@@ -1307,7 +1309,7 @@
-- Set seed for internal random number generator
procedure
- plseed(s : Unsigned_Int);
+ plseed(s : unsigned);
pragma Import(C, plseed, "c_plseed");
@@ -1373,7 +1375,7 @@
procedure
- plshades( z : Long_Float_Pointer_Array; nx : PLINT; ny : PLINT; defined : Mask_Function_Pointer_Type;
+ plshades(z : Long_Float_Pointer_Array; nx : PLINT; ny : PLINT; defined : Mask_Function_Pointer_Type;
xmin : PLFLT; xmax : PLFLT; ymin : PLFLT; ymax : PLFLT;
clevel : PL_Float_Array; nlevel : PLINT; fill_width : PLINT;
cont_color : PLINT; cont_width : PLINT;
@@ -1504,10 +1506,21 @@
pragma Import(C, plstripd, "c_plstripd");
+ -- plots a 2d image (or a matrix too large for plshade() )
+
+ procedure
+ plimagefr(data : Long_Float_Pointer_Array; nx : PLINT; ny : PLINT;
+ xmin : PLFLT; xmax : PLFLT; ymin : PLFLT; ymax : PLFLT; zmin : PLFLT; zmax : PLFLT;
+ valuemin :PLFLT; valuemax : PLFLT;
+ pltr : Transformation_Procedure_Pointer_Type;
+ pltr_data : PLpointer);
+ pragma Import(C, plimagefr, "c_plimagefr");
+
+
-- plots a 2d image (or a matrix too large for plshade() )
procedure
- plimage( data : Long_Float_Pointer_Array; nx : PLINT; ny : PLINT;
+ plimage(data : Long_Float_Pointer_Array; nx : PLINT; ny : PLINT;
xmin : PLFLT; xmax : PLFLT; ymin : PLFLT; ymax : PLFLT; zmin : PLFLT; zmax : PLFLT;
Dxmin : PLFLT; Dxmax : PLFLT; Dymin : PLFLT; Dymax : PLFLT);
pragma Import(C, plimage, "c_plimage");
@@ -1694,7 +1707,7 @@
-- pltr0, pltr1, and pltr2 had to be re-written in Ada in order to make the
-- callback work while also passing the data structure along, e.g.
-- pltr_data in the formal names below. The machinery surrounding this idea
- -- also allows for easy user- defined plot transformation subprograms to be
+ -- also allows for easy user-defined plot transformation subprograms to be
-- written.
-- Identity transformation. Re-write of pltr0 in plcont.c in Ada.
@@ -1721,5 +1734,10 @@
tx, ty : out PLFLT;
pltr_data : PLplot_thin.PLpointer);
pragma Convention (Convention => C, Entity => pltr2);
+
+
+ -- Wait for graphics input event and translate to world coordinates.
+ procedure plGetCursor(gin : out PLGraphicsIn);
+ pragma Import (C, plGetCursor, "plGetCursor");
end PLplot_Thin;
Modified: trunk/bindings/ada/plplot_traditional.adb.cmake
===================================================================
--- trunk/bindings/ada/plplot_traditional.adb.cmake 2008-08-21 21:46:56 UTC (rev 8701)
+++ trunk/bindings/ada/plplot_traditional.adb.cmake 2008-08-23 04:30:07 UTC (rev 8702)
@@ -2648,7 +2648,23 @@
-- plots a 2d image (or a matrix too large for plshade() )
- procedure plimage -- No documentation in Chapter 17 of Programmer's Reference Manual
+ procedure plimagefr
+ (Data : Real_Matrix;
+ x_Min, x_Max : Long_Float;
+ y_Min, y_Max : Long_Float;
+ z_Min, z_Max : Long_Float;
+ Value_Min, Value_Max : Long_Float;
+ Transformation_Procedure_Pointer : Transformation_Procedure_Pointer_Type;
+ Transformation_Data_Pointer : PLpointer) is
+ begin
+ PLplot_Thin.plimagefr(Matrix_To_Pointers(Data), Data'Length(1), Data'Length(2),
+ x_Min, x_Max, y_Min, y_Max, z_Min, z_Max, Value_Min, Value_Max,
+ Transformation_Procedure_Pointer, Transformation_Data_Pointer);
+ end plimagefr;
+
+
+ -- plots a 2d image (or a matrix too large for plshade() )
+ procedure plimage
(Data : Real_Matrix;
x_Min, x_Max : Long_Float;
y_Min, y_Max : Long_Float;
@@ -2656,7 +2672,7 @@
Dxmin, Dxmax : Long_Float;
Dymin, Dymax : Long_Float) is
begin
- PLplot_Thin.plimage(Matrix_To_Pointers(Data), Data'Length(2), Data'Length(1), x_Min, x_Max, y_Min, y_Max, z_Min, z_Max, Dxmin, Dxmax, Dymin, Dymax);
+ PLplot_Thin.plimage(Matrix_To_Pointers(Data), Data'Length(1), Data'Length(2), x_Min, x_Max, y_Min, y_Max, z_Min, z_Max, Dxmin, Dxmax, Dymin, Dymax);
end plimage;
@@ -2931,7 +2947,13 @@
begin
PLplot_Thin.pltr2(x_Grid, y_Grid, x_World, y_World, Data_Pointer);
end pltr2;
+
+ -- Wait for graphics input event and translate to world coordinates.
+ procedure plGetCursor(Graphics_Input : out PLGraphicsIn) is
+ begin
+ PLplot_Thin.plGetCursor(Graphics_Input);
+ end plGetCursor;
begin -- package body for PLplot
Modified: trunk/bindings/ada/plplot_traditional.ads.cmake
===================================================================
--- trunk/bindings/ada/plplot_traditional.ads.cmake 2008-08-21 21:46:56 UTC (rev 8701)
+++ trunk/bindings/ada/plplot_traditional.ads.cmake 2008-08-23 04:30:07 UTC (rev 8702)
@@ -44,8 +44,10 @@
-- good to remove "use PLplot_Thin" for clarity since it is used in only
-- a few places.
subtype PLPointer is PLplot_Thin.PLpointer;
+ subtype Unsigned_Int is Interfaces.C.unsigned;
subtype Transformation_Data_Type is Plplot_Thin.Transformation_Data_Type;
subtype Transformation_Data_Type_2 is Plplot_Thin.Transformation_Data_Type_2;
+ subtype Graphics_Input_Record_Type is Plplot_Thin.PLGraphicsIn;
-- "Rename" the unicode type for characters.
subtype Unicode is PLplot_Thin.PLUNICODE;
@@ -1218,7 +1220,7 @@
-- Set color map 1 colors using a piece-wise linear relationship between
-- intensity [0,1] (cmap 1 index) and position in HLS or RGB color space.
procedure plscmap1l
- (Color_Model : Color_Model_Type; -- HLS or RGB
+ (Color_Model : Color_Model_Type; -- HLS or RGB
Control_Points : Real_Vector; -- range 0.0 .. 1.0; not checked here
H_Or_R : Real_Vector; -- range 0.0 .. 1.0; not checked here
L_Or_G : Real_Vector; -- range 0.0 .. 1.0; not checked here
@@ -1230,7 +1232,7 @@
-- intensity [0,1] (cmap 1 index) and position in HLS or RGB color space.
-- Will also linear interpolate alpha values.
procedure plscmap1la
- (Color_Model : Color_Model_Type; -- HLS or RGB
+ (Color_Model : Color_Model_Type; -- HLS or RGB
Control_Points : Real_Vector; -- range 0.0 .. 1.0; not checked here
H_Or_R : Real_Vector; -- range 0.0 .. 1.0; not checked here
L_Or_G : Real_Vector; -- range 0.0 .. 1.0; not checked here
@@ -1494,7 +1496,18 @@
-- plots a 2d image (or a matrix too large for plshade() )
- procedure plimage -- No documentation in Chapter 17 of Programmer's Reference Manual
+ procedure plimagefr -- No documentation in Chapter 17 of Programmer's Reference Manual
+ (Data : Real_Matrix;
+ x_Min, x_Max : Long_Float;
+ y_Min, y_Max : Long_Float;
+ z_Min, z_Max : Long_Float;
+ Value_Min, Value_Max : Long_Float;
+ Transformation_Procedure_Pointer : Transformation_Procedure_Pointer_Type;
+ Transformation_Data_Pointer : PLpointer);
+
+
+ -- plots a 2d image (or a matrix too large for plshade() )
+ procedure plimage
(Data : Real_Matrix;
x_Min, x_Max : Long_Float;
y_Min, y_Max : Long_Float;
@@ -1641,11 +1654,11 @@
-- I wonder if this is approaching "wrapper bloat" since these procedures
-- get called a lot of times during the making of a contour plot.
-- The way to eliminate one level of calling would be to move the bodies
- -- of pltrx from plplot_thin.adb into plplot_traditional.adb and
+ -- of pltr? from plplot_thin.adb into plplot_traditional.adb and
-- plplot.adb, then optionally eliminating the bodies from plplot_thin.adb
-- on the idea that nobody is going to use them anyway. But even if the
-- bodies were left in plplot_thin.adb, having them here would still
- -- remove the extra call level. The argument for the currend arrangement is
+ -- remove the extra call level. The argument for the current arrangement is
-- easier code maintainence.
-- Identity transformation.
@@ -1672,6 +1685,8 @@
Data_Pointer : PLpointer);
pragma Convention(Convention => C, Entity => pltr2);
-
+ -- Wait for graphics input event and translate to world coordinates.
+ procedure plGetCursor(Graphics_Input : out Graphics_Input_Record_Type);
+
end PLplot_Traditional;
Modified: trunk/examples/ada/CMakeLists.txt
===================================================================
--- trunk/examples/ada/CMakeLists.txt 2008-08-21 21:46:56 UTC (rev 8701)
+++ trunk/examples/ada/CMakeLists.txt 2008-08-23 04:30:07 UTC (rev 8702)
@@ -38,6 +38,7 @@
"17"
"18"
"19"
+"20"
"21"
"22"
"23"
@@ -67,6 +68,7 @@
"thick17"
"thick18"
"thick19"
+"thick20"
"thick21"
"thick22"
"thick23"
Modified: trunk/examples/ada/Makefile.examples.in
===================================================================
--- trunk/examples/ada/Makefile.examples.in 2008-08-21 21:46:56 UTC (rev 8701)
+++ trunk/examples/ada/Makefile.examples.in 2008-08-23 04:30:07 UTC (rev 8702)
@@ -49,6 +49,7 @@
x17a$(EXEEXT) \
x18a$(EXEEXT) \
x19a$(EXEEXT) \
+ x20a$(EXEEXT) \
x21a$(EXEEXT) \
x22a$(EXEEXT) \
x23a$(EXEEXT) \
@@ -78,6 +79,7 @@
xthick17a$(EXEEXT) \
xthick18a$(EXEEXT) \
xthick19a$(EXEEXT) \
+ xthick20a$(EXEEXT) \
xthick21a$(EXEEXT) \
xthick22a$(EXEEXT) \
xthick23a$(EXEEXT) \
Added: trunk/examples/ada/x20a.adb.cmake
===================================================================
--- trunk/examples/ada/x20a.adb.cmake (rev 0)
+++ trunk/examples/ada/x20a.adb.cmake 2008-08-23 04:30:07 UTC (rev 8702)
@@ -0,0 +1,455 @@
+-- $Id$
+
+-- plimage demo
+
+-- Copyright (C) 2008 Jerry Bauck
+
+-- 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
+
+with
+ Ada.Text_IO,
+ Interfaces.C,
+ System,
+ Ada.Sequential_IO,
+ Ada.Numerics,
+ Ada.Numerics.Long_Elementary_Functions,
+ PLplot_Traditional,
+ PLplot_Auxiliary;
+use
+ Ada.Text_IO,
+ Interfaces.C,
+ System,
+ Ada.Numerics,
+ Ada.Numerics.Long_Elementary_Functions,
+ PLplot_Traditional,
+ PLplot_Auxiliary;
+
+-- COMMENT THIS LINE IF YOUR COMPILER DOES NOT INCLUDE THESE
+-- DEFINITIONS, FOR EXAMPLE, IF IT IS NOT ADA 2005 WITH ANNEX G.3 COMPLIANCE.
+--with Ada.Numerics.Long_Real_Arrays; use Ada.Numerics.Long_Real_Arrays;
+@Ada_Is_2007_With_and_Use_Numerics@
+
+procedure x20a is
+
+ XDIM : constant Integer := 260;
+ YDIM : constant Integer := 220;
+ PLK_Return : constant unsigned := 16#0D#;
+ dbg : Integer := 0;
+ nosombrero : Integer := 0;
+ nointeractive : Integer := 0;
+ x : Real_Vector(0 .. XDIM - 1);
+ y : Real_Vector(0 .. YDIM - 1);
+ z, r : Real_Matrix(0 .. XDIM - 1, 0 .. YDIM - 1);
+ xi, yi, xe, ye : Long_Float;
+ width, height, num_col : Integer;
+ img_f : Real_Matrix(0 .. 398, 0 .. 485); -- Lena is width 399, height 486.
+ img_min, img_max : Long_Float;
+ Get_Clip_Return : Integer;
+ type stretch_data is
+ record
+ xmin, xmax, ymin, ymax : Long_Float;
+ stretch : Long_Float;
+ end record;
+ stretch : stretch_data;
+ xx, yy : Long_Float;
+ f_name : String(1 .. 200);
+ f_name_length : Integer;
+ Save_Sombrero : Boolean := False;
+
+ -- Read image from file in binary ppm format.
+ procedure read_img
+ (fname : String; img_f : out Real_Matrix;
+ width, height, num_col : out Integer)
+ is
+ type Byte is mod 2 ** 8;
+ A_Byte : Byte;
+ package Lena_IO is new Ada.Sequential_IO(Byte);
+ use Lena_IO;
+ Input_File : Lena_IO.File_Type;
+ begin
+ -- Naive grayscale binary ppm reading. If you know how to, improve it.
+ -- Mine is naiver than yours.
+ -- lena.pgm has 133 bytes of header followed by 399 * 486 bytes of 8-bit pixels.
+ Lena_IO.Open(Input_File, In_File, fname);
+
+ for i in 1 .. 133 loop
+ Lena_IO.Read(Input_File, A_Byte);
+ end loop;
+
+ width := 399; -- columns
+ height := 486; -- rows
+ num_col := 255; -- number of colors
+
+ for j in img_f'range(2) loop
+ for i in img_f'range(1) loop
+ Lena_IO.Read(Input_File, A_Byte);
+ img_f(i, height - j - 1) := Long_Float(A_Byte); -- Flip image up-down.
+ end loop;
+ end loop;
+ end read_img;
+
+
+ -- Save plot.
+ procedure save_plot(fname : String) is
+ cur_strm, new_strm : Integer;
+ begin
+ plgstrm(cur_strm); -- Get current stream.
+ plmkstrm(new_strm); -- Create a new one.
+ plsdev("psc"); -- New device type. Use a known existing driver.
+ plsfnam(fname); -- Set the file name.
+ plcpstrm(cur_strm, False); -- Copy old stream parameters to new stream.
+ plreplot; -- Do the save.
+ plend1; -- Close new device...
+ plsstrm(cur_strm); -- ...and return to previous one.
+ end save_plot;
+
+
+ -- Get selection square interactively.
+ procedure get_clip(xi, xe, yi, ye : in out Long_Float; Return_This : out Integer) is
+ gin : Graphics_Input_Record_Type;
+ xxi : Long_Float := xi;
+ yyi : Long_Float := yi;
+ xxe : Long_Float := xe;
+ yye : Long_Float := ye;
+ t : Long_Float;
+ start : Integer := 0;
+ st : Boolean := False;
+ sx, sy : Real_Vector(0 .. 4);
+ begin
+ plxormod(True, st); -- Enter xor mode to draw a selection rectangle.
+
+ if st then -- Driver has xormod capability. Continue.
+ loop
+ plxormod(False, st);
+ plGetCursor(gin);
+ plxormod(True, st);
+
+ if gin.button = 1 then
+ xxi := gin.wX;
+ yyi := gin.wY;
+ if start /= 0 then
+ plline(sx, sy); -- Clear previous rectangle.
+ end if;
+
+ start := 0;
+
+ sx(0) := xxi;
+ sy(0) := yyi;
+ sx(4) := xxi;
+ sy(4) := yyi;
+ end if;
+
+ if (gin.state and Unsigned(16#100#)) /= 0 then
+ xxe := gin.wX;
+ yye := gin.wY;
+
+ if start /= 0 then
+ plline(sx, sy); -- Clear previous rectangle.
+ end if;
+
+ start := 1;
+
+ sx(2) := xxe;
+ sy(2) := yye;
+ sx(1) := xxe;
+ sy(1) := yyi;
+ sx(3) := xxi;
+ sy(3) := yye;
+ plline(sx, sy); -- Draw new rectangle.
+ end if;
+
+ if gin.button = 3 or gin.keysym = PLK_Return or
+ gin.keysym = unsigned(Character'pos('Q')) then
+ if start /= 0 then
+ plline(sx, sy); -- Clear previous rectangle.
+ end if;
+ exit;
+ end if;
+ end loop;
+
+ plxormod(False, st); -- Leave xor mod.
+
+ if xxe < xxi then
+ t := xxi;
+ xxi := xxe;
+ xxe := t;
+ end if;
+
+ if yyi < yye then
+ t :=yyi;
+ yyi := yye;
+ yye := t;
+ end if;
+
+ xe := xxe;
+ xi := xxi;
+ ye := yye;
+ yi := yyi;
+
+ if gin.keysym = unsigned(Character'pos('Q')) then
+ Return_This := 1;
+ else
+ Return_This := 0;
+ end if;
+ else -- Driver has no xormod capability; just do nothing.
+ Return_This := 0;
+ end if;
+ end get_clip;
+
+
+ -- Set gray colormap.
+ procedure gray_cmap(num_col : Integer) is
+ r, g, b, pos : Real_Vector(0 .. 1);
+ A_Boolean : Boolean_Array_1D(1 .. 1);
+ begin
+ r(0) := 0.0;
+ g(0) := 0.0;
+ b(0) := 0.0;
+
+ r(1) := 1.0;
+ g(1) := 1.0;
+ b(1) := 1.0;
+
+ pos(0) := 0.0;
+ pos(1) := 1.0;
+
+ plscmap1n(num_col);
+ A_Boolean(1) := False;
+ plscmap1l(RGB, pos, r, g, b, A_Boolean);
+ end gray_cmap;
+
+
+ procedure mypltr
+ (x, y : Long_Float;
+ tx, ty : out Long_Float;
+ s : stretch_data)
+ is
+ x0, y0, dy : Long_Float;
+ begin
+ x0 := (s.xmin + s.xmax) * 0.5;
+ y0 := (s.ymin + s.ymax) * 0.5;
+ dy := (s.ymax - s.ymin) * 0.5;
+ tx := x0 + (x0 - x) * (1.0 - s.stretch * cos((y - y0) / dy * pi * 0.5));
+ ty := y;
+ end mypltr;
+
+begin
+ -- 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
+ plparseopts(PL_PARSE_FULL);
+
+ -- Initialize plplot
+ plinit;
+
+ -- View image border pixels.
+ if dbg /= 0 then
+ plenv(1.0, Long_Float(XDIM), 1.0, Long_Float(YDIM), 1, 1); -- no plot box
+
+ -- Build a one pixel square border, for diagnostics.
+ for i in z'range(1) loop
+ z(i, YDIM - 1) := 1.0; -- right
+ end loop;
+
+ for i in z'range(1) loop
+ z(i, 0) := 1.0; -- left
+ end loop;
+
+ for i in z'range(2) loop
+ z(0, i) := 1.0; -- top
+ end loop;
+
+ for i in z'range(2) loop
+ z(XDIM - 1, i) := 1.0; -- botton
+ end loop;
+
+ pllab("...around a blue square."," ","A red border should appear...");
+
+ plimage(z,
+ 1.0, Long_Float(XDIM), 1.0, Long_Float(YDIM), 0.0, 0.0,
+ 1.0, Long_Float(XDIM), 1.0, Long_Float(YDIM));
+
+ pladv(0);
+ end if;
+
+ -- sombrero-like demo
+ if nosombrero = 0 then
+ plcol0(2); -- Draw a yellow plot box, useful for diagnostics! :(
+ plenv(0.0, 2.0 * pi, 0.0, 3.0 * pi, 1, -1);
+
+ for i in x'range loop
+ x(i) := Long_Float(i) * 2.0 * pi / Long_Float(XDIM - 1);
+ end loop;
+
+ for i in y'range loop
+ y(i) := Long_Float(i) * 3.0 * pi / Long_Float(YDIM - 1);
+ end loop;
+
+ for i in z'range(1) loop
+ for j in z'range(2) loop
+ r(i, j) := sqrt(x(i) * x(i) + y(j) * y(j)) + 1.0e-3;
+ z(i, j) := sin(r(i, j)) / (r(i, j));
+ end loop;
+ end loop;
+
+ pllab("No, an amplitude clipped ""sombrero""", "", "Saturn?");
+ plptex(2.0, 2.0, 3.0, 4.0, 0.0, "Transparent image");
+ plimage(z, 0.0, 2.0 * pi, 0.0, 3.0 * pi, 0.05, 1.0,
+ 0.0, 2.0 * pi, 0.0, 3.0 * pi);
+
+ -- Save the plot.
+ if Save_Sombrero then
+ Put("Enter a path and name to save the Postscript file or RETURN to not save: ");
+ Get_Line(f_name, f_name_length);
+ if f_name'Length /= 0 then
+ save_plot(f_name(1 .. f_name_length));
+ end if;
+ end if;
+
+ pladv(0);
+ end if;
+
+ -- Read the Lena image.
+ -- Note we try two different locations to cover the case where this
+ -- examples is being run from the test_c.sh script.
+ begin
+ read_img("./lena.pgm", img_f, width, height, num_col);
+ exception
+ when NAME_ERROR =>
+ null;
+ begin
+ read_img("../lena.pgm", img_f, width, height, num_col);
+ exception
+ when NAME_ERROR =>
+ Put_Line("Failed to open lena.pgm. Aborting.");
+ plend;
+ return;
+ end; -- second exception block
+ end; -- first exception block
+
+ -- Set gray colormap.
+ gray_cmap(num_col);
+
+ -- Display Lena.
+ plenv(1.0, Long_Float(width), 1.0, Long_Float(height), 1, -1);
+
+ if nointeractive = 0 then
+ pllab("Set and drag Button 1 to (re)set selection, Button 2 to finish."," ","Lena...");
+ else
+ pllab(""," ","Lena...");
+ end if;
+
+ plimage(img_f, 1.0, Long_Float(width), 1.0, Long_Float(height), 0.0, 0.0, 1.0,
+ Long_Float(width), 1.0, Long_Float(height));
+
+ -- Selection/expansion demo
+ if nointeractive = 0 then
+ xi := 200.0;
+ xe := 330.0;
+ yi := 280.0;
+ ye := 220.0;
+
+ get_clip(xi, xe, yi, ye, Get_Clip_Return); -- get selection rectangle
+ if Get_Clip_Return /= 0 then
+ plend;
+ end if;
+
+ -- 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!
+
+ -- plbop();
+
+ -- 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.
+
+ plspause(False);
+ pladv(0);
+
+ -- Display selection only.
+ plimage(img_f, 1.0, Long_Float(width), 1.0, Long_Float(height), 0.0, 0.0, xi, xe, ye, yi);
+
+ plspause(True);
+ pladv(0);
+
+ -- Zoom in selection.
+ plenv(xi, xe, ye, yi, 1, -1);
+ plimage(img_f, 1.0, Long_Float(width), 1.0, Long_Float(height), 0.0, 0.0, xi, xe, ye, yi);
+ pladv(0);
+ end if;
+
+ -- Base the dynamic range on the image contents.
+ img_min := Matrix_Min(img_f);
+ img_max := Matrix_Max(img_f);
+
+ -- Draw a saturated version of the original image. Use only the middle 50%
+ -- of the image's full dynamic range.
+ plcol0(2);
+ plenv(0.0, Long_Float(width), 0.0, Long_Float(height), 1, -1);
+ pllab("", "", "Reduced dynamic range image example");
+ plimagefr(img_f, 0.0, Long_Float(width), 0.0, Long_Float(height), 0.0, 0.0,
+ img_min + img_max * 0.25, img_max - img_max * 0.25, Null, System.Null_Address);
+
+ -- Draw a distorted version of the original image, showing its full dynamic range.
+ plenv(0.0, Long_Float(width), 0.0, Long_Float(height), 1, -1);
+ pllab("", "", "Distorted image example");
+
+ stretch.xmin := 0.0;
+ stretch.xmax := Long_Float(width);
+ stretch.ymin := 0.0;
+ stretch.ymax := Long_Float(height);
+ stretch.stretch := 0.5;
+
+ -- In C / C++ the following would work, with plimagefr directly calling
+ -- mypltr. For compatibilty with other language bindings the same effect
+ -- can be achieved by generating the transformed grid first and then
+ -- using pltr2.
+ -- plimagefr(img_f, width, height, 0., width, 0., height, 0., 0., img_min, img_max, mypltr, (PLPointer) &stretch);
+
+ declare -- Declare block is based on runtime-determined values of width, height.
+ cgrid2 : aliased Transformation_Data_Type_2
+ (x_Last => width,
+ y_Last => height);
+ begin
+ for i in 0 .. width loop
+ for j in 0 .. height loop
+ mypltr(Long_Float(i), Long_Float(j), xx, yy, stretch);
+ cgrid2.xg(i, j) := xx;
+ cgrid2.yg(i, j) := yy;
+ end loop;
+ end loop;
+
+ plimagefr(img_f, 0.0, Long_Float(width), 0.0, Long_Float(height), 0.0, 0.0, img_min, img_max,
+ pltr2'access, cgrid2'Address);
+ pladv(0);
+ end;
+ plend;
+end x20a;
Property changes on: trunk/examples/ada/x20a.adb.cmake
___________________________________________________________________
Added: svn:keywords
+ Author Date Id Revision
Added: svn:eol-style
+ native
Added: trunk/examples/ada/xthick20a.adb.cmake
===================================================================
--- trunk/examples/ada/xthick20a.adb.cmake (rev 0)
+++ trunk/examples/ada/xthick20a.adb.cmake 2008-08-23 04:30:07 UTC (rev 8702)
@@ -0,0 +1,455 @@
+-- $Id$
+
+-- Draw_Image_Color_Map_1_Automatic demo
+
+-- Copyright (C) 2008 Jerry Bauck
+
+-- 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
+
+with
+ Ada.Text_IO,
+ Interfaces.C,
+ System,
+ Ada.Sequential_IO,
+ Ada.Numerics,
+ Ada.Numerics.Long_Elementary_Functions,
+ PLplot,
+ PLplot_Auxiliary;
+use
+ Ada.Text_IO,
+ Interfaces.C,
+ System,
+ Ada.Numerics,
+ Ada.Numerics.Long_Elementary_Functions,
+ PLplot,
+ PLplot_Auxiliary;
+
+-- COMMENT THIS LINE IF YOUR COMPILER DOES NOT INCLUDE THESE
+-- DEFINITIONS, FOR EXAMPLE, IF IT IS NOT ADA 2005 WITH ANNEX G.3 COMPLIANCE.
+--with Ada.Numerics.Long_Real_Arrays; use Ada.Numerics.Long_Real_Arrays;
+@Ada_Is_2007_With_and_Use_Numerics@
+
+procedure xthick20a is
+
+ XDIM : constant Integer := 260;
+ YDIM : constant Integer := 220;
+ PLK_Return : constant unsigned := 16#0D#;
+ dbg : Integer := 0;
+ nosombrero : Integer := 0;
+ nointeractive : Integer := 0;
+ x : Real_Vector(0 .. XDIM - 1);
+ y : Real_Vector(0 .. YDIM - 1);
+ z, r : Real_Matrix(0 .. XDIM - 1, 0 .. YDIM - 1);
+ xi, yi, xe, ye : Long_Float;
+ width, height, num_col : Integer;
+ img_f : Real_Matrix(0 .. 398, 0 .. 485); -- Lena is width 399, height 486.
+ img_min, img_max : Long_Float;
+ Get_Clip_Return : Integer;
+ type stretch_data is
+ record
+ xmin, xmax, ymin, ymax : Long_Float;
+ stretch : Long_Float;
+ end record;
+ stretch : stretch_data;
+ xx, yy : Long_Float;
+ f_name : String(1 .. 200);
+ f_name_length : Integer;
+ Save_Sombrero : Boolean := False;
+
+ -- Read image from file in binary ppm format.
+ procedure read_img
+ (fname : String; img_f : out Real_Matrix;
+ width, height, num_col : out Integer)
+ is
+ type Byte is mod 2 ** 8;
+ A_Byte : Byte;
+ package Lena_IO is new Ada.Sequential_IO(Byte);
+ use Lena_IO;
+ Input_File : Lena_IO.File_Type;
+ begin
+ -- Naive grayscale binary ppm reading. If you know how to, improve it.
+ -- Mine is naiver than yours.
+ -- lena.pgm has 133 bytes of header followed by 399 * 486 bytes of 8-bit pixels.
+ Lena_IO.Open(Input_File, In_File, fname);
+
+ for i in 1 .. 133 loop
+ Lena_IO.Read(Input_File, A_Byte);
+ end loop;
+
+ width := 399; -- columns
+ height := 486; -- rows
+ num_col := 255; -- number of colors
+
+ for j in img_f'range(2) loop
+ for i in img_f'range(1) loop
+ Lena_IO.Read(Input_File, A_Byte);
+ img_f(i, height - j - 1) := Long_Float(A_Byte); -- Flip image up-down.
+ end loop;
+ end loop;
+ end read_img;
+
+
+ -- Save plot.
+ procedure save_plot(fname : String) is
+ cur_strm, new_strm : Integer;
+ begin
+ Get_Stream_Number(cur_strm); -- Get current stream.
+ Make_Stream(new_strm); -- Create a new one.
+ Set_Device_Name("psc"); -- New device type. Use a known existing driver.
+ Set_Output_File_Name(fname); -- Set the file name.
+ Copy_State_Parameters(cur_strm, False); -- Copy old stream parameters to new stream.
+ Replot; -- Do the save.
+ End_PLplot_Current_Stream; -- Close new device...
+ Set_Stream_Number(cur_strm); -- ...and return to previous one.
+ end save_plot;
+
+
+ -- Get selection square interactively.
+ procedure get_clip(xi, xe, yi, ye : in out Long_Float; Return_This : out Integer) is
+ gin : Graphics_Input_Record_Type;
+ xxi : Long_Float := xi;
+ yyi : Long_Float := yi;
+ xxe : Long_Float := xe;
+ yye : Long_Float := ye;
+ t : Long_Float;
+ start : Integer := 0;
+ st : Boolean := False;
+ sx, sy : Real_Vector(0 .. 4);
+ begin
+ Set_XOR_Mode(True, st); -- Enter xor mode to draw a selection rectangle.
+
+ if st then -- Driver has xormod capability. Continue.
+ loop
+ Set_XOR_Mode(False, st);
+ Get_Cursor(gin);
+ Set_XOR_Mode(True, st);
+
+ if gin.button = 1 then
+ xxi := gin.wX;
+ yyi := gin.wY;
+ if start /= 0 then
+ Draw_Curve(sx, sy); -- Clear previous rectangle.
+ end if;
+
+ start := 0;
+
+ sx(0) := xxi;
+ sy(0) := yyi;
+ sx(4) := xxi;
+ sy(4) := yyi;
+ end if;
+
+ if (gin.state and Unsigned(16#100#)) /= 0 then
+ xxe := gin.wX;
+ yye := gin.wY;
+
+ if start /= 0 then
+ Draw_Curve(sx, sy); -- Clear previous rectangle.
+ end if;
+
+ start := 1;
+
+ sx(2) := xxe;
+ sy(2) := yye;
+ sx(1) := xxe;
+ sy(1) := yyi;
+ sx(3) := xxi;
+ sy(3) := yye;
+ Draw_Curve(sx, sy); -- Draw new rectangle.
+ end if;
+
+ if gin.button = 3 or gin.keysym = PLK_Return or
+ gin.keysym = unsigned(Character'pos('Q')) then
+ if start /= 0 then
+ Draw_Curve(sx, sy); -- Clear previous rectangle.
+ end if;
+ exit;
+ end if;
+ end loop;
+
+ Set_XOR_Mode(False, st); -- Leave xor mod.
+
+ if xxe < xxi then
+ t := xxi;
+ xxi := xxe;
+ xxe := t;
+ end if;
+
+ if yyi < yye then
+ t :=yyi;
+ yyi := yye;
+ yye := t;
+ end if;
+
+ xe := xxe;
+ xi := xxi;
+ ye := yye;
+ yi := yyi;
+
+ if gin.keysym = unsigned(Character'pos('Q')) then
+ Return_This := 1;
+ else
+ Return_This := 0;
+ end if;
+ else -- Driver has no xormod capability; just do nothing.
+ Return_This := 0;
+ end if;
+ end get_clip;
+
+
+ -- Set gray colormap.
+ procedure gray_cmap(num_col : Integer) is
+ r, g, b, pos : Real_Vector(0 .. 1);
+ A_Boolean : Boolean_Array_1D(1 .. 1);
+ begin
+ r(0) := 0.0;
+ g(0) := 0.0;
+ b(0) := 0.0;
+
+ r(1) := 1.0;
+ g(1) := 1.0;
+ b(1) := 1.0;
+
+ pos(0) := 0.0;
+ pos(1) := 1.0;
+
+ Set_Number_Of_Colors_In_Color_Map_1(num_col);
+ A_Boolean(1) := False;
+ Set_Color_Map_1_Piecewise(RGB, pos, r, g, b, A_Boolean);
+ end gray_cmap;
+
+
+ procedure mypltr
+ (x, y : Long_Float;
+ tx, ty : out Long_Float;
+ s : stretch_data)
+ is
+ x0, y0, dy : Long_Float;
+ begin
+ x0 := (s.xmin + s.xmax) * 0.5;
+ y0 := (s.ymin + s.ymax) * 0.5;
+ dy := (s.ymax - s.ymin) * 0.5;
+ tx := x0 + (x0 - x) * (1.0 - s.stretch * cos((y - y0) / dy * pi * 0.5));
+ ty := y;
+ end mypltr;
+
+begin
+ -- Bugs in Draw_Image_Color_Map_1_Automatic():
+ -- -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
+ Parse_Command_Line_Arguments(Parse_Full);
+
+ -- Initialize plplot
+ Initialize_PLplot;
+
+ -- View image border pixels.
+ if dbg /= 0 then
+ Set_Environment(1.0, Long_Float(XDIM), 1.0, Long_Float(YDIM), 1, 1); -- no plot box
+
+ -- Build a one pixel square border, for diagnostics.
+ for i in z'range(1) loop
+ z(i, YDIM - 1) := 1.0; -- right
+ end loop;
+
+ for i in z'range(1) loop
+ z(i, 0) := 1.0; -- left
+ end loop;
+
+ for i in z'range(2) loop
+ z(0, i) := 1.0; -- top
+ end loop;
+
+ for i in z'range(2) loop
+ z(XDIM - 1, i) := 1.0; -- botton
+ end loop;
+
+ Write_Labels("...around a blue square."," ","A red border should appear...");
+
+ Draw_Image_Color_Map_1_Automatic(z,
+ 1.0, Long_Float(XDIM), 1.0, Long_Float(YDIM), 0.0, 0.0,
+ 1.0, Long_Float(XDIM), 1.0, Long_Float(YDIM));
+
+ Advance_To_Subpage(Next_Subpage);
+ end if;
+
+ -- sombrero-like demo
+ if nosombrero = 0 then
+ Set_Pen_Color(Yellow); -- Draw a yellow plot box, useful for diagnostics! :(
+ Set_Environment(0.0, 2.0 * pi, 0.0, 3.0 * pi, 1, -1);
+
+ for i in x'range loop
+ x(i) := Long_Float(i) * 2.0 * pi / Long_Float(XDIM - 1);
+ end loop;
+
+ for i in y'range loop
+ y(i) := Long_Float(i) * 3.0 * pi / Long_Float(YDIM - 1);
+ end loop;
+
+ for i in z'range(1) loop
+ for j in z'range(2) loop
+ r(i, j) := sqrt(x(i) * x(i) + y(j) * y(j)) + 1.0e-3;
+ z(i, j) := sin(r(i, j)) / (r(i, j));
+ end loop;
+ end loop;
+
+ Write_Labels("No, an amplitude clipped ""sombrero""", "", "Saturn?");
+ Write_Text_World(2.0, 2.0, 3.0, 4.0, 0.0, "Transparent image");
+ Draw_Image_Color_Map_1_Automatic(z, 0.0, 2.0 * pi, 0.0, 3.0 * pi, 0.05, 1.0,
+ 0.0, 2.0 * pi, 0.0, 3.0 * pi);
+
+ -- Save the plot.
+ if Save_Sombrero then
+ Put("Enter a path and name to save the Postscript file or RETURN to not save: ");
+ Get_Line(f_name, f_name_length);
+ if f_name'Length /= 0 then
+ save_plot(f_name(1 .. f_name_length));
+ end if;
+ end if;
+
+ Advance_To_Subpage(Next_Subpage);
+ end if;
+
+ -- Read the Lena image.
+ -- Note we try two different locations to cover the case where this
+ -- examples is being run from the test_c.sh script.
+ begin
+ read_img("./lena.pgm", img_f, width, height, num_col);
+ exception
+ when NAME_ERROR =>
+ null;
+ begin
+ read_img("../lena.pgm", img_f, width, height, num_col);
+ exception
+ when NAME_ERROR =>
+ Put_Line("Failed to open lena.pgm. Aborting.");
+ End_PLplot;
+ return;
+ end; -- second exception block
+ end; -- first exception block
+
+ -- Set gray colormap.
+ gray_cmap(num_col);
+
+ -- Display Lena.
+ Set_Environment(1.0, Long_Float(width), 1.0, Long_Float(height), Justified, Box);
+
+ if nointeractive = 0 then
+ Write_Labels("Set and drag Button 1 to (re)set selection, Button 2 to finish."," ","Lena...");
+ else
+ Write_Labels(""," ","Lena...");
+ end if;
+
+ Draw_Image_Color_Map_1_Automatic(img_f, 1.0, Long_Float(width), 1.0, Long_Float(height), 0.0, 0.0, 1.0,
+ Long_Float(width), 1.0, Long_Float(height));
+
+ -- Selection/expansion demo
+ if nointeractive = 0 then
+ xi := 200.0;
+ xe := 330.0;
+ yi := 280.0;
+ ye := 220.0;
+
+ get_clip(xi, xe, yi, ye, Get_Clip_Return); -- get selection rectangle
+ if Get_Clip_Return /= 0 then
+ End_PLplot;
+ end if;
+
+ -- 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 Advance_To_Subpage() is not present! Using Begin_New_Page() solves the problem, but
+ -- it shouldn't be needed!
+
+ -- Begin_New_Page();
+
+ -- Set_Pause(0), Advance_To_Subpage(Next_Subpage), Set_Pause(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.
+
+ Set_Pause(False);
+ Advance_To_Subpage(Next_Subpage);
+
+ -- Display selection only.
+ Draw_Image_Color_Map_1_Automatic(img_f, 1.0, Long_Float(width), 1.0, Long_Float(height), 0.0, 0.0, xi, xe, ye, yi);
+
+ Set_Pause(True);
+ Advance_To_Subpage(Next_Subpage);
+
+ -- Zoom in selection.
+ Set_Environment(xi, xe, ye, yi, Justified, Box);
+ Draw_Image_Color_Map_1_Automatic(img_f, 1.0, Long_Float(width), 1.0, Long_Float(height), 0.0, 0.0, xi, xe, ye, yi);
+ Advance_To_Subpage(Next_Subpage);
+ end if;
+
+ -- Base the dynamic range on the image contents.
+ img_min := Matrix_Min(img_f);
+ img_max := Matrix_Max(img_f);
+
+ -- Draw a saturated version of the original image. Use only the middle 50%
+ -- of the image's full dynamic range.
+ Set_Pen_Color(Yellow);
+ Set_Environment(0.0, Long_Float(width), 0.0, Long_Float(height), Justified, Box);
+ Write_Labels("", "", "Reduced dynamic range image example");
+ Draw_Image_Color_Map_1(img_f, 0.0, Long_Float(width), 0.0, Long_Float(height), 0.0, 0.0,
+ img_min + img_max * 0.25, img_max - img_max * 0.25, Null, System.Null_Address);
+
+ -- Draw a distorted version of the original image, showing its full dynamic range.
+ Set_Environment(0.0, Long_Float(width), 0.0, Long_Float(height), Justified, Box);
+ Write_Labels("", "", "Distorted image example");
+
+ stretch.xmin := 0.0;
+ stretch.xmax := Long_Float(width);
+ stretch.ymin := 0.0;
+ stretch.ymax := Long_Float(height);
+ stretch.stretch := 0.5;
+
+ -- In C / C++ the following would work, with Draw_Image_Color_Map_1 directly calling
+ -- mypltr. For compatibilty with other language bindings the same effect
+ -- can be achieved by generating the transformed grid first and then
+ -- using Plot_Transformation_2.
+ -- Draw_Image_Color_Map_1(img_f, width, height, 0., width, 0., height, 0., 0., img_min, img_max, mypltr, (PLPointer) &stretch);
+
+ declare -- Declare block is based on runtime-determined values of width, height.
+ cgrid2 : aliased Transformation_Data_Type_2
+ (x_Last => width,
+ y_Last => height);
+ begin
+ for i in 0 .. width loop
+ for j in 0 .. height loop
+ mypltr(Long_Float(i), Long_Float(j), xx, yy, stretch);
+ cgrid2.xg(i, j) := xx;
+ cgrid2.yg(i, j) := yy;
+ end loop;
+ end loop;
+
+ Draw_Image_Color_Map_1(img_f, 0.0, Long_Float(width), 0.0, Long_Float(height), 0.0, 0.0, img_min, img_max,
+ Plot_Transformation_2'access, cgrid2'Address);
+ Advance_To_Subpage(Next_Subpage);
+ end;
+ End_PLplot;
+end xthick20a;
Property changes on: trunk/examples/ada/xthick20a.adb.cmake
___________________________________________________________________
Added: svn:keywords
+ Author Date Id Revision
Added: svn:eol-style
+ native
Modified: trunk/plplot_test/test_ada.sh.in
===================================================================
--- trunk/plplot_test/test_ada.sh.in 2008-08-21 21:46:56 UTC (rev 8701)
+++ trunk/plplot_test/test_ada.sh.in 2008-08-23 04:30:07 UTC (rev 8702)
@@ -31,10 +31,10 @@
# Skip 17 because it is interactive.
for index in \
01 02 03 04 05 06 07 08 09 \
-10 11 12 13 15 16 18 19 \
+10 11 12 13 15 16 18 19 20 \
21 22 23 24 25 26 27 28 29 30 \
thick01 thick02 thick03 thick04 thick05 thick06 thick07 thick08 thick09 \
-thick10 thick11 thick12 thick13 thick15 thick16 thick18 thick19 \
+thick10 thick11 thick12 thick13 thick15 thick16 thick18 thick19 thick20 \
thick21 thick22 thick23 thick24 thick25 thick26 thick27 thick28 thick29 thick30; do
if [ "$verbose_test" ]; then
echo "x${index}a"
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|