DataMuseum.dk

top - download

    Length: 3109 (0xc25)
    Types: TextFile
    Names: »subs1.f«

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

TextFile

*****************************************************************************
* subroutine zaed(ival) does the following:
*     + converts integer parameter (color number,
*       raduis,etc.) into two byte modified hex
*       AED code, and save it in display file (jpage).
*     + ival- integer AED parameter.
*
*****************************************************************************
	subroutine zaed(ival)
	integer ival
	character*1 ib1,ib2
c
c convert the lowest 4 bits.
	ib2 = char(and(ival,15) + 48)
c convert the upper 4 bits.
	ib1 = char(and(rshift(ival,4),15) + 48)
c
c store characters in display file.
c
	call store(ib1)
	call store(ib2)
c
	return
	end
****************************************************************************
* subroutine xyaed(i,j) does the following:
*     + converts device coords (i,j) into a 
*       5 bytes modified hex AED coordinates,
*       and save it in the display file.
*
***************************************************************************
	subroutine xyaed(i,j)
	integer i,j
	character*1 ib1,ib2,ib3,ib4,ib5
c
c check for coords within bounds.
c
	if(i.lt.0)i=0
	if(i.gt.511)i=511
	if(j.lt.0)j=0
	if(j.gt.482)j=482
c
c determine the lowest 4 bits of i.
c
	idum=i
	ib3 = char(and(idum,15) + 48)
c
c determine the middle 4 bits of i.
c
	idum = rshift(idum,4)
	ib2 = char(and(idum,15) + 48)
c
c determine the value of the upper 2 bits of i.
c
	idum = rshift(idum,2)
c
c determine the value of the lowest 4 bits of j.
c
	jdum=j
	ib5 = char(and(jdum,15) + 48)
c
c determine the value of the middle 4 bits of j.
c
	jdum = rshift(jdum,4)
	ib4 = char(and(jdum,15) + 48)
c
c determine the upper 2 bits of j and combine
c it with those from i.
c
	jdum = rshift(jdum,4)
	ib1 = char(or(jdum,and(idum,12)) + 48)
c
c store the values in display file.
c
	call store(ib1)
	call store(ib2)
	call store(ib3)
	call store(ib4)
	call store(ib5)
c
	return
	end
**********************************************************************
* subroutine store(cval) does the following:
*     + store a character value in the display 
*       file and increment the counter.
*     + cval- character parameter.
*
*********************************************************************
	subroutine store(cval)
	character*1 cval
	common/page/jpage(6000)
	common/contr/icnt
	character*1 jpage
c
	jpage(icnt)=cval
	icnt=icnt+1
	return
	end
********************************************************************************
*
* subroutine movepr(i,j) does the following:
*     + moves to point (i,j) without
*       drawing by setting current device
*       drawing position,(lastx,lasty) to (i,j).
*     + output device is the AED TERMINAL 
*       convert (i,j) into 5 byte move code:
*       (Q,xy20 code) and store it into jpage.
*
********************************************************************************
	subroutine movepr(i,j)
	integer i,j,iq
	common/device/lastx,lasty,numpag
	character*1 q
c
c set current device drawing position 
c (lastx,lasty) to (i,j).
	lastx=i
	lasty=j
c decimal code for a move is (81).
	iq=81
	q=char(iq)
	call store(q)
	call xyaed(i,j)
	return
	end