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