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...) -
---------------------------------------------------------------------