' ============================================================================== ' ' File...... AEROGPS4.BSP ' Purpose... ' Author.... Parallax ' E-mail.... stamptech@parallaxinc.com ' Started... 16 JUL 2001 ' Updated... 06 FEB 2003 ' ' { $STAMP BS2p } ' { $PBASIC 2.5 } ' ' ============================================================================== ' ------------------------------------------------------------------------------ ' Program Description ' ------------------------------------------------------------------------------ ' ' This program captures and records GPS data from consumer receiver ' (i.e. Garmin eTrex or equivalent) using standard NMEA output. ' ' Standard NMEA 0183 string: ' ' $GPRMC,POS_UTC,POS_STAT,LAT,LAT_D,LON,LON_D,SPD,HDG,DATE,MAG_VAR,MAG_REF,*CC ' ' POS_UTC - UTC of position. Hours, minutes and seconds. (hhmmss) ' POS_STAT - Position status. (A = Data valid, V = Data invalid) ' LAT - Latitude (ddmm.ffff) ' LAT_D - Latitude direction. (N = North, S = South) ' LON - Longitude (dddmm.ffff) ' LON_D - Longitude direction (E = East, W = West) ' SPD - Speed over ground. (knots) (0.0 - 999.9) ' HDG - Heading/track made good (degrees True) (x.x) ' DATE - Date (ddmmyy) ' MAG_VAR - Magnetic variation (degrees) (x.x) ' MAG_REF - Magnetic variation (E = East, W = West) ' *CC - Checksum ' ' Custom Garmin string: ' ' $PGRMZ,ALT,F,X*CC ' ' ALT,F - Altitude in feet ' X - Position fix dimensions (2 = user, 3 = GPS) ' *CC - Checksum ' ------------------------------------------------------------------------------ ' Revision History ' ------------------------------------------------------------------------------ ' ------------------------------------------------------------------------------ ' I/O Definitions ' ------------------------------------------------------------------------------ GPSpin PIN 0 Buttons VAR IND ' clear & start inputs (12, 13) MemLED PIN 14 ' on (RED) if records in log RunLED PIN 15 ' on (GREEN) when logging DoMenu PIN 8 ' 0 = test using DEBUG report ' 1 = log data RxD CON 16 ' DEBUG terminal input ' ------------------------------------------------------------------------------ ' Constants ' ------------------------------------------------------------------------------ T9600 CON 240 ' 9600-8-N-1 (matches DEBUG) N4800 CON 16884 ' 4800-8-N-1 (for GPS output) EESlot CON 1 ' data starts in this slot MaxAddr CON 8 - EESlot * 2048 - 1 ' last available address FirstAddr CON 2 ' make room for readings Comma CON "," ' report field delimiter RecSize CON 11 ' 11 bytes for each record IsOn CON 1 ' LEDs are active high IsOff CON 0 Yes CON 1 No CON 0 ' ------------------------------------------------------------------------------ ' Variables ' ------------------------------------------------------------------------------ records VAR Word ' stored records response VAR Byte ' terminal response character idx VAR response ' index into SPRAM btns VAR Nib ' returns button input btnClear VAR btns.BIT0 ' pin 12 btnRun VAR btns.BIT1 ' pin 13 flags VAR Byte ' valid, N/S, E/W valid VAR flags.BIT7 ' 0 = valid latDeg VAR Byte ' latitude degrees latFrac VAR Word ' fractional degrees latFrLo VAR latFrac.LOWBYTE latFrHi VAR latFrac.HIGHBYTE latNS VAR flags.BIT0 ' 0 = N lonDeg VAR Byte ' longitude degrees lonFrac VAR Word ' fractional degrees lonFrLo VAR lonFrac.LOWBYTE lonFrHi VAR lonFrac.HIGHBYTE lonEW VAR flags.BIT1 ' 0 = E altitude VAR Word ' above sea-level altLo VAR altitude.LOWBYTE altHi VAR altitude.HIGHBYTE speed VAR Word ' mph spdLo VAR speed.LOWBYTE spdHi VAR speed.HIGHBYTE char VAR Byte ' byte pulled from SPRAM workVal VAR Word ' for numeric conversions field VAR Nib ' field # fldWidth VAR field ' width of field eeAddr VAR Word ' flat EE address eeData VAR Byte recNum VAR workVal ' loop counter for reports ' ------------------------------------------------------------------------------ ' EEPROM Data ' ------------------------------------------------------------------------------ ' ------------------------------------------------------------------------------ ' Initialization ' ------------------------------------------------------------------------------ Initialize: STORE EESlot ' point to data slot READ 0, records.LOWBYTE ' retrieve records from EEPROM READ 1, records.HIGHBYTE OUTS.LOWBIT(MemLED) = IsOff ' assume no records OUTPUT MemLED ' enable mem LED OUTS.LOWBIT(RunLED) = IsOff OUTPUT RunLED ' enable run LED PAUSE 250 ' allow DEBUG window to open DEBUG CLS BRANCH DoMenu, [Show_Menu, Check_Input] Show_Menu: DEBUG "AeroGPS - Version 3 (", DEC records, " records)", CR, CR DEBUG "[1] View live GPS data", CR DEBUG "[2] Dump datalog to PC (Detail Format)", CR, CR, "--> " SERIN RxD, T9600, [response] DEBUG CLS IF (response < "1") OR (response > "2") THEN Show_Menu BRANCH (response - "1"), [Main, Dump_Raw] GOTO Show_Menu Check_Input: LOW RunLED OUTS.LOWBIT(MemLED) = (records / records) GOSUB Get_Buttons Check_Clear: IF (btnClear = No) THEN Check_Run records = 0 DEBUG CLS, "Records cleared." GOTO Check_Input Check_Run: IF (btnRun = No) THEN Check_Input LOW MemLED HIGH RunLED DEBUG CLS, "Running" PAUSE 1000 ' give time for button release ' ------------------------------------------------------------------------------ ' Program Code ' ------------------------------------------------------------------------------ Main: GOSUB Get_Buttons IF (btnRun = No) THEN Acquire_Signal ' stop if Run pressed Wait_For_Run_Release: LOW RunLED OUTS.LOWBIT(MemLED) = (records / records) GOSUB Get_Buttons IF (btnRun = Yes) THEN Wait_For_Run_Release ' for user to release button GOTO Check_Input Acquire_Signal: ' capture GPS data, parse $GPMRC string SERIN GPSpin, N4800, 3000, No_GPS_Data, [WAIT("GPRMC,"), SPSTR 65] GOSUB Parse_GPS ' pull altitude from Garmin $PGRMZ string SERIN GPSpin, N4800, 1500, Main, [WAIT("PGRMZ,"), DEC altitude] BRANCH DoMenu, [Show_GPS_Signal] ' show signal if in test mode Log_GPS_Data: BRANCH ~valid, [Main] ' don't log bad signal records = records + 1 eeAddr = (records - 1) * RecSize + FirstAddr IF ((eeAddr + RecSize - 1) > MaxAddr) THEN EE_Full eeAddr = eeAddr + 0 : eeData = flags : GOSUB Write_Big_EE eeAddr = eeAddr + 1 : eeData = latDeg : GOSUB Write_Big_EE eeAddr = eeAddr + 1 : eeData = latFrLo : GOSUB Write_Big_EE eeAddr = eeAddr + 1 : eeData = latFrHi : GOSUB Write_Big_EE eeAddr = eeAddr + 1 : eeData = lonDeg : GOSUB Write_Big_EE eeAddr = eeAddr + 1 : eeData = lonFrLo : GOSUB Write_Big_EE eeAddr = eeAddr + 1 : eeData = lonFrHi : GOSUB Write_Big_EE eeAddr = eeAddr + 1 : eeData = altLo : GOSUB Write_Big_EE eeAddr = eeAddr + 1 : eeData = altHi : GOSUB Write_Big_EE eeAddr = eeAddr + 1 : eeData = spdLo : GOSUB Write_Big_EE eeAddr = eeAddr + 1 : eeData = spdHi : GOSUB Write_Big_EE STORE EESlot ' save records in data slow WRITE 0, records.LOWBYTE WRITE 1, records.HIGHBYTE DEBUG CLS, "Log: ", DEC records, CR GOTO Main Show_GPS_Signal: DEBUG HOME, "GPS Signal Test Mode", CLREOL, CR, CR BRANCH ~valid, [Bad_Signal] DEBUG " Latitude: ", DEC2 latDeg, ".", DEC4 latFrac DEBUG " ", "N" + (latNS * 5), CR DEBUG " Longitude: ", DEC3 lonDeg, ".", DEC4 lonFrac DEBUG " ", "E" + (lonEW * 18), CR DEBUG " Altitude: ", DEC altitude, " ft.", ClrEOL, CR DEBUG " Speed: ", DEC (speed / 10), "." DEBUG DEC1 (speed // 10), " mph", ClrEOL GOTO Main Bad_Signal: DEBUG "-- Invalid Signal", ClrEOL, CR, ClrEOL, CR, ClrEOL, CR, ClrEOL, CR GOTO Main ' ******************************* ' Stamp EE is full -- handle here ' ******************************* EE_Full: LOW RunLED HIGH MemLED PAUSE 500 LOW MemLED PAUSE 500 GOTO EE_Full ' do something to indicate ' HIGH MemFull ' turn on LED END ' ------------------------------------------------------------------------------ ' Subroutines ' ------------------------------------------------------------------------------ Get_Buttons: btns = %0011 ' assume buttons pressed FOR workVal = 1 TO 5 btns = btns & ~Buttons ' invert input for active low PAUSE 10 NEXT RETURN No_GPS_Data: DEBUG CLS, "Error: No GPS detected" PAUSE 1000 GOTO Initialize ' try again Clear_Log: records = 0 ' clear records counter STORE EESlot ' point to first data slot WRITE 0, 0 ' clear EE log of count WRITE 1, 0 RETURN ' ************************** ' Parse data from GPS stream ' ************************** Parse_GPS: idx = 9 : fldWidth = 2 ' latitude degrees GOSUB String_To_Value latDeg = workVal idx = 11 : fldWidth = 2 ' latitude minutes GOSUB String_To_Value latFrac = workVal * 1000 / 6 ' convert to fractional degrees idx = 14 : fldWidth = 4 ' latitude fractional minutes GOSUB String_To_Value latFrac = latFrac + (workVal * 36 / 100) ' add to fractional degrees idx = 21 : fldWidth = 3 ' longitude degrees GOSUB String_To_Value lonDeg = workVal idx = 24 : fldWidth = 2 ' longitude minutes GOSUB String_To_Value lonFrac = workVal * 1000 / 6 ' convert to fractional degrees idx = 27 : fldWidth = 4 ' longitude fractional minutes GOSUB String_To_Value lonFrac = lonFrac + (workVal * 36 / 100) ' add to fractional degrees ' get character info -- convert to bits Check_Valid: GET 7, char valid = char.BIT1 ' 0 = Valid, 1 = Warning Get_NS: GET 19, char latNS = char.BIT0 ' 0 = North, 1 = South Get_EW: GET 32, char lonEW = char.BIT1 ' 0 = East, 1 = West Get_Speed: idx = 34 GOSUB Mixed_To_Tenths ' convert "xxx.x" to number ' speed = workVal ' speed in knots (tenths) speed = workVal + (workVal ** $2699) ' x 1.1507771555 for mph ' ********************************************* ' Convert string data (nnnn) to numeric value ' -- idx - location of first digit in data ' -- fldWidth - width of data field (1 to 5) ' -- workVal - returns numeric value of field ' ********************************************* String_To_Value: workVal = 0 IF (fldWidth = 0) OR (fldWidth > 5) THEN String_To_Value_Done Get_Field_Digit: GET idx, char ' get digit from field workVal = workVal + (char - "0") ' convert, add into value fldWidth = fldWidth - 1 ' decrement field width IF (fldWidth = 0) THEN String_To_Value_Done workVal = workVal * 10 ' shift result digits left idx = idx + 1 ' point to next digit GOTO Get_Field_Digit String_To_Value_Done: RETURN ' ***************************************************** ' Convert string data (nnn.n) to numeric value (tenths) ' -- idx - location of first digit in data ' -- workVal - returns numeric value of field ' ***************************************************** Mixed_To_Tenths: workVal = 0 Get_Mixed_Digit: GET idx, char ' read digit from speed field IF (char = ".") THEN Get_Mixed_Last ' skip decimal point workVal = (workVal + (char - "0")) * 10 ' add digit, move data left idx = idx + 1 ' point to next digit GOTO Get_Mixed_Digit Get_Mixed_Last: GET (idx + 1), char ' point to tenths digit workVal = workVal + (char - "0") ' workVal is in tenths RETURN ' ************************************************************ ' Find field location after variable-length data (i.e., speed) ' -- field - field number ' -- idx - returns position of first digit in field ' ************************************************************ ' ' Move_To_Field: ' idx = 0 ' IF (field = 0) THEN Move_To_Field_Done ' if zero, we're there ' ' Get_Char: ' GET idx, char ' get char from SPRAM ' IF (char = Comma) THEN Found_Comma ' is it a comma? ' idx = idx + 1 ' no, move to next char ' GOTO Get_Char ' ' Found_Comma: ' field = field - 1 ' was comma, dec field coutner ' idx = idx + 1 ' point to next char ' IF (field = 0) THEN Move_To_Field_Done ' if field = 0, we're there ' GOTO Get_Char ' ' Move_To_Field_Done: ' RETURN ' ****************************** ' Write data to "flat" EE memory ' ****************************** Write_Big_EE: IF (eeAddr > MaxAddr) THEN No_Write ' check for bad eeAddr STORE (eeAddr / 2048) + EESlot ' point to EE slot WRITE (eeAddr // 2048), eeData No_Write: RETURN ' ------------------------------------------------------------------------------ ' Reports ' ------------------------------------------------------------------------------ Dump_Raw: ' dump for detailed analysis ' -- ,,,,,, ' -- ,,,,,, DEBUG CLS, "AeroGPS Details", CR, CR PAUSE 250 FOR recNum = 1 TO records GOSUB Load_GPS_Record DEBUG DEC recNum, Comma DEBUG DEC latDeg, ".", DEC4 latFrac, Comma, "N" + (latNS * 5), Comma DEBUG DEC lonDeg, ".", DEC4 lonFrac, Comma, "E" + (lonEW * 18), Comma DEBUG DEC altitude, Comma DEBUG DEC (speed / 10), ".", DEC1 (speed // 10), CR NEXT END ' removed to make room for new code ' 'Dump_Graph: ' ' dump for easy Excel graphing of track ' ' -- converts "S" and "W" to "-" ' ' -- put longitude in first column for X axis of X/Y graph ' ' -- ,,, ' ' -- ,,, ' ' DEBUG CLS, "AeroGPS Lon/Lat/Alt/Speed Data", CR ' DEBUG "(", DEC records, " Records)", CR, CR ' PAUSE 250 ' ' FOR recNum = 1 TO records ' GOSUB Load_GPS_Record ' DEBUG " " + (lonEW * 13), DEC lonDeg, ".", DEC4 lonFrac, Comma ' DEBUG " " + (latNS * 13), DEC latDeg, ".", DEC4 latFrac, Comma ' DEBUG DEC altitude, Comma ' DEBUG DEC (speed / 10), ".", DEC1 (speed // 10), CR ' NEXT ' END ' *********************************************** ' Load store GPS records for data dump to screen ' *********************************************** Load_GPS_Record: eeAddr = (recNum - 1) * RecSize + FirstAddr eeAddr = eeAddr + 0 : GOSUB Read_Big_EE : flags = eeData eeAddr = eeAddr + 1 : GOSUB Read_Big_EE : latDeg = eeData eeAddr = eeAddr + 1 : GOSUB Read_Big_EE : latFrLo = eeData eeAddr = eeAddr + 1 : GOSUB Read_Big_EE : latFrHi = eeData eeAddr = eeAddr + 1 : GOSUB Read_Big_EE : lonDeg = eeData eeAddr = eeAddr + 1 : GOSUB Read_Big_EE : lonFrLo = eeData eeAddr = eeAddr + 1 : GOSUB Read_Big_EE : lonFrHi = eeData eeAddr = eeAddr + 1 : GOSUB Read_Big_EE : altLo = eeData eeAddr = eeAddr + 1 : GOSUB Read_Big_EE : altHi = eeData eeAddr = eeAddr + 1 : GOSUB Read_Big_EE : spdLo = eeData eeAddr = eeAddr + 1 : GOSUB Read_Big_EE : spdHi = eeData RETURN ' ******************************* ' Read data from "flat" EE memory ' ******************************* Read_Big_EE: IF (eeAddr > MaxAddr) THEN No_Read ' check for bad eeAddr STORE (eeAddr / 2048) + EESlot ' point to EE slot READ (eeAddr // 2048), eeData No_Read: RETURN