DataMuseum.dk

top - download

    Length: 5933 (0x172d)
    Types: TextFile
    Names: »subs5.f«

└─⟦a0efdde77⟧ Bits:30001252 EUUGD11 Tape, 1987 Spring Conference Helsinki
    └─ ⟦this⟧ »EUUGD11/euug-87hel/sec1/utep/subs5.f« 

TextFile

****************************************************************************
*
* subroutine wdscrn(x,y,sx,sy) does the following:
*  + transform world coords(x,y)into screen coords(sx,sy)
*
****************************************************************************
	subroutine wdscrn(x,y,sx,sy)
	real x,y,sx,sy
	common/windo/wxmin,wxmax,wymin,wymax
	common/vport/vxmin,vxmax,vymin,vymax
c
	sx=(((vxmax-vxmin)/(wxmax-wxmin))*(x-wxmin))+vxmin
	sy=(((vymax-vymin)/(wymax-wymin))*(y-wymin))+vymin
	return
	end
****************************************************************************
*
* subroutine driver(sx,sy,i,j) does the following:
* + transforms screen coords (sx,sy)to device coords(i,j).
*
****************************************************************************
	subroutine driver(sx,sy,i,j)
	integer i,j
	real sx,sy
	common/scren/sxmin,sxmax,symin,symax
c
	idxmin=0
	idxmax=511
	idymin=0
	idymax=482
	i=int(((idxmax-idxmin)/(sxmax-sxmin))*(sx-sxmin)+idxmin+0.5)
	j=int(((idymax-idymin)/(symax-symin))*(sy-symin)+idymin+0.5)
	return
	end
*************************************************************************
*
* subprogram block data does the following:
*     - assign initial values to common variables.
************************************************************************
	block data
	common/device/lastx,lasty,numpag
	common/worldc/xlast,ylast
	common/windo/wxmin,wxmax,wymin,wymax
	common/scren/sxmin,sxmax,symin,symax
	common/vport/vxmin,vxmax,vymin,vymax
	common/contr/icnt
	common/num/numitms
	common/space/ifree
	common/poly/iflag,numpoly,ifivply(5)
	common/ovlap/iovlap(21,21)
	common/prec/ipgrec,icflag
	common/gc/igcflg
	common/aucp/iaucp
	common/array/q(3,3)
	data wxmin,wymin,sxmin,symin/-1.0,-1.0,-1.0,-1.0/
	data vxmin,vymin,vxmax,vymax/-1.0,-1.0,11.0,11.0/
	data wxmax,wymax,sxmax,symax/11.0,11.0,11.0,11.0/
	data xlast,ylast/0.0,0.0/
	data lastx,lasty,numpag/1,1,0/
	data icnt/1/
	data numitms,iflag,numpoly,ifree/0,0,0,1/
	data iovlap/441*0/
	data ipgrec,icflag/0,0/
	data igcflg/0/
	data iaucp/0/
	data q(1,1),q(1,2),q(1,3)/1.0,0.0,0.0/
	data q(2,1),q(2,2),q(2,3)/0.0,1.0,0.0/
	data q(3,1),q(3,2),q(3,3)/0.0,0.0,1.0/
	end
************************************************************************
*
* subroutine windo(wwxmin,wwxmax,wwymin,wwymax)
* does the following:
*    + (re) specifies window boundaries.
*
***********************************************************************
	subroutine window(wwxmin,wwxmax,wwymin,wwymax)
	real wwxmin,wwxmax,wwymin,wwymax
	common/windo/wxmin,wxmax,wymin,wymax
c
c check if boundaries gives positive area 
c if so set window bounds else take default
c values for wxmin,wxmax,wymin,wymax.
	if((wwxmin.ne.wwxmax).and.(wwymin.ne.wwymax))then
	wxmin= wwxmin
	wxmax= wwxmax
	wymin= wwymin
	wymax= wwymax
	endif
	return
	end
**********************************************************************
*
* subroutine screen(ssxmin,ssxmax,ssymin,ssymax)
* does the following:
*    + (re) specifies screen boundaries.
*
***********************************************************************
	subroutine screen(ssxmin,ssxmax,ssymin,ssymax)
	real ssxmin,ssxmax,ssymin,ssymax
	common/scren/sxmin,sxmax,symin,symax
c
c check if boundaries gives positive area if so
c set screen bounds else assume default values 
c for sxmin,sxmax,symin,symax.
	if((ssxmin.ne.ssxmax).and.(ssymin.ne.ssymax))then
	sxmin= ssxmin
	sxmax= ssxmax
	symin= ssymin
	symax= ssymax
	endif
        return
        end
**********************************************************************
*
* subroutine vwport(vvxmin,vvxmax,vvymin,vvymax)
* does the following:
*    + check against screen boundaries
*      if exceed screen boundaries,set 
*      to screen boundaries.
*    + (re)specifies viewport boundaries.
*
**********************************************************************
	subroutine vwport(vvxmin,vvxmax,vvymin,vvymax)
	real vvxmin,vvxmax,vvymin,vvymax
	common/scren/sxmin,sxmax,symin,symax
	common/vport/vxmin,vxmax,vymin,vymax
c
c check if boundaries gives positve area if so 
c set viewport bounds else assume default 
c values for vxmin,vxmax,vymin,vymax.
	if((vvxmin.ne.vvxmax).and.(vvymin.ne.vvymax))then
c   check vvxmin against  sxmin
	if(vvxmin.lt.sxmin)then
	   vxmin=sxmin
	else
	   vxmin=vvxmin
	endif
	
c   check vvxmax against sxmax
	if(vvxmax.gt.sxmax)then
	   vxmax=sxmax
	else
	   vxmax=vvxmax
	endif

c   check vvymin against symin
	if(vvymin.lt.symin)then
	   vymin=symin
	else
	   vymin=vvymin
	endif

c  check vvymax against symax
	if(vvymax.gt.symax)then
	   vymax=symax
	else
	   vymax=vvymax
	endif
	
	endif
	return
	end
*
***************************************************************************
* subroutine sqr does the following:
*    + draws a square with the following 
*      world coordinates:
*      (0.0,0.0),(1.0,0.0),(1.0,1.0),(0.0,1.0).
*
******************************************************************************
	subroutine sqr
	call move(0.0,0.0)
	call line(1.0,0.0)
	call line(1.0,1.0)
	call line(0.0,1.0)
	call line(0.0,0.0)
	return
	end

******************************************************************************
*
* subroutine cir does the following:
*     + draws a unit circle centerd at (1,1)
*       in world coods system.
*******************************************************************************
	subroutine cir
	real theta,x,y
	integer i,k
	real pi
c
	call move(2.0,1.0)
	pi=3.14159265
	k=0
	do 10 i=1,360
	theta=(pi*k)/180.0
	x=cos(theta)
	y=sin(theta)
	k=k+1
	call line(x+1,y+1)
10      continue
	return
	end
**************************************************************************
*
* subroutine triang does the following:
*  + draws a triangle with the following
*    world coordinates:
*    (0.0,0.0),(1.0,0.0),(0.5,1.0).
*************************************************************************
c
	subroutine triang
	call move(0.0,0.0)
	call line(1.0,0.0)
	call line(0.5,1.0)
	call line(0.0,0.0)
	return
	end