----------------------------------------------------------------------- -- Demonstration program for PGPLOT. The main program opens the output -- device and calls a series of subroutines, one for each sample plot. ----------------------------------------------------------------------- -- WITH Pg_interface; USE Pg_interface; WITH Interfaces.Fortran; USE Interfaces.Fortran; WITH Ada.Numerics.Generic_Elementary_Functions; WITH Text_IO; WITH Fx, Fy, Bessel_0, Bessel_1; PROCEDURE Pg_demo_1 IS PACKAGE Int_IO IS NEW Text_IO.Integer_IO (Integer); PACKAGE Math_Lib IS NEW Ada.Numerics.Generic_Elementary_Functions (Real); USE Math_Lib; Open_error : EXCEPTION; Istat : Integer; ------------------------------------------------------------------ -- This example illustrates the use of PGENV, PGLAB, PGPT, PGLINE ------------------------------------------------------------------ PROCEDURE Pg_Ex1 IS XS : Pg_Real_Arr_type (1..5) := (1.0, 2.0, 3.0, 4.0, 5.0); YS : Pg_Real_Arr_type (1..5) := (1.0, 4.0, 9.0, 16.0, 25.0); XR, YR : Pg_Real_Arr_type (1..100); BEGIN -- Call PGENV to specify the range of the axes and to draw a box, and -- PGLAB to label it. The x-axis runs from 0 to 10, and y from 0 to 20. Pg_Set_Environment (0.0, 10.0, 0.0, 20.0, 0, 1); Pg_Write_Label ("(x)", "(y)", "PGPLOT Example 1: y = x\u2"); -- Mark five points (coordinates in arrays XS and YS), using symbol -- number 9. Pg_Draw_Points (5, XS, YS, 9); -- Compute the function at 60 points, and use PGLINE to draw it. FOR I In 1..60 LOOP XR(I) := 0.1 * Real (I); YR(I) := XR(I)**2; END LOOP; Pg_Draw_Polyline (60, XR, YR); END Pg_Ex1; -------------------------------------------------------------------- -- Repeat the process for another graph. This one is a graph of the -- sinc (sin x over x) function. -------------------------------------------------------------------- PROCEDURE Pg_Ex2 IS XR, YR : Pg_Real_Arr_type (1..100); BEGIN Pg_Set_Environment (-2.0, 10.0, -0.4, 1.2, 0, 1); Pg_Write_Label ("(x)", "sin(x)/x", "PGPLOT Example 2: Sinc Function"); FOR I IN 1..100 LOOP XR(I) := Real (I-20) / 6.0; YR(I) := 1.0; IF (XR(I) /= 0.0) THEN YR(I) := Sin (XR(I)) / XR(I); END IF; END LOOP; Pg_Draw_Polyline (100, XR, YR); END Pg_Ex2; ----------------------------------------------------------------------- -- This example illustrates the use of PGBOX and attribute routines to -- mix colors and line-styles. ----------------------------------------------------------------------- PROCEDURE Pg_Ex3 IS PI : CONSTANT Real := Ada.Numerics.Pi; XR, YR : Pg_Real_Arr_Type (1..360); Arg : Real; BEGIN -- Call PGENV to initialize the viewport and window; the -- AXIS argument is -2, so no frame or labels will be drawn. Pg_Set_Environment (0.0, 720.0, -2.0, 2.0, 0, -2); Pg_Save; -- Set the color index for the axes and grid (index 5 = cyan). -- Call PGBOX to draw first a grid at low brightness, and then a -- frame and axes at full brightness. Note that as the x-axis is -- to represent an angle in degrees, we request an explicit tick -- interval of 90 deg with subdivisions at 30 deg, as multiples of -- -- 3 are a more natural division than the default. Pg_Set_Color_Index (14); Pg_Draw_Box ("G", 30.0, 0, "G", 0.2, 0); Pg_Set_Color_Index (5); Pg_Draw_Box ("ABCTSN", 90.0, 3, "ABCTSNV", 0.0, 0); -- Call PGLAB to label the graph in a different color (3=green). Pg_Set_Color_Index (3); Pg_Write_Label ("x (degrees)","f(x)","PGPLOT Example 3"); -- Compute the function to be plotted: a trig function of an -- angle in degrees, computed every 2 degrees. FOR I IN 1..360 LOOP XR(I) := 2.0 * Real (I); ARG := XR(I) / 180.0 * PI; YR(I) := Sin (ARG) + 0.5 * Cos (2.0*ARG) + 0.5 * Sin (1.5*ARG + PI/3.0); END LOOP; -- Change the color (6=magenta), line-style (2=dashed), and line -- width and draw the function. Pg_Set_Color_Index (6); Pg_Set_Line_Style (2); Pg_Set_Line_Width (3); Pg_Draw_Polyline (360, XR, YR); -- Restore attributes to defaults. Pg_Unsave; END Pg_Ex3; ------------------------------------------------------------------------ -- Demonstration program for the PGPLOT plotting package. This example -- illustrates curve drawing with PGFUNT; the parametric curve drawn is -- a simple Lissajous figure. -------------------------------------------------------------------------- PROCEDURE Pg_Ex9 IS BEGIN -- Call PGFUNT to draw the function (autoscaling). Pg_Set_Line_Style (1); Pg_Begin_Buffer; Pg_Save; Pg_Set_Color_Index (5); Pg_Draw_Function_xy (Fx'ACCESS, Fy'ACCESS, 360, 0.0, 2.0 * 3.14159265, 0); -- Call PGLAB to label the graph in a different color. Pg_Set_Color_Index (3); Pg_Write_Label ("x", "y", "PGPLOT Example 9: routine PGFUNT"); Pg_Unsave; Pg_End_Buffer; END Pg_Ex9; ------------------------------------------------------------------------ -- Demonstration program for the PGPLOT plotting package. This example -- illustrates curve drawing with PGFUNX. -- T. J. Pearson 1983 Oct 5 ------------------------------------------------------------------------ -- The following define mnemonic names for the color indices and -- linestyle codes. PROCEDURE Pg_Ex10 IS BLACK : Integer := 0; WHITE : Integer := 1; RED : Integer := 2; GREEN : Integer := 3; BLUE : Integer := 4; CYAN : Integer := 5; MAGENT : Integer := 6; YELLOW : Integer := 7; FULL : Integer := 1; DASH : Integer := 2; DOTD : Integer := 3; BEGIN -- Call PGFUNX twice to draw two functions (autoscaling the first time). Pg_Begin_Buffer; Pg_Save; Pg_Set_Color_Index (YELLOW); Pg_Draw_Function_x (Bessel_0'ACCESS, 500, 0.0, 10.0 * 3.14159265, 0); Pg_Set_Color_Index (RED); Pg_Set_Line_Style (DASH); Pg_Draw_Function_x (Bessel_1'ACCESS, 500, 0.0, 10.0 * 3.14159265, 1); -- Call PGLAB to label the graph in a different color. Note the -- use of "\f" to change font. Use PGMTXT to write an additional -- legend inside the viewport. Pg_Set_Color_Index (GREEN); Pg_Set_Line_Style (FULL); Pg_Write_Label ("\fix", "\fiy", "\frPGPLOT Example 10: routine PGFUNX"); Pg_Write_Text_Relative ("T", -4.0, 0.5, 0.5, "\frBessel Functions"); -- Call PGARRO to label the curves. Pg_Draw_Arrow (8.0, 0.7, 1.0, Bessel_0(1.0)); Pg_Draw_Arrow (12.0, 0.5, 9.0, Bessel_1(9.0)); Pg_Set_Text_Background_Color_Index (GREEN); Pg_Set_Color_Index(0); Pg_Write_Text_Arbitrary ( 8.0, 0.7, 0.0, 0.0, " \fiy = J\d0\u(x)"); Pg_Write_Text_Arbitrary (12.0, 0.5, 0.0, 0.0, " \fiy = J\d1\u(x)"); Pg_Unsave; Pg_End_Buffer; END Pg_Ex10; BEGIN -- Call PGOPEN to initiate PGPLOT and open the output device; PGOPEN -- will prompt the user to supply the device name and type. Always -- check the return code from PGOPEN. Istat := Pg_open (to_fortran ("?")); Int_IO.Put (Istat); Text_IO.New_Line; IF (Istat > 0) THEN RAISE Open_error; END IF; -- Call the demonstration subroutines (4,5 are put on one page) Pg_Ex1; Pg_Ex2; Pg_Ex3; Pg_Ex9; Pg_Ex10; -- Finally, call PGCLOS to terminate things properly. Pg_Close; END Pg_demo_1; ------------------------------------------------------------------------- -- Bessel function of order 0 (approximate). -- Reference: Abramowitz and Stegun: Handbook of Mathematical Functions. ------------------------------------------------------------------------- -- WITH Ada.Numerics.Generic_Elementary_Functions; WITH Interfaces.Fortran; USE Interfaces.Fortran; FUNCTION Bessel_0 (xx : Real) RETURN Real IS PACKAGE Math IS NEW Ada.Numerics.Generic_Elementary_Functions (Real); USE Math; X, XO3, T, F0, THETA0 : Real; BEGIN X := ABS (XX); IF (X <= 3.0) THEN XO3 := X / 3.0; T := XO3 * XO3; RETURN 1.0 + T * (-2.2499997 + T * ( 1.2656208 + T * (-0.3163866 + T * ( 0.0444479 + T * (-0.0039444 + T * ( 0.0002100 )))))); ELSE T := 3.0 / X; F0 := 0.79788456 + T * (-0.00000077 + T * (-0.00552740 + T * (-0.00009512 + T * ( 0.00137237 + T * (-0.00072805 + T * ( 0.00014476 )))))); THETA0 := X - 0.78539816 + T * (-0.04166397 + T * (-0.00003954 + T * ( 0.00262573 + T * (-0.00054125 + T * (-0.00029333 + T * ( 0.00013558 )))))); RETURN F0 * Cos (THETA0) / Sqrt (X); END IF; END Bessel_0; ------------------------------------------------------------------------- -- Bessel function of order 1 (approximate). -- Reference: Abramowitz and Stegun: Handbook of Mathematical Functions. ------------------------------------------------------------------------- -- WITH Ada.Numerics.Generic_Elementary_Functions; WITH Interfaces.Fortran; USE Interfaces.Fortran; FUNCTION Bessel_1 (xx : Real) RETURN Real IS PACKAGE Math IS NEW Ada.Numerics.Generic_Elementary_Functions (Real); USE Math; Help, X, XO3, T, F1, THETA1 : Real; BEGIN X := ABS (XX); IF (X <= 3.0) THEN XO3 := X / 3.0; T := XO3 * XO3; Help := 0.5 + T * (-0.56249985 + T * ( 0.21093573 + T * (-0.03954289 + T * ( 0.00443319 + T * (-0.00031761 + T * ( 0.00001109 )))))); Help := Help * XX; ELSE T := 3.0 / X; F1 := 0.79788456 + T * ( 0.00000156 + T * ( 0.01659667 + T * ( 0.00017105 + T * (-0.00249511 + T * ( 0.00113653 + T * (-0.00020033 )))))); THETA1 := X -2.35619449 + T * ( 0.12499612 + T * ( 0.00005650 + T * (-0.00637879 + T * ( 0.00074348 + T * ( 0.00079824 + T * (-0.00029166 )))))); Help := F1 * Cos (THETA1) / Sqrt (X); END IF; IF (XX < 0.0) THEN Help := -Help; END IF; RETURN Help; END Bessel_1; WITH Ada.Numerics.Generic_Elementary_Functions; WITH Interfaces.Fortran; USE Interfaces.Fortran; ----------------------------------------- FUNCTION Fx (T : Real) RETURN Real IS PACKAGE Math IS NEW Ada.Numerics.Generic_Elementary_Functions (Real); BEGIN RETURN Math.Sin (T * 5.0); END Fx; WITH Ada.Numerics.Generic_Elementary_Functions; WITH Interfaces.Fortran; USE Interfaces.Fortran; ----------------------------------------- FUNCTION Fy (T : Real) RETURN Real IS PACKAGE Math IS NEW Ada.Numerics.Generic_Elementary_Functions (Real); BEGIN RETURN Math.Sin (T * 4.0); END Fy;