	SUBROUTINE ALLOC_HP

**-	SUBROUTINE ALLOC_HP
**- subroutine opens and allocates the hpaint device
**- put line ($ define hpaint _txb0:) in your login.com
**- include (common /hp_lun/ hp_unit<i>) to get logical unit number

	INCLUDE '($IODEF)'
	INCLUDE '($TTDEF)'
	INCLUDE '($TT2DEF)'

	INTEGER HP_UNIT
 	INTEGER*4 STATUS,TER_SIZ
	INTEGER*2 OUTPUT_CHAN
	INTEGER*4 SYS$ALLOC,SYS$ASSIGN,SYS$DASSGN,SYS$QIO 
	CHARACTER ESC
	STRUCTURE/TERMINAL_CAR/
           BYTE CLASS,TYPE
           INTEGER*2 PAGEWIDTH
           INTEGER*4 SET1,SET2    
        END STRUCTURE
	STRUCTURE/IOSTAT_BLOCK2/
	   INTEGER*2 IOSTATUS,SPEED
           BYTE CRFIL,LFFIL,PARITY,DUM
	END STRUCTURE
	RECORD/IOSTAT_BLOCK2/ IOSB2
	RECORD/TERMINAL_CAR/ TERCAR
	PARAMETER(TER_SIZ=12)
	PARAMETER (ESC=CHAR(27))

	COMMON /HP_LUN/ HP_UNIT
	SAVE /HP_LUN/

	CALL GET_LUN(HP_UNIT)
	STATUS=SYS$ALLOC(%DESCR('HPAINT'),,,)
	STATUS=SYS$ASSIGN(%DESCR('HPAINT'),%REF(OUTPUT_CHAN),,)
	IF(.NOT.STATUS) CALL LIB$SIGNAL(%VAL(STATUS))
	STATUS= SYS$QIO(,
     &	      		%VAL(OUTPUT_CHAN),
     &			%VAL(IO$_SENSEMODE),
     &			%REF(IOSB2),,,
     &			%REF(TERCAR),
     &			%VAL(TER_SIZ),,,,)
	IF(.NOT.STATUS) CALL LIB$SIGNAL(%VAL(STATUS))
        TERCAR.SET2=TERCAR.SET2.OR.TT2$M_PASTHRU
        TERCAR.SET1=TERCAR.SET1.OR.TT$M_NOBRDCST 
        TERCAR.SET1=TERCAR.SET1.OR.TT$M_MECHFORM 
        TERCAR.SET1=TERCAR.SET1.OR.TT$M_MECHTAB 
        TERCAR.SET1=TERCAR.SET1.OR.TT$M_NOECHO 
        TERCAR.SET1=TERCAR.SET1.AND.(.NOT.TT$M_WRAP) 
	STATUS= SYS$QIO(,
     &			%VAL(OUTPUT_CHAN),
     &			%VAL(IO$_SETMODE),
     &			%REF(IOSB2),,,
     &			%REF(TERCAR),
     &			%VAL(TER_SIZ),,,,)
	IF(.NOT.STATUS) CALL LIB$SIGNAL(%VAL(STATUS))
	STATUS=SYS$DASSGN(%VAL(OUTPUT_CHAN))
	OPEN(HP_UNIT,STATUS='UNKNOWN',FILE='HPAINT',RECL=512)
	RETURN
	END

	SUBROUTINE DALLOC_HP

**-	SUBROUTINE DALLOC_HP
**- subroutine closes and deallocates the hpaint device

	INTEGER HP_UNIT
 	INTEGER*4 STATUS
	INTEGER*4 SYS$DALOC 

	COMMON /HP_LUN/ HP_UNIT
                                              
	CLOSE (HP_UNIT)
	STATUS=SYS$DALLOC(%DESCR('HPAINT'),)
	RETURN
	END

	SUBROUTINE SPEKTER1_HP

**-	SUBROUTINE SPEKTER1_HP
**- define 16 colours specter no.1

	INTEGER HP_UNIT
        CHARACTER ESC,PALETA(3,16)*2
	PARAMETER (ESC=CHAR(27))
	COMMON /HP_LUN/ HP_UNIT

	DATA PALETA /'90','88','85', '20',' 5','21', '10',' 4','27',
     &		     ' 4',' 5','32', ' 3','10','46', ' 2','22','64',
     &		     ' 3','30','41', '11','39','21', '30','53','16',
     &		     '89','83','13', '74','44','16', '63','20','15',
     &		     '53',' 8','14', '27','11','11', '22','14','17',
     &		     ' 4',' 4',' 6'/
	WRITE(HP_UNIT,'($,''+'',A)') ESC//'*r4U'   !16 clors	  
	DO I=1,16
	  WRITE(HP_UNIT,'($,''+'',A)') ESC//'*v'//PALETA(1,I)//'A'
	  WRITE(HP_UNIT,'($,''+'',A)') ESC//'*v'//PALETA(2,I)//'B'
	  WRITE(HP_UNIT,'($,''+'',A)') ESC//'*v'//PALETA(3,I)//'C'
	  WRITE(HP_UNIT,'($,''+'',A,I2,A)') ESC//'*v',I-1,'I'
	ENDDO
	RETURN
	END

	SUBROUTINE SPEKTER2_HP

**-	SUBROUTINE SPEKTER2_HP
**- define 16 colours specter no.2

	INTEGER HP_UNIT
        CHARACTER ESC,PALETA(3,16)*2
	PARAMETER (ESC=CHAR(27))
	COMMON /HP_LUN/ HP_UNIT

	DATA PALETA /'90','88','85', '37','58','49', '28','58','45',
     &		     '12','40','28', '15','41','30',  '9','39','27',
     &		      '5','30','23',  '4','30','24',  '5','20','17',
     &		      '4','16','16',  '8','19','20',  '6','11','14',
     &		      '5','11','11',  '4', '9','11',  '4', '6', '8',
     &		      '4', '4', '6'/
	WRITE(HP_UNIT,'($,''+'',A)') ESC//'*r4U'   !16 clors	  
	DO I=1,16
	  WRITE(HP_UNIT,'($,''+'',A)') ESC//'*v'//PALETA(1,I)//'A'
	  WRITE(HP_UNIT,'($,''+'',A)') ESC//'*v'//PALETA(2,I)//'B'
	  WRITE(HP_UNIT,'($,''+'',A)') ESC//'*v'//PALETA(3,I)//'C'
	  WRITE(HP_UNIT,'($,''+'',A,I2,A)') ESC//'*v',I-1,'I'
	ENDDO
	RETURN
	END

	SUBROUTINE SPEKTER3_HP

**-	SUBROUTINE SPEKTER3_HP
**- define 8 colours specter no.3 (paw)
**- white, black, red, green, blue, yellow, magenta, cyan

	INTEGER HP_UNIT
        CHARACTER ESC,PALETA(3,8)*2
	PARAMETER (ESC=CHAR(27))
	COMMON /HP_LUN/ HP_UNIT

	DATA PALETA /'90','88','85', '4','4','6', '53','8','14',
     &		     '3','26','22', '4','4','29',  '89','83','13',
     &		      '53','5','25',  '2','22','64'/ 
	WRITE(HP_UNIT,'($,''+'',A)') ESC//'*r3U'   !8 clors	  
	DO I=1,8
	  WRITE(HP_UNIT,'($,''+'',A)') ESC//'*v'//PALETA(1,I)//'A'
	  WRITE(HP_UNIT,'($,''+'',A)') ESC//'*v'//PALETA(2,I)//'B'
	  WRITE(HP_UNIT,'($,''+'',A)') ESC//'*v'//PALETA(3,I)//'C'
	  WRITE(HP_UNIT,'($,''+'',A,I2,A)') ESC//'*v',I-1,'I'
	ENDDO
	RETURN
	END
                      
	SUBROUTINE HIST2D_HP(SLIKA,NDIMX,NDIMY,IBINX,IBINY,HOROFF)

**-	SUBROUTINE HIST2D_HP(SLIKA,NDIMX,NDIMY,IBINX,IBINY,HOROFF)
**- risanje dvodimenzionalnega histograma z ink_jet printerjem
**- input parameters: slika<r> - 2D histogran
**-                   ndim<i> - dimenzija histograma (x,y smer)
**-		      ibin<i> - sirina bina (x,y smer)
**-		      horoff<i> - levi rob v tockah (ce je negative
**-				  potem je slika centrirana)	

	INTEGER HP_UNIT
	CHARACTER ESC,LF
	BYTE MASK(8)
	REAL SLIKA(NDIMX,NDIMY),MAXSL,BREZ,TREZ,SLOFF
	INTEGER HOROFF
	STRUCTURE /RDAT/
	  UNION
	    MAP
	      CHARACTER*90 VRSTA(4)
	    ENDMAP
	    MAP
	      BYTE VRSTAB(90,4)
	    ENDMAP
	  ENDUNION
	ENDSTRUCTURE      
	RECORD /RDAT/ OUTV
	PARAMETER (LF=CHAR(10))
	PARAMETER (ESC=CHAR(27))
	COMMON /HP_LUN/ HP_UNIT
        COMMON /REZI/ BREZ,TREZ
	DATA BREZ,TREZ /0,1/
	DATA MASK /1,2,4,8,16,32,64,-128/
	IF (NDIMX*IBINX.GT.720) GOTO 10
	IF (HOROFF.LT.0) THEN
	  HOROFF=(720-NDIMX*IBINX)/2
	 ELSE
	  HOROFF=MIN(HOROFF,720-NDIMX*IBINX)
	ENDIF
	MAXSL=0
	DO J=1,NDIMY
	  DO I=1,NDIMX
	    MAXSL=MAX(MAXSL,SLIKA(I,J))
	  ENDDO
	ENDDO
	IF (MAXSL.EQ.0) MAXSL=1
	SLOFF=BREZ*MAXSL
	MAXSL=MAXSL*TREZ-SLOFF
	WRITE(HP_UNIT,'($,''+'',A)') ESC//'*t90R'  !raster_90		
	CALL SPEKTER1_HP
	WRITE(HP_UNIT,'($,''+'',A)') ESC//'*r0A'   !raster_start
	WRITE(HP_UNIT,'($,''+'',A)') ESC//'*b0M'
	DO J=NDIMY,1,-1
	  DO IJ=1,4
	    DO JI=1,90
	      OUTV.VRSTAB(JI,IJ)=0
	    ENDDO
	  ENDDO
	  DO I=1,NDIMX
	    ICOLOR=INT((SLIKA(I,J)-SLOFF)*16/MAXSL)
	    ICOLOR=MAX(ICOLOR,0)
	    ICOLOR=MIN(ICOLOR,15)
	    ICOLOR=15-ICOLOR
	    DO K=0,IBINX-1
	      IXPOINT=HOROFF+(I-1)*IBINX+K
	      IXBYTE=IXPOINT/8+1
	      IXBIT=8-MOD(IXPOINT,8)
	      DO L=0,3
		IF (BTEST(ICOLOR,L)) OUTV.VRSTAB(IXBYTE,L+1)=
     &		OUTV.VRSTAB(IXBYTE,L+1)+MASK(IXBIT)
	      ENDDO
	    ENDDO 
	  ENDDO
	  DO L=1,IBINY
	    DO K=1,3
	      WRITE(HP_UNIT,'($,''+'',A)') ESC//'*b90V'//OUTV.VRSTA(K)
            ENDDO
	    WRITE(HP_UNIT,'($,''+'',A)') ESC//'*b90W'//OUTV.VRSTA(4)
	  ENDDO
	ENDDO
	WRITE(HP_UNIT,'($,''+'',A)') ESC//'*r0B'//LF	
10	RETURN
	END
                      
	SUBROUTINE HIST2X2D_HP(SLIKA1,SLIKA2,NDIMX,NDIMY,IBINX,IBINY)

**-	SUBROUTINE HIST2X2D_HP(SLIKA1,SLIKA2,NDIMX,NDIMY,IBINX,IBINY)
**- risanje 2 x dvodimenzionalnega histograma z ink_jet printerjem
**- input parameters: slika<r> - 2D histograma (levi in desni)
**-                   ndim<i> - dimenzija histograma (x,y smer)
**-		      ibin<i> - sirina bina (x,y smer)	

	INTEGER HP_UNIT
	CHARACTER ESC,LF
	BYTE MASK(8)
	REAL SLIKA1(NDIMX,NDIMY),SLIKA2(NDIMX,NDIMY)
	REAL MAXSL(2),BREZ(2),TREZ(2),SLOFF(2)
	INTEGER HOROFF                        ! ,NSTB(4)
	STRUCTURE /RDAT/
	  UNION
	    MAP
	      CHARACTER*90 VRSTA(4)
	    ENDMAP
	    MAP
	      BYTE VRSTAB(90,4)
	    ENDMAP
	  ENDUNION
	ENDSTRUCTURE      
	RECORD /RDAT/ OUTV
	PARAMETER (LF=CHAR(10))
	PARAMETER (ESC=CHAR(27))
	COMMON /HP_LUN/ HP_UNIT
        COMMON /REZI2/ BREZ,TREZ
	DATA BREZ,TREZ /0,0,1,1/
	DATA MASK /1,2,4,8,16,32,64,-128/
	HOROFF=NDIMX*IBINX*2
	IF (HOROFF.GT.720) GOTO 10
	HOROFF=(720-HOROFF)/3
	MAXSL(1)=0
	MAXSL(2)=0
	DO J=1,NDIMY
	  DO I=1,NDIMX
	    MAXSL(1)=MAX(MAXSL(1),SLIKA1(I,J))
	    MAXSL(2)=MAX(MAXSL(2),SLIKA2(I,J))
	  ENDDO
	ENDDO
	IF (MAXSL(1).EQ.0) MAXSL(1)=1
	IF (MAXSL(2).EQ.0) MAXSL(2)=1
	SLOFF(1)=BREZ(1)*MAXSL(1)          
	MAXSL(1)=MAXSL(1)*TREZ(1)-SLOFF(1)
	SLOFF(2)=BREZ(2)*MAXSL(2)
	MAXSL(2)=MAXSL(2)*TREZ(2)-SLOFF(2)
	WRITE(HP_UNIT,'($,''+'',A)') ESC//'*t90R'  !raster_90		
	CALL SPEKTER1_HP
	WRITE(HP_UNIT,'($,''+'',A)') ESC//'*r0A'   !raster_start
	WRITE(HP_UNIT,'($,''+'',A)') ESC//'*b0M'
	DO J=NDIMY,1,-1
	  DO IJ=1,4
	    DO JI=1,90
	      OUTV.VRSTAB(JI,IJ)=0
	    ENDDO
	  ENDDO
	  DO I=1,NDIMX
	    ICOLOR=INT((SLIKA1(I,J)-SLOFF(1))*16/MAXSL(1))
	    ICOLOR=MAX(ICOLOR,0)
	    ICOLOR=MIN(ICOLOR,15)
	    ICOLOR=15-ICOLOR
	    DO K=0,IBINX-1
	      IXPOINT=HOROFF+(I-1)*IBINX+K
	      IXBYTE=IXPOINT/8+1
	      IXBIT=8-MOD(IXPOINT,8)
	      DO L=0,3
		IF (BTEST(ICOLOR,L)) OUTV.VRSTAB(IXBYTE,L+1)=
     &		OUTV.VRSTAB(IXBYTE,L+1)+MASK(IXBIT)
	      ENDDO
	    ENDDO 
	  ENDDO
	  IXPOINT_STAR=IXPOINT+HOROFF+1
	  DO I=1,NDIMX
	    ICOLOR=INT((SLIKA2(I,J)-SLOFF(2))*16/MAXSL(2))
	    ICOLOR=MAX(ICOLOR,0)
	    ICOLOR=MIN(ICOLOR,15)
	    ICOLOR=15-ICOLOR
	    DO K=0,IBINX-1
	      IXPOINT=IXPOINT_STAR+(I-1)*IBINX+K
	      IXBYTE=IXPOINT/8+1
	      IXBIT=8-MOD(IXPOINT,8)
	      DO L=0,3
		IF (BTEST(ICOLOR,L)) OUTV.VRSTAB(IXBYTE,L+1)=
     &		OUTV.VRSTAB(IXBYTE,L+1)+MASK(IXBIT)
	      ENDDO
	    ENDDO 
	  ENDDO
	  DO L=1,IBINY
	    DO K=1,3
	      WRITE(HP_UNIT,'($,''+'',A)') ESC//'*b90V'//OUTV.VRSTA(K)
	    ENDDO
	    WRITE(HP_UNIT,'($,''+'',A)') ESC//'*b90W'//OUTV.VRSTA(4)
	  ENDDO
	ENDDO
	WRITE(HP_UNIT,'($,''+'',A)') ESC//'*r0B'//LF//LF	
10	RETURN                            
	END

	SUBROUTINE PLSPEK_HP 

**-	SUBROUTINE PLSPEK_HP 
**- risanje spektra

	INTEGER HP_UNIT
	CHARACTER ESC,LF,OO,FF,B1,B2
	INTEGER HOROFF
	COMMON /HP_LUN/ HP_UNIT
	PARAMETER (OO=CHAR(0))
	PARAMETER (FF=CHAR(255))
	PARAMETER (B1=CHAR(128))
	PARAMETER (B2=CHAR(1))
	PARAMETER (LF=CHAR(10))
	PARAMETER (ESC=CHAR(27))
	CHARACTER*48 VRSTA1(4),VRSTA2(4)
	CHARACTER VRSTAB(48,4)
	DATA VRSTAB /3*FF,3*OO,3*FF,3*OO,3*FF,3*OO,3*FF,3*OO,
     &		3*FF,3*OO,3*FF,3*OO,3*FF,3*OO,3*FF,B1,OO,B2,
     &		6*FF,6*OO,6*FF,6*OO,6*FF,6*OO,6*FF,3*OO,B1,OO,B2,
     &		12*FF,12*OO,12*FF,9*OO,B1,OO,B2,
     &		24*FF,21*OO,B1,OO,B2/ 
	DO I=1,4
	  DO J=1,48
	    VRSTA1(I)(J:J)=VRSTAB(J,I)
	  ENDDO
	ENDDO
	DO I=1,4
	  VRSTA2(I)=VRSTA1(I)(1:45)//FF//FF//FF
	ENDDO
	WRITE(HP_UNIT,'($,''+'',A)') LF//ESC//'*r0A'
	WRITE(HP_UNIT,'($,''+'',A)') ESC//'*b0M'
	WRITE(HP_UNIT,'($,''+'',A)') ESC//'*b8Y'
	WRITE(HP_UNIT,'($,''+'',A)') ESC//'*b168X'
	DO K=1,3
	  WRITE(HP_UNIT,'($,''+'',A)') ESC//'*b48V'//VRSTA2(K)
        ENDDO
	WRITE(HP_UNIT,'($,''+'',A)') ESC//'*b48W'//VRSTA2(4)
	DO L=1,6
	  WRITE(HP_UNIT,'($,''+'',A)') ESC//'*b168X'
	  DO K=1,3
	    WRITE(HP_UNIT,'($,''+'',A)') ESC//'*b48V'//VRSTA1(K)
          ENDDO
	  WRITE(HP_UNIT,'($,''+'',A)') ESC//'*b48W'//VRSTA1(4)
	ENDDO
	WRITE(HP_UNIT,'($,''+'',A)') ESC//'*b168X'
	DO K=1,3
	  WRITE(HP_UNIT,'($,''+'',A)') ESC//'*b48V'//VRSTA2(K)
        ENDDO
	WRITE(HP_UNIT,'($,''+'',A)') ESC//'*b48W'//VRSTA2(4)
	WRITE(HP_UNIT,'($,''+'',A)') ESC//'*r0B'//LF
	WRITE(HP_UNIT,'($,''+'',A)') ESC//'&k2S'
	WRITE(HP_UNIT,'($,''+'',A)') ESC//'&a1344H0'
	WRITE(HP_UNIT,'($,''+'',A)') ESC//'&a2827H0.5'
	WRITE(HP_UNIT,'($,''+'',A)') ESC//'&a4384H1'//LF
	WRITE(HP_UNIT,'($,''+'',A)') ESC//'&k0S'
	RETURN
	END
                      
	SUBROUTINE COL2D_HP(BITMAP,NDIMX,NDIMY,IBINX,IBINY,HOROFF)

**-	SUBROUTINE COL2D_HP(BITMAP,NDIMX,NDIMY,IBINX,IBINY,HOROFF)
**- risanje color mape ink_jet printerjem, uporabljen je spekter z osmimi
**- barvami st. 3
**- input parameters: bitmap<b> - color mapa
**-                   ndim<i> - dimenzija histograma (x,y smer)
**-		      ibin<i> - sirina bina (x,y smer)
**-		      horoff<i> - levi rob v tockah (ce je negative
**-				  potem je slika centrirana)	

	INTEGER HP_UNIT
	CHARACTER ESC,LF
	BYTE MASK(8),BITMAP(NDIMX,NDIMY)
	INTEGER HOROFF
	STRUCTURE /RDAT/
	  UNION
	    MAP
	      CHARACTER*180 VRSTA(3)
	    ENDMAP
	    MAP
	      BYTE VRSTAB(180,3)
	    ENDMAP
	  ENDUNION
	ENDSTRUCTURE      
	RECORD /RDAT/ OUTV
	PARAMETER (LF=CHAR(10))
	PARAMETER (ESC=CHAR(27))
	COMMON /HP_LUN/ HP_UNIT
	DATA MASK /1,2,4,8,16,32,64,-128/
	IF (NDIMX*IBINX.GT.1440) GOTO 10
	IF (HOROFF.LT.0) THEN
	  HOROFF=(1440-NDIMX*IBINX)/2
	 ELSE
	  HOROFF=MIN(HOROFF,1440-NDIMX*IBINX)
	ENDIF
	WRITE(HP_UNIT,'($,''+'',A)') ESC//'*t180R'  !raster_180		
	CALL SPEKTER3_HP
	WRITE(HP_UNIT,'($,''+'',A)') ESC//'*r0A'   !raster_start
	WRITE(HP_UNIT,'($,''+'',A)') ESC//'*b0M'
	DO J=NDIMY,1,-1
	  DO IJ=1,3
	    DO JI=1,180
	      OUTV.VRSTAB(JI,IJ)=0
	    ENDDO
	  ENDDO
	  DO I=1,NDIMX
	    ICOLOR=BITMAP(I,J)
	    DO K=0,IBINX-1
	      IXPOINT=HOROFF+(I-1)*IBINX+K
	      IXBYTE=IXPOINT/8+1
	      IXBIT=8-MOD(IXPOINT,8)
	      DO L=0,2
		IF (BTEST(ICOLOR,L)) OUTV.VRSTAB(IXBYTE,L+1)=
     &		OUTV.VRSTAB(IXBYTE,L+1)+MASK(IXBIT)
	      ENDDO
	    ENDDO 
	  ENDDO
	  DO L=1,IBINY
	    DO K=1,2
	      WRITE(HP_UNIT,'($,''+'',A)') ESC//'*b180V'
     &		//OUTV.VRSTA(K)
            ENDDO
	    WRITE(HP_UNIT,'($,''+'',A)') ESC//'*b180W'
     &		//OUTV.VRSTA(3)
	  ENDDO
	ENDDO
	WRITE(HP_UNIT,'($,''+'',A)') ESC//'*r0B'//LF	
10	RETURN
	END
