⟦da850d81c⟧

TextFile

******************************************************************************
*
* subroutine cat(x1,y1,xt,yt) does the following:
*    - performs concatenation transformation,
*      on point (x1,y1) like this:
*      (xt,yt,1)=(x,y,1) Q
*      where Q is the current transformation
*      matrix which is 3x3 matrix.
*
*******************************************************************************
	subroutine cat(x1,y1,xt,yt)
	real x1,y1,xt,yt
	common/array/q(3,3)
c
	xt=(q(1,1)*x1)+(q(2,1)*y1)+q(3,1)
	yt=(q(1,2)*x1)+(q(2,2)*y1)+q(3,2)
	return
	end
*********************************************************************************
* subroutine clr does the following:
*  + (re) initialize transformatio matrix (q).
*    q=( 1 0 0 )
*      ( 0 1 0 )
*      ( 0 0 1 )
*
*******************************************************************************
	subroutine clr
	common/array/q(3,3)
c
	q(1,1)=1.0
	q(1,2)=0.0
	q(1,3)=0.0
	q(2,1)=0.0
	q(2,2)=1.0
	q(2,3)=0.0
	q(3,1)=0.0
	q(3,2)=0.0
	q(3,3)=1.0
	return
	end
******************************************************************************
*
* subroutine scl(sx,sy) does the following:
*     - matrix (s) is the scaling matrix.
*     - forms matrix s=( sx 0 0 )
*                       ( 0 sy 0 )
*                       ( 0  0 1 )
*     - update transformation matrix after
*       scaling .
*     - tranformation matrix ( q = q . s )
*
******************************************************************************
	subroutine scl(sx,sy)
	real sx,sy
	common/array/q(3,3)
	dimension s(3,3)
c
	s(1,1)=sx
	s(1,2)=0.0
	s(1,3)=0.0
	s(2,1)=0.0
	s(2,2)=sy
	s(2,3)=0.0
	s(3,1)=0.0
	s(3,2)=0.0
	s(3,3)=1.0
	call matmlt(q,s)
	return
	end
****************************************************************************
*
* subroutine rot(theta) does the following:
*       - matrix (r) is the rotation matrix
*       - convert (theta) to radians (tr).
*       -forms matrix (r) as follows:
*       r=( cos(tr) -sin(tr) 0 )
*         ( sin(tr)  cos(tr) 0 )
*         (    0        0    1 )
*       - update transformation matrix after
*         rotation .
*       - transformation matrix ( q = q . r)
*         by calling MATMLT.
*
****************************************************************************
	subroutine rot(theta)
	real theta
	common/array/q(3,3)
	dimension r(3,3)
	real tr,pi
c
	pi=3.14159265
	tr=((pi/180.0)*theta)
	r(1,1)=cos(tr)
	r(1,2)=-sin(tr)
	r(1,3)=0.0
	r(2,1)=sin(tr)
	r(2,2)=cos(tr)
	r(2,3)=0.0
	r(3,1)=0.0
	r(3,2)=0.0
	r(3,3)=1.0
	call matmlt(q,r)
	return
	end
*****************************************************************************
*
* subroutine tlt(tx,ty) does the following:
*      - matirx (t) is the translation matrix.
*      - forms matirx t=( 1 0 0 )
*                       ( 0 1 0 )
*                       (tx ty 1 )
*      - update transformation matrix after
*        translation.
*      - transformation matrix ( q = q . t )
*
*****************************************************************************
	subroutine tlt(tx,ty)
	real tx,ty
	common/array/q(3,3)
	dimension t(3,3)
c
	t(1,1)=1.0
	t(1,2)=0.0
	t(1,3)=0.0
	t(2,1)=0.0
	t(2,2)=1.0
	t(2,3)=0.0
	t(3,1)=tx
	t(3,2)=ty
	t(3,3)=1.0
	call matmlt(q,t)
	return
	end
************************************************************************
*
* subroutine clip(x1,y1,x2,y2,ic) does the following:
*    - using Conleys algorithm.
*    - clips line (x1,y1) to (x2,y2)
*      to the window.
*    - (ic) is the visibility flag.
*        ic= 1
*        (line fullly or partially visible).
*        ic= -1
*        (line is invisible).
*
***************************************************************************
	subroutine clip(x1,y1,x2,y2,ic)
	real x1,y1,x2,y2
	integer ic
	common/windo/wxmin,wxmax,wymin,wymax
	integer iswap,odd
c
c (iswap) is the no. of times points (x1,y1) & 
c (x2,y2) swaped.
	iswap=0
	odd=0
c    check if x1>x2 then swap the two points

	if(x1.gt.x2)then
	call swap(x1,y1,x2,y2)
	iswap=iswap+1
	endif
c check if point (x1,y1) out of window bounds.
c if so clip line to windows left edge.

	if((x1.lt.wxmin).and.(x2.ge.wxmin))then
	   y1=(((y2-y1)/(x2-x1))*(wxmin-x1))+y1
	   x1=wxmin
	endif
c check if point (x2,y2) out of window bounds.
c if so clip line to windows rigth edge.

	if((x1.le.wxmax).and.(x2.gt.wxmax))then
	   y2=(((y2-y1)/(x2-x1))*(wxmax-x1))+y1
	   x2=wxmax
	endif
c  check if y1>y2 then swap the two points.

	if(y1.gt.y2)then
	call swap(x1,y1,x2,y2)
	  iswap=iswap+1
	endif
c check if point (x1,y1) out of window bounds,
c if so clip line to windows bottom edge.

	if((y1.lt.wymin).and.(y2.ge.wymin))then
	x1=(((x2-x1)/(y2-y1))*(wymin-y1))+x1
	y1=wymin
	endif
c check if point (x2,y2) is out of window bounds,
c if so clip line to windows top edge.

	if((y1.le.wymax).and.(y2.gt.wymax))then
	x2=(((x2-x1)/(y2-y1))*(wymax-y1))+x1
	y2=wymax
	endif
	odd=iswap-((mod(iswap,2))*2)
c  if no. of swaps is odd then swap one more time.
	if(odd.eq.1)then
	call swap
	endif

c  if both points not in clipping rectangle then ic=-1
        if((((x1.ge.wxmin).and.(x1.le.wxmax)).and.
     *  ((y1.ge.wymin).and.(y1.le.wymax))).and.
     *  (((x2.ge.wxmin).and.(x2.le.wxmax)).and.
     *  ((y2.ge.wymin).and.(y2.le.wymax))))then
	ic=1
	else
	ic=-1
	endif
	return
	end

******************************************************************
*
* subroutine swap(x1,y1,x2,y2) does the following:
*       - swap the two points
*        (x1,y1) and (x2,y2).
*
*************************************************************
	subroutine swap(x1,y1,x2,y2)
	real x1,y1,x2,y2,xtemp,ytemp
c
	xtemp=x1
	ytemp=y1
	x1=x2
	y1=y2
	x2=xtemp
	y2=ytemp
	return
	end
*****************************************************************************
*
* subroutine line does the following:
*     - calls  cat(x,y,xtt,ytt), to see if any 
*       transformation has been done .
*     - sets world point (u1,v1)to(xlast,ylast).
*       and world point (u2,v2)to(xtt,ytt)
*       and (xlast,ylast)to(xtt,ytt)
*     - call clip to see if line is within window
*       if flag ic=1 then visible else
*     - if ic=-1 then (line invisible)return.
*     - if line visible then do the following
*     -  transforms(u1,v1)to device coords
*       (i,j) if the latter not equal to 
*       (lastx,lasty) then call movepr.
*     - transforms (u2,v2) to device coords(k,l)
*     -output device is the AED TERMINAL 
*        + set the decimal code 65 for the hardware
*         line drawing
*        + call xyaed(k,l)
*        + set(lastx,lasty) to (k,l).
*
******************************************************************************
	subroutine line(x,y)
	real x,y
	common/device/lastx,lasty,numpag
	common/worldc/xlast,ylast
	real u1,v1,u2,v2
	character*1 a
c
	call cat(x,y,xtt,ytt)
	u1=xlast
	v1=ylast
	u2=xtt
	v2=ytt
	xlast=xtt
	ylast=ytt
c clip line to window ,then check visibility flag (ic).
	call clip(u1,v1,u2,v2,ic)
	if(ic.eq.1)then
c line is visible or partially visible.
c    transform line from world coords to device coords.
c    begin with starting point (u1,v1).
	call wdscrn(u1,v1,ssx,ssy)
	call driver(ssx,ssy,i,j)
c check (lastx,lasty) if not in proper position call movepr.
	if((i.ne.lastx).or.(j.ne.lasty))then
	   call movepr(i,j)
	endif
c now convert ending point to device coords.
	call wdscrn(u2,v2,sx,sy)
	call driver(sx,sy,k,l)
c output device is AED terminal .
	ia=65
	a=char(ia)
	call store(a)
	call xyaed(k,l)
	lastx=k
	lasty=l
	endif
	return
	end
******************************************************************************
*
* subroutine move(x,y) does the following:
*    - specify device coordinates
*    - transform point if it had under
*      gone any transformation,call cat
*      then set world last drawing position
*      to transformed point.
*       (xlast,ylast)=(xtt,ytt)
*    - transform xtt,ytt to device coords i,j
*    - if (i,j) within device bounds then 
*      move to (i,j) else return
*
*******************************************************************************
	subroutine move(x,y)
	real x,y
	common/worldc/xlast,ylast
	real xtt,ytt,ssx,ssy
	integer idxmin,idxmax,idymin,idymax,i,j
c
	idxmin=0
	idxmax=511
	idymin=0
	idymax=482
c
	call cat(x,y,xtt,ytt)
	xlast=xtt
	ylast=ytt
c transforme point coords from world to device .
	call wdscrn(xtt,ytt,ssx,ssy)
	call driver(ssx,ssy,i,j)
c check if (i,j) is witin device bounds
	if(((i.ge.idxmin).and.(i.le.idxmax)).and.
     *  ((j.ge.idymin).and.(j.le.idymax)))then
c if every thing checks OK then call movepr(i,j).
	call movepr(i,j)
	endif
	return
	end
*******************************************************************************
*
* subroutine matmlt(a,b) does the following:
*       - performs multiplication between 
*         two matrices (a,b) and puts the 
*         result in (a).
*
*******************************************************************************
	subroutine matmlt(a,b)
	dimension a(3,3),b(3,3),result(3,3)
c
	do 20 n=1,3
	do 10 m=1,3
	result(m,n)=0.0
10	continue
20	continue

	do 50 i=1,3
	do 40 j=1,3
	do 30 k=1,3

	result(i,j)=result(i,j)+(a(i,k)*b(k,j))
30	continue
40	continue
50	continue


	do 70 li=1,3
	do 60 lj=1,3
	a(li,lj)=result(li,lj)
60	continue
70	continue
	return
	end
*********************************************************************************
* subroutine term does the following:
*     + insert code in (jpage) to return to 
*       alpha mode.
*     + outputs (jpage) contents.
*     + print on unit 0
*       number of pages = numpag.
********************************************************************************
	subroutine term
	common/contr/icnt
	common/page/jpage(6000)
	common/device/lastx,lasty,numpag
	character*1 ers,alpha
	character*1 jpage
c output device is AED terminal .
	ialpha=1
	iers=126
	ers=char(iers)
	call store(ers)
	alpha=char(ialpha)
	call store(alpha)
	do 300 j=1,icnt-1
	call prnt(jpage(j))
300	continue
c
	write(0,45) numpag
45	format(1x,'NUMBER OF PAGES=',i2)
	return
	end
DataMuseum.dk

DKUUG/EUUG Conference tapes

⟦da850d81c⟧ TextFile

Derivation

TextFile
