/*
@BPSPrintInfo  @P@Iby Robin Evans, April, 1992
Produces listing of information about doc for service bureau
*/

PSListF = 't:psfontlist'
OnState.0 = 'off'
OnState.1 = 'on'
cr = '0a'x

call ShowStatus('Preparing output information')

FileTitle = getpsoutput()
if FileTitle = '' then exit

parse value reverse(FileTitle) with FileTail '/' Path
if FileTail = reverse(FileTitle) then do
	parse value reverse(FileTitle) with FileTail ':' Path
	Path = reverse(Path)':'
end
else
	Path = reverse(Path)'/'

OType = Inform(2, 'Choose output type', ' Disk File ', '  Printer  ')
select
	when OType == 0 then do
		parse value reverse(FileTail) with FilePfx '.ps'
		OutFileName = FilePfx'.nfo'
			/* Now find out if that's a good name */
		OutFileName = GetFileName('Choose file for info', Path, OutFileName)
		if OutFileName == '' then do
			call ShowStatus('Operation cancelled')
			exit
		end
	end
	when OType == 1 then
		OutFileName = 'PRT:'
	otherwise do
		call ShowStatus('Bad choice. Exiting.')
		exit
	end
end

call open(OutF, OutFileName, W)
call writeln(outF, "Output file:" reverse(FileTail) "      [path:" Path"]")
call writeln(OutF, "")

	/* Check for User info clips */

cliplist = show('C')
if pos('PPUSER', cliplist) > 0 then do
	ppc. = ''
	ppc.0 = 6
	ppc.1 = getclip('PPUSER_NAME')
	ppc.2 = getclip('PPUSER_COMPANY')
	ppc.3 = getclip('PPUSER_ADDRESS')
	ppc.4 = getclip('PPUSER_CITY')',' getclip('PPUSER_STATE') getclip('PPUSER_ZIPCODE') getclip('PPUSER_COUNTRY')
	if length(ppc.4) < 4 then ppc.4 = ''
	ppc.5 = 'Phone:' getclip('PPUSER_PHONE')
	if length(ppc.5) < 7 then ppc.5 = ''
	ppc.6 = 'Fax:' getclip('PPUSER_FAX')
	if length(ppc.6) < 6 then ppc.6 = ''

	call writeln(OutF, "Order information:")
	call writeln(OutF, '   Submitted by')
	PITab = '      '
	do clpWrite = 1 to ppc.0
		is ppc.ClpWrite > '' then
			call writeln(OutF, PITab || ppc.ClpWrite)
	end
	call writeln(OutF, "")
end

	/* Get output resolution choice */
ResList = '1270'cr' 300'cr' 600'cr'2400'
ResChoice = SelectFromList('Pick output resolution',26,4, 0, ResList)
call writeln(OutF, 'Please output file at' ResChoice 'dpi')
call writeln(OutF, "")


call writeln(OutF, "Professional Page document" GetDocName())
call writeln(OutF, "   Created" CreationDate())
call writeln(OutF, "   Revision" GetRevision()". Last saved" SavedDate()".")
call writeln(OutF, "")

NumPages = NumPages()
call writeln(OutF, NumPages " pages in document")
	/* Get color sep info */
parse value getcsinks() with Kon Yon Mon Con MechOn
if MechOn = ' ' then MechOn = 0
NumColors = Kon + Yon + Mon + Con + MechOn
if NumColors = 1 then
	call writeln(outF, "   No color separation.")
else do
	call writeln(OutF, "   Separations will be made for" NumColors "colors.")
	call writeln(OutF, NumColors * NumPages "total sheets of output.")
end
call writeln(OutF, "")

SvUnits = ppm_getunits()
call ppm_setunits(1)
RPstate = word(getpsrollpaper(), 1)
RollSize = word(getpsrollpaper(), 2)
call writeln(OutF, "Roll paper setting is" OnState.RPstate)
if RPstate then
	call writeln(OutF, "Paper width is" RollSize)
call writeln(OutF, "Output image size is" word(getpspagesize(),1) "by" word(getpspagesize(),2) "inches")
call writeln(OutF, "Output scale is" getpsoutputscale())
call ppm_setunits(SvUnits)
CropState = word(getpsOutputCrop(), 1)
call writeln(OutF, "Crop marks are" OnState.CropState)
call writeln(OutF, "")

fonts = sortlist(getpsfontsused(),0,0)
do x = 0 until fonts = ""
	parse var fonts font.x '0a'x fonts
end
DidDL = getpsfontdownload()

if ~show(C, 'PSFontDir') & DidDL then do
	address command
	'list quick nohead cgfonts:ps >'PSListF
	call open(FontL, PSListF, R)
	address
	PSfonts = ''
	do until eof(FontL)
		lfont = readln(FontL)
		if lfont ~== '' then do
			parse var lfont lfont '.psfont'
			PSfonts = lfont PSfonts
		end
	end
	call setclip('PSFontDir', PSFonts)
end
else
	PSfonts = getclip('PSFontDir')

call writeln(OutF, font.0 "fonts used in document:")
call writeln(OutF, "   These fonts should be resident in printer:")

fx = 1
do x = 1 to font.0
	if find(PSFonts, font.x) = 0 | ~DidDL then
		call writeln(OutF, "      "font.x)
	else do
		DLfont.fx = font.x
		fx = fx + 1
	end
end

call writeln(OutF, "")
if fx > 1 then do
	call writeln(OutF, "   These fonts will be downloaded:")
	do x = 1 to fx - 1
		call writeln(OutF, "      "DLfont.x)
	end
end
call ClearStatus()
call inform(1, 'Finished',)

 