DISLIN Examples / Free Pascal

Demonstration of CURVE / Free Pascal

program dislin_curve;

uses
   dislin;

const
   n =  100;

var
   i, ic	 : int32;
   fpi, step, x	 : double;
   xray, y1ray, y2ray : array[0..n-1] of double;

begin
   fpi := 3.1415926 / 180.0;
   step := 360.0 / (n - 1);
   for i:= 0 to n - 1 do
   begin
      xray[i] := i * step;
      x := xray[i] * fpi;
      y1ray[i] := sin (x); 
      y2ray[i] := cos (x); 
   end;

   metafl ('cons');
   scrmod ('reverse');
   disini ();
   pagera ();
   complx ();
   axspos (450, 1800);
   axslen (2200, 1200);

   name ('X-axis', 'X');
   name ('Y-axis', 'Y');

   labdig (-1, 'x');
   ticks (9, 'x');
   ticks (10, 'y');

   titlin ('Demonstration of CURVE', 1);
   titlin ('SIN(X), COS(X)', 3);

   ic := intrgb (0.95, 0.95, 0.95);
   axsbgd (ic);
   
   graf (0.0, 360.0, 0.0, 90.0, -1.0, 1.0, -1.0, 0.5);
   setrgb (0.7, 0.7, 0.7);
   grid   (1, 1);

   color ('fore');
   height (50);
   title ();

   color ('red');
   curve (@xray[0], @y1ray[0], n);
   color ('green');
   curve (@xray[0], @y2ray[0], n);
   disfin ();
end.
}

Polar Plots / Free Pascal

program dislin_polar;

uses
   dislin;

const
   n = 300;
   m =  10;
   
var
   i, ic	: int32;
   f, step, a	: double;
   xray, yray	: array[0..n-1] of double;
   x2, y2	: array[0..m-1] of double;

begin
   f := 3.1415926 / 180.0;
   step := 360.0 / (n - 1);
   for i:= 0 to n - 1 do
   begin   
      a := i * step * f;
      yray[i] := a;
      xray[i] := sin (5 * a);
   end;

   for i:= 0 to m - 1 do
   begin   
      x2[i] := i + 1;
      y2[i] := i + 1;
   end;

   setpag ('da4p');
   metafl ('cons');
   scrmod ('revers');
   disini ();
   pagera ();
   hwfont ();
   axspos (450,1800);

   titlin ('Polar Plots', 2);
   ticks  (3, 'Y');
   axends ('NOENDS', 'X');
   labdig (-1, 'Y');
   axslen (1000, 1000);
   axsorg (1050, 900);

   ic := intrgb (0.95, 0.95, 0.95);
   axsbgd (ic);
 
   grafp  (1.0, 0.0, 0.2, 0.0, 30.0);
   color  ('blue');
   curve  (@xray[0], @yray[0], n);
   color  ('fore');
   htitle (50);
   title  ();
   endgrf ();

   labdig (-1, 'X');
   axsorg (1050, 2250);
   labtyp ('VERT', 'Y');
   grafp  (10.0, 0.0, 2.0, 0.0, 30.0);
   barwth (-5.0);
   polcrv ('FBARS');
   color  ('blue');
   curve  (@x2[0], @y2[0], m);
   disfin ();
end.

Symbols / Free Pascal

program dislin_symbols;

uses
   dislin;

var
   nl, ny, i, nxp : int32;
   ctit, cstr	  : AnsiString;

begin
   ctit := 'Symbols';
   SetLength (cstr, 80);
   
   scrmod ('revers');
   setpag ('da4p');
   metafl ('cons');
   disini ();
   pagera ();
   complx ();

   height (60);
   nl := nlmess (ctit);
   nxp := (2100 - nl) div 2;
   messag (ctit, nxp, 200);

   height (50);
   hsymbl (120);

   ny := 150;

   for i := 0 to 23 do
   begin
      if (i mod 4) = 0 then
      begin 	 
	 ny  := ny + 400;
	 nxp := 550;
      end
      else
      begin	 
	 nxp := nxp + 350;
      end;

      nl := intcha (i, cstr);
      nl := nlmess (cstr) div 2;
      messag (cstr, nxp - nl, ny + 150);
      symbol (i, nxp, ny);
   end;
   disfin ();
end.

Interpolation Methods / Free Pascal

program dislin_intpol;

uses
   dislin;

const
   n = 16;

var
   nya		 : int32 = 2700;
   i, nx, ny, ic : int32;
   x : array[0..n-1] of double = (0.0, 1.0, 3.0, 4.5, 6.0, 8.0, 9.0,
		 11.0, 12.0, 12.5, 13.0, 15.0, 16.0, 17.0, 19.0, 20.0);
   y : array[0..n-1] of double = (2.0, 4.0, 4.5, 3.0, 1.0, 7.0, 2.0,
		  3.0, 5.0, 2.0, 2.5, 2.0, 4.0, 6.0, 5.5, 4.0);
   cpol : array[0..5] of ansistring = ('SPLINE', 'STEM', 'BARS', 'STAIRS',
		  'STEP', 'LINEAR');
   ctit : ansistring = 'Interpolation Methods';

begin
   setpag ('da4p');
   metafl ('cons');
   scrmod ('revers');
   disini ();
   complx ();
   pagera ();
   incmrk (1);
   hsymbl (25);
   titlin (ctit, 2);
   axslen (1500, 350);
   setgrf ('line', 'line', 'line', 'line');
   ic := intrgb (1.0, 1.0, 0.0);
   axsbgd (ic);

   for i := 0 to 5 do
   begin
      axspos (350, nya - i * 350);
      polcrv (cpol[i]);
      marker(16);

      graf   (0.0, 20.0, 0.0, 5.0, 0.0, 10.0, 0.0, 5.0);
      nx := nxposn (1.0);
      ny := nyposn (8.0);
      messag (cpol[i], nx, ny);
      color  ('red');
      curve  (x, y, 16);
      color  ('fore');

      if i = 5 then
      begin
	 height (50);
         title  ();
      end;
      endgrf ();
   end;
   disfin ();
end.

Bar Graphs / Free Pascal

program dislin_bars;

uses
   dislin;

var
   nya, i : int32;
   ctit	  : ansistring = 'Bar Graphs (BARS)';
   cbuf	  : ansistring;
   x  : array[0..8] of double = (1.0, 2.0, 3.0, 4.0, 5.0, 6.0, 7.0, 8.0, 9.0);
   y  : array[0..8] of double = (0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0);
   y1 : array[0..8] of double = (1.0, 1.5, 2.5, 1.3, 2.0, 1.2, 0.7, 1.4, 1.1);
   y2 : array[0..8] of double = (2.0, 2.7, 3.5, 2.1, 3.2, 1.9, 2.0, 2.3, 1.8);
   y3 : array[0..8] of double = (4.0, 3.5, 4.5, 3.7, 4.0, 2.9, 3.0, 3.2, 2.6);

begin
   nya  := 2700;
   SetLength (cbuf, 25);
   
   scrmod ('revers');
   setpag ('da4p');
   metafl ('cons');
   disini ();
   pagera ();
   complx ();
   ticks  (1, 'x');
   intax  ();;
   axslen (1600, 700);
   titlin (ctit, 3);

   legini (cbuf, 3, 8);
   leglin (cbuf, 'FIRST', 1);
   leglin (cbuf, 'SECOND', 2);
   leglin (cbuf, 'THIRD', 3);
   legtit (' ');
   shdpat (5);
   for i := 1 to 3 do
   begin  
      if i > 1 then
	 labels ('none', 'x');
      axspos (300, nya - (i - 1) * 800);
      graf   (0.0, 10.0, 0.0, 1.0, 0.0, 5.0, 0.0, 1.0);

      if i = 1 then
      begin
	 bargrp (3, 0.15);
         color  ('red');
         bars   (@x[0], @y[0], @y1[0], 9);
         color  ('green');
         bars   (@x[0], @y[0], @y2[0], 9);
         color  ('blue');
         bars   (@x[0], @y[0], @y3[0], 9);
         color  ('fore');
         reset  ('bargrp');
      end
      else if i = 2 then
      begin  
         height (30);
         labels ('delta', 'bars');
         labpos ('center', 'bars');
         color  ('red');
         bars   (@x[0], @y[0], @y1[0], 9);
         color  ('green');
         bars   (@x[0], @y1[0], @y2[0], 9);
         color  ('blue');
         bars   (@x[0], @y2[0], @y3[0], 9);
         color  ('fore');
         reset  ('height');
      end  
      else if i = 3 then
      begin	  
         labels ('second', 'bars');
         labpos ('outside', 'bars');
         color  ('red');
         bars   (@x[0], @y[0], @y1[0], 9);
         color  ('fore');
      end;

      if i <> 3 then
	 legend (cbuf, 7);

      if i = 3 then
      begin  
         height (50);
         title  ();
      end;
      endgrf ();
   end;
   disfin ();
end.

Pie Charts / Free Pascal

program dislin_piegrf;

uses
   dislin;

var
   
   nya : int32 = 2800;
   i   : int32;
   ctit : ansistring = 'Pie Charts (PIEGRF)';
   cbuf : ansistring;
   xray : array[0..4] of double = (1.0, 2.5, 2.0, 2.7, 1.8);

begin
   SetLength (cbuf, 41);
   
   scrmod ('revers');
   setpag ('da4p');
   metafl ('cons');
   disini ();
   pagera ();
   complx ();
   axslen (1600, 1000);
   titlin (ctit, 2);
   chnpie ('both');

   legini (cbuf, 5, 8);
   leglin (cbuf, 'FIRST', 1);
   leglin (cbuf, 'SECOND', 2);
   leglin (cbuf, 'THIRD', 3);
   leglin (cbuf, 'FOURTH', 4);
   leglin (cbuf, 'FIFTH', 5);

   patcyc (1, 7);
   patcyc (2, 4);
   patcyc (3, 13);
   patcyc (4, 3);
   patcyc (5, 5);

   for i := 0 to 1 do
   begin
      axspos (250, nya - i * 1200);
      if i = 1 then
      begin	 
         labels ('data', 'pie');
         labpos ('external', 'pie');
      end;
      piegrf (cbuf, 1, xray, 5);

      if i = 1 then
      begin	 
         height (50);
         title  ();
      end;
      endgrf ();
   end;

   disfin ();
end.

3-D Bar Graph / 3-D Pie Chart / Free Pascal

program dislin_pie3d;

uses
   dislin;

var
   cbuf	  : ansistring;
   xray	  : array[0..4] of double = (2.0, 4.0, 6.0, 8.0, 10.0);
   y1ray  : array[0..4] of double = (0.0, 0.0, 0.0, 0.0, 0.0);
   y2ray  : array[0..4] of double = (3.2, 1.5, 2.0, 1.0, 3.0);
   ic1ray : array[0..4] of int32  = (50, 150, 100, 200, 175);
   ic2ray : array[0..4] of int32  = (50, 150, 100, 200, 175);

begin
   SetLength (cbuf, 80);
   scrmod ('revers');
   setpag ('da4p');
   metafl ('cons');
   disini ();
   pagera ();
   hwfont ();

   titlin ('3-D Bar Graph / 3-D Pie Chart', 2);
   htitle (40);

   shdpat (16);
   axslen (1500, 1000);
   axspos (300, 1400);

   barwth (0.5);
   bartyp ('3dvert');
   labels ('second', 'bars');
   labpos ('outside', 'bars');
   labclr (255, 'bars');
   graf   (0.0, 12.0, 0.0, 2.0, 0.0, 5.0, 0.0, 1.0);
   title  ();
   color  ('red');
   bars   (@xray[0], @y1ray[0], @y2ray[0], 5);
   endgrf ();

   shdpat (16);
   labels ('data', 'pie');
   labclr (255, 'pie');
   chnpie ('none');
   pieclr (@ic1ray[0], @ic2ray[0], 5);
   pietyp ('3d');
   axspos (300, 2700);
   piegrf (cbuf, 0, @y2ray[0], 5);       
   disfin ();
end.

3-D Bars / BARS3D / Free Pascal

program dislin_bars3d;

uses
   dislin;

const
   n =  18;

var
   i	 : int32;
   cbuf  : ansistring;
   xray  : array[0..n-1] of double  = (1.0, 3.0, 8.0, 1.5, 9.0, 6.3, 5.8,
              2.3, 8.1, 3.5, 2.2, 8.7, 9.2, 4.8, 3.4, 6.9, 7.5, 3.8);
   yray  : array[0..n-1] of double = (5.0, 8.0, 3.5, 2.0, 7.0, 1.0, 4.3, 7.2,
             6.0, 8.5, 4.1, 5.0, 7.3, 2.8, 1.6, 8.9, 9.5, 3.2);
   z1ray : array[0..n-1] of double = (0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0,
	     0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0);
   z2ray : array[0..n-1] of double = (4.0, 5.0, 3.0, 2.0, 3.5, 4.5, 2.0,
	     1.6, 3.8, 4.7, 2.1, 3.5, 1.9, 4.2, 4.9, 2.8, 3.6, 4.3);
   icray : array[0..n-1] of int32  = (30, 30, 30, 30, 30, 30, 100, 100,
	     100, 100, 100, 100, 170, 170, 170, 170, 170, 170);
   xwray : array[0..n-1] of double;
   ywray : array[0..n-1] of double;

begin
   SetLength (cbuf, 80);
   for i := 0 to n - 1 do
   begin
      xwray[i] := 0.5;
      ywray[i] := 0.5;
   end; 

   scrmod ('revers');
   setpag ('da4p');
   metafl ('cons');
   disini ();
   pagera ();
   hwfont ();
   axspos (200, 2600);
   axslen (1800, 1800);

   name   ('X-axis', 'x');
   name   ('Y-axis', 'y');
   name   ('Z-axis', 'z');

   titlin ('3-D Bars / BARS3D', 3);
   labl3d ('hori');

   graf3d (0.0, 10.0, 0.0, 2.0, 0.0, 10.0, 0.0, 2.0,
             0.0, 5.0, 0.0, 1.0);
   grid3d (1, 1, 'bottom');
   bars3d (@xray[0], @yray[0], @z1ray[0], @z2ray[0],
	   @xwray[0], @ywray[0], @icray[0], n);

   legini (cbuf, 3, 20);
   legtit (' ');
   legpos (1350, 1150);
   leglin (cbuf, 'First', 1);
   leglin (cbuf, 'Second', 2);
   leglin (cbuf, 'Third', 3);
   legend (cbuf, 3);

   height (50);
   title  ();
   disfin ();
end.

Shading Patterns / Free Pascal

program dislin_patterns;

uses
   dislin;

var
   ctit	       : ansistring  = 'Shading Patterns (AREAF)';
   cstr	       : ansistring;
   nx, nl      : int32;
   ny, i, j    : int32;
   ii, k, iclr : int32;
   nx0	       : int32 = 335;
   ny0	       : int32 = 350;
   ixp	       : array[0..3] of int32;
   iyp	       : array[0..3] of int32;
   ix	       : array[0..3] of int32 = (0, 300, 300, 0);
   iy	       : array[0..3] of int32 = (0, 0, 400, 400);

begin
   SetLength (cstr, 80);  
   scrmod ('revers');
   metafl ('cons');
   disini ();
   pagera ();
   complx ();
   setvlt ('small');

   height (50);
   nl := nlmess (ctit);
   nx := (2970 - nl) div 2;
   messag (ctit, nx, 200);

   iclr := 0;
   for i := 0 to 2 do
   begin
      ny := ny0 + i * 600;
      for j := 0 to 5 do
      begin	 
	 nx := nx0 + j * 400;
	 ii := i * 6 + j;
	 nl := intcha (ii, cstr);
         shdpat (ii);

	 iclr := iclr mod 8;
	 iclr := iclr + 1;
         setclr (iclr);

	 for k := 0 to 3 do
         begin
	    ixp[k] := ix[k] + nx;
	    iyp[k] := iy[k] + ny;
	 end;   
         areaf  (@ixp[0], @iyp[0], 4);

         nl := nlmess (cstr);
         nx := nx + (300 - nl) div 2;
         messag (cstr, nx, ny + 460);
      end;
   end;
   disfin ();
end.

3-D Colour Plot / Free Pascal

program dislin_color3d;

uses
   dislin;

const
   n = 100;
   m = 100;
   
var
   i, j		   : int32;
   fpi, stepx, stepy, x, y : double;
   zmat		   : array[0..n*m-1] of double;

begin
   stepx := 360.0 / (n - 1);
   stepy := 360.0 / (m - 1);
   fpi := 3.1415926 / 180.0;

   for i:= 1 to n  do
   begin
      x := (i - 1) * stepx;
      for j:= 1 to m do
      begin	 
	 y := (j - 1) * stepy;
	 zmat[i - 1 + (j - 1) * m] := 2 * sin (x * fpi) * sin (y * fpi);
      end;
   end;

   scrmod ('revers');
   metafl ('cons');
   disini ();
   pagera ();
   hwfont ();

   titlin ('3-D Colour Plot of the Function', 2);
   titlin ('F(X,Y) = 2 * SIN(X) * SIN(Y)', 4);

   name   ('X-axis', 'x');
   name   ('Y-axis', 'y');
   name   ('Z-axis', 'z');

   intax  ();
   autres (n, n);
   axspos (300, 1850);
   ax3len (2200, 1400, 1400);

   graf3  (0.0, 360.0, 0.0, 90.0, 0.0, 360.0, 0.0, 90.0,
            -2.0, 2.0, -2.0, 1.0);
   crvmat (zmat, n, m, 1, 1);
  
   height (50);
   title  ();
   disfin ();
end.

Surface Plot / Free Pascal

program dislin_surface;

uses
   dislin;

const
   n = 50;
   m = 50;

var
   i, j	 : int32;
   fpi, stepx, stepy, x, y : double;
   zmat	 : array[0..n*m-1] of double;
   ctit1 : ansistring = 'Surface Plot (SURMAT)';
   ctit2 : ansistring = 'F(X,Y) = 2*SIN(X)*SIN(Y)';

begin

   stepx := 360.0 / (n - 1);
   stepy := 360.0 / (m - 1);
   fpi := 3.1415926 / 180.0;

   for i:= 1 to n  do
   begin
      x := (i - 1) * stepx;
      for j:= 1 to m do
      begin	 
	 y := (j - 1) * stepy;
	 zmat[i - 1 + (j - 1) * m] := 2 * sin (x * fpi) * sin (y * fpi);
      end;
   end;

   scrmod ('revers');
   setpag ('da4p');
   metafl ('cons');
   disini ();
   pagera ();
   complx ();
   axspos (200, 2600);
   axslen (1800, 1800);

   name   ('X-axis', 'x');
   name   ('Y-axis', 'y');
   name   ('Z-axis', 'z');

   titlin (ctit1, 2);
   titlin (ctit2, 4);

   view3d (-5.0, -5.0, 4.0, 'abs');
   graf3d (0.0, 360.0, 0.0, 90.0, 0.0, 360.0, 0.0, 90.0,
             -3.0, 3.0, -3.0, 1.0);
   height (50);
   title  ();

   color  ('green');
   surmat (@zmat[0], n, m, 1, 1);
   disfin ();
end.

Shaded Surface Plot / Free Pascal

program dislin_surshd;

uses
   dislin;

const
   n = 50;
   m = 50;

var
   i, j	 : int32;
   fpi, stepx, stepy, x, y : double;
   zmat	 : array[0..n*m-1] of double;
   xray	 : array[0..n-1] of double;
   yray	 : array[0..m-1] of double;

   ctit1 :ansistring = 'Shaded Surface Plot';
   ctit2 : ansistring = 'F(X,Y) = 2*SIN(X)*SIN(Y)';

begin

   stepx := 360.0 / (n - 1);
   stepy := 360.0 / (m - 1);
   fpi := 3.1415926 / 180.0;

   for i:= 1 to n  do
   begin
      x := (i - 1) * stepx;
      xray[i] := x;
      for j:= 1 to m do
      begin	 
	 y := (j - 1) * stepy;
	 yray[j] := y;
	 zmat[i - 1 + (j - 1) * m] := 2 * sin (x * fpi) * sin (y * fpi);
      end;
   end;

   scrmod ('revers');
   setpag ('da4p');
   metafl ('cons');
   disini ();
   pagera ();
   complx ();
   axspos (200, 2600);
   axslen (1800, 1800);

   name   ('X-axis', 'x');
   name   ('Y-axis', 'y');
   name   ('Z-axis', 'z');

   titlin (ctit1, 2);
   titlin (ctit2, 4);

   view3d (-5.0, -5.0, 4.0, 'abs');
   graf3d (0.0, 360.0, 0.0, 90.0, 0.0, 360.0, 0.0, 90.0,
             -3.0, 3.0, -3.0, 1.0);
   height (50);
   title  ();

   shdmod ('smooth', 'surface'); 
   surshd (@xray[0], n, @yray[0], n, @zmat[0]);
   disfin ();
end.

Contour Plot / Free Pascal

program dislin_contour;

uses
   dislin;

const
   n = 50;
   m = 50;

var
   i, j	: int32;
   fpi, stepx, stepy, x, y, zlev : double;
   zmat	: array[0..n*m-1] of double;
   xray	: array[0..n-1] of double;
   yray	: array[0..m-1] of double;

begin

   stepx := 360.0 / (n - 1);
   stepy := 360.0 / (m - 1);
   fpi := 3.1415926 / 180.0;

   for i := 0 to n - 1 do
      xray[i] := i * stepx;

   for j := 0 to m - 1 do
      yray[j] := j * stepy;

   for i := 1 to n  do
   begin
      x := xray[i-1] * fpi;
      for j := 1 to m do
      begin
	 y := yray[j-1] * fpi;    
	 zmat[i - 1 + (j - 1) * m] := 2 * sin (x) * sin (y);
      end;
   end;   

   scrmod ('revers');
   setpag ('da4p');
   metafl ('cons');
   disini ();
   complx ();
   pagera ();

   titlin ('Contour Plot', 1);
   titlin ('F(X,Y) = 2 * SIN(X) * SIN(Y)', 3);

   name   ('X-axis', 'x');
   name   ('Y-axis', 'y');

   intax  ();
   axspos (450, 2670);
   graf   (0.0, 360.0, 0.0, 90.0, 0.0, 360.0, 0.0, 90.0);

   height (30);
   for i := 0 to 8 do
   begin   
      zlev := -2.0 + i * 0.5;
      setclr ((i + 1) * 25);
      if i = 4 then
        labels ('none', 'contur') 
      else
        labels ('float', 'contur');

      contur  (@xray[0], n, @yray[0], m, @zmat[0], zlev);
   end;

   height (50);
   color  ('fore');
   title  ();
   disfin ();
end. 

Shaded Contour Plot / Free Pascal

program dislin_conshd;

uses
   dislin;

const
   n = 50;
   m = 50;

var
   i, j	: int32;
   stepx, stepy, x, y : double;
   zmat	: array[0..n*m-1] of double;
   xray	: array[0..n-1] of double;
   yray	: array[0..m-1] of double;
   zlev	: array[0..11] of double;

begin 
   stepx := 1.6 / (n - 1);
   stepy := 1.6 / (m - 1);
   for i := 0 to n - 1  do
   begin
      x := 0.0 + i * stepx;
      xray[i] := x;
      for j := 0 to m - 1 do
      begin	 
	 y := 0.0 + j * stepy;
	 yray[j] := y;
	 zmat[i + j * m] := (x * x - 1.0) * (x * x - 1.0) + 
                   (y * y - 1.0) * (y * y - 1.0);
      end;
   end;

   scrmod ('revers');
   setpag ('da4p');
   metafl ('cons');
   disini ();
   pagera ();
   complx ();

   mixalf ();
   titlin ('Shaded Contour Plot', 1);
   titlin ('F(X,Y) = (X[2$ - 1)[2$ + (Y[2$ - 1)[2$', 3);
   name   ('X-axis', 'x');
   name   ('Y-axis', 'y');

   shdmod ('poly', 'contur');
   axspos (450, 2670);
   graf   (0.0, 1.6, 0.0, 0.2, 0.0, 1.6, 0.0, 0.2);

   for i := 1 to 12 do
      zlev[12-i] := 0.1 + (i - 1) * 0.1;

   conshd (@xray[0], n, @yray[0], n, @zmat[0], @zlev[0], 12);

   height (50);
   title  ();
   disfin ();
end.

Shaded Surface / Contour Plot / Free Pascal

program dislin_surcon

uses
   dislin;

const
   n	= 50;
   m	= 50;
   nlev	=  20;
   
var
   i, j		   : int32;
   fpi, step, stepx, stepy, x, y : double;
   zmat		   : array[0..n*m-1] of double;
   xray		   : array[0..n-1] of double;
   yray		   : array[0..m-1] of double;
   zlev		   : array[0..nlev-1] of double;
   ctit1	   : ansistring = 'Shaded Surface / Contour Plot';
   ctit2	   : ansistring = 'F(X,Y) = 2*SIN(X)*SIN(Y)';

begin
   stepx := 360.0 / (n - 1);
   stepy := 360.0 / (m - 1);
   fpi := 3.1415926 / 180.0;

   for i:= 1 to n  do
   begin
      x := (i - 1) * stepx;
      xray[i-1] := x;
      for j:= 1 to m do
      begin	 
	 y := (j - 1) * stepy;
	 yray[j] := y;
	 zmat[i - 1 + (j - 1) * m] := 2 * sin (x * fpi) * sin (y * fpi);
      end;
   end;

   scrmod ('revers');
   setpag ('da4p');
   metafl ('cons');
   disini ();
   pagera ();
   hwfont ();
   axspos (200, 2600);
   axslen (1800, 1800);

   name   ('X-axis', 'x');
   name   ('Y-axis', 'y');
   name   ('Z-axis', 'z');

   titlin (ctit1, 2);
   titlin (ctit2, 4);

   graf3d (0.0, 360.0, 0.0, 90.0, 0.0, 360.0, 0.0, 90.0,
             -2.0, 2.0, -2.0, 1.0);
   height (50);
   title  ();

   grfini (-1.0, -1.0, -1.0, 1.0, -1.0, -1.0, 1.0, 1.0, -1.0);
   nograf ();
   graf   (0.0, 360.0, 0.0, 90.0, 0.0, 360.0, 0.0, 90.0);
   step := 4.0 / nlev;
   for i:= 0 to nlev - 1 do
      zlev[i] := -2.0 + i * step; 

   conshd (@xray[0], n, @yray[0], n, @zmat[0], @zlev[0], nlev);
   box2d  ();
   reset  ('nograf');
   grffin ();

   shdmod ('smooth', 'surface'); 
   surshd (@xray[0], n, @yray[0], n, @zmat[0]);
   disfin ();
end.

Spheres and Tubes / Free Pascal



Some Solids / Free Pascal

program dislin_spheres;

uses
   dislin;

var
   i, j1, j2 : int32;
   x : array[0..16] of double = (10.0, 20.0, 10.0, 20.0, 5.0, 15.0, 25.0,
	    5.0, 15.0, 25.0, 5.0, 15.0, 25.0, 10.0, 20.0, 10.0, 20.0);
   y : array[0..16] of double = (10.0, 10.0, 20.0, 20.0, 5.0, 5.0, 5.0, 15.0,
	    15.0, 15.0, 25.0, 25.0, 25.0, 10.0, 10.0, 20.0, 20.0);
   z : array[0..16] of double = (5.0, 5.0, 5.0, 5.0, 15.0, 15.0, 15.0, 15.0,
	     15.0, 15.0, 15.0, 15.0, 15.0, 25.0, 25.0, 25.0, 25.0);  
   idx : array[0..55] of int32 = (1, 2, 1, 3, 3, 4, 2, 4, 5, 6, 6, 7, 8, 9,
	      9, 10, 11, 12, 12, 13,  5, 8, 8, 11, 6, 9, 9, 12, 7, 10,
              10, 13,  14, 15, 16, 17, 14, 16, 15, 17,
              1, 5, 2, 7, 3, 11, 4, 13, 5, 14, 7, 15, 11, 16, 13, 17);

begin	       
   setpag ('da4p');
   scrmod ('revers');
   metafl ('cons');
   disini ();
   pagera ();
   hwfont ();
   light  ('on');
   matop3 (0.02, 0.02, 0.02, 'specular');

   clip3d ('none');
   axspos (0, 2500);
   axslen (2100, 2100);

   htitle (50);
   titlin ('Spheres and Tubes', 4);

   name   ('X-axis', 'x');
   name   ('Y-axis', 'y');
   name   ('Z-axis', 'z');

   labdig (-1, 'xyz');  
   labl3d ('hori');
   graf3d (0.0, 30.0, 0.0, 5.0, 0.0, 30.0, 0.0, 5.0, 
             0.0, 30.0, 0.0, 5.0);
   title  ();

   shdmod ('smooth', 'surface');
  
   i := zbfini ();
   matop3 (1.0, 0.0, 0.0, 'diffuse');
   for i := 0 to 16 do
      sphe3d (x[i], y[i], z[i], 2.0, 50, 25);

   matop3 (0.0, 1.0, 0.0, 'diffuse');
   i := 0;
   while (i < 56) do
   begin
      j1 := idx[i] - 1;
      j2 := idx[i+1] - 1;
      tube3d (x[j1], y[j1], z[j1], x[j2], y[j2], z[j2], 0.5, 5, 5);
      i := i + 2;
   end;

   zbffin ();
   disfin ();
end.

Map Plot / Free Pascal

program dislin_map;

uses
   dislin;

begin
   scrmod ('revers');
   metafl ('cons');
   disini ();
   pagera ();
   complx ();

   frame  (3);
   axspos (400, 1850);
   axslen (2400, 1400);

   name   ('Longitude', 'x');
   name   ('Latitude', 'y');
   titlin ('World Coastlines and Lakes', 3);

   labels ('map', 'xy');
   grafmp (-180.0, 180.0, -180.0, 90.0, -90.0, 90.0, -90.0, 30.0);

   gridmp (1, 1);
   color  ('green');
   world  ();
   color  ('fore');

   height (50);
   title  ();
   disfin ();
end.

TeX Instructions for Mathematical Formulas / Free Pascal

program dislin_tex;

uses
   dislin;

var
   cstr	: ansistring = 'TeX Instructions for Mathematical Formulas';
   nl	: int32;

begin
   scrmod ('revers');
   setpag ('da4p');
   metafl ('cons');
   disini ();
   pagera ();
   complx ();
   height (40);

   nl := nlmess (cstr);
   messag (cstr, (2100 - nl) div 2, 100);
  
   texmod ('on');
   messag ('$\frac{1}{x+y}$', 150, 400);
   messag ('$\frac{a^2 - b^2}{a+b} = a - b$', 1200, 400);
  
   messag ('$r = \sqrt{x^2 + y^2}', 150, 700);
   messag ('$\cos \phi = \frac{x}{\sqrt{x^2 + y^2}}$', 1200, 700);

   messag ('$\Gamma(x) = \int_0^\infty e^{-t}t^{x-1}dt$', 150, 1000);
   messag ('$\lim_{x \to \infty} (1 + \frac{1}{x})^x = e$', 1200, 1000);

   messag ('$\mu = \sum_{i=1}^n x_i p_i$', 150, 1300);
   messag ('$\mu = \int_{-\infty}^ \infty x f(x) dx$', 1200, 1300);

   messag ('$\overline{x} = \frac{1}{n} \sum_{i=1}^n x_i$', 150, 1600);
   messag ('$s^2 = \frac{1}{n-1} \sum_{i=1}^n (x_i - \overline{x})^2$',
           1200, 1600);

   messag ('$\sqrt[n]{\frac{x^n - y^n}{1 + u^{2n}}}$', 150, 1900);  
   messag ('$\sqrt[3]{-q + \sqrt{q^2 + p^3}}$', 1200, 1900);

   messag ('$\int \frac{dx}{1+x^2} = \arctan x + C$', 150, 2200);
   messag ('$\int \frac{dx}{\sqrt{1+x^2}} = {\rm arsinh} x + C$',
           1200, 2200);

   messag ('$\overline{P_1P_2} = \sqrt{(x_2-x_1)^2 + (y_2-y_1)^2}$',
            150,2500);
   messag ('$x = \frac{x_1 + \lambda x_2}{1 + \lambda}$', 1200, 2500);
   disfin ();
end.