        SUBROUTINE hpDRIV(IFUNC,RBUF,NBUF,CHR,LCHR)
	integer IFUNC, NBUF,LCHR
        REAL      RBUF(*)
        CHARACTER*45 CHR
	integer ixdim,iydim,lenbuf,ICOL
	include "driv.inc"
	data ixdim,iydim,lenbuf,lun,ICOL/292, 3200, 934400,99,0/
	if(ifunc.eq.28)goto 280
        GOTO( 10, 20, 30, 40, 50, 60, 70,999, 90,100,
     &       110,120,130,140,150) IFUNC
        GOTO 999
C--- IFUNC= 1, Return device name.
C
10      CHR='HP      (jiang, portrait  for hp_printer)'                   !
	NBUF=0
        LCHR=LEN(CHR)
        RETURN
C--- IFUNC= 2, Return Physical min and max for plot device.
20      RBUF(1)=0
        RBUF(2)=2335                    !
        RBUF(3)=0
        RBUF(4)=3199                    !
        RBUF(5)=0
        RBUF(6)=1
        NBUF=6
        LCHR = 0
        RETURN
C--- IFUNC= 3, Return device (X and Y) resolution in pixels per inch as
30      RBUF(1)=300.0
        RBUF(2)=300.0
        RBUF(3)=1
        NBUF=3
        LCHR=0
        RETURN
C--- IFUNC= 4, Return misc device info.
40      CHR='HNNNNNNNNN'
	NBUF =0
        LCHR=10
        RETURN
C--- IFUNC= 5, Return default file name.
50      CHR='pgplot.hp'
	NBUF=0
        LCHR=LEN(CHR)
        RETURN
C--- IFUNC= 6, Return default physical size of plot.
60      RBUF(1)=0
        RBUF(2)=2335                    !
        RBUF(3)=0
        RBUF(4)=3199                    !
	NBUF=4
	LCHR=0
        RETURN
C--- IFUNC= 7, Return misc defaults.
70      RBUF(1)=1
        NBUF=1
	LCHR=0
        RETURN
C--- IFUNC= 9, Open workstation.
90      CALL grglun(lun)
	call unlink(CHR(:LCHR))
        OPEN(UNIT=lun,FILE=CHR(:LCHR),STATUS='NEW',IOSTAT=IER)
        IF(IER.NE.0) THEN
            CALL GRWARN('Cannot open graphics device '//CHR(:LCHR))
            RBUF(1)=lun
            RBUF(2)=0
	    close (lun)
		goto 999
        ELSE
            RBUF(1)=0
            RBUF(2)=1
        END IF
	call hpbuf0(934400,PIXMAP)
        RETURN
C--- IFUNC=10, Close workstation.
100	close (lun)
        RETURN
C--- IFUNC=11, Begin Picture.  Note, IXMIN=0 and IXMAX=RBUF(1) so,
C--- IXDIM=IXMAX-IXMIN+1=RBUF(1)+1
110     IxDIM=INT(RBUF(1)/8.)+1  
        IyDIM=RBUF(2)+1           
        LENBUF=IxDIM*IyDIM
        call grhp02(PIXMAP,lenbuf)
        RETURN
C--- IFUNC=12, Draw line.
120     continue
        CALL GRhp01(1,RBUF,ICOL,IxDIM,PIXMAP)
        RETURN
C--- IFUNC=13, Draw dot.
130     CALL GRhp01(0,RBUF,ICOL,IxDIM,PIXMAP)
        RETURN
C--- IFUNC=14, End picture.
140     CALL GRhp04(LUN,PIXMAP,IxDIM,IyDIM)
        RETURN
C--- IFUNC=15, Select pen.  Save pen number (up to 11) for
C--- possible use in pattern interior.
150     ICOL=MAX(0,MIN(NINT(RBUF(1)),11))
        RBUF(1)=MAX(0,MIN(ICOL,1))
        RETURN
C--- Flag function not implemented.
999     NBUF=-1
        RETURN

c      for gray scale raster
280	call grhp03(rbuf,ixdim,PIXMAP)
	return
        END

	subroutine hpbuf0(k,buf)
	byte buf(1)
	do i=1,k
	buf(i)=0
	enddo
	end

        SUBROUTINE GRhp01(LINE,RBUFI,ICOL,IXDIM,QXYBUF)         !
	integer*2 qxybuf(0:*),qmask(0:15),i2
        REAL    RBUFI(4),RBUF(4)  
        DATA   QMASK /32768,16384,8192,4096,
     *              2048,1024,512,256,128,64,32,16,8,4,2,1/
c	write(*,*)line,rbufi,icol,ixdim
        RBUF(1)=rbufi(1)   
        RBUF(2)=3199-rbufi(2)
        RBUF(3)=rbufi(3)      
        RBUF(4)=3199-rbufi(4)   
	ixd2=ixdim/2
        IF(LINE.GT.0) THEN
          LENGTH=NINT(MAX(ABS(RBUF(3)-RBUF(1)),
     &                    ABS(RBUF(4)-RBUF(2))))
          D = MAX(1,LENGTH)
          XINC = (RBUF(3)-RBUF(1))/D
          YINC = (RBUF(4)-RBUF(2))/D
        ELSE
            LENGTH=0
            XINC=0.
            YINC=0.
        END IF
        XP = RBUF(1)
        YP = RBUF(2)
        IF (ICOL.GT.0) THEN
            DO K=0,LENGTH
                KX = NINT(XP)
                KY = NINT(YP)
		kk=ky*ixd2+kx/16
                QXYBUF(kk) = IOR(QXYBUF(kk),QMASK(MOD(Kx,16)))
                XP = XP + XINC
                YP = YP + YINC
            END DO
        ELSE
            DO K=0,LENGTH
                KX = NINT(XP)
                KY = NINT(YP)
		kk=ky*ixd2+kx/16
	        i2= nnot(QMASK(MOD(kx,16)))
                QXYBUF(kk) = IAND(QXYBUF(kk),i2)
                XP = XP + XINC
                YP = YP + YINC
            END DO
        END IF
        RETURN
        END

	subroutine grhp02(buf,n)
	integer*2 buf(1)
	do 10 i=1,n/2
10	buf(i)=0
	end

	subroutine grhp03(rbuf,ixdim,qxybuf)
	integer*2 qxybuf(0:*),qmask(0:15)
	integer*2 ii(18),jj(18),ix,iy
        REAL    RBUF(*)  
        DATA   QMASK /32768,16384,8192,4096,
     *              2048,1024,512,256,128,64,32,16,8,4,2,1/
	data ii/0,0,1,0,-1,1,1,2,-1,-1,-2,0,0,2,-2,1,-1,0/
	data jj/0,1,0,-1,0,1,-1,0,1,-1,0,2,-2,1,1,2,2,3/
	ixd2=ixdim/2
        ix= rbuf(1)
        iy= 3199-rbuf(2)
	kz= nint(rbuf(3))
	if(kz.lt.1)return
	is=nint(rbuf(4))
	if(kz.gt.is)kz=is
	do 10 i=1,kz
	kx=ix+ii(i)
	ky=iy+jj(i)
	kk=ky*ixd2+kx/16
10      QXYBUF(kk) = IOR(QXYBUF(kk),QMASK(MOD(Kx,16)))
        END

        SUBROUTINE GRhp04(LUN,QBUF,IXDIM,IYDIM)
        BYTE QBUF(ixdim,iydim),a(300)
	character c*300,c_line*9,c_row*5,c_head*12,c_end*4
	byte init_hp(17),end_hp(5),v_line(9),
     *       h_row(5),line_head(12),line_end(4)
	equivalence (c,a),(c_line,v_line),(c_row,h_row),
     *              (c_head,line_head),(c_end,line_end)
	data init_hp/32,32,27,69,27,42,112,43,49,89,  ! init&.5 inch from top
     *               27,42,116,51,48,48,82/	! 300 dots/inch
	data v_line/27,42,112,43,5*0/		! down # pixel
	data h_row /5*0/			! right_shift # pixel
	data line_head/27,42,114,49,65,		! current curcor
     *                 27,42,98,3*0,87/		! raster nnn bytes
	data line_end/27,42,114,66/		! end line's raster
	data end_hp/27,38,108,48,72/	 	! eject paper


	call swap2(qbuf,ixdim*iydim)
	write(lun,'(17a1,$)')init_hp
	jj=0
	do 10 j=1,iydim
	do 15 i=1,ixdim
	if(qbuf(i,j).ne.0)goto 16
15	continue
16	ii=i-1
	l=5
	i=ii*8
	if(i.lt.1000)l=4
	if(i.lt.100)l=3
	if(i.lt.10)l=2
c	write(c_row(1:),'(i<l-1>)')i
	if(l.eq.5)write(c_row(1:),'(i4)')i
	if(l.eq.4)write(c_row(1:),'(i3)')i
	if(l.eq.3)write(c_row(1:),'(i2)')i
	if(l.eq.2)write(c_row(1:),'(i1)')i
	h_row(l)=88
	do 20 i=1,ixdim-ii
20	a(i)=qbuf(i+ii,j)	
	do 30 i=ixdim-ii,1,-1
	if(a(i).ne.0)goto 40
30	continue
40	k=i
	if(k.ne.0)then
	write(c_head(9:),'(i3.3)')k
	line_head(12)=87
	m=9
	if(jj.lt.1000)m=8
	if(jj.lt.100)m=7
	if(jj.lt.10)m=6
c	write(c_line(5:),'(i<m-5>)')jj
	if(m.eq.9)write(c_line(5:),'(i4)')jj
	if(m.eq.8)write(c_line(5:),'(i3)')jj
	if(m.eq.7)write(c_line(5:),'(i2)')jj
	if(m.eq.6)write(c_line(5:),'(i1)')jj
	v_line(m)=121
	write(lun,'(5a,$)')c_line(1:m),c_row(1:l),c_head,c(1:k),c_end
	jj=0
	else
	jj=jj+1
	endif
10	continue
	write(lun,'(5a1,$)')end_hp
        END

        function nnot(a)
        integer*2 a
        nnot=65535-a
        end

