SET_CLEARWIN_STRING@ ( 'PRINTER_DOCUMENT', etc

I'm having trouble with SET_CLEARWIN_STRING@ ( 'PRINTER_DOCUMENT', etc. Here is an example code:

      WINAPP
      OPTIONS (INTL)
      PROGRAM PRINTER_DOC
      INCLUDE <WINDOWS.INS>
      EXTERNAL Prin_FUNCTION   
      I = WINIO@('%ca[PD tester]%mn[Print]',
     &    'PRINTER_OPEN',10,Prin_FUNCTION)
      END
      INTEGER FUNCTION PRIN_FUNCTION()
      INCLUDE <WINDOWS.INS>
      CHARACTER*(30) CWS
      CALL SET_CLEARWIN_STRING@ ('PRINTER_DOCUMENT','Anything but')
      CWS = CLEARWIN_STRING@ ('PRINTER_DOCUMENT')
      WRITE(10,*) 'Printer document name = '//CWS
      CALL CLOSE_PRINTER@ (0)
      PRIN_FUNCTION = 1     
      END

In the printer queue, the document name is 'Clearwin + Output'. According to my understanding of FTN95.chm, it ought to be 'Anything but'.

We'll leave out (for the time being) that it looks in FTN95.chm that one could omit the quotes from 'PRINTER_DOCUMENT' - as though PRINTER_DOCUMENT was a constant declared in one of the multitudes of declarations in the INS files (which it isn't).

Is the problem that I'm printing to a networked printer, or is there some deeper flaw to my understanding? I'm using 4.90.

Eddie

Eddie,

I've used this OK, but I set the string before opening the printer, see below a modified version.

      WINAPP 
      OPTIONS (INTL) 
      PROGRAM PRINTER_DOC 
      INCLUDE <WINDOWS.INS> 
      EXTERNAL Prin_FUNCTION    
      I = WINIO@('%ca[PD tester]%mn[Print]',Prin_FUNCTION) 
      END 
      INTEGER FUNCTION PRIN_FUNCTION() 
      INCLUDE <WINDOWS.INS> 
      CHARACTER*(30) CWS 
      CALL SET_CLEARWIN_STRING@ ('PRINTER_DOCUMENT','Anything but') 
      itest = open_printer@(0) 
      if(itest .ne. 0)then
        i=USE_RGB_COLOURS@( 0, .true. ) 
        call SELECT_GRAPHICS_OBJECT@( 0 )
        CWS = CLEARWIN_STRING@ ('PRINTER_DOCUMENT')
        call DRAW_LINE_BETWEEN@(0,0,100,100,rgb@(255,0,0))
        WRITE(*,*) 'Printer document name = '//CWS 
        CALL CLOSE_PRINTER@ (0) 
      endif 
      PRIN_FUNCTION = 1      
      END 

If you print to a pdf, then the file name defaults to 'Anything but.pdf'

Regards

Ian

Ian,

Thanks for the speedy reply.

I've also tried graphics printing with the standard callback, and that puts 'Clearwin + Output' into the printer queue too. It therefore looks as though 'PRINTER_DOCUMENT' only works if the printer is explicitly opened with OPEN_PRINTER@. That rules out labelling the printer queue entry for Fortran formatted output, as the only way to get a fortran device number associated with a specific printer is through the standard call-back route with 'PRINTER_OPEN', device_number, Print_Function. I suspect that 'HTML_PRINTER_OPEN' suffers the same limitation...

Another thing for FTN95.chm?

The routine OPEN_PRINTER@ ought, for consistency with the standard callbacks, to have been called GPRINTER_OPEN@.

I think I've been near here before (see 'Associate a fortran unit with a printer' thread).

Eddie

Eddie, It can be done, see below for a very messy version.

      WINAPP 
      OPTIONS (INTL) 
      PROGRAM PRINTER_DOC 
      implicit real*8 (a-h,o-z)
      INCLUDE <WINDOWS.INS> 
      EXTERNAL Prin_FUNCTION,print_driver
      common/driver_data/nrow,ncol,xchar,ychar,scale,icol,angle,imode
      character*2000 outputstring
      common/last_string/outputstring
      ncol = 80
      nrow = 60
      xchar = 6d0
      ychar = 2d0
      icol  = rgb@(128,128,128)
      angle = 0d0
      imode = 0
      open(unit=50,driver=print_driver)
      I = WINIO@('%ca[PD tester]%mn[Print]',Prin_FUNCTION) 
      close(unit=50) 
      END 

      
      INTEGER FUNCTION PRIN_FUNCTION() 
      implicit real*8 (a-h,o-z)
      INCLUDE <WINDOWS.INS> 
      CHARACTER*(30) CWS 
      common/driver_data/nrow,ncol,xchar,ychar,scale,icol,angle,imode
      CALL SET_CLEARWIN_STRING@ ('PRINTER_DOCUMENT','Anything but') 
      itest = open_printer@(0) 
      if(itest .ne. 0)then
        call SELECT_GRAPHICS_OBJECT@( 0 )
        i=USE_RGB_COLOURS@( 0, .true. ) 
        call get_graphical_resolution@( ixxx, iyyy )
c
c set pixel paper size
        call set_paper_size(ixxx,iyyy)
c
c get the text size for the main body of the text
        call get_text_scale(ncol,nrow,scale,imode)
c        call set_mode(imode)
        angle = 0d0
        call scale_font@(scale)
        call set_text_offset(0,0)
        call set_scale(scale)

        CWS = CLEARWIN_STRING@ ('PRINTER_DOCUMENT')
        
        WRITE(50,*) 'Printer document name = '//CWS 
        WRITE(50,*) 'Printer document name = '//CWS 
        WRITE(50,*) 'Printer document name = '//CWS 
        CALL CLOSE_PRINTER@ (0)
      endif 
      PRIN_FUNCTION = 1      
      END 
      subroutine print_driver(buffer,bsize,blen,action,ifail)
      implicit real*8 (a-h,o-z)
      include <windows.ins>
      integer*2 bsize,buffer(bsize),blen,action,ifail
      integer*2 substring_int
      character*2000 outputstring
      common/last_string/outputstring
      character*2 substring
      equivalence(substring,substring_int)
      common/driver_data/nrow,ncol,xchar,ychar,scale,icol,angle,imode
      if(action .eq. 2)then
c
c formatted write only
        call SELECT_GRAPHICS_OBJECT@( 0 )
        iout = 1
        outputstring = ' '
        do i=1,blen
          substring_int = buffer(i)
          outputstring(iout:iout+1) = substring
          iout = iout + 2
        enddo
c
c move to next row on page
        ychar = ychar + 1d0
c
c close and print this page when full or when first character is
c a 1 - i.e. old form feed rule
        if(ychar .gt. nrow .or. outputstring(1:1) .eq. '1')then
          ychar = 1d0
          CALL CLOSE_PRINTER@ (0)
          i     = open_printer1@(0) 
          call SELECT_GRAPHICS_OBJECT@( 0 )
          i     = USE_RGB_COLOURS@( 0, .true. ) 
        endif          
          
        call select_font@('SYSTEM FIXED FONT') 

        call draw_text_at(outputstring(2:blen),xchar,ychar,
     &                    scale,icol,angle,imode)
      endif
      end

Continued

      subroutine convert_char_to_pixel(xchar,ychar,ix,iy)
      implicit real*8 (a-h,o-z)
      common/printer_text_offset/ixpoff,iypoff,ixmax,iymax,ixlast,iylast
      common/printer_cell_defaults/iwl,iwr,iwt,iwb,ibord_col,
     &                             xchar_offset,ychar_offset,itest,
     &                             nrow,ncol,imode,scale,angle
      common/font_sizing/iwid,ihgt
      if(imode .eq. 0)then
c
c portrait
        ix = xchar * iwid * scale + ixpoff
        iy = ychar * ihgt * scale + iypoff
      else
        ix = ychar * ihgt * scale + iypoff
        iy = iymax - (xchar * iwid * scale + ixpoff)
      endif

      end

      subroutine get_text_scale(ncol,nrow,scale,imode)
      implicit real*8 (a-h,o-z)
      include <windows.ins>,nolist
c
c determines the scale factor for text to fit the printer 
c used to be based on a default 8x14 font, now uses font_metrics@ to determine size
      common/printer_text_offset/ixpoff,iypoff,ixmax,iymax,ixlast,iylast
      common/font_sizing/iwid,ihgt
      integer*4 metrics(20)
      call scale_font@(1d0)
      call font_metrics@(metrics)
      iwid = metrics(7)
      ihgt = metrics(1)
c      print *,metrics
      
      if(imode .eq. 0)then
c
c portrait
        scale1 = float(ixmax)/(0.9+iwid)/float(ncol)
        scale2 = float(iymax)/(0.9+ihgt)/float(nrow)
      else
c
c landscape
        scale1 = float(iymax)/(0.3+iwid)/float(ncol)
        scale2 = float(ixmax)/(0.3+ihgt)/float(nrow)
      endif
      scale  = min(scale1,scale2)
      end

      subroutine get_max_characters(maxcol,maxrow)
      implicit real*8 (a-h,o-z)
      include <windows.ins>,nolist
c
c determines the scale factor for text to fit the printer 
c used to be based on a default 8x14 font, now uses font_metrics@ to determine size
      common/printer_text_offset/ixpoff,iypoff,ixmax,iymax,ixlast,iylast
      common/printer_cell_defaults/iwl,iwr,iwt,iwb,ibord_col,
     &                             xchar_offset,ychar_offset,itest,
     &                             nrow,ncol,imode,scale,angle
      common/font_sizing/iwid,ihgt

      if(imode .eq. 0)then
c
c portrait
        maxcol = float(ixmax-ixpoff)/(0.9+iwid)/scale
        maxrow = float(iymax-iypoff)/(0.9+ihgt)/scale
      else
c
c landscape
        maxcol = float(iymax-ixpoff)/(0.3+iwid)/scale
        maxrow = float(ixmax-iypoff)/(0.3+ihgt)/scale
      endif
      end

and a bit more...

      subroutine set_text_offset(ixoff,iyoff)
      common/printer_text_offset/ixpoff,iypoff,ixmax,iymax,ixlast,iylast
      ixpoff = ixoff
      iypoff = iyoff
      end
      subroutine set_paper_size(ixxx,iyyy)
      common/printer_text_offset/ixpoff,iypoff,ixmax,iymax,ixlast,iylast
      ixmax = ixxx
      iymax = iyyy
      end

      subroutine draw_text_at(text,xchar,ychar,scale,
     &                        itext_col,angle,imode)
      implicit real*8 (a-h,o-z)
      include <windows.ins>,nolist
      common/font_sizing/iwid,ihgt
      character*(*) text
      call convert_char_to_pixel(xchar,ychar,ixtext,iytext)
      call rotate_font@(dble(angle+imode*90d0))
      call scale_font@(scale)
      call draw_characters@(text,ixtext,iytext,itext_col)
      end
      subroutine set_scale(scale_set)
      implicit real*8 (a-h,o-z)
      include <windows.ins>,nolist
      common/printer_cell_defaults/iwl,iwr,iwt,iwb,ibord_col,
     &                             xchar_offset,ychar_offset,itest,
     &                             nrow,ncol,imode,scale,angle
      scale = scale_set


      end
      subroutine set_angle(angle_set)
      implicit real*8 (a-h,o-z)
      common/printer_cell_defaults/iwl,iwr,iwt,iwb,ibord_col,
     &                             xchar_offset,ychar_offset,itest,
     &                             nrow,ncol,imode,scale,angle
      angle = angle_set

      end

Thats all folks!

Ian,

I'm stunned.

The DRIVER= option in the OPEN statement isn't anything I'd come across before - not knowing about it I couldn't see any way to use formatted output.

Thanks

Eddie

Eddie,

First time I've used it and I was very suprised that it worked.

Where should I send the bill?

Regards

Ian

PS, I should have said that it partially supports the old lineprinter format where the first character on the line is carriage control. At present a '1' means 'form feed' and everthing else in the first character position is ignored.