c	File LA100D.FOR
c	Rev. 8406.011
c
c	Contributed to DECUS at Spring 1984 U.S. Symposium
c	by Rob Hamilton of Multiware Inc., Davis, CA
c
c	*****************************************************
c	   This software is provided on an "AS-IS" basis.
c	*****************************************************
c
	Subroutine DECARG (istat)
c
c	Decodes ASCII-Graphics file, and makes Raster File.
c
	byte fid(40), fido(40), line(80), ians
	integer iparam(2)
c
	integer*2 icmnd
c
	logical first
	common /MFTR01/ first , factmf, ixdev, iydev, ixsize, iysize,
	1		ixoffs, iyoffs, irotat, xmax, ymax
c
	integer*2 MOVE  , DRAW  , TEXT  , SLINT
	integer*2 SCOLS , SETLIM, SETOFS, SETLAL
	integer*2 ENDPIC, STTXAN, STTXSZ, STGROT
	common /RECTYP/ MOVE  , DRAW  , TEXT  , SLINT ,
	1		SCOLS , SETLIM, SETOFS, SETLAL,
	2		ENDPIC, STTXAN, STTXSZ, STGROT
c
	byte chrdot
	common /CHRGEN/ ixform(4), iyform(4), ixpath(4), iypath(4),
	1		ixup(4), iyup(4), isize, ipath, ispath,
	2		chrdot(480)
c
	common /LA100U/ lui, luo, luterm, iopen
	common /WATCH/  iwatch, irec
c
	data iwatch / 1 /		! watch record count?
c
c	Input file command definitions:
c
	data MOVE   / 1 /		! move
	data DRAW   / 2 /		! draw
	data TEXT   / 3 /		! graphics text
	data SLINT  / 4 /		! set line style
	data SCOLS  / 5 /		! set color index
	data SETLIM / 6 /		! set x & y limits of ARG file
	data SETOFS / 7 /		! set x & y offsets of LA100
	data SETLAL / 8 /		! set x & y limits of LA100
	data ENDPIC / 9 /		! end picture
	data STTXAN / 10 /		! set text angle
	data STTXSZ / 11 /		! set text size
	data STGROT / 12 /		! set graphics 90-deg rot
c
	istat = 0			! set no error (yet)
	irec  = 0			! set record-read counter
c
c	Ask user for file names.
c
	write (luterm, 1001)
 1001	format(' Name of input file: ',$)
	read (luterm, 1002, end=983) nch, (fid(k),k=1,40)
 1002	format(Q, 40A1)
	if (nch .le. 0 .or. fid(1) .eq. ' ') go to 985
	fid(nch+1) = 0
c
c	Try opening named file;
c
	open (unit=lui, name=fid, type='OLD', readonly, err=990)
c
c	Initialize raster file (direct access)
c
	call INIDAF (luo)
c
c	Get commands from input file, and decode them one by one.
c	Move instructions are delayed and made pending, so as to remove
c	consecutive move commands.
c
	if (iwatch .eq. 0) go to 180
	write (luterm, 1171)
 1171	format (' Processing input record     1',$)
c
  180	ipend = 0
  200	call IGTCMD (icmnd, iparam)
	if (iwatch .ge. 0) go to 202
	write (luterm, 1171)
	iwatch = 1
  202	if (icmnd .eq. TEXT) go to 230
	if (ipend .eq. 0 .or. icmnd .eq. MOVE) go to 204 ! MOVE pending?
c
c	Moves are done here:
c
	ixc = ixdev				! simply save current
	iyc = iydev				!  position.
	ipend = 0
c
c	What kind of command was found?  Act on it.
c
  204	if (icmnd .eq. DRAW) go to 220		! "DRAW"?
	if (icmnd .eq. MOVE) go to 210		! "MOVE"?
	if (icmnd .eq. SLINT) go to 240		! "SET LINE TYPE"?
	if (icmnd .eq. SCOLS) go to 250		! "SET LINE TYPE"?
	if (icmnd .eq. SETLIM) go to 260	! "SET LIMITS"?
	if (icmnd .eq. SETOFS) go to 270	! "SET OFFSETS"?
	if (icmnd .eq. SETLAL) go to 280	! "SET LIMITS OF LA100"?
	if (icmnd .eq. STTXAN) go to 300	! "SET TEXT ANGLE"?
	if (icmnd .eq. STTXSZ) go to 310	! "SET TEXT SIZE"?
	if (icmnd .eq. STGROT) go to 320	! "SELECT ROTATED GRAPH"?
	if (icmnd .eq. ENDPIC) go to 980	! "END PICTURE"?
c
c	None of the above.  Ignore it.  (?)
c
	write (luterm, 1210) icmnd
 1210	format (' ?LA100D-W-Unrecognized opcode ',I5,' on input')
	iwatch = -iwatch
	go to 200
c
c	MOVE command;
c	Convert file's (x,y) coordinate to output device coordinates.
c	Then, set the "MOVE PENDING" flag.
c
  210	call CVTXY (iparam(1), iparam(2), ix, iy)
	ipend = 1				! (make MOVE pending)
	go to 200
c
c	Vector drawing is done here;  First, convert file (x,y)
c	coordinate values to hardware device coordinates.  Then call
c	hardware move/draw routine with pen code = 1 (down).
c
  220	call CVTXY (iparam(1), iparam(2), ix, iy)
	call DOTFIL (ixc, iyc, ix, iy)
	ixc = ix
	iyc = iy
	go to 200
c
c	Text command;  Get number of characters, retrieve them
c	and use hardware-text routine to print them on device.
c
  230	nch = iparam(1)
	ndx = 2
	read (lui, 1231) line
 1231	format (80A1)
	if (nch .gt. 80) nch = 80
c
c	Output hardware text here.
c
	call CHARGN (nch, line, ixdev, iydev)
	ipend = 0
	go to 200
c
c	Set line type.
c
  240	call RFLINT (iparam(1))
	go to 200
c
c	Set color (no such function on LA100;  on devices that
c	do support color, multiple bitmaps would be required.)
c
  250	continue
	go to 200
c
c	Set new x/y limits
c
  260	xmax = FLOAT(iparam(1))
	ymax = FLOAT(iparam(2))
	first = .TRUE.
	go to 200
c
c	Set LA100 offset values
c
  270	ixoffs = iparam(1)
	iyoffs = iparam(2)
	go to 200
c
c	Set LA100 limit values
c
  280	ixsize = iparam(1)
	iysize = iparam(2)
	first = .TRUE.
	go to 200
c
c	Set text rotation angle
c
  300	angle = FLOAT(iparam(1))
	call CHRANG (angle)
	go to 200
c
c	Set text size in raster units.
c
  310	call CHRSIZ (iparam(1), iparam(2))
	go to 200
c
c	set/clear ROTATION flag
c
  320	irotat = 0
	if (iparam(1) .ne. 0) irotat = 1
	ipath  = (ispath-1) - irotat		! set dot char angle
	ipath  = ipath .and. 3			! actual char path
	ipath  = ipath + 1
	go to 200
c
c	Finish the plot here.
c
  980	call FINDAF			! close output,
	close (unit=lui)		! close input.
	istat = 0
	go to 999
c
  983	write (luterm, 1984)
 1984	format(' ')
c
c	No file name entered.  CTRL-Z exit.
c
  985	istat = -2
	go to 999
c
c	Error exit.
c
  990	istat = -1
c
  999	return
c
	end
	Subroutine IGTCMD (icmnd, iparam)
c
c	Get one command (with parameters) from the input file.
c
	integer*2 icmnd
	integer iparam(1)
	byte bs
	integer*2 MOVE  , DRAW  , TEXT  , SLINT
	integer*2 SCOLS , SETLIM, SETOFS, SETLAL
	integer*2 ENDPIC, STTXAN, STTXSZ, STGROT
	logical first
	common /MFTR01/ first , factmf, ixdev, iydev, ixsize, iysize,
	1		ixoffs, iyoffs, irotat, xmax, ymax
	common /RECTYP/ MOVE  , DRAW  , TEXT  , SLINT ,
	1		SCOLS , SETLIM, SETOFS, SETLAL,
	2		ENDPIC, STTXAN, STTXSZ, STGROT
	common /LA100U/ lui, luo, luterm, iopen
	common /WATCH/  iwatch, irec
c
	data bs / 8 /				! backspace code
c
  100	read (lui, *, end=300) icmnd, iparam(1), iparam(2)
	irec = irec + 1
	if (iwatch .eq. 0) go to 200
	if ((irec .and. "77) .ne. 0) go to 200
	write (5, 1091) bs, bs, bs, bs, bs, irec
 1091	format (1H+, 5A1, I5, $)
  200	continue
	return
c
  300	icmnd = ENDPIC
	return
c
	end
	Subroutine CVTXY (ixmf, iymf, ix, iy)
c
c	Subroutine CVTXY converts an (x,y) coordinate pair expressed
c	in input file dimensions to the units of the output device being
c	used for output.
c
	integer ixmf, iymf, ix, iy
	logical first
	common /MFTR01/ first , factmf, ixdev, iydev, ixsize, iysize,
	1		ixoffs, iyoffs, irotat, xmax, ymax
c
	data xmax   / 4095.0 /		! Input file x-limit (default)
	data ymax   / 3071.0 /		! Input file y-limit (default)
	data ixsize / 958 /		! LA100 width
	data iysize / 720 /		! LA100 height
	data ixoffs / 0 /		! default offsets
	data iyoffs / 0 /
	data irotat / 0 /		! rotation flag
	data first  / .TRUE. /
c
c	On the first time through, calculate scaling factors.
c
	if (.not. first) go to 200
	factmf = FLOAT(ixsize) / xmax
	ytest  = FLOAT(iysize) / ymax
	if (ytest .lt. factmf) factmf = ytest
	first = .FALSE.
c
c	Transform input file coordinate to LA100 coordinate
c
  200	ix = IFIX (FLOAT(ixmf) * factmf)
	iy = IFIX (FLOAT(iymf) * factmf)
	if (irotat .eq. 0) go to 300
	ixtemp = ix
	ix = iy
	iy = iysize - ixtemp
c
  300	ix = ix + ixoffs
	ixdev = ix
	iy = iy + iyoffs
	iydev = iy
	return
c
	end
���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������