<?xl version="0.1" encoding="EUC-JP"?>

<Define> ^mode (Arg 1) </Define>

<Switch>
<Case> (= mode "direct")
	<Define> ^image-prefix (Arg 2) </Define>
	<Define> ^w-unit (Arg 3) </Define>
	<Define> ^mapping-url (Arg 4) </Define>
	<Define> ^file-list (FindFile (+ "*." image-prefix)) </Define>
</Case>
<Case> (= mode "csv")
	()
</Case>
<Case> 1
	(PrintStd (+ "invalid mode :" mode))
</Case>
</Switch>


<Define> ^convert-to-cr ()
<Arguments>
	^src ^dest ^m-data ^unit
</Arguments>
<Export target="exl"> 
	<Load option="exec"> _graphics.xl </Load>
	<Define> ^src (Local src) </Define>
	<Define> ^dest (Local dest) </Define>
	<Define> ^m-data (Local m-data) </Define>
	<Define> ^unit (Local unit) </Define>

	<Define> ^mx ^'<matrix v="3" h="3">
		($ ([Cast type="floating"] (GE m-data 0)))
			($ ([Cast type="floating"] (GE m-data 1)))
			($ ([Cast type="floating"] (GE m-data 4)))
		($ ([Cast type="floating"] (GE m-data 2)))
			($ ([Cast type="floating"] (GE m-data 3)))
			($ ([Cast type="floating"] (GE m-data 5)))
		0		0		1
		</matrix>
	</Define>
(PrintStd mx)
	<Define> ^ex ^'<matrix v="3"> 1 0 0 </matrix></Define>
	<Define> ^ey ^'<matrix v="3"> 0 1 0 </matrix></Define>
	<Define> ^_ex (Mmul mx ex) </Define>
	<Define> ^_ey (Mmul mx ey) </Define>
	<Define> ^inv-reso (sqrt (/
			(+ (Minner _ex _ex) (Minner _ey _ey)) 2))
	</Define>

	<Define> ^get-crd-pt ()
	<Arguments> ^x ^y ^unit </Arguments>
	<Sequence> ()
(PrintStd "get-crd-pt")
(PrintStd x)
(PrintStd y)
		<Define> ^p (Mmul mx 
			'<matrix v="3">
			($ x) ($ y) 1
			</matrix>)
		</Define>
(PrintStd p)
		(List
			([SetUnit unit="^unit"](GE p 2))
			([SetUnit unit="^unit"](GE p 1)))
	</Sequence>
	</Define>

	<netpbm> ^src tmp.ppm </netpbm>
	<Shell pipe="on" cmdout="on">
		(+ "ppm2r64 -pr tmp.ppm tmp.r64 -l - -crsize 128 -cr "
			dest)
	</Shell>
	<Define> ^status <Parse encoding="utf-8">
	<Shell pipe="on" cmdout="on">
		(+ "r64status " dest)
	</Shell>
	</Parse></Define>
	<Rm>^"tmp.ppm"</Rm>
	<Rm>^"tmp.r64"</Rm>
	
	<Define> ^width ([Cast type="integer"](GE status 1)) </Define>
	<Define> ^height ([Cast type="integer"](GE status 2)) </Define>

	<Define> ^p0-lst (List 
			([SetUnit unit="^unit"] 0)
			([SetUnit unit="^unit"] 0))
	</Define>
	<Define> ^p0-crd (get-crd-pt 0 0 unit) </Define>
	<Define> ^p1-lst (List 
			([SetUnit unit="^unit"] 0)
			([SetUnit unit="^unit"] (* inv-reso height)))
	</Define>
	<Define> ^p1-crd (get-crd-pt 0 height unit) </Define>
	<Define> ^p2-lst (List 
			([SetUnit unit="^unit"] (* inv-reso width))
			([SetUnit unit="^unit"] 0)) </Define>
	<Define> ^p2-crd (get-crd-pt width 0 unit) </Define>

	<List>
		^inv-reso
		(List p0-lst p0-crd)
		(List p1-lst p1-crd)
		(List p2-lst p2-crd)
	</List>
</Export>
</Define>


<Define> ^gen-lst ()
<Arguments>
	^f ^resolution ^reso-unit
</Arguments>
<Sequence> ()
	<Save   oflag="creat:trunc" mode="0644"
		option="xl"
		format.mode="xml"
		format.indent="on"
		format.multiroot="on"
		format.text="off"
		encoding="UTF-8">
		(+ f "lst")
		(quote(
		<?xl version="0.1" encoding="UTF-8"?>
		<luster>
		<meta>
		<file type="cr"> ($ (+ f "cr")) </file>
		<scale> (/ 1 1.0) </scale>
		<scan-resolution> 
			($ ([SetUnit unit="^reso-unit"] resolution))
		</scan-resolution>
		</meta>
		</luster>
		))
	</Save>
</Sequence>
</Define>

<Define> ^bib-list ()
<Arguments> ^q ^lst </Arguments>
<Sequence> ()
	<Define> ^ret () </Define>
	<Define> ^q (cdr q) </Define>
	<Define> ^lst (cdr lst) </Define>
	<For dec="lst">
		<If> (= q ()) <Then>
			<Break> 0 </Break> </Then> </If>
		<Define> ^qq (car q) </Define>
		<Define> ^d (car lst) </Define>
		<If> (= qq ()) <Else>
			<Define> ^type (GE (GE qq 'qtype) 1)
			</Define>
			<Define> ^dd (GE (GE qq 'qdata) 1)
			</Define>
			<Define> ^sym 
				([Cast type="symbol"]
				(GE (GE qq 'qualifier) 1))
			</Define>
			<If> (= dd ()) <Then>
				<Define> ^sym
					(SetAttribute sym "data" d)
				</Define>
			</Then>
			<Else>
				<Define> ^sym
					(SetAttribute sym "data" dd)
				</Define>
			</Else></If>
			<Define> ^sym
				(SetAttribute sym "type" type)
			</Define>
			<set> ^ret (cons (List sym) ret) </set>
		</Else></If>
		<set> ^q (cdr q) </set>
	</For>
	<For dec="q">
		<Define> ^qq (car q) </Define>
		<If> (= qq ()) <Else>
			<Define> ^type (GE (GE qq 'qtype) 1)
			</Define>
			<Define> ^dd (GE (GE qq 'qdata) 1)
			</Define>
			<Define> ^sym 
				([Cast type="symbol"]
				(GE (GE qq 'qualifier) 1))
			</Define>
			<If> (= dd ())
			<Then>
				<Continue/>
			</Then>
			<Else>
				<Define> ^sym
					(SetAttribute sym "data" dd)
				</Define>
			</Else></If>
			<Define> ^sym
				(SetAttribute sym "type" type)
			</Define>
			<set> ^ret (cons (List sym) ret) </set>
		</Else></If>
		<set> ^q (cdr q) </set>
	</For>
	(cons '[bib xmlns:gb="xlp://isjhp1.nichibun.ac.jp:8080/gb_metadata"]
			ret)
</Sequence>
</Define>

<Define> ^gen-crd ()
<Arguments>
	^output-file ^encoding ^qualifier ^lst ^parameter ^unit
</Arguments>
<Sequence> ()
	<Define> ^reso-unit (+ "dot/" unit) </Define>
	<Save   oflag="creat:trunc" mode="0644"
		option="xl"
		format.mode="xml"
		format.indent="on"
		format.multiroot="on"
		format.text="off"
		encoding="^encoding">
		^output-file
		(quote(
		<?xl version="0.1" encoding="$encoding"?>
		<coordinate>
		<meta>
		($ (bib-list qualifier lst))
		<file type="e2d"/>
		<mr> ( ( ($ ([SetUnit unit="^unit"] 0))
			 ($ ([SetUnit unit="^unit"] 0)) )
			( ($ (GE (GE (GE parameter 3) 0) 0))
			  ($ (GE (GE (GE parameter 2) 0) 1)))
			)
		</mr>
		<v>
		<resolution> ($ ([SetUnit unit="^reso-unit"]
				(/ 10 (GE(GE(GE parameter 3) 0) 0))))
		</resolution>
		</v>
		</meta>
		</coordinate>
		))
	</Save>
</Sequence>
</Define>

<Define> ^gen-map ()
<Arguments>
	^file ^src ^dest ^mx
</Arguments>
<Sequence> ()
	<Save   oflag="creat:trunc" mode="0644"
		option="xl"
		format.mode="xml"
		format.indent="on"
		format.multiroot="on"
		format.text="off"
		encoding="UTF-8">
		^file
		(quote(
		<?xl version="0.1" encoding="UTF-8"?>
		<map>
		<meta>
		<file type="xl"/>
		<src> ($ src) </src>
		<dest> ($ dest) </dest>
		<dp> 1 </dp>
		</meta>
		<point-map> a1
			($ (cons 'point (GE (GE mx 1) 0)))
			($ (cons 'point (GE (GE mx 1) 1)))
		</point-map>
		<point-map> a2
			($ (cons 'point (GE (GE mx 2) 0)))
			($ (cons 'point (GE (GE mx 2) 1)))
		</point-map>
		<point-map> a3
			($ (cons 'point (GE (GE mx 3) 0)))
			($ (cons 'point (GE (GE mx 3) 1)))
		</point-map>
		</map>
		))
	</Save>
</Sequence>
</Define>

<Define> ^gen-map-zero ()
<Arguments>
	^file ^src ^dest
</Arguments>
<Sequence> ()
	<Save   oflag="creat:trunc" mode="0644"
		option="xl"
		format.mode="xml"
		format.indent="on"
		format.multiroot="on"
		format.text="off"
		encoding="UTF-8">
		^file
		(quote(
		<?xl version="0.1" encoding="UTF-8"?>
		<map>
		<meta>
		<file type="xl"/>
		<src> ($ src) </src>
		<dest> ($ dest) </dest>
		<dp> 1 </dp>
		</meta>
		<point-map> a1
			<point> 0 0 </point>
			<point> 0 0 </point>
		</point-map>
		</map>
		))
	</Save>
</Sequence>
</Define>

<Define> ^convert-worldfile ()
<Arguments>
	^f
	^w
	^data
	^w-unit
</Arguments>
<Sequence> ()
	(PrintStd f)
	(PrintStd w)
	<Define> ^mx
		(convert-to-cr f (+ w "cr") data w-unit)
	</Define>
(PrintStd mx)
	(gen-lst w (/ 1 (GE mx 0)) (+ "dot/" w-unit))
	(gen-map (+ w "map") (+ w "lst") mapping-url mx)
</Sequence>
</Define>

<Define> ^convert-worldfile-csv ()
<Arguments>
	^f
	^w
	^data
	^w-unit
	^mapping
	^encoding
	^qualifier
	^lst
</Arguments>
<Sequence> ()
	(PrintStd f)
	(PrintStd w)
	<Define> ^mx
		(convert-to-cr f (+ w "cr") data w-unit)
	</Define>
(PrintStd mx)
	(gen-lst w (/ 1 (GE mx 0)) (+ "dot/" w-unit))
	(gen-crd (+ w "crd") encoding qualifier lst mx w-unit)
	(gen-map (+ w "map") (+ w "crd") mapping mx)
	(gen-map-zero (+ w "l.map") (+ w "lst") (+ w "crd"))
</Sequence>
</Define>


<Switch>
<Case> (= mode "direct")


(PrintStd image-prefix)
(PrintStd (ListLength file-list))

<Define> ^f-list ^file-list </Define>
<For dec="f-list">
	<Define> ^f (car f-list) </Define>
	<Define> ^w (CutString f 0
			(- (StringLength f)
				(StringLength image-prefix)))
	</Define>
	<Define> ^d (ErrHandler
		([Load option="text"
			terminate="\r\n|\r|\n"] (+ w "tfw"))) </Define>
	<If> (= (GE d 5) 0) <Then>
		(convert-worldfile f w (GE d 6) w-unit)
	</Then><Else>
	</Else></If>
</For>

</Case>
<Case> (= mode "csv")

<Load option="exec"> _csv.xl </Load>

<Define> ^wf.mapping ^"" </Define>
<Define> ^wf.unit m </Define>

<Define> ^image-pos -1 </Define>
<Define> ^image-prefix ^"tif" </Define>
<csv-env type="raw">
	<Define> ^.wf.mapping ()
	<Arguments>
		^cmd ^lst
	</Arguments>
	<Sequence> ()
		<set> ^wf.mapping (GE cmd 1) </set>
		2
	</Sequence>
	</Define>

	<Define> ^.wf.processing ()
	<Arguments> ^cmd ^lst </Arguments>
	<Sequence> ()
		<If> (= image-pos -1) <Then>
		<set> ^image-pos 1 </set>
		<set> ^cmd (cdr cmd) </set>
		<For dec="cmd">
			<If> (Not (= (car cmd) ""))
			<Then>
				<set> ^image-prefix (car cmd) </set>
				<Break> 0 </Break>
			</Then></If>
			<set> ^image-pos (+ image-pos 1) </set>
		</For>
		</Then></If>
		<Define> ^file (GE lst image-pos) </Define>
		<If> (And (Not (= file ())) (Not (= file ""))) <Then>
		<Define> ^d
			([Load option="text"
				terminate="\r\n|\r|\n"] (+ file ".tfw"))
		</Define>
		(convert-worldfile-csv (+ file "." image-prefix)
				(+ file ".")
				d
				wf.unit
				wf.mapping
				(Arg 2)
				csv-qualifier
				lst
				)
		</Then></If>
		0
	</Sequence>
	</Define>

</csv-env>

<do-csv> (Arg 2) (Arg 3) </do-csv>

(PrintStd csv-qualifier)

</Case>
<Case> 1
	(PrintStd "err")
</Case>
</Switch>