home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Frozen Fish 1: Amiga
/
FrozenFish-Apr94.iso
/
bbs
/
alib
/
d9xx
/
d916
/
mathplot.lha
/
MathPlot
/
Macros
/
GridLines.mapl
< prev
next >
Wrap
Text File
|
1993-10-04
|
4KB
|
258 lines
/* Plots a grid. */
/* Version 1.00, 07.08.1993 */
options results
IF ~SHOW('L','rexxmathlib.library') THEN
CALL ADDLIB('rexxmathlib.library',0,-30)
/* OK, MathPlot will clear the screen before every plot when there */
/* was no REAL plot before. So we have to do some trick to get a */
/* real plot.... */
/* If you do not understand this: Try this script and then plot */
/* another function or the axis. Then delete the next lines, clear */
/* screen and do it again. The first time, you will se both */
/* functions, the second time only the last function. */
getfunc 0
a = result
setfunc 0 10000
plot 0 normal
setfunc 0 a
/* End of trick.... */
/* First, get some infos from the program */
getintervall2 stem intervall.
evalstring intervall.xmin
xmn = result
evalstring intervall.xmax
xmp = result
evalstring intervall.ymin
ymn = result
evalstring intervall.ymax
ymp = result
evalstring intervall.xminreal
xmnr = result
evalstring intervall.xmaxreal
xmpr = result
evalstring intervall.yminreal
ymnr = result
evalstring intervall.ymaxreal
ympr = result
info stem b.
colors = b.colors
/* Calc the tics */
xtics = maketics(xmn, xmp, 0, 10)
ytics = maketics(ymn, ymp, 0, 10)
flx = floor(xmn/xtics)
fly = floor(ymn/ytics)
clx = ceil(xmp/xtics)
cly = ceil(ymp/ytics)
/* Draw the tics */
drawtics(xtics*flx, xtics, xtics*clx,
,ytics*fly, ytics, ytics*cly)
exit
/* ------------------------------------------------------------*/
/* Function MakeTics */
maketics:
parse arg tmin, tmax, logscale, baselog
x = tmin-tmax
xr = fabs(x)
l10 = log10(xr)
if(l10 >= 0.0) then do
i = floor(l10)
end
else do
i = ceil(l10-1.0)
end
if(logscale) then do
tic = raise(baselog, i)
if(tic < 1.0) then tic = 1.0
end
else do
xnorm = pow(10.0, l10-i)
if(xnorm <= 2.01) then do
tics = 0.2
end
else do
if(xnorm <= 5) then do
tics = 0.5
end
else do
tics = 1.0
end
end
tic = tics * raise(10.0,i)
end
return tic
/* ------------------------------------------------------------*/
/* Function RAISE */
raise:
parse arg x,y
val = 1.0
do i=0 to abs(y)-1
val = val*x
end
if(y < 0) then val = 1/val
return val
/* ------------------------------------------------------------*/
/* DrawTics */
drawtics:
parse arg xstart, xdiff, xendorig, ystart, ydiff, yendorig
/* Round a bit */
xend = xendorig * 1.001
yend = yendorig * 1.001
a = 0
b = 0
e = exp(1)
pi = 2*acos(0)
ln10 = ln(10)
select
when intervall.xmode=0 then do
do pos1 = xstart to xend by xdiff
x.a = pos1
a = a+1
end
end
when intervall.xmode=1 then do
do pos1 = xstart to xend by xdiff
x.a = pos1*e
a = a+1
end
end
when intervall.xmode=2 then do
do pos1 = xstart to xend by xdiff
x.a = pos1*pi
a = a+1
end
end
when intervall.xmode=3 then do
do pos1 = xstart to xend by xdiff
x.a = exp(pos1)
a = a+1
end
end
when intervall.xmode=4 then do
do pos1 = xstart to xend by xdiff
x.a = exp(pos1*ln10)
a = a+1
end
end
otherwise nop
end
select
when intervall.ymode=0 then do
do pos1 = ystart to yend by ydiff
y.b = pos1
b = b+1
end
end
when intervall.ymode=1 then do
do pos1 = ystart to yend by ydiff
y.b = pos1*e
b = b+1
end
end
when intervall.ymode=2 then do
do pos1 = ystart to yend by ydiff
y.b = pos1*pi
b = b+1
end
end
when intervall.ymode=3 then do
do pos1 = ystart to yend by ydiff
y.b = exp(pos1)
b = b+1
end
end
when intervall.ymode=4 then do
do pos1 = ystart to yend by ydiff
y.b = exp(pos1*ln10)
b = b+1
end
end
otherwise nop
end
/* Reset plotcolor */
getcolor plotcolor
oldcolor = result
/* Ask plotcolor */
/* First generate the button-string */
select
when colors = 2 then do
but = "1|Cancel"
end
when colors = 4 then do
but = "1|2|3|Cancel"
end
when colors = 8 then do
but = "1|2|3|4|5|6|7|Cancel"
end
when colors = 16 then do
but = "1|2|3|4|5|6|7|8|9|10|11|12|13|14|15|Cancel"
end
when colors = 32 then do
/* 32 colors does not make sense here */
but = "1|2|3|4|5|6|7|8|9|10|11|12|13|14|15|Cancel"
end
end
text = 'title "GridLines" prompt "Select a color" button ' || but
/* Now ask */
requestresponse text
if RC == 5 then exit
setcolor plotcolor result
/* Plot the grid */
do i=0 to a-1
line x.i ympr x.i ymnr
end
do j=0 to b-1
line xmnr y.j xmpr y.j
end
setcolor plotcolor oldcolor
return 0