forums.silverfrost.com Forum Index forums.silverfrost.com
Welcome to the Silverfrost forums
 
 FAQFAQ   SearchSearch   MemberlistMemberlist   UsergroupsUsergroups   RegisterRegister 
 ProfileProfile   Log in to check your private messagesLog in to check your private messages   Log inLog in 

SET_CLEARWIN_STRING@ ( 'PRINTER_DOCUMENT', etc

 
Post new topic   Reply to topic    forums.silverfrost.com Forum Index -> ClearWin+
View previous topic :: View next topic  
Author Message
LitusSaxonicum



Joined: 23 Aug 2005
Posts: 2388
Location: Yateley, Hants, UK

PostPosted: Thu Jul 09, 2009 10:51 am    Post subject: SET_CLEARWIN_STRING@ ( 'PRINTER_DOCUMENT', etc Reply with quote

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

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
Back to top
View user's profile Send private message
IanLambley



Joined: 17 Dec 2006
Posts: 490
Location: Sunderland

PostPosted: Thu Jul 09, 2009 12:22 pm    Post subject: Reply with quote

Eddie,

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

      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
Back to top
View user's profile Send private message Send e-mail
LitusSaxonicum



Joined: 23 Aug 2005
Posts: 2388
Location: Yateley, Hants, UK

PostPosted: Sat Jul 11, 2009 12:22 pm    Post subject: Reply with quote

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
Back to top
View user's profile Send private message
IanLambley



Joined: 17 Dec 2006
Posts: 490
Location: Sunderland

PostPosted: Sat Jul 11, 2009 4:48 pm    Post subject: Reply with quote

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

Code:

      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


Last edited by IanLambley on Sat Jul 11, 2009 4:52 pm; edited 1 time in total
Back to top
View user's profile Send private message Send e-mail
IanLambley



Joined: 17 Dec 2006
Posts: 490
Location: Sunderland

PostPosted: Sat Jul 11, 2009 4:50 pm    Post subject: Reply with quote

Code:

      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...
Back to top
View user's profile Send private message Send e-mail
IanLambley



Joined: 17 Dec 2006
Posts: 490
Location: Sunderland

PostPosted: Sat Jul 11, 2009 4:51 pm    Post subject: Reply with quote

Code:

      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!
Back to top
View user's profile Send private message Send e-mail
LitusSaxonicum



Joined: 23 Aug 2005
Posts: 2388
Location: Yateley, Hants, UK

PostPosted: Sat Jul 11, 2009 5:31 pm    Post subject: Reply with quote

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
Back to top
View user's profile Send private message
IanLambley



Joined: 17 Dec 2006
Posts: 490
Location: Sunderland

PostPosted: Sat Jul 11, 2009 5:43 pm    Post subject: Reply with quote

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.
Back to top
View user's profile Send private message Send e-mail
Display posts from previous:   
Post new topic   Reply to topic    forums.silverfrost.com Forum Index -> ClearWin+ All times are GMT + 1 Hour
Page 1 of 1

 
Jump to:  
You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum
You cannot vote in polls in this forum


Powered by phpBB © 2001, 2005 phpBB Group