SUBROUTINE GRATS(IU) C initializes graphics on unit IU COMMON/GRATSUNIT/IUNIT IUNIT=IU OPEN(IUNIT,FILE='RAWVDU:',FORM='PRINTER') RETURN END SUBROUTINE COLOUR(K) C sets colour for text (*VDU17,K) COMMON/GRATSUNIT/IUNIT WRITE(IUNIT,101)?I112A,K 101 FORMAT(A2,4A1) RETURN END SUBROUTINE DRAW(IX,IY) C SIMILAR TO BASIC DRAW COMMAND line to point IX,IY C (*VDU25,5,IX;IY;) COMMON/GRATSUNIT/IUNIT WRITE(IUNIT,102)?I05192A,IX,IY 102 FORMAT(A3,5A2) RETURN END SUBROUTINE GCOL(M,K) C similar to BASIC GCOL same arguments M=operation K=col no C (*VDU18,M,K) COMMON/GRATSUNIT/IUNIT WRITE(IUNIT,101)?I122A,M,K 101 FORMAT(A2,4A1) RETURN END SUBROUTINE GWIND(IX1,IY1,IX2,IY2) C make graphics window COMMON/GRATSUNIT/IUNIT WRITE(IUNIT,101)?I182A,IX1,IY1,IX2,IY2 101 FORMAT(5A2) RETURN END SUBROUTINE LINE(IX1,IY1,IX2,IY2) C DRAWS A LINE FROM IX1,IY1 TO IX2,IY2 in current colour C (*VDU25,4,IX1;IY1;25,5,IX2;IY2;) COMMON/GRATSUNIT/IUNIT WRITE(IUNIT,102)?I04192A,IX1,IY1,?I0519,IX2,IY2 102 FORMAT(A3,5A2) RETURN END SUBROUTINE MODE(M) C simulates the BASIC MODE command *VDU22,M COMMON/GRATSUNIT/IUNIT WRITE(IUNIT,101)?I162A,M 101 FORMAT(A2,4A1) RETURN END SUBROUTINE MOVE(IX,IY) C MOVES THE GRAPHICS CURSOR TO THE point IX,IY C (*VDU25,4,IX;IY;) COMMON/GRATSUNIT/IUNIT WRITE(IUNIT,102)?I04192A,IX,IY 102 FORMAT(A3,5A2) RETURN END SUBROUTINE PLOT(IPL,IX,IY) C PLOT operation IPL C (*VDU25,IPL,IX;IY;) COMMON/GRATSUNIT/IUNIT WRITE(IUNIT,102)?I192A,IPL,IX,IY 102 FORMAT(A2,A1,2A2) RETURN END SUBROUTINE PLOT85(IX,IY) C DRAWS SOLID TRIANGLE AT IX,IY FROM TWO PREVIOUS POINTS C (*VDU25,4,IX;IY;) COMMON/GRATSUNIT/IUNIT WRITE(IUNIT,102)?I55192A,IX,IY 102 FORMAT(A3,5A2) RETURN END SUBROUTINE POLY(N,IX,IY) DIMENSION IX(*),IY(*) C fills n-polygon CALL MOVE(IX(2),IY(2)) DO 10 I=3,N CALL MOVE(IX(1),IY(1)) 10 CALL PLOT85(IX(I),IY(I)) RETURN END SUBROUTINE PRDUMP(NLINES) C Screen dump for modes 0 to 5 C NLINES = no of lines to dump <32 >0 CHARACTER*1 BUF(960),INTRO(5) INTEGER STREAM,BTEST DIMENSION IPALET(0:15),IPARM(2),IC(5),IYS(5),NXS(5),LOCS(5), +IPIX(6,0:7),NPB(5),NBT(5),IPC(8,4) DATA IC/1,3,15,1,3/,IYS/1,3,6,3,6/,NXS/80,80,80,40,40/ DATA NBT/1,2,4,1,2/,LOCS/3*?IFFFF3000,2*?IFFFF5800/,NPB/8,4,2,8,4/ DATA INTRO(1)/?H1B/,INTRO(2)/?H2A/ DATA IPIX/0,0,0,0,0,0, 2,1,0,2,1,0, 2,1,2,1,2,1, + 2,3,3,1,3,3, 2,0,0,1,0,0, 2,3,0,1,3,0, + 3,1,2,3,2,1, 3,3,3,3,3,3/ C colours: black, red, green C yellow, blue, magenta C cyan, white. C C check no lines to dump LINES=MAX(1,MIN(32,NLINES)) C get screen mode I=IFXOSbyte(MODE,I,135,0,0) IF(MODE.GT.5.OR.MODE.EQ.3) RETURN IF(MODE.LT.3) MODE=MODE+1 C get palette DO 10 I=0,IC(MODE) IPARM(1)=I CALL IFOSWord(11,IPARM) 10 IPALET(I)=IPARM(1)/256 C open print file STREAM=IFXFindOutput('rawlp:') C set line spacing CALL IFXSBlockWriteI(STREAM,3,?I18331B) C set introductory bytes for each line IF(MODE.GT.1) THEN INTRO(3)=CHAR(1) ELSE INTRO(3)=CHAR(4) ENDIF C initialize screen pointer IPS=LOCS(MODE) C loop over row pairs DO 70 IY2=1,LINES C loop over rows in pair DO 60 IY1=1,2 IPARM(1)=IPS NB=0 NBITS=0 C loop over column sets DO 50 IX2=1,NXS(MODE) C get 4 bytes DO 20 I=1,4 CALL IFXOSword(5,IPARM) IPARM(1)=IPARM(1)+1 C decode into physical colours DO 20 J=1,NPB(MODE) K=0 J1=8-J DO 15 L=1,NBT(MODE) K=K+K+BTEST(IPARM(2),J1) 15 J1=J1-NPB(MODE) 20 IPC(J,I)=IPALET(K) C reset pointer IPARM(1)=IPARM(1)+4 C loop over columns in set DO 40 IX1=1,NPB(MODE) C make IYS bytes / x pixel DO 40 J=1,IYS(MODE) JB=0 C put in the 4 Y pixels DO 30 I=1,4 30 JB=4*JB+IPIX(J,IPC(IX1,I)) NB=NB+1 C count hits IF(JB.NE.0) NBITS=NB C store byte 40 BUF(NB)=CHAR(JB) C increment X 50 CONTINUE IF(NB.NE.960.AND.MODE.GT.1) STOP 960 IF(NB.NE.640.AND.MODE.EQ.1) STOP 960 C print line if there are hits IF(NBITS.NE.0) THEN INTRO(4)=CHAR(MOD(NBITS,256)) INTRO(5)=CHAR(NBITS/256) C print header CALL IFXSBlockWriteC(STREAM,5,INTRO) C print buffer CALL IFXSBlockWriteC(STREAM,NBITS,BUF) ENDIF C then newline CALL IFXSBlockWriteI(STREAM,1,13) 60 IPS=IPS+4 IPS=IPARM(1)-4 70 CONTINUE C reset printer IF(LINES.EQ.32)CALL IFXSBlockWriteI(STREAM,3,?I0C321B) C close file CALL IFXCloseStream(STREAM) RETURN END SUBROUTINE RECTAN(IX1,IY1,IX2,IY2) C DRAWS a rectangle with lower left IX1,IY1, upper right IX2,IY2 C (*VDU25,4,IX1;IY1;25,101,IX2+IY2;) COMMON/GRATSUNIT/IUNIT WRITE(IUNIT,102)?I04192A,IX1,IY1,?I6519,IX2,IY2 102 FORMAT(A3,5A2) RETURN END SUBROUTINE SPOT(IX,IY) C plots a single point at IX,IY in current colour C (*VDU25,69,IX;IY;) COMMON/GRATSUNIT/IUNIT WRITE(IUNIT,102)?I45192A,IX,IY 102 FORMAT(A3,5A2) RETURN END SUBROUTINE TAB(IX,IY) COMMON/GRATSUNIT/IUNIT C move cursor to IX,IY (text) WRITE(IUNIT,103)31,IX,IY 103 FORMAT('*',3A1) RETURN END SUBROUTINE VDU(I) C SEND A single VDU COMMAND COMMON/GRATSUNIT/IUNIT WRITE(IUNIT,103)I 103 FORMAT('*',A1) RETURN END SUBROUTINE VDU19(I1,I2) COMMON/GRATSUNIT/IUNIT C VDU 19 - define physical colour WRITE(IUNIT,103)19,I1,I2,0 103 FORMAT('*',3A1,A3) RETURN END SUBROUTINE VDU23(I1,I2,I3,I4,I5,I6,I7,I8,I9) COMMON/GRATSUNIT/IUNIT C VDU 23 - define character etc. WRITE(IUNIT,103)23,I1,I2,I3,I4,I5,I6,I7,I8,I9 103 FORMAT('*',10A1) RETURN END SUBROUTINE WINDOW(IX1,IY1,IX2,IY2) C sets up a text window C (*VDU28,IX1,IY1,IX2,IY2) COMMON/GRATSUNIT/IUNIT WRITE(IUNIT,101)?I1C2A,IX1,IY1,IX2,IY2 101 FORMAT(A2,4A1) RETURN END