|
forums.silverfrost.com Welcome to the Silverfrost forums
|
View previous topic :: View next topic |
Author |
Message |
LitusSaxonicum
Joined: 23 Aug 2005 Posts: 2388 Location: Yateley, Hants, UK
|
Posted: Thu Jul 09, 2009 10:51 am Post subject: SET_CLEARWIN_STRING@ ( 'PRINTER_DOCUMENT', etc |
|
|
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 |
|
|
IanLambley
Joined: 17 Dec 2006 Posts: 490 Location: Sunderland
|
Posted: Thu Jul 09, 2009 12:22 pm Post subject: |
|
|
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 |
|
|
LitusSaxonicum
Joined: 23 Aug 2005 Posts: 2388 Location: Yateley, Hants, UK
|
Posted: Sat Jul 11, 2009 12:22 pm Post subject: |
|
|
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 |
|
|
IanLambley
Joined: 17 Dec 2006 Posts: 490 Location: Sunderland
|
Posted: Sat Jul 11, 2009 4:48 pm Post subject: |
|
|
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 |
|
|
IanLambley
Joined: 17 Dec 2006 Posts: 490 Location: Sunderland
|
Posted: Sat Jul 11, 2009 4:50 pm Post subject: |
|
|
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 |
|
|
IanLambley
Joined: 17 Dec 2006 Posts: 490 Location: Sunderland
|
Posted: Sat Jul 11, 2009 4:51 pm Post subject: |
|
|
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 |
|
|
LitusSaxonicum
Joined: 23 Aug 2005 Posts: 2388 Location: Yateley, Hants, UK
|
Posted: Sat Jul 11, 2009 5:31 pm Post subject: |
|
|
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 |
|
|
IanLambley
Joined: 17 Dec 2006 Posts: 490 Location: Sunderland
|
Posted: Sat Jul 11, 2009 5:43 pm Post subject: |
|
|
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 |
|
|
|
|
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
|