Archive version of: photopoint.r ... version: 1 ... piotrgapinsk 18-Dec-2005

Amendment note: new script || Publicly available? Yes

REBOL [	
	Title: "PhotoPoint"
	Purpose: {
		Find out gps-location of the picture.
		All you need is OZI-explorer tracklog (PLT) file and EXIF JPG picture.
	}
	Date: 2005-12-17
	Version: 0.2.2
	Author: "Piotr Gapinski"
	Email: {news [at] rowery! olsztyn.pl}
	File: %photopoint.r
	Url: http://www.rowery.olsztyn.pl/wspolpraca/rebol/photopoint/
	Copyright: "Olsztynska Strona Rowerowa http://www.rowery.olsztyn.pl"
	License: "GNU General Public License (Version II)"
	Comment: {
		1. place all files (photopoint.r, OZI-explorer tracklog and images) in one directory
 		2. rename tracklog file to "tracklog.plt"
		3. adjust "timezone" variable in photopoint.r (time offset to GMT)
		4. do %photopoint.r
		5. waypoints are stored in photopoint.wpt file (OZI file format)
	}
	Library: [
		level: 'intermediate
		platform: 'all
		type: [tool]
		domain: [files]
		tested-under: [
			view 1.3.2  on [Linux]
		]
		support: none
		license: 'GPL
	]
]

ctx-exif: context [
	set 'EXIF-SOI  #{FFD8}
	set 'EXIF-APP0 #{FFE0}
	set 'EXIF-APP1 #{FFE1}
	set 'EXIF-APP2 #{FFE2}
	set 'EXIF-CMT  #{FFFE}
	set 'EXIF-EOI  #{FFD9}

	EXIF-HEADER: #{457869660000}
	TIFF-HEADER-OFFSET: 10

	EXIF-FORMS: [
		#{0001} [1 to-integer]  ;; unsigned byte (1 bajt/komponent)
		#{0002} [1 to-ascii]    ;; ascii napisy koncza sie bajtem zerowym (jest wliczony w wielkosc napisu)
		#{0003} [2 to-integer]  ;; unsigned short (2 bajty/komponent)
		#{0004} [4 to-integer]  ;; unsigned long (4 bajty/komponent)
		#{0005} [8 to-rational] ;; unsigned rational (8 bajtow/komponent)
		#{0006} [1 to-integer]  ;; signed byte (1 bajt/komponent)
		#{0007} [1 to-binary]   ;; undefined (1 bajt/komponent)
		#{0008} [2 to-integer]  ;; signed short (2 bajty/komponent)
		#{0009} [4 to-integer]  ;; signed long (4 bajty/komponent)
		#{000A} [8 to-rational] ;; signed rational (8 bajtow/komponent)
		#{000B} [4 to-binary]   ;; signed float (4 bajty/komponent)
		#{000C} [8 to-binary]   ;; double float (8 bajtow/komponent)
	]

	byte-order: "" ;; MM (Motorola) lub II (Intel)
	dat: none  ;; bufor danych
	debug: false

	range: func [
		"Pobiera fragment danych z bufora (bez weryfikacji zakresu danych); zwraca binary!"
		offset [integer!] "przesuniecie od poczatku bufora"
		length [integer!] "dlugosc danych w bajtach (wzgledem offsetu)"
		/all "dlugosc danych liczona od poczatku bufora"
		/custom "bufor danych" buffer [series!] "opcjonalny bufor z danymi"
		/local d] [

		d: any [buffer dat] ;; albo bufor przekazany jako paramentr albo bufor 'dat'
		copy/part (skip d offset) (either all [length - offset] [length])
	]

	get-content: func [
		"Pobiera size danych znajdujacych sie location bajtow za naglowkiem bufora; zwraca binary!"
		location [integer!] "przesuniecie od poczatku bufora"
		size [integer!] "dlugosc danych bajtach (wzgledem offsetu)"] [

		range (TIFF-HEADER-OFFSET + location) size
	]

	intel?: func [
		"Konwersja zapisu danych binarnych Intel-Motorola (zmiana kolejnosci bajtow)."
		bin [binary!] "dane binarne" ] [
		either (byte-order = "II") [head reverse bin] [bin]
	]

	read-traverse: func [
		"Poszukuje tag w pliku JPEG; zwraca binary! (zawartosc chunk) lub none!"
		file-name [file! string!] "nazwa pliku"
		tag [binary!] "szukany chunk-id"
		/position "zwraca offset pozycji chunk od poczatku pliku"
		/local chunk-id chunk-size offset buffer] [

		file: to-file file-name
		if error? try [
			buffer: read/binary/direct/part file 2
			if not equal? EXIF-SOI (range/custom 0 2 buffer) [return none] ;; jezeli naglowek pliku <> EXIF-SOI to nie jest to plik JPEG
			;; buffer: skip dat 2 ;; pomin SOI

			offset: 2
			forever [
				buffer: read/binary/direct/part file (offset + 4) ;; wczytaj id bloku danch i ich wielkosc
				chunk-id: range/custom offset 2 buffer
				if (chunk-id and #{FF00} <> #{FF00}) [return none]

				chunk-size: to-integer range/custom (offset + 2) 2 buffer

				if debug [print ["znaleziono chunk" chunk-id "offset" offset "wielkosc" (chunk-size + 2) "bajtow"]]

				if (chunk-id = tag) [
					buffer: skip (read/binary/direct/part file (offset + chunk-size + 2)) offset
					return either position [offset] [buffer]
				]
				offset: offset + chunk-size + 2
			]
		] [return none]
	]

	set 'exif-file? func [
		"Bada czy plik jest w formacie JPEG i zawiera dane EXIF-APP1; zwraca logic!"
		file-name [file! string!] "nazwa pliku"
		/debug "dodatkowe informacje o dzialaniu programu"
		/local size] [

		self/debug: any [(not none? debug) false]
		not none? all [
			not none? dat: read-traverse file-name EXIF-APP1
			equal? EXIF-APP1 range 0 2 ;; bajty 02:04 = FFE1
			not zero? size: to-integer range 2 2 ;; wielkosc chunk APP1
			not empty? byte-order: to-string range 10 2
		]
	]
	set 'good-file? :exif-file? ;; synonim

	set 'exif-tag func [
		"Przeszukuje katalogi struktury EXIF; zwraca block!, binary! lub none!"
		tag [binary! block!] "poszukiwane znaczniki"
		/local ifd-first ifd-next search-ifds ifds rcs tags offset] [

		if none? dat [return none]
		;; offsety sa licznone wzgledem poczatku naglowka APP1 #{FFE1}
		ifd-first: does [TIFF-HEADER-OFFSET + to-integer (intel? range 14 4)] ;; IFD0
		ifd-next: func [
			"Zwraca integer! offset do nastepnego IFD lub none!"
			offset "aktualna pozycja katalogu"
			/local elements next] [

			;; kazdy katalog zawiera nastepujace dane
			;; 00-02 liczba elementow (tagow) w katalogu
			;; ..... 12 bajtow na kazdy element w katalogu
			;; ..... 4-ro bajtowy wskaznik do nastepnego IFD lub 0

			elements: to-integer (intel? range offset 2)
			next: to-integer (intel? range (offset + 2 + (elements * 12)) 4)
			either equal? 0 next [none] [TIFF-HEADER-OFFSET + next]
		]
		search-ifds: func [
			"Szuka znacznika tag we wszystkich katalogach APP1."
			ifds [block!] "block! offsetow do katalogow APP1"
			tag [binary!] "szukany znacznik EXIF"
			/local offset rc] [

			foreach offset ifds [if not none? (rc: ifd-content offset tag) [break]]
			return rc
		]

		ifds: copy [] tags: copy [] rcs: copy []

		;; tworznie tablicy z pozycjami wszystkich katalogow EXIF v2.1
		append ifds offset: ifd-first ;; IFD0
		while [not none? (offset: ifd-next offset)] [append ifds offset] ;; IFD1,...

		;; foreach tag [#{8769} #{A005} #{8825}] [ ;; SUBIFD0 Interoperability GPSIFD
		foreach tag [#{8769} #{A005}] [ ;; SUBIFD0 Interoperability
			offset: search-ifds ifds tag
			if not none? offset [append ifds (TIFF-HEADER-OFFSET + (to-integer offset))]
		]
		ifds: sort ifds ;; znaczniki najczesciej uzywane sa przewaznie w poczatkowych katalogach

		if debug [print ["znalezione katalogi" mold ifds CRLF "rozpoczynam poszukiwania" CRLF]]

		;; traktuj przekazany parametr (tag) jako block! danych
		;; zapisuj wartosc kazdego paramtru lub none! gdy nie znaleziony
		;; pojedyncze wartosci sa zwracane bez bloku (brana jest pierwsza wartosc z listy)

		either block? tag [tags: tag][append tags tag]
		foreach tag tags [append rcs (search-ifds ifds tag)]
		either (block? tag) [rcs] [first rcs]
	]
	set 'exif-ifd :exif-tag

	ifd-content: func [
		"Wyszukuje okreslony parametr w katalogu EXIF; zwraca jego wartosc lub none!"
		offset [integer!] "lokalizacja (offset) katalogu"
		tag [binary!] "poszukiwany znacznik"
		/local items tag-format tag-length tag-value tag-components] [

		items: to-integer intel? range offset 2 ;; liczba parametrow w biezacym katalogu EXIF

		if debug [print ["szkukam" tag "w katalogu" offset "(" items "elementy/ow )"]]

		offset: offset + 2 ;; pomin 2 bajty z liczba elementow

		loop items [
			;; na kazdy element w katalogu przypada 12 bajtow
			;; 00-02 znacznik
			;; 02-04 format danych (zobacz EXIF-FORM)
			;; 04-08 liczba czesci z ktorych skladaja sie dane (liczba czesci nie oznacza liczby bajtow!)
			;; 08-12 dane znacznika lub offset do danych gdy ich dlugosc przekracza 4 bajty

			if debug [print ["-> znaleziono znacznik" (intel? range offset 2)]]
			if equal? tag (intel? range offset 2) [

				;; znaleziono wlasciwy tag - pobierz jego wartosc
				tag-format: intel? range (offset + 2) 2
				tag-components: to-integer intel? range (offset + 4) 4
				tag-length: tag-components * EXIF-FORMS/:tag-format/1 ;; liczba bajtow przypadajaca na dane jednego znacznika

				tag-value: intel? range offset + 8 4
				if (tag-length > 4) [tag-value: range (TIFF-HEADER-OFFSET + to-integer tag-value) tag-length]

				if debug [print ["-> format" tag-format tag-components "komponent/ow w buforze" tag-value "(" tag-length "bajt/y )" CRLF]]

				;; zamien na rebol datatype
				return to-rebol tag-value tag-format tag-length
			]
			offset: offset + 12 ;; do nastepnego znacznika w biezacym katalogu
		]

		if debug [print ["-> znacznika" tag "nie znaleziono!" CRLF]]
		return none
	]

	to-rebol: func [
		"Konwersja danych binarnych na Rebol datatype."
		bin [binary!] "dane binarne"
		format [binary!] "format danych"
		length [integer!] "bajtow danych (binarnych)"] [

		to-rational: func [bin [binary!] /local a b] [
			a: intel? copy/part bin 4
			b: intel? copy/part skip bin 4 4
			to-string rejoin [(to-integer a) "/" (to-integer b)]
		]
		to-ascii: func  [bin [binary!]] [trim to-string bin]

		;; zwracaj tylko tyle bajtow ile jest danych
		;; zmienna bin ma 4 bajty lub wiecej a np. dla typu "unsigned short" potrzebujemy tylko 2 bajtow
		;; proteza jest potrzebna dla typow "short", "byte" czy "ascii", ktore moga zawierac pojedyncze bajty

		return do EXIF-FORMS/:format/2 copy/part skip bin ((length? bin) - length) length
	]
]

jpeg-datetime: func [
	"Zwraca date! wykonania zdjecia zwarta w strukturze EXIF (lub none!)."
	[catch]
	file-name [file! string!] "nazwa pliku zdjecia"
	/local date time] [

	;; jezeli plik nie ma danych EXIF to zwroc none!

	if not good-file? to-file file-name [return none]
	attempt [
		set [date time] parse/all trim exif-tag #{0132} " " ;; "DateTime Tag"
		to-date rejoin [replace/all date ":" "-" "/" time] ;; "+" now/zone] ;; mozliwosc dodania strefy czasowej
	]
]

save-wpt: func [
	filename [string! file!]
	waypoints [block!]
	/local to-ozitime compare items lines num name
	latitude longitude altitude description datetime dat] [

	to-ozitime: func [
		"Zamienia date! na format programu OZI (liczba dni od 30-12-1899)"
		datetime [date!] "data do konwersji"
		/local ref] [
	
		ref: 30-12-1899/00:00
		(datetime/date - ref/date) + ((to-integer datetime/time) / 86400)
	]

	; porzadkuj waypointy narastajaco wzgledem daty punktu
	compare: func [a b] [attempt [a/datetime < b/datetime]]
	sort/compare waypoints :compare

	items: length? waypoints
	lines: copy {}
	num: 0

	foreach wpt waypoints [

		num: num + 1
		name: join "wpt" num
		latitude: wpt/latitude
		longitude: wpt/longitude
		altitude: wpt/altitude * 3.28083931316019
		description: copy/part reform [wpt/image wpt/datetime] 40
		datetime: to-ozitime wpt/datetime

		dat: rejoin [
			num "," name ","
			latitude ","
			longitude ","
			"37880,"
			datetime ","
			"70," "1," "6," "0," "13158342,"
			description ","
			"2," "0," "0,"
			altitude ","
			"8.25," "0," "17" CRLF
		]
		append lines dat
	]
	insert lines join {OziExplorer Waypoint File Version 1.1} [CRLF	"WGS 84" CRLF "Reserved 2" CRLF "garmin" CRLF]
	write/direct (to-file filename) lines
]

load-plt: func [
	"Wczytuje dane z pliku PLT, zwraca hash! [lat lon date]"
	filename [string! file!] "nazwa pliku PLT"
	/local to-datetime file items column track
	point latitude longitude altitude datetime feet] [

	to-datetime: func [
		"Konwertuje date i czas tracklogu OZI na rebol datetime!"
		ozi [number!] "OZI datetime"
		/local ref] [

		; w pliku PLT daty sa liczone jako liczba dni od 30-12-1899
		; czesc calkowita to liczba dani, ulamkowa to czas
		ref: 30-12-1899/00:00
		ref + (to-integer ozi) + to-time to-integer ((ozi - (to-integer ozi)) * 86400)
	]
	
	file: attempt [open/lines/direct/read to-file filename]
	if none? file [return none]
		
	skip file 5 ; pomin piec pierwszych linii pliku PLT
	items: to-integer trim pick file 1
	track: make hash! 2 * items
		
	; w pliku PLT pola sa rozdzielone znakiem ","; pierwsza kolumna to szerokosc geogr,
	; druga kolumna to dlugosc geogr; piata kolumna zawiera date liczona jako
	; liczba dni od 30-12-1899r; kolumna moze byc pusta (pusty ciag znakow)
	; wysokosc jest w stopach angielskich; 1 stopa to okolo 30,479 cm
	loop items [

		if none? point: attempt [pick file 1] [break]
		column: parse/all point ","

		attempt [
			latitude: (to-decimal trim first column)
			longitude: (to-decimal trim second column)
			altitude: any [
				attempt [
					feet: to-decimal trim fourth column
					if (feet <> -777) [feet / 3.28083931316019]
				]
				9.89999976239995E+24 ; wysokosc nie zdefiniowana
			]
			datetime: any [
				attempt [to-datetime to-decimal trim fifth column]
				now
			]

			repend/only track ['latitude latitude 'longitude longitude 'altitude altitude 'datetime datetime]
		]
	]
	close file
	return track
]

to-gps: func [
   "Wyszukuje wspolrzedne geograficzne na podstawie daty; zwraca block! [lat lon date] lub none!"
	track [hash! block!] "tracklog"
	datetime [date!] "data poszukiwanego punktu"
	zone [time!] "przesuniecie czasowe dodawane do daty punktu"
	/local i diff delta duration] [

	; oblicz roznice miedzy data punktu trasy i poszukiwanego miejsca
	; szukamy minimum tej roznicy

	diff: make hash! length? track
	foreach point track [
		attempt [
			append diff (abs difference (zone + (point/datetime)) datetime)
		]
	]
	attempt [
		; ignoruj gdy data zdjecia nie pasuje do dat w tracklogu
		i: index? delta: minimum-of diff
		duration: difference (select last track 'datetime) (select first track 'datetime)
		if (first delta) < duration [copy track/:i]
	]
]

; main
; strefa czasowa w zaleznosci od daty tracklogu
timezone: 2:00

; sprawdz wszystkie pliki jpg w biezacym katalogu
if none? track: load-plt %tracklog.plt [print "tracklog error" halt]
files: remove-each file read %. [(suffix? file) <> %.jpg]
waypoints: copy []

foreach file files [
	any [
		if none? datetime: jpeg-datetime file [print ["exif not found" file] true]
		if none? location: to-gps track datetime timezone [print ["location not found" file] true]
		attempt [
			repend location ['image (form second split-path file)]
			append/only waypoints location
		]
	]
]

save-wpt %photopoint.wpt waypoints
; print [length? waypoints "waypoints"]
; halt
quit