REBOL [ Title: "PhotoPoint" Purpose: {Combine GPS tracklog and jpeg/exif files to find out where digital photos were taken} Date: 2006-07-10 Version: 0.4.1 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 PLT 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 Waypoints are stored in images (as jpeg comment) and in photopoint.wpt file (OZI-explorer WPT format). As long as the GPS was in the same location as the camera this represents the location of the photo. } Library: [ level: 'intermediate platform: 'all type: [tool] domain: [files] tested-under: [ core 2.6.0 on 'Linux view 1.3.2 on [Linux WinXP] ] support: none license: 'GPL ] ] ; strefa czasowa w zaleznosci od daty tracklogu timezone: +00:00 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 ] set 'jpeg-datetime func [ "Zwraca date! wykonania zdjecia zwarta w strukturze EXIF (lub none!)." [catch] file-name [file! string!] "nazwa pliku zdjecia" /local date time] [ 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 ] ] set 'jpeg-thumbnail func [ "Zwraca image! miniaturki zdjecia z pliku EXIF lub none! (obsluguje tylko JPEG EXIF)." [catch] file-name [file! string!] "nazwa pliku zdjecia" /binary "Zwraca zdjecie w formacie binary! (JPEG)" /local compression location size thumb] [ if not good-file? to-file file-name [return none] attempt [ set [compression location size] exif-tag [#{0103} #{0201} #{0202}] ;; Compression, Size, OffsetTag if compression = 6 [ ;; 6 oznacza iz mamy do czynienia z miniaturka zdjecia w formacie JPEG thumb: self/get-content location size either binary [thumb] [load thumb] ] ] ] set 'jpeg-size func [ "Zwraca pair! rozdzielczosci zdjecia EXIF lub none!" [catch] file-name [file! string!] "nazwa pliku zdjecia"] [ if not good-file? to-file file-name [return none] attempt [to-pair exif-tag [#{a002} #{a003}]] ] ] ctx-ozi: context [ not-valid-altitude: -777 ; znacznik braku wysokosci dla OZI-explorer meters: 9.89999976239995E+24 reference-date: 30-12-1899/00:00 to-datetime: func [ "Konwertuje date i czas tracklogu OZI na rebol datetime!" ozi [number!] "OZI datetime"] [ ; w pliku PLT daty sa liczone jako liczba dni od 30-12-1899 ; czesc calkowita to liczba dani, ulamkowa to czas reference-date + (to-integer ozi) + to-time to-integer ((ozi - (to-integer ozi)) * 86400) ] to-ozitime: func [ "Zamienia date! na format programu OZI (liczba dni od 30-12-1899)" datetime [date!] "data do konwersji"] [ (datetime/date - reference-date/date) + ((to-integer datetime/time) / 86400) ] to-meters: func [feet [number!]] [either (feet = not-valid-altitude) [feet] [feet / 3.28083931316019]] to-feet: func [meters [number!]] [either (meters = not-valid-altitude) [meters] [meters * 3.28083931316019]] set 'save-wpt func [ filename [string! file!] waypoints [block!] /local compare items lines num name latitude longitude altitude description datetime dat] [ ; 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 [ attempt [ num: minimum (num + 1) 1000 name: join "wpt" num latitude: wpt/latitude longitude: wpt/longitude altitude: to-feet wpt/altitude description: replace (copy/part reform [wpt/image wpt/image-datetime] 40) "," "_" datetime: to-ozitime wpt/datetime dat: rejoin [ num "," ; Number - this is the location in the array (max 1000), must be unique name "," ; Name - the waypoint name, use the correct length name to suit the GPS type latitude "," ; Latitude - decimal degrees longitude "," ; Longitude - decimal degrees datetime "," ; Date - if blank a preset date will be used "70," ; Symbol - 0 to number of symbols in GPS "1," ; Status - always set to 1 "6," ; Map Display Format "0," ; Foreground Color (RGB value) "13158342," ; Background Color (RGB value) description "," ; Description (max 40), no commas "2," ; Pointer Direction "0," ; Garmin Display Format "0," ; Proximity Distance - 0 is off any other number is valid altitude "," ; Altitude - in feet (-777 if not valid) "8.25," ; Font Size - in points "0," ; Font Style - 0 is normal, 1 is bold "17" CRLF ; Symbol Size - 17 is normal size ] 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 ] set 'load-plt func [ "Wczytuje dane z pliku PLT, zwraca hash! [lat lon date]" filename [string! file!] "nazwa pliku PLT" /local file items column track point latitude longitude altitude datetime] [ 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! 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 [to-meters (to-decimal trim fourth column)] to-meters not-valid-altitude ] 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 ] ] ctx-photopoint: context [ byte-order: "" to-hex: func [val /local s r] [ s: make struct! [i [integer!]] none s/i: val r: copy/part (third s) 2 either self/byte-order = "II" [reverse r] [r] ] set 'find-location 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 duration: abs difference (select last track 'datetime) (select first track 'datetime) i: index? delta: minimum-of diff if (first delta) < duration [copy track/:i] ] ] set 'make-comment func [ "zapis informacji o waypoincie jako komentarz pliku JPEG" file [string! file!] "nazwa pliku JPEG" location [block!] /backup "zapisuj informacje do kopii oryginalow" /local new-file dat pos info] [ file: to-file file orig: join file ".orig" ; zabezpiecz oryginal pliku if none? attempt [ dat: read/binary/direct file pos: to-integer ctx-exif/read-traverse/position file EXIF-APP1 rename file orig ] [return false] ; jezeli pojawi sie blad to usun nowy plik i przywroc oryginalna nazwe any [ attempt [ byte-order: to-string ctx-exif/range/custom (pos + 10) 2 dat len: 2 + to-integer ctx-exif/range/custom (pos + 2) 2 dat ;; wielkosc danych w chunk + dwa bajty na sam znacznik info: form location write/binary file copy/part dat (pos + len) write/append/binary file repend #{} [EXIF-CMT (to-hex 2 + length? info) (to-binary info)] write/append/binary file (skip dat (pos + len)) if not value? 'backup [delete orig] true ] do [ attempt [delete file] attempt [rename orig file] false ] ] ] ] ; sprawdz wszystkie pliki jpg w biezacym katalogu if none? track: load-plt %tracklog.plt [print "tracklog load error" halt] files: remove-each file read %. [(suffix? file) <> %.jpg] if empty? files [print "no files to process" halt] waypoints: copy [] foreach file files [ any [ if none? datetime: jpeg-datetime file [print ["exif metadata not found" file] true] if none? location: find-location track datetime timezone [print ["location not found" file] true] attempt [ ;; print [file location/latitude location/longitude location/datetime] repend location ['image (form file) 'image-datetime datetime] append/only waypoints location make-comment/backup file location ] ] ] save-wpt %photopoint.wpt waypoints if (length? files) <> (length? waypoints) [halt] quit