← Back to branch summary

~uhh-ssd/+junk/humidity_readout

« back to all changes in this revision

Viewing changes to plplot/plplot-5.9.9/examples/ada/x20a.adb

  • Committer: Joachim Erfle
  • Date: 2013-07-24 13:53:41 UTC
  • Revision ID: joachim.erfle@desy.de-20130724135341-1qojpp701zsn009p
initial commit

Show diffs side-by-side

added added

removed removed

Lines of Context:
plplot/plplot-5.9.9/examples/ada/x20a.adb
 
1
-- $Id: x20a.adb 11680 2011-03-27 17:57:51Z airwin $
 
2
 
 
3
-- plimage demo
 
4
 
 
5
-- Copyright (C) 2008 Jerry Bauck
 
6
 
 
7
-- This file is part of PLplot.
 
8
 
 
9
-- PLplot is free software; you can redistribute it and/or modify
 
10
-- it under the terms of the GNU Library General Public License as published
 
11
-- by the Free Software Foundation; either version 2 of the License, or
 
12
-- (at your option) any later version.
 
13
 
 
14
-- PLplot is distributed in the hope that it will be useful,
 
15
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
 
16
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 
17
-- GNU Library General Public License for more details.
 
18
 
 
19
-- You should have received a copy of the GNU Library General Public License
 
20
-- along with PLplot; if not, write to the Free Software
 
21
-- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
 
22
 
 
23
with
 
24
    Ada.Text_IO,
 
25
    Interfaces.C,
 
26
    System,
 
27
    Ada.Sequential_IO,
 
28
    Ada.Numerics,
 
29
    Ada.Numerics.Long_Elementary_Functions,
 
30
    PLplot_Traditional,
 
31
    PLplot_Auxiliary;
 
32
use
 
33
    Ada.Text_IO,
 
34
    Interfaces.C,
 
35
    System,
 
36
    Ada.Numerics,
 
37
    Ada.Numerics.Long_Elementary_Functions,
 
38
    PLplot_Traditional,
 
39
    PLplot_Auxiliary;
 
40
 
 
41
 
 
42
 
 
43
procedure x20a is
 
44
 
 
45
    XDIM : constant Integer := 260;
 
46
    YDIM : constant Integer := 220;
 
47
    PLK_Return : constant unsigned := 16#0D#;
 
48
    dbg : Integer := 0;
 
49
    nosombrero : Integer := 0;
 
50
    nointeractive : Integer := 0;
 
51
    x : Real_Vector(0 .. XDIM - 1);
 
52
    y : Real_Vector(0 .. YDIM - 1);
 
53
    z, r : Real_Matrix(0 .. XDIM - 1, 0 .. YDIM - 1);
 
54
    xi, yi, xe, ye : Long_Float; 
 
55
    width, height, num_col : Integer;
 
56
    img_f : Real_Matrix(0 .. 398, 0 .. 485); -- Lena is width 399, height 486.
 
57
    img_min, img_max : Long_Float;
 
58
    Get_Clip_Return : Integer;
 
59
    type stretch_data is
 
60
        record
 
61
            xmin, xmax, ymin, ymax : Long_Float;
 
62
            stretch                : Long_Float;
 
63
        end record;
 
64
    stretch : stretch_data;
 
65
    xx, yy : Long_Float;
 
66
    f_name : String(1 .. 200);
 
67
    f_name_length : Integer;
 
68
    Save_Sombrero : Boolean := False;
 
69
 
 
70
    -- Read image from file in binary ppm format.
 
71
    procedure read_img
 
72
       (fname : String; img_f : out Real_Matrix;
 
73
        width, height, num_col : out Integer) 
 
74
    is
 
75
        type Byte is mod 2 ** 8;
 
76
        A_Byte : Byte;
 
77
        package Lena_IO is new Ada.Sequential_IO(Byte);
 
78
        use Lena_IO;
 
79
        Input_File : Lena_IO.File_Type;
 
80
    begin
 
81
        -- Naive grayscale binary ppm reading. If you know how to, improve it.
 
82
        -- Mine is naiver than yours.
 
83
        -- lena.pgm has 133 bytes of header followed by 399 * 486 bytes of 8-bit pixels.
 
84
        Lena_IO.Open(Input_File, In_File, fname);
 
85
        
 
86
        for i in 1 .. 133 loop
 
87
            Lena_IO.Read(Input_File, A_Byte);
 
88
        end loop;
 
89
        
 
90
        width  := 399; -- columns
 
91
        height := 486; -- rows
 
92
        num_col := 255; -- number of colors
 
93
        
 
94
        for j in img_f'range(2) loop
 
95
            for i in img_f'range(1) loop
 
96
                Lena_IO.Read(Input_File, A_Byte);
 
97
                img_f(i, height - j - 1) := Long_Float(A_Byte); -- Flip image up-down.
 
98
            end loop;
 
99
        end loop;
 
100
    end read_img;
 
101
 
 
102
 
 
103
    -- Save plot.
 
104
    procedure save_plot(fname : String) is
 
105
        cur_strm, new_strm : Integer; 
 
106
    begin
 
107
        plgstrm(cur_strm); -- Get current stream.
 
108
        plmkstrm(new_strm); -- Create a new one.
 
109
        plsdev("psc"); -- New device type. Use a known existing driver.
 
110
        plsfnam(fname); -- Set the file name.
 
111
        plcpstrm(cur_strm, False); -- Copy old stream parameters to new stream.
 
112
        plreplot;       -- Do the save.
 
113
        plend1; -- Close new device...
 
114
        plsstrm(cur_strm);      -- ...and return to previous one.
 
115
    end save_plot;
 
116
 
 
117
 
 
118
    -- Get selection square interactively.
 
119
    procedure get_clip(xi, xe, yi, ye : in out Long_Float; Return_This : out Integer) is
 
120
        gin : Graphics_Input_Record_Type;
 
121
        xxi : Long_Float := xi; 
 
122
        yyi : Long_Float := yi;
 
123
        xxe : Long_Float := xe;
 
124
        yye : Long_Float := ye;
 
125
        t : Long_Float;
 
126
        start : Integer := 0;
 
127
        st : Boolean := False;
 
128
        sx, sy : Real_Vector(0 .. 4);
 
129
    begin
 
130
        plxormod(True, st); -- Enter xor mode to draw a selection rectangle.
 
131
 
 
132
        if st then -- Driver has xormod capability. Continue.
 
133
            loop
 
134
                plxormod(False, st);
 
135
                plGetCursor(gin);
 
136
                plxormod(True, st);
 
137
 
 
138
                if gin.button = 1 then
 
139
                    xxi := gin.wX;
 
140
                    yyi := gin.wY;
 
141
                    if start /= 0 then
 
142
                        -- Suppress warning """sy"" may be referenced before it has a value".
 
143
                        pragma Warnings(Off);
 
144
                        plline(sx, sy); -- Clear previous rectangle.
 
145
                        pragma Warnings(On);
 
146
                    end if;
 
147
        
 
148
                    start := 0;
 
149
 
 
150
                    sx(0) := xxi;
 
151
                    sy(0) := yyi;
 
152
                    sx(4) := xxi;
 
153
                    sy(4) := yyi;
 
154
                end if;
 
155
 
 
156
                if (gin.state and Unsigned(16#100#)) /= 0 then
 
157
                    xxe := gin.wX;
 
158
                    yye := gin.wY;
 
159
                    
 
160
                    if start /= 0 then
 
161
                        plline(sx, sy); -- Clear previous rectangle.
 
162
                    end if;
 
163
        
 
164
                    start := 1;
 
165
            
 
166
                    sx(2) := xxe;
 
167
                    sy(2) := yye;
 
168
                    sx(1) := xxe;
 
169
                    sy(1) := yyi;
 
170
                    sx(3) := xxi;
 
171
                    sy(3) := yye;
 
172
                    plline(sx, sy); -- Draw new rectangle.
 
173
                end if;
 
174
 
 
175
                if gin.button = 3 or gin.keysym = PLK_Return or 
 
176
                    gin.keysym = unsigned(Character'pos('Q')) then
 
177
                    if start /= 0 then
 
178
                        plline(sx, sy); -- Clear previous rectangle.
 
179
                    end if;
 
180
                    exit;
 
181
                end if;
 
182
            end loop;
 
183
        
 
184
            plxormod(False, st); -- Leave xor mod.
 
185
 
 
186
            if xxe < xxi then
 
187
                t   := xxi;
 
188
                xxi := xxe;
 
189
                xxe := t;
 
190
            end if;
 
191
        
 
192
            if yyi < yye then
 
193
                t   :=yyi;
 
194
                yyi := yye;
 
195
                yye := t;
 
196
            end if;
 
197
        
 
198
            xe := xxe;
 
199
            xi := xxi;
 
200
            ye := yye;
 
201
            yi := yyi;
 
202
            
 
203
            if gin.keysym = unsigned(Character'pos('Q')) then
 
204
                Return_This := 1;
 
205
            else
 
206
                Return_This := 0;
 
207
            end if;
 
208
        else -- Driver has no xormod capability; just do nothing.
 
209
            Return_This := 0;
 
210
        end if;
 
211
    end get_clip;
 
212
 
 
213
 
 
214
    -- Set gray colormap.
 
215
    procedure gray_cmap(num_col : Integer) is
 
216
        r, g, b, pos : Real_Vector(0 .. 1);
 
217
    begin
 
218
        r(0) := 0.0;
 
219
        g(0) := 0.0;
 
220
        b(0) := 0.0;
 
221
 
 
222
        r(1) := 1.0;
 
223
        g(1) := 1.0;
 
224
        b(1) := 1.0;
 
225
 
 
226
        pos(0) := 0.0;
 
227
        pos(1) := 1.0;
 
228
 
 
229
        plscmap1n(num_col);
 
230
        plscmap1l(RGB, pos, r, g, b, Reverse_Hue_None);
 
231
    end gray_cmap;
 
232
 
 
233
 
 
234
    procedure mypltr
 
235
       (x, y   : Long_Float; 
 
236
        tx, ty : out Long_Float; 
 
237
        s      : stretch_data)
 
238
    is
 
239
        x0, y0, dy : Long_Float;
 
240
    begin
 
241
        x0 := (s.xmin + s.xmax) * 0.5;
 
242
        y0 := (s.ymin + s.ymax) * 0.5;
 
243
        dy := (s.ymax - s.ymin) * 0.5;
 
244
        tx := x0 + (x0 - x) * (1.0 - s.stretch * cos((y - y0) / dy * pi * 0.5));
 
245
        ty := y;
 
246
    end mypltr;
 
247
 
 
248
begin
 
249
    --  Bugs in plimage():
 
250
    -- -at high magnifications, the left and right edge are ragged. Try
 
251
    -- ./x20c -dev xwin -wplt 0.3,0.3,0.6,0.6 -ori 0.5.
 
252
     
 
253
    -- Bugs in x20c.c:
 
254
    -- -if the window is resized after a selection is made on "lena", when
 
255
    -- making a new selection the old one will re-appear.
 
256
 
 
257
 
 
258
    -- Parse and process command line arguments
 
259
    plparseopts(PL_PARSE_FULL);
 
260
 
 
261
    -- Initialize plplot
 
262
    plinit;
 
263
 
 
264
    -- View image border pixels.
 
265
    if dbg /= 0 then
 
266
        plenv(1.0, Long_Float(XDIM), 1.0, Long_Float(YDIM), 1, 1); -- no plot box
 
267
 
 
268
        -- Build a one pixel square border, for diagnostics.
 
269
        for i in z'range(1) loop
 
270
            z(i, YDIM - 1) := 1.0; -- right
 
271
        end loop;
 
272
 
 
273
        for i in z'range(1) loop
 
274
            z(i, 0) := 1.0; -- left
 
275
        end loop;
 
276
 
 
277
        for i in z'range(2) loop
 
278
            z(0, i) := 1.0; -- top
 
279
        end loop;
 
280
 
 
281
        for i in z'range(2) loop
 
282
            z(XDIM - 1, i) := 1.0; -- botton
 
283
        end loop;
 
284
 
 
285
        pllab("...around a blue square."," ","A red border should appear...");
 
286
 
 
287
        plimage(z,
 
288
            1.0, Long_Float(XDIM), 1.0, Long_Float(YDIM), 0.0, 0.0,
 
289
            1.0, Long_Float(XDIM), 1.0, Long_Float(YDIM));
 
290
    end if;
 
291
 
 
292
    -- sombrero-like demo
 
293
    if nosombrero = 0 then
 
294
        plcol0(2); -- Draw a yellow plot box, useful for diagnostics! :(
 
295
        plenv(0.0, 2.0 * pi, 0.0, 3.0 * pi, 1, -1);
 
296
 
 
297
        for i in x'range loop
 
298
            x(i) := Long_Float(i) * 2.0 * pi / Long_Float(XDIM - 1);
 
299
        end loop;
 
300
        
 
301
        for i in y'range loop
 
302
            y(i) := Long_Float(i) * 3.0 * pi / Long_Float(YDIM - 1);
 
303
        end loop;
 
304
 
 
305
        for i in z'range(1) loop
 
306
            for j in z'range(2) loop
 
307
                r(i, j) := sqrt(x(i) * x(i) + y(j) * y(j)) + 1.0e-3;
 
308
                z(i, j) := sin(r(i, j)) / (r(i, j));
 
309
            end loop;
 
310
        end loop;
 
311
 
 
312
        pllab("No, an amplitude clipped ""sombrero""", "", "Saturn?");
 
313
        plptex(2.0, 2.0, 3.0, 4.0, 0.0, "Transparent image");
 
314
        plimage(z, 0.0, 2.0 * pi, 0.0, 3.0 * pi, 0.05, 1.0,
 
315
            0.0, 2.0 * pi, 0.0, 3.0 * pi); 
 
316
 
 
317
        -- Save the plot.
 
318
        if Save_Sombrero then
 
319
            Put("Enter a path and name to save the Postscript file or RETURN to not save: ");
 
320
            Get_Line(f_name, f_name_length);
 
321
            if f_name'Length /= 0 then
 
322
                save_plot(f_name(1 .. f_name_length));
 
323
            end if;
 
324
        end if;
 
325
    end if;
 
326
 
 
327
    -- Read the Lena image.
 
328
    -- Note we try two different locations to cover the case where this
 
329
    -- examples is being run from the test_c.sh script.
 
330
    begin
 
331
        read_img("./lena.pgm", img_f, width, height, num_col);
 
332
    exception
 
333
        when NAME_ERROR =>
 
334
            null;
 
335
        begin
 
336
            read_img("../lena.pgm", img_f, width, height, num_col);
 
337
        exception
 
338
            when NAME_ERROR =>
 
339
                Put_Line("Failed to open lena.pgm. Aborting.");
 
340
                plend;
 
341
                return;
 
342
        end; -- second exception block
 
343
    end; -- first exception block
 
344
 
 
345
    -- Set gray colormap.
 
346
    gray_cmap(num_col);
 
347
 
 
348
    -- Display Lena.
 
349
    plenv(1.0, Long_Float(width), 1.0, Long_Float(height), 1, -1);
 
350
 
 
351
    if nointeractive = 0 then
 
352
        pllab("Set and drag Button 1 to (re)set selection, Button 2 to finish."," ","Lena...");
 
353
    else
 
354
        pllab(""," ","Lena...");
 
355
    end if;
 
356
 
 
357
    plimage(img_f, 1.0, Long_Float(width), 1.0, Long_Float(height), 0.0, 0.0, 1.0, 
 
358
        Long_Float(width), 1.0, Long_Float(height));
 
359
 
 
360
    -- Selection/expansion demo
 
361
    if nointeractive = 0 then
 
362
        xi := 200.0;
 
363
        xe := 330.0;
 
364
        yi := 280.0;
 
365
        ye := 220.0;
 
366
 
 
367
        get_clip(xi, xe, yi, ye, Get_Clip_Return); -- get selection rectangle
 
368
        if Get_Clip_Return /= 0 then
 
369
            plend;
 
370
        end if;
 
371
      
 
372
        -- I'm unable to continue, clearing the plot and advancing to the next
 
373
        -- one, without hiting the enter key, or pressing the button... help!
 
374
 
 
375
        -- Forcing the xwin driver to leave locate mode and destroying the
 
376
        -- xhairs (in GetCursorCmd()) solves some problems, but I still have
 
377
        -- to press the enter key or press Button-2 to go to next plot, even
 
378
        -- if a pladv() is not present!  Using plbop() solves the problem, but
 
379
        -- it shouldn't be needed! 
 
380
 
 
381
        -- plbop();
 
382
 
 
383
        -- plspause(0), pladv(0), plspause(1), also works,
 
384
        -- but the above question remains.
 
385
        -- With this approach, the previous pause state is lost,
 
386
        -- as there is no API call to get its current state.
 
387
 
 
388
        plspause(False);
 
389
        pladv(0);
 
390
 
 
391
        -- Display selection only.
 
392
        plimage(img_f, 1.0, Long_Float(width), 1.0, Long_Float(height), 0.0, 0.0, xi, xe, ye, yi);
 
393
 
 
394
        plspause(True);
 
395
 
 
396
        -- Zoom in selection.
 
397
        plenv(xi, xe, ye, yi, 1, -1);
 
398
        plimage(img_f, 1.0, Long_Float(width), 1.0, Long_Float(height), 0.0, 0.0, xi, xe, ye, yi);
 
399
    end if;
 
400
 
 
401
    -- Base the dynamic range on the image contents.
 
402
    img_min := Matrix_Min(img_f);
 
403
    img_max := Matrix_Max(img_f);
 
404
 
 
405
    -- Draw a saturated version of the original image. Use only the middle 50%
 
406
    -- of the image's full dynamic range.
 
407
    plcol0(2);
 
408
    plenv(0.0, Long_Float(width), 0.0, Long_Float(height), 1, -1);
 
409
    pllab("", "", "Reduced dynamic range image example");
 
410
    plimagefr(img_f, 0.0, Long_Float(width), 0.0, Long_Float(height), 0.0, 0.0, 
 
411
        img_min + img_max * 0.25, img_max - img_max * 0.25, Null, System.Null_Address);
 
412
 
 
413
    -- Draw a distorted version of the original image, showing its full dynamic range.
 
414
    plenv(0.0, Long_Float(width), 0.0, Long_Float(height), 1, -1);
 
415
    pllab("", "", "Distorted image example");
 
416
 
 
417
    stretch.xmin := 0.0;
 
418
    stretch.xmax := Long_Float(width);
 
419
    stretch.ymin := 0.0;
 
420
    stretch.ymax := Long_Float(height);
 
421
    stretch.stretch := 0.5;
 
422
 
 
423
    -- In C / C++ the following would work, with plimagefr directly calling
 
424
    -- mypltr. For compatibilty with other language bindings the same effect
 
425
    -- can be achieved by generating the transformed grid first and then
 
426
    -- using pltr2.
 
427
    -- plimagefr(img_f, width, height, 0., width, 0., height, 0., 0., img_min, img_max, mypltr, (PLPointer) &stretch);
 
428
 
 
429
    declare -- Declare block is based on runtime-determined values of width, height.
 
430
        cgrid2 : aliased Transformation_Data_Type_2
 
431
           (x_Last => width,
 
432
            y_Last => height);
 
433
    begin
 
434
        for i in 0 .. width loop
 
435
            for j in 0 .. height loop
 
436
                mypltr(Long_Float(i), Long_Float(j), xx, yy, stretch);
 
437
                cgrid2.xg(i, j) := xx;
 
438
                cgrid2.yg(i, j) := yy;
 
439
            end loop;
 
440
        end loop;
 
441
          
 
442
        plimagefr(img_f, 0.0, Long_Float(width), 0.0, Long_Float(height), 0.0, 0.0, img_min, img_max, 
 
443
            pltr2'access, cgrid2'Address);
 
444
    end;
 
445
    plend;
 
446
end x20a;