REBOL [ title: "PhotoTrackr DPL700" purpose: "Reads the memory from the Gisteq PhotoTrackr GPS logger to a file" author: "pijoter" date: 29-Sep-2009/10:17:22+2:00 file: %dpl700.r license: "GNU General Public License (Version II)" library: [ level: 'intermediate platform: 'all type: [tool] domain: [file-handling] tested-under: [ view 2.7.6 on [Linux WinXP] ] support: none license: 'GPL ] ] dt: context [ to-epoch: func [date [date!]] [ ;; epoch to czas gmt any [ attempt [to-integer (difference date 1970-01-01/00:00:00)] (date - 1970-01-01/00:00:00) * 86400 ] ] from-epoch: func [value [integer!] /zone tz [time!] /local date time dt] [ value: to-time value date: 1970-01-01 + (round/down value / 24:00:00) time: value // 24:00:00 dt: to-date rejoin [date "/" time] dt/zone: any [(if value? zone [tz]) 0:00] dt + dt/zone ] normalize: func [dt [date!] /date /time /local pad d t s] [ pad: func [val n] [head insert/dup val: form val #"0" (n - length? val)] dt: rejoin [ (pad dt/year 4) #"-" (pad dt/month 2) #"-" (pad dt/day 2) #"/" to-itime any [dt/time 0:00] ] any [ if date [copy/part dt 10] if time [copy/part (skip dt 11) 8] dt ] ] to-stamp: func [dt [date!] /date /time] [ dt: any [ if date [self/normalize/date dt] if time [self/normalize/time dt] self/normalize dt ] remove-each ch dt [found? find "-/:" ch] ] to-local: func [dt [date!] /zone offset [time!]] [ offset: any [ if zone [offset] now/zone ] dt/zone: offset dt: dt + offset ] to-gmt: func [dt [date!]] [ any [ zero? dt/zone attempt [ dt: dt - dt/zone dt/zone: 0:00 ] ] dt ] to-iso: func [dt [date!]] [ dt: self/to-gmt dt append (replace (self/normalize dt) "/" "T") "Z" ] ] host: context [ windows?: does [system/version/4 = 3] linux?: does [system/version/4 = 4] ] dpl: context [ DUMP-PREFIX: "dpl_" DUMP-SUFFIX: ".sr" hardware: context [ BUFFER-SIZE: 4'000'000 buffer: make binary! BUFFER-SIZE last-command: none last-response: none cmd-table: [ "ident" [ "WP AP-Exit^@" none ;; INIT "W'P Camera Detect^@" "WP GPS+BT^@" ;; BOD "WP AP-Exit^@" none ;; EXIT ] "dump" [ "WP AP-Exit^@" none ;; INIT "W'P Camera Detect^@" "WP GPS+BT^@" ;; BOD #{60b50000000000} "WP Update Over^@" ;; DUMP "WP AP-Exit^@" none ;; EXIT ] "erase" [ "WP AP-Exit^@" none ;; INIT "W'P Camera Detect^@" "WP GPS+BT^@" ;; BOD #{61b60000000000} [0:0:8 "WP Update Over^@"] ;; ERASE "WP AP-Exit^@" none ;; EXIT ] "datetime" [ "WP AP-Exit^@" none ;; INIT "W'P Camera Detect^@" "WP GPS+BT^@" ;; BOD #{64B80000000000} 16 ;; DATETIME "WP AP-Exit^@" none ;; EXIT ] "reset" [ "WP AP-Exit^@" none ;; EXIT ] "test" [ "WP AP-Exit^@" none ;; INIT "W'P Camera Detect^@" "WP GPS+BT^@" ;; BOD #{63B70000000000} 4 ;; ??? "WP AP-Exit^@" none ;; EXIT ] ] reset: func [gps [port!] /local cmd] [ cmd: select self/cmd-table "reset" if block? cmd [insert gps first cmd] ] flow: func [gps [port!] cmd [word! string! block!] /callback f [function!] /local pairs awake command response timeout status item bytes-requested bytes-received match tmp start-datetime ready] [ pairs: any [ if block? cmd [cmd] select self/cmd-table (to-string cmd) ] if any [none? pairs empty? pairs] [return false] awake: any [:f (get in self 'awake)] start-datetime: now/precise foreach [command response] pairs [ if command <> 'none [ write-io gps command (length? command) self/last-command: command net-utils/net-log ["flow/write" (mold command)] ] if response <> 'none [ if not block? response [response: reduce [response]] bytes-requested: any [ if integer? bytes-requested: first response [bytes-requested] none ;; till EOD ] timeout: any [ if time? timeout: first response [timeout] 0.1 ] clear self/buffer bytes-received: 0 self/last-response: none set/any 'status try [ until [ wait [gps timeout] bytes: any [attempt [read-io gps tmp: self/buffer any [bytes-requested 20480]] 0] bytes-received: length? self/buffer net-utils/net-log ["flow/read" "received" (bytes-received) "last-read" bytes] if bytes <= ZERO [break] match: false foreach item response [ if all [ any [(string? item) (binary? item)] found? match: find/last self/buffer item ][ self/last-response: copy/part match (length? item) if string? item [self/last-response: to-string self/last-response] remove/part match (length? item) net-utils/net-log ["dpl/flow" "response found" (mold self/last-response)] break ] ] any [ found? match bytes-received = bytes-requested ] ] ] ;; try ready: all [(not error? get/any 'status) (bytes-received > ZERO)] net-utils/net-log ["flow/time" (difference now/precise start-datetime)] net-utils/net-log ["flow/callback" (ready)] any [ if ready [awake self] break ] ] ] ] is-gisteq?: does [self/last-response = "WP GPS+BT^@"] is-over?: does [self/last-response = "WP Update Over^@"] awake: func [hardware [object!]] [true] ] cmd: get in self/hardware 'flow connected?: func [port [word! string!] /local device gisteq-found?] [ gisteq-found?: false port: to-word port if device: self/init port [ self/cmd/callback device "ident" func [hardware [object!]] [ if gisteq-found?: hardware/is-gisteq? [ net-utils/net-log ["dpl/connected?" (port)] ] true ;; callback ] close device ] gisteq-found? ] detect: has [serial com port device] [ printd "trying to find phototrackr gps device..." serial: system/ports/serial any [ if host/windows? [ repeat c 10 [ com: to-word (join "com" c) if not found? find serial com [append serial com] ] ] if host/linux? [ append serial [ttyUSB0 ttyUSB1 ttyACM0 ttyACM1 ttyS0 ttyS1] ] ] forall serial [ port: to-word join "port" (index? serial) if self/connected? port [ printd ["found! /" (port) (pick system/ports/serial index? serial)] break/return port ] ] ] init: func [port [word!] /local device] [ device: attempt [ open/binary/direct/no-wait compose [ scheme: 'serial device: port speed: 115200 data-bits: 8 parity: 'none stop-bits: 1 rts-cts: off timeout: 1 ] ] net-utils/net-log ["dpl/init" (port) (not none? device)] device ] erase!: func [port [word!] /local device erased?] [ net-utils/net-log "dpl/erase!" erased?: false if device: self/init port [ printd "erasing memory..." self/cmd/callback device "erase" func [hardware [object!]] [ if binary? hardware/last-command [ either erased?: hardware/is-over? [ net-utils/net-log ["dpl/erase!" (true)] printd "gps memory is empty now!" ][ self/debug hardware ] ] true ;; callback ] self/cmd device "reset" close device ] erased? ] dump: func [port [word!] /as name [string! file!] /local device mark saved?] [ net-utils/net-log "dpl/dump" saved?: false if device: self/init port [ printd "reading memory..." self/cmd/callback device "dump" func [hardware [object!] /local file] [ if binary? hardware/last-command [ either all [ hardware/is-over? (length? hardware/buffer) = 3997696 ][ count: any [ if found? mark: find hardware/buffer #{FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF} [ attempt [to-integer ((index? mark) / 16)] ] 3997696 / 16 ] file: to-file any [ if all [(as) (not empty? name)] [name] rejoin [self/DUMP-PREFIX (dt/to-stamp now) self/DUMP-SUFFIX] ] net-utils/net-log ["dpl/dump" (file) (length? hardware/buffer) "bytes" (count) "records"] printd [(form file) "/" (length? hardware/buffer) "bytes" count "records"] attempt [ write/binary file hardware/buffer saved?: true ] ][ self/debug hardware ] ] true ;; callback ] self/cmd device "reset" close device ] saved? ] datetime: func [port [word!] /gmt /local device gmt-date] [ net-utils/net-log "dpl/datetime" gmt-date: none if device: self/init port [ self/cmd/callback device "datetime" func [hardware [object!] /local dtm date time] [ if binary? hardware/last-command [ dtm: hardware/buffer if (length? dtm) = 16 [ date: to-date reduce [(dtm/4 + 2000) dtm/5 dtm/6] time: to-time reduce [dtm/1 dtm/2 dtm/3] gmt-date: to-date rejoin [date "/" time "+" 0:0] net-utils/net-log ["dpl/datetime" "raw" (dtm) "cooked" (gmt-date) "GMT"] ][ self/debug hardware ] ] true ;; callback ] self/cmd device "reset" close device ] if gmt-date [ printd ["gps datetime" dt/normalize gmt-date "GMT"] any [ if gmt [gmt-date] dt/to-local gmt-date ] ] ] debug: func [hardware [object!]] [ print "something went wrong!" print ["[debug]" (mold hardware/last-command) (mold hardware/last-response) (length? hardware/buffer)] ] ] printd: func [message [block! string!]] [ any [ system/options/quiet print message ] ] hold: does [ any [ system/options/quiet not host/windows? ask "^/press enter" ] ] getopts: func [cmds [string!] cases [block!] /default case [block!] /local args cmd opts opt rcs] [ args: any [system/script/args ""] args: parse args none cmds: parse cmds ":" rcs: make block! length? cmds forall cmds [ cmd: first cmds if found? opts: find args (join "--" cmd) [ set [opt optargs] opts ;; parametr opcji nie moze byc taki sam jak opcja any [ none? optargs (length? optargs) <= 2 not found? find head cmds (skip optargs 2) optargs: none ] if (opt = (join "--" cmd)) [(append rcs cmd) (switch cmd cases)] ] ] any [ if all [empty? rcs function? case] [do case] true ] ] ;### main ### system/options/quiet: false net-watch: false if all [net-watch none? system/script/args] [system/script/args: "--verbose"] cmds: make block! 4 gps: none filename: none printd [ system/script/header/title LF system/script/header/purpose LF ] getopts "help:port::dump::erase:datetime:test:quiet:verbose" [ "port" [ device: to-word any [ attempt [to-string second (split-path to-file any [optargs "ttyACM0"])] "ttyACM0" ] port: any [ if found? port: find system/ports/serial device [index? port] length? append system/ports/serial device ] gps: to-word join "port" port ] "dump" [ append cmds "dump" filename: all [optargs (attempt [to-file optargs])] ] "erase" [append cmds "erase"] "datetime" [append cmds "datetime"] "quiet" [system/options/quiet: true] "help" [append cmds "help"] "verbose" [ net-watch: true echo to-file rejoin ["log_" (dt/to-stamp now) ".txt"] ] "test" [append cmds "test"] ] if empty? cmds [append cmds "dump"] net-utils/net-log ["main/getopts" "cmds" cmds] if found? find cmds "help" [ print [ system/script/header/file "[--port {comX|unix-device}] --dump [filename] --erase --datetime --test --help --quiet --verbose" ] hold quit ] gps: any [gps dpl/detect] if any [(none? gps) (not dpl/connected? gps)] [ print "no gps - no fun!" hold quit ] foreach cmd cmds [ switch cmd [ "dump" [ any [ if filename [dpl/dump/as gps filename] dpl/dump gps ] ] "erase" [dpl/erase! gps] "datetime" [dpl/datetime gps] "test" [ ;; API if device: dpl/init gps [ dpl/cmd/callback device "test" func [hardware [object!]] [ if binary? hardware/last-command [ print ["cmd" form hardware/last-command] print ["response" form hardware/buffer] ] true ;; callback ] close device ] ] ] ] hold quit