Archive version of: dpl700.r ... version: 2 ... piotrgapinsk 17-Sep-2009

REBOL [
	title: "PhotoTrackr DPL700"
	purpose: "Reads the memory from the Gisteq PhotoTrackr GPS logger to a file"
	author: "pijoter"
	date: 17-Sep-2009/11:01:44+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] [
		dt: any [
			if date [self/normalize/date 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-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:5 "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
			]
		]

		reset: func [gps [port!] /local cmd] [
			cmd: select self/cmd-table "reset"
			if cmd [insert gps first cmd]
		]

		flow: func [gps [port!] cmd [word! string!]
			/callback f [function!]
			/local pairs awake command response timeout status item bytes-requested bytes-received
			match start-datetime awaked?] [

			if none? pairs: select self/cmd-table (to-string cmd) [return false]
			awake: any [:f (get in self 'awake)]
			start-datetime: now/precise

			foreach [command response] pairs [
				if command <> 'none [
					insert gps 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]
						ZERO ;; till EOD
					]

					timeout: any [
						if time? timeout: first response [timeout]
						0.1
					]

					clear self/buffer
					self/last-response: none

					status: try [
						until [
							if wait [gps timeout] [
								either bytes-requested > ZERO [
									read-io gps self/buffer bytes-requested
								][
									append self/buffer (copy gps)
								]
							]

							bytes-received: length? self/buffer
							net-utils/net-log ["flow/read" (bytes-received) (mold copy/part self/buffer 20) (to-string copy/part self/buffer 20) "..."]
							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
								zero? bytes-received
								bytes-received = bytes-requested
							]
						]
					] ;; try

					awaked?: any [
						if all [(not error? status) (bytes-received > ZERO)] [awake self]
						false
					]
					net-utils/net-log ["flow/awaked?" (awaked?)]
					net-utils/net-log ["flow/time" (difference now/precise start-datetime)]

					if (not awaked?) [
						self/reset gps
						break/return false
					]
				]
			]
		]

		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

	detect: has [serial com port device gisteq-found] [
		self/inform "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-lit-word join "port" (index? serial)

			if device: self/init port [
				gisteq-found: false

				self/cmd/callback device "ident" func [hardware [object!]] [
					if gisteq-found: hardware/is-gisteq? [
						net-utils/net-log ["dpl/detect" "gisteq found" (port)]
					]
					true
				]

				close device
				if gisteq-found [
					self/inform ["found" port]
					break/return port
				]
			]
		]
	]

	init: func [port [word!] /local device] [
		device: attempt [
			open/binary/no-wait compose [
				scheme: 'serial
				device: port
				speed: 9600
				data-bits: 8
				parity: 'none
				stop-bits: 1
				rts-cts: yes
				timeout: 1
			]
		]
		net-utils/net-log ["dpl/init" (port) (not none? device)]
		device
	]

	erase!: func [port [word!] /local device] [
		net-utils/net-log "dpl/erase!"

		if device: self/init port [
			self/inform "erasing memory..."

			self/cmd/callback device "erase" func [hardware [object!]] [
				if binary? hardware/last-command [
					either hardware/is-over? [
						net-utils/net-log ["dpl/erase!" (true)]
						self/inform "gps memory is empty now!"
					][
						self/debug hardware
					]
				]

				true
			]

			self/cmd device "reset"
			close device
		]
	]

	dump: func [port [word!] /as name [string! file!] /local device mark] [
		net-utils/net-log "dpl/dump"

		if device: self/init port [
			self/inform "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
					][
						file: to-file any [
							if all [(as) (not empty? name)] [name]
							join (dt/to-stamp now) self/DUMP-SUFFIX
						]

						count: any [
							if found? mark: find hardware/buffer #{FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF} [
								attempt [to-integer ((index? mark) / 16)]
							]
							3997696 / 16
						]
							
						net-utils/net-log ["dpl/dump" (file) (length? hardware/buffer) "bytes" (count) "records"]
						self/inform [(form file) "/" (length? hardware/buffer) "bytes" count "records"]

						attempt [write/binary file hardware/buffer]
					][
						self/debug hardware
					]
				]

				true
			]

			self/cmd device "reset"
			close device
		]
	]

	datetime: func [port [word!] /gmt /local device gmt-date] [
		net-utils/net-log "dpl/datetime"

		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
			]
		]

		self/cmd device "reset"
		close device

		if gmt-date [
			self/inform reduce ["gps datetime" dt/normalize gmt-date "GMT"]
			any [
				if gmt [gmt-date]
				dt/to-local gmt-date
			]
		]
	]

	inform: func [message [block! string!]] [
		any [
			system/options/quiet
			print message
		]
	]

	debug: func [hardware [object!]] [
		print "something went wrong!"
		print ["[debug]" (mold hardware/last-command) (mold hardware/last-response) (length? hardware/buffer)]
	]
]

net-watch: false
system/options/quiet: false
if net-watch [echo to-file (join dt/to-stamp now "_log.txt")]

use [gps] [
	either gps: dpl/detect [
		dpl/datetime/gmt gps
		dpl/dump gps
		;; dpl/dump/as gps "test.sr"
		;; dpl/erase! gps
		print "done."
	][
		print "no gps - no fun!"
	]
]

echo none
quit