cross-translate


;*******************************************************************
;This translator was written by:
;A. Farrel Droke
;HEBCO, INC.
;1601 S.E. 66th Street
;Oklahoma City, OK  73149-5210
;(405)672-1461 
;written around 9/6/97
;modified 9/30/97
;My E-MAIL is fdroke@hebco.com

;If you make improvements to this program, I sure would appreciate it if you could sent
;me a copy.  We work the heck out of this program and, as you might guess, it sometimes
;makes the difference between profit and loss on a conversion job.

;I am happy to give anybody who needs it the right to use or change this program.  To ALL
;of the wonderful OmniMark folks out there who have helped me with advice
;and programming assistance over the years - this program is for you.  Use it well!
;If you wish to pay something for the use of this program, I will accept only payment
;in the form of beer.  If you like this program, please buy me one.  Thanks!

;NOTES:

;This OmniMark Translator is used to determine the Image Width and Image Length of
;a standard TIFF file.  The routine looks for data in the following format

;<graphic boardno="test2"> or <symbol boardno="test2">

;The routine expects "boardno" to follow the element name in the tag.

;Here is an example of the command line for OmniMark:

;     inputfile.sgm  -s TIFFSIZE.XOM -of outputfile.sgm

;Your output file will then have the depth and width dimention attributes included with
;the <graphic or <symbol tag.  These dimensions will be listed in inches up to 3 decimals.

;The routine doesn't currently search out dimensions other than "inches."

;You will notice that the program performs several "do scan file" routines.  This is because
;in a TIFF file, data can be located ANYWHERE in the file - not necessarily in any order.

;Remember, byte orders are all reversed when File Type is Intel or Motorola.

;The program warns the user when a TIFF is encountered that is something other than
;300 dpi.
;*******************************************************************

include "omfsys.xin"
declare function-library "omfsys"
;These STREAMS are used for the PATHNAME external function

MACRO upto (ARG pattern) IS
	((LOOKAHEAD NOT (pattern)) ANY)*
MACRO-END


GLOBAL COUNTER char1
GLOBAL COUNTER char2
GLOBAL COUNTER char3
GLOBAL COUNTER char4
GLOBAL COUNTER offset
GLOBAL COUNTER depth
GLOBAL COUNTER width
GLOBAL COUNTER wid1
GLOBAL COUNTER wid2
GLOBAL COUNTER dep1
GLOBAL COUNTER dep2
GLOBAL COUNTER temp1
GLOBAL COUNTER temp2
GLOBAL COUNTER temp3
GLOBAL COUNTER temp4
GLOBAL COUNTER tag1
GLOBAL COUNTER tag2
GLOBAL COUNTER bytes
GLOBAL COUNTER tags
GLOBAL COUNTER xo1
GLOBAL COUNTER xo2
GLOBAL COUNTER yo1
GLOBAL COUNTER yo2
GLOBAL COUNTER xoff
GLOBAL COUNTER yoff
GLOBAL COUNTER xdpi
GLOBAL COUNTER ydpi
GLOBAL STREAM filenames VARIABLE initial-size 0
GLOBAL STREAM filetypes VARIABLE initial-size 0
GLOBAL STREAM newfilenames VARIABLE initial-size 0
GLOBAL STREAM newboardnos VARIABLE initial-size 0
GLOBAL STREAM type
GLOBAL STREAM string
GLOBAL STREAM widthstring
GLOBAL STREAM depthstring
GLOBAL STREAM xresoffset
GLOBAL STREAM yresoffset
GLOBAL STREAM filename initial {""}
GLOBAL STREAM tagdata
GLOBAL SWITCH missing
GLOBAL SWITCH test ;activate to see TIFF analysis data
GLOBAL SWITCH processed
GLOBAL STREAM report initial {""}


;variable required by external function FS_RENAME
GLOBAL STREAM stat

find-start
	reset bytes
	reopen report


;*******Finds the ENTITIES, evaluates them and stores them in variable streams*****


find (UL"<!ENTITY" BLANK* [any except BLANK]+ => boardno BLANK+ "SYSTEM" 
[any except "%""]+ "%"" BLANK* [any except "%""]+ => filename  "%"" BLANK* "NDATA" 
BLANK* [any except "%_" or ">"]+ => type "%_"* ">")=> ent
	local stream newfilename initial {""}
	local stream newboardno initial {""}
	reopen newfilename
	repeat scan filename
		match "_"
			put newfilename "-"
		match any=>char
			put newfilename char
	again
	close newfilename
	reopen newboardno
	repeat scan boardno
		match "_"
			put newboardno "-"
		match any=>char
			put newboardno char
	again
	close newboardno
	output "<!ENTITY %lg(newboardno) SYSTEM %"%lg(newfilename)%" NDATA %x(type)>"
	set new filenames key boardno to "%lx(filename)"
	set new filetypes key boardno to "%lx(type)"
	do when newfilenames has key newboardno
		put #console and report "**BIG PROBLEM-GRAPHICS FILENAMES CONTAIN UNDERSCORE THAT CANNOT BE RENAMED!**%n"
	else		set new newfilenames key boardno to "%lg(newfilename)"
		set new newboardnos key boardno to "%lg(newboardno)"
	done

find (UL"<graphic" or UL"<symbol")=>front upto(">")=>stuff ">"
	local stream boardno initial {""}
	local stream ents initial {""}
	local stream newname
	deactivate processed
	reopen ents
	repeat scan stuff
		match white-space UL"repro" upto("%"") "%"" upto("%"") "%""
		match white-space UL"boardno" upto("%"") "%"" upto("%"")=>brd "%""
			set boardno to brd		
		match any=>char
			put ents char
	again
	close ents
	set filename to filenames ^ boardno
	set newname to newfilenames ^ boardno
	activate missing
	do when file "%g(filename)" exists
;FS_Rename will rename the file to match the upper-lower case of the ENTITY
;also rename file to eliminate the underscore character
		FS_Rename
			"%g(filename)" to "%g(newname)"
   			status stat
		deactivate missing
;******************************************************************
		do when filetypes ^ boardno is equal "eps"
			activate processed
			repeat scan binary-mode file "%lg(newname)"
				match "BoundingBox:" blank+
					("-")?=> hstartneg digit+ => hstart blank+ 
					("-")?=> vstartneg digit+ => vstart blank+
					("-")?=> hstopneg digit+ => hstop blank+
					("-")?=> vstopneg digit+ => vstop
;					put #console "graphic " || filename || " " || hstart || " " || vstart || " " || hstop || " " || vstop || "%n"
					do when hstartneg is equal hstopneg ;the same
						reset width to (((hstop * 1000) - (hstart *1000))/72)
					else ;different
						reset width to (((hstop * 1000) + (hstart *1000))/72)
					done
					do when vstartneg is equal vstopneg ;the same
						reset depth to (((vstop * 1000) - (vstart *1000))/72)
					else ;different
						reset depth to (((vstop * 1000) + (vstart *1000))/72)
					done
				match any
			again
			reset width to (0 - width) when width is less-than 0
			reset depth to (0 - depth) when depth is less-than 0
			do when newboardnos has key boardno
				output "%x(front) boardno = %"" || newboardnos ^ boardno || "%"%_"
				output "reprowid = %"%3sd(width)in%"%_"
				output "reprodep = %"%3sd(depth)in%""
				output ents || ">"
			else
				output "<!--BIG PROBLEM-BOARDNO COULD NOT BE RENAMED!-->"
				output "%x(front) boardno = %"%g(boardno)%"%_"
				output "reprowid = %"%3sd(width)in%"%_"
				output "reprodep = %"%3sd(depth)in%""
				output ents || ">"
				put #console and report "PROBLEM WITH BOARDNO=" || boardno || " IT COULD NOT BE RENAMED!"
			done

		done
;******************************************************************
		do when filetypes ^ boardno is equal "fax"
;*******Find the File Type and offset to the Image File Directory*****
			activate processed
			do scan binary-mode file "%g(newname)"
				match any = mi any{3} any = first any = second any = third any = forth
					set type to "M" when "%x(mi)" is equal "M"
					set type to "I" when "%x(mi)" is equal "I"
					output "File type = %g(type)%n" when active test
					reset char1 to BINARY first
					reset char2 to BINARY second
					reset char3 to BINARY third
					reset char4 to BINARY forth
					reset offset to 
						(("%2fz10rd(char3)" * 65536) + ("%2fz10rd(char2)" * 256 ) + "%2fz10rd(char1)") 
						when "%g(type)" is equal "I"
					reset offset to 
						(("%2fz10rd(char2)" * 65536) + ("%2fz10rd(char3)" * 256 ) + "%2fz10rd(char4)") 
						when "%g(type)" is equal "M"
					output "offset = %d(offset)%n" when active test
			done

;*********Using the offset from above, the following captures all of the TIFF tags

			do scan binary-mode file "%g(newname)" 
				match any{"%d(offset)"}any = q1 any = q2
					reset tag1 to binary q1
					reset tag2 to binary q2
					reset tags to ("%10rd(tag1)" + "%10rd(tag2)")
					output "%d(tags) tags in this directory.%n%n" when active test
			done	
			reset temp1 to ("%d(tags)" * 12)
			set string to ""
			do scan binary-mode file "%g(newname)" 
				match any{"%d(offset)"} any{2} any{"%d(temp1)"} = goodies
					set tagdata to "%x(goodies)"

;**********The next routine identifies the width, length,
;                     and x and y resolution offset tags.  It also pulls the tag info out as hex.

					repeat scan "%g(tagdata)"
						match any = byte1 any = byte2 any{10} = remain 
							reset char1 to binary byte1
							reset char2 to binary byte2
							reopen string
							put string "%2fzu16rd(char1)%2fzu16rd(char2)%x(remain)"
							close string
							do scan "%g(string)"
								match ("0001" or "0100") any{10} = data
									set widthstring to "%x(data)"
								match "0101" any{10} = data
									set depthstring to "%x(data)"
								match ("1A01" or "011A") any{10} = data
									set xresoffset to "%x(data)"
								match ("1B01" or "011B") any{10} = data
									set yresoffset to "%x(data)"
							done
							set string to ""
					again
			done

;***********Use the stuff below to get a really neato hex output of all of the tags
			do when active test
				output "%n Tag  Type      Count      Value/Offset%n"
				repeat scan "%g(tagdata)"
					match any = byte 
						reset temp1 to binary byte
						output "%2fzu16rd(temp1)%_"
						do when counter bytes is equal 12
							output "%n"
							reset bytes to 0
						done
  						increment bytes
				again
			done


;*****this finds the bytes for the width
			do scan "%g(widthstring)"
				match any{6} any = one any = two any = three any = four
					reset temp1 to BINARY one
					reset temp2 to BINARY two
					reset temp3 to BINARY three
					reset temp4 to BINARY four
			done
			do when ("%2fzu16rd(temp1)" is equal "00") and ("%2fzu16rd(temp2)" is equal "00")
				reset wid1 to "%d(temp3)"
				reset wid2 to "%d(temp4)"
			else
				reset wid1 to "%d(temp1)"
				reset wid2 to "%d(temp2)"
			done
			output "wfirst = %2fzu16rd(wid1)%n" when active test
			output "wsecond = %2fzu16rd(wid2)%n" when active test

;********this finds the bytes for the depth
;This finds the "type" on the depth tag
			do scan "%g(depthstring)"
				match any{6} any = one any = two any = three any = four
					reset temp1 to BINARY one
					reset temp2 to BINARY two
					reset temp3 to BINARY three
					reset temp4 to BINARY four
			done
			do when ("%2fzu16rd(temp1)" is equal "00") and ("%2fzu16rd(temp2)" is equal "00")
				reset dep1 to "%d(temp3)"
				reset dep2 to "%d(temp4)"
			else
				reset dep1 to "%d(temp1)"
				reset dep2 to "%d(temp2)"
			done
			output "depfirst = %2fzu16rd(dep1)%n" when active test
			output "depsecond = %2fzu16rd(dep2)%n" when active test


;********this finds the bytes for the xresoffset and the xresolution in dpi

			do scan "%g(xresoffset)" 
				match any{6} any = xo1st any = xo2nd any = xo3rd any = xo4th
					reset xo1 to BINARY xo1st when "%g(type)" is equal "I"
					reset xo2 to BINARY xo2nd when "%g(type)" is equal "I"
					reset xo1 to BINARY xo4th when "%g(type)" is equal "M"
					reset xo2 to BINARY xo3rd when "%g(type)" is equal "M"
					output "xoffset 1st byte  = %2fzu16rd(xo1)%n" when active test
					output "xoffset 2nd byte = %2fzu16rd(xo2)%n" when active test
			done
			reset xoff to ("%10rd(xo1)" + (256 * "%10rd(xo2)"))
			do scan binary-mode file "%g(newname)"
				match any{"%d(xoff)"}
						any=>b1 any=>b2 any=>b3 any=>b4 any=>b5 any=>b6 any=>b7 any=>b8
					local counter d1x1
					local counter d1x2
					local counter d1x3
					local counter d1x4
					local counter d2x1
					local counter d2x2
					local counter d2x3
					local counter d2x4
					local counter numerator
					local counter denominator
					do when type is equal "M"
						reset d1x1 to binary b1
						reset d1x2 to binary b2
						reset d1x3 to binary b3
						reset d1x4 to binary b4
						reset d2x1 to binary b5
						reset d2x2 to binary b6
						reset d2x3 to binary b7
						reset d2x4 to binary b8
					else when type is equal "I"
						reset d1x1 to binary b4
						reset d1x2 to binary b3
						reset d1x3 to binary b2
						reset d1x4 to binary b1
						reset d2x1 to binary b8
						reset d2x2 to binary b7
						reset d2x3 to binary b6
						reset d2x4 to binary b5
					done
					reset numerator to (d1x4 + (d1x3 * 256) 
						+ (d1x2 * 65536) + (d1x1 * 16777216))
					reset denominator to (d2x4 + (d2x3 * 256) 
						+ (d2x2 * 65536) + (d2x1 * 16777216))
					reset xdpi to (numerator/denominator)
				done
			output "xdpi = %d(xdpi)%n" when active test

;********this finds the bytes for the yresoffset and the yresolution in dpi

			do scan "%g(yresoffset)" 
				match any{6} any = yo1st any = yo2nd any = yo3rd any = yo4th
					reset yo1 to BINARY yo1st when "%g(type)" is equal "I"
					reset yo2 to BINARY yo2nd when "%g(type)" is equal "I"
					reset yo1 to BINARY yo4th when "%g(type)" is equal "M"
					reset yo2 to BINARY yo3rd when "%g(type)" is equal "M"
					output "yoffset 1st byte  = %2fzu16rd(yo1)%n" when active test
					output "yoffset 2nd byte = %2fzu16rd(yo2)%n" when active test
			done
			reset yoff to ("%10rd(xo1)" + (256 * "%10rd(xo2)"))
			do scan binary-mode file "%g(newname)"
				match any{"%d(yoff)"}
						any=>b1 any=>b2 any=>b3 any=>b4 any=>b5 any=>b6 any=>b7 any=>b8
					local counter d1x1
					local counter d1x2
					local counter d1x3
					local counter d1x4
					local counter d2x1
					local counter d2x2
					local counter d2x3
					local counter d2x4
					local counter numerator
					local counter denominator
					do when type is equal "M"
						reset d1x1 to binary b1
						reset d1x2 to binary b2
						reset d1x3 to binary b3
						reset d1x4 to binary b4
						reset d2x1 to binary b5
						reset d2x2 to binary b6
						reset d2x3 to binary b7
						reset d2x4 to binary b8
					else when type is equal "I"
						reset d1x1 to binary b4
						reset d1x2 to binary b3
						reset d1x3 to binary b2
						reset d1x4 to binary b1
						reset d2x1 to binary b8
						reset d2x2 to binary b7
						reset d2x3 to binary b6
						reset d2x4 to binary b5
					done
					reset numerator to (d1x4 + (d1x3 * 256) 
						+ (d1x2 * 65536) + (d1x1 * 16777216))
					reset denominator to (d2x4 + (d2x3 * 256) 
						+ (d2x2 * 65536) + (d2x1 * 16777216))
					reset ydpi to (numerator/denominator)
				done
			output "ydpi = %d(xdpi)%n" when active test

			reset width to (("%10rd(wid1)" + (256 * "%10rd(wid2)")) * 1000 / "%d(xdpi)") 
				when "%g(type)" is equal "I"
			reset depth to (("%10rd(dep1)" + (256 * "%10rd(dep2)")) * 1000 / "%d(ydpi)") 
				when "%g(type)" is equal "I"
			reset width to (("%10rd(wid2)" + (256 * "%10rd(wid1)")) * 1000 / "%d(xdpi)") 
				when "%g(type)" is equal "M"
			reset depth to (("%10rd(dep2)" + (256 * "%10rd(dep1)")) * 1000 / "%d(ydpi)") 
				when "%g(type)" is equal "M"

;***********The following outputs the original format including reprowid and reprodep.
;***********Modify these statements for other attribute names.

			do when newboardnos has key boardno
				output "%x(front) boardno = %"" || newboardnos ^ boardno || "%"%_"
				output "reprowid = %"%3sd(width)in%"%_"
				output "reprodep = %"%3sd(depth)in%""
				output ents || ">"
			else
				output "<!--BIG PROBLEM-BOARDNO COULD NOT BE RENAMED!-->"
				output "%x(front) boardno = %"%g(boardno)%"%_"
				output "reprowid = %"%3sd(width)in%"%_"
				output "reprodep = %"%3sd(depth)in%""
				output ents || ">"
				put #console and report "PROBLEM WITH BOARDNO=" || boardno || " IT COULD NOT BE RENAMED!"
			done

		done
;******************************************************************
	else
		put #console and report "file - %g(newname) NOT FOUND   %n"
;	output "%n<!--****** THE FOLLOWING GRAPHIC AND ENTITY ARE MISSING ******-->%n'
		output "%x(front) boardno=%"%g(boardno)%"%g(ents)>"
		activate processed
	done
	reset width to 0
	reset depth to 0

;*********The following warns the user of TIFFs that are not 300 or 600 dpi
	do when active missing
	else when filetypes ^ boardno is equal "fax"
		do when ((xdpi - ((xdpi/300) * 300)) isnt equal 0) or ((ydpi - ((ydpi/300) * 300)) isnt equal 0)
			put #console and report "%g(newname) has xdpi = %d(xdpi)  ydpi = %d(ydpi)%n"
				when xdpi isnt equal 299 and ydpi isnt equal 299
		done
	done
;**********The following outputs graphics info for files that don't process as FAX or EPS
	do when not active processed
		output "%x(front) boardno=%"%g(boardno)%"%g(ents)>"
		put #console and report "ENTITY CALLOUT for %g(boardno) isn't FAX or EPS%n"
	done

find-end
	local stream tempo
	put #console "If you are running the same file for a second time%n"
		|| "remember that your original graphics and entities names%n"
		|| "have been changed and will generate a NOT FOUND error.%n"
	close report
	open tempo as file "graphicsreport.txt"
	put tempo ""
	close tempo
	open tempo as file "graphicsreport.txt"
	put tempo report
	close tempo