add AIS decoder

src/libraries/OS-Independent/Message/Encodings/AIS.dcl

+definition module Message.Encodings.AIS
+/**
+* This module provides functions for decoding a stream of AIVDM/AIVDO messages.
+* These messages transmitted by AIS (Automatic Identification System) radio receivers.
+*
+* This module is based on the information provided at:
+* http://gpsd.berlios.de/AIVDM.html
+* and the python ais.py decoder of the gpsd project
+*
+* Currently this module decodes type 1-5, 18, 19 and 27 messages. All other message types are ignored.
+*/
+
+from Data.Maybe import :: Maybe
+
+// AIVDM Message data
+
+:: AIVDM
+	= AIVDM1  !AIVDMCNB
+	| AIVDM2  !AIVDMCNB
+	| AIVDM3  !AIVDMCNB
+	| AIVDM4  !AIVDM4
+	| AIVDM5  !AIVDM5
+	| AIVDM18 !AIVDM18
+	| AIVDM19 !AIVDM19
+	| AIVDM27 !AIVDM27
+	| AIVDM   !Int //An unsupported message type
+
+:: AIVDMCNB = //Common Navigation Block (data for messages type 1,2 and 3)
+	{ msgtype	:: !Int       // Message Type
+	, repeat	:: !Int       // Repeat Indicator
+	, mmsi		:: !Int       // MMSI
+	, status	:: !Int       // Navigation Status
+	, turn		:: !Maybe Int // Rate of Turn
+	, speed		:: !Maybe Int // Speed Over Ground
+	, accuracy	:: !Bool      // Position Accuracy
+	, lon		:: !Int       // Longitude
+	, lat		:: !Int       // Latitude
+	, course    :: !Maybe Int // Course Over Ground
+	, heading	:: !Maybe Int // True Heading
+	, second	:: !Int       // Time Stamp
+	, maneuver	:: !Int       // Manuever Indicator
+	, raim		:: !Bool      // RAIM flag
+	, radio		:: !Int       // Radio status
+	}
+
+:: AIVDM4 = //Type 4 message (Base station report)
+	{ msgtype		:: Int		// Message Type
+	, repeat		:: Int		// Repeat Indicator
+	, mmsi			:: Int		// MMSI
+	, year			:: Int		// Year
+	, month			:: Int		// Month
+	, day			:: Int		// Day
+	, hour			:: Int		// Hour
+	, minute		:: Int		// Minute
+	, second		:: Int		// Second
+	, accuracy		:: Bool		// Fix quality
+	, lon			:: Int		// Longitude
+	, lat			:: Int		// Latitude
+	, epfd			:: Int		// Type of EPFD
+	, raim			:: Bool		// RAIM flag
+	, radio			:: Int		// SOTDMA state
+	}
+
+:: AIVDM5 = //Type 5 message (Static and Voyage Related data)
+	{ msgtype		:: Int		// Message type
+	, repeat		:: Int		// Repeat Indicator
+	, mmsi			:: Int		// MMSI
+	, ais_version	:: Int		// AIS Version
+	, imo_id		:: Int		// IMO Identification Number
+	, callsign		:: String	// Call Sign
+	, shipname		:: String	// Vessel Name
+	, shiptype		:: Int		// Ship Type
+	, to_bow		:: Int		// Dimension to Bow
+	, to_stern		:: Int		// Dimension to Stern
+    , to_port		:: Int		// Dimension to Port
+	, to_starboard	:: Int		// Dimension to Starboard
+    , epfd			:: Int		// Position Fix Type
+	, month			:: Int		// ETA month
+	, day			:: Int		// ETA day
+	, hour			:: Int		// ETA hour
+	, minute		:: Int		// ETA minute
+	, draught		:: Int 		// Draught
+	, destination	:: String	// Destination
+	, dte			:: Bool		// DTE
+	}
+
+//* Standard Class B CS Position Report
+:: AIVDM18 =
+	{ repeat	:: !Int       // Repeat Indicator
+	, mmsi		:: !Int       // MMSI
+	, speed		:: !Maybe Int // Speed Over Ground
+	, accuracy	:: !Bool      // Position Accuracy
+	, lon		:: !Int       // Longitude
+	, lat		:: !Int       // Latitude
+	, course	:: !Maybe Int // Course Over Ground
+	, heading	:: !Maybe Int // True Heading
+	, second	:: !Int       // Time Stamp
+	// TODO: add left out fields
+	, raim		:: !Bool      // RAIM flag
+	, radio		:: !Int       // Radio status
+	}
+
+//* Extended Class B CS Position Report
+:: AIVDM19 =
+	{ repeat	:: !Int       // Repeat Indicator
+	, mmsi		:: !Int       // MMSI
+	, speed		:: !Maybe Int // Speed Over Ground
+	, accuracy	:: !Bool      // Position Accuracy
+	, lon		:: !Int       // Longitude
+	, lat		:: !Int       // Latitude
+	, course	:: !Maybe Int // Course Over Ground
+	, heading	:: !Maybe Int // True Heading
+	, second	:: !Int       // Time Stamp
+	, shipname  :: !String
+	, shiptype  :: !Int // Ship Type
+	, to_bow        :: !Int		// Dimension to Bow
+	, to_stern      :: !Int		// Dimension to Stern
+	, to_port       :: !Int		// Dimension to Port
+	, to_starboard  :: !Int		// Dimension to Starboard
+	, epfd          :: !Int		// Position Fix Type
+	, raim          :: !Bool      // RAIM flag
+	, dte           :: !Bool		// DTE
+	, assignedMode  :: !Bool
+	}
+
+//* Long Range AIS Broadcast message
+:: AIVDM27 =
+	{ repeat	:: !Int       // Repeat Indicator
+	, mmsi		:: !Int       // MMSI
+	, accuracy	:: !Bool      // Position Accuracy
+	, raim		:: !Bool      // RAIM flag
+	, status	:: !Int       // Navigation Status
+	, lon		:: !Int       // Longitude
+	, lat		:: !Int       // Latitude
+	, speed		:: !Maybe Int // Speed Over Ground
+	, course	:: !Maybe Int // Course Over Ground
+	, gnss      :: !Bool
+	}
+
+/**
+* Decodes a series of encoded AIVDM sentences to a series of
+* decoded messages. AIVDM is the message format used by AIS
+* AIVDM messages can consist of multiple sentences, so only full messages
+* are parsed. If there are sentences of yet incomplete messages they are returned
+*/
+decodeAIVDM :: ![String] -> (![AIVDM], ![String])

src/libraries/OS-Independent/Message/Encodings/AIS.icl

+implementation module Message.Encodings.AIS
+
+import StdEnv
+import Data.Func, Data.GenDefault, Data.Maybe, Data.Tuple
+import Text
+
+decodeAIVDM :: ![String] -> (![AIVDM], ![String])
+decodeAIVDM [] = ([],[])
+decodeAIVDM sentences
+	# (payload, remainder) = decodeWrapper sentences
+	= case payload of
+		[]  = ([],remainder)
+		parts
+			# cnb = decodePayload (concat parts)
+			# (cnbs,remainder) = decodeAIVDM remainder
+			= ([cnb:cnbs],remainder)
+where
+	//Take a number of fragments from the stream to unwrap and reconstruct the message payload
+	decodeWrapper :: [String] -> ([{#Char}], [String])
+	decodeWrapper [] = ([],[])
+	decodeWrapper [sentence:remainder]
+		= case split "," sentence of
+			[f1,f2,f3,f4,f5,f6,f7]
+				| f1 <> "!AIVDM" && f1 <> "!BSVDM" && f1 <> "!ABVDM" && f1 <> "!AIVDO" && f1 <> "!BSVDO" && f1 <> "!BYVDM" && f1 <> "!SSVDM" && f1 <> "!SSVDO" && f1 <> "!BYVDO" && f1 <> "!ABVDO"
+					= ([],remainder)
+				# fragmentCount = toInt f2
+				# fragmentNum = toInt f3
+				| fragmentCount == fragmentNum
+					= ([f6],remainder)
+				| otherwise
+					# (fragments,remainder) = decodeWrapper remainder
+					= ([f6:fragments],remainder)
+			_ 	= ([],remainder)
+
+	//Decode the message data
+	decodePayload :: {#Char} -> AIVDM
+	decodePayload bits
+		# bits = bv_unarmor bits
+		= snd ((decodeDyn decodeMsgType decoderByType) bits 0)
+	where
+		decodeMsgType bits pos = decodeUnsigned 6 (\t _ -> initMessage t) bits pos (AIVDM 0)
+
+		decoderByType :: !{#Char} !Int !AIVDM -> (!Int, !AIVDM)
+		decoderByType bits pos msg = case msg of
+			AIVDM1  m = appSnd AIVDM1  $ decodeCNB bits pos m
+			AIVDM2  m = appSnd AIVDM2  $ decodeCNB bits pos m
+			AIVDM3  m = appSnd AIVDM3  $ decodeCNB bits pos m
+			AIVDM4  m = appSnd AIVDM4  $ decodeType4  bits pos m
+			AIVDM5  m = appSnd AIVDM5  $ decodeType5  bits pos m
+			AIVDM18 m = appSnd AIVDM18 $ decodeType18 bits pos m
+			AIVDM19 m = appSnd AIVDM19 $ decodeType19 bits pos m
+			AIVDM27 m = appSnd AIVDM27 $ decodeType27 bits pos m
+			m         = decodeSpare 0 bits pos m//Nop
+
+		initMessage 1  = AIVDM1 (initCNB 1)
+		initMessage 2  = AIVDM2 (initCNB 2)
+		initMessage 3  = AIVDM3 (initCNB 3)
+		initMessage 4  = AIVDM4 initType4
+		initMessage 5  = AIVDM5 initType5
+		initMessage 18 = AIVDM18 gDefault{|*|}
+		initMessage 19 = AIVDM19 gDefault{|*|}
+		initMessage 27 = AIVDM27 gDefault{|*|}
+		initMessage  i = AIVDM i
+
+		initCNB type = {msgtype=type,repeat=0,mmsi=0,status=0,turn=Nothing,speed=Nothing,accuracy=False
+					   ,lon=0,lat=0,course=Nothing,heading=Nothing,second=0,maneuver=0,raim=False,radio=0}
+		initType4    = {msgtype=4,repeat=0,mmsi=0,year=0,month=0,day=0,hour=0,minute=0
+					   ,second=0,accuracy=False,lon=0,lat=0,epfd=0,raim=False,radio=0}
+		initType5    = {msgtype=5,repeat=0,mmsi=0,ais_version=0,imo_id=0,callsign="",shipname=""
+					   ,shiptype=0,to_bow=0,to_stern=0,to_port=0,to_starboard=0,epfd=0,month=0
+					   ,day=0,hour=0,minute=0,draught=0,destination="",dte=False}
+
+		decodeCNB = decodeMultiple
+			[decodeUnsigned  2 (\i m -> {AIVDMCNB| m & repeat = i})
+			,decodeUnsigned 30 (\i m -> {AIVDMCNB| m & mmsi = i})
+			,decodeUnsigned 4 (\i cnb -> {AIVDMCNB|cnb & status = i})
+			,decodeSigned 8 (updCnbIf ((<>) -128) (\i cnb -> {AIVDMCNB|cnb & turn = Just i}))
+			,decodeUnsigned 10 (updCnbIf ((<>) 1023) (\i cnb -> {AIVDMCNB|cnb & speed = Just i}))
+			,decodeUnsigned 1 (\i cnb -> {AIVDMCNB|cnb & accuracy = i > 0})
+			,decodeSigned 28 (\i cnb -> {AIVDMCNB|cnb & lon = i})
+			,decodeSigned 27 (\i cnb -> {AIVDMCNB|cnb & lat = i})
+			,decodeUnsigned 12 (updCnbIf ((<>) 3600) (\i cnb -> {AIVDMCNB|cnb & course = Just i}))
+			,decodeUnsigned 9 (updCnbIf ((<>) 511) (\i cnb -> {AIVDMCNB|cnb & heading = Just i}))
+			,decodeUnsigned 6 (\i cnb -> {AIVDMCNB|cnb & second = i})
+			,decodeUnsigned 2 (\i cnb -> {AIVDMCNB|cnb & maneuver = i})
+			,decodeSpare 3
+			,decodeUnsigned 1 (\i cnb -> {AIVDMCNB|cnb & raim = i > 0})
+			,decodeUnsigned 19 (\i cnb -> {AIVDMCNB|cnb & radio = i})
+			]
+
+		decodeType4 = decodeMultiple
+			[decodeUnsigned  2 (\i m -> {AIVDM4| m & repeat = i})
+			,decodeUnsigned 30 (\i m -> {AIVDM4| m & mmsi = i})
+			]
+
+		decodeType5 = decodeMultiple
+			[decodeUnsigned  2 (\i m -> {AIVDM5| m & repeat = i})
+			,decodeUnsigned 30 (\i m -> {AIVDM5| m & mmsi = i})
+			,decodeUnsigned 2 (\i m -> {AIVDM5|m & ais_version = i})
+			,decodeUnsigned 30 (\i m -> {AIVDM5|m & imo_id = i})
+			,decodeString 42 (\s m -> {AIVDM5|m & callsign = s})
+			,decodeString 120 (\s m -> {AIVDM5|m & shipname= s})
+			,decodeUnsigned 8 (\i m -> {AIVDM5|m & shiptype = i})
+			,decodeUnsigned 9 (\i m -> {AIVDM5|m & to_bow = i})
+			,decodeUnsigned 9 (\i m -> {AIVDM5|m & to_stern = i})
+			,decodeUnsigned 6 (\i m -> {AIVDM5|m & to_port = i})
+			,decodeUnsigned 6 (\i m -> {AIVDM5|m & to_starboard= i})
+			,decodeUnsigned 4 (\i m -> {AIVDM5|m & epfd = i})
+			,decodeUnsigned 4 (\i m -> {AIVDM5|m & month = i})
+			,decodeUnsigned 5 (\i m -> {AIVDM5|m & day = i})
+			,decodeUnsigned 5 (\i m -> {AIVDM5|m & hour = i})
+			,decodeUnsigned 6 (\i m -> {AIVDM5|m & minute = i})
+			,decodeUnsigned 8 (\i m -> {AIVDM5|m & draught = i})
+			,decodeString 120 (\s m -> {AIVDM5|m & destination = s})
+			,decodeUnsigned 1 (\i m -> {AIVDM5|m & dte = i > 0})
+			,decodeSpare 1
+			]
+
+		decodeType18 = decodeMultiple
+			[ decodeUnsigned  2 (\i m -> {AIVDM18| m & repeat = i})
+			, decodeUnsigned 30 (\i m -> {AIVDM18| m & mmsi = i})
+			, decodeSpare     8
+			, decodeUnsigned 10 (\i m -> if (i == 1023) m {AIVDM18| m & speed = Just i})
+			, decodeUnsigned  1 (\i m -> {AIVDM18| m & accuracy = i > 0})
+			, decodeUnsigned 28 (\i m -> {AIVDM18| m & lon = i})
+			, decodeUnsigned 27 (\i m -> {AIVDM18| m & lat = i})
+			, decodeUnsigned 12 (\i m -> if (i == 3600) m {AIVDM18| m & course = Just i})
+			, decodeUnsigned  9 (\i m -> if (i == 511) m {AIVDM18| m & heading = Just i})
+			, decodeUnsigned  6 (\i m -> {AIVDM18| m & second = i})
+			, decodeSpare     8
+			, decodeUnsigned  1 (\i m -> {AIVDM18| m & raim = i > 0})
+			, decodeUnsigned 20 (\i m -> {AIVDM18| m & radio = i})
+			]
+
+		decodeType19 = decodeMultiple
+			[ decodeUnsigned  2 (\i m -> {AIVDM19| m & repeat = i})
+			, decodeUnsigned 30 (\i m -> {AIVDM19| m & mmsi = i})
+			, decodeSpare     8
+			, decodeUnsigned 10 (\i m -> if (i == 1023) m {AIVDM19| m & speed = Just i})
+			, decodeUnsigned  1 (\i m -> {AIVDM19| m & accuracy = i > 0})
+			, decodeUnsigned 28 (\i m -> {AIVDM19| m & lon = i})
+			, decodeUnsigned 27 (\i m -> {AIVDM19| m & lat = i})
+			, decodeUnsigned 12 (\i m -> if (i == 3600) m {AIVDM19| m & course = Just i})
+			, decodeUnsigned  9 (\i m -> if (i == 511) m {AIVDM19| m & heading = Just i})
+			, decodeUnsigned  6 (\i m -> {AIVDM19| m & second = i})
+			, decodeSpare     4
+			, decodeString  120 (\s m -> {AIVDM19| m & shipname= s})
+			, decodeUnsigned  8 (\i m -> {AIVDM19| m & shiptype = i})
+			, decodeUnsigned  9 (\i m -> {AIVDM19| m & to_bow = i})
+			, decodeUnsigned  9 (\i m -> {AIVDM19| m & to_stern = i})
+			, decodeUnsigned  6 (\i m -> {AIVDM19| m & to_port = i})
+			, decodeUnsigned  6 (\i m -> {AIVDM19| m & to_starboard= i})
+			, decodeUnsigned  4 (\i m -> {AIVDM19| m & epfd = i})
+			, decodeUnsigned  1 (\i m -> {AIVDM19| m & raim = i > 0})
+			, decodeUnsigned  1 (\i m -> {AIVDM19| m & dte = i > 0})
+			, decodeUnsigned  1 (\i m -> {AIVDM19| m & assignedMode = i > 0})
+			, decodeSpare     4
+			]
+
+		decodeType27 = decodeMultiple
+			[ decodeUnsigned  2 (\i m -> {AIVDM27| m & repeat = i})
+			, decodeUnsigned 30 (\i m -> {AIVDM27| m & mmsi = i})
+			, decodeUnsigned  1 (\i m -> {AIVDM27| m & accuracy = i > 0})
+			, decodeUnsigned  1 (\i m -> {AIVDM27| m & raim = i > 0})
+			, decodeUnsigned  4 (\i m -> {AIVDM27| m & status = i})
+			, decodeUnsigned 18 (\i m -> {AIVDM27| m & lon = i * 1000})
+			, decodeUnsigned 17 (\i m -> {AIVDM27| m & lat = i * 1000})
+			, decodeUnsigned  6 (\i m -> if (i == 63) m {AIVDM27| m & speed = Just $ i * 10})
+			, decodeUnsigned  9 (\i m -> if (i == 511) m {AIVDM27| m & course = Just $ i * 10})
+			, decodeUnsigned  1 (\i m -> {AIVDM27| m & gnss = i == 0})
+			, decodeSpare     1
+			]
+
+		updCnbIf updateFor f i m
+			| updateFor i = f i m
+			| otherwise   = m
+
+	decodeUnsigned :: !Int !(Int msg -> msg) !{#Char} !Int !msg -> (!Int, !msg)
+	decodeUnsigned width modifier bits pos msg
+		= (pos + width, modifier (bv_ubits pos width bits) msg)
+
+	decodeSigned :: !Int !(Int msg -> msg) !{#Char} !Int !msg -> (!Int, !msg)
+	decodeSigned width modifier bits pos msg
+		= (pos + width, modifier (bv_sbits pos width bits) msg)
+
+	decodeString :: !Int !(String msg -> msg) !{#Char} !Int !msg -> (!Int, !msg)
+	decodeString width modifier bits pos msg
+		 = (pos + width, modifier chars msg)
+	where
+		chars = rtrim {char c \\ c <- takeWhile (\i -> i > 0) [bv_ubits (pos + i * 6) 6 bits \\ i <- [0 .. (width / 6) - 1]]}
+		char i = if (i == 0 || i > 64) ' ' "@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^- !\"#$%&'()*+,-./0123456789:;<=>?".[i]
+
+	decodeSpare :: !Int !{#Char} !Int !msg -> (!Int, !msg)
+	decodeSpare width bits pos msg = (pos + width, msg)
+
+	decodeDyn ::
+		!({#Char} Int -> (Int, msg)) !({#Char} Int msg -> (Int, msg)) !{#Char} !Int -> (!Int, !msg)
+	decodeDyn first cont bits pos
+		# (pos, msg) = first bits pos
+		= cont bits pos msg
+
+	decodeMultiple :: ![{#Char} Int msg -> (Int, msg)] !{#Char} !Int !msg -> (!Int, !msg)
+	decodeMultiple [] bits pos msg = (pos,msg)
+	decodeMultiple [f:fs] bits pos msg
+		# (pos,msg) = f bits pos msg
+		= decodeMultiple fs bits pos msg
+
+import StdMisc
+//Lowlevel bit manipulation
+bv_unarmor :: {#Char} -> {#Char}
+bv_unarmor src = unarmor_and_copy src 0 0 0 0 (createArray required_bytes '\0')
+where
+	//The number of 8-bit bytes needed to hold all the bits
+	num_bits = size src * 6
+	required_bytes = num_bits / 8 + (if (num_bits rem 8 > 0) 1 0)
+
+	unarmor_and_copy :: {#Char} Int Int Int Int *{#Char} -> *{#Char}
+	unarmor_and_copy src srci desti buf bufwidth dest
+		| srci >= size src
+			| bufwidth > 0	//Add remaining buffer bits to dest
+				# byte	= toChar (buf bitand ((2 ^ bufwidth) - 1))
+				= {dest & [desti] = byte}
+			| otherwise
+				= dest //Done.
+		# buf = (buf << 6) bitor (unarmor_char src.[srci])
+		# bufwidth = bufwidth + 6
+		| bufwidth >= 8	//Copy another byte to the destination array
+			# byte		= toChar (buf >> (bufwidth - 8))
+			# bufwidth	= bufwidth - 8
+			= (unarmor_and_copy src (srci + 1) (desti + 1) buf bufwidth {dest & [desti] = byte})
+		| otherwise
+			= unarmor_and_copy src (srci + 1) desti buf bufwidth dest
+	where
+		//Extract the six bits from an armored ASCII character
+		unarmor_char :: Char -> Int
+		unarmor_char char = let bits = toInt char - 48 in (if (bits > 40) (bits - 8) bits)
+
+bv_ubits :: Int Int {#Char} -> Int
+bv_ubits start width bytes
+    | start + width > (size bytes * 8) = -1 //abort ("NOT ENOUGH BYTES: " +++ toString (start + width - (size bytes * 8)))
+	# field = copy_bytes (start / 8) ((start + width - 1) / 8) 0	//Copy all bytes that contain the bitfield
+	# align = (start + width) rem 8
+	# field = if (align > 0) (field >> (8 - align)) field			//Align the field
+	# field = field bitand ((2 ^ width) - 1)						//Mask the field
+	= field
+where
+	copy_bytes firstbyte lastbyte field
+		| firstbyte > lastbyte	= field
+		| otherwise				= copy_bytes (firstbyte + 1) lastbyte ((field << 8) bitor (toInt bytes.[firstbyte]))
+
+bv_sbits :: Int Int {#Char} -> Int
+bv_sbits start width bits
+	# field = bv_ubits start width bits
+	| field bitand (1 << (width - 1)) == 0	= field
+											= ~(2 ^ width - field)
+
+derive gDefault AIVDM18, AIVDM19, AIVDM27
+gDefault{|Maybe|} _ = Nothing

tests/linux64/test.icl

@@ -231,5 +231,6 @@ import qualified Text.Unicode
 import qualified Text.Unicode.Encodings.JS
 import qualified Text.Unicode.Encodings.UTF8
 import qualified Text.Unicode.UChar
+import qualified Message.Encodings.AIS
 
 Start = "Hello World!"