*  BITMAPPING ROUTINES
******************************************************************************
*   THESE ROUTINES MANAGE THE BITMAP PICTURE
******************************************************************************
        SUBROUTINE BITDOT(IX,IY)           
*  THIS ROUTINE PLACES A DOT IN THE BITMAP AT LOCATION IX,IY
*   SCALING IS UP TO THE CALLING ROUTINES
        IMPLICIT INTEGER*2 (A-Z)        
        BYTE GRAPH(1050,200),BYTE(2)     
        COMMON /BITMAP/ IX1,IY1,IX2,IY2,GRAPH,MAXROW(200),MAXLIN
        COMMON /BITDEN/ NBITPC
        EQUIVALENCE (OPER,BYTE(1))      
C      **                               
        XDOT=IX+1                       
        YDOT=IY/ NBITPC + 1                     
C      **                               
        BYTE(2)=0                       
        BYTE(1)=GRAPH(XDOT,YDOT)        
C      **                               
        ORPAD=2**MOD(IY,NBITPC)
        OPER=OR(OPER,ORPAD)           
C      **                               
        GRAPH(XDOT,YDOT)=BYTE(1)        
        IF (MAXROW(YDOT).LT.XDOT) MAXROW(YDOT)=XDOT
        IF (MAXLIN.LT.YDOT) MAXLIN=YDOT
C      **
        RETURN                          
C      **                               
        END                             
C      **                               
C      **                               
        SUBROUTINE BITLIN(IX1,IY1,IX2,IY2)
*  DRAWS A LINE IN THE BITMAP VIA BITDOT
        IMPLICIT INTEGER*2 (A-Z)
        REAL M,B,X1,Y1,X2,Y2
C      ** 
C      **
        X1=IX1 
        X2=IX2 
        Y1=IY1 
        Y2=IY2 
C      **
        FLAG=0
        IF(X2 .NE. X1) GO TO 10
        M=0.
        GO TO 20
C      **
10     M=(Y2-Y1)/(X2-X1) 
        IF(ABS(M) .LT. 1.) GO TO 30
C      ** 
        M=1./M 
20     B=X1-M*Y1
        FIRST=Y1
        LAST=Y2 
        FLAG=1  
        GO TO 40
C      **
30     B=Y1-M*X1 
        FIRST=X1 
        LAST=X2 
C      **
40     STEP=1
        IF(FIRST .GT. LAST) STEP=-1     
C      **                               
        DO 100,X=FIRST,LAST,STEP        
        X1=X                            
        Y1=M*X1+B                       
        Y=Y1                            
        IF(FLAG .EQ. 0) CALL BITDOT(X,Y)   
        IF(FLAG .EQ. 1) CALL BITDOT(Y,X)   
100    CONTINUE                         
        RETURN                          
        END                             
C      **                               
        SUBROUTINE BMCLR
        IMPLICIT INTEGER*2 (A-Z)
        BYTE GRAPH(1050,200),BYTE(2)
        COMMON /BITMAP/ IX1,IY1,IX2,IY2,GRAPH,MAXROW(200),MAXLIN
C      **                           
        DO 20,I=1,200
        MAXROW(I)=0
        DO 10,J=1,1050
        GRAPH(J,I)=0
10     CONTINUE     
        MAXLIN=0
20     CONTINUE     
        RETURN      
C      **           
C      **           
        END         
C      **           
*********************************************************************
*   THESE ARE ROUTINES FOR THE IDS PAPER TIGER PRINTER
*          WHICH DO GRAPHICS VIA A BITMAP
*
        SUBROUTINE PTCLN                     
C      **                                      
C      ** CLEAN UP                             
C      **                                      
        WRITE(11,23)140                        
23     FORMAT(1X,A1)
        CLOSE(UNIT=11)                        
        RETURN                                 
        END                                    
C      **
C      **                               
        SUBROUTINE PTOPEN
        IMPLICIT INTEGER*2 ( A - Z )
        COMMON /BITDEN/ NBITPC
C      **
        NBITPC = 7
        WRITE ( 11, '(1X,A)' ) CHAR(138)
C      **
        RETURN
C      **
        END
        SUBROUTINE PTOUT       
        IMPLICIT INTEGER*2 (A-Z)        
        INTEGER *4 OUT                  
C?        BYTE GRAPH(1050,200),RECORD(1000),BYTE(2),EXT,SXT,SO,HOLD
        BYTE GRAPH(1050,200),RECORD(1000),BYTE(2),HOLD
        CHARACTER EXT,SXT,SO, ASCII*1
        COMMON /ASCIIC/ ASCII( 0: 255)
        COMMON/BITMAP/ IX1,IY1,IX2,IY2,GRAPH,MAXROW(200),MAXLIN
        EQUIVALENCE (OPER,BYTE(1))                         
C      **                                                  
C?        DATA NULL,EXT,SXT,SO/128,131,130,142/
        EQUIVALENCE ( NULL, ASCII(128)), ( EXT, ASCII(131))
        EQUIVALENCE ( SXT, ASCII(130)), ( SO, ASCII( 142))
C      **                                                  
4      FORMAT(1X,A)                                        
C      **                                                  
        WRITE(11,100) EXT,NULL,EXT,SO
C      **                                                  
        DO 20,I=1,MAXLIN
        K=1
        RECORD(1)=0
        IF (MAXROW(I).LT.1) GO TO 10
        K=0                                                
        DO 10,J=1,MAXROW(I)
C      **                                                  
        BYTE(2)=0                                          
        BYTE(1)=GRAPH(J,I)                                 
        OPER=OR(OPER,NULL)                                
        HOLD =BYTE(1)                                 
C      **                                                  
        K=K+1                                              
        RECORD(K)=HOLD
        IF ( HOLD .EQ. ICHAR(EXT) ) THEN                       
        K=K+1                                              
        RECORD(K)=ICHAR(EXT)
        ENDIF                                
        IF ( K .GE. 200) THEN
           WRITE(11,100) (RECORD(L),L=1,K)
           K = 0
        ENDIF
10     CONTINUE                              
C      **                                    
        WRITE(11,100) (RECORD(L),L=1,K),EXT,SO
20     CONTINUE                               
C      **                                     
        WRITE(11,100) EXT,SXT                 
100    FORMAT(1024A1)                         
C      **                                     
        RETURN                                
C      **                                     
C      **                                     
        END                                   
***********************************************************************