[comp.lang.pascal] Units - In source form

ace@cc.ic.ac.uk (Andreas C. Enotiadis) (07/17/90)

 Apparently uuencoded files have trouble traveling through BITNET.
 Therefore here's the units I posted in source form. Any comments,
 etc as before.

 ace

 P.S. I hope I haven't forgotten any copyright messages for code
 out of books. If so I am sorry.
 P.P.S. My only copyright is ---USE, ABUSE, MODIFY TO YOUR HEARTS
 CONTENT----
 P.P.P.S. I suggest we use xxencode instead. I have the source in
 C but just for spite I'll translate to TP before I post it.



------------------------- CUT-----------------------------------



(***************************************************)
(*                                                 *)
(*     Advanced Graphics Library  v. 1.00          *)
(*     C. ACE 1988                                 *)
(*     Requires Graph Unit of Turbo 4.x,5.x        *)
(*                                                 *)
(***************************************************)

unit Adgraph;


interface

TYPE
  plot_array = ARRAY[1..1500,1..2] OF real;


PROCEDURE Initialize;

FUNCTION forcolor : word;

FUNCTION backcolor : word;

PROCEDURE define_window(window_number,xleft,ybottom,xright,ytop : integer);

PROCEDURE select_window(window_number : integer);

PROCEDURE define_world(world_number : integer; left,bottom,right,top : real;
                       logx,logy : boolean);

PROCEDURE select_world(world_number: integer);

PROCEDURE draw_point(x,y : real ; color : word);

PROCEDURE draw_circle(x,y,r : real; fill : boolean);

PROCEDURE draw_square(x,y,l : real; fill : boolean);

PROCEDURE draw_triangle(x,y,l : real; fill : boolean);

PROCEDURE draw_inverse_triangle(x,y,l : real; fill : boolean);

PROCEDURE draw_diamond(x,y,l : real; fill : boolean);

PROCEDURE set_clipping_off;

PROCEDURE set_clipping_on;

PROCEDURE draw_line(x1,y1,x2,y2 : real ; color,linetype : word);

PROCEDURE set_foreground_color(color : word);

PROCEDURE set_background_color(color : word);

PROCEDURE clear_window(windex : shortint);

PROCEDURE draw_border(windex : shortint);

PROCEDURE draw_conn_data(i : integer; plotarray : plot_array ; lstyle : word ; fill :
                         boolean);

PROCEDURE draw_histogram(i : integer; plotarray : plot_array ;
                         pattern : word ; fill : boolean);

PROCEDURE setup_x_axes(top,bottom,zerox : boolean ;
                       xmajtick,xmintick,tickfont,labelfont,prec : word;
                       topt,bott,grid: boolean; xlabel : string ; xtlabelsize,
                       xllabelsize : word);

PROCEDURE setup_y_axes(left,right,zeroy : boolean ;
                       ymajtick,ymintick,tickfont,labelfont,prec : word;
                       leftt,rightt,grid : boolean; ylabel : string ; ytlabelsize,
                       yllabelsize : word);

PROCEDURE setup_x_log_axes(top,bottom : boolean ;
                           xmintick,tickfont,labelfont,prec : word;
                           topt,bott,grid: boolean; xlabel : string ; xtlabelsize,
                           xllabelsize : word);

PROCEDURE setup_y_log_axes(left,right : boolean ;
                           ymintick,tickfont,labelfont,prec : word;
                           leftt,rightt,grid : boolean; ylabel : string ; ytlabelsize,
                           yllabelsize : word);

PROCEDURE draw_text(x,y : real; font,direction,size,xj,yj : word ; outex : string);

PROCEDURE flush_window(windex : byte);

PROCEDURE Leave;

implementation

uses
 dos,crt,graph,datetime,rmath;

TYPE
  world_coor = ARRAY[1..10,1..4] OF real;
  win_coor   = ARRAY[1..10,1..4] OF integer;
  actual_data = ARRAY[1..1500,1..2] OF integer;

  CONST {This section (c) Borland International}
  { The names of the various device drivers supported }
    DriverNames : ARRAY[0..10] OF STRING[8] =
                                              ('Detect', 'CGA', 'MCGA', 'EGA', 'EGA64',
                                               'EGAMono',
                                               'RESERVED', 'HercMono', 'ATT400', 'VGA',
                                               'PC3270');

  { The five fonts available }
    Fonts : ARRAY[0..4] OF STRING[13] =
                                        ('DefaultFont', 'TriplexFont', 'SmallFont',
                                         'SansSerifFont', 'GothicFont');

  { The five predefined line styles supported }
    LineStyles : ARRAY[0..4] OF STRING[9] =
                                            ('SolidLn', 'DottedLn', 'CenterLn', 'DashedLn'
                                             , 'UserBitLn');

  { The twelve predefined fill styles supported }
    FillStyles : ARRAY[0..11] OF STRING[14] =
                                              ('EmptyFill', 'SolidFill', 'LineFill',
                                               'LtSlashFill', 'SlashFill',
                                               'BkSlashFill', 'LtBkSlashFill', 'HatchFill'
                                               , 'XHatchFill',
                                               'InterleaveFill', 'WideDotFill',
                                               'CloseDotFill');

  { The two text directions available }
    TextDirect : ARRAY[0..1] OF STRING[8] = ('HorizDir', 'VertDir');

  { The Horizontal text justifications available }
    HorizJust  : ARRAY[0..2] OF STRING[10] = ('LeftText', 'CenterText', 'RightText');

  { The vertical text justifications available }
    VertJust   : ARRAY[0..2] OF STRING[10] = ('BottomText', 'CenterText', 'TopText');

VAR 
  GraphDriver : integer;  { The Graphics device driver }
  GraphMode   : integer;  { The Graphics mode value }
  MaxX, MaxY  : word;     { The maximum resolution of the screen }
  ErrorCode   : integer;  { Reports any graphics errors }
  MaxColor    : word;     { The maximum color value available }
  current_sel : shortint; { The current world index }
  win_indices : win_coor; { Array holding the window coordinates}
  world_indices : world_coor; { Array holding the equivalent world coordinates }
  no_of_windows : shortint; { Total amount of windows 10 }
  clip,xlog,ylog : boolean; { Clipping Parameter }
  scalex,scaley : real; { World to absolute coordinate conversions, x & y }
  offsx,offsy   : integer; { Offsets in conversion }
  win_length,win_width : integer;
  aspect               : real;
  XScreenMaxGlb        : word;
  out                  : text;
  cwindow              : byte;
  fcolor,bcolor        : word;


FUNCTION forcolor;

BEGIN
  forcolor := fcolor;
END;

FUNCTION backcolor;

BEGIN
  backcolor := bcolor;
END;

PROCEDURE Initialize; { (C) Borland Inernational }
{ Initialize graphics and report any errors that may occur }
BEGIN
  { when using Crt and graphics, turn off Crt's memory-mapped writes }
  DirectVideo := False;
  GraphDriver := Detect;                  { use autodetection }
  InitGraph(GraphDriver, GraphMode, '');  { activate graphics }
  ErrorCode := GraphResult;               { error? }
  IF ErrorCode <> grOk
    THEN
      BEGIN
        Writeln('Graphics error: ', GraphErrorMsg(ErrorCode));
        Halt(1);
      END;
  MaxColor := GetMaxColor;  { Get the maximum allowable drawing color }
  MaxX := GetMaxX;          { Get screen resolution values }
  MaxY := GetMaxY;
  no_of_windows := 0;
  clip := true;
  xlog := false;
  ylog := false;
  aspect := 0.75*(maxx/maxy);
  XScreenMaxGlb := MaxX;
  fcolor := maxcolor;
  setcolor(fcolor);
  bcolor := 0;
END; { Initialize }

FUNCTION fix_string(a: real ; prec : integer ) : string;

VAR 
  tmp : STRING;
  inprec : byte;
  toprec : byte;

BEGIN
  str(a,tmp);
  inprec := pos('.',tmp);
  toprec := inprec+prec;
  str(a:toprec:prec,tmp);
  fix_string := tmp;
END;

PROCEDURE adgrapherror(msg : string);

  BEGIN
    closegraph;
    writeln('Advanced graphics error. '+msg);
    leave;
    halt(1);
  END;

FUNCTION map_x(x : real): integer;

BEGIN
  map_x := trunc(x*scalex-offsx);
END;

FUNCTION map_y(y : real): integer;

BEGIN
  map_y := trunc(y*scaley-offsy);
END;


PROCEDURE set_foreground_color(color : word);

BEGIN
  Fcolor := color;
  setcolor(color);
END;


PROCEDURE set_background_color(color : word);

BEGIN
  Bcolor := color;
END;

PROCEDURE define_window;

BEGIN
  IF (window_number>0) AND (window_number<=10)
    THEN
      BEGIN
        IF (xleft<0) OR (xleft>maxX)
          THEN xleft := 0;
        IF (xright<0) OR (xright>maxX)
          THEN xright := maxX;
        IF (ybottom<0) OR (ybottom>maxY)
          THEN ybottom := 0;
        IF (ytop<0) OR (ytop>maxY)
          THEN ytop := maxY;
        setviewport(xleft,ybottom,xright,ytop,clip);
        win_indices[window_number,1] := xleft;
        win_indices[window_number,2] := xright;
        win_indices[window_number,3] := ybottom;
        win_indices[window_number,4] := ytop;
        no_of_windows := no_of_windows+1;
      END
    ELSE
      adgrapherror('Too many windows');
END;

PROCEDURE flush_window;

VAR 
  i : byte;

BEGIN
  FOR i:=1 TO 4 DO
    win_indices[windex,i] := 0;
  dec(no_of_windows);
END;

PROCEDURE select_window(window_number : integer);

BEGIN
  IF (window_number>0) AND (window_number<=no_of_windows)
    THEN
      BEGIN
        setviewport(win_indices[window_number,1],win_indices[window_number,3],win_indices[
                    window_number,2]
                    ,win_indices[window_number,4],clip);
        win_length := win_indices[window_number,4]-win_indices[window_number,3];
        win_width := win_indices[window_number,2]-win_indices[window_number,1];
        cwindow := window_number;
      END
    ELSE
      adgrapherror('Undefined window');

END;

PROCEDURE clear_window(windex : shortint);

TYPE 
  border = ARRAY [1..5,1..2] OF integer;

VAR 
  round : border;
  i     : integer;

BEGIN
  select_window(windex);
  FOR i:=1 TO 5 DO
    BEGIN
      round[1,1] := 0;
      round[1,2] := 0;
      round[2,1] := 0;
      round[2,2] := win_length;
      round[3,1] := win_width;
      round[3,2] := win_length;
      round[4,1] := win_width;
      round[4,2] := 0;
      round[5,1] := 0;
      round[5,2] := 0;
    END;
  setfillstyle(solidfill,bcolor);
  fillpoly(5,round);
END;

PROCEDURE define_world;

BEGIN
  IF logx
    THEN
      BEGIN
        world_indices[world_number,1] := rlog10(left);
        world_indices[world_number,2] := rlog10(right);
      END
    ELSE
      BEGIN
        world_indices[world_number,1] := left;
        world_indices[world_number,2] := right;
      END;
  IF logy
    THEN
      BEGIN
        world_indices[world_number,3] := rlog10(bottom);
        world_indices[world_number,4] := rlog10(top);
      END
    ELSE
      BEGIN
        world_indices[world_number,3] := bottom;
        world_indices[world_number,4] := top;
      END;
  xlog := logx;
  ylog := logy;
END;

PROCEDURE select_world;

VAR 
  temp : string;

BEGIN
  current_sel := world_number;
  scalex := (win_indices[current_sel,2]-win_indices[current_sel,1])/
            (world_indices[current_sel,2]-world_indices[current_sel,1]);
  scaley := (win_indices[current_sel,3]-win_indices[current_sel,4])/
            (world_indices[current_sel,4]-world_indices[current_sel,3]);
  offsx := trunc(scalex*world_indices[current_sel,1]);
  offsy := trunc(scaley*world_indices[current_sel,4]);
END;

PROCEDURE draw_point;

VAR 
  xpos,ypos : integer;

BEGIN
  IF xlog
    THEN
      xpos := map_x(rlog10(x))
    ELSE
      xpos := map_x(x);
  IF ylog
    THEN
      ypos := map_y(rlog10(y))
    ELSE
      ypos := map_y(y);
  putpixel(xpos,ypos,Fcolor);
END;

PROCEDURE draw_circle;

VAR 
  xpos,ypos : integer;

BEGIN
  IF xlog
    THEN
      xpos := map_x(rlog10(x))
    ELSE
      xpos := map_x(x);
  IF ylog
    THEN
      ypos := map_y(rlog10(y))
    ELSE
      ypos := map_y(y);
  circle(xpos,ypos,trunc(r*scalex));
  IF fill
    THEN
      BEGIN
        setfillstyle(1,fcolor);
        floodfill(xpos,ypos,Fcolor);
      END;
END;

PROCEDURE draw_square;

TYPE 
  border = ARRAY[1..5,1..2] OF word;

VAR 
  corners : border;
  fix     : real;
  xpos,ypos : integer;

BEGIN
  IF xlog
    THEN
      xpos := map_x(rlog10(x))
    ELSE
      xpos := map_x(x);
  IF ylog
    THEN
      ypos := map_y(rlog10(y))
    ELSE
      ypos := map_y(y);
  fix := (l/2)*scalex;
  corners[1,1] := xpos-trunc(fix);
  corners[2,1] := xpos-trunc(fix);
  corners[3,1] := xpos+trunc(fix);
  corners[4,1] := xpos+trunc(fix);
  corners[5,1] := xpos-trunc(fix);
  corners[1,2] := ypos-trunc(fix/sqrt(aspect));
  corners[2,2] := ypos+trunc(fix/sqrt(aspect));
  corners[3,2] := ypos+trunc(fix/sqrt(aspect));
  corners[4,2] := ypos-trunc(fix/sqrt(aspect));
  corners[5,2] := ypos-trunc(fix/sqrt(aspect));
  drawpoly(5,corners);
  IF fill
    THEN
      BEGIN
        setfillstyle(1,Fcolor);
        fillpoly(5,corners);
      END;
END;

PROCEDURE draw_diamond;

TYPE 
  border = ARRAY[1..5,1..2] OF word;

VAR 
  corners : border;
  fix     : real;
  xpos,ypos : integer;

BEGIN
  IF xlog
    THEN
      xpos := map_x(rlog10(x))
    ELSE
      xpos := map_x(x);
  IF ylog
    THEN
      ypos := map_y(rlog10(y))
    ELSE
      ypos := map_y(y);
  fix := (l/2)*scalex;
  corners[1,1] := xpos-trunc(fix);
  corners[2,1] := xpos;
  corners[3,1] := xpos+trunc(fix);
  corners[4,1] := xpos;
  corners[5,1] := xpos-trunc(fix);
  corners[1,2] := ypos;
  corners[2,2] := ypos+trunc(fix/sqrt(aspect));
  corners[3,2] := ypos;
  corners[5,2] := ypos;
  corners[4,2] := ypos-trunc(fix/sqrt(aspect));
  drawpoly(5,corners);
  IF fill
    THEN
      BEGIN
        setfillstyle(1,Fcolor);
        fillpoly(5,corners);
      END;
END;



PROCEDURE draw_triangle;

TYPE 
  border = ARRAY[1..4,1..2] OF word;

VAR 
  corners : border;
  xoff,yoff,voff : real;
  xpos,ypos : integer;

BEGIN
  IF xlog
    THEN
      xpos := map_x(rlog10(x))
    ELSE
      xpos := map_x(x);
  IF ylog
    THEN
      ypos := map_y(rlog10(y))
    ELSE
      ypos := map_y(y);
  yoff := (l/2)*0.57735027;
  xoff := (l/2);
  voff := (l/2)*0.86602541;
  corners[1,1] := xpos-trunc(scalex*xoff);
  corners[4,1] := xpos-trunc(scalex*xoff);
  corners[2,1] := xpos;
  corners[3,1] := xpos+trunc(scalex*xoff);
  corners[1,2] := ypos+trunc(scalex/sqrt(aspect)*yoff);
  corners[4,2] := ypos+trunc(scalex/sqrt(aspect)*yoff);
  corners[2,2] := ypos-trunc(scalex/sqrt(aspect)*voff);
  corners[3,2] := ypos+trunc(scalex/sqrt(aspect)*yoff);
  drawpoly(4,corners);
  IF fill
    THEN
      BEGIN
        setfillstyle(1,Fcolor);
        fillpoly(4,corners);
      END;
END;

PROCEDURE draw_inverse_triangle;

TYPE 
  border = ARRAY[1..4,1..2] OF word;

VAR 
  corners : border;
  xoff,yoff,voff : real;
  xpos,ypos : integer;

BEGIN
  IF xlog
    THEN
      xpos := map_x(rlog10(x))
    ELSE
      xpos := map_x(x);
  IF ylog
    THEN
      ypos := map_y(rlog10(y))
    ELSE
      ypos := map_y(y);
  yoff := (l/2)*0.57735027;
  xoff := (l/2);
  voff := (l/2)*0.86602541;
  corners[1,1] := xpos-trunc(scalex*xoff);
  corners[4,1] := xpos-trunc(scalex*xoff);
  corners[2,1] := xpos;
  corners[3,1] := xpos+trunc(scalex*xoff);
  corners[1,2] := ypos-trunc(scalex/sqrt(aspect)*yoff);
  corners[4,2] := ypos-trunc(scalex/sqrt(aspect)*yoff);
  corners[2,2] := ypos+trunc(scalex/sqrt(aspect)*voff);
  corners[3,2] := ypos-trunc(scalex/sqrt(aspect)*yoff);
  drawpoly(4,corners);
  IF fill
    THEN
      BEGIN
        setfillstyle(1,Fcolor);
        fillpoly(4,corners);
      END;
END;


PROCEDURE set_clipping_off;

BEGIN
  clip := false;
END;

PROCEDURE set_clipping_on;

BEGIN
  clip := true;
END;

PROCEDURE draw_line;

VAR
  xpos1,xpos2,ypos1,ypos2,tcolor : integer;

BEGIN
  IF xlog
    THEN
      BEGIN
        xpos1 := map_x(rlog10(x1));
        xpos2 := map_x(rlog10(x2));
      END
    ELSE
      BEGIN
        xpos1 := map_x(x1);
        xpos2 := map_x(x2);
      END;
  IF ylog
    THEN
      BEGIN
        ypos1 := map_y(rlog10(y1));
        ypos2 := map_y(rlog10(y2));
      END
    ELSE
      BEGIN
        ypos1 := map_y(y1);
        ypos2 := map_y(y2);
      END;
  tcolor := fcolor;
  set_foreground_color(color);
  setlinestyle(linetype,0,1);
  line(xpos1,ypos1,xpos2,ypos2);
  moveto(xpos2,ypos2);
  set_foreground_color(fcolor);
END;

PROCEDURE draw_border;

TYPE 
  border = ARRAY[1..5,1..2] OF integer;

VAR 
  round : border;
  i     : integer;

BEGIN
  IF (windex>0) AND (windex<=no_of_windows)
    THEN
      BEGIN
        select_window(windex);
        FOR i:=1 TO 5 DO
          BEGIN
            round[1,1] := 0;
            round[1,2] := 0;
            round[2,1] := 0;
            round[2,2] := win_length;
            round[3,1] := win_width;
            round[3,2] := win_length;
            round[4,1] := win_width;
            round[4,2] := 0;
            round[5,1] := 0;
            round[5,2] := 0;
          END;
        drawpoly(5,round);
      END
    ELSE
      AdGraphError('Undefined Window');
END;

PROCEDURE draw_poly(ndata : integer; data : actual_data);

VAR 
  i : integer;

BEGIN
  FOR i:=2 TO ndata DO
    line(data[i-1,1],data[i-1,2],data[i,1],data[i,2]);
END;

PROCEDURE draw_conn_data;

VAR 
  fin_poly : actual_data;
  nob,rem  : integer;
  j,k      : integer;

PROCEDURE draw_connected_data( VAR drawn_poly : actual_data );


VAR 
  index      : integer;

BEGIN
  FOR index:=1 TO i DO
    BEGIN
      drawn_poly[index,1] := map_x(plotarray[index,1]);
      drawn_poly[index,2] := map_y(plotarray[index,2]);
    END;
  draw_poly(i,drawn_poly);
  IF fill
    THEN
      BEGIN
        setfillstyle(1,fcolor);
        fillpoly(i,drawn_poly);
      END;
END;

PROCEDURE draw_log_log_connected_data( VAR drawn_poly : actual_data );


VAR 
  index      : integer;

BEGIN
  FOR index:=1 TO i DO
    BEGIN
      drawn_poly[index,1] := map_x(rlog10(plotarray[index,1]));
      drawn_poly[index,2] := map_y(rlog10(plotarray[index,2]));
    END;
  draw_poly(i,drawn_poly);
  IF fill
    THEN
      BEGIN
        setfillstyle(1,fcolor);
        fillpoly(i,drawn_poly);
      END;
END;

PROCEDURE draw_log_lin_connected_data( VAR drawn_poly : actual_data );


VAR 
  index      : integer;

BEGIN
  FOR index:=1 TO i DO
    BEGIN
      drawn_poly[index,1] := map_x(rlog10(plotarray[index,1]));
      drawn_poly[index,2] := map_y(plotarray[index,2]);
    END;
  draw_poly(i,drawn_poly);
  IF fill
    THEN
      BEGIN
        setfillstyle(1,fcolor);
        fillpoly(i,drawn_poly);
      END;
END;

PROCEDURE draw_lin_log_connected_data( VAR drawn_poly : actual_data );


VAR
  index      : integer;

BEGIN
  FOR index:=1 TO i DO
    BEGIN
      drawn_poly[index,1] := map_x(plotarray[index,1]);
      drawn_poly[index,2] := map_y(rlog10(plotarray[index,2]));
    END;
  draw_poly(i,drawn_poly);
  IF fill
    THEN
      BEGIN
        setfillstyle(1,fcolor);
        fillpoly(i,drawn_poly);
      END;
END;


BEGIN
  setlinestyle(lstyle,0,1);
  IF xlog AND NOT ylog
    THEN
      draw_log_lin_connected_data(fin_poly);
  IF xlog AND ylog
    THEN
      draw_log_log_connected_data(fin_poly);
  IF NOT xlog AND ylog
    THEN
      draw_lin_log_connected_data(fin_poly);
  IF NOT xlog AND NOT ylog
    THEN
      draw_connected_data(fin_poly);
END;

PROCEDURE draw_histogram;

TYPE
  small = ARRAY[1..5,1..2] OF real;

VAR
  actual : small;
  index,jndex  : integer;
  space      : real;
  drawn_poly : actual_data;

BEGIN
  plotarray[i+1,1] := 2*plotarray[i,1]-plotarray[i-1,1];
  plotarray[i+1,2] := 0;
  FOR jndex:=1 TO i DO
    BEGIN
      space := (plotarray[jndex+1,1]-plotarray[jndex,1])/2;
      actual[1,1] := plotarray[jndex,1]-space;
      actual[2,1] := plotarray[jndex,1]-space;
      actual[3,1] := plotarray[jndex,1]+space;
      actual[4,1] := actual[3,1];
      actual[5,1] := actual[1,1];
      actual[1,2] := 0;
      actual[2,2] := plotarray[jndex,2];
      actual[3,2] := plotarray[jndex,2];
      actual[4,2] := 0;
      actual[5,2] := 0;
      FOR index:=1 TO 5 DO
        BEGIN
          drawn_poly[index,1] := map_x(actual[index,1]);
          drawn_poly[index,2] := map_y(actual[index,2]);
        END;
      drawpoly(5,drawn_poly);
      IF fill
        THEN
          BEGIN
            setfillstyle(pattern,Fcolor);
            fillpoly(5,drawn_poly);
          END;
    END;
END;

PROCEDURE setup_x_axes;

VAR 
  tick_length : integer;
  i,j         : integer;
  spacex,spacey  : real;
  xtext,ytext    : integer;
  old_window     : byte;
  temp           : string;
  tickval        : real;
  old_length,old_width : integer;
  dist                 : integer;
  old_style            : linesettingstype;

BEGIN
  IF top
    THEN
        line(0,0,win_width,0);
  IF bottom
    THEN
        line(0,win_length,win_width,win_length);
  IF zerox
    THEN
      draw_line(world_indices[current_sel,1],0,world_indices[current_sel,2],0,Fcolor,0);
  tick_length := trunc(rfloat(win_width)/100);
  IF xmajtick>0
    THEN
      FOR i:=1 TO xmajtick+1 DO
        BEGIN
          IF top AND topt
            THEN
              BEGIN
                line(trunc((i-1)*(win_width/xmajtick)),0,
                trunc((i-1)*(win_width/xmajtick)),tick_length);
              END;
          IF bottom AND bott
            THEN
              BEGIN
                line(trunc((i-1)*(win_width/xmajtick)),win_length,
                trunc((i-1)*(win_width/xmajtick)),win_length-tick_length);
              END;
          IF grid
            THEN
              BEGIN
                getlinesettings(old_style);
                setlinestyle(1,0,1);
                line(trunc((i-1)*(win_width/xmajtick)),win_length,
                trunc((i-1)*(win_width/xmajtick)),0);
                WITH old_style DO
                    setlinestyle(linestyle,pattern,thickness);
              END;
        END;
  spacex := win_width/xmajtick;
  IF xmajtick>0
    THEN
      IF xmintick>0
        THEN
          BEGIN
            FOR i:= 1 TO xmajtick DO
              FOR j:= 1 TO xmintick-1 DO
                BEGIN
                  IF top AND topt
                    THEN
                      BEGIN
                        line(trunc((i-1)*spacex+j*spacex/xmintick),0,
                        trunc((i-1)*spacex+j*spacex/xmintick),trunc(tick_length/2));
                      END;
                  IF bottom AND bott
                    THEN
                      BEGIN
                        line(trunc((i-1)*spacex+j*spacex/xmintick),win_length,
                        trunc((i-1)*spacex+j*spacex/xmintick),trunc(win_length-tick_length
                                                                    /2));
                      END;
                  IF grid
                    THEN
                      BEGIN
                        getlinesettings(old_style);
                        setlinestyle(1,0,1);
                        line(trunc((i-1)*spacex+j*spacex/xmintick),win_length,
                        trunc((i-1)*spacex+j*spacex/xmintick),0);
                        WITH old_style DO
                          BEGIN
                            setlinestyle(linestyle,pattern,thickness);
                          END;
                      END;
                END;
          END;
  settextjustify(1,2);
  old_window := no_of_windows;
  old_length := win_length;
  old_width := win_width;
  define_window(old_window+1,0,0,maxx,maxy);
  select_window(old_window+1);
  settextstyle(tickfont,0,xtlabelsize);
  IF xmajtick>0
    THEN
      FOR i:=1 TO xmajtick+1 DO
        BEGIN
          tickval := (i-1)*(world_indices[current_sel,2]-world_indices[current_sel,1])/
                     xmajtick+
                     world_indices[current_sel,1];
          temp := fix_string(tickval,prec);
          xtext := trunc((i-1)*(old_width/xmajtick))+win_indices[old_window,1];
          ytext := win_indices[old_window,4]+2;
          outtextxy(xtext,ytext,temp);
        END;
  settextjustify(1,2);
  settextstyle(labelfont,0,xllabelsize);
  xtext := win_indices[old_window,1]+trunc(old_width/2);
  ytext := ytext+textheight(xlabel);
  outtextxy(xtext,ytext,xlabel);
  flush_window(old_window+1);
  select_window(old_window);
END;

PROCEDURE setup_y_axes;

VAR
  tick_length : integer;
  i,j         : integer;
  spacex,spacey  : real;
  xtext,ytext    : integer;
  old_window     : byte;
  temp           : string;
  tickval        : real;
  old_length,old_width : integer;
  dist                 : integer;
  old_style            : linesettingstype;

BEGIN
  IF left
    THEN
        line(0,0,0,win_length);
  IF right
    THEN
        line(win_width,0,win_width,win_length);
  IF zeroy
    THEN
      draw_line(0,world_indices[current_sel,3],0,world_indices[current_sel,4],Fcolor,0);
  tick_length := trunc(rfloat(win_width)/100);
  IF ymajtick>0
    THEN
      FOR i:=1 TO ymajtick+1 DO
        BEGIN
          IF left AND leftt
            THEN
              BEGIN
                line(0,trunc((i-1)*(win_length/ymajtick)),tick_length,
                trunc((i-1)*(win_length/ymajtick)));
              END;
          IF right AND rightt
            THEN
              BEGIN
                line(win_width,trunc((i-1)*(win_length/ymajtick)),win_width-tick_length,
                trunc((i-1)*(win_length/ymajtick)));
              END;
          IF grid
            THEN
              BEGIN
                getlinesettings(old_style);
                setlinestyle(1,0,1);
                line(win_width,trunc((i-1)*(win_length/ymajtick)),0,
                trunc((i-1)*(win_length/ymajtick)));
                WITH old_style DO
                    setlinestyle(linestyle,pattern,thickness);
              END;
        END;
  spacey := win_length/ymajtick;
  IF ymajtick>0
    THEN
      IF ymintick>0
        THEN
          FOR i:= 1 TO ymajtick DO
            FOR j:= 1 TO ymintick-1 DO
              BEGIN
                IF left AND leftt
                  THEN
                      line(0,trunc((i-1)*spacey+j*spacey/ymintick),trunc(tick_length/2),
                      trunc((i-1)*spacey+j*spacey/ymintick));
                IF right AND rightt
                  THEN
                      line(win_width,trunc((i-1)*spacey+j*spacey/ymintick),trunc(win_width
                                                                                 -
                                                                               tick_length
                                                                                 /2),
                      trunc((i-1)*spacey+j*spacey/ymintick));
                IF grid
                  THEN
                    BEGIN
                      getlinesettings(old_style);
                      setlinestyle(1,0,1);
                      line(win_width,trunc((i-1)*spacey+j*spacey/ymintick),0,
                      trunc((i-1)*spacey+j*spacey/ymintick));
                      WITH old_style DO
                          setlinestyle(linestyle,pattern,thickness);
                    END;
              END;
  old_window := no_of_windows;
  old_length := win_length;
  old_width := win_width;
  define_window(old_window+1,-1,-1,-1,-1);
  select_window(old_window+1);
  settextstyle(tickfont,0,ytlabelsize);
  settextjustify(2,1);
  IF ymajtick>0
    THEN
      FOR i:=1 TO ymajtick+1 DO
        BEGIN
          tickval := (i-1)*(world_indices[current_sel,3]-world_indices[current_sel,4])/
                     ymajtick+
                     world_indices[current_sel,4];
          temp := fix_string(tickval,prec);
          ytext := trunc((i-1)*(old_length/ymajtick))+win_indices[old_window,3];
          xtext := win_indices[old_window,1]-2;
          outtextxy(xtext,ytext,temp);
        END;
  dist := textwidth(temp);
  settextjustify(2,1);
  settextstyle(labelfont,1,yllabelsize);
  ytext := win_indices[old_window,3]+trunc(old_length/2);
  xtext := win_indices[old_window,1]-round(dist*1.5);
  outtextxy(xtext,ytext,ylabel);
  flush_window(old_window+1);
  select_window(old_window);
END;


PROCEDURE setup_x_log_axes;

VAR 
  tick_length : integer;
  i,j         : integer;
  spacex,spacey  : real;
  xtext,ytext    : integer;
  old_window     : byte;
  temp           : string;
  tickval        : real;
  old_length,old_width : integer;
  nodec                : integer;
  decshft              : real;
  dist                 : integer;
  old_style            : linesettingstype;

BEGIN
  IF top
    THEN
      line(0,0,win_width,0);
  IF bottom
    THEN
      line(0,win_length,win_width,win_length);
  decshft := trunc(world_indices[current_sel,1]);
  nodec := trunc(world_indices[current_sel,2])-trunc(world_indices[current_sel,1]);
  tick_length := trunc(rfloat(win_width)/100);
  IF nodec>0
    THEN
      FOR i:=1 TO nodec DO
        BEGIN
          IF top AND topt
            THEN
              line(map_x(i+decshft),0,
              map_x(i+decshft),tick_length);
          IF bottom AND bott
            THEN
              line(map_x(i+decshft),win_length,
              map_x(i+decshft),win_length-tick_length);
          IF grid
            THEN
              BEGIN
                getlinesettings(old_style);
                setlinestyle(1,0,1);
                line(map_x(i+decshft),win_length,
                map_x(i+decshft),0);
                WITH old_style DO
                  setlinestyle(linestyle,pattern,thickness);
              END;
        END;
  spacex := win_width/nodec;
  IF nodec>0
    THEN
      IF xmintick>0
        THEN
          BEGIN
            FOR i:= 0 TO nodec DO
              FOR j:= 1 TO xmintick-1 DO
                BEGIN
                  IF top AND topt
                    THEN
                      line(map_x(i+decshft+rlog10(j*10/xmintick)),0,
                      map_x(i+decshft+rlog10(j*10/xmintick)),trunc(tick_length/2));
                  IF bottom AND bott
                    THEN
                      line(map_x(i+decshft+rlog10(j*10/xmintick)),win_length,
                      map_x(i+decshft+rlog10(j*10/xmintick)),trunc(win_length-tick_length/
                                                                   2));
                  IF grid
                    THEN
                      BEGIN
                        getlinesettings(old_style);
                        setlinestyle(1,0,1);
                        line(map_x(i+decshft+rlog10(j*10/xmintick)),win_length,
                        map_x(i+decshft+rlog10(j*10/xmintick)),0);
                        WITH old_style DO
                          setlinestyle(linestyle,pattern,thickness);
                      END;
                END;
          END;
  settextjustify(1,1);
  old_window := no_of_windows;
  old_length := win_length;
  old_width := win_width;
  define_window(old_window+1,-1,-1,-1,-1);
  select_window(old_window+1);
  setusercharsize(xtlabelsize,round(10*aspect),xtlabelsize,round(10*aspect));
  settextstyle(tickfont,0,usercharsize);
  IF nodec>0
    THEN
      BEGIN
        FOR i:=2 TO nodec+1 DO
          BEGIN
            tickval := rbase10(i+decshft-1);
            temp := fix_string(tickval,prec);
            xtext := map_x(i+decshft-1)+win_indices[old_window,1];
            ytext := old_length+win_indices[old_window,3]+textheight(temp);
            outtextxy(xtext,ytext,temp);
          END;
        tickval := rbase10(world_indices[current_sel,1]);
        temp := fix_string(tickval,prec);
        xtext := win_indices[old_window,1];
        ytext := old_length+win_indices[old_window,3]+textheight(temp);
        outtextxy(xtext,ytext,temp);
      END;
  settextjustify(1,2);
  setusercharsize(round(xllabelsize/aspect),round(10/aspect),round(xllabelsize/aspect),
  round(10/aspect));
  settextstyle(labelfont,0,usercharsize);
  xtext := win_indices[old_window,1]+trunc(old_width/2);
  ytext := ytext+round(textheight(xlabel)/2);
  outtextxy(xtext,ytext,xlabel);
  flush_window(old_window+1);
  select_window(old_window);
END;

PROCEDURE setup_y_log_axes;

VAR 
  tick_length : integer;
  i,j         : integer;
  spacex,spacey  : real;
  xtext,ytext    : integer;
  old_window     : byte;
  temp           : string;
  tickval        : real;
  old_length,old_width : integer;
  nodec                : integer;
  decshft              : real;
  dist                 : integer;
  old_style            : linesettingstype;

BEGIN
  IF left
    THEN
      line(0,0,0,win_length);
  IF right
    THEN
      line(win_width,0,win_width,win_length);
  nodec := trunc(world_indices[current_sel,4])-trunc(world_indices[current_sel,3]);
  tick_length := trunc(rfloat(win_width)/100);
  IF nodec>0
    THEN
      FOR i:=1 TO nodec DO
        BEGIN
          IF left AND leftt
            THEN
              line(0,map_y(i+decshft),tick_length,
              map_y(i+decshft));
          IF right AND rightt
            THEN
              line(win_width,map_y(i+decshft),win_width-tick_length,
              map_y(i+decshft));
          IF grid
            THEN
              BEGIN
                getlinesettings(old_style);
                setlinestyle(1,0,1);
                line(win_width,map_y(i+decshft),0,
                map_y(i+decshft));
                WITH old_style DO
                  setlinestyle(linestyle,pattern,thickness);
              END;
        END;
  spacey := win_length/nodec;
  IF nodec>0
    THEN
      IF ymintick>0
        THEN
          FOR i:= 0 TO nodec+1 DO
            FOR j:= 1 TO ymintick-1 DO
              BEGIN
                IF left AND leftt
                  THEN
                    line(0,map_y(i+decshft+rlog10(j*10/ymintick)),trunc(tick_length/2),
                    map_y(i+decshft+rlog10(j*10/ymintick)));
                IF right AND rightt
                  THEN
                    line(win_width,map_y(i+decshft+rlog10(j*10/ymintick)),trunc(win_width-
                                                                               tick_length
                                                                                /2),
                    map_y(i+decshft+rlog10(j*10/ymintick)));
                IF grid
                  THEN
                    BEGIN
                      getlinesettings(old_style);
                      setlinestyle(1,0,1);
                      line(win_width,map_y(i+decshft+rlog10(j*10/ymintick)),0,
                      map_y(i+decshft+rlog10(j*10/ymintick)));
                      WITH old_style DO
                        setlinestyle(linestyle,pattern,thickness);
                    END;
              END;
  old_window := no_of_windows;
  old_length := win_length;
  old_width := win_width;
  define_window(old_window+1,-1,-1,-1,-1);
  select_window(old_window+1);
  setusercharsize(ytlabelsize,round(aspect*10),ytlabelsize,round(aspect*10));
  settextstyle(tickfont,0,usercharsize);
  settextjustify(0,1);
  IF nodec>0
    THEN
      BEGIN
        FOR i:=2 TO nodec+1 DO
          BEGIN
            tickval := rbase10(i+decshft-1);;
            temp := fix_string(tickval,prec);
            ytext := map_y(i+decshft-1)+win_indices[old_window,3];
            xtext := win_indices[old_window,1]-textwidth(temp)-2;
            outtextxy(xtext,ytext,temp);
          END;
        tickval := rbase10(world_indices[current_sel,3]);
        temp := fix_string(tickval,prec);
        xtext := win_indices[old_window,1]-textwidth(temp)-2;
        ytext := win_indices[old_window,4];
        outtextxy(xtext,ytext,temp);
      END;
  dist := textwidth(temp);
  settextjustify(2,1);
  setusercharsize(trunc(yllabelsize*aspect),round(10*aspect),trunc(yllabelsize*aspect),
  round(10/sqrt(aspect)));
  settextstyle(labelfont,1,usercharsize);
  ytext := win_indices[old_window,3]+trunc(old_length/2);
  xtext := win_indices[old_window,1]-trunc(1.5*dist);
  outtextxy(xtext,ytext,ylabel);
  flush_window(old_window+1);
  select_window(old_window);
END;


PROCEDURE draw_text;


BEGIN
  IF xlog
    THEN
      x := rlog10(x);
  IF ylog
    THEN
      y := rlog10(y);
  settextstyle(font,direction,size);
  settextjustify(xj,yj);
  outtextxy(map_x(x),map_y(y),outex);
END;


PROCEDURE Leave;

BEGIN
  CloseGraph;
END;



END.

------------------- End of ADGRAPH.PAS --------------------------


Unit RMath;


interface

function rlog10(a:real):real;
function rasin(a:real):real;
function racos(a:real):real;
function rcos(a:real):real;
function rtan(a:real):real;
function ratan(a:real):real;
function ratanf(x,y : real):real;
function rceil(a:real):real;
function rdeg_to_rad(a:real):real;
function rfloor(a:real):real;
function rcosh(a:real):real;
function rsinh(a:real):real;
function rtanh(a:real):real;
function rfmod(x,y:real):real;
function rpower(base,exponent:real):real;
function rfloat (int_in : integer) : real;
function rbase10(a:real):real;

implementation

function rlog10(a:real):real;

begin
 rlog10:=ln(a)/ln(10);
end;

function rasin(a:real):real;

begin
 if a=1 then
  rasin:=pi/2
 else
  rasin:=arctan(sqrt(abs(a*a/(1-a*a))));
end;

function racos(a:real):real;

begin
 if a=0 then
  racos:=pi/2
 else
  racos:=arctan(sqrt(abs((1-a*a)/(a*a))));
end;

function rcos(a:real):real;

begin
 rcos:=sqrt(1-sin(a)*sin(a));
end;

function rtan(a:real):real;

begin
 rtan:=sin(a)/cos(a);
end;

function ratan(a:real) : real;

begin
 ratan:=arctan(a);
end;

function ratanf(x,y : real):real;

begin
 ratanf:=arctan(y/x);
end;

function rceil(a:real):real;

var
 tmp : comp;

begin
 tmp:=round(a);
 if tmp>a then
  rceil:=tmp
 else
  rceil:=tmp+1;
end;

function rdeg_to_rad(a:real):real;

begin
 rdeg_to_rad:=360/(2*pi);
end;

function rfloor(a:real):real;

var
 tmp:longint;

begin
 tmp:=trunc(a);
 rfloor:=tmp;
end;

function rcosh(a:real):real;

begin
 rcosh:=(exp(a)+exp(-a))/2;
end;

function rsinh(a:real):real;

begin
 rsinh:=(exp(a)-exp(-a))/2;
end;

function rtanh(a:real):real;

begin
 rtanh:=rsinh(a)/rcosh(a);
end;

function rfmod(x,y : real):real;


begin
 rfmod:=x-rfloor(x/y)*y;
end;

function rpower ( base,exponent : real ) : real;

begin
 rpower:=exp(exponent*ln(abs(base)));
end;

function rfloat (int_in : integer) : real;

begin
 rfloat:=int_in;
end;

function rbase10(a:real):real;

var
 temp : real;

begin
 temp:=a*ln(10);
 rbase10:=exp(temp);
end;

end.

--------------------------- end of rmath.pas ------------------------



Unit DateTime;

{****************************************************************
** Copied from an old TP3 manual. I assume C. Borland Intn'l   **
****************************************************************}

interface

uses
 dos;

function date_and_time : string;

implementation

function date_and_time : string;


var
 regs : registers;
 temp : string;
 mark : string;

begin
 fillchar(mark,79,0);
 with regs do
  begin
   AX:=$2a00;
   MsDos(regs);
   str(lo(DX),temp);
   mark:=mark+temp+'/';
   str(hi(DX),temp);
   mark:=mark+temp+'/';
   str(CX,temp);
   mark:=mark+temp+' ';
   AX:=$2C00;
   MSDOS(regs);
   str(Hi(CX),temp);
   mark:=mark+temp+':';
   str(lo(CX),temp);
   mark:=mark+temp+':';
   str(hi(DX),temp);
   mark:=mark+temp;
  end;
  date_and_time :=mark;
end;

end.

---------------------------- end of datetime.pas --------------
---------------------------------------------------------------------
- Andreas C. Enotiadis (ace@cc.ic.ac.uk, ace@grathun1.earn, etc)    -
- (I'm still thinking about something clever to put here...)        -
---------------------------------------------------------------------