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