rs@uunet.UU.NET (Rich Salz) (07/09/87)
Submitted-by: "Wombat" <rsk@j.cc.purdue.edu>
Posting-Number: Volume 10, Issue 49
Archive-name: crc_plot/Part05
# This is a shell archive.
# Remove everything above and including the cut line.
# Then run the rest of the file through sh.
#----cut here-----cut here-----cut here-----cut here----#
#!/bin/sh
# shar: Shell Archiver
# Run the following text with /bin/sh to create:
# src
mkdir src
chdir src
cat << \SHAR_EOF > crc.h
#
/*
crc.h - include file for the CRC graphics package
Carl Crawford
Purdue University
W. Lafayette, IN 47907
Jan. 1981
*/
#include <stdio.h>
#include <math.h>
#include <signal.h>
unsigned short *_pic; /* pointer to bit plane */
int _xp,_yp; /* integer position */
float _axp,_ayp; /* real position */
float _xo,_yo; /* current origin */
int _ud; /* indicates up/down for pen */
int _error; /* indicates error in plotting */
float _fac; /* scale factor */
float _ipsz; /* size of the internal file - 1 */
float _ipsz10; /* ipsize / 10.0 */
int DEV; /* major device number */
char DEVN; /* minor device number */
int BLANK; /* 1 = don't blank device before plotting */
char *STORE; /* default storage file */
char *PLOTFILT; /* Plot Filter Name */
float TICDIS; /* distance between tic marks on the axis */
float HEIGHT; /* char height in axis routines */
int DIGITS; /* number of dec. digits + 1 in axis annotation */
unsigned _bufsize; /* size of point buffer */
char _abuf[100]; /* char buffer for anyone */
char *SITE; /* site for gplp */
FILE *_pipe_fd; /* file descriptor for pipes and pseudo pipes */
int (*_isig)(); /* save SIGINT signal */
int (*_qsig)(); /* save SIGQUIT signal */
int (*_hsig)(); /* save SIGHUP signal */
int _intty[3]; /* save current tty modes in here */
/* control characters */
#define NUL 0 /* <nul> */
#define SOH 1 /* <soh> */
#define STX 2 /* <stx> */
#define ETC 3 /* <etc> */
#define ETX 3 /* <etx> */
#define EOT 4 /* <eot> */
#define ENQ 5 /* <enq> */
#define ACK 6 /* <ack> */
#define BEL 7 /* <bel> */
#define BS 8 /* <bs> */
#define HT 9 /* <ht> */
#define LF 10 /* <lf> */
#define VT 11 /* <vt> */
#define FF 12 /* <ff> */
#define CR 13 /* <cr> */
#define SO 14 /* <so> */
#define SI 15 /* <si> */
#define DLE 16 /* <dle> */
#define DC1 17 /* <dc1> */
#define DC2 18 /* <dc2> */
#define DC3 19 /* <dc3> */
#define DC4 20 /* <dc4> */
#define NAK 21 /* <nak> */
#define SYN 22 /* <syn> */
#define ETB 23 /* <etb> */
#define CAN 24 /* <can> */
#define EM 25 /* <em> */
#define SUB 26 /* <sub> */
#define ESC 27 /* <esc> */
#define FS 28 /* <fs> */
#define GS 29 /* <gs> */
#define RS 30 /* <rs> */
#define US 31 /* <us> */
/* variables for HP and TEK */
int _CM; /* current mode */
int _X; /* x position */
int _Y; /* y position */
int _FILL; /* number of fill characters */
#define BINARY_FONT_FILE "/usr/unsup/lib/crc/font.5x7"
#define PLOTBIN "/usr/bin/plot"
#define BIT 0 /* major device table */
#define GOV 1
#define IMAGE 2
#define GGOV 3
#define GIMAGE 4
#define PLOT 5
#define TEK 6
#define HP 7
#define MBIT 4
/* maximum device in bit plane mode */
/*
Major and minor device tables
DEV DEVN dev OUTPUT
0 0 0 file or standard output
1 8 Versatec through gp (I)
2 16 Printronix through gplp (I) and opr (I)
1 0 1 Comtal graphics overlay 0(*)
1 9 Comtal graphics overlay 1(*)
2 17 Comtal graphics overlay 2(*)
2 0 2 Comtal image image displayed(*)
1 10 Comtal image 0(*)
2 18 Comtal image 1(*)
3 26 Comtal image 2(*)
3 0 3 Grinnell graphics overlay 0(*)
1 11 Grinnell graphics overlay 1(*)
2 19 Grinnell graphics overlay 2(*)
3 27 Grinnell graphics overlay 3(*)
4 0 4 Grinnell Image being Displayed (*)
1 12 Grinnell Image Plane 0(*)
2 20 Grinnell Image Plane 1(*)
3 28 Grinnell Image Plane 2(*)
4 36 Grinnell Image Plane 3(*)
5 44 Grinnell Image Plane 4(*)
5 0 5 Plot Subroutines
6 0 6 Tektronix through standard output
1 14 Retro-Graphics through standard output
2 22 Tektronix 4113
7 0 7 HP through /u/lib/graphics/hpd
(*) - through /u/lib/graphics/gd
*/
SHAR_EOF
cat << \SHAR_EOF > draw.f
c
c draw - draw a line and set the hiding boundaries accorindingly
c
subroutine draw(x1,y1,x2,y2)
parameter(maxstp=8000)
logical xaxs,yaxs,zaxs,abv,blw,xdir,ydir,print
logical vertcl,hrzntl
dimension above(maxstp),below(maxstp)
common /b/ above,below
common /d/ zlen,nx,ny,numstp,dlmnsm,dm,dl,small
common /flag/ xaxs,yaxs,zaxs,abv,blw,xdir,ydir,print
common /pos/ xpos,ypos
if( x1 .eq. x2 .and. y1 .eq. y2 ) return
c going left or right?
isign = 1
if ( x2 .lt. x1 ) isign = -1
xpos = x1
ypos = y1
hrzntl = .false.
c
c if the line is vertical increase the number of points
c in between.
c
if ( abs(x2 - x1) .lt. dl ) then
vertcl = .true.
dx = (x2 - x1) / 30.0
dy = (y2 - y1) / 30.0
if( abs(y2-y1) .lt. small ) hrzntl = .true.
else
vertcl = .false.
dx = isign * dl
dy = dl * (y2 - y1) / abs(x2 - x1)
endif
absdx = abs( dx ) / 2.0 - small
absdy = abs( dy ) / 2.0 - small
m = ifix(x1*dm+1.01)
c
10 continue
if ( abv ) then
c
c if hitting the boundary while approaching from above
c draw the line up to there.
c
if ( y1 .lt. above(m) ) then
if( print ) write(6,*)" hit from above draw ",
$ "to x1,y1",x1,y1
call plot(xpos,ypos,3)
call plot(x1,y1,2)
abv = .false.
if( y1 .le. below(m) ) then
c when no axis both flags are true in the begining
blw = .true.
if( blw ) below(m) = y1
endif
endif
c
c if hitting the boundary while approaching from above
c draw the line up to there.
c
elseif( .not. blw ) then
if( y1 .ge. above(m) ) then
if( print ) write(6,*)" hit abv fr mid dr ",
$ "fr x1,y1",x1,y1
xpos = x1
ypos = y1
abv = .true.
endif
if( y1 .le. below(m) ) then
if( print ) write(6,*)" hit blw fr mid dr ",
$ "fr x1,y1",x1,y1
xpos = x1
ypos = y1
blw = .true.
endif
c on the bottom
else
if ( y1 .gt. below(m) ) then
call plot(xpos,ypos,3)
call plot(x1,y1,2)
if( print ) write(6,*)" hit from below ",
$ "draw to x1,y1",x1,y1
blw = .false.
if( y1 .ge. above(m) ) abv = .true.
endif
endif
c if line is vertical, the hiding limits have been or will
c be set by other segments below or above this segment,
c unless it hits a line in the middle.
if( .not. vertcl ) then
if( y1 .gt. above(m) ) then
above(m) = y1
abv = .true.
endif
if( y1 .lt. below(m) ) then
below(m) = y1
blw = .true.
endif
m = m + isign
if( m .lt. 1 .or. m .gt. maxstp ) then
write(6,*)"exceeded the hiding boundary in draw.f"
write(6,*)"draw(",x1,",",y1,",",x2,",",y2,")"
stop
endif
endif
c JUST ADDED FOR TEST
if( .not. vertcl ) x1 = x1 + dx
y1 = y1 + dy
c if( vertcl ) then
c if( y1 .gt. above(m) ) then
c above(m) = y1
c endif
c if( y1 .lt. below(m) ) then
c below(m) = y1
c endif
c endif
c if the line is vertical, compare the y components
if( vertcl ) then
if( .not. hrzntl .and. abs(y2-y1) .gt. absdy ) go to 10
elseif( abs(x2 - x1) .gt. absdx ) then
go to 10
endif
c
if (abv .or. blw ) then
if( print ) write(6,*)" at end, draw to x1,y1",x2,y2
call plot(xpos,ypos,3)
call plot(x2,y2,2)
else
if( print ) write(6,*)" at end, jump to x1,y1",x2,y2
xpos = x2
ypos = y2
endif
if( print ) then
if( abv ) write(6,*)" exit above"
if( blw ) write(6,*)" exit below"
if( .not. (abv .or. blw) ) then
write(6,*)" exit middle"
endif
endif
return
end
SHAR_EOF
cat << \SHAR_EOF > newtru.f
c
c
c newtru - 3 dimentional plotting routine
c
c The CRC Graphics Package
c
c An old routine rewritten by Mani Azimi
c 12/9/83
c
c This routine has been available for a long period in EE Dept.
c Malcolm Slaney provided an interface for it (plot3d.c) and
c added some options to it. The major modifications were getting
c the lines below the horizon to be plotted, drawing axes for all
c the three directions and correcting the bugs in the old
c routine. For finding about the many options available see the
c manual for plot3d.
c
c
subroutine newtru(z,x,y,inx,iny,nxdim,aphi1,aphi2
$ ,xlen,ylen,azlen,ixbyte,iybyte,izbyte
$ ,ixdig,iydig,izdig,xtic,ytic,ztic,xlbl,ylbl,zlbl,tl,bl
$ ,scfac,ixdir,iydir,azmax,azmin,izmin,abase,ixaxis,iyaxis,izaxis
$ ,resol,iprnt)
parameter(maxstp=8000)
logical xaxs,yaxs,zaxs,abv,blw,xdir,ydir,print
dimension absx(512),absy(512),xold(512),yold(512)
dimension above(maxstp),below(maxstp)
dimension z(nxdim,1),x(1),y(1)
real xymin(2),xymax(2),tic(3)
real xcorn(2,2),ycorn(2,2),xcindx(2,2),ycindx(2,2)
integer ibyte(3),idig(3),ixlbl(3)
character*80 lbl(3),xlbl,ylbl,zlbl,tl,bl
common /a/ phi1,phi2,cphi1,sphi1,cphi2,s1s2,c1s2,zfct,absxs
common /b/ above,below
common /c/ xymin,xymax,tic,ibyte,idig,ixlbl,base,zbmax,zbmin,pi
common /d/ zlen,nx,ny,numstp,dlmnsm,dm,dl,small
common /e/ istrt1,iend1,istep1,istrt2,iend2,istep2
common /f/ xold,yold,absx,absy
common /pos/ xpos,ypos
common /flag/ xaxs,yaxs,zaxs,abv,blw,xdir,ydir,print
c
print = .false.
if(iprnt .eq. 1) print = .true.
nx = inx
ny = iny
zlen = 6.0 * azlen / 8.0
base = abase
zbmax = azmax
zbmin = azmin
phi1 = aphi1
phi2 = aphi2
xaxs = .false.
yaxs = .false.
zaxs = .false.
if( ixaxis .eq. 1 ) xaxs = .true.
if( iyaxis .eq. 1 ) yaxs = .true.
if( izaxis .eq. 1 ) zaxs = .true.
xdir = .false.
ydir = .false.
if( ixdir .eq. 1 ) xdir = .true.
if( iydir .eq. 1 ) ydir = .true.
ibyte(1) = ixbyte
ibyte(2) = iybyte
ibyte(3) = izbyte
tic(1) = xtic
tic(2) = ytic
tic(3) = ztic
idig(1) = ixdig
idig(2) = iydig
idig(3) = izdig
lbl(1)(1:80) = xlbl(1:80)
lbl(2)(1:80) = ylbl(1:80)
lbl(3)(1:80) = zlbl(1:80)
c number of steps for line hiding
numstp = ifix(resol*float(maxstp)/4.0)
do 10 i=1 , 3
ixlbl(i) = index(lbl(i),'\0') - 1
10 continue
ixtl = index(tl,'\0') - 1
ixbl = index(bl,'\0') - 1
small = 1.0e-7
alarge = 1.0e25
pi = 3.1415926535897932384626433
dm = 150.0 * resol
dl = 1.0 / dm
dlmnsm = dl - small
arg1 = phi1 * pi / 180.0
arg2 = phi2 * pi / 180.0
sphi1 = sin(arg1)
cphi1 = cos(arg1)
sphi2 = sin(arg2)
cphi2 = cos(arg2)
s1s2 = sphi1 * sphi2
c1s2 = cphi1 * sphi2
c
c determine min and max values
c
xymin(1) = x(nx+1)
xymax(1) = x(nx+2)
xymin(2) = y(ny+1)
xymax(2) = y(ny+2)
do 5 i=1 , 2
if ( xymin(i) .ge. xymax(i) ) then
a = xymin(i)
xymin(i) = xymax(i)
xymax(i) = a
endif
5 continue
c
c
c set the distance between the vertical lines in the front panels
c
idxvrt = nx / 8
if ( nx .lt. 16 ) idxvrt = 1
idyvrt = ny / 8
if ( ny .lt. 16 ) idyvrt = 1
c
c select the the coordinates of the front edge depending on
c the direction of line drawing either (istrt1,istrt2) or
c (istrt2,istrt1).
c
istrt1 = 1
istep1 = 1
istrt2 = 1
istep2 = 1
if( ydir ) then
if( phi1 .ge. 0.0 ) then
istrt1 = nx
iend1 = 1
istep1 = -1
iend2 = ny
else
iend1 = nx
iend2 = ny
endif
else
if( phi1 .ge. 0.0 ) then
iend1 = ny
istrt2 = nx
iend2 = 1
istep2 = -1
else
iend1 = ny
iend2 = nx
endif
endif
c
c set base to the min (max) of the values on the edges
c depending on whether phi2 is positive (negative)
c
if( base .gt. alarge ) then
if( phi2 .ge. 0.0 ) then
do 60 i=istrt1 , iend1 , istep1
if( ydir) then
dumz = z(i,istrt2)
else
dumz = z(istrt2,i)
endif
if( dumz .lt. base ) base = dumz
60 continue
do 70 i=istrt2 , iend2 , istep2
if( ydir ) then
dumz = z(istrt1,i)
else
dumz = z(i,istrt1)
endif
if( dumz .lt. base ) base = dumz
70 continue
else
base = - base
do 61 i=istrt1 , iend1 , istep1
if( ydir ) then
dumz = z(i,istrt2)
else
dumz = z(istrt2,i)
endif
if( dumz .gt. base ) base = dumz
61 continue
do 71 i=istrt2 , iend2 , istep2
if( ydir ) then
dumz = z(i,istrt2)
else
dumz = z(istrt2,i)
endif
if( dumz .gt. base ) base = dumz
71 continue
endif
endif
c
c if no max set, set it to the max of z()
c if no min set, set it to the min of (min z()) and base
c
if( izmin .ne. 1) zbmin = amin1(zbmin,base)
c
shrink = 0.65
xlen = xlen * shrink
ylen = ylen * shrink
zlen = zlen * shrink
c
c normalize the x and y arrays for plotting
c
xfct = xlen / ( xymax(1) - xymin(1) )
yfct = ylen / ( xymax(2) - xymin(2) )
do 20 i=1 , nx
x(i) = ( x(i) - xymin(1) ) * xfct
20 continue
do 30 i=1 , ny
y(i) = ( y(i) - xymin(2) ) * yfct
30 continue
zfct = zlen / ( zbmax - zbmin )
c
c setup proper origin on plotting page
c
dumfct = cphi2 * zfct
xadd = - s1s2 * ( x(nx) - x(1) ) / float(nx-1)
yadd = c1s2 * ( y(ny) - y(1) ) / float(ny-1)
dzmax = -1.0e30
dzmin = 1.0e30
dumx = - x(1) * s1s2
do 980 ix=1 , nx
dumy = y(1) * c1s2
do 981 iy=1 , ny
dum = dumfct * z(ix,iy) + dumx + dumy
if( dum .gt. dzmax ) dzmax = dum
if( dum .lt. dzmin ) dzmin = dum
dumy = dumy + yadd
981 continue
dumx = dumx + xadd
980 continue
xsize = cphi1 * xlen + abs(sphi1) * ylen
call factor(scfac)
call plot( 5.0-xsize/2.0 + 0.35 , 0.0 , -3 )
height = 0.2
call alpha
if( ixtl .gt. 0 ) then
call symbol(xlen*0.66666-(3.0/7.0*float(ixtl)*height),
$ 9.5-height*0.5,height,tl(1:ixtl),0.0)
endif
if( ixbl .gt. 0 ) then
call symbol(xlen*0.66666-(3.0/7.0*float(ixbl)*height),
$ 0.85+height*0.5,height,bl(1:ixbl),0.0)
endif
call plot( 0.0 , 5.0-(dzmax+dzmin)/2.0+0.5 , -3 )
c call plot( 5.0-xsize/2.0 + 0.4 , 5.0-(dzmax+dzmin)/2.0+0.5 , -3 )
c
c absxs is the x coordinate of the origin relative to the
c plot coordinates. In this way all the x components are positive.
c
if( phi1 .ge. 0.0 ) then
absxs = 0.0
else
c absxs = sphi1 * y(ny)
absxs = sphi1 * ylen
endif
c
do 120 i=1 , numstp
below(i) = 20.0
above(i) = -20.0
120 continue
c
c draw axis and set the boundary of hiding limits.
c
if( xaxs .or. yaxs .or. zaxs ) call setaxs(xlen,ylen,lbl)
c
c draw the vertical lines on the front panel
c while the lines are plotted (if x-y axes are to be drawn)
c
if( xaxs .or. yaxs ) then
xcindx(1,1) = x(1)
ycindx(1,1) = y(1)
xcindx(1,2) = x(nx)
ycindx(1,2) = y(1)
if( phi1 .ge. 0.0 ) then
xcindx(2,1) = x(nx)
xcindx(2,2) = x(nx)
else
xcindx(2,1) = x(1)
xcindx(2,2) = x(1)
endif
ycindx(2,1) = y(1)
ycindx(2,2) = y(ny)
if( xaxs .or. yaxs .or. zaxs ) then
do 90 i=1 , 2
iflag = 3
do 80 j=1 , 2
xcorn(i,j) = xcal(xcindx(i,j) , ycindx(i,j))
ycorn(i,j) = ycal(xcindx(i,j) , ycindx(i,j) , base)
if( xaxs .or. yaxs ) then
if( iflag .eq. 3 ) then
xpos = xcorn(i,j)
ypos = ycorn(i,j)
else
call plot(xpos,ypos,3)
call plot(xcorn(i,j),ycorn(i,j),iflag)
endif
endif
iflag = 2
80 continue
90 continue
endif
call panel(x,y,z,nxdim)
endif
c
c setup the first row depending on the direction options,
c either in x direction or y direction. absx and absy are
c the absolute coordinate sizes for plotting.
c
c
c main loop
c
do 500 index1=istrt1 , iend1 , istep1
c
c calculate the line coordinates for next row
c if last row no need for next row calculations
c
do 215 i=istrt2 , iend2 , istep2
if( ydir ) then
absx(i) = float( ifix( xcal(x(index1),y(i)) *dm))*dl
absy(i) = ycal( x(index1),y(i),z(index1,i) )
else
absx(i) = float( ifix( xcal(x(i),y(index1)) *dm))*dl
absy(i) = ycal( x(i),y(index1),z(i,index1) )
endif
215 continue
if( index1 .ne. istrt1 ) then
if( xdir .and. ydir ) then
do 230 index2=istrt2 , iend2 , istep2
call perpen(index2)
230 continue
else
call perpen(istrt2)
endif
endif
x2 = absx(istrt2)
y2 = absy(istrt2)
m = x2 * dm + 1.01
c
c set the line hiding flags for the first point of line.
c
abv = .false.
blw = .false.
if( y2 .gt. above(m) ) abv = .true.
if( y2 .lt. below(m) ) blw = .true.
c
c loop for drawing one complete line
c
do 600 index2=istrt2 , iend2-istep2 , istep2
x1 = x2
y1 = y2
x2 = absx(index2+istep2)
y2 = absy(index2+istep2)
if( print ) then
if( abv ) write(6,*)" above"
if( blw ) write(6,*)" below"
write(6,*)"-long: x1,y1,x2,y2",x1,y1,x2,y2
endif
call draw(x1,y1,x2,y2)
600 continue
if( index1 .ne. istrt1 .and. .not. (xdir .and. ydir) ) then
call perpen(iend2)
endif
c
c store the line just drawn
c
do 210 i=istrt2 , iend2 , istep2
xold(i) = absx(i)
yold(i) = absy(i)
210 continue
c
c end of main loop
c
500 continue
return
end
SHAR_EOF
cat << \SHAR_EOF > setaxs.f
c
c draw base, axes and label coordinates
c
subroutine setaxs(xlen,ylen,lbl)
parameter(maxstp=8000)
real xcorn(2,2),ycorn(2,2),xymin(2),xymax(2),tic(3)
integer ibyte(3),idig(3),ixlbl(3)
real xcindx(2,2),ycindx(2,2)
dimension above(maxstp),below(maxstp)
logical xaxs,yaxs,zaxs,abv,blw,xdir,ydir,print
character*80 lbl(3)
common /a/ phi1,phi2,cphi1,sphi1,cphi2,s1s2,c1s2,zfct,absxs
common /b/ above,below
common /c/ xymin,xymax,tic,ibyte,idig,ixlbl,base,zbmax,zbmin,pi
common /d/ zlen,nx,ny,numstp,dlmnsm,dm,dl,small
common /pos/ xpos,ypos
common /flag/ xaxs,yaxs,zaxs,abv,blw,xdir,ydir,print
c
c CHANGE *********------+++++++********-----
c xcindx(i,*) and ycindx(i,*) are indices of the x and y coordinates of
c the i th axis (i=1 is the x axis and i=2 is the y axis)
c xcindx(*,1(2)) is the x comp of the first (last) point of the axis.
c ycindx(*,1(2)) is the y comp of the first (last) point of the axis.
c The direction of the axes is preserved.
c The two axes considered are the ones in front of the object and
c are also used for axes drawing.
c
c xcindx(1,1) = xymin(1)
c ycindx(1,1) = xymin(2)
c xcindx(1,2) = xymax(1)
c ycindx(1,2) = xymin(2)
c if( phi1 .ge. 0.0 ) then
c xcindx(2,1) = xymax(1)
c xcindx(2,2) = xymax(1)
c else
c xcindx(2,1) = xymin(1)
c xcindx(2,2) = xymin(1)
c endif
c ycindx(2,1) = xymin(2)
c ycindx(2,2) = xymax(2)
xcindx(1,1) = 0.0
ycindx(1,1) = 0.0
xcindx(1,2) = xlen
ycindx(1,2) = 0.0
if( phi1 .ge. 0.0 ) then
xcindx(2,1) = xlen
xcindx(2,2) = xlen
else
xcindx(2,1) = 0.0
xcindx(2,2) = 0.0
endif
ycindx(2,1) = 0.0
ycindx(2,2) = ylen
if( xaxs .or. yaxs .or. zaxs ) then
do 90 i=1 , 2
iflag = 3
do 80 j=1 , 2
xcorn(i,j) = xcal( xcindx(i,j) , ycindx(i,j) )
ycorn(i,j) = ycal( xcindx(i,j) , ycindx(i,j) , base )
80 continue
90 continue
endif
if( zaxs ) then
zaxisl = cphi2 * zlen
call axisv(tic(3),idig(3))
c
c decide which edge should the z-axis be on.
c
if( phi1 .ge. 0.0 ) then
ixzedg = 1
iyzedg = 1
else
ixzedg = 2
iyzedg = 2
endif
x1 = xcorn(ixzedg,iyzedg)
y1 = ycorn(ixzedg,iyzedg)
c draw the z axis from the min of z to max of z
if( base .gt. zbmin ) then
y1 = y1 - cphi2 * zlen * ( base - zbmin ) / ( zbmax - zbmin )
endif
call plot(x1,y1,3)
iflag = 1
if( ibyte(3) .eq. 5 ) iflag = 0
call axis(x1,y1,lbl(3)(1:ixlbl(3)),1,zaxisl,amin1(base,zbmin),zbmax
$ ,iflag)
endif
if (xaxs .or. yaxs) then
istrt = 1
iend = 2
if( .not. xaxs ) istrt = 2
if( .not. yaxs ) iend = 1
c
do 110 i=istrt , iend
call plot(xcorn(i,1),ycorn(i,1),3)
ang = atan2( ycorn(i,2)-ycorn(i,1) , xcorn(i,2)-xcorn(i,1) )
dumsz =sqrt( (xcorn(i,2)-xcorn(i,1))**2
$ + (ycorn(i,2)-ycorn(i,1)) **2 )
x1 = xcorn(i,1)
y1 = ycorn(i,1)
dummin = xymin(i)
dummax = xymax(i)
sznew = dumsz
c if numbers are integer
if( ibyte(i) .eq. 3 ) then
dis = dumsz / ( xymax(i) - xymin(i) )
disnum = tic(i) / dis
c do not have steps of less than 1
if( disnum .le. 1.0 ) then
tic(i) = dis - small / 10.0
else
c modify tic size to suit integer values
atic = float( ifix( disnum + small / 10.0 ) * dis )
if( abs(tic(i)-atic) .gt. small ) tic(i) = atic - small
endif
dum = dumsz * float(ifix(dumsz/tic(i))) / (dumsz/tic(i))
if( abs(dumsz-dum) .gt. small ) sznew = dum + small / 10.0
endif
c do not put the number at the point where
c the z axis is drawn
dum = 1.001 * ( dumsz - sznew ) / tic(i)
if( i .eq. ixzedg .and. dum .lt. 0.4 ) sznew = sznew - tic(i)
diff = dumsz - sznew
if( abs(diff) .gt. small ) then
if( i .eq. ixzedg .and. iyzedg .eq. 1 ) then
dumx = x1
dumy = y1
x1 = x1 + diff * cos(ang)
y1 = y1 + diff * sin(ang)
dummin = dummin + (xymax(i)-xymin(i)) * diff / dumsz
else
dumx = x1 + sznew * cos(ang)
dumy = y1 + sznew * sin(ang)
dummax = dummax - (xymax(i)-xymin(i)) * diff / dumsz
endif
call plot(dumx,dumy,3)
dumx = dumx + diff * cos(ang)
dumy = dumy + diff * sin(ang)
call plot(dumx,dumy,2)
dumsz = sznew
endif
idir = 1
if( i .eq. 2 .and. phi1 .lt. 0.0 ) idir = - idir
if( phi2 .lt. 0.0 ) idir = - idir
iflag = 0
if( ibyte(i) .eq. 3 ) iflag = 1
call axisv(tic(i),idig(i))
call draxis(x1,y1,lbl(i)(1:ixlbl(i)),ang*180.0/pi,idir,dumsz
$ ,dummin,dummax,iflag)
110 continue
do 150 ii=1 , 2
do 130 jj=1 , 2
xcorn(ii,jj) = float( ifix ( xcal( xcindx(ii,jj)
$ , ycindx(ii,jj) ) * dm ) ) * dl
ycorn(ii,jj) =ycal(xcindx(ii,jj),ycindx(ii,jj),base )
130 continue
c the direction of the y axis is different for phi1 < 0
if( ii .eq. 2 .and. phi1 .lt. 0.0 ) then
y1 = ycorn(ii,2)
y2 = ycorn(ii,1)
x1 = xcorn(ii,2)
x2 = xcorn(ii,1)
else
y1 = ycorn(ii,1)
y2 = ycorn(ii,2)
x1 = xcorn(ii,1)
x2 = xcorn(ii,2)
endif
c set the hiding lines. Since axes is drawn, everything
c below(above) the axes should be hided when phi2 is
c positive(negative).
if( x1 .ne. x2 ) then
y21x21 = ( y2 - y1 ) / ( x2 - x1 )
m = x1 * dm + 1.01
xdum = x1
140 continue
dum = y1 + (xdum - x1) * y21x21
if( phi2 .ge. 0.0 ) then
above(m) = dum
below(m) = -20.0
else
above(m) = 20.0
below(m) = dum
endif
xdum = xdum + dl
m = m + 1
if( abs(xdum-x2) .gt. dl/2.0 ) go to 140
else
c if the axis is vertical, it is simple!
above(m) = amax1(y1,y2)
below(m) = amin1(y1,y2)
endif
150 continue
endif
return
end
SHAR_EOF
cat << \SHAR_EOF > subr.f
c
c panel - draw the vertical lines on the front panels.
c
subroutine panel(x,y,z,nxdim)
dimension z(nxdim,1),x(1),y(1)
logical xaxs,yaxs,zaxs,abv,blw,xdir,ydir,print
real xymin(2),xymax(2),tic(3)
integer ibyte(3),idig(3),ixlbl(3)
common /c/ xymin,xymax,tic,ibyte,idig,ixlbl,base,zbmax,zbmin,pi
common /d/ zlen,nx,ny,numstp,dlmnsm,dm,dl,small
common /e/ istrt1,iend1,istep1,istrt2,iend2,istep2
common /flag/ xaxs,yaxs,zaxs,abv,blw,xdir,ydir,print
c
c set the distance between the vertical lines in the front panels
c
idxvrt = nx / 8
if ( nx .lt. 16 ) idxvrt = 1
idyvrt = ny / 8
if ( ny .lt. 16 ) idyvrt = 1
c
c select the the coordinates of the front edge depending on
c the direction of line drawing either (istrt1,istrt2) or
c (istrt2,istrt1).
c
if( ydir ) then
idel1 = idxvrt
idel2 = idyvrt
else
idel1 = idyvrt
idel2 = idxvrt
endif
c
c setup the first row depending on the direction options,
c either in x direction or y direction. absx and absy are
c the absolute coordinate sizes for plotting.
c
idel = idel2 * istep2
ilimit = istrt2 + ( ( iend2 - istrt2 ) / idel ) * idel
do 215 i=istrt2 , iend2 , idel2*istep2
if( ydir ) then
xdum = float( ifix( xcal(x(istrt1),y(i)) *dm))*dl
if( ydir ) then
ydum = ycal( x(istrt1),y(i),z(istrt1,i) )
else
ydum = ycal( x(istrt1),y(i),z(i,istrt1) )
endif
ybase = ycal( x(istrt1) , y(i) , base )
else
xdum = float( ifix( xcal(x(i),y(istrt1)) *dm))*dl
if( ydir ) then
ydum = ycal( x(i),y(istrt1),z(istrt1,i) )
else
ydum = ycal( x(i),y(istrt1),z(i,istrt1) )
endif
ybase = ycal( x(i) , y(istrt1) , base )
endif
if( print ) write(6,*)"x1,y1,iflag",xdum,ydum,"3"
call plot(xdum,ydum,3)
if( print ) write(6,*)"alng: x1,y1,iflag",xdum,ybase,"2"
call plot(xdum,ybase,2)
if( i .eq. ilimit .and. i .ne. iend2 ) i = iend2 - idel2*istep2
215 continue
idel = idel1 * istep1
ilimit = istrt1 + ( ( iend1 - istrt1 ) / idel ) * idel
do 216 i=istrt1 , iend1 , idel1*istep1
if( .not. ydir ) then
xdum = float( ifix( xcal(x(istrt2),y(i)) *dm))*dl
if( ydir ) then
ydum = ycal( x(istrt2),y(i),z(i,istrt2) )
else
ydum = ycal( x(istrt2),y(i),z(istrt2,i) )
endif
ybase = ycal( x(istrt2) , y(i) , base )
else
xdum = float( ifix( xcal(x(i),y(istrt2)) *dm))*dl
if( ydir ) then
ydum = ycal( x(i),y(istrt2),z(i,istrt2) )
else
ydum = ycal( x(i),y(istrt2),z(istrt2,i) )
endif
ybase = ycal( x(i) , y(istrt2) , base )
endif
if( print ) write(6,*)"x1,y1,iflag",xdum,ydum,"3"
call plot(xdum,ydum,3)
if( print ) write(6,*)"alng: x1,y1,iflag",xdum,ybase,"2"
call plot(xdum,ybase,2)
if( i .eq. ilimit .and. i .ne. iend1 ) i = iend1 - idel1*istep1
216 continue
return
end
c
c xcal - calculate the absolute x coordinate of a point
c
real function xcal(x,y)
common /a/ phi1,phi2,cphi1,sphi1,cphi2,s1s2,c1s2,zfct,absxs
xcal = cphi1 * x + sphi1 * y -absxs
end
c
c ycal - calculate the absolute y coordinate of a point
c
real function ycal(x,y,z)
common /a/ phi1,phi2,cphi1,sphi1,cphi2,s1s2,c1s2,zfct,absxs
ycal = - s1s2 * x + c1s2 * y + cphi2 * z * zfct
end
c
c perpen - draws the small lines between two adjacent stripes
c
subroutine perpen(iprpn)
parameter(maxstp=8000)
dimension above(maxstp),below(maxstp)
dimension absx(512),absy(512),xold(512),yold(512)
logical xaxs,yaxs,zaxs,abv,blw,xdir,ydir,print
common /b/ above,below
common /d/ zlen,nx,ny,numstp,dlmnsm,dm,dl,small
common /e/ istrt1,iend1,istep1,istrt2,iend2,istep2
common /f/ xold,yold,absx,absy
common /flag/ xaxs,yaxs,zaxs,abv,blw,xdir,ydir,print
x1 = xold(iprpn)
y1 = yold(iprpn)
x2 = absx(iprpn)
y2 = absy(iprpn)
c
c set the line hiding flags.
c
m = x1 * dm + 1.01
abv = .false.
blw = .false.
if( y1 .gt. above(m) ) abv = .true.
if( y1 .lt. below(m) ) blw = .true.
if( print ) then
if( abv ) write(6,*)" above"
if( blw ) write(6,*)" below"
write(6,*)"-fredg: x1,y1,x2,y2",x1,y1,x2,y2
endif
call draw(x1,y1,x2,y2)
return
end
SHAR_EOF
cat << \SHAR_EOF > test.f
dimension x(4),y(4)
x(1)=2.
x(2)=6.
x(3)=0.
x(4)=10.
y(1)=1.
y(2)=9.
y(3)=0.
y(4)=10.
call plots(3,1)
call factor(.3)
call symbol(2.,7.,.3,"$G Functions",0.)
call plot(2.,2.,-3)
call laxis(0.,0.,"$|$a*f(x)$ dx",0,6.,0,1,0)
call laxis(0.,3.,"$|$a*f(x)$ dx",2,6.,0,1,0)
call laxis(0.,0.,"This is a test",1,3.,0,1,3)
call laxis(6.,0.,"This is a test",3,3.,0,1,3)
call line(x,y,2,0,6.,3.)
call plot(1.,1.,-3)
call axis(0.,0.,"$|$a*f(x)$ dx",0,6.,0.,10.,0)
call axis(0.,3.,"$|$a*f(x)$ dx",2,6.,0.,10.,0)
call axis(0.,0.,"This is a test",1,3.,0.,10.,3)
call axis(6.,0.,"This is a test",3,3.,0.,10.,3)
call newpen(3)
call dline(x,y,2,.2,.2,1,6.,3.)
call plot(0.,0.,999)
stop
end
SHAR_EOF
cat << \SHAR_EOF > axis.c
#include "crc.h"
/*
axis - interface to 'draxis'
The CRC graphics package
*/
axis(x,y,label,xy,size,xmin,xmax,idata)
float x,y,size,xmin,xmax;
int xy,idata;
char *label;
{
float angle;
int xydum;
angle = 0.0;
xydum = 1;
switch(xy){
case 0:
break;
case 1:
angle = 90.0;
xydum = -1;
break;
case 2:
xydum = -1;
break;
case 3:
angle = 90.0;
break;
}
draxis(x,y,label,angle,xydum,size,xmin,xmax,idata);
}
SHAR_EOF
cat << \SHAR_EOF > axis_.c
/*
axis_ - F77 interface to 'axis'
The CRC graphics package
Carl Crawford
Purdue University
West Lafayette, IN 47901
October 1981
*/
#include "crc.h"
axis_(x,y,label,xy,size,min,max,flag,labell)
float *x;
float *y;
char *label;
long int *xy;
float *size;
float *min;
float *max;
long int *flag;
long int labell;
{
axis(*x,*y,label,(int)*xy,*size,*min,*max,(int)*flag);
}
SHAR_EOF
cat << \SHAR_EOF > axisv_.c
#include "crc.h"
/*
axisv_ - f77 callable version of 'axisv'
The CRC graphics package
carl crawford
purdue university
west lafayette, indiana 47907
april 1980
*/
axisv_(ticdis,digits)
float *ticdis;
long int *digits;
{
axisv(*ticdis,(int) *digits);
}
SHAR_EOF
cat << \SHAR_EOF > crclabel.c
/*
crclabel - program to label vectors
The CRC graphics package
Malcolm Slaney
Purdue University
W. Lafayette, Indiana
compile with "cc -O crclabel.c -i -lG -lm"
*/
#include <stdio.h>
#include <math.h>
#define DevNum(Major,Minor) ((Major) + (Minor)*8)
#define BIT 0 /* major device table */
#define GOV 1
#define IMAGE 2
#define GGOV 3
#define GIMAGE 4
#define TEK 6
#define HP 7
#define STDOUT 0 /* Special Device Numbers */
#define VERSATEC 8
#define PRINTRONIX 16
#define RETRO 14
float scfac = 1.0; /* scale factor in plot */
float xxs,yys; /* starting locations for the graph */
int spd = 36; /* speed of hp plotter */
char *tl; /* top label */
char *stfl;
char *host; /* host overide for all pipes */
float height = 0.2; /* character heights */
int pen = 1; /* hp pen color */
char *siten = "pl"; /* default site for gplp */
int blank; /* blank flag */
int devn; /* minor device number */
int dev = PRINTRONIX;/* major device number */
int size[] = {
sizeof(char), /* signed char */
sizeof(char), /* unsigned char */
sizeof(short), /* short integer */
sizeof(int), /* integer */
sizeof(long), /* long integer */
sizeof(float), /* float */
sizeof(double), /* double */
};
#define INT 0
#define FLOAT 1
#define LONG 2
#define CHAR 3
struct hash {
char *label;
int type;
char **pointer;
} table[] = {
/* 1 */ {"xp",FLOAT,(char **)&xxs},
/* 2 */ {"yp",FLOAT,(char **)&yys},
/* 3 */ {"pen",INT,(char **)&pen},
/* 4 */ {"scfac",FLOAT,(char **)&scfac},
/* 5 */ {"site",CHAR,&siten},
/* 6 */ {"speed",INT,(char **)&spd},
/* 7 */ {"tl",CHAR,&tl},
/* 8 */ {"op",CHAR,&host},
/* 9 */ {"g",CHAR,&stfl},
{0,0,0}
};
main(argc,argv)
int argc;
char **argv;
{
FILE *fd;
float xd[514],yd[514];
int cx,cy;
long atol();
float max(),min();
register int i,j;
float dx,xtmp,ytmp,sftmp;
char buf[10];
if((fd = fopen("/etc/cpu","r")) != NULL){
fgets(buf,10,fd);
buf[strlen(buf) -1] = 0;
if(strcmp(buf,"arpa") == 0)
dev = DevNum(GOV,0);
fclose(fd);
}
file();
args();
parse(argc,argv);
if(dev == DevNum(GOV,0) || dev == DevNum(IMAGE,0) ||
dev == DevNum(GGOV,0) || dev == DevNum(GIMAGE,0)){
if(devn){
devn -= '0';
if(dev == DevNum(IMAGE,0) || dev == DevNum(GIMAGE,0))
devn += 1;
}
dev |= devn << 3;
}
strcpy(buf,"-");
strcat(buf,siten);
site(buf);
fname(stfl);
if(host)
dev |= 0100;
plots(dev,blank,host);
newpen(pen);
speed(spd);
plot(xxs,yys,-3);
factor(scfac);
if(tl){ /* top label */
symbol(0.0,0.0,height,tl,0.0);
}
plot(0.0,0.0,999);
}
err(s1,s2)
char *s1,*s2;
{
fprintf(stderr,"%s%s\n",s1,s2);
exit(1);
}
comm(s)
char *s;
{
register int j,r;
char *p;
struct hash *hp;
for(hp=table;hp->label;hp++){
for(j=0;(r=hp->label[j]) == s[j] && r;j++);
if(r == 0 && s[j] == '=')
if(!s[j+1]){
s[j] = 0;
err("empty string: ",s);
}else{
switch(hp->type){
case CHAR:
*hp->pointer = s + j + 1;
break;
case INT:
*((int *)hp->pointer) = atoi(s+j+1);
break;
case FLOAT:
*((float *)hp->pointer) = atof(s+j+1);
break;
case LONG:
*((long *)hp->pointer) = atol(s+j+1);
break;
}
return(hp - table + 1);
}
}
p = s;
while(*p){
if(*p == '='){
*p = 0;
break;
}
p++;
}
err("bad option: ",s);
}
parse(argc,argv)
int argc;
char **argv;
{
char c;
int i;
while(argv++ , --argc){
if(argv[0][0] == '-')while(c = *++*argv)switch(c){
case '0': /* device # */
case '1':
case '2':
case '3': /* grinell */
case '4':
devn = c;
break;
case 'G':
if (dev == IMAGE || dev == GIMAGE)
dev = GIMAGE;
else
dev = GGOV;
break;
case 'g': /* use graphics overlay */
if (dev == GGOV || dev == GIMAGE)
dev = GGOV;
else
dev = GOV;
break;
case 'i': /* use Image Plane */
if (dev == GGOV || dev == GIMAGE)
dev = GIMAGE;
else
dev = IMAGE;
break;
case 'c': /* use comtal */
if (dev == GOV || dev == GGOV)
dev = GOV;
else
dev = IMAGE;
break;
case 'b': /* don't blank display */
blank = 1;
break;
case 'B': /* blank display */
blank = 0;
break;
case 't': /* use tektronix */
dev = TEK;
break;
case 'T': /* use Retro-graphics */
dev = RETRO;
break;
case 'h': /* use hp plotter */
dev = HP;
break;
case 'o': /* g=stdout */
dev = STDOUT;
stfl = "-";
break;
case 'v': /* direct versatec mode */
dev = VERSATEC;
break;
case 'p': /* direct line printer mode */
dev = PRINTRONIX;
break;
default:
fprintf(stderr,"bad flag: -%c\n",c);
exit(1);
}
else
switch(i = comm(*argv)){
case 9: /* output file name */
dev = STDOUT;
break;
case 3: /* pen */
case 6: /* speed */
dev = HP;
break;
case 5: /* site */
dev = PRINTRONIX;
break;
}
}
}
args()
{
char *argv[20];
int argc;
char *s,*getenv(),*p;
if((s=getenv("CRCLABELARGS")) == NULL)return;
argv[0] = s;
argc = 1;
while(*s){
while(*s == ' ')*s++ = 0;
if(*s){
if(*s != '"')argv[argc++] = s;
else{
argv[argc++] = ++s;
while(*s){
if(*s != '"')s++;
else{
*s++ = 0;
break;
}
}
}
}
while( (*s != ' ') && *s){
if(*s != '"')s++;
else{
p = s;
while(*p){
*p = *(p+1);
p++;
}
while(*s){
if(*s != '"')s++;
else{
*s++ = 0;
break;
}
}
}
}
}
parse(argc,argv);
}
file()
{
int argc;
char *argv[20];
static char buf[256];
char *b;
char *getenv(),*s;
FILE *dfd;
if((s = getenv("HOME")) == NULL)return;
strcpy(buf,s);
strcat(buf,"/.crclabelargs");
if((dfd = fopen(buf,"r")) == NULL)return;
argc = 1;
b = buf;
while(fgets(b,256-((int)(b - buf)),dfd) != NULL){
b[strlen(b)-1] = 0;
argv[argc++] = b;
b += strlen(b)+1;
if(argc == 20)break;
}
parse(argc,argv);
fclose(dfd);
}
SHAR_EOF
cat << \SHAR_EOF > draxis.c
#include "crc.h"
/*
draxis - draw numerically annotated axes for slant axes
The CRC graphics package
carl crawford
purdue univeristy
w. lafayette, in 47907
may 1980
*/
#define PI 3.141592
#define SMALL 0.00000000001
draxis(x,y,label,angle,xy,size,xmin,xmax,idata)
/* xy = 1 clockwise
= -1 counter clockwise */
float x,y,angle,size,xmin,xmax;
int xy,idata;
char *label;
{
float xt,yt,half,dumang,sang,cang;
float height,del,delx,dely,dticx,dticy;
int numt,i,j;
int n1,n2,fl,atic;
char *b,*c;
angle = angle*PI/180.0;
sang = sin(angle);
cang = cos(angle);
atic = 1;
plot(x,y,3);
height = HEIGHT;
plot(x+size*cang,y+size*sang,2);
if(TICDIS == 0.0)_err("axis error: ","ticdis zero");
numt = floor(size/TICDIS+.5);
if(!numt)
numt = -1;
plot(x,y,3);
xt = x;
yt = y;
dticx = 0.075*atic*cos(angle-xy*PI/2.0);
dticy = 0.075*atic*sin(angle-xy*PI/2.0);
del = ( xmax - xmin ) / numt;
delx = size*cang/numt;
dely = size*sang/numt;
numt++;
for(i = 0;i<numt;i++){
plot(xt+dticx,yt+dticy,2);
xt += delx;
yt += dely;
plot(xt,yt,3);
}
if(idata >= 0)n1 = _axisl(xmin,xmax,idata,1);
c = label;
b = _abuf;
#ifdef sel
strncpy(b, c, sizeof(_abuf));
while(*b++ != NULL);
#else
while(*b++ = *c++);
#endif
if(n1 && idata >= 0){
--b;
*b++ = ' ';
*b++ = '(';
*b++ = 'X';
*b++ = '1';
*b++ = '0';
*b++ = '$';
*b++ = '{';
if(n1 < 0){
*b++ = '-';
n1 = -n1;
}
if(n1 > 9){
*b++ = '0' + (n1/10);
n2 = n1/10;
n1 -= n2*10;
}
*b++ = '0' + n1;
*b++ = '$';
*b++ = '}';
*b++ = ')';
*b = 0;
}
half = 6.0/7.0 * _ssize(_abuf) / 2.0 * height;
dticx = 1.1*atic*cos(angle-xy*PI/2.0) + ( size/2.0-half ) * cang;
dticy = 1.1*atic*sin(angle-xy*PI/2.0) + ( size/2.0-half ) * sang;
if( fabs(angle-PI/2) < SMALL )
symbol(x+(xy*atic * 1.2),y+(size/2.0) - half,height,_abuf,90.0);
else if( fabs(angle) < SMALL )
symbol(x+(size/2.0)-half,y-(xy*atic * .75),height,_abuf,0.0);
else if( fabs(angle) <= PI/2.0 ){
symbol(x+dticx,y+dticy,height,_abuf,angle*180.0/PI);
}
else{
dumang = angle - PI;
if( dumang < -PI)
dumang += 2.0*PI;
dticx += 2.0 * half * cang;
dticy += 2.0 * half * sang;
symbol(x+dticx,y+dticy,height,_abuf,dumang*180.0/PI);
}
if( idata < 0)return;
height *= 2.8/4.0;
plot(x,y,3);
xt = x;
yt = y;
for(i = 0; i <numt; i++){
half = height * (6.0/7.0) * _axisl(xmin,del,idata,0);
if( fabs(angle-PI/2) < SMALL )
symbol(xt+xy*atic*(((xy<0)*half)+0.145),yt -(height/2.0),height,_abuf,0.0);
else if( fabs(angle) < SMALL )
symbol(xt-(half/2.0),yt-(xy*atic*(0.145 + height)),height,_abuf,0.0);
else if( xy*angle > SMALL )
symbol(xt+0.6*height+height*fabs(cang),yt-1.5*xy*height*cang,height,_abuf,0.0);
else
symbol(xt-0.6*height-height*fabs(cang)-half,yt-xy*height*cang,height,_abuf,0.0);
xmin += del;
xt += delx;
yt += dely;
}
}
_axisl(a,b,iflag,opt)
float a,b;
int iflag,opt;
{
double d;
double c;
int minus,dc,si,i;
static int n,efl;
int n1,n2,n3;
char *ecvt(),*bu,*bb;
if(opt){
c = b - a;
ecvt(fabs(a),DIGITS,&n1,&si);
ecvt(fabs(b),DIGITS,&n2,&si);
ecvt(fabs(c),DIGITS,&n3,&si);
if(iabs(n1-n2) <= 1) n = (n1 > n2)? n1 : n2;
else if(iabs(n1-n3) <= 1) n = n3;
else if(iabs(n2-n3) <= 1) n = n2;
efl = 0;
if(n <= -2 || n >= (DIGITS + iflag)){
efl = 1;
}
return(efl ? n-1 : 0);
}
else{
if(iflag)d = floor(a + 0.5);
else d = a;
minus = 0;
if(d < 0){
d = -d;
minus = 1;
}
bu = ecvt(d,DIGITS,&dc,&si);
if(d == 0.0)dc++;
if(efl)dc -= n - 1;
if(iflag && efl == 0){
bu[dc] = 0;
bb = _abuf;
if(minus)*bb++ = '-';
while( *bb++ = *bu++);
}
else{
bb = _abuf;
if(minus)*bb++ = '-';
if(dc <= 0){
*bb++ = '.';
while(dc++)*bb++ = '0';
while(*bb++ = *bu++);
_abuf[DIGITS+1+minus] = 0;
}
else{
while(dc--)*bb++ = *bu++;
*bb++ = '.';
while(*bb++ = *bu++);
}
}
return(_ssize(_abuf));
}
}
iabs(i)
int i;
{
return((i>0)? i : -i);
}
SHAR_EOF
cat << \SHAR_EOF > genfont.c
/*
genfont - generate character font files
The CRC graphics package
Carl Crawford
Purdue University
W. Lafayette, IN 47907
October 1981
*/
/*
The file generated by 'genfont' has the following format:
short height Default character height.
short size Bytes of core required to hold coordinates.
short pnt[256] Indexes to 1st coordinate of each symbol.
short crd[size] Coordinates of symbols
Where each crd[i] has the following format:
EVSXXXXXXSYYYYYY (a 'short' is assumed to be 16 bits)
III IIIIIIII
III I I----- Y coordinate (sign magnitude format)
IIIIIIIII
II I----- X coordinate (sign magnitude format)
II----- Line segment visible flag (0=invisible, 1=visible)
I----- 1=more coordinates; 0=last coordinate
The file used as input to 'genfont' as the following format:
\n/x0,y0,v0/x1,y1,v2/.../xm,ym,vm<cr>
.
.
.
where:
'n' is the character in octal.
xi, i=1,2,..m is the x coordinate of the i'th segment
yi, i=1,2,..m is the x coordinate of the i'th segment
vi, i=1,2,..m is the visible indicator of the i'th segment
v = 0 => invisible
= 1 => visible
*/
#include <stdio.h>
FILE *fd; /* output file descriptor */
FILE *ifd; /* input file descriptor */
char j[512]; /* input character buffer */
int i1; /* general integer */
int i3; /* position within file */
int k1; /* x position */
int k2; /* y position */
int k3; /* visib flag */
short l; /* formed coordinate */
int n; /* character number */
struct{ /* header structure */
short height;
short coordsz;
short pntr1st[256];
}fontcom;
main(argc, argv)
int argc;
char **argv;
{
if(argc != 3)synerr();
if((fd = fopen(argv[1],"w")) == NULL)err("can't create ",argv[1]);
if(strcmp(argv[1],argv[2])==0){
err("output and input files have the same name","");
}
if((ifd = fopen(argv[2],"r"))==NULL)err("can't open: ",argv[2]);
for (i1=0; i1<256; i1++)fontcom.pntr1st[i1] = -1;
/* get height of font */
if(gread())err("can't read height","");
fontcom.height = atoi(j);
/* save space for header */
fseek(fd,(long)sizeof(fontcom),0);
/* loop through all the entries */
while(!gread()){
if (*j == '\\') {
n = atoi(j+1);
n = (n/100*64) + (((n/10)%10)*8) + n%10;
if (n<0 || n>255)err("invalid character number ",j+1);
fontcom.pntr1st[n] = i3;
/* terminate previous character */
fseek(fd,-(long)sizeof(l),1);
l |= 0100000;
fwrite(&l,sizeof(l),1,fd);
}else{
k1 = atoi(j);
if(gread())err("incomplete coordinate specified","");
k2 = atoi(j);
if(gread())err("incomplete coordinate specified","");
k3 = atoi(j)&&01;
l = (k3<<14) | ((abs(k1)%128)<<7) | (abs(k2)%128);
if(k1 < 0)l |= 0020000;
if(k2 < 0)l |= 0100;
fwrite(&l,sizeof(l),1,fd);
fontcom.coordsz += sizeof(l);
i3++;
}
}
/* clean up last character */
fseek(fd,-(long)sizeof(l),1);
l |= 0100000;
fwrite(&l,sizeof(l),1,fd);
/* write header */
fseek(fd,(long)0,0);
fwrite(&fontcom,sizeof(fontcom),1,fd);
exit(0);
}
gread()
{
char *c;
c = j;
while((*c = fgetc(ifd)) != EOF){
if(*c == ',' || *c == '/' || *c == '\n')return(0);
c++;
}
return(1);
}
err(s1,s2)
char *s1,*s2;
{
fputs(s1,stderr);
fputs(s2,stderr);
fputc('\n',stderr);
exit(1);
}
synerr(){
err("syntax: genfont <output file> <input file>","");
}
SHAR_EOF
cat << \SHAR_EOF > scale.c
/*
scale - find minimum and maximum of vector
The CRC graphics package
Carl Crawford
Purdue University
West Lafayette, IN 47901
October 1981
*/
#include "crc.h"
scale(a,n)
float *a;
int n;
{
float ai,fmax,fmin;
register int i;
fmax = fmin = *a;
for(i=0;i<n;i++){
ai=a[i];
if(ai > fmax) fmax = ai;
if(ai < fmin) fmin = ai;
}
a[n] = fmin;
a[n+1] = fmax;
}
SHAR_EOF
cat << \SHAR_EOF > strip7.c
/*
strip7 - strip byte counts from binary f77 writes
The CRC graphics package
carl crawford
purdue university
west lafayette, indiana 47907
april 10, 1980
Modified 11/2/82...to give it bigger buffer for plot3d
Malcolm
syntax: strip7 [-r] file1 file2 ...
*/
#include <stdio.h>
#include <signal.h>
#define MAXBUF 30000
int files; /* 1 if multiple files present */
int new; /* 1 put stripped file in name.s7 */
int ofile; /* 1 open temp or output file */
char name[50]; /* file name buffer */
char buf[MAXBUF];
main(argc,argv)
int argc;
char **argv;
{
FILE *fdi,*fdo;
int i,j;
int rmtmp();
if(argc > 1 && argv[1][0] == '-' && argv[1][1] == 'r'){
new = 1;
argc--;
argv++;
}
if(argc == 1)err("usage: strip7 [-r] file1 ...","");
signal(SIGHUP,rmtmp);
signal(SIGINT,rmtmp);
signal(SIGQUIT,rmtmp);
if(argc > 2)files = 1;
while(++argv,--argc){
if((fdi = fopen(*argv,"r")) == NULL){
err("can't open: ",*argv);
goto nfile;
}
if(new){
strcpy(name,*argv);
strcat(name,".s7");
if((fdo = fopen(name,"w")) == NULL){
err("can't create: ",name);
goto nfile;
}
}else{
if((fdo = fopen("strip7.tmp","w")) == NULL){
err("can't create temp file\n","");
goto nfile;
}
}
ofile = 1;
while(fread(&i,sizeof(int),1,fdi) == 1){
if(i <= 0 || i > MAXBUF){
bad(*argv);
goto nfile;
}
if(fread(buf,1,i,fdi) != i){
bad(*argv);
goto nfile;
}
fwrite(buf,1,i,fdo);
if(fread(&j,sizeof(int),1,fdi) != 1){
bad(*argv);
goto nfile;
}
if(j != i){
bad(*argv);
goto nfile;
}
}
fclose(fdi);
fclose(fdo);
if(!new){
if(unlink(*argv) == -1){
err("can't unlink: ",*argv);
goto nfile;
}
if(link("strip7.tmp",*argv) == -1){
strcpy(buf,"cp strip7.tmp ");
strcat(buf,*argv);
system(buf);
}
unlink("strip7.tmp");
}
ofile = 0;
nfile:
;
}
}
bad(s)
char *s;
{
if(files){
fprintf(stderr,"%s:bad data structure\n",s);
}else{
fprintf(stderr,"bad data structure\n");
}
rmfiles();
}
err(s1,s2)
char *s1,*s2;
{
fprintf(stderr,"%s%s\n",s1,s2);
rmfiles();
}
rmfiles()
{
if(!ofile)return;
if(new){
unlink(name);
}else{
unlink("strip7.tmp");
}
ofile = 0;
}
rmtmp()
{
rmfiles();
exit(1);
}
SHAR_EOF
cat << \SHAR_EOF > xyaxes.c
#include <stdio.h>
main(argc,argv)
int argc;
char **argv;
{
int fd1, fd2, i, xaxis[6];
double yaxis[50];
fd1 = creat("xaxis", 0600);
fd2 = creat("yaxis", 0600);
for(i = 0; i < 6; i++){
xaxis[i] = 30 * i;
}
for(i = 0; i < 50; i++){
yaxis[i] = i / 100.0;
}
write(fd1, xaxis, 6 * sizeof (int));
write(fd2, yaxis, 50 * sizeof (double));
}
SHAR_EOF
cat << \SHAR_EOF > Makefile
# crc/src Makefile
#
# $Header: /usr/src/unsup/bin/crc/src/RCS/Makefile,v 1.9 87/05/06 23:27:04 rsk Local $
#
# Richard S. Kulawiec, Purdue University Computing Center
# 9/26/86
#
BIN= ${DESTDIR}/usr/unsup/bin
LIB= ${DESTDIR}/usr/unsup/lib/crc
GRAPHICSLIB=../lib/libG.a
OWNER = binary
GROUP = system
MODE = 751
SHMODE = 755
SUMODE = 4751
SGMODE = 2751
TXTMODE = 644
INCLUDE =
CDEFS =
CFLAGS = -O -n ${CDEFS} ${INCLUDE}
HDR =
# Use this set if you want the drivers; it includes gd gp gplp hpd
# SRC = qplot.c plot3d.c gd.c gp.c gplp.c hpd.c crclabel.c strip7.c \
# axis.c axis_.c axisv_.c draxis.c plot3dres.c scale.c xyaxes.c genfont.c
SRC = qplot.c plot3d.c crclabel.c strip7.c \
axis.c axis_.c axisv_.c draxis.c plot3dres.c scale.c xyaxes.c genfont.c
FSRC = draw.f newtru.f setaxs.f subr.f test.f
# See comment above.
# OBJ = qplot.o plot3d.o gd.o gp.o gplp.o hpd.o crclabel.o strip7.o \
# axis.o axis_.o axisv_.o draxis.o plot3dres.o scale.o xyaxes.o genfont.o
OBJ = qplot.o plot3d.o crclabel.o strip7.o \
axis.o axis_.o axisv_.o draxis.o plot3dres.o scale.o xyaxes.o genfont.o
FOBJ = draw.o newtru.o setaxs.o subr.o test.o
SOURCE= Makefile ${HDR} ${SRC} ${FSRC}
# all: qplot plot3d gd gp gplp hpd crclabel strip7 font.5x7
all: qplot plot3d crclabel strip7 font.5x7
qplot: qplot.c $(GRAPHICSLIB)
${CC} -O qplot.c $(GRAPHICSLIB) -lm -o qplot
plot3d: $(OBJS) $(FOBJ) $(GRAPHICSLIB)
${CC} $(CFLAGS) $(OBJS) $(FOBJ) -o plot3d $(GRAPHICSLIB) -lI77 -lU77 -lF77 -lm
#
# gd: gd.c $(GRAPHICSLIB)
# ${CC} -O gd.c $(GRAPHICSLIB) -lm -o gd
#
# gp: gp.c $(GRAPHICSLIB)
# ${CC} -O gp.c $(GRAPHICSLIB) -lm -o gp
#
# gplp: gplp.c $(GRAPHICSLIB)
# ${CC} -O gplp.c $(GRAPHICSLIB) -lm -o gplp
#
# hpd: hpd.c $(GRAPHICSLIB)
# ${CC} -O hpd.c $(GRAPHICSLIB) -lm -o hpd
crclabel: crclabel.c $(GRAPHICSLIB)
${CC} -O crclabel.c $(GRAPHICSLIB) -lm -o crclabel
strip7: strip7.c $(GRAPHICSLIB)
${CC} -O strip7.c $(GRAPHICSLIB) -lm -o strip7
font.5x7: ifont.5x7 genfont
./genfont font.5x7 ifont.5x7
genfont: genfont.c
${CC} $(CFLAGS) genfont.c -o genfont
$(GRAPHICSLIB): ../lib/libG.a
cd ../lib;make all
clean: FRC
-rm -f Makefile.bak a.out core errs lint.errs *.o font.5x7 genfont \
qplot plot3d gd gp gplp hpd crclabel strip7 font.5x7
depend: ${HDR} ${SRC} FRC
maketd -a ${CDEFS} ${INCLUDE} ${SRC}
install: all FRC
-install -c -m ${MODE} -o ${OWNER} -g ${GROUP} -s qplot ${BIN}
-install -c -m ${MODE} -o ${OWNER} -g ${GROUP} -s plot3d ${BIN}
# -install -c -m ${MODE} -o ${OWNER} -g ${GROUP} -s gd ${LIB}
# -install -c -m ${MODE} -o ${OWNER} -g ${GROUP} -s gp ${LIB}
# -install -c -m ${MODE} -o ${OWNER} -g ${GROUP} -s gplp ${LIB}
# -install -c -m ${MODE} -o ${OWNER} -g ${GROUP} -s hpd ${LIB}
-install -c -m ${MODE} -o ${OWNER} -g ${GROUP} -s crclabel ${LIB}
-install -c -m ${MODE} -o ${OWNER} -g ${GROUP} -s strip7 ${BIN}
-install -c -m ${TXTMODE} -o ${OWNER} -g ${GROUP} font.5x7 ${LIB}
lint: ${HDR} ${SRC} FRC
lint -hnx ${CDEFS} ${INCLUDE} ${SRC}
print: source FRC
lpr -J"crc/src source" ${SOURCE}
source: ${SOURCE}
spotless: clean
rcsclean Makefile ${HDR} ${SRC} ${FSRC}
tags: ${HDR} ${SRC}
ctags -t ${HDR} ${SRC}
${SOURCE}:
co $@
FRC:
# DO NOT DELETE THIS LINE - make depend DEPENDS ON IT
I=/usr/include
S=/usr/include/sys
qplot.o: $I/math.h $I/stdio.h qplot.c
plot3d.o: $I/math.h $I/stdio.h plot3d.c
crclabel.o: $I/math.h $I/stdio.h crclabel.c
strip7.o: $I/signal.h $I/stdio.h strip7.c
axis.o: $I/math.h $I/signal.h $I/stdio.h axis.c crc.h
axis_.o: $I/math.h $I/signal.h $I/stdio.h axis_.c crc.h
axisv_.o: $I/math.h $I/signal.h $I/stdio.h axisv_.c crc.h
draxis.o: $I/math.h $I/signal.h $I/stdio.h crc.h draxis.c
plot3dres.o: $I/math.h $I/stdio.h plot3dres.c
scale.o: $I/math.h $I/signal.h $I/stdio.h crc.h scale.c
xyaxes.o: $I/stdio.h xyaxes.c
genfont.o: $I/stdio.h genfont.c
# *** Do not add anything here - It will go away. ***
SHAR_EOF
chdir ..
# End of shell archive
exit 0
--
Rich $alz "Anger is an energy"
Cronus Project, BBN Labs rsalz@bbn.com
Moderator, comp.sources.unix sources@uunet.uu.net