Script Library: 1247 scripts
  • Home
  • Script library
  • AltME Archive
  • Mailing list
  • Articles Index
  • Site search
 

Archive version of: dpl700.r ... version: 1 ... piotrgapinsk 14-Sep-2009

Amendment note: new script || Publicly available? Yes

REBOL [
    title: "PhotoTrackr DPL700r"
    purpose: "Reads the memory from the Gisteq PhotoTrackr GPS logger (MTK) to a file"
    author: "pijoter"
    date: 14-Sep-2009/19:32+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-gmt: func [date [date!]] [
		any [
			zero? date/zone
			attempt [
				date: date - date/zone
				date/zone: 0:00
			]
		]
		date
	]

	to-iso: func [date [date!]] [
		date: self/to-gmt date
		append (replace (self/normalize date) "/" "T") "Z"
	]
]

host: context [
	windows?: does [system/version/4 = 3]
	linux?: does [system/version/4 = 4]
]

dpl: context [
	DUMP-SUFFIX: ".sr"

	hardware: context [
		gps-said: make binary! 4'000'000
		buffer: make binary! 5'000

		last-command: none
		last-result: none

		cmd-table: [
			"ident" [
				"WP AP-Exit^@" none						;; EXIT
				"WP AP-Exit^@" none						;; INIT
				"W'P Camera Detect^@" "WP GPS+BT^@"		;; BOD
				"WP AP-Exit^@" none						;; EXIT
			]
			"dump" [
				"WP AP-Exit^@" none						;; EXIT
				"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						;; EXIT
				"WP AP-Exit^@" none						;; INIT
				"W'P Camera Detect^@" "WP GPS+BT^@"		;; BOD
				#{61b60000000000} "WP Update Over^@"	;; ERASE
				"WP AP-Exit^@" none						;; EXIT
			]
			"reset" [
				"WP AP-Exit^@" none						;; EXIT
			]
		]

		flow: func [gps [port!] cmd [word! string!]
			/callback f [function!]
			/local pairs awake command response item bytes-received match] [

			if none? pairs: select self/cmd-table cmd [return false]
			awake: any [:f (get in self 'awake)]

			foreach [command response] pairs [
				if command <> 'none [
					self/last-command: command
					net-utils/net-log ["flow/write" trim form command]

					if error? try [insert gps command][
						attempt [insert gps first self/cmd/reset]
						return false
					]

					wait 0.1
				]

				if response <> 'none [
					any [
						block? response
						response: reduce [response]
					]
					clear gps-said
					self/last-result: none

					until [
						clear buffer
						wait 0.01

						if error? try [bytes-received: read-io gps buffer 5'000][
							if binary? self/last-command [
								attempt [
									loop 1'000 [
										read-io gps buffer 4'000
										clear buffer wait 0.01
									]
								]
							]

							attempt [insert gps first self/cms/reset]
							return false
						]

						net-utils/net-log ["flow/read" bytes-received copy/part (to-string buffer) 60]

						foreach item response [
							if found? match: find/last buffer item [
								self/last-result: to-string copy/part match (length? item)

								net-utils/net-log ["dpl/flow" "response found" trim form item]

								remove/part match (length? item)
								break
							]
						]

						append gps-said buffer
						any [(found? match) (zero? bytes-received)]
					]

					if (not awake self) [
						insert gps first self/cmd/reset
						return false
					]
				]
			]
		]

		is-gisteq?: does [self/last-result = "WP GPS+BT^@"]
		is-over?: does [self/last-result = "WP Update Over^@"]
		awake: func [hardware [object!]] [true]
	]

	cmd: get in self/hardware 'flow

	detect: has [serial com port device gisteq-found] [
		any [
			system/options/quiet
			print "trying to talk to the USB devices..."
		]

		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 [break/return port]
			]
		]
	]

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

	erase!: func [port [word!] /local device] [
		if device: self/init port [

			any [
				system/options/quiet
				print "erasing memory..."
			]

			self/cmd/callback device "erase" func [hardware [object!]] [
				if all [
					binary? hardware/last-command
					hardware/is-over?
				][
					net-utils/net-log ["dpl/erase!" true]
					any [
						system/options/quiet
						print "gps memory is empty now!"
					]
				]
				true
			]

			self/cmd device "reset"
			close device
		]
	]

	dump: func [port [word!] /as name [string! file!] /local device] [
		if device: self/init port [

			any [
				system/options/quiet
				print "reading memory..."
			]

			self/cmd/callback device "dump" func [hardware [object!]
				/local buffer file] [

				if all [
					binary? hardware/last-command
					hardware/is-over?
				][
					buffer: hardware/gps-said

					file: to-file any [
						if all [(as) (not empty? name)] [name]
						join (dt/to-stamp now) self/DUMP-SUFFIX
					]

					net-utils/net-log ["dpl/dump" file (length? buffer) "bytes"]
					any [
						system/options/quiet
						print [form file "/" (length? buffer) "bytes"]
					]
					attempt [write/binary file buffer]
				]
				true
			]

			self/cmd device "reset"
			close device
		]
	]
]


net-watch: false
system/options/quiet: false

use [port] [
	either port: dpl/detect [
		any [
			system/options/quiet
			print ["gps found!" port]
		]
		dpl/dump port
		;; dpl/dump/as port "test.sr"
		;; dpl/erase! port
	][
		print "no gps - no fun!"
	]
]

quit