home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / sigm / vol194 / graf2.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1984-10-17  |  17.9 KB  |  486 lines
  1. {************************************************************************
  2.  *                                                                      *
  3.  *                        Copyright 1984 by                             *
  4.  *                         Thomas E. Speer                              *
  5.  *                       All rights reserved                            *
  6.  *                                                                      *
  7.  *       This file provides the ability to draw graphics characters,    *
  8.  *               plot axes, and do whole rectangular grids.             *
  9.  *                                                                      *
  10.  ************************************************************************}
  11.  
  12. {------------------------------------------------------------------------}
  13. PROCEDURE chset( xsize, ysize, theta: REAL );
  14. {       This procedure sets the character size and orientation
  15.         inputs:
  16.                 xsize   horizontal size of character
  17.                 ysize   vertical   size of character
  18.                 theta   clockwise rotation of character (0 := upright)
  19.         outputs:
  20.                 none returned
  21. }
  22. VAR
  23.     t: REAL;
  24.  
  25. BEGIN    
  26.     chxsz := xsize;
  27.     chysz := ysize;
  28.     chrot := theta;
  29.  
  30.     t := theta/57.29578;
  31.     scale[3] :=  cos( t );
  32.     scale[4] :=  sin( t );
  33. END;
  34.     
  35. {------------------------------------------------------------------------}
  36. FUNCTION posang ( angle:REAL ):REAL;
  37. {       This function returns an angle that is in the range 0 to 360 deg.
  38.         inputs:
  39.                 angle   angle to be converted
  40.         outputs:
  41.                 posang  converted angle
  42. }
  43. BEGIN
  44.     IF ( (angle < 360.0) AND (angle >= 0.0)) THEN
  45.         posang := angle
  46.     ELSE BEGIN
  47.         angle := angle - 360.0 *  Trunc(angle/360.0);
  48.         IF (angle < 0.0 ) THEN angle := angle + 360.;
  49.         posang := angle;
  50.     END
  51. END;
  52.  
  53. {------------------------------------------------------------------------}
  54. PROCEDURE ticend( rmin,rmax, dr:REAL; VAR pr1,pr2:REAL );
  55. {       This function calculates endpoints which are multiples of dr and
  56.         lie between rmin and rmax.
  57.         inputs:
  58.                 rmin,rmax       range of values along axis
  59.                 dr              increment used for axis
  60.         outputs:
  61.                 *pr1,*pr2       new values corresponding to rmin,rmax
  62. }
  63. VAR
  64.     r1,r2:REAL;
  65.  
  66. BEGIN
  67.     r1 :=  Trunc( rmin/dr) * dr;
  68.     r2 :=  Trunc( rmax/dr) * dr;
  69.     
  70.     IF ( (r1 < 0.0) OR (r2 < 0.0) ) THEN BEGIN
  71.         IF ((r1>0.0) OR (r2>0.0)) THEN BEGIN
  72.             pr1 := r1;
  73.             pr2 := r2;
  74.         END
  75.         ELSE BEGIN
  76.             IF ((dr<0.0) AND (r1>rmin)) THEN r1 := r1 + dr;
  77.             IF ((dr>0.0) AND (r2>rmax)) THEN r2 := r2 - dr;
  78.         END
  79.     END
  80.     ELSE BEGIN
  81.         IF ((dr>0.0) AND (r1<rmin)) THEN r1 := r1 + dr;
  82.         IF ((dr<0.0) AND (r2<rmax)) THEN r2 := r2 - dr;
  83.     END;
  84.     pr1 := r1;
  85.     pr2 := r2;
  86. END;
  87.  
  88. {------------------------------------------------------------------------}
  89. FUNCTION dxdy( x1,x2:REAL; nx:INTEGER; VAR lblnum,lbldec:INTEGER ):REAL;
  90. {       This function calculates a good engineering value for the
  91.         increment between tic marks on an axis.
  92.         inputs:
  93.                 x1,x2   minimum and maximum values to associated w/ axis
  94.                 nx      approximate number of intervals for axis
  95.         outputs:
  96.                 dxdy    increment between tic marks
  97.                 lblnum  number of characters required for labels
  98.                 lbldec  number of characters after decimal point
  99. }
  100. VAR
  101.     xlen,dx,dxlog,dxmant,t,ln10: REAL;
  102.     dxexp: INTEGER;
  103.  
  104. BEGIN
  105.     ln10 := ln(10.0);
  106.     xlen := x2-x1;
  107.     IF (xlen = 0.0) THEN BEGIN
  108.         write(CON, 'zero length axis in dxdy. 0 returned');
  109.         lbldec := 0;
  110.         lblnum := 0;
  111.         dxdy := 0;
  112.     END
  113.     ELSE BEGIN
  114.         dx := Abs(  xlen/nx );   { calculate raw dx }
  115.         dxlog :=  ln(dx)/ln10;
  116.         dxexp := Trunc(dxlog);
  117.         dxmant := dxlog - dxexp;
  118.         IF (dxmant <= 0.0) THEN BEGIN
  119.             dxexp := dxexp - 1;
  120.             dxmant := dxmant + 1;
  121.         END;
  122.         dx := 1.;                               { select good engr. values }
  123.         IF (dxmant > 0.18) THEN
  124.             dx := 2.;
  125.         IF (dxmant > 0.40) THEN
  126.             dx := 5.;
  127.         IF (dxmant > 0.88) THEN
  128.             dx := 10.0;
  129.         dx := dx * exp( ln10*dxexp ) * xlen/Abs(  xlen );
  130.  
  131.         dxlog := xlen;                         { how many digits in numbers? }
  132.         IF (x1  <> 0.0)  THEN BEGIN
  133.             t :=  Abs(  x1);
  134.             IF (t > dxlog) THEN dxlog :=t;
  135.         END;
  136.         IF (x2  <> 0.0) THEN BEGIN
  137.             t :=  Abs(  x2);
  138.             IF (t > dxlog) THEN dxlog := t;
  139.         END;
  140.  
  141.         dxlog :=  ln(dxlog)/ln10;
  142.         IF (dxlog > 0.0 ) THEN
  143.             lblnum := Trunc( dxlog + 1.0 )
  144.         ELSE
  145.             lblnum := 0;
  146.  
  147.         dxlog :=  Abs(  xlen);  { now get f format spec }
  148.         IF (x1 <> 0.0) THEN BEGIN
  149.             t :=  Abs(  x1);
  150.             IF (t < dxlog) THEN dxlog := t;
  151.         END;
  152.         IF (x2 <> 0.0) THEN BEGIN
  153.             t :=  Abs(  x2);
  154.             IF (t < dxlog) THEN dxlog := t;
  155.         END;
  156.         t :=  Abs(  dx);
  157.         IF (t < dxlog) THEN dxlog := t;
  158.  
  159.         dxlog :=  ln(dxlog)/ln10;
  160.         IF (dxlog < 0.0) THEN 
  161.             lbldec := Trunc( -dxlog + 1.0 )
  162.         ELSE
  163.             lbldec := 0;
  164.         lblnum := lblnum + lbldec + 2;
  165.  
  166.         dxdy := dx;
  167.     END
  168. END;
  169.         
  170. {------------------------------------------------------------------------}
  171. PROCEDURE gchar( cx,cy:REAL ;charin:CHAR );
  172. {       This procedure will plot a graphic character at an arbitrary
  173.         size and orientation.
  174.         inputs:
  175.                 cx,cy   coordinates for lower left corner of char.
  176.                 charin  character to be plotted
  177.         outputs:
  178.                 none returned
  179.  
  180.         Note: The elements of tchar have a specific format.  The lower 4
  181.         bits contain the Y coordinate, the next 3 bits the X
  182.         coordinate, and the high bit indicates whether or not the byte
  183.         corresponds to a move or a line ("pen up" or "pen down"). The
  184.         value 255 signals the end of the sequence of segments for a
  185.         character.
  186. }
  187. CONST
  188.     tchar:ARRAY [1..721] of BYTE = (                    { 721 elements }
  189.        255,  56, 181,  51, 178, 255,  40, 166,  72, 198, 255,  40,
  190.        162,  72, 194,   6, 230,   4, 228, 255,  56, 178,  87, 151,
  191.        134, 149, 213, 228, 211, 147, 255, 104, 130,   8, 168, 166,
  192.        134, 136,  68, 228, 226, 194, 196, 255,  98, 151, 168, 184,
  193.        199, 198, 148, 147, 162, 178, 212, 255,   6, 151, 152, 136,
  194.        135, 151, 255,  72, 182, 180, 194, 255,  40, 182, 180, 162,
  195.        255,  21, 213,  39, 195,  71, 163, 255,  55, 179,  21, 213,
  196.        255,  17, 162, 163, 147, 146, 162, 255,  21, 213, 255,  34,
  197.        163, 147, 146, 162, 255,  88, 146, 255,  40, 200, 214, 212,
  198.        194, 162, 148, 150, 168, 255,  38, 184, 178,  34, 194, 255,
  199.         23, 168, 200, 215, 214, 147, 146, 210, 255,  23, 168, 200,
  200.        215, 214, 197, 212, 211, 194, 162, 147, 255,  72, 194,  55,
  201.        148, 212, 255,  88, 152, 150, 198, 213, 211, 194, 162, 147,
  202.        255,  87, 200, 168, 151, 147, 162, 194, 211, 212, 197, 165,
  203.        148, 255,  24, 216, 162, 255,  37, 197, 212, 211, 194, 162,
  204.        147, 148, 165, 150, 151, 168, 200, 215, 214, 197, 255,  19,
  205.        162, 194, 211, 215, 200, 168, 151, 150, 165, 197, 214, 255,
  206.         23, 167, 166, 150, 151,  20, 164, 163, 147, 148, 255,  17,
  207.        162, 163, 147, 146, 162,  22, 166, 165, 149, 150, 255,  87,
  208.        149, 211, 255,  22, 214,  20, 212, 255,  23, 213, 147, 255,
  209.         23, 168, 200, 215, 214, 180,  50, 177, 255,  23, 168, 200,
  210.        215, 211, 194, 162, 147, 148, 165, 181, 178, 255,   2, 184,
  211.        226,  20, 212, 255,   5, 197, 212, 211, 194, 130, 136, 200,
  212.        215, 214, 197, 255,  87, 200, 152, 135, 131, 146, 194, 211,
  213.        255,   2, 136, 200, 214, 212, 194, 130, 255,  88, 136, 130,
  214.        210,  53, 133, 255,  88, 136, 130,  53, 133, 255,  87, 200,
  215.        152, 135, 131, 146, 194, 211, 213, 181, 255,   2, 136,  88,
  216.        210,  85, 133, 255,  40, 200,  56, 178,  34, 194, 255,  20,
  217.        147, 162, 178, 195, 200,  56, 216, 255,   8, 130,  88, 133,
  218.        210, 255,  24, 146, 210, 255,   2, 136, 181, 232, 226, 255,
  219.          2, 136, 226, 232, 255,   7, 152, 216, 231, 227, 210, 146,
  220.        131, 135, 255,   2, 136, 200, 215, 214, 197, 133, 255,   7,
  221.        152, 216, 231, 228, 194, 146, 131, 135,  68, 226, 255,   2,
  222.        136, 200, 215, 214, 197, 133,  53, 210, 255,  87, 200, 152,
  223.        135, 134, 149, 197, 212, 211, 194, 146, 131, 255,   8, 232,
  224.         56, 178, 255,  24, 147, 162, 194, 211, 216, 255,   8, 178,
  225.        232, 255,   8, 146, 181, 210, 232, 255,   8, 226, 104, 130,
  226.        255,  24, 180, 178,  88, 180, 255,   8, 232, 130, 226, 255,
  227.         88, 184, 178, 210, 255,  24, 210, 255,  24, 184, 178, 146,
  228.        255,  22, 184, 214, 255,   0, 224, 255, 102, 215, 216, 232,
  229.        231, 215, 255,   5, 150, 182, 197, 195, 178, 146, 131, 148,
  230.        196,  67, 210, 255,  24, 146, 194, 211, 212, 197, 149, 255,
  231.         85, 165, 148, 147, 162, 210, 255,  88, 210, 162, 147, 148,
  232.        165, 213, 255,  82, 162, 147, 148, 165, 197, 212, 148, 255,
  233.         87, 200, 184, 167, 162,  21, 197, 255,  17, 160, 176, 193,
  234.        197, 165, 148, 147, 162, 194, 255,  18, 152,  21, 181, 196,
  235.        194, 255,  50, 181,  55, 184, 255,  18, 145, 160, 176, 193,
  236.        197,  71, 200, 255,  24, 146,  20, 199,  37, 210, 255,  40,
  237.        184, 178,  34, 194, 255,   2, 133,   4, 149, 165, 180, 178,
  238.         52, 197, 213, 228, 226, 255,  18, 149,  20, 165, 197, 212,
  239.        210, 255,  20, 165, 197, 212, 211, 194, 162, 147, 148, 255,
  240.         16, 149, 197, 212, 211, 194, 146, 255,  80, 213, 165, 148,
  241.        147, 162, 210, 255,  18, 149,  20, 165, 181, 196, 255,  19,
  242.        162, 194, 211, 196, 164, 149, 166, 198, 213, 255,  40, 163,
  243.        178, 194, 211, 212,  22, 182, 255,  21, 147, 162, 194, 211,
  244.        213,  83, 226, 255,  21, 178, 213, 255,  21, 162, 180, 194,
  245.        213, 255,  21, 194,  18, 197, 255,  21, 178,  85, 178, 161,
  246.        144, 255,  21, 213, 146, 210, 255,  72, 184, 167, 166, 149,
  247.        164, 163, 178, 194, 255,  48, 184, 255,  40, 184, 199, 198,
  248.        213, 196, 195, 178, 162, 255,   7, 152, 168, 198, 214, 231,
  249.        255  );    
  250.  
  251.     ichar:ARRAY [1..95] of INTEGER =  (                        { 95 elements }
  252.          1,   2,   7,  12,  21,  32,  45,  57,  64,  69,  74,  81,
  253.         86,  93,  96, 102, 105, 115, 121, 130, 142, 148, 158, 171,
  254.        175, 192, 205, 216, 228, 232, 237, 241, 250, 263, 269, 281,
  255.        290, 298, 305, 311, 322, 329, 336, 345, 351, 355, 361, 366,
  256.        376, 384, 396, 406, 419, 424, 431, 435, 441, 446, 452, 457,
  257.        462, 465, 470, 474, 477, 484, 497, 505, 512, 520, 529, 537,
  258.        548, 555, 560, 569, 576, 582, 595, 603, 613, 621, 629, 636,
  259.        647, 656, 665, 669, 675, 680, 687, 692, 702, 705, 715  );
  260.  
  261. VAR
  262.     schar,cmd,ix,iy: BYTE;
  263.     i: INTEGER;
  264.     x,y,t: REAL;
  265.  
  266. BEGIN
  267.     schar := Ord(charin) AND 127;
  268.  
  269.     IF (schar >= 32) THEN BEGIN
  270.  
  271.         i := schar - 31;
  272.         i := ichar[i];
  273.  
  274.         WHILE tchar[i] < 255 DO BEGIN
  275.             cmd := tchar[i];
  276.             i  := i + 1;
  277.             iy := cmd AND 15;
  278.             ix := cmd AND 112;
  279.             ix := ix DIV 16;
  280.             x := ix * chxsz / 7.0;
  281.             y := iy * chysz / 9.0;
  282.             t := x;
  283.             x := cx + scale[3]*t - scale[4]*y;
  284.             y := cy + scale[4]*t + scale[3]*y;
  285.  
  286.             IF (cmd < 128) THEN
  287.                 gmove( x,y )
  288.             ELSE
  289.                 vector( x,y )
  290.         END
  291.     END
  292. END;
  293.  
  294. {------------------------------------------------------------------------}
  295. PROCEDURE gwrite(x,y:REAL ;chars:textline; nchar:INTEGER);
  296. {       This function plots a string of graphic characters with the
  297.         preset orientation and size.
  298.         inputs:
  299.                 x,y     coordinates for start of string (bottom left corner)
  300.                 chars   string to be plotted
  301.         outputs:
  302.                 none returned
  303. }
  304. VAR
  305.     i: INTEGER;
  306.     
  307. BEGIN
  308.     FOR i := 1 TO nchar DO BEGIN
  309.         gchar( x, y, chars[i] );
  310.         x := x + chxsz*scale[3];
  311.         y := y + chxsz*scale[4];
  312.     END
  313. END;
  314.  
  315. {------------------------------------------------------------------------}
  316. PROCEDURE axis(r1,r2,dri,sx1,sy1,sx2,sy2,ticlen,ticang: REAL;
  317.                lblnum,lbldec: INTEGER; lblang: REAL);
  318. {       This procedure plots and labels a linear graph axis
  319.         inputs:
  320.                 r1      real world value at start of axis
  321.                 r2      real world value at end of axis
  322.                 dri     real world increment for labels
  323.                 sx1,sy1 screen coordinates of start of axis
  324.                 sx2,sy2 screen coordinates at end   of axis
  325.                 ticlen  length of tic marks (screen units 0.0-->1.0)
  326.                 ticang  angle between horizontal and tic marks
  327.                 lblnum  number of characters in labels
  328.                 lbldec  number of digits right of decimal place
  329.                 lblang  angle between horizontal and labels
  330.         outputs:
  331.                 none returned
  332. }
  333. VAR
  334.     angtic,anglbl,lentic,xlen,ylen,rlen,dr,rtic,rend,xtic,ytic,
  335.           angtst,xlabel,ylabel,t,radian,x,y,dtic: REAL;
  336.     alabel:  STRING[20];
  337.     stemp:  STRING[6];
  338.  
  339. BEGIN    
  340.     radian := 57.29578;
  341.     IF ((dri = 0.0) OR (r2-r1 = 0.0))  THEN BEGIN
  342.         Write(CON, 'Zero value for real length or increment. Axis not plotted');
  343.     END
  344.     ELSE BEGIN
  345.         IF (lblnum < 7) THEN lblnum := 7;
  346.         IF ( ((r1<0.0) OR (r2<0.0)) AND (lblnum<8) ) THEN lblnum := 8;
  347.         angtic := ticang;
  348.         IF (ticlen < 0.0) THEN angtic := -angtic;
  349.         angtic := posang (angtic);
  350.         anglbl := posang (lblang);
  351.         lentic := Abs( ticlen );
  352.         xlen := sx2-sx1;
  353.         ylen := sy2-sy1;
  354.         rlen :=  r2-r1;
  355.         dr := Abs( dri ) * Abs( rlen )/rlen;
  356.         ticend(r1,r2,dr,rtic,rend);
  357.         angtst := posang(angtic - anglbl);
  358.         angtic := angtic/radian;
  359.         anglbl := anglbl/radian;
  360.         xtic := lentic * cos( angtic );
  361.         ytic := lentic * sin( angtic );
  362.         scale[3] :=  cos( anglbl );
  363.         scale[4] :=  sin( anglbl );
  364.  
  365.         {       calculate offsets for labels     }
  366.  
  367.         IF ( (angtst < 45.0) OR         { tic is "left" of label }
  368.              (angtst >= 315.0) )  THEN BEGIN
  369.             xlabel := ( chxsz*scale[3] + chysz*scale[4])/2.0;
  370.             ylabel := (-chysz*scale[3] - chxsz*scale[4])/2.0;
  371.         END
  372.         ELSE IF ( angtst < 135.0) THEN BEGIN    { tic is "below" label }
  373.             t := (lblnum-lbldec-1) * chxsz;
  374.             xlabel := -t*scale[3] - chysz*scale[4]/2.0;
  375.             ylabel := -t*scale[4] + chysz*scale[3]/2.0;
  376.         END
  377.         ELSE IF ( angtst < 225.0) THEN BEGIN    { tic is "right" of label }
  378.             t := ( lblnum + 0.5 ) *chxsz;
  379.             xlabel := -scale[4]*chysz/2.0 - t*scale[3];
  380.             ylabel := -scale[3]*chysz/2.0 - t*scale[4];
  381.         END
  382.         ELSE IF ( angtst < 315.0) THEN BEGIN    { tic is "above" label }
  383.             t := (lblnum-lbldec-1) * chxsz;
  384.             xlabel := -t*scale[3] + chysz*scale[4]*1.5;
  385.             ylabel := -t*scale[4] - chysz*scale[3]*1.5;
  386.         END;
  387.  
  388.         {  Draw Axis }
  389.  
  390.         segmnt( sx1,sy1, sx2,sy2 );
  391.         WHILE ((dr<0.0)AND(rtic>=rend)) OR ((dr>0.0)AND(rtic<=rend)) DO BEGIN
  392.             dtic := (rtic-r1)/rlen;
  393.             x := xlen*dtic + sx1;
  394.             y := ylen*dtic + sy1;
  395.             gmove(x,y);
  396.             x := x + xtic;
  397.             y := y + ytic;
  398.             vector(x,y);
  399.             x := x + xlabel;
  400.             y := y + ylabel;
  401.  
  402.             Str(rtic:lblnum:lbldec, alabel);
  403.             gwrite(x, y, alabel, lblnum);
  404.             rtic := rtic + dr;
  405.         END;
  406.         {  clean up static storage }
  407.         t := chrot/radian;
  408.         scale[3] :=  cos( t );
  409.         scale[4] :=  sin( t );
  410.     END
  411. END;
  412.  
  413. {-------------------------------------------------------------------------}
  414. PROCEDURE graph(xmini,xmaxi:REAL; nx:INTEGER; ymini,ymaxi:REAL;ny:INTEGER;
  415.                 sxl,sxr,syb,syt:REAL);
  416. {       This procedure plots and labels a graph and establishes scale factors
  417.         for future use.
  418.         inputs:
  419.                 xmini,xmaxi     min & max real world values for x axis
  420.                 nx              approximate no. of intervals on x axis
  421.                 ymini,ymaxi     min & max real world values for y axis
  422.                 ny              approximate no. of intervals on y axis
  423.                 sxl,sxr         screen left & right coord. for graph area
  424.                 syb,syt         screen bottom & top coord. for graph area
  425.         outputs:
  426.                 none returned
  427. }
  428. VAR
  429.     dx,dy,tic,xdot,ydot,dxydot,xydot,ticnd: REAL;
  430.     lblnum,lbldec: INTEGER;
  431.  
  432. BEGIN
  433.     { Set Scale Factors }
  434.  
  435.     xmin := xmini;
  436.     ymin := ymini;
  437.     xmax := xmaxi;
  438.     ymax := ymaxi;
  439.     swindo(sxl,sxr,syb,syt);
  440.  
  441.     { Draw Axes }
  442.  
  443.     dx := dxdy(xmin,xmax,nx,lblnum,lbldec);
  444.     nxchar := lblnum;
  445.     axis(xmin,xmax,dx, sxl,syb,sxr,syb, chysz/2.,270.0, lblnum,lbldec,0.0);
  446.  
  447.     dy := dxdy(ymin,ymax,ny,lblnum,lbldec);
  448.     nychar := lblnum;
  449.     axis(ymin,ymax,dy, sxl,syb,sxl,syt, chxsz/2.,180.0, lblnum,lbldec,90.0);
  450.  
  451.     { Do Vertical Dotted Lines }
  452.  
  453.     ticend(xmin,xmax,dx,tic,ticnd);
  454.     dxydot := dy/5.0;
  455.     IF (tic = xmin) THEN tic := tic + dx;
  456.     WHILE ((dx>0.0)AND(tic<=ticnd)) OR ((dx<0.0)AND(tic>=ticnd)) DO BEGIN
  457.         xdot := sx(tic);
  458.         tic := tic + dx;
  459.         xydot := ymin + dxydot;
  460.         WHILE ((dxydot>0.0)AND(xydot<=ymax)) OR
  461.               ((dxydot<0.0)AND(xydot>=ymax)) DO BEGIN
  462.             ydot  := sy(xydot);
  463.             xydot := xydot + dxydot;
  464.             point( xdot,ydot );
  465.         END
  466.     END;
  467.     { Do Horizontal Dotted Lines }
  468.  
  469.     ticend(ymin,ymax,dy,tic,ticnd);
  470.     dxydot := dx/5.0;
  471.     IF (tic = ymin) THEN tic := tic + dy;
  472.     WHILE ((dy>0.0)AND(tic<=ticnd)) OR ((dy<0.0)AND(tic>=ticnd)) DO BEGIN
  473.         ydot := sy(tic);
  474.         tic  := tic + dy;
  475.         xydot := xmin + dxydot;
  476.         WHILE ((dxydot>0.0)AND(xydot<=xmax)) OR
  477.               ((dxydot<0.0)AND(xydot>=xmax)) DO BEGIN
  478.             xdot  := sx(xydot);
  479.             xydot := xydot + dxydot;
  480.             point( xdot,ydot );
  481.         END
  482.     END
  483. END;
  484.  
  485. {-------------------------------------------------------------------------}
  486.