7m…ôcUG/\cdËs1REM *************************************REM *********** PsiNMEA *****************REM *************************************REM Version 2.00b, 30.03.2000REM (c) Torsten BaumbachREM Torsten.Baumbach@uni-jena.deREM *************************************INCLUDE "const.oph"INCLUDE "system.oxh"INCLUDE "date.oxh"INCLUDE "dbase.oxh"INCLUDE "rmralarm.oxh"INCLUDE "systinfo.oxh"INCLUDE "ndirnav.oxh"CONST KUidTorstenBaumbach&=268456758 :rem $10005336(hex)CONST KAppName$="PsiNMEA"CONST KVerStr$ ="2.00b"CONST KBuiltStr$ ="2000/03/30"CONST KMaxCalibPoints% = 2CONST KMaxMaps% = 100CONST KMaxTrackPoints% = 500CONST KPixelPerCM = 47.8CONST KStandardMapFile$ = "RMWorld.mbm"CONST KStandardMapDesc$ = "World map (from RealMaps)"CONST KStandardMap1X% = 161CONST KStandardMap1Y% = 54CONST KStandardMap1Lat = 68.35CONST KStandardMap1Lon = 133.7CONST KStandardMap1Desc$ = "Inuvik"CONST KStandardMap2X% = 1153CONST KStandardMap2Y% = 429CONST KStandardMap2Lat = -38.8166666667CONST KStandardMap2Lon = -144.9666666667CONST KStandardMap2Desc$ = "Melbourne"APP PsiNMEA,KUidTorstenBaumbach& ICON "icon.mbm" CAPTION KAppName$,KLangEnglish%ENDACONST STalkerFile$ ="data\TALKERS"CONST SManufacturersFile$ ="data\MFACTURS.db"CONST SGPSProdIDFile$ ="data\GPSProdIDs.db"CONST SEarthDFile$ ="DATUMS"CONST SMapFolder$ ="maps\"CONST SEclPathFile$ ="sofi\SE19990811.DAT"CONST SMapCalibFile$ ="MAPCALIB"CONST SWaypointFolder$ ="wayp\"CONST SWaypointFile$ ="Waypoints.wpt"CONST SWaypExportFile$ ="Waypoints.txt"CONST STrackingFolder$ ="tracks\"CONST STrackingFile$ ="Track.trk"CONST SRouteFolder$ ="routes\"CONST SRouteFile$ ="Route.rte"CONST SWldDatabase$ ="data\Wldbase.db"CONST SIniFileExt$ =".ini"CONST SPicFile1$ ="rsc\title.mbm"CONST SPicFile2$ ="rsc\voyager.mbm"CONST SPicFile3$ ="rsc\sofi.mbm"CONST KTrackExtension$ = ".trk"CONST KRouteExtension$ = ".rte"CONST KWaypointExtension$ = ".wpt"CONST KMaxParseFields%=50CONST KMaxSentenceBuffer%=50REM used shortcuts in combination with Ctrl:CONST Ctrl$="ABCDGIJKLMNOPRSTUWXY"REM used shortcuts in combination with Shift+Ctrl:CONST ShiftCtrl$="ABCDEFGIJLMNPRSTVXYZ"REM *************************************REM *********** Main prog ***************REM *************************************INCLUDE "PsiNMEA.oph"PROC main_PsiNMEA: GLOBAL sentence$(255),descr$(255) GLOBAL field$(KMaxParseFields%,100),fields%,version% GLOBAL values(KMaxParseFields%),values$(KMaxParseFields%,100) GLOBAL list_start%,list_cnt%,list_rep% GLOBAL connectmode%,baud%,parity%,data%,stop%,hand% GLOBAL GRMN_baud%,GRMN_parity%,GRMN_data%,GRMN_stop%,GRMN_hand% GLOBAL mytype$(3),yourtype$(3),PropDevice$(5) GLOBAL setting%(10),format%(10),utc_offs&,stdscreen% GLOBAL MyDir$(255),UseSystemFolder&,UseFastFileDialog% GLOBAL LastParseFile$(255),LastStatisticFile$(255) GLOBAL LastMonitorFile$(255),LastSunEclFile$(255) GLOBAL LastTrackFile$(255),LastWaypointFile$(255) GLOBAL LastRouteFile$(255),LastWaypExportFile$(255) GLOBAL alarmstat%,menuinit1%,menuinit2%,screen% GLOBAL msg_all%,msg_read%,mfactid$(5) GLOBAL satnr%(50),sat1(50),sat2(50),sat3(50),sats% GLOBAL sentence_buffer$(KMaxSentenceBuffer%,255) GLOBAL sbuffer_start%,sbuffer_cnt%,wayp_xch_setts& GLOBAL MapCursorMask%,MapPenAction%,abox_id% GLOBAL lock_counter%,busy_counter%,CloseAppCmd% GLOBAL screen_xsize%,screen_ysize%,GRMNwaitforrequest% GLOBAL GRMN_captag$(25,1),GRMN_capdata%(25),GRMN_capnum%  LOCAL m%,k&,ende%,scan%,shft%,ctrl%,auto&,bl1&,bl2& LOCAL event&(16),eventstat%,str$(255)  Busy:("Initializing"+KDots$,1) ESCAPE off CloseAppCmd%=KFalse% lock_counter%=0 : busy_counter%=0 REM Create needed folders MyDir$=LEFT$(CMD$(1),LPosInStr%:("\",CMD$(1))) TRAP MKDIR MyDir$+SMapFolder$ TRAP MKDIR MyDir$+SWaypointFolder$ TRAP MKDIR MyDir$+STrackingFolder$ TRAP MKDIR MyDir$+SRouteFolder$ REM store current auto switch off setting auto&=SIAutoSwitchOffBehaviour&: REM store current backlight setting bl1&=SIBacklightBehaviour&: bl2&=SIBacklightOnTime&:  REM store screen extensions gUSE 1 screen_xsize%=gWIDTH screen_ysize%=gHEIGHT  REM init program IF NOT InitSettings%: : RETURN : ENDIF REM establish connection  IF setting%(8)=KModeNMEA% IF OpenSerial%: connectmode%=KModeNMEA% SetSerial: str$=GetYourDevice$:(KFalse%) Busy:(KBusyOff$,0) gIPRINT str$,1 ENDIF ELSEIF setting%(8)=KModeGRMN% IF OpenSerial%: connectmode%=KModeGRMN% GRMN_SetSerial: str$=GetGarminProductDatas$:(KFalse%) Busy:(KBusyOff$,0) IF str$<>"" gIPRINT str$,1 ELSE gIPRINT "No GRMN device found.",1 ENDIF GRMN_capnum%=0 ENDIF ELSE REM no connection established ENDIF  InitScreen: abox_id%=AboutBox%:(KFalse%)  screen%=0 ende%=KFalse% DO  IF CloseAppCmd% : BREAK : ENDIF  REM waiting for input and repainting data screens DO PaintScreen:(screen%) GETEVENTA32 eventstat%,event&() IOYIELD IF eventstat%>=0 : BREAK : ENDIF GETEVENTC(eventstat%) UNTIL KFalse%  IF abox_id%<>0 gCLOSE abox_id% abox_id%=0 ENDIF  REM process input k&=event&(KEvaType%)   IF (k&=KKeyMenu32%) OR (k&=KKeySidebarMenu32%)  REM menu button pressed --------------------------  m%=SysMenu%: IF m%>=%A AND m%<=%Z IF PosInStr%:(CHR$(m%),ShiftCtrl$,1)>0 @("MenuProc_ShiftCtrl_"+CHR$(m%)): ENDIF ELSEIF m%>=%a AND m%<=%z IF PosInStr%:(UPPER$(CHR$(m%)),Ctrl$,1)>0 @("MenuProc_Ctrl_"+CHR$(m%)): ELSEIF m%=%e ende%=KTrue% ENDIF ELSEIF m%=13 ProgSettings_NMEAparser:  ELSEIF m%=14 GarminPowerOff: ELSEIF m%=15 REM Parse only selected datas from serial port IF connectmode%<>KModeNMEA% : RETURN : ENDIF ParseMask: ELSEIF m%=16 AND connectmode%=KModeNMEA% SunEclipse:(KFalse%) : REM current location ELSEIF m%=17 SunEclipse:(KTrue%) : REM entered location ELSEIF m%=18 RegisterMaps:(KTrue%) : REM new map ELSEIF m%=19 RegisterMaps:(KFalse%) : REM edit/delete map ELSEIF m%=20 SunEclPath2Map: : REM draw path of totallity ELSEIF m%=21 DISPLAYTASKLIST: : REM task list ELSEIF m%=22 : REMAboutbox AboutBox%:(KTrue%) ELSEIF m%=23 CheckMapRegistration:(MyDir$+SMapFolder$+SMapCalibFile$) ELSEIF m%=24 SetScreen:(-1) ELSEIF m%=25 SetScreen:(0) ELSEIF m%=26 SetScreen:(1) ELSEIF m%=27 ProgSettings_GRMNparser:  ELSEIF m%=28 IF connectmode%<>KModeNMEA% : RETURN : ENDIF Query: ELSEIF m%=29 ELSEIF m%=30 AddStandardMap: ELSEIF m%=31 ENDIF  ELSEIF k&=10001 or k&=10002 or k&=10003 or k&=10004  REM edit, infrared or zoom button -------------- Busy:(KBusyOff$,0) gIPRINT "Function not available",0  ELSEIF k&=KEvPtr& AND event&(KEvAPtrType%)=KEvPtrPenUp&  REM pointer event -------------------------------  REM xptr%=event&(KEvAPtrScreenPosX%) REM yptr%=event&(KEvAPtrScreenPosY%)  ELSEIF (event&(1) AND &400)=0  REM key pressed, shortcut ? ---------------------  scan%=event&(1)+%A-1 shft%=event&(4) AND $2 ctrl%=event&(4) AND $4 IF ctrl% IF shft% IF PosInStr%:(UPPER$(CHR$(scan%)),ShiftCtrl$,1)>0 @("MenuProc_ShiftCtrl_"+CHR$(scan%)): ENDIF ELSE IF PosInStr%:(UPPER$(CHR$(scan%)),Ctrl$,1)>0 @("MenuProc_Ctrl_"+CHR$(scan%)): ELSEIF scan%=%E ende%=KTrue% ENDIF ENDIF ENDIF  ELSEIF event&(1)=$404 REM system command "X", "O" or "C"  IF GETCMD$="X" : BREAK : ENDIF ENDIF UNTIL ende%  REM program will be closed gIPRINT "Closing PsiNMEA"+KDots$,1  IF BACKLIGHTON&: AND (bl1&=0) gIPRINT "Backlight timer is switched ON",1 PAUSE 20 ENDIF SETAUTOSWITCHOFFBEHAVIOR:(auto&)  IF connectmode%<>KModeDisconnected% : CloseSerial: : ENDIF WriteSettings:  SETBACKLIGHTBEHAVIOR:(bl1&) SETBACKLIGHTONTIME:(bl2&)ENDPREM ************************************REM ********** Procedures **************REM ************************************REM *** Handling of cascaded locks ****PROC Lock:(mode%) IF mode%=KLock% lock_counter%=lock_counter%+1 IF lock_counter%=1 LOCK ON ENDIF ELSEIF mode%=KUnlock% AND lock_counter%>0 lock_counter%=lock_counter%-1 IF lock_counter%=0 LOCK OFF ENDIF ENDIFENDPPROC Busy:(str$,pos%) IF str$=KBusyOff$ BUSY off IF busy_counter%=1 Lock:(KUnlock%) busy_counter%=0 ENDIF ELSE IF busy_counter%=0 Lock:(KLock%) busy_counter%=1 ENDIF BUSY str$,pos% ENDIFENDPREM *** KEY with syscommand handler ***PROC Key%: LOCAL key%,eventstat%,event&(16)  GETEVENTA32 eventstat%,event&() key%=0 IOYIELD IF eventstat%>=0 IF event&(1)=$404 IF GETCMD$="X" CloseAppCmd%=KTrue% RETURN 0 ENDIF ELSEIF (event&(1) AND $400)=0 IF (event&(4) AND $4)=0 REM no ctrl key key%=event&(1) ENDIF ENDIF ELSE GETEVENTC(eventstat%) RETURN 0 ENDIF RETURN key%ENDPREM *** Calls GET in locked mode or with syscommand handler ***PROC Get%:(locked%) LOCAL r%,event&(16) IF locked% Lock:(KLock%) r%=GET Lock:(KUnlock%) RETURN r% ELSE DO GETEVENT32 event&() IF event&(1)=$404 IF GETCMD$="X" CloseAppCmd%=KTrue% RETURN 0 ENDIF ELSEIF (event&(1) AND $400)=0 RETURN event&(1) ENDIF UNTIL KFalse% ENDIFENDPREM *** Own INPUT procedure for handle of syscommands ***PROC Input:(astr&,lstr%) LOCAL str$(255),event&(16),c%,key%,sx%,sy%,info%(10)  SCREENINFO info%()  c%=0 CURSOR ON  DO GETEVENT32 event&() IF event&(1)=$404 IF GETCMD$="X" CloseAppCmd%=KTrue% BREAK ENDIF ELSEIF (event&(1) AND $400)=0 IF (event&(4) AND $4)=0 key%=event&(1) IF key%=KKeyEnter% BREAK ELSEIF key%>=KKeySpace% IF c%0 str$=LEFT$(str$,c%-1) c%=c%-1 GetCursPos:(ADDR(sx%),ADDR(sy%)) sx%=sx%-1 IF sx%=0 sy%=sy%-1 sx%=info%(3) ENDIF AT sx%,sy% : PRINT " "; : AT sx%,sy% ENDIF ENDIF ENDIF ENDIF  UNTIL KFalse%  CURSOR OFF POKE$ astr&,str$ PRINTENDPREM *** Convert 32bit IEEE float format (1/8/23) to 64bit ***PROC IEEEfloat_GRM32_2_OPL64:(abits&) LOCAL z,m&,s&,m2&,bits&,a2& m&=PEEKB(abits&+3) s&=m& AND &80 m&=m& AND &7F m2&=PEEKB(abits&+2) m2&=m2& AND &80 m&=m&*2+m2&/128 m&=(m&-127)+1023  a2&=ADDR(bits&) POKEB a2&+3,0 POKEB a2&+2,(PEEKB(abits&+2) AND $7F) POKEB a2&+1,PEEKB(abits&+1) POKEB a2& ,PEEKB(abits&)  a2&=ADDR(z) POKEB a2&+4,0 POKEB a2&+5,0 POKEB a2&+6,0 POKEB a2&+7,(bits& AND &000007)*&20 POKEB a2& ,(bits& AND &0007F8)/&8 POKEB a2&+1,(bits& AND &07F800)/&800 POKEB a2&+2,(m& AND &0F)*16+((bits& AND &780000)/&80000) POKEB a2&+3,s& OR ((m& AND &07F0)/16) RETURN zENDPPROC IEEEfloat_GRM64_2_OPL64:(abits&) LOCAL z,abit2& abit2&=ADDR(z) POKEB abit2&+3,PEEKB(abits&+7) POKEB abit2&+2,PEEKB(abits&+6) POKEB abit2&+1,PEEKB(abits&+5) POKEB abit2& ,PEEKB(abits&+4) POKEB abit2&+7,PEEKB(abits&+3) POKEB abit2&+6,PEEKB(abits&+2) POKEB abit2&+5,PEEKB(abits&+1) POKEB abit2&+4,PEEKB(abits&) RETURN zENDPREM *** Returns the current text cursor position ***PROC GetCursPos:(ax&,ay&) LOCAL a%(10),sx%,sy%  SCREENINFO a%() a%(1)=1 : a%(2)=1 IOW(-2,8,a%(),a%()) POKEW ax&,(a%(5)+1) POKEW ay&,(a%(6)+1)ENDPREM *** same as VAL, but without runtime error ***PROC StrVal:(str$) LOCAL c%,lng%,nums%,commas%,ch%  IF str$="" : RETURN 0 : ENDIF  lng%=LEN(str$) c%=1 nums%=0 : commas%=0 WHILE c%<=lng% ch%=ASC(MID$(str$,c%,1)) IF ch%>=%0 AND ch%<=%9 nums%=nums%+1 ELSEIF ch%=%. IF commas%>0 : RETURN 0 : ENDIF commas%=1 ELSEIF ch%=%+ OR ch%=%- IF c%<>1 : RETURN 0 : ENDIF ELSE RETURN 0 ENDIF c%=c%+1 ENDWH IF nums%=0 : RETURN 0 : ENDIF RETURN VAL(str$)ENDPREM *** Returns first position of char in string ***REM (beginning on position pos%)PROC PosInStr%:(char$,string$,pos%) LOCAL c%,lng% lng%=LEN(string$) c%=pos% WHILE c%<=lng% IF MID$(string$,c%,1)=char$ RETURN c% ENDIF c%=c%+1 ENDWH RETURN 0ENDPREM *** Returns last position of char in string ***PROC LPosInStr%:(char$,string$) LOCAL c% c%=LEN(string$) WHILE c%>0 IF MID$(string$,c%,1)=char$ RETURN c% ENDIF c%=c%-1 ENDWH RETURN 0ENDPREM *** Returns the num%th substring (parted by spaces) ***PROC SubString$:(str$,num%) LOCAL c1%,c2%,n%,sub$(255) c1%=0 : n%=0 DO c2%=PosInStr%:(" ",str$,c1%+1) IF c2%=0 : c2%=LEN(str$)+1 : ENDIF IF c2%>c1%+1 n%=n%+1 IF n%=num% RETURN MID$(str$,c1%+1,c2%-c1%-1) ENDIF ENDIF IF c2%>=LEN(str$) : RETURN "" : ENDIF c1%=c2% UNTIL KFalse%ENDPREM *** formated output of numerical values ***PROC NumFormat$:(val%,c%) LOCAL c2%,str$(10) IF val%=0 c2%=c%-1 ELSE c2%=c%-INT(LOG(val%))-1 ENDIF str$="" WHILE c2%>0 str$=str$+"0" : c2%=c2%-1 ENDWH RETURN str$+FIX$(val%,0,10)ENDPREM *** modulo functions ***PROC modulo%:(v1%,v2%) RETURN v1%-((v1%/v2%)*v2%)ENDPPROC modulo:(v1,v2%) RETURN v1-(INT(v1/v2%)*v2%)ENDPREM *** reads hexvalue from string ***PROC Hex2Dec%:(parseline$) LOCAL pos%,dec%,lng%,sum%,pl$(255) pl$=parseline$ lng%=LEN(pl$) pos%=1 sum%=0 WHILE pos%<=lng% dec%=PEEKB(ADDR(pl$)+pos%) IF dec%>%9 dec%=dec%-%A+10 ELSE dec%=dec%-%0 ENDIF sum%=sum%*16+dec% pos%=pos%+1 ENDWH RETURN sum%ENDPREM *** writes hexvalue to string ***PROC Dec2Hex$:(dec%,fix%) LOCAL hx$(20),lng% hx$=HEX$(dec%) lng%=LEN(hx$) WHILE lng%0 AND r1%>r2% file2$=LEFT$(file2$,r1%-1) ENDIF file2$=PARSE$(ext$,file2$,offs%()) RETURN file2$ENDPREM *** Reads settings from ini-file or sets defaults ***PROC InitSettings%: LOCAL IniFile$(255),offs%(6),h%,r% LOCAL city$(100),country$(100),lat,lon LOCAL dst&,hcity$(100),hcountry$(100),iscapital%  connectmode%=KModeDisconnected% : REM no connection established sbuffer_start%=1 sbuffer_cnt% =0 REM read settings from ini file IniFile$=PARSE$(SIniFileExt$,CMD$(1),offs%()) IF EXIST(IniFile$) DO r%=IOOPEN(h%,IniFile$,$400) IF r%=0 IOREAD(h%,ADDR(yourtype$),4) IOREAD(h%,ADDR(mytype$),4) IOREAD(h%,ADDR(baud%),2) IOREAD(h%,ADDR(parity%),2) IOREAD(h%,ADDR(data%),2) IOREAD(h%,ADDR(stop%),2) IOREAD(h%,ADDR(hand%),2) IOREAD(h%,ADDR(GRMN_baud%),2) IOREAD(h%,ADDR(GRMN_parity%),2) IOREAD(h%,ADDR(GRMN_data%),2) IOREAD(h%,ADDR(GRMN_stop%),2) IOREAD(h%,ADDR(GRMN_hand%),2) IOREAD(h%,ADDR(setting%(1)),10*2) IOREAD(h%,ADDR(format%(1)),10*2) IOREAD(h%,ADDR(LastParseFile$),256) IOREAD(h%,ADDR(LastSunEclFile$),256) IOREAD(h%,ADDR(LastMonitorFile$),256) IOREAD(h%,ADDR(LastStatisticFile$),256) IOREAD(h%,ADDR(LastTrackFile$),256) IOREAD(h%,ADDR(LastWaypointFile$),256) IOREAD(h%,ADDR(utc_offs&),4) IOREAD(h%,ADDR(dst&),4) IOREAD(h%,ADDR(hcity$),100) IOREAD(h%,ADDR(hcountry$),100) IOREAD(h%,ADDR(UseSystemFolder&),4) IOREAD(h%,ADDR(PropDevice$),5) IOREAD(h%,ADDR(MapCursorMask%),2) IOREAD(h%,ADDR(MapPenAction%),2) IOREAD(h%,ADDR(UseFastFileDialog%),2) REM in order to keep compatibility to older versions REM of the ini file, following entries have to be tested IF IOREAD(h%,ADDR(LastRouteFile$),256)<=0 OR LastRouteFile$="" LastRouteFile$=MyDir$+SRouteFolder$+SRouteFile$ ENDIF IF IOREAD(h%,ADDR(LastWaypExportFile$),256)<=0 OR LastWaypExportFile$="" LastWaypExportFile$=MyDir$+SWaypointFolder$+SWaypExportFile$ ENDIF IF IOREAD(h%,ADDR(wayp_xch_setts&),4)<=0 OR wayp_xch_setts&<&11111 OR wayp_xch_setts&>&35555 wayp_xch_setts&=&34321 ENDIF IOREAD(h%,ADDR(GRMNwaitforrequest%),2) IOCLOSE(h%) REM check, if UTC offset has to be changed  IF HomeCity%:(ADDR(city$),ADDR(country$)) IF hcity$<>city$ OR hcountry$<>country$ dINIT "UTC offset" dTEXT "","Home city is changed.",2 dTEXT "","Do you want to reset UTC offset?",2 dBUTTONS " No ",(%N+$300),"Yes",(%Y+$300) Busy:(KBusyOff$,0) Lock:(KLock%) : h%=DIALOG : Lock:(KUnlock%) IF h%=%y GetCityInfos%:(city$,country$,ADDR(lat),ADDR(lon),ADDR(utc_offs&),ADDR(iscapital%)) IF SIDaylightSaving%:(0) : utc_offs&=utc_offs&+3600 : ENDIF ProgSettings_Units: ENDIF ELSE IF dst&<>SIDaylightSaving%:(0) IF dst& dINIT "UTC offset" dTEXT "","Daylight saving was switched off.",2 dTEXT "","Do you want to decrement UTC offset?",2 dBUTTONS " No ",(%N+$300),"Yes",(%Y+$300) Busy:(KBusyOff$,0) Lock:(KLock%) : h%=DIALOG : Lock:(KUnlock%) IF h%=%y utc_offs&=utc_offs&-3600 ENDIf ELSE dINIT "UTC offset" dTEXT "","Daylight saving was switched on.",2 dTEXT "","Do you want to increment UTC offset?",2 dBUTTONS " No ",(%N+$300),"Yes",(%Y+$300) Busy:(KBusyOff$,0) Lock:(KLock%) : h%=DIALOG : Lock:(KUnlock%) IF h%=%y utc_offs&=utc_offs&+3600 ENDIf ENDIF ENDIF ENDIF ENDIF RETURN KTrue% ENDIF UNTIL NOT ErrorMessage%:("Open ini-file",r%,KTrue%) ENDIF  REM could not read from ini file -> defaults IF screen_xsize%<>640 OR screen_ysize%<>240 dINIT "Notice" dTEXT "","PsiNMEA is developed for use with",2 dTEXT "","640•240 displays. On your system",2 dTEXT "","some visualizations could be wrong.",2 dBUTTONS "Start PsiNMEA",13+$100," Abort PsiNMEA ",-(27+$100) IF DIALOG<>13 : RETURN KFalse% : ENDIF ENDIF ResetSerialSettings: GRMN_ResetSerialSettings: yourtype$="GP" : REM standard: connected device is GPS mytype$="CC" : REM PSION modulates CC setting%(1)=0 : REM no message on checksum error setting%(2)=1 : REM message on syntax error (maybe internal error) setting%(3)=0 : REM no message on reading error setting%(4)=0 : REM no message on unknown sentence format setting%(5)=1 : REM ignore sentences with checksum error setting%(6)=0 : REM (currently not used) setting%(7)=2 : REM ignore not recommended formats of NMEA version 2.00 setting%(8)=KModeDisconnected% : REM connection manually PropDevice$="" format%(1)=1 : REM lat/long output format format%(2)=1 : REM time format format%(3)=1 : REM am/pm-format format%(4)=1 : REM date format format%(5)=1 : REM angle unit = degree format%(6)=1 : REM length unit = metric format%(7)=1 : REM velocity unit = m/s format%(8)=1 : REM duration format = floating point format%(9)=1 : REM temperature unit = °C IF HomeCity%:(ADDR(city$),ADDR(country$)) GetCityInfos%:(city$,country$,ADDR(lat),ADDR(lon),ADDR(utc_offs&),ADDR(iscapital%)) IF SIDaylightSaving%:(0) : utc_offs&=utc_offs&+3600 : ENDIF ELSE utc_offs&=0 ENDIF LastParseFile$=MyDir$ LastSunEclFile$=MyDir$+SEclPathFile$ LastMonitorFile$=MyDir$ LastStatisticFile$=MyDir$ LastTrackFile$=MyDir$+STrackingFolder$ LastWaypointFile$=MyDir$+SWaypointFolder$ LastWaypExportFile$=MyDir$+SWaypointFolder$+SWaypExportFile$ LastRouteFile$=MyDir$+SRouteFolder$ UseSystemFolder&=512 MapCursorMask%=1 MapPenAction%=1 UseFastFileDialog%=KFalse% wayp_xch_setts&=&34321 GRMNwaitforrequest%=KFalse% WriteSettings: RETURN KTrue%ENDPREM *** Default serial port settings for NMEA ***PROC ResetSerialSettings: baud%=13 : REM 4800 baud parity%=0 : REM none parity data%=8 : REM 8 data bits stop%=1 : REM 1 stop bit hand%=4 : REM no handshakingENDPREM *** Default serial port settings for GRMN *** PROC GRMN_ResetSerialSettings: GRMN_baud%=15 : REM baud GRMN_parity%=0 : REM none parity GRMN_hand%=4 : REM no handshaking GRMN_stop%=0 : REM 0 stop bit GRMN_data%=8 : REM 8 data bits GRMNwaitforrequest%=KFalse%ENDPREM *** writes settings to ini file ***PROC WriteSettings: LOCAL IniFile$(255),offs%(6),h%,r%,dst& LOCAL city$(100),country$(100)  IniFile$=PARSE$(SIniFileExt$,CMD$(1),offs%()) DO r%=IOOPEN(h%,IniFile$,$102) IF r%=0 IOWRITE(h%,ADDR(yourtype$),4) IOWRITE(h%,ADDR(mytype$),4) IOWRITE(h%,ADDR(baud%),2) IOWRITE(h%,ADDR(parity%),2) IOWRITE(h%,ADDR(data%),2) IOWRITE(h%,ADDR(stop%),2) IOWRITE(h%,ADDR(hand%),2) IOWRITE(h%,ADDR(GRMN_baud%),2) IOWRITE(h%,ADDR(GRMN_parity%),2) IOWRITE(h%,ADDR(GRMN_data%),2) IOWRITE(h%,ADDR(GRMN_stop%),2) IOWRITE(h%,ADDR(GRMN_hand%),2) IOWRITE(h%,ADDR(setting%(1)),10*2) IOWRITE(h%,ADDR(format%(1)),10*2) IOWRITE(h%,ADDR(LastParseFile$),256) IOWRITE(h%,ADDR(LastSunEclFile$),256) IOWRITE(h%,ADDR(LastMonitorFile$),256) IOWRITE(h%,ADDR(LastStatisticFile$),256) IOWRITE(h%,ADDR(LastTrackFile$),256) IOWRITE(h%,ADDR(LastWaypointFile$),256) IOWRITE(h%,ADDR(utc_offs&),4) HomeCity%:(ADDR(city$),ADDR(country$)) dst&=SIDaylightSaving%:(0) IOWRITE(h%,ADDR(dst&),4) IOWRITE(h%,ADDR(city$),100) IOWRITE(h%,ADDR(country$),100) IOWRITE(h%,ADDR(UseSystemFolder&),4) IOWRITE(h%,ADDR(PropDevice$),5) IOWRITE(h%,ADDR(MapCursorMask%),2) IOWRITE(h%,ADDR(MapPenAction%),2) IOWRITE(h%,ADDR(UseFastFileDialog%),2) IOWRITE(h%,ADDR(LastRouteFile$),256) IOWRITE(h%,ADDR(LastWaypExportFile$),256) IOWRITE(h%,ADDR(wayp_xch_setts&),4) IOWRITE(h%,ADDR(GRMNwaitforrequest%),2) IOCLOSE(h%) RETURN ENDIF UNTIL ErrorMessage%:("Writing settings",r%,KTrue%)ENDPREM *** Welcome window/Abour box ***PROC AboutBox%:(wait%) LOCAL id%,id2%,r% id%=gCreateWindow%:(MAX(screen_xsize%/2-185,0),MAX(screen_ysize%/2-107,0),370,214,"About"+KDots$) IF id%<0 : RETURN 0 : ENDIF gCOLOR 180,180,180 gAT 98,59 : gFONT 12 : gSTYLE 9 : gPRINT "PsiNMEA" gCOLOR 0,0,0 gAT 95,60 : gPRINT "PsiNMEA"  gCOLOR 180,180,180 gAT 98,79 : gSTYLE 1 : gPRINT "Release "+KVerStr$+", "+KBuiltStr$ gCOLOR 0,0,0 gAT 95,80 : gPRINT "Release "+KVerStr$+", "+KBuiltStr$  gAT 25,110 : gFONT 7 : gSTYLE 0 : gPRINT "written by" gAT 25,128 : gFONT 8 : gPRINT "Torsten Baumbach" gAT 182,128 : gFONT 6 : gPRINT "Torsten.Baumbach@uni-jena.de" gAT 174,143 : gFONT 6 : gPRINT "http://pandora.inf.uni-jena.de/ttbb" gCOLOR 85,85,85 gAT 25,173 : gSTYLE 1 : gPRINT "Uses RMRAlarm & SystInfo © O.Cheong" gAT 25,187 : gSTYLE 1 : gPRINT "Uses nDirNav © A.Wilbur, H.Hirst, Neuon" gAT 25,201 : gSTYLE 1 : gPRINT "Contains digital maps of RealMaps © K.Millican"  ONERR noload:: id2%=gLOADBIT(MyDir$+SPicFile2$,0) ONERR off gUSE id% : gAT 25,43 gCOPY id2%,0,0,32,32,3 gCLOSE id2% GOTO isload::noload:: ONERR off ShortMessagePrompt:("Reading resource file","Resource file (MBM) not found.")isload:: gCOLOR 100,100,100 : gAT 200,95 : gLINETO 350,95 gAT 340,35 : gLINETO 340,105 gCOLOR 0,0,0 : gAT 200,97 : gLINETO 350,97 gAT 338,35 : gLINETO 338,105 gCOLOR 255,255,255 : gAT 339,94 : gLINETO 339,98 gAT 338,96 : gLINETO 341,96 gVISIBLE on Busy:(KBusyOff$,0) IF wait% r%=GET%:(KFalse%) gCLOSE id% RETURN 0 ENDIF RETURN id%ENDPREM *** Draws the standard background ***PROC InitScreen: LOCAL xs%,ys% xs%=640 ys%=240  ONERR nocr:: stdscreen%=gCREATE(0,0,xs%,ys%,0,1) ONERR off screen%=-1 gSETWIN screen_xsize%/2-xs%/2,screen_ysize%/2-ys%/2 SetScreen:(0) RETURNnocr:: ONERR off Busy:(KBusyOff$,0) ErrorMessage%:("Creating title screen",ERR,KFalse%) gCLS gAT 50,70 : gFONT 12 : gSTYLE 17 : gPRINT "PsiNMEA" gAT 50,90 : gFONT 10 : gSTYLE 0 : gPRINT "error during screen initialization" gVISIBLE on RETURNENDPREM *** Switchs off standard-/datascreen ***PROC ClearScreen: IF stdscreen% gUSE stdscreen% gVISIBLE off ENDIF gUSE 1 gCLSENDPREM *** Switchs on standard-/datascreen ***REM after a call of ClearScreen:PROC RefreshScreen: gUSE 1 gCLS IF stdscreen% gUSE stdscreen% gVISIBLE on ENDIFENDPREM *** Read datas asynchron from serial port ***PROC ReadSerialAsync%:(p3&,p4&,timeout%) LOCAL c%,r%,status%,buffer$(255),sec1,sec2,maxlng% maxlng%=PEEKW(p4&) r%=IOA(-1,1,status%,#ADDR(buffer$),maxlng%) IF r% IOCANCEL(-1) IOWAITSTAT status% RETURN KFalse% ENDIF  sec1=-1 DO IOYIELD IF status%<>-46 : BREAK : ENDIF IF sec1=-1 sec1=DATETOSECS(YEAR,MONTH,DAY,HOUR,MINUTE,SECOND) ENDIF sec2=DATETOSECS(YEAR,MONTH,DAY,HOUR,MINUTE,SECOND) IF sec2-sec1>timeout% IOCANCEL(-1) IOWAITSTAT status% RETURN KFalse% ENDIF  UNTIL KFalse% c%=0 WHILE c%31 pos%=pos%+1 ENDWH IF pos%=255 REM sentence longer than buffer; REM here you can insert code for reading REM again, but I think its not needed RETURN "" ENDIF POKEB ADDR(buffer$),pos%-1 RETURN buffer$ENDPREM *** Reads sentence from internal sentence buffer ***REM into global variablePROC GetSentence: LOCAL p%,r% IF sbuffer_cnt%<=KMaxSentenceBuffer%/10 REM fill buffer with new sentences p%=sbuffer_start%+sbuffer_cnt% r%=MIN(KMaxSentenceBuffer%-sbuffer_cnt%,KMaxSentenceBuffer%/10) WHILE r%>0 IF p%>KMaxSentenceBuffer% p%=p%-KMaxSentenceBuffer% ENDIF sentence_buffer$(p%)=GetSentenceDirect$: IF sentence_buffer$(p%)="" r%=0 ELSE sbuffer_cnt%=sbuffer_cnt%+1 r%=r%-1 p%=p%+1 ENDIF ENDWH ENDIF  IF sbuffer_cnt%>0 REM sentence buffer is not empty sentence$=sentence_buffer$(sbuffer_start%) sbuffer_start%=sbuffer_start%+1 sbuffer_cnt%=sbuffer_cnt%-1 IF (sbuffer_start%>KMaxSentenceBuffer%) OR (sbuffer_cnt%=0) sbuffer_start%=1 ENDIF ELSE sentence$="" ENDIFENDPREM *** Writes a sentence to serial port ***REM addcs%=KTrue% -> add checksumPROC SendSentence$:(send$,addcs%) LOCAL lng%,buffer$(100),ret$(100) IF addcs% buffer$=AddChecksum$:(send$) ELSE buffer$=send$ ENDIF ret$=buffer$ buffer$=buffer$+CHR$(10)+CHR$(13) lng%=LEN(buffer$) IOW(-1,2,#(ADDR(buffer$)+1),lng%) RETURN ret$+"[CR][LF]"ENDPREM *** Opens serial port (no settings!) ***PROC OpenSerial%: IF connectmode%=KModeDisconnected% ONERR notopen:: LOPEN "tty:a" ONERR off RETURN KTrue%notopen:: ONERR off dINIT "Open serial port" dTEXT "","Error: "+ERR$(ERR),2 dTEXT "","Be sure, no other application is using",2 dTEXT "","the serial port and the communication",2 dTEXT "","mode in the system menu is set to NONE.",2 dBUTTONS " Okay ",13+$100 Lock:(KLock%) : DIALOG : Lock:(KUnlock%) RETURN KFalse% ENDIF RETURN KTrue%ENDPREM *** Closes serial port ***PROC CloseSerial: SetScreen:(0) ONERR noclose:: LCLOSE ONERR OFF connectmode%=KModeDisconnected% RETURN 1.0noclose:: gIPRINT "Could not close serial port!",1 RETURN 0.0ENDPREM *** Sets the serial settings for NMEA ***PROC SetSerial: LOCAL frame%,cmd%(7),term&,dummy%,err% IF connectmode%<>KModeNMEA% : RETURN : ENDIF term&=$400 : REM terminating mask for reading frame%=data%-5 IF stop%=2 :frame%=frame% OR 16 :ENDIF IF parity% :frame%=frame% OR 32 :ENDIF cmd%(1)=baud% OR (baud%*256) cmd%(2)=frame% OR (parity%*256) cmd%(3)=(hand% AND 255) OR $1100 cmd%(4)=$13  POKEL ADDR(cmd%(5)),term& err%=IOW(-1,7,cmd%(1),dummy%) IF err% ErrorMessage%:("Setting serial port",err%,KFalse%) ENDIFENDPREM *** Sets the serial settings for GRMN ***PROC GRMN_SetSerial: LOCAL frame%,cmd%(7),term&,dummy%,err% IF connectmode%<>KModeGRMN% : RETURN : ENDIF term&=0 : REM terminating mask for reading frame%=GRMN_data%-5 IF GRMN_stop%=2 :frame%=frame% OR 16 :ENDIF IF GRMN_parity% :frame%=frame% OR 32 :ENDIF cmd%(1)=GRMN_baud% OR (GRMN_baud%*256) cmd%(2)=frame% OR (GRMN_parity%*256) cmd%(3)=(GRMN_hand% AND 255) OR $1100 cmd%(4)=$13  POKEL ADDR(cmd%(5)),term& err%=IOW(-1,7,cmd%(1),dummy%) IF err% ErrorMessage%:("Setting serial port",err%,KFalse%) ENDIFENDPREM *** Dialog for serial settings of NMEA ***PROC InputSerial: LOCAL parity2%,hand2%,data2%,r%  DO  parity2%=parity%+1 data2%=data%-4 IF hand%=11 : hand2%=1 ELSEIF hand%=4 : hand2%=2 ELSEIF hand%=7 : hand2%=3 ELSEIF hand%=0 : hand2%=4 ELSEIF hand%=3 : hand2%=5 ELSEIF hand%=12 : hand2%=6 ELSEIF hand%=15 : hand2%=7 ELSEIF hand%=8 : hand2%=8 ENDIF  dINIT "Serial settings (NMEA)" dCHOICE baud%,"Baud rate","50,75,110,134,150,300,600,1200,1800,2000,2400,3600,4800,7200,9600,19200" dCHOICE parity2%,"Parity","NONE,EVEN,ODD" dCHOICE data2%,"Data bits","5,6,7,8" dCHOICE stop%,"Stop bits","1,2" dCHOICE hand2%,"Handshake","all,none,XON,RTS,XON+RTS,DSR,XON+DSR,RTS+DSR" dBUTTONS " Default ",%D," Cancel ",-(27+$100),"Set",13+$100 Lock:(KLock%) : r%=DIALOG : Lock:(KUnlock%)  IF r%=13 data%=data2%+4 parity%=parity2%-1 IF hand2%=1 : hand%=11 ELSEIF hand2%=2 : hand%=4 ELSEIF hand2%=3 : hand%=7 ELSEIF hand2%=4 : hand%=0 ELSEIF hand2%=5 : hand%=3 ELSEIF hand2%=6 : hand%=12 ELSEIF hand2%=7 : hand%=15 ELSEIF hand2%=8 : hand%=8 ENDIF BREAK ELSEIF r%=%d ResetSerialSettings: ELSE BREAK ENDIF  UNTIL KFalse%ENDPREM *** Dialog for serial settings of GRMN/GRMN ***PROC GRMN_InputSerial: LOCAL parity2%,hand2%,data2%,r%  DO parity2%=GRMN_parity%+1 data2%=GRMN_data%-4 IF GRMN_hand%=11 : hand2%=1 ELSEIF GRMN_hand%=4 : hand2%=2 ELSEIF GRMN_hand%=7 : hand2%=3 ELSEIF GRMN_hand%=0 : hand2%=4 ELSEIF GRMN_hand%=3 : hand2%=5 ELSEIF GRMN_hand%=12 : hand2%=6 ELSEIF GRMN_hand%=15 : hand2%=7 ELSEIF GRMN_hand%=8 : hand2%=8 ENDIF  dINIT "Serial settings (GRMN)" dCHOICE GRMN_baud%,"Baud rate","50,75,110,134,150,300,600,1200,1800,2000,2400,3600,4800,7200,9600,19200" dCHOICE parity2%,"Parity","NONE,EVEN,ODD" dCHOICE data2%,"Data bits","5,6,7,8" dCHOICE GRMN_stop%,"Stop bits","1,2" dCHOICE hand2%,"Handshake","all,none,XON,RTS,XON+RTS,DSR,XON+DSR,RTS+DSR" dTEXT "","",$800 dCHECKBOX GRMNwaitforrequest%,"Wait for host command before sending" dBUTTONS " Default ",%D," Cancel ",-(27+$100),"Set",13+$100 Lock:(KLock%) : r%=DIALOG : Lock:(KUnlock%)  IF r%=13 GRMN_data%=data2%+4 GRMN_parity%=parity2%-1 IF hand2%=1 : GRMN_hand%=11 ELSEIF hand2%=2 : GRMN_hand%=4 ELSEIF hand2%=3 : GRMN_hand%=7 ELSEIF hand2%=4 : GRMN_hand%=0 ELSEIF hand2%=5 : GRMN_hand%=3 ELSEIF hand2%=6 : GRMN_hand%=12 ELSEIF hand2%=7 : GRMN_hand%=15 ELSEIF hand2%=8 : GRMN_hand%=8 ENDIF BREAK ELSEIF r%=%d GRMN_ResetSerialSettings: ELSE BREAK ENDIF  UNTIL KFalse%ENDPREM *** Clear port and sentence buffer ***PROC ClearPortBuffer: LOCAL c% sbuffer_start%=1 : sbuffer_cnt%=0 c%=0 WHILE c%<20 sentence$=GetSentenceDirect$: IF sentence$="" : RETURN : ENDIF c%=c%+1 ENDWHENDPREM *** Create and show main menu; returns selection ***PROC SysMenu%: LOCAL fl1%,fl1n%,fl2%,fl2n%,flx%,fl%(10),c%,o1%,o2%,ox%  fl1%=0 fl2%=0 flx%=$1000 o1%=0 : o2%=0 : ox%=0 IF connectmode%=KModeNMEA% fl1%=$1000 : flx%=0 : o1%=$2000 c%=0 WHILE c%<10 c%=c%+1 IF screen%=c%-1 : fl%(c%)=$1000 : ENDIF ENDWH ELSEIF connectmode%=KModeGRMN% fl2%=$1000 : flx%=0 : o2%=$2000 ELSE ox%=$2000 ENDIF fl1n%=$1000-fl1% fl2n%=$1000-fl2% mINIT mCASC "Serial port","NMEA"+KDots$,%N,"GRMN"+KDots$+" ",%G mCASC "Settings","Program"+KDots$,%p,"Output"+KDots$+" ",-%o,"NMEA socket"+KDots$,13,"GRMN socket"+KDots$,-27,"Serial port>",12 mCASC "Monitor","sentences"+KDots$,%m+fl1n%,"parsed datas"+KDots$,-(%M+fl1n%),"from file"+KDots$,%F mCASC "Local circumstances","current location"+KDots$,16+fl1n%,"entered location"+KDots$,17 mCASC "Location on map","Current"+KDots$,%c+fl1n%,"Entered"+KDots$,%E mCASC " Map registry ","Add map"+KDots$,18,"Edit map"+KDots$,-19,"Check"+KDots$,-23,"Add world map"+KDots$,30 mCASC "Protocol"," NMEA",%n+$0900+o1%," GRMN",%g+$0a00+o2%," Disconnect ",%d+$0b00+ox% mCASC " Waypoints","Add/Edit"+KDots$,-%w,"Send"+KDots$,%i+fl2n%,"Read"+KDots$,-(%j+fl2n%),"Export"+KDots$,%x,"Import"+KDots$,%y mCASC " Routes","New/Edit"+KDots$,%r,"Analyse/Draw"+KDots$,-%l,"Send"+KDots$,%I+fl2n%,"Read"+KDots$,-(%J+fl2n%),"Export"+KDots$,%X,"Import"+KDots$,%Y mCASC " Tracks","Tracking"+KDots$,%t+fl1n%,"Analyse/Draw"+KDots$+" ",-%s,"Read"+KDots$,-(%k+fl2n%),"Add to route"+KDots$,%R mCASC "Sun eclipse","Local circumstances>",-7,"Draw path"+KDots$,20 rem mCASC "Screens","Standard",(25+fl1n%+fl%(1)),"GPS",-(26+fl1n%+fl%(2)),"userdefined"+KDots$,24+fl1n% mCARD "Program","Protocol>",11,"Settings>",-5,"About"+KDots$,22,"Exit ",%e REM -(%S+fl1n%),"Screens>", IF connectmode%=KModeGRMN% mCASC "Read special","Date & Time",2+fl1n%,"GPS location",-(2+fl1n%),"userdefined"+KDots$,-(15+fl1n%),"Query"+KDots$,28+fl1n% mCARD "NMEA","About device"+KDots$,2+fl1n%,"Set listener ID"+KDots$,-%L,"Monitor>",8,"Terminal",-(%T+fl1n%),"Read special>",2,"Statistics"+KDots$,%S+fl1n% mCARD "Garmin","About device"+KDots$,-%a,"Read date & time",%D,"Read GPS location",%P,"Read PVT datas",-%V,"Power off",14 REM ,"Read/save almanac",%A,"Restore almanac"+KDots$,%B ELSE mCASC "Read special","Date & Time",%D+fl1n%,"GPS location",-(%P+fl1n%),"userdefined"+KDots$,-(15+fl1n%),"Query"+KDots$,28+fl1n% mCARD "NMEA","About device"+KDots$,%a+fl1n%,"Set listener ID"+KDots$,-%L,"Monitor>",8,"Terminal",-(%T+fl1n%),"Read special>",2,"Statistics"+KDots$,%S+fl1n% ENDIF mCARD "GPS","Location on map>",3,"Tracking"+KDots$,%t+fl1n% mCARD "Databases"," Map registry >",-4," Waypoints>",9," Routes>",-10," Tracks>",11 IF SIAutoSwitchOffBehaviour&:>0 fl1%=$2800 ELSE fl1%=0 ENDIF mCARD "More","Unit converter"+KDots$,%C,"Dist. calculator"+KDots$,%Z,"Sun eclipse>",-3,"Backlight",%b-$2800*BACKLIGHTON&:,"Auto off",-(%u+fl1%),"Task manager"+KDots$+" ",21  Lock:(KLock%) : c%=MENU(menuinit1%) : Lock:(KUnlock%) RETURN c%ENDPREM ****** procedures for menu commands ******REM ******************************************PROC MenuProc_Ctrl_A: REM get other device type LOCAL str$(100) IF connectmode%=KModeNMEA% str$=GetYourDevice$:(KTrue%) Busy:(KBusyOff$,0) gIPRINT str$,1 ELSEIF connectmode%=KModeGRMN% GetGarminProductDatas$:(KTrue%) ENDIF ENDPPROC MenuProc_Ctrl_B: REM switch backlight LOCAL r% IF NOT BACKLIGHTON&: IF NOT IsExternalPowerPresent&: dINIT "No external power present" dTEXT "","Do you really want to switch on",2 dTEXT "","the untimed backlight ?",2 dBUTTONS "No",%N+$300," Yes ",%Y+$300 Lock:(KLock%) : r%=DIALOG : Lock:(KUnlock%) IF r%<>%y : RETURN : ENDIF ENDIF SETBACKLIGHTBEHAVIOR:(1) SETBACKLIGHTON:(1) Busy:(KBusyOff$,0) gIPRINT "Untimed (!) backlight on",1 ELSE SETBACKLIGHTON:(0) SETBACKLIGHTBEHAVIOR:(0) ENDIFENDPPROC MenuProc_Ctrl_C: REM location on map IF connectmode%<>KModeNMEA% : RETURN : ENDIF RealMap:(KFalse%,KFalse%,0,0,0,0,0,0,0,0,0,1000,1000,0)ENDPPROC MenuProc_Ctrl_D: REM disconnect IF connectmode%=KModeDisconnected% : RETURN : ENDIF CloseSerial: Busy:(KBusyOff$,0) gIPRINT "Disconnected",1ENDPPROC MenuProc_Ctrl_G: LOCAL str$(255) REM Connect with GARMIN-Protocol IF connectmode%=KModeGRMN% : RETURN : ENDIF CloseSerial: SetScreen:(0) IF OpenSerial%: connectmode%=KModeGRMN% GRMN_SetSerial: str$=GetGarminProductDatas$:(KFalse%) Busy:(KBusyOff$,0) IF str$<>"" gIPRINT str$,1 ELSE gIPRINT "No GRMN device found.",1 ENDIF GRMN_capnum%=0 ENDIFENDPPROC MenuProc_Ctrl_I: REM Send waypoints 2 Garmin IF connectmode%=KModeGRMN% : Waypoints2Garmin: : ENDIFENDPPROC MenuProc_Ctrl_J: REM Read waypoints from Garmin IF connectmode%=KModeGRMN% : WaypointsFromGarmin: : ENDIFENDPPROC MenuProc_Ctrl_K: TrackFromGarmin:ENDPPROC MenuProc_Ctrl_L: REM analyse/draw a route AnalyseTrack:(KTrue%)ENDPPROC MenuProc_Ctrl_M: REM monitoring IF connectmode%<>KModeNMEA% : RETURN : ENDIF ShowMonitor:ENDPPROC MenuProc_Ctrl_N: LOCAL str$(255) REM connect with NMEA protocol IF connectmode%=KModeNMEA% : RETURN : ENDIF CloseSerial: IF OpenSerial%: sbuffer_start%=1 : sbuffer_cnt%=0 connectmode%=KModeNMEA% SetSerial: str$=GetYourDevice$:(KFalse%) Busy:(KBusyOff$,0) gIPRINT str$,1 ENDIFENDPPROC MenuProc_Ctrl_O: REM program settings ProgSettings_Units:ENDPPROC MenuProc_Ctrl_P: REM program settings ProgSettings_General:ENDPPROC MenuProc_Ctrl_R: REM New/Edit Route EditRoute:ENDPPROC MenuProc_Ctrl_S: REM Analyse Track AnalyseTrack:(KFalse%)ENDPPROC MenuProc_Ctrl_T: REM Track on map RealMap:(KFalse%,KTrue%,0,0,0,0,0,0,0,0,0,1000,1000,0)ENDPPROC MenuProc_Ctrl_U: REM switch auto off LOCAL r% IF SIAutoSwitchOffBehaviour&:>0 IF NOT IsExternalPowerPresent&: dINIT "No external power present" dTEXT "","Do you really want to deactivate",2 dTEXT "","the auto switch off ?",2 dBUTTONS "No",%N+$300," Yes ",%Y+$300 Lock:(KLock%) : r%=DIALOG : Lock:(KUnlock%) IF r%<>%y : RETURN : ENDIF ENDIF SETAUTOSWITCHOFFBEHAVIOR:(0) Busy:(KBusyOff$,0) gIPRINT "Auto switch off deactivated",1 ELSE SETAUTOSWITCHOFFBEHAVIOR:(1) gIPRINT "Auto switch off activated",1 ENDIFENDPPROC MenuProc_Ctrl_W: REM Add/Edit waypoint file EditWaypoint:ENDPPROC MenuProc_Ctrl_X: Waypoints2Textfile:ENDPPROC MenuProc_Ctrl_Y: WaypointsFromTextfile:ENDPPROC MenuProc_ShiftCtrl_A: ReadAlmanacDatas:ENDPPROC MenuProc_ShiftCtrl_B: UpdateAlmanac:ENDPPROC MenuProc_ShiftCtrl_C: REM Unit converter UnitConverter:ENDPPROC MenuProc_ShiftCtrl_D: REM Parse for date and time IF connectmode%=KModeNMEA% ShowCurrentDateTime: ELSEIF connectmode%=KModeGRMN% ReadGarminDateAndTime: ENDIFENDPPROC MenuProc_ShiftCtrl_E: REM entered location on map RealMap:(KTrue%,KFalse%,0,0,0,0,0,0,0,0,0,1000,1000,0)ENDPPROC MenuProc_ShiftCtrl_F: REM Parse file sentence by sentence ParseLoop:(KFalse%)ENDPPROC MenuProc_ShiftCtrl_G: REM Set serial port for GARMIN-Protocol GRMN_InputSerial: GRMN_SetSerial:ENDPPROC MenuProc_ShiftCtrl_I: REM Send routes 2 Garmin IF connectmode%=KModeGRMN% : Routes2Garmin: : ENDIFENDPPROC MenuProc_ShiftCtrl_J: REM Read routes from Garmin IF connectmode%=KModeGRMN% : RoutesFromGarmin: : ENDIFENDPPROC MenuProc_ShiftCtrl_L: REM set my device type SetMyDevice:ENDPPROC MenuProc_ShiftCtrl_M: REM Parse serial port sentence by sentence IF connectmode%<>KModeNMEA% : RETURN : ENDIF ParseLoop:(KTrue%)ENDPPROC MenuProc_ShiftCtrl_N: REM serial settings for NMEA InputSerial: SetSerial:ENDPPROC MenuProc_ShiftCtrl_T: REM Terminal IF connectmode%<>KModeNMEA% : RETURN : ENDIF Terminal:ENDPPROC MenuProc_ShiftCtrl_P: REM Parse for location IF connectmode%=KModeNMEA% ShowCurrentPosition: ELSEIF connectmode%=KModeGRMN% ReadGarminPosition: ENDIFENDPPROC MenuProc_ShiftCtrl_R: REM Add track to route Track2Route:ENDPPROC MenuProc_ShiftCtrl_S: REM Statistics of repeated messurements IF connectmode%<>KModeNMEA% : RETURN : ENDIF Statistics:ENDPPROC MenuProc_ShiftCtrl_V: REM read PVT datas ReadPVTDatas:ENDPPROC MenuProc_ShiftCtrl_X: Route2Textfile:ENDPPROC MenuProc_ShiftCtrl_Y: RouteFromTextfile:ENDPPROC MenuProc_ShiftCtrl_Z: REM distance calculator DistanceCalculator:ENDPREM *** general settings dialog ***PROC ProgSettings_General: LOCAL r%,sysfold%,fast%,prot%  IF setting%(8)=KModeNMEA% : prot%=2 ELSEIF setting%(8)=KModeGRMN% : prot%=3 ELSE prot%=1 ENDIF  dINIT "Settings"  dCHOICE prot%,"Establish connection","manually,during start (NMEA),during start (GRMN)" fast%=UseFastFileDialog% dCHECKBOX fast%,"Fast file dialogs" sysfold%=(UseSystemFolder&<>0) dCHECKBOX sysfold%,"Show system folder"  dBUTTONS " Cancel ",-(27+$100),"Set",13+$100 Lock:(KLock%) : r%=DIALOG : Lock:(KUnlock%)  IF r%<>13 : RETURN : ENDIF  IF sysfold% : UseSystemFolder&=512 ELSE : UseSystemFolder&=0 ENDIF  IF (NOT UseFastFileDialog%) AND fast% dINIT "Warning - nDirNav",17 dTEXT "","The fast file dialog boxes are using the",2 dTEXT "","nDirNav OPX module by Neuron. The version 1.00",2 dTEXT "","and earlier versions of nDirNav contain",2 dTEXT "","the following bug: a slow double click on",2 dTEXT "","a file name leads to an abort of PsiNMEA.",2 dBUTTONS " Use standard dialogs ",-27," Use fast dialogs ",13 Lock:(KLock%) : fast%=DIALOG : Lock:(KUnlock%) IF fast%=13 : UseFastFileDialog%=KTrue% : ENDIF ELSE UseFastFileDialog%=fast% ENDIF  IF prot%=2 : setting%(8)=KModeNMEA% ELSEIF prot%=3 : setting%(8)=KModeGRMN% ELSE : setting%(8)=KModeDisconnected% ENDIFENDPREM *** settings dialog for units/formats ***PROC ProgSettings_Units: utc_offs&=utc_offs&/60 dINIT "",19 dCHOICE format%(2),"Time format","05:20:30.4,05h20m30.4s" dCHOICE format%(3),"","12h,24h" dLONG utc_offs&,"UTC offset (min)",-720,720 dCHOICE format%(4),"Date format","yyyy/mm/dd,yyyy/dd/mm,yyyy-mm-dd,dd.mm.yyyy" dCHOICE format%(8),"Duration format","floating point,separated" dCHOICE format%(1),"Latitude/Longitude format","12°30'0.0"+CHR$(%")+",12°30.0',12.5°" dCHOICE format%(6),"Length units","metric,British" dCHOICE format%(5),"Angle unit","degree,radiant,grad" dCHOICE format%(7),"Velocity unit","m/s,km/h,knots" dCHOICE format%(9),"Temperature unit","°Celcius,Kelvin,Fahrenheit,Réaumur" dBUTTONS " Cancel ",-(27+$100),"Set",13+$100 Lock:(KLock%) : DIALOG : Lock:(KUnlock%) utc_offs&=utc_offs&*60ENDPREM *** settings for NMEA handling ***PROC ProgSettings_NMEAparser: LOCAl buffer$(255),idnum%,r%,r2%,add%,id$(3),n$(50) DO DO ONERR notopen:: OPEN MyDir$+SManufacturersFile$+" SELECT id,name FROM mfacturers ORDER BY name",M,id$,mname$ ONERR OFF BREAKnotopen:: ONERR OFF IF NOT ErrorMessage%:("Reading manufacturers list",ERR,KTrue%) RETURN ENDIF UNTIL KFalse%  dINIT "Settings",16 Busy:("Building list"+KDots$,1) REM read all manufacturers and add to choicefield buffer$="(Ignore)" : idnum%=1 FIRST DO dCHOICE idnum%,"Propietary datas",buffer$+",..." buffer$=M.mname$ IF M.id$=PropDevice$ : idnum%=POS+1 : ENDIF NEXT UNTIL EOF CLOSE dCHOICE idnum%,"Propietary datas",buffer$ dCHOICE setting%(7),"Viewing formats","all formats,only recommended v2.00" REM only influences dialogs, where user has to choose formats  dCHOICE setting%(5),"CRC error","Abort sentence,Abort all,Ignore" dCHECKBOX setting%(1),"Prompt on CRC error" dCHECKBOX setting%(2)," ... syntax error" dCHECKBOX setting%(3)," ... reading error" dCHECKBOX setting%(4)," ... unknown sentence" dBUTTONS " New manufacturer"+KDots$+" ",%N,"Cancel",-(27+$100),"Set",13+$100 Busy:(KBusyOff$,0) Lock:(KLock%) : r%=DIALOG : Lock:(KUnlock%) IF r%=%n REM add new manufacturer add%=KTrue% DO ONERR notopen2:: OPEN MyDir$+SManufacturersFile$+" SELECT id,name FROM mfacturers",M,id$,mname$ ONERR OFF BREAKnotopen2:: ONERR OFF IF NOT ErrorMessage%:("Reading manufacturers list",ERR,KTrue%) add%=KFalse% BREAK ENDIF UNTIL KFalse%  IF NOT add% : CONTINUE : ENDIF dINIT "Add new manufacturer" dEDIT id$,"ID (3 characters)",3 dEDIT n$ ,"Name",20 dBUTTONS " Cancel ",-(27+$100),"Add",13+$100 Lock:(KLock%) : r2%=DIALOG : Lock:(KUnlock%) IF r2%=13  BEGINTRANS INSERT M.id$=UPPER$(id$) M.mname$=UPPER$(n$) PUT COMMITTRANS ENDIF CLOSE ENDIF UNTIL r%<>%n IF r%<>13 : RETURN : ENDIF PropDevice$=""  IF idnum%>1 DO ONERR notopen3:: OPEN MyDir$+SManufacturersFile$+" SELECT id,name FROM mfacturers ORDER BYname",M,id$,mname$ ONERR off POSITION idnum%-1 PropDevice$=M.id$ CLOSE BREAKnotopen3:: ONERR off IF NOT ErrorMessage%:("Reading manufacturers list",ERR,KTrue%) add%=KFalse% BREAK ENDIF UNTIL KFalse% ENDIF ENDPREM *** settings for GRMN handling ***PROC ProgSettings_GRMNparser: dINIT "Settings" dTEXT "","At the moment no user settings imlemented." dBUTTONS " Okay ",13+$100 Lock:(KLock%) : DIALOG : Lock:(KUnlock%)ENDPREM *** monitoring of all sentences ***PROC ShowMonitor: LOCAL chk%,c&,file$(255),cnt&,h%,r% LOCAL event&(16),eventstat%  dINIT "Monitoring" dLONG c&,"Number of sentences",0,65000 dCHECKBOX chk%,"Printing to file" dBUTTONS " Cancel ",-(27+$100),"Okay",13+$100 Lock:(KLock%) : r%=DIALOG : Lock:(KUnlock%) IF r%<>13 : RETURN : ENDIF IF chk% file$=LastMonitorFile$ IF UseFastFileDialog% file$=FileDialog$:("Select output file",file$,KTrue%,"",&0) IF file$="" : RETURN : ENDIF ELSE Busy:("Building file list"+KDots$,1) dINIT "Select output file" dFILE file$,"Filename,Folder,Disk",17+UseSystemFolder& dBUTTONS " Cancel ",-(27+$100),"Start",13+$100 Busy:(KBusyOff$,0) Lock:(KLock%) : r%=DIALOG : Lock:(KUnlock%) IF r%<>13 : RETURN : ENDIF ENDIF LastMonitorFile$=file$ ENDIF  Busy:(KBusyOff$,0)  cnt&=0 IF chk% DO r%=IOOPEN(h%,file$,$0122) IF r% IF NOT ErrorMessage%:("Create file",r%,KTrue%) : RETURN : ENDIF ENDIF UNTIL r%=0 ENDIF  ClearScreen: FONT 6,17 : gSTYLE 1 gBORDER 1 Busy:("Clearing buffer"+KDots$,1) ClearPortBuffer: Busy:(KBusyOff$,0)  IF c&=0 gIPRINT "End monitoring with [ESC]",1 ENDIF  DO GetSentence: IF sentence$<>"" cnt&=cnt&+1 PRINT sentence$ IF chk% IOWRITE(h%,ADDR(sentence$)+1,PEEKB(ADDR(sentence$))) ENDIF ELSE IF chk% : IOCLOSE(h%) : ENDIF RefreshScreen: gIPRINT "No NMEA device found",1 RETURN ENDIF IF c&>0 AND cnt&=c& BREAK ELSE GETEVENTA32 eventstat%,event&() IOYIELD IF eventstat%>=0 IF (event&(1) AND &400)=0  IF event&(1)=27 AND c&=0 BREAK ENDIF ELSEIF event&(1)=$404 IF GETCMD$="X" CloseAppCmd%=KTrue% BREAK ENDIF ENDIF ELSE GETEVENTC(eventstat%) ENDIF ENDIF UNTIL KFalse%  IF chk% : IOCLOSE(h%) : ENDIF IF NOT CloseAppCmd% Busy:(KBusyOff$,0) gIPRINT "Stopped - press any key",1 GET%:(KFalse%) RefreshScreen: ENDIFENDPREM *** set NMEA emulation type of Psion ***PROC SetMyDevice: LOCAL h%,r%,buffer$(255),buffer2$(255) LOCAL mytype%,c%  DO r%=IOOPEN(h%,MyDir$+STalkerFile$,$0420) IF r% IF NOT ErrorMessage%:("Reading ID list",r%,KTrue%) RETURN ENDIF ENDIF UNTIL r%=0 Busy:("Building manufacturers list"+KDots$,1) dINIT "NMEA device type" dTEXT ""," " dTEXT "","PSION emulates the following type"+KDots$,0  REM read textfile and add every line to the choice-box r%=IOREAD(h%,ADDR(buffer2$)+1,255) POKEB ADDR(buffer2$),r% mytype%=1 c%=1 DO r%=IOREAD(h%,ADDR(buffer$)+1,255) IF r%<0 : r%=0 : ENDIF POKEB ADDR(buffer$),r% IF r%>0 : buffer2$=buffer2$+",..." : ENDIF IF LEFT$(buffer2$,2)=mytype$ : mytype%=c% : ENDIF dCHOICE mytype%,"",buffer2$ buffer2$=buffer$ c%=c%+1 UNTIL r%=0 IOCLOSE(h%)  dTEXT ""," "  dBUTTONS " Cancel ",-(27+$100),"Okay",13+$100 Busy:(KBusyOff$,0) Lock:(KLock%) : r%=DIALOG : Lock:(KUnlock%) IF r%<>13 : RETURN : ENDIF  REM determine the talker ID from the choice number DO r%=IOOPEN(h%,MyDir$+STalkerFile$,$0420) IF r% IF NOT ErrorMessage%:("Reading ID list",r%,KTrue%) RETURN ENDIF ENDIF UNTIL r%=0  c%=1 DO r%=IOREAD(h%,ADDR(buffer2$)+1,255) IF r%<0 : r%=0 : ENDIF IF c%=mytype% AND r%>0 POKEB ADDR(buffer2$),r% mytype$=LEFT$(buffer2$,2) r%=0 ENDIF c%=c%+1 UNTIL r%<=0  IOCLOSE(h%) ENDPREM *** get NMEA type of connected device ***PROC GetYourDevice$:(dialog%) LOCAL c%,cc%,id$(20),id2$(5),okay%,r%,h%,grm% LOCAL type$(5),read%(100),buffer$(255),buffer2$(255)  Busy:("Determining device type"+KDots$,1) yourtype$="" c%=0 id$="" okay%=KFalse% grm%=KFalse% DO c%=c%+1 IF c%=50 REM no useful sentence for a too long time Busy:(KBusyOff$,0) RETURN "Can't determine device type" ENDIF GetSentence: IF sentence$="" Busy:(KBusyOff$,0) RETURN "No NMEA device found" ENDIF IF sentence$<>"" AND LEFT$(sentence$,2)<>"$P" REM no proprietary datas id2$=MID$(sentence$,2,2) IF id$="" id$=id2$ ELSE IF id$<>id2$ Busy:(KBusyOff$,0) RETURN "Multiple type information found" ENDIF okay%=KTrue% ENDIF ENDIF UNTIL okay%  REM get full device type name DO r%=IOOPEN(h%,MyDir$+STalkerFile$,$0420) IF r% Busy:(KBusyOff$,0) IF NOT ErrorMessage%:("Reading ID list",r%,KTrue%) RETURN "Can't determine device type" ENDIF Busy:("Determining device type"+KDots$,1) ENDIF UNTIL r%=0 DO r%=IOREAD(h%,ADDR(buffer$)+1,255) IF r%<0 : r%=0 : ENDIF POKEB ADDR(buffer$),r% UNTIL LEFT$(buffer$,2)=id$ IOCLOSE(h%)   yourtype$=LEFT$(buffer$,2) IF NOT dialog% : Busy:(KBusyOff$,0) : RETURN buffer$ : ENDIF REM look for proprietary datas c%=0 id$="" okay%=KFalse% DO c%=c%+1 IF c%=50 REM no useful sentence for a too long time BREAK ENDIF GetSentence: IF sentence$="" Busy:(KBusyOff$,0) RETURN "No NMEA device found" ENDIF IF sentence$<>"" AND LEFT$(sentence$,2)="$P" REM proprietary datas id2$=MID$(sentence$,3,3) IF id$="" id$=id2$ ELSE IF id$<>id2$ REM multiple proprietary types BREAK ENDIF okay%=KTrue% ENDIF ENDIF UNTIL okay%  buffer2$="(unavailable)" IF id$<>"" AND id$=id2$ REM get full manufacturers name DO ONERR notopen:: OPEN MyDir$+SManufacturersFile$+" SELECT id,name FROM mfacturers",M,id$,n$ ONERR off BREAKnotopen:: ONERR off Busy:(KBusyOff$,0) IF NOT ErrorMessage%:("Reading manufacturers list",r%,KTrue%) RETURN "Can't determine device type" ENDIF Busy:("Determining device type"+KDots$,1) UNTIL KFalse%  buffer2$="(unknown)" FIRST WHILE id$<>M.id$ AND NOT EOF : NEXT : ENDWH IF id$=M.id$ : buffer2$=M.n$ : ENDIF CLOSE ENDIF  REM if GRM, look for model and software version IF id$="GRM" grm%=KTrue% c%=0 id$="(unavailable)" okay%=KFalse% DO c%=c%+1 IF c%=50 REM no useful sentence for a too long time BREAK ENDIF GetSentence: IF sentence$="" Busy:(KBusyOff$,0) RETURN "No NMEA device found" ENDIF IF sentence$<>"" AND LEFT$(sentence$,6)="$PGRMT" REM proprietary datas NMEA_GRM_T%: IF Parse%:(sentence$)=1 id$=values$(1) okay%=KTrue% ENDIF ENDIF UNTIL okay%  ENDIF Busy:(KBusyOff$,0) IF dialog% dINIT "Connected device type" dTEXT "Talker ID",yourtype$ dTEXT "Full name",MID$(buffer$,4,255) dTEXT "Manufacturer",buffer2$ IF grm% : dTEXT "Model",id$ : ENDIF dBUTTONS " Formats ",13,"Okay",-27 Lock:(KLock%) : c%=DIALOG : Lock:(KUnlock%) IF c%=13 Busy:("Searching formats"+KDots$,1) REM enumerate sentence formats, sent from the device c%=1 WHILE c%<100 : read%(c%)=KFalse% : c%=c%+1 : ENDWH c%=0 : cc%=0 DO  GetSentence: IF sentence$="" Busy:(KBusyOff$,0) RETURN "No NMEA device found" ENDIF id$=SentenceType_Standard$:(sentence$,-1) IF id$<>"" IF NOT read%(VAL(id$)) REM new format read%(VAL(id$))=KTrue% c%=0 cc%=cc%+1 ELSE c%=c%+1 ENDIF ELSE c%=c%+1 ENDIF UNTIL c%>50 : REM 50 sentences without new format IF cc%=0 dINIT "Searching formats" dTEXT "","No sentence read.",2 ELSE REM output by alphabetical order dINIT "Formats of connected device" c%=1 WHILE c%<100 IF read%(c%) cc%=cc%-1 IF cc% dCHOICE cc%,"Format list",SentenceType_Standard$:("",c%)+",..." ELSE dCHOICE cc%,"Format list",SentenceType_Standard$:("",c%) ENDif ENDIF c%=c%+1 ENDWH ENDIF Busy:(KBusyOff$,0) dBUTTONS " Okay ",13+$100 Lock:(KLock%) : DIALOG : Lock:(KUnlock%) ENDIF ENDIF Busy:(KBusyOff$,0) RETURN buffer$ENDPREM *** compute checksum ***PROC ComputeChecksum%:(parseline$) LOCAL cs%,pos%,lng%,ch%,pl$(255) pl$=parseline$ lng%=LEN(pl$) cs%=0 pos%=2 WHILE pos%<=lng% AND MID$(pl$,pos%,1)<>"*" ch%=PEEKB(ADDR(pl$)+pos%) cs%=(cs% AND NOT ch%) OR (ch% AND NOT cs%) pos%=pos%+1 ENDWH RETURN cs%ENDPREM *** extract checksum from string ***PROC GetChecksum%:(parseline$) LOCAL lng%,pl$(255) pl$=parseline$ lng%=PEEKB(ADDR(pl$)) IF lng%<3 OR MID$(pl$,lng%-2,1)<>"*" REM no checksum given RETURN -1 ENDIF RETURN Hex2Dec%:(RIGHT$(pl$,2))ENDPREM *** add checksum to string ***PROC AddChecksum$:(parseline$) LOCAL cs%,pl$(255) cs%=ComputeChecksum%:(parseline$) pl$=parseline$+"*" RETURN pl$+Dec2Hex$:(cs%,2)ENDPREM *** parsing the NMEA sentence ***REM *********************************PROC Parse%:(sentence$) LOCAL Type$(5),cs1%,cs2%,pre$(30) IF LEFT$(sentence$,1)<>"$" : RETURN 0 : ENDIF IF MID$(sentence$,2,1)="P" REM propietary datas IF PropDevice$="" REM ignore such sentences RETURN 0 ENDIF Type$=ManufacturersType$:(PropDevice$,0) IF Type$="" IF setting%(4) ShortMessagePrompt:("Unknown propietary manufacturer","Address field: "+LEFT$(sentence$,6)) ENDIF RETURN 0 ENDIF Type$=@$("SentenceType_"+PropDevice$):(sentence$,0) pre$=PropDevice$+"_" ELSE REM standard NMEA sentence Type$=SentenceType_Standard$:(sentence$,0) pre$="" ENDIF IF Type$<>"" REM For this type a procedure exist; REM test checksum cs1%=ComputeChecksum%:(sentence$) cs2%=GetChecksum%:(sentence$) IF cs2%<>-1 AND cs1%<>cs2% Error_Checksum:(sentence$,cs2%,cs1%): IF setting%(5)=1 : RETURN 0 ELSEIF setting%(5)=2 : RETURN -1 ENDIF ENDIF @%("NMEA_"+pre$+Type$): IF fields%=0 IF setting%(4) ShortMessagePrompt:("Format ID known, but no fields defined","Address field: "+LEFT$(sentence$,6)) ENDIF RETURN 0 ENDIF RETURN ReadDatas%:(sentence$) ELSE IF setting%(4) ShortMessagePrompt:("Unknown sentence format","Address field: "+LEFT$(sentence$,6)) ENDIF RETURN 0 ENDIFENDPREM *** returns the format identifier of sentence$ ***REM *** (or "", if this format is not implemented) ***REM as_number%=0 -> returns format id of sentence$REM as_number%<0 -> returns number of format idREM as_number%>0 -> ignores sentence$ and returnsREM format id belonging to number as_number%REM All available formats have to be written to STypes$REM separated by commas. "AAM,ALM, ..."REM reclng% is the char number of one identifierPROC SentenceType$:(STypes$,sentence$,as_number%,rec_lng%) LOCAL Type$(10),SType$(10),c%,lng%,rl% IF as_number%>0 c%=as_number%*(rec_lng%+1)-rec_lng% IF c%+rec_lng%-1>LEN(STypes$) : RETURN "" : ENDIF RETURN MID$(STypes$,c%,rec_lng%) ENDIF  IF LEFT$(sentence$,1)="$" REM beginning of sentence given Type$=MID$(sentence$,7-rec_lng%,rec_lng%) ELSE REM identifier directly given Type$=sentence$ ENDIF  c%=1 lng%=LEN(STypes$) WHILE c%<=lng% SType$=MID$(STypes$,c%,rec_lng%) IF SType$=Type$ IF as_number% RETURN GEN$((c%+rec_lng%)/(rec_lng%+1),4) ELSE RETURN SType$ ENDIF ENDIF c%=c%+rec_lng%+1 ENDWH RETURN ""ENDPREM *** same as SentenceType$ ***REM *** but only for standard NMEA sentences ***PROC SentenceType_Standard$:(sentence$,as_number%) LOCAL STypes$(255),str$(20),as%,s$(255)  s$=sentence$ IF LEN(s$)>4 IF LEFT$(s$,1)="$" AND MID$(s$,2,1)<>"P" AND MID$(s$,4,1)="R" AND MID$(s$,5,1)<="9" REM sentence of format $--Rxx s$=LEFT$(s$,3)+"Rxx"+MID$(s$,7,255) ENDIF ENDIF  STypes$="AAM,ALM,APA,APB,ASD,BEC,BER,BOD,BPI,BWC,BWR,BWW" STypes$=STypes$+",DBT,DCN,DBK,DBS,DPT,DRU,DSC,DSI,DSR,DTM" STypes$=STypes$+",FSI,GBS,GDA,GDF,GDP,GGA,GLA,GLC,GLF,GLL" STypes$=STypes$+",GLP,GOA,GOF,GOP,GRS,GSA,GST,GSV,GTD,GXA" STypes$=STypes$+",GXF,GXP,HCC,HCD,HDG,HDM,HDT,HSC,HVD" str$=SentenceType$:(STypes$,s$,as_number%,3) IF str$<>"" OR (as_number%>0 AND as_number%<52) RETURN str$ ENDIF  STypes$="HVM,IMA,LCD,MDA,MSK,MSS,MTW,MWD,MWV,OLN,OSD,RMA,RMB,RMC" STypes$=STypes$+",ROT,RPM,RSA,RSD,RTE,Rxx,SFI,STN,TLL,TRF" STypes$=STypes$+",TTM,VBW,VDR,VHW,VLW,VPW,VTG,VWR,WCV" STypes$=STypes$+",WDC,WDR,WNC,WPL,XDR,XTE,XTR,ZDA,ZDL,ZFO,ZTG" as%=as_number% IF as%>0 : as%=as%-51 : ENDIF str$=SentenceType$:(STypes$,s$,as%,3) IF str$<>"" AND as%<0 str$=GEN$(VAL(str$)+51,3) ENDIF RETURN str$ENDPREM *** same as SentenceType$ ***REM *** but only for Garmin propietary formats ***PROC SentenceType_GRM$:(sentence$,as_number%) LOCAL STypes$(255) STypes$="C,E,F,I,M,O,T,V,Z" RETURN SentenceType$:(STypes$,sentence$,as_number%,1)ENDPPROC SentenceType_SLI$:(sentence$,as_number%) LOCAL STypes$(255) STypes$="B"  RETURN SentenceType$:(STypes$,sentence$,as_number%,1)ENDPREM *** Test, if propietary datas of this manufacturer ***REM *** are impemented ***PROC ManufacturersType$:(mIDs$,as_number%) LOCAL MTypes$(255) MTypes$="GRM,SLI" RETURN SentenceType$:(MTypes$,mIDs$,as_number%,3)ENDPREM *** STANDARD NMEA SENTENCES ***REM *******************************REM *** fills the global variables FIELDS% and FIELD$() ***REM *** with the special information for the sentence format ***PROC NMEA_AAM%: descr$="Waypoint Arrival Alarm" fields%=4 : version%=KStandardNMEA% field$(1)="arrival circle entered,B" field$(2)="perpendicular passed at waypoint,B" field$(3)="arrival circle radius,X[D=#]" field$(4)="waypoint,S"ENDPPROC NMEA_ALM%: descr$="GPS Almanac Data" fields%=14 : version%=KStandardNMEA% field$(1)="message number,N" field$(2)="satellite PRN number,X" field$(3)="GPS week number,X" field$(4)="SV health,H(2)" field$(5)="eccentricity,H(4)" field$(6)="almanac reference time,H(2)" field$(7)="inclination angle,H(4)" field$(8)="rate of right ascension,H(4)" field$(9)="root of semi-major axis,H(6)" field$(10)="argument of perigee,H(6)" field$(11)="longitude of ascension node,H(6)" field$(12)="mean anomaly,H(6)" field$(13)="F0 Clock Parameter,H(3)" field$(14)="F1 Clock Parameter,H(3)"ENDPPROC NMEA_APA%: descr$="Autopilot Sentence A" fields%=9 : version%=KOldNMEA% field$(1)="Status,B(OK or nor used)(Loran-C Blink or SNR warning)" field$(2)="Status,B(OK or not used)(Loran-C Cycle Lock warning)" field$(3)="Cross Track Error Magnitude,X[R=5]" field$(4)="Direction to steer,CD" field$(5)="Cross Track Units,-" field$(6)="Arrival Circle Entered,B" field$(7)="Perpendicular passed at waypoint,B" field$(8)="Bearing, origin to destination,X[R=D]" field$(9)="Destination Waypoint ID,S"ENDPPROC NMEA_APB%: descr$="Autopilot Sentence B" fields%=11 : version%=KStandardNMEA% field$(1)="Status,B(OK or nor used)(Loran-C Blink or SNR or general warning)" field$(2)="Status,B(OK or not used)(Loran-C Cycle Lock warning)" field$(3)="Cross Track Error Magnitude,X[R=5]" field$(4)="Direction to steer,CD" field$(5)="Cross Track Units,-" field$(6)="Arrival Circle Entered,B" field$(7)="Perpendicular passed at waypoint,B" field$(8)="Bearing, origin to destination,X[R=D]" field$(9)="Destination Waypoint ID,S" field$(10)="Bearing, present position to destination,X[R=D]" field$(11)="Heading to steer to destination,X[R=D]"ENDPPROC NMEA_ASD%: descr$="Autopilot System Data" fields%=0 : REM ??? unknownENDPPROC NMEA_BEC%: descr$="Bearing & Distance to Waypoint - Dead Reckoning" fields%=7 : version%=KStandardNMEA% field$(1)="Time of observation,T" field$(2)="Waypoint Latitude,A" field$(3)="Waypoint Longitude,O" field$(4)="Bearing true,MT" field$(5)="Bearing magnetic,MM" field$(6)="Distance,X[D=#]" field$(7)="Waypoint ID,S"ENDPPROC NMEA_BER%: descr$="Bearing & Distance to Waypoint" fields%=7 : version%=KOldNMEA% field$(1)="Time of observation,T" field$(2)="Waypoint Latitude,A" field$(3)="Waypoint Longitude,O" field$(4)="Bearing true,MT" field$(5)="Bearing magnetic,MM" field$(6)="Distance,X[D=#]" field$(7)="Waypoint ID,S"ENDPPROC NMEA_BOD%: descr$="Bearing - Waypoint to Waypoint" fields%=4 : version%=KStandardNMEA% field$(1)="Bearing,MT" field$(2)="Bearing,MM" field$(3)="TO Waypoint,S" field$(4)="FROM Waypoint,S"ENDPPROC NMEA_BPI%: descr$="Bearing & Distance to Point of Interest" fields%=6 : version%=KOldNMEA% field$(1)="Time of observation,T" field$(2)="Waypoint Latitude,A" field$(3)="Waypoint Longitude,O" field$(4)="Bearing true,MT" field$(5)="Bearing magnetic,MM" field$(6)="Distance,X[D=#]"ENDPPROC NMEA_BWC%: descr$="Bearing & Distance to Waypoint - Great Circle" fields%=7 : version%=KStandardNMEA% field$(1)="Time of observation,T" field$(2)="Waypoint Latitude,A" field$(3)="Waypoint Longitude,O" field$(4)="Bearing,MT" field$(5)="Bearing,MM" field$(6)="Distance,X[D=#]" field$(7)="Waypoint ID,S"ENDPPROC NMEA_BWR%: descr$="Bearing and Distance to Waypoint - Rhumb Line" fields%=7 : version%=KStandardNMEA% field$(1)="Time of observation,T" field$(2)="Waypoint Latitude,A" field$(3)="Waypoint Longitude,O" field$(4)="Bearing,MT" field$(5)="Bearing,MM" field$(6)="Distance,X[D=#]" field$(7)="Waypoint ID,S"ENDPPROC NMEA_BWW%: descr$="Bearing - Waypoint to Waypoint" fields%=4 : version%=KStandardNMEA% field$(1)="Bearing,MT" field$(2)="Bearing,MM" field$(3)="TO Waypoint,S" field$(4)="FROM Waypoint,S"ENDPPROC NMEA_DBK%: descr$="Depth below kiel" fields%=1 : version%=KOldNMEA% field$(1)="Depth,X[D=#]" REM 2 fields with other units ignoredENDPPROC NMEA_DBS%: descr$="Depth below surface" fields%=1 : version%=KOldNMEA% field$(1)="Depth,X[D=#]" REM 2 fields with other units ignoredENDPPROC NMEA_DBT%: descr$="Depth below transducer" fields%=1 : version%=KStandardNMEA% field$(1)="Depth,X[D=#]" REM 2 fields with other units ignoredENDPPROC NMEA_DCN%: descr$="Decca Position" fields%=15 : version%=KStandardNMEA% field$(1)="Decca chain identifier,X" field$(2)="Red Zone Identifier,S" field$(3)="Red Line Of Position,X" field$(4)="Red Master Line Status,B(valid)(invalid)" field$(5)="Green Zone Identifier,S" field$(6)="Green Line Of Position,X" field$(7)="Green Master Line Status,B(valid)(invalid)" field$(8)="Purple Zone Identifier,S" field$(9)="Purple Line Of Position,X" field$(10)="Purple Master Line Status,B(valid)(invalid)" field$(11)="Red Line Navigation Use,B(valid)(invalid)" field$(12)="Green Line Navigation Use,B(valid)(invalid)" field$(13)="Purple Line Navigation Use,B(valid)(invalid)" field$(14)="Position Uncertainity,X[D=#]" field$(15)="Fix Data Basis,C(1=Normal Pattern)(2=Lane Ident. Pattern)(3=Lane Ident. Transmissions)"ENDPPROC NMEA_DPT%: descr$="Depth below transducer" fields%=2 : version%=KStandardNMEA% field$(1)="Depth,X[D=M]" field$(2)="Offset from transducer,X[D=M]" : REM ??? units okay ?ENDPPROC NMEA_DRU%: descr$="Dual Doppler Auxiliary Data" fields%=5 : version%=KOldNMEA% field$(1)="Depth,X[D=M]" : REM ??? units okay ? field$(2)="Depth Status,B" field$(3)="Rate of turn,X[U=D]" : REM ??? units okay ? field$(4)="Turn Status,B" field$(5)="Propeller shaft rotation,X[U=P]"ENDPPROC NMEA_DSC%: descr$="Digital Selective Calling Info" fields%=0 : REM ??? unknownENDPPROC NMEA_DSE%: descr$="Extended DSC" fields%=0 : REM ??? unknownENDPPROC NMEA_DSI%: descr$="DSC Transponder initiate" fields%=0 : REM ??? unknownENDPPROC NMEA_DSR%: descr$="DSC Transponder response" fields%=0 : REM ??? unknownENDPPROC NMEA_DTM%: descr$="Datum reference" fields%=0 : REM ??? unknownENDPPROC NMEA_FSI%: descr$="Frequency Set Information" fields%=4 : version%=KStandardNMEA% field$(1)="Transmitting Frequency,X" field$(2)="Receiving Frequency,X" field$(3)="Communications Mode,CC" field$(4)="Power Level,X"ENDPPROC NMEA_GBS%: descr$="GPS Satellite fault detection" fields%=0 : REM ??? unknownENDPPROC NMEA_GDA%: descr$="Dead reckoning position & time (past)" fields%=4 : version%=KOldNMEA% field$(1)="Time of position fix,T" field$(2)="Latitude,A" field$(3)="Longitude,O" field$(4)="Waypoint ID,S"ENDPPROC NMEA_GDF%: descr$="Dead reckoning position - estimated time" fields%=4 : version%=KOldNMEA% field$(1)="Time of position fix,T" field$(2)="Latitude,A" field$(3)="Longitude,O" field$(4)="Waypoint ID,S"ENDPPROC NMEA_GDP%: descr$="Dead reckoning position & time (present)" fields%=4 : version%=KOldNMEA% field$(1)="Time of position fix,T" field$(2)="Latitude,A" field$(3)="Longitude,O" field$(4)="Waypoint ID,S"ENDPPROC NMEA_GGA%: descr$="Global Positioning System Fix Data" fields%=10 : version%=KStandardNMEA% field$(1)="Time of position,T" field$(2)="Latitude,A" field$(3)="Longitude,O" field$(4)="GPS Quality Indicator,C(0=not available)(1=GPS fix)(2=DGPS fix)" field$(5)="Number of satellites in use,X" field$(6)="Horizontal Dilution of precision,X" field$(7)="Antenna Altitude above mean-sea-level,X[D=#]" field$(8)="Geoidal separation,X[D=#]" field$(9)="Age of DGPS data,X[T=s]" field$(10)="DGPS reference station ID,X"ENDPPROC NMEA_GLA%: descr$="Loran-C position & time (past)" fields%=5 : version%=KOldNMEA% field$(1)="Time of position fix,T" field$(2)="Latitude,A" field$(3)="Longitude,O" field$(4)="Waypoint ID,S" field$(5)="Satellite number,X"ENDPPROC NMEA_GLC%: descr$="Geographic Position (Loran-C)" fields%=13 : version%=KStandardNMEA% field$(1)="GRI,X[T=j]" field$(2)="Master TOA,X[T=i]" : REM ??? or [T=#] ??? field$(3)="Master TOA Signal Status,B" field$(4)="Time Difference 1,X[T=i]" field$(5)="Time Difference 1 Signal Status,CL" field$(6)="Time Difference 2,X[T=i]" field$(7)="Time Difference 2 Signal Status,CL" field$(8)="Time Difference 3,X[T=i]" field$(9)="Time Difference 3 Signal Status,CL" field$(10)="Time Difference 4,X[T=i]" field$(11)="Time Difference 4 Signal Status,CL" field$(12)="Time Difference 5,X[T=i]" field$(13)="Time Difference 5 Signal Status,CL"ENDPPROC NMEA_GLF%: descr$="Loran-C position - estimated time" fields%=5 : version%=KOldNMEA% field$(1)="Time of position fix,T" field$(2)="Latitude,A" field$(3)="Longitude,O" field$(4)="Waypoint ID,S" field$(5)="Satellite number,X"ENDPPROC NMEA_GLL%: descr$="Geographic Position - Latitude/Longitude" fields%=4 : version%=KStandardNMEA% field$(1)="Latitude,A" field$(2)="Longitude,O" field$(3)="Time of position,T" field$(4)="Data Valid,B"ENDPPROC NMEA_GLP%: descr$="Loran-C position & time (present)" fields%=5 : version%=KOldNMEA% field$(1)="Time of position fix,T" field$(2)="Latitude,A" field$(3)="Longitude,O" field$(4)="Waypoint ID,S" field$(5)="Satellite number,X"ENDPPROC NMEA_GOA%: descr$="Omega position & time (past)" fields%=5 : version%=KOldNMEA% field$(1)="Time of position fix,T" field$(2)="Latitude,A" field$(3)="Longitude,O" field$(4)="Waypoint ID,S" field$(5)="Satellite number,X"ENDPPROC NMEA_GOF%: descr$="Omega position & estimated time" fields%=5 : version%=KOldNMEA% field$(1)="Time of position fix,T" field$(2)="Latitude,A" field$(3)="Longitude,O" field$(4)="Waypoint ID,S" field$(5)="Satellite number,X"ENDPPROC NMEA_GOP%: descr$="Omega position & time (present)" fields%=5 : version%=KOldNMEA% field$(1)="Time of position fix,T" field$(2)="Latitude,A" field$(3)="Longitude,O" field$(4)="Waypoint ID,S" field$(5)="Satellite number,X"ENDPPROC NMEA_GRS%: descr$="GPS Range residuals" fields%=0 : REM ??? unknownENDPPROC NMEA_GSA%: descr$="GPS DOP and active satellites" fields%=17 : version%=KStandardNMEA% field$(1)="Mode selection,C(M=manual forced)(A=automatic)" field$(2)="Mode,C(1=no fix)(2=2D fix)(3=3D fix)" field$(3)="1. ID of used satellite,X" field$(4)="2. ID of used satellite,X" field$(5)="3. ID of used satellite,X" field$(6)="4. ID of used satellite,X" field$(7)="5. ID of used satellite,X" field$(8)="6. ID of used satellite,X" field$(9)="7. ID of used satellite,X" field$(10)="8. ID of used satellite,X" field$(11)="9. ID of used satellite,X" field$(12)="10.ID of used satellite,X" field$(13)="11.ID of used satellite,X" field$(14)="12.ID of used satellite,X" field$(15)="PDOP,X[D=M]" field$(16)="HDOP,X[D=M]" field$(17)="VDOP,X[D=M]"ENDPPROC NMEA_GST%: descr$="GPS noise statistics" fields%=0 : REM ??? unknownENDPPROC NMEA_GSV%: descr$="Satellites in view" fields%=6 : version%=KStandardNMEA% field$(1)="Message number,N" field$(2)="Satellites in view,X" field$(3)="Satellite number,X*" : REM length of list is always 4 field$(4)="Elevation,X[R=D]" field$(5)="Azimut,Mt" field$(6)="SNR (C/No),X[S=D]"ENDPPROC NMEA_GTD%: descr$="Geographic location in time differences" fields%=5 : version%=KOldNMEA% field$(1)="Time difference 1,X[T=i]" field$(2)="Time difference 2,X[T=i]" field$(3)="Time difference 3,X[T=i]" field$(4)="Time difference 4,X[T=i]" field$(5)="Time difference 5,X[T=i]"ENDPPROC NMEA_GXA%: descr$="TRANSIT Position - Latitude/Longitude" fields%=5 : version%=KStandardNMEA% field$(1)="Time of position fix,T" field$(2)="Latitude,A" field$(3)="Longitude,O" field$(4)="Waypoint ID,S" field$(5)="Satellite number,X"ENDPPROC NMEA_GXF%: descr$="TRANSIT Position & estimated time" fields%=5 : version%=KOldNMEA% field$(1)="Time of position fix,T" field$(2)="Latitude,A" field$(3)="Longitude,O" field$(4)="Waypoint ID,S" field$(5)="Satellite number,X"ENDPPROC NMEA_GXP%: descr$="TRANSIT Position & time (present)" fields%=5 : version%=KOldNMEA% field$(1)="Time of position fix,T" field$(2)="Latitude,A" field$(3)="Longitude,O" field$(4)="Waypoint ID,S" field$(5)="Satellite number,X"ENDPPROC NMEA_HCC%: descr$="Vessel compass heading" fields%=1 : version%=KOldNMEA% field$(1)="Compass heading,X[R=D]"ENDPPROC NMEA_HCD%: descr$="Vessel magnetic heading and deviation" fields%=4 : version%=KOldNMEA% field$(1)="Magnetic heading,MM" field$(2)="Compass heading,X[R=D]" field$(3)="Degrees flag,-" field$(4)="Magnetic deviation,X[R=*]"ENDPPROC NMEA_HDG%: descr$="Heading - Deviation & Variation" fields%=3 : version%=KStandardNMEA% field$(1)="Magnetic heading,X[R=D]" field$(2)="Magnetic Deviation,X[R=*]" field$(3)="Magnetic Variation,X[R=*]"ENDPPROC NMEA_HDM%: descr$="Heading - Magnetic" fields%=1 : version%=KOldNMEA% field$(1)="Heading,Mm"ENDPPROC NMEA_HDT%: descr$="Heading - True" fields%=1 : version%=KStandardNMEA% field$(1)="Heading,Mt"ENDPPROC NMEA_HSC%: descr$="Heading Steering Command" fields%=2 : version%=KStandardNMEA% field$(1)="Heading true,MT" field$(2)="Heading magnetic,MM"ENDPPROC NMEA_HVD%: descr$="Magnetic Variation - Automatic" fields%=1 : version%=KOldNMEA% field$(1)="Magnetic variation,X[R=*]"ENDPPROC NMEA_HVM%: descr$="Magnetic Variation - Manually Set" fields%=1 : version%=KOldNMEA% field$(1)="Magnetic variation,X[R=*]"ENDPPROC NMEA_IMA%: descr$="Vessel Identification" fields%=7 : version%=KOldNMEA% field$(1)="Vessel name,S" field$(2)="Radio call sign,S" field$(3)="Latitude,A" field$(4)="Longitude,O" field$(5)="Heading true,MT" field$(6)="Heading magnetic,MM" field$(7)="Speed,X[V=#]"ENDPPROC NMEA_LCD%: descr$="Loran-C Signal Data" fields%=13 : version%=KStandardNMEA% field$(1)="GRI,X[T=j]" field$(2)="Master Relative SNR,X" field$(3)="Master Relative ECD,X" field$(4)="Secondary 1, rel. SNR,X" field$(5)="Secondary 1, rel. ECD,X" field$(6)="Secondary 2, rel. SNR,X" field$(7)="Secondary 2, rel. ECD,X" field$(8)="Secondary 3, rel. SNR,X" field$(9)="Secondary 3, rel. ECD,X" field$(10)="Secondary 4, rel. SNR,X" field$(11)="Secondary 4, rel. ECD,X" field$(12)="Secondary 5, rel. SNR,X" field$(13)="Secondary 5, rel. ECD,X"ENDPPROC NMEA_MDA%: descr$="Metrological Composite" fields%=11 : version%=KOldNMEA% field$(1)="Barometric pressure,X[P=#]" field$(2)="Same pressure,-" field$(3)="Other units,-" field$(4)="Air temperature,X[K=#]" field$(5)="Water temperature,X[K=#]" field$(6)="Relative humidity,X[H=P]" field$(7)="Absolute humidity,X[H=P]" field$(8)="Dew point,X[K=#]" field$(9)="Wind direction (true),MT" field$(10)="Wind direction (magnetic),MM" field$(11)="Wind speed,X[V=#]"ENDPPROC NMEA_MSK%: descr$="MSK Receiver interface" fields%=0 : REM ??? unknownENDPPROC NMEA_MSS%: descr$="MSK Receiver signal status" fields%=0 : REM ??? unknownENDPPROC NMEA_MTW%: descr$="Water Temperature" fields%=1 field$(1)="Temperature,X[K=#]"ENDPPROC NMEA_MWD%: descr$="Wind direction and speed" fields%=0 : REM ??? unknownENDPPROC NMEA_MWV%: descr$="Wind speed and angle" fields%=4 : version%=KStandardNMEA% field$(1)="Wind Angle,X[R=D]" field$(2)="Reference,C(R=Relative)(T=True)" field$(3)="Wind Speed,X[V=#]" field$(4)="Data Valid,B"ENDPPROC NMEA_OLN%: descr$="Omega Lane Numbers" fields%=9 : version%=KStandardNMEA% field$(1)="Pair 1: Omega ID,,S" field$(2)="Pair 1: Lane Number,X" field$(3)="Pair 1: Centilane Number,X" field$(4)="Pair 2: Omega ID,S" field$(5)="Pair 2: Lane Number,X" field$(6)="Pair 2: Centilane Number,X" field$(7)="Pair 3: Omega ID,S" field$(8)="Pair 3: Lane Number,X" field$(9)="Pair 3: Centilane Number,X"ENDPPROC NMEA_OSD%: descr$="Own Ship Data" fields%=8 : version%=KStandardNMEA% field$(1)="Heading true,Mt" field$(2)="Data Valid,B" field$(3)="Vessel Course,Mt" field$(4)="Course Reference,CR" field$(5)="Vessel Speed,X[V=9]" field$(6)="Speed Reference,CR" field$(7)="Vessel Set,Mt" field$(8)="Vessel drift (speed),X[V=#]"ENDPPROC NMEA_Rxx%: descr$="Waypoints in active route" fields%=1 field$(1)="Waypoint ID,S*"ENDPPROC NMEA_RMA%: descr$="Recommended Minimum specific Loran-C data" fields%=8 : version%=KStandardNMEA% field$(1)="Status,B(okay)(Blink or SNR or cycle warning)" field$(2)="Latitude,A" field$(3)="Longitude,O" field$(4)="Time Difference A,X[T=i]" field$(5)="Time Difference B,X[T=i]" field$(6)="Speed Over Ground,X[V=N]" field$(7)="Track Made Good,Mt" field$(8)="Magnetic Variation,X[R=*]"ENDPPROC NMEA_RMB%: descr$="Recommended Minimum Navigation Information" fields%=11 : version%=KStandardNMEA% field$(1)="Status,B(okay)(Navigation receiver warning)" field$(2)="Cross Track error,X[D=N]" field$(3)="Direction to Steer,CD" field$(4)="FROM Waypoint,S" field$(5)="TO Waypoint,S" field$(6)="Destination Wpt. Latitude,A" field$(7)="Destination Wpt. Longitude,O" field$(8)="Range to destination,X[D=N]" field$(9)="Bearing to destination,Mt" field$(10)="Destination closing velocity,X[V=N]" field$(11)="Arrival Circle Entered,B"ENDPPROC NMEA_RMC%: descr$="Recommended Minimum specific GPS/Transit data" fields%=8 : version%=KStandardNMEA% field$(1)="Time of position fix,T" field$(2)="Status,B(okay)(Navigation receiver warning)" field$(3)="Latitude,A" field$(4)="Longitude,O" field$(5)="Speed over ground,X[V=N]" field$(6)="Track made good,Mt" field$(7)="Date,D" field$(8)="Magnetic Variation,X[R=*]"ENDPPROC NMEA_ROT%: descr$="Rate Of Turn" fields%=2 : version%=KStandardNMEA% field$(1)="Rate Of Turn,X[U=D]" field$(2)="Data valid,B"ENDPPROC NMEA_RPM%: descr$="Revolutions" fields%=5 : version%=KStandardNMEA% field$(1)="Source,C(S=Shaft)(E=Engine)" field$(2)="Engine or shaft number,X" field$(3)="Speed,X[U=R]" field$(4)="Propeller pitch (%),X" field$(5)="Data valid,B"ENDPPROC NMEA_RSA%: descr$="Rudder Sensor Angle" fields%=4 : version%=KStandardNMEA% field$(1)="Rel. rudder angle (starboard),X[R=D]" field$(2)="Data valid,B" field$(3)="Rel. rudder angle (port),X[R=D]" field$(4)="Data valid,B"ENDPPROC NMEA_RSD%: descr$="RADAR System Data" fields%=13 : version%=KStandardNMEA% field$(1)="Origin1 Range from ship,X[D=12]" field$(2)="Origin1 Bearing,X[R=D]" field$(3)="VRM1,X[D=12]" field$(4)="EBL1,X[R=D]" field$(5)="Origin2 Range from ship,X[D=12]" field$(6)="Origin2 Bearing,X[R=D]" field$(7)="VRM2,X[D=12]" field$(8)="EBL2,X[R=D]" field$(9)="Cursor Range from ship,,X[D=12]" field$(10)="Cursor Bearing (clockwise from 0),X[R=D]" field$(11)="Range Scale,X" field$(12)="Range Units,-" field$(13)="Display rotation,C(C=course-up)(H=head-up)(N=north-up)"ENDPPROC NMEA_RTE%: descr$="Routes" fields%=4 : version%=KStandardNMEA% field$(1)="Message number,N" field$(2)="Message mode,C(c=complete route)(w=working route)" field$(3)="Route ID,S" field$(4)="Waypoint ID,S*"ENDPPROC NMEA_SFI%: descr$="Scanning Frequency Information" fields%=4 : version%=KStandardNMEA% field$(1)="Message number,N" field$(2)="Frequency or ITU channel,X*" field$(3)="Mode of operation,CT"ENDPPROC NMEA_STN%: descr$="Multiple Data ID" fields%=1 : version%=KStandardNMEA% field$(1)="Talker ID Number,X"ENDPPROC NMEA_TLL%: descr$="Target location (lat/long)" fields%=0 : REM ??? unknownENDPPROC NMEA_TRF%: descr$="TRANSIT Fix Data" fields%=10 : version%=KStandardNMEA% field$(1)="Time of position fix,T" field$(2)="Date,D" field$(3)="Latitude,A" field$(4)="Longitude,O" field$(5)="Elevation angle,X[R=D]" field$(6)="Number of iterations,X" field$(7)="Number of Doppler intervals,X" field$(8)="Update distance,X[D=N]" field$(9)="Satellite ID,X" field$(10)="Data Valid,B"ENDPPROC NMEA_TTM%: descr$="Tracked Target Message" fields%=12 : version%=KStandardNMEA% field$(1)="Target Number,X" field$(2)="Target Distance,X[D=N]" : REM ??? units okay ? field$(3)="Bearing from own ship,X[R=D]" field$(4)="Bearing reference,C(T=true)(R=relative)" field$(5)="Target speed,X[V=N]" : REM ??? units okay ? field$(6)="Target Course,X[R=D]" field$(7)="Course reference,C(T=true)(R=relative)" field$(8)="Distance of closest-point-of-approach,X[D=N]" : REM ??? units okay ? field$(9)="Time until CPA,X[T=#]" field$(10)="Target name,S" field$(11)="Target Status,C(L=lost)(Q=query)(T=tracking)" field$(12)="Reference Target,C"ENDPPROC NMEA_VBW%: descr$="Dual Ground/Water Speed" fields%=6 : version%=KStandardNMEA% field$(1)="Longitudinal water speed,X[V=N]" field$(2)="Transverse water speed,X[V=N]" field$(3)="Data Valid,B" field$(4)="Longitudinal ground speed,X[V=N]" field$(5)="Transverse ground speed,X[V=N]" field$(6)="Data Valid,B"ENDPPROC NMEA_VDR%: descr$="Set and Drift" fields%=3 : version%=KStandardNMEA% field$(1)="Degress true,MT" field$(2)="Degrees magnetic,MM" field$(3)="Speed of current,X[V=#]"ENDPPROC NMEA_VHW%: descr$="Water speed and heading" fields%=3 : version%=KStandardNMEA% field$(1)="Heading true,MT" field$(2)="Heading magnetic,MM" field$(3)="Vessel speed rel. to water,X[V=#]" REM field of speed in km/h ignoredENDPPROC NMEA_VLW%: descr$="Distance traveled through Water" fields%=2 : version%=KStandardNMEA% field$(1)="Total cumulative distance,X[D=#]" field$(2)="Distance since reset,X[D=#]"ENDPPROC NMEA_VPW%: descr$="Speed parallel to Wind" fields%=1 : version%=KStandardNMEA% field$(1)="Speed,X[V=#]" REM field of speed in m/s ignoredENDPPROC NMEA_VTG%: descr$="Track made good and Ground speed" fields%=3 : version%=KStandardNMEA% field$(1)="Track true,MT" field$(2)="Track magnetic,MM" field$(3)="Speed rel. to ground,X[V=#]" REM field of speed in km/h ignoredENDPPROC NMEA_VWR%: descr$="Relative wind speed and angle" fields%=3 field$(1)="Direction magnitude to bow,X[R=D]" field$(2)="Direction to bow,CD" field$(3)="Speed,X[V=#]" REM fields of speed in m/s and km/h ignoredENDPPROC NMEA_WCV%: descr$="Waypoint Closure Velocity" fields%=2 : version%=KStandardNMEA% field$(1)="Velocity,X[V=#]" field$(2)="Waypoint ID,S"ENDPPROC NMEA_WDC%: descr$="Distance to waypoint - Great circle" fields%=0 : REM ??? unknownENDPPROC NMEA_WDR%: descr$="Distance to waypoint - Rhumb line" fields%=0 : REM ??? unknownENDPPROC NMEA_WNC%: descr$="Distance - Waypoint to Waypoint" fields%=5 : version%=KStandardNMEA% field$(1)="Distance,X[D=#]" field$(2)="Same distance,-" field$(3)="Units,-" field$(4)="TO Waypoint,S" field$(5)="FROM Waypoint,S"ENDPPROC NMEA_WPL%: descr$="Waypoint Location" fields%=3 : version%=KStandardNMEA% field$(1)="Latitude,A" field$(2)="Longitude,O" field$(3)="Waypoint ID,S"ENDPPROC NMEA_XDR%: descr$="Cross Track Error - Dead Reckoning" fields%=4 : version%=KStandardNMEA% field$(1)="Transducer Type,CT*" field$(2)="Measurement Data,X" field$(3)="Units of measurement,CU" field$(4)="Name of transducer,S"ENDPPROC NMEA_XTE%: descr$="Cross-Track Error (Measured)" fields%=4 : version%=KStandardNMEA% field$(1)="Status,B(OK or not used)(Loran-C Blink or SNR warning)" field$(2)="Status,B(OK or not used)(Loran-C Cycle Lock warning flag)" field$(3)="Cross track error magnitude,X[D=5]" field$(4)="Direction to steer,CD"ENDPPROC NMEA_XTR%: descr$="Cross Track Error - Dead Reckoning" fields%=2 : version%=KStandardNMEA% field$(1)="Cross track error magnitude,X[D=3]" field$(2)="Direction to steer,CD"ENDPPROC NMEA_ZDA%: descr$="Time & Date" fields%=6 : version%=KStandardNMEA% field$(1)="Time,T" field$(2)="Day,X" field$(3)="Month,X" field$(4)="Year,X" field$(5)="Local zone offset (h),X[T=h]" field$(6)="Local zone offset (min),X[T=m]"ENDPPROC NMEA_ZDL%: descr$="Time & Distance to variable point" fields%=0 : REM ??? unknownENDPPROC NMEA_ZFO%: descr$="Time from origin Waypoint" fields%=3 : version%=KStandardNMEA% field$(1)="Time of observation,T" field$(2)="Elapsed time,T" field$(3)="Origin waypoint ID,S"ENDPPROC NMEA_ZTG%: descr$="Time to Destination Waypoint" fields%=3 : version%=KStandardNMEA% field$(1)="Time of observation,T" field$(2)="Time remaining,T" field$(3)="Destination waypoint ID,S"ENDPREM *** GARMIN PROPIETARY SENTENCES ***PROC NMEA_GRM_C%: descr$="Sensor configuration information" fields%=12 field$(1)="Fix mode,C(A=automatic)" field$(2)="Altitude above mean sea level,X[D=M]" field$(3)="Earth datum index,E" field$(4)="User earth datum semi-major axis,X[D=M]" field$(5)="User inverse flattening factor,X" field$(6)="User delta x earth centered coordinate,X[D=M]" field$(7)="User delta y earth centered coordinate,X[D=M]" field$(8)="User delta z earth centered coordinate,X[D=M]" field$(9)="Differential mode,C(A=automatic)(D=DGPS exclusively)" field$(10)="NMEA Baud rate,C(1=1200)(2=2400)(3=4800)(4=9600)" field$(11)="Filter mode,C(2=no filtering)" field$(12)="PPS mode,C(1=No PPS)(2=1 Hz)"ENDPPROC NMEA_GRM_E%: descr$="Estimated Position Error" fields%=3 field$(1)="Estimated horizontal error,X[D=#]" field$(2)="Estimated vertical error,X[D=#]" field$(3)="Overall spherical position error,X[D=#]"ENDPPROC NMEA_GRM_F%: descr$="Position Fix Sentence" fields%=13 field$(1)="GPS week number,X" field$(2)="GPS seconds,X[T=s]" field$(3)="Date of position fix,D" field$(4)="Time of position fix,T" field$(5)="GPS leap second count,X[T=s]" field$(6)="Latitude,A" field$(7)="Longitude,O" field$(8)="Mode,C(M=manual)(A=automatic)" field$(9)="Fix type,C(0=no fix)(1=2D fix)(2=3D fix)" field$(10)="Speed over ground,X[V=K]" field$(11)="Course over ground,Mt" field$(12)="Position dilution of precision,X" field$(13)="Time dilution of precision,X"ENDPPROC NMEA_GRM_I%: descr$="Sensor initialisation information" fields%=4 field$(1)="Latitude,A" field$(2)="Longitude,O" field$(3)="Current date,D" field$(4)="Current time,T"ENDPPROC NMEA_GRM_M%: descr$="Map datum" fields%=1 field$(1)="Active horizontal datum,S"ENDPPROC NMEA_GRM_O%: REM you(!) have to send this sentence ! descr$="Output sentence enable/disable" fields%=2 field$(1)="Target sentence,S" field$(2)="Target sentence mode,C(0=disable)(1=enable)(2=disable all)(3=enable all)"ENDPPROC NMEA_GRM_T%: descr$="Sensor status information" fields%=9 field$(1)="Model and software version,S" field$(2)="Rom checksum test,C(P=pass)(F=fail)" field$(3)="Receiver failure discrete,C(P=pass)(F=fail)" field$(4)="Stored data status,C(R=retained)(L=lost)" field$(5)="Real time clock status,C(R=retained)(L=lost)" field$(6)="0scillator drift discrete,C(P=pass)(F=excessive drift detected)" field$(7)="Data collection discrete,C(C=collecting)" field$(8)="Board temperature,X[K=C]" field$(9)="Board configuration data,C(R=retained)(L=lost)"ENDPPROC NMEA_GRM_V%: descr$="3D velocity" fields%=3 field$(1)="True east velocity,X[V=M]" field$(2)="True north velocity,X[V=M]" field$(3)="Up velocity,X[V=M]"ENDPPROC NMEA_GRM_Z%: descr$="Altitude Information" fields%=2 field$(1)="Altitude,X[D=#]" field$(2)="Position fix dimensions,C(2=user altitude)(3=GPS altitude)"ENDPPROC NMEA_SLI_B%: descr$="Differental control Starlink receiver" fields%=3 field$(1)="Frequency,X[F=K]" field$(2)="Bit rate,X" field$(3)="Request type,C(J=status request)(K=configuration request)"ENDPREM *** Check descriptor , if field has to be ignored ***PROC IsIgnoreField%:(c%) REM (fast implemetation) RETURN (PEEKW(ADDR(field$(c%))+PEEKW(ADDR(field$(c%))))=%-)ENDPREM *** Check descriptor, if field contains numbers ***PROC IsNumField%:(c%) LOCAL p%,c$(3) p%=LPosInStr%:(",",field$(c%)) IF p%=0 : RETURN KFalse% : ENDIF c$=MID$(field$(c%),p%+1,1) RETURN (c$<>"C" AND c$<>"S" AND c$<>"B" AND c$<>"N")ENDPREM *** Extract datas from sentence ***REM *** (data field informations have to be filled into ***REM *** global variables FIELDS% and FIELD$() ) ***PROC ReadDatas%:(sentence$) LOCAL dpos%,dpos_all%,ddesc$(50),type$(100),empty% LOCAL pos%,pos2%,lng%,flg%,ind%,ind2%,ind3%,ind4% LOCAL blank%,curField$(255),PercentFlag%,mte,sec dpos%=1 : REM current parse field dpos_all%=1 : REM current data field blank%=0 : REM number of successive empty data fields list_start%=0 : list_cnt%=0 : list_rep%=0  WHILE dpos%<=fields% OR list_start%>0  IF list_start%>0 IF dpos%<=fields% REM more parse field definitions after the first REM field with a repeat indicator IF RIGHT$(field$(dpos%),1)="*" Error_Syntax:(KFieldAfterRepeat%,sentence$,dpos_all%,values$(dpos%),ddesc$,type$) RETURN 0 ENDIF list_cnt%=list_cnt%+1 curField$=field$(dpos%) ELSE REM calculate element of repeated group pos2%=modulo%:(dpos%-list_start%,list_cnt%)+list_start% REM repeat IF dpos%>KMaxParseFields% Error_Syntax:(KTooManyRepetitons%,sentence$,dpos_all%,values$(dpos%),ddesc$,type$) RETURN 0 ENDIF IF pos2%=list_start% list_rep%=list_rep%+1 ENDIF field$(dpos%)=field$(pos2%) curField$=field$(pos2%) ENDIF ELSE curField$=field$(dpos%) IF RIGHT$(curField$,1)="*" list_start%=dpos% list_cnt%=1 list_rep%=0 ENDIF ENDIF IF RIGHT$(curField$,1)="*" curField$=LEFT$(curField$,LEN(curField$)-1) ENDIF  REM looking for last comma pos%=LPosInStr%:(",",curField$) IF pos%=0 Error_Syntax:(KMissingDescr%,sentence$,dpos_all%,values$(dpos%),ddesc$,type$) RETURN 0 ENDIF ddesc$=LEFT$(curField$,pos%-1) type$=MID$(curField$,pos%+1,255) : ind% =ASC(type$) type$=MID$(curField$,pos%+2,255) : ind2%=ASC(type$) lng%=LEN(type$)  values$(dpos%)=ReadData$:(sentence$,dpos_all%) IF values$(dpos%)=CHR$(0) REM data field doesnt exist IF dpos%=list_start% OR list_rep%>0 REM you want to read the first parse field of a list REM or you have read at least one parse field group pos2%=modulo%:(dpos%-list_start%,list_cnt%) IF pos2%=0 REM list end WHILE list_rep%>0 AND blank%>0 AND modulo%:(blank%,list_cnt%)=0 REM last list group of fields was empty list_rep%=list_rep%-1 blank%=blank%-list_cnt% ENDWH BREAK : REM end of list ends parsing ELSE REM in the middle of a parse field group REM the data field has to exist Error_Syntax:(KFieldDontExist%,sentence$,dpos_all%,values$(dpos%),ddesc$,type$) RETURN 0 ENDIF ELSE Error_Syntax:(KFieldDontExist%,sentence$,dpos_all%,values$(dpos%),ddesc$,type$) RETURN 0 ENDIF ENDIF ind3%=ASC(values$(dpos%))   empty%=KFalse% IF values$(dpos%)="" empty%=KTrue% blank%=blank%+1 ELSE blank%=0 ENDIF   IF ind%=%- REM ignore data field empty%=KFalse% values(dpos%)=0 values$(dpos%)=CHR$(KascIgnore%)  ELSEIF ind%=%C REM data field consits of only one character IF lng%>0 REM flag type is given IF ind2%=%D REM direction IF ind3%=%N : values$(dpos%)="North" ELSEIF ind3%=%S : values$(dpos%)="South" ELSEIF ind3%=%W : values$(dpos%)="West" ELSEIF ind3%=%O : values$(dpos%)="East" ELSEIF ind3%=%L : values$(dpos%)="Left" ELSEIF ind3%=%R : values$(dpos%)="Right" ELSEIF NOT empty% Error_Syntax:(KWrongSymbol%,sentence$,dpos_all%,values$(dpos%),ddesc$,type$) RETURN 0 ENDIF ELSEIF ind2%=%C REM communications mode IF ind3%=%d : values$(dpos%)="F3E G3E SimplexTelephone" ELSEIF ind3%=%e : values$(dpos%)="F3E G3E DuplexTelephone" ELSEIF ind3%=%m : values$(dpos%)="J3E Telephone" ELSEIF ind3%=%o : values$(dpos%)="H3E Telephone" ELSEIF ind3%=%q : values$(dpos%)="F1B J2B FEC NBDP TelexTeleprinter" ELSEIF ind3%=%s : values$(dpos%)="F1B J2B ARQ NBDP TelexTeleprinter" ELSEIF ind3%=%w : values$(dpos%)="F1B J2B Receive Only Teleprinter DSC" ELSEIF ind3%=%x : values$(dpos%)="A1A Morse Tape Recorder" ELSEIF ind3%=%{ : values$(dpos%)="A1A Morse Tape Recorder" ELSEIF ind3%=%| : values$(dpos%)="F1C F2C F3C Fax Machine" ELSEIF NOT empty% Error_Syntax:(KWrongSymbol%,sentence$,dpos_all%,values$(dpos%),ddesc$,type$) RETURN 0 ENDIF ELSEIF ind2%=%R REM reference IF ind3%=%B : values$(dpos%)="Bottom Tracking Log" ELSEIF ind3%=%M : values$(dpos%)="Manually Entered" ELSEIF ind3%=%W : values$(dpos%)="Water Referenced" ELSEIF ind3%=%R : values$(dpos%)="Radar Tracking Of Fixed Target" ELSEIF ind3%=%P : values$(dpos%)="Positioning System Ground Reference" ELSEIF NOT empty% Error_Syntax:(KWrongSymbol%,sentence$,dpos_all%,values$(dpos%),ddesc$,type$) RETURN 0 ENDIF ELSEIF ind2%=%T REM transducer IF ind3%=%A : values$(dpos%)="Angular Displacement" ELSEIF ind3%=%D : values$(dpos%)="Linear Displacement" ELSEIF ind3%=%C : values$(dpos%)="Temperature" ELSEIF ind3%=%F : values$(dpos%)="Frequency" ELSEIF ind3%=%N : values$(dpos%)="Force" ELSEIF ind3%=%P : values$(dpos%)="Pressure" ELSEIF ind3%=%R : values$(dpos%)="FlowRate" ELSEIF ind3%=%T : values$(dpos%)="Tachometer" ELSEIF ind3%=%H : values$(dpos%)="Humidity" ELSEIF ind3%=%V : values$(dpos%)="Volume" ELSEIF NOT empty% Error_Syntax:(KWrongSymbol%,sentence$,dpos_all%,values$(dpos%),ddesc$,type$) RETURN 0 ENDIF ELSEIF ind2%=%U REM units for transducers IF ind3%=%C : values$(dpos%)="°C" ELSEIF ind3%=%D : values$(dpos%)="°" ELSEIF ind3%=%M : values$(dpos%)="meters" ELSEIF ind3%=%H : values$(dpos%)="Hz" ELSEIF ind3%=%N : values$(dpos%)="Newtons" ELSEIF ind3%=%B : values$(dpos%)="bar" ELSEIF ind3%=%l : values$(dpos%)="liters/s" ELSEIF ind3%=%R : values$(dpos%)="RPM" ELSEIF ind3%=%P : values$(dpos%)="%" ELSEIF ind3%=%M : values$(dpos%)="m^3" ELSEIF NOT empty% Error_Syntax:(KWrongSymbol%,sentence$,dpos_all%,values$(dpos%),ddesc$,type$) RETURN 0 ENDIF ELSEIF ind2%=%L REM lorean time IF ind3%=%B : values$(dpos%)="Loran Blink Warning" ELSEIF ind3%=%C : values$(dpos%)="Loran Cycle Warning" ELSEIF ind3%=%S : values$(dpos%)="Loran SNR Warning" ELSEIF ind3%=%A : values$(dpos%)="Loran Valid" ELSEIF NOT empty% Error_Syntax:(KWrongSymbol%,sentence$,dpos_all%,values$(dpos%),ddesc$,type$) RETURN 0 ENDIF ELSEIF ind2%=%( REM meaning is user defined; REM looking in list for given symbol pos%=0 flg%=KFalse% WHILE pos%%A AND ind3%<>%V AND NOT empty% Error_Syntax:(KWrongBoolSymbol%,sentence$,dpos_all%,values$(dpos%),ddesc$,type$) RETURN 0 ENDIF IF lng%=0 REM use TRUE and FALSE IF ind3%=%A : values$(dpos%)="True" ELSEIF ind3%=%V : values$(dpos%)="False" ENDIF ELSEIF ind2%=%( REM use user defined words pos%=2 IF ind%=%V REM looking for 2nd '(' WHILE pos%<=lng% AND MID$(type$,pos%,1)<>"(" pos%=pos%+1 ENDWH pos%=pos%+1 IF pos%>=lng% Error_Syntax:(KWrongSyntaxDesc%,sentence$,dpos_all%,values$(dpos%),ddesc$,type$) RETURN 0 ENDIF ENDIF REM reading until ')' pos2%=PosInStr%:(")",type$,pos%) IF pos2%=0 Error_Syntax:(KWrongSyntaxDesc%,sentence$,dpos_all%,values$(dpos%),ddesc$,type$) RETURN 0 ENDIF values$(dpos%)=MID$(type$,pos%,pos2%-pos%) ELSE Error_Syntax:(KWrongSymbol%,sentence$,dpos_all%,values$(dpos%),ddesc$,type$) RETURN 0 ENDIF ELSEIF ind%=%S REM data field is a string IF lng%>=3 REM adding leading spaces pos%=StrVal:(MID$(type$,2,lng%-2)) IF pos%<=0 Error_Syntax:(KWrongSyntaxDesc%,sentence$,dpos_all%,values$(dpos%),ddesc$,type$) RETURN 0 ENDIF lng%=LEN(values$(dpos%)) IF pos%>lng% values$(dpos%)=REPT$(" ",pos%-lng%)+values$(dpos%) ENDIF ELSEIF lng%>0 Error_Syntax:(KWrongSyntaxDesc%,sentence$,dpos_all%,values$(dpos%),ddesc$,type$) RETURN 0 ENDIF ELSEIF ind%=%T REM time values(dpos%)=StrVal:(values$(dpos%)) values$(dpos%)=CHR$(KascValid%)+KTypeTime$ ELSEIF ind%=%D REM date values(dpos%)=StrVal:(values$(dpos%)) values$(dpos%)=CHR$(KascValid%)+KTypeDate$ ELSEIF ind%=%A REM latitude values(dpos%)=StrVal:(values$(dpos%))/100 mte=(values(dpos%)-INTF(values(dpos%)))*100 values(dpos%)=INTF(values(dpos%))+mte/60  dpos_all%=dpos_all%+1 values$(dpos%)=ReadData$:(sentence$,dpos_all%) IF values$(dpos%)=CHR$(0) Error_Syntax:(KFieldDontExist%,sentence$,dpos_all%,values$(dpos%),ddesc$,type$) RETURN 0 ENDIF IF values$(dpos%)="S" values(dpos%)=-values(dpos%) ELSEIF values$(dpos%)<>"N" AND values$(dpos%)<>"" Error_Syntax:(KWrongSymbol%,sentence$,dpos_all%,values$(dpos%),ddesc$,type$) RETURN 0 ENDIF values$(dpos%)=CHR$(KascValid%)+KTypeLatitude$ ELSEIF ind%=%O REM longitude values(dpos%)=StrVal:(values$(dpos%))/100 mte=(values(dpos%)-INTF(values(dpos%)))*100 values(dpos%)=INTF(values(dpos%))+mte/60 dpos_all%=dpos_all%+1 values$(dpos%)=ReadData$:(sentence$,dpos_all%) IF values$(dpos%)=CHR$(0) Error_Syntax:(KFieldDontExist%,sentence$,dpos_all%,values$(dpos%),ddesc$,type$) RETURN 0 ENDIF IF values$(dpos%)="E" values(dpos%)=-values(dpos%) ELSEIF values$(dpos%)<>"W" AND values$(dpos%)<>"" Error_Syntax:(KWrongSymbol%,sentence$,dpos_all%,values$(dpos%),ddesc$,type$) RETURN 0 ENDIF values$(dpos%)=CHR$(KascValid%)+KTypeLongitude$ ELSEIF ind%=%N REM two data fields with total number of messages ttt and message number mmm REM (storing as floating point ttt.mmm) IF empty% Error_Syntax:(KFieldBlank%,sentence$,dpos_all%,values$(dpos%),ddesc$,type$) RETURN 0 ENDIF values(dpos%)=StrVal:(values$(dpos%)) dpos_all%=dpos_all%+1 values$(dpos%)=ReadData$:(sentence$,dpos_all%) IF values$(dpos%)=CHR$(0) Error_Syntax:(KFieldDontExist%,sentence$,dpos_all%,values$(dpos%),ddesc$,type$) RETURN 0 ENDIF IF values$(dpos%)<>"" values(dpos%)=values(dpos%)+(StrVal:(values$(dpos%))/1000.0) ELSE Error_Syntax:(KFieldBlank%,sentence$,dpos_all%,values$(dpos%),ddesc$,type$) RETURN 0 ENDIF values$(dpos%)=CHR$(KascValid%)+KTypeMessageNumber$ ELSEIF ind%=%E REM Garmin propietary: EarthDatum values(dpos%)=Hex2Dec%:(values$(dpos%))  values$(dpos%)=CHR$(KascValid%)+KTypeEarthDatum$ ELSEIF ind%=%M REM bearing values(dpos%)=StrVal:(values$(dpos%))  IF ind2%=%M OR ind2%=%T REM verify with next field dpos_all%=dpos_all%+1 values$(dpos%)=ReadData$:(sentence$,dpos_all%) IF ASC(values$(dpos%))<>ind2% Error_Syntax:(KBadHeadingType%,sentence$,dpos_all%,values$(dpos%),ddesc$,type$) RETURN 0 ENDIF ENDIF IF ind2%=%M OR ind2%=%m values$(dpos%)=CHR$(KascValid%)+KTypeBearMagnetic$ ELSEIF ind2%=%T OR ind2%=%t values$(dpos%)=CHR$(KascValid%)+KTypeBearTrue$ ELSE Error_Syntax:(KWrongSymbol%,sentence$,dpos_all%,values$(dpos%),ddesc$,type$) RETURN 0 ENDIF  ELSEIF ind%=%H REM hexvalue IF lng%>0 IF ind2%=%( REM looking for closing ')' pos%=PosInStr%:(")",type$,2) IF pos%=0 Error_Syntax:(KWrongSyntaxDesc%,sentence$,dpos_all%,values$(dpos%),ddesc$,type$) RETURN 0 ENDIF pos2%=StrVal:(MID$(type$,2,pos%-2)) ELSE Error_Syntax:(KWrongSymbol%,sentence$,dpos_all%,values$(dpos%),ddesc$,type$) RETURN 0 ENDIF ELSE pos2%=0 ENDIF values(dpos%)=Hex2Dec:(values$(dpos%)) values$(dpos%)=CHR$(KascValid%)+KTypeHexvalue$+CHR$(pos2%) ELSEIF ind%=%X REM number values(dpos%)=StrVal:(values$(dpos%))   IF lng%>0 IF ind2%=%( REM align number; REM looking for closing ')' pos%=PosInStr%:(")",type$,2) IF pos%=0 Error_Syntax:(KWrongSyntaxDesc%,sentence$,dpos_all%,values$(dpos%),ddesc$,type$) RETURN 0 ENDIF pos%=StrVal:(MID$(type$,2,pos%-2)) type$=MID$(type$,pos%+1,255) ind2%=ASC(type$) ENDIF IF ind2%=%[ REM units ind3%=ASC(MID$(type$,2,1)) ind4%=ASC(MID$(type$,4,1)) IF ind4%=%# REM read units from next data field dpos_all%=dpos_all%+1 values$(dpos%)=ReadData$:(sentence$,dpos_all%) IF values$(dpos%)=CHR$(0) Error_Syntax:(KFieldDontExist%,sentence$,dpos_all%,values$(dpos%),ddesc$,type$) RETURN 0 ENDIF IF values$(dpos%)="" ind4%=%D REM ind4% must be valid, else error occurs ELSE ind4%=ASC(values$(dpos%)) ENDIF ELSEIF ind4%>=%0 AND ind4%<=%9 REM read units from special field; REM first, looking for closing ']' pos%=PosInStr%:("]",type$,5) IF pos%=0 Error_Syntax:(KWrongSyntaxDesc%,sentence$,dpos_all%,values$(dpos%),ddesc$,type$) RETURN 0 ENDIF  pos2%=StrVal:(MID$(type$,4,pos2%-4)) values$(dpos%)=ReadData$:(sentence$,pos2%) IF values$(dpos%)=CHR$(0) Error_Syntax:(KFieldDontExist%,sentence$,dpos_all%,values$(dpos%),ddesc$,type$) RETURN 0 ENDIF IF values$(dpos%)="" ind4%=-1 REM ind4% must be valid, else error occurs ELSE ind4%=ASC(values$(dpos%)) ENDIF  ENDIF PercentFlag%=0 IF ind3%=ASC(KUnitGroupDistance$) IF ind4%=ASC(KUnitSymbolNauticalMiles$) values(dpos%)=Convert:(values(dpos%),KNauticalMiles%,KMeters%) ELSEIF ind4%=ASC(KUnitSymbolMeters$) REM nothing to do ELSEIF ind4%=ASC(KUnitSymbolKilometers$) values(dpos%)=Convert:(values(dpos%),KKilometers%,KMeters%) ELSEIF ind4%=ASC(KUnitSymbolFeets$) values(dpos%)=Convert:(values(dpos%),KFeets%,KMeters%) ELSEIF ind4%=ASC(KUnitSymbolFathoms$) values(dpos%)=Convert:(values(dpos%),KFathoms%,KMeters%) ELSEIF ind4%=ASC(KUnitSymbolInches$) values(dpos%)=Convert:(values(dpos%),KInches%,KMeters%) ELSEIF ind4%=ASC(KUnitSymbolPercent$) PercentFlag%=$80 ELSEIF ind4%<>-1 Error_Syntax:(KWrongSymbol%,sentence$,dpos_all%,values$(dpos%),ddesc$,type$) RETURN 0 ENDIF values$(dpos%)=CHR$(KascValid%)+KTypeUnit$+CHR$(ASC(KUnitGroupDistance$)+PercentFlag%) ELSEIF ind3%=ASC(KUnitGroupVelocity$) IF ind4%=ASC(KUnitSymbolKnots$) values(dpos%)=Convert:(values(dpos%),KKnots%,KMetersPerSecond%) ELSEIF ind4%=ASC(KUnitSymbolMetersPerSecond$) REM nothing to do ELSEIF ind4%=ASC(KUnitSymbolKilometersPerHour$) values(dpos%)=Convert:(values(dpos%),KKilometersPerHour%,KMetersPerSecond%) ELSEIF ind4%=ASC(KUnitSymbolStatuteMilesPerHour$) values(dpos%)=Convert:(values(dpos%),KStatuteMilesPerHour%,KMetersPerSecond%) ELSEIF ind4%=ASC(KUnitSymbolPercent$) PercentFlag%=$80 ELSEIF ind4%<>-1 Error_Syntax:(KWrongSymbol%,sentence$,dpos_all%,values$(dpos%),ddesc$,type$) RETURN 0 ENDIF values$(dpos%)=CHR$(KascValid%)+KTypeUnit$+CHR$(ASC(KUnitGroupVelocity$)+PercentFlag%) ELSEIF ind3%=ASC(KUnitGroupTime$) IF ind4%=ASC(KUnitSymbolSeconds$) REM nothing to do ELSEIF ind4%=ASC(KUnitSymbolMicroseconds$) values(dpos%)=Convert:(values(dpos%),KMicroseconds%,KSeconds%)  ELSEIF ind4%=ASC(KUnitSymbolMicroseconds10$) values(dpos%)=Convert:(values(dpos%),KMicroseconds10%,KSeconds%)  ELSEIF ind4%=ASC(KUnitSymbolMinutes$) values(dpos%)=Convert:(values(dpos%),KMinutes%,KSeconds%) ELSEIF ind4%=ASC(KUnitSymbolHours$) values(dpos%)=Convert:(values(dpos%),KHours%,KSeconds%) ELSEIF ind4%=ASC(KUnitSymbolPercent$) PercentFlag%=$80 ELSEIF ind4%<>-1 Error_Syntax:(KWrongSymbol%,sentence$,dpos_all%,values$(dpos%),ddesc$,type$) RETURN 0 ENDIF values$(dpos%)=CHR$(KascValid%)+KTypeUnit$+CHR$(ASC(KUnitGroupTime$)+PercentFlag%) ELSEIF ind3%=ASC(KUnitGroupDirection$) IF ind4%=ASC(KUnitSymbolDegrees$) REM nothing to do ELSEIF ind4%=%* REM also degrees, but read sign from next data field dpos_all%=dpos_all%+1 values$(dpos%)=ReadData$:(sentence$,dpos_all%)  IF values$(dpos%)=CHR$(0) Error_Syntax:(KFieldDontExist%,sentence$,dpos_all%,values$(dpos%),ddesc$,type$) RETURN 0 ENDIF IF values$(dpos%)="W" values(dpos%)=-values(dpos%) ELSEIF values$(dpos%)<>"E" AND values$(dpos%)<>"" Error_Syntax:(KWrongSymbol%,sentence$,dpos_all%,values$(dpos%),ddesc$,type$) RETURN 0 ELSEIF values$(dpos%)="" AND NOT empty% Error_Syntax:(KFieldBlank%,sentence$,dpos_all%,values$(dpos%),ddesc$,type$) RETURN 0  ENDIF  ELSEIF ind4%=ASC(KUnitSymbolPercent$) PercentFlag%=$80 ELSEIF ind4%<>-1 Error_Syntax:(KWrongSymbol%,sentence$,dpos_all%,values$(dpos%),ddesc$,type$) RETURN 0 ENDIF values$(dpos%)=CHR$(KascValid%)+KTypeUnit$+CHR$(ASC(KUnitGroupDirection$)+PercentFlag%)  ELSEIF ind3%=ASC(KUnitGroupTemperature$) IF ind4%=ASC(KUnitSymbolCelcius$) REM nothing to do ELSEIF ind4%=ASC(KUnitSymbolPercent$) PercentFlag%=$80 ELSEIF ind4%<>-1 Error_Syntax:(KWrongSymbol%,sentence$,dpos_all%,values$(dpos%),ddesc$,type$) RETURN 0 ENDIF values$(dpos%)=CHR$(KascValid%)+KTypeUnit$+CHR$(ASC(KUnitGroupTemperature$)+PercentFlag%) ELSEIF ind3%=ASC(KUnitGroupRevolution$) IF ind4%=ASC(KUnitSymbolRevolutionsPerMinute$) values(dpos%)=Convert:(values(dpos%),KRevolutionsPerMinute%,KDegreesPerMinute%) ELSEIF ind4%=ASC(KUnitSymbolDegreesPerMinute$) REM nothing to do ELSEIF ind4%=ASC(KUnitSymbolPercent$) PercentFlag%=$80 ELSEIF ind4%<>-1 Error_Syntax:(KWrongSymbol%,sentence$,dpos_all%,values$(dpos%),ddesc$,type$) RETURN 0 ENDIF values$(dpos%)=CHR$(KascValid%)+KTypeUnit$+CHR$(ASC(KUnitGroupRevolution$)+PercentFlag%)  ELSEIF ind3%=ASC(KUnitGroupPressure$) IF ind4%=ASC(KUnitSymbolInchesOfMercury$) values(dpos%)=Convert:(values(dpos%),KInchesOfMercury%,KBars%) ELSEIF ind4%=ASC(KUnitSymbolBars$) REM nothing to do ELSEIF ind4%=ASC(KUnitSymbolPercent$) PercentFlag%=$80 ELSEIF ind4%<>-1 Error_Syntax:(KWrongSymbol%,sentence$,dpos_all%,values$(dpos%),ddesc$,type$) RETURN 0 ENDIF values$(dpos%)=CHR$(KascValid%)+KTypeUnit$+CHR$(ASC(KUnitGroupPressure$)+PercentFlag%) ELSEIF ind3%=ASC(KUnitGroupSignal$) IF ind4%=ASC(KUnitSymbolDecibel$) REM nothing to do ELSEIF ind4%=ASC(KUnitSymbolPercent$) PercentFlag%=$80 ELSEIF ind4%<>-1 Error_Syntax:(KWrongSymbol%,sentence$,dpos_all%,values$(dpos%),ddesc$,type$) RETURN 0 ENDIF values$(dpos%)=CHR$(KascValid%)+KTypeUnit$+CHR$(ASC(KUnitGroupSignal$)+PercentFlag%) ELSEIF ind3%=ASC(KUnitGroupFrequency$) IF ind4%=ASC(KUnitSymbolHertz$) REM nothing to do ELSEIF ind4%=ASC(KUnitSymbolKilohertz$) values(dpos%)=Convert:(values(dpos%),KKilohertz%,KHertz%) ELSEIF ind4%=ASC(KUnitSymbolPercent$) PercentFlag%=$80 ELSEIF ind4%<>-1 Error_Syntax:(KWrongSymbol%,sentence$,dpos_all%,values$(dpos%),ddesc$,type$) RETURN 0 ENDIF values$(dpos%)=CHR$(KascValid%)+KTypeUnit$+CHR$(ASC(KUnitGroupFrequency$)+PercentFlag%) ELSEIF ind3%=ASC(KUnitGroupHumidity$) IF ind4%=ASC(KUnitSymbolPercent$) PercentFlag%=$80 ELSEIF ind4%<>-1 Error_Syntax:(KWrongSymbol%,sentence$,dpos_all%,values$(dpos%),ddesc$,type$) RETURN 0 ENDIF values$(dpos%)=CHR$(KascValid%)+KTypeUnit$+CHR$(ASC(KUnitGroupHumidity$)+PercentFlag%) ELSEIF ind3%=ASC(KUnitGroupVolume$) IF ind4%=ASC(KUnitSymbolLiters$) REM nothing to do ELSEIF ind4%=ASC(KUnitSymbolCubicMeters$) values(dpos%)=Convert:(values(dpos%),KCubicMeters%,KLiters%) ELSEIF ind4%=ASC(KUnitSymbolPercent$) PercentFlag%=$80 ELSEIF ind4%<>-1 Error_Syntax:(KWrongSymbol%,sentence$,dpos_all%,values$(dpos%),ddesc$,type$) RETURN 0 ENDIF values$(dpos%)=CHR$(KascValid%)+KTypeUnit$+CHR$(ASC(KUnitGroupVolume$)+PercentFlag%) ELSE Error_Syntax:(KWrongSymbol%,sentence$,dpos_all%,values$(dpos%),ddesc$,type$) RETURN 0 ENDIF  ELSEIF ind2%<>0 REM symbol after X, but not '(' or '[' Error_Syntax:(KWrongSymbol%,sentence$,dpos_all%,values$(dpos%),ddesc$,type$) RETURN 0 ENDIF  ELSE : REM lng%=0 ; X without additional specifications values$(dpos%)=CHR$(KascValid%)+KTypeUnknown$ ENDIF ELSE REM unknown data format indicator Error_Syntax:(KWrongSymbol%,sentence$,dpos_all%,values$(dpos%),ddesc$,type$) RETURN 0 ENDIF  IF empty% REM blank field IF values$(dpos%)<>"" AND ASC(values$(dpos%))<32 values$(dpos%)=CHR$(KascBlank%)+MID$(values$(dpos%),2,255) ELSE values$(dpos%)="" ENDIF ENDIF  dpos%=dpos%+1 dpos_all%=dpos_all%+1 ENDWH  RETURN 1ENDPREM *** returns a string representing ***REM *** data field number dpos% in the sentence$ ***REM *** (returns CHR$(0), if dpos% is too large) ***PROC ReadData$:(sentence$,dpos%) LOCAL pos%,lng%,dc%,d1%,sym$(3) lng%=LEN(sentence$) pos%=1 dc%=0 : d1%=0 WHILE pos%<=lng% sym$=MID$(sentence$,pos%,1) IF sym$="," OR sym$="*" dc%=dc%+1 IF dc%=dpos% AND sym$="," : d1%=pos% : ENDIF IF dc%>dpos% AND d1%>0 RETURN MID$(sentence$,d1%+1,pos%-d1%-1) ENDIF ENDIF pos%=pos%+1 ENDWH IF dc%=dpos% AND d1%>0 RETURN MID$(sentence$,d1%+1,pos%-d1%-1) ELSE RETURN CHR$(0) ENDIFENDPREM *** Create and send a query ***PROC Query: LOCAL str$(100),format$(4),query$(80),cnt&,cnt2&,r% format$=ChooseFormatDlg$:("Query") IF format$="" : RETURN : ENDIF  IF yourtype$="" REM last device detection failed str$=GetYourDevice$:(KFalse%) IF yourtype$="" Busy:(KBusyOff$,0) gIPRINT str$,1 RETURN ENDIF ENDIF  REM create and send query sentence query$="$"+mytype$+yourtype$+"Q,"+format$ DO  ClearPortBuffer: SendSentence$:(query$,0)  cnt&=0 cnt2&=0 Busy:("Sent - Waiting for respond",1) DO GetSentence: IF sentence$<>"" cnt&=cnt&+1 IF format$=MID$(sentence$,4,3) cnt2&=cnt2&+1 ELSE cnt2&=0 ENDIF ENDIF UNTIL cnt&=30 Busy:(KBusyOff$,0)  IF cnt2&<10 dINIT "Query ("+query$+")" dTEXT "","Connected device does not answer the query." dBUTTONS " Cancel ",-27,"Retry",13 Lock:(KLock%) : r%=DIALOG : Lock:(KUnlock%) IF r%<>13 : RETURN : ENDIF ELSE gIPRINT "Query was successful",1 RETURN ENDIF UNTIL KFalse%ENDPREM *** Opens dialog for sentence format selection ***PROC ChooseFormatDlg$:(title$) LOCAL buffer$(255),c%,format%,type$(5),c1%,c2% LOCAL fnum%(200),fc%,r% Busy:("Building format list"+KDots$,1) dINIT title$ dTEXT ""," " dTEXT "","Select the sentence format:",0  c%=1 c1%=0 : c2%=0 fc%=0 type$=SentenceType_Standard$:("",c%) DO version%=KUnknownNMEA% @%("NMEA_"+type$): buffer$=type$+" - "+descr$ c%=c%+1 type$=SentenceType_Standard$:("",c%) IF version%<>KOldNMEA% OR setting%(7)=1  REM add this format to list IF version%=KOldNMEA% buffer$=buffer$+" (*)" c1%=c1%+1 ENDIF IF version%=KUnknownNMEA% OR fields%=0 buffer$=buffer$+" (**)" c2%=c2%+1 ENDIF IF type$<>"" : buffer$=buffer$+",..." : ENDIF dCHOICE format%,"",buffer$ ELSE REM save this number as ignored string fc%=fc%+1 fnum%(fc%)=c%-1 ENDIF UNTIL type$=""  Busy:(KBusyOff$,0)  IF c1% dTEXT ""," (*) Not recommended format of version 2.00" ENDIF IF c2% dTEXT ""," (**) Unknown message format" ENDIF dTEXT ""," "  dBUTTONS " Cancel ",-(27+$100),"Okay",13+$100 Lock:(KLock%) : r%=DIALOG : Lock:(KUnlock%) IF r%<>13 : RETURN "" : ENDIF  REM set format% to real number including ignored strings c%=1 WHILE c%<=fc% IF fnum%(c%)>format% : BREAK : ENDIF format%=format%+1 c%=c%+1 ENDWH RETURN SentenceType_Standard$:("",format%)ENDPREM *** Choose mask of needed sentence fields ***REM *** ch_addr has to point to a array of at least 50 integers *** PROC ChooseMaskDlg$:(title$,ch_addr&,onlynums%,modi$) LOCAL c%,ca%,ce%,c2%,repeat%,started%,fields2%,aoff& LOCAL pg%,pgs%,pos%,r%,str$(255),format$(5),ch%(50)  c%=0 WHILE c%<50 c%=c%+1 IF modi$<>"" ch%(c%)=1 ELSE ch%(c%)=0 ENDIF ENDWH  DO  REM choose sentence format format$=ChooseFormatDlg$:(title$) IF format$="" : RETURN "" : ENDIF  format$=SentenceType_Standard$:(format$,0) IF format$="" ShortMessagePrompt:(title$,"This format is still not implemented.") CONTINUE ENDIF  REM fill syntax information into global fields @%("NMEA_"+format$): IF fields%=0 ShortMessagePrompt:(title$,"The data fields of this format are unknown.") CONTINUE ENDIF  REM dialog for selecting parse fields you are interested in; REM (for sentence formats with more than 9 parse fields REM these have to be splitted into some dialog pages); REM count parse fields (without ignorable fields) fields2%=0 : c%=1 WHILE c%<=fields% IF onlynums% AND RIGHT$(field$(c%),1)="*" BREAK ENDIF IF (NOT IsIgnoreField%:(c%)) AND (IsNumField%:(c%) OR (NOT onlynums%)) fields2%=fields2%+1 ENDIF c%=c%+1 ENDWH  IF fields2%=0 ShortMessagePrompt:("Statistics","This format contains no numerical fields.") ENDIF  UNTIL fields2%>0 pgs%=1 IF fields2%>9 pgs%=INT((fields2%+8.0)/9.0) ENDIF DO  pg%=1 DO str$="Format mask - "+format$ IF onlynums% str$=str$+" (only numerical fields)" ENDIF IF pgs%>1 str$=str$+" - page "+NUM$(pg%,2)+"/"+NUM$(pgs%,2) ENDIF dINIT str$,17  ca%=pg%*9-8 ce%=ca%+8 IF pgs%=1 : ce%=ce%+2 : ENDIF ce%=MIN(ce%,fields2%) c%=1 : c2%=0 started%=KFalse% : repeat%=KFalse%  DO  IF RIGHT$(field$(c%),1)="*" IF onlynums% : BREAK : ENDIF repeat%=KTrue% ENDIF  IF (NOT IsIgnoreField%:(c%)) AND (IsNumField%:(c%) OR (NOT onlynums%)) c2%=c2%+1 IF c2%>=ca% str$=field$(c%) pos%=LPosInStr%:(",",str$) IF pos%>1 str$=LEFT$(str$,pos%-1) ENDIF  IF repeat% IF NOT started% dTEXT "","List fields:" started%=KTrue% ENDIF str$=" "+str$ ENDIF  IF modi$<>"" dCHOICE ch%(c%),str$,modi$ ELSE dCHECKBOX ch%(c%),str$ ENDIF ENDIF  ENDIF  c%=c%+1 UNTIL c2%=ce% IF pgs%>1 IF pg%=1 dBUTTONS "Next"+KDots$,%N," Cancel ",-(27+$100),"Okay",13+$100 ELSEIF pg%=pgs% dBUTTONS "Prev"+KDots$,%P," Cancel ",-(27+$100),"Okay",13+$100 ELSE dBUTTONS "Prev"+KDots$,%P,"Next"+KDots$,%N," Cancel ",-(27+$100),"Okay",13+$100 ENDIF ELSE dBUTTONS " Cancel ",-(27+$100),"Okay",13+$100 ENDIF Lock:(KLock%) : r%=DIALOG : Lock:(KUnlock%) IF r%=%p AND pg%>1 : pg%=pg%-1 : ENDIF IF r%=%n AND pg%%p AND r%<>%n  IF r%<>13 : RETURN : ENDIF  REM test, if no item is selected ce%=0 c%=1 : aoff&=0 WHILE c%<=fields% POKEW ch_addr&+aoff&,ch%(c%) IF (modi$="" AND ch%(c%)) OR (modi$<>"" AND ch%(c%)>1): ce%=ce%+1 : ENDIF c%=c%+1 aoff&=aoff&+2 ENDWH IF ce%=0 dINIT title$ dTEXT "","No data fields are selected." dBUTTONS " Cancel ",-27,"Retry",13 Lock:(KLock%) : c%=DIALOG : Lock:(KUnlock%) IF c%<>13 : RETURN "" : ENDIF ENDIF UNTIL ce%>0  RETURN format$ENDPREM *** Sends all entered strings ***PROC Terminal: LOCAL inp$(100),checksum% checksum%=1 ClearScreen: FONT 6,17 : gSTYLE 1 gBORDER 1 inp$=GetYourDevice$:(KFalse%) PRINT "Connected device type: " PRINT inp$ PRINT "Every input will be sent to this device." PRINT "Type [q] for exit the terminal state." PRINT "Type [c] for switching automatic checksum on/off." PRINT "Checksum state: ON"  DO PRINT "> "; Input:(ADDR(inp$),100) IF CloseAppCmd% : BREAK : ENDIF  IF inp$="C" OR inp$="c" checksum%=1-checksum% PRINT "Checksum state: "; IF checksum% : PRINT "ON" : ELSE PRINT "OFF" : ENDIF ELSEIF inp$<>"Q" AND inp$<>"q" AND inp$<>"" inp$=SendSentence$:(inp$,checksum%) PRINT "Sent: ";inp$ ENDIF UNTIL inp$="Q" OR inp$="q"  RefreshScreen:ENDPREM *** Unit conversion ***PROC Convert:(values,src_unit%,dest_unit%) LOCAL val2 IF src_unit%=dest_unit% : RETURN values : ENDIF  REM convert to default unit  REM length units; convert to meters IF src_unit%=KNauticalMiles% : val2=values*1852 ELSEIF src_unit%=KStatuteMiles% : val2=values*1609.344 ELSEIF src_unit%=KMeters% : val2=values ELSEIF src_unit%=KKilometers% : val2=values*1000 ELSEIF src_unit%=KFeets% : val2=values*0.3048 ELSEIF src_unit%=KFathoms% : val2=values*1.8288 ELSEIF src_unit%=KInches% : val2=values*2.54  REM velocity units; convert to m/s ELSEIF src_unit%=KKnots% : val2=values*1852/3600 ELSEIF src_unit%=KMetersPerSecond% : val2=values ELSEIF src_unit%=KKilometersPerHour% : val2=values/3.6 ELSEIF src_unit%=KStatuteMilesPerHour% : val2=values*1.15*1852.0 REM volume to liters ELSEIF src_unit%=KLiters% : val2=values ELSEIF src_unit%=KCubicMeters% : val2=values*1000  REM time units; convert to seconds ELSEIF src_unit%=KSeconds% : val2=values ELSEIF src_unit%=KMicroseconds% : val2=values/1000000.0 ELSEIF src_unit%=KMicroseconds10% : val2=values/10000000.0 ELSEIF src_unit%=KMinutes% : val2=values*60.0 ELSEIF src_unit%=KHours% : val2=values*3600.0 ELSEIF src_unit%=KDays% : val2=values*3600.0*24.0 ELSEIF src_unit%=KSidericalDays% : val2=values*3600.0*23.934469722222222 REM pressure into bars ELSEIF src_unit%=KInchesOfMercury% : val2=values*25.4/750.0638 ELSEIF src_unit%=KBars% : val2=values REM frequency into hertz ELSEIF src_unit%=KHertz% : val2=values ELSEIF src_unit%=KKilohertz% : val2=values*1000.0 REM rate of turn; convert to R/min ELSEIF src_unit%=KRevolutionsPerMinute% : val2=values ELSEIF src_unit%=KDegreesPerMinute% : val2=values/360.0  REM angles; convert to degree ELSEIF src_unit%=KDegrees% : val2=values ELSEIF src_unit%=KRadiant% : val2=values*180.0/PI ELSEIF src_unit%=KGrad% : val2=values*1.8  REM temperature; convert to celcius ELSEIF src_unit%=KCelcius% : val2=values ELSEIF src_unit%=KKelvin% : val2=values-273.15 ELSEIF src_unit%=KFahrenheit% : val2=(values-32)/1.8 ELSEIF src_unit%=KReaumur% : val2=values/0.8 ENDIF REM convert default unit to requested unit  IF dest_unit%=KNauticalMiles% : RETURN val2/1852.0 ELSEIF dest_unit%=KStatuteMiles% : RETURN val2/1609.344 ELSEIF dest_unit%=KMeters% : RETURN val2 ELSEIF dest_unit%=KKilometers% : RETURN val2/1000.0 ELSEIF dest_unit%=KFeets% : RETURN val2/0.3048 ELSEIF dest_unit%=KFathoms% : RETURN val2/1.8288 ELSEIF dest_unit%=KInches% : RETURN val2*100/2.54 ELSEIF dest_unit%=KStatuteMilesPerHour% : RETURN val2/1852.0/1.15 ELSEIF dest_unit%=KKnots% : RETURN val2*3600.0/1852.0 ELSEIF dest_unit%=KMetersPerSecond% : RETURN val2 ELSEIF dest_unit%=KKilometersPerHour% : RETURN val2*3.6 ELSEIF dest_unit%=KLiters% : RETURN val2 ELSEIF dest_unit%=KCubicMeters% : RETURN val2/1000.0 ELSEIF dest_unit%=KSeconds% : RETURN val2 ELSEIF dest_unit%=KMicroseconds% : RETURN val2*1000000.0 ELSEIF dest_unit%=KMicroseconds10% : RETURN val2*10000000.0 ELSEIF dest_unit%=KMinutes% : RETURN val2/60.0 ELSEIF dest_unit%=KHours% : RETURN val2/3600.0 ELSEIF dest_unit%=KDays% : RETURN val2/3600.0/24.0 ELSEIF dest_unit%=KSidericalDays% : RETURN val2/3600.0/23.934469722222222 ELSEIF dest_unit%=KInchesOfMercury% : RETURN val2*750.0638/25.4 ELSEIF dest_unit%=KBars% : RETURN val2 ELSEIF dest_unit%=KHertz% : RETURN val2 ELSEIF dest_unit%=KKilohertz% : RETURN val2/1000.0 ELSEIF dest_unit%=KRevolutionsPerMinute% : RETURN val2 ELSEIF dest_unit%=KDegreesPerMinute% : RETURN val2*360.0 ELSEIF dest_unit%=KDegrees% : RETURN val2 ELSEIF dest_unit%=KRadiant% : RETURN val2*PI/180 ELSEIF dest_unit%=KGrad% : RETURN val2/1.8 ELSEIF dest_unit%=KCelcius% : RETURN val2 ELSEIF dest_unit%=KKelvin% : RETURN val2+273.15 ELSEIF dest_unit%=KFahrenheit% : RETURN val2*1.8+32 ELSEIF dest_unit%=KReaumur% : RETURN val2*0.8 ENDIF RETURN values : REM no conversion foundENDPREM *** Output error message ***PROC ErrorMessage%:(title$,err%,retry%) LOCAL r% Busy:(KBusyOff$,0) dINIT title$ dTEXT ""," Error: "+ERR$(err%)+" ",2 IF retry% dBUTTONS " Cancel ",-27,"Retry",13 ELSE dBUTTONS " Okay ",13+$100 ENDIF Lock:(KLock%) : r%=DIALOG : Lock:(KUnlock%) RETURN (r%=13)ENDPPROC ShortMessagePrompt:(title$,error$) LOCAL r% Busy:(KBusyOff$,0) dINIT title$ dTEXT "",error$,2 dBUTTONS " Okay ",13+$100 Lock:(KLock%) : r%=DIALOG : Lock:(KUnlock%)ENDPREM *** Output parse errors ***PROC Error_Checksum:(sentence$,ist%,soll%) IF setting%(1)=0 IF setting%(5)=2 Busy:("Wrong checksum - Press any key",1) GET%:(KTrue%) Busy:(KBusyOff$,0) ENDIF RETURN ENDIF dINIT "Wrong checksum" dTEXT "",sentence$ dTEXT "Read checksum",Dec2Hex$:(ist%,2) dTEXT "Computed checksum",Dec2Hex$:(soll%,2) dBUTTONS " Okay ",13+$100 Lock:(KLock%) : DIALOG : Lock:(KUnlock%)ENDPREM *** Output syntax errors ***PROC Error_Syntax:(error%,sentence$,dpos%,value$,ddesc$,type$) LOCAL str$(80),ErrorStr$(9,40) IF setting%(2)=0 : RETURN : ENDIF ErrorStr$(1)="Unknown symbol in data field" ErrorStr$(2)="No boolean value (A or V)" ErrorStr$(3)="Bad syntax descriptor" ErrorStr$(4)="No 2nd list start allowed" ErrorStr$(5)="No data format descriptor found" ErrorStr$(6)="Can not store all parse fields" ErrorStr$(7)="Requested data field does not exist" ErrorStr$(8)="Field must contain a valid value" ErrorStr$(9)="Heading type (magnetic/true) violation" dINIT "Wrong Syntax" dTEXT "",sentence$ IF value$<>"" : str$=value$ : ELSE str$="(null)" : ENDIF dTEXT "Data field",NUM$(dpos%,10) dTEXT "Value of data field",str$ dTEXT "Description",ddesc$ dTEXT "Format flags",type$ dTEXT "Error",ErrorStr$(error%) dBUTTONS " Okay ",13+$100 Lock:(KLock%) : DIALOG : Lock:(KUnlock%)ENDPREM *** Loop for parsing sentence by sentence ***PROC ParseLoop:(fromport%) LOCAL ende%,c%,ce%,str$(255),file$(255),error% LOCAL h%,r%,ac%,ln%,wait%,event&(16),eventstat%,key% ende%=KFalse% : error%=KFalse%  h%=0 IF NOT fromport% file$=LastParseFile$ REM parse sentences from a textfile IF UseFastFileDialog% file$=FileDialog$:("Select input file",file$,KFalse%,"",&0) IF file$="" : RETURN : ENDIF dINIT "Parseing from file" dCHECKBOX wait%,"Pause between sentences" dBUTTONS " Cancel ",-(27+$100),"Okay",13+$100 Lock:(KLock%) : r%=DIALOG : Lock:(KUnlock%) IF r%<>13 : RETURN : ENDIF ELSE Busy:("Building file list"+KDots$,1) dINIT "Select input file" dFILE file$,"Filename,Folder,Disk",16+UseSystemFolder& dCHECKBOX wait%,"Pause between sentences" dBUTTONS " Cancel ",-(27+$100),"Okay",13+$100 Busy:(KBusyOff$,0) Lock:(KLock%) : r%=DIALOG : Lock:(KUnlock%) IF r%<>13 : RETURN : ENDIF ENDIF  DO r%=IOOPEN(h%,file$,$0420) IF r% IF NOT ErrorMessage%:("Open input file",r%,KTrue%) RETURN ENDIF ENDIF UNTIL r%=0 LastParseFile$=file$ ELSE dINIT "Parsing" dCHECKBOX wait%,"Pause between sentences" dBUTTONS " Cancel ",-(27+$100),"Okay",13+$100 Lock:(KLock%) : r%=DIALOG : Lock:(KUnlock%) IF r%<>13 : RETURN : ENDIF ENDIF  ClearScreen: FONT 7,1 : rem gSTYLE 1 gBORDER 1  DO IF h% REM read sentence from file r%=IOREAD(h%,ADDR(sentence$)+1,255) IF r%<=0 ende%=KTrue% sentence$="" ELSE POKEB ADDR(sentence$),r% ENDIF ELSE REM read sentence from serial port GetSentence: IF sentence$="" ende%=KTrue% : error%=KTrue% ENDIF ENDIF  IF sentence$<>"" r%=Parse%:(sentence$) key%=Key%:  IF CloseAppCmd% : BREAK :ENDIF IF r%=1 CLS PRINT descr$ : PRINT c%=1  ln%=3 IF list_start%>0 ce%=list_start%+list_cnt%*list_rep%-1 ELSE ce%=fields% ENDIF WHILE c%<=ce% IF PrintField%:(c%,ln%) ln%=ln%+1 ENDIF c%=c%+1 ENDWH IF wait% Busy:(KBusyOff$,0) gIPRINT "[ENTER] or [ESC]" ende%=ende% OR (GET%:(KFalse%)=27) IF CloseAppCmd% : BREAK : ENDIF ELSE ende%=ende% OR (key%=27) ENDIF ELSEIF r%=-1 ende%=KTrue% ELSE ende%=ende% OR (key%=27) ENDIF ENDIF  UNTIL ende% IF h% : IOCLOSE(h%) : ENDIF  RefreshScreen: Busy:(KBusyOff$,0) IF error% gIPRINT "No device found - Parsing ended",1 ELSEIF NOT CloseAppCmd% gIPRINT "Parsing ended",1 ENDIFENDPREM *** returns a string representing the content ***REM *** of parse field c%. (If it is a numerical ***REM *** field, it uses value.) ***PROC FormatValue_NoDirect$:(c%,value) RETURN FormatValue_Intern$:(c%,value,KFalse%)ENDPPROC FormatValue$:(c%,value) RETURN FormatValue_Intern$:(c%,value,KTrue%)ENDPPROC FormatValue_Intern$:(c%,value,lat_lon_direction%) LOCAL str$(255),ac%,c$(100),cc%,ce%,daydiff& ac%=ASC(values$(c%)) IF ac%=KascIgnore% : RETURN "(ignore)" : ENDIF IF values$(c%)="" OR ac%=KascBlank% str$="(unavailable)" ELSEIF ac%<32 str$=GEN$(value,15) c$=MID$(values$(c%),2,1) IF c$=KTypeTime$ str$=FormatStr_Time$:(value,utc_offs&,ADDR(daydiff&)) ELSEIF c$=KTypeDate$ REM if there exist a time field REM change date depent from utc offset cc%=1 IF list_start%>0 ce%=list_start%+list_cnt%*list_rep%-1 ELSE ce%=fields% ENDIF WHILE cc%<=ce% IF MID$(values$(cc%),2,1)=KTypeTime$ str$=FormatStr_Time$:(values(cc%),utc_offs&,ADDR(daydiff&)) BREAK ENDIF cc%=cc%+1 ENDWH str$=FormatStr_Date$:(value,daydiff&) ELSEIF c$=KTypeLatitude$ str$=FormatStr_Latitude$:(value,lat_lon_direction%) ELSEIF c$=KTypeLongitude$ str$=FormatStr_Longitude$:(value,lat_lon_direction%) ELSEIF c$=KTypeMessageNumber$ str$=GEN$((value-INT(value))*1000,3)+" of "+GEN$(INT(value),3) ELSEIF c$=KTypeBearMagnetic$ str$=str$+" ° (magnetic)" ELSEIF c$=KTypeBearTrue$ str$=str$+" ° (true)" ELSEIF c$=KTypeEarthDatum$ str$=str$+"("+Dec2Hex$:(value,2)+" hex)" REM you can read the full earth datum from file EARTHDATUM ELSEIF c$=KTypeHexvalue$ str$=Dec2Hex$:(value,ASC(MID$(values$(c%),3,1))) str$=str$+" hex" ELSEIF c$=KTypeUnknown$ REM unspecified value ELSEIF c$=KTypeUnit$  ac%=ASC(MID$(values$(c%),3,1)) c$=CHR$(ac%) IF ac%>=128 REM Angabe in Prozent REM (lower byte stores unit group) str$=str$+"%" ELSEIF c$=KUnitGroupDistance$ str$=FormatStr_Distance$:(value,KFalse%) ELSEIF c$=KUnitGroupVelocity$ str$=FormatStr_Velocity$:(value) ELSEIF c$=KUnitGroupTime$ str$=FormatStr_Duration$:(value) ELSEIF c$=KUnitGroupDirection$ str$=FormatStr_Angle$:(value) ELSEIF c$=KUnitGroupTemperature$ str$=FormatStr_Temperature$:(value) ELSEIF c$=KUnitGroupRevolution$ str$=str$+" R/min" ELSEIF c$=KUnitGroupPressure$ str$=str$+" bar" ELSEIF c$=KUnitGroupSignal$ str$=str$+" dB" ELSEIF c$=KUnitGroupFrequency$ str$=str$+" Hz" ELSEIF c$=KUnitGroupVolume$ str$=str$+" l" ELSEIF c$=KUnitGroupHumidity$ str$=str$+"%"  ELSE ShortMessagePrompt:("Internal error","Unit group type '"+CHR$(ac%)+"' will not be processed.") ENDIF ELSE ShortMessagePrompt:("Internal error","Value type '"+c$+"' will not be processed.") ENDIF ELSE str$=values$(c%) ENDIF  RETURN str$ENDPREM *** print the value of the parse field c% ***REM *** on line line% ***PROC PrintField%:(c%,line%) LOCAL ac%,str$(255),curField$(255),pos%,c$(3),info%(10)  ac%=ASC(values$(c%)) IF ac%<>KascIgnore% REM don't ignore field str$=FormatValue$:(c%,values(c%))  curField$=field$(c%) pos%=LPosInStr%:(",",curField$) curField$=LEFT$(curField$,pos%-1)  IF line%>0  SCREENINFO info%() IF info%(4)>=line% AT 1,line% IF LEN(curField$)>18 PRINT LEFT$(curField$,17)+KDots$ ELSE PRINT curField$ ENDIF AT 20,line% : PRINT str$ RETURN 1 ELSE AT info%(3)-5,info%(4) : PRINT "..." RETURN 0 ENDIF ELSE str$=curField$+" : "+str$ IOWRITE(-line%,ADDR(str$)+1,LEN(str$)) ENDiF ELSE RETURN 0 ENDIFENDPREM *** Select data fields you are interested in ***PROC ParseMask: LOCAL format$(5),format2$(5),ch%(50),str$(255) LOCAL c%,cc%,ce%,cpos%,r%,line%,pos%,ende%,re% LOCAL repeat%,started%,wait%,eventstat%,event&(16),key%  format$=ChooseMaskDlg$:("Parse selected datas",ADDR(ch%(1)),KFalse%,"") IF format$="" : RETURN : ENDIF  dINIT "Parsing" dCHECKBOX wait%,"Pause between sentences" dBUTTONS " Cancel ",-(27+$100),"Okay",13+$100 Lock:(KLock%) : r%=DIALOG : Lock:(KUnlock%) IF r%<>13 : RETURN : ENDIF  REM read sentence by sentence and test, if REM it has the requested format => print selected fields ClearScreen: FONT 7,1 ende%=KFalse% cc%=0 DO cc%=cc%+1 : REM counter of unrequested sentences GetSentence: IF sentence$<>""  key%=Key%: IF CloseAppCmd% : BREAK : ENDIF  format2$=SentenceType_Standard$:(sentence$,0) IF format$=format2$ REM correct sentence format r%=Parse%:(sentence$) IF r%=1 REM parsed successfully cc%=0 : REM counter of unrequested sentences CLS PRINT descr$ c%=1 line%=3 IF list_start%>0 ce%=list_start%+list_cnt%*list_rep%-1 ELSE ce%=fields% ENDIF WHILE c%<=ce% IF c%""  IF (cc%>100) AND NOT ende% REM 100 sentences in unrequested format dINIT "Parse" dTEXT "","No sentence of the requested format read." dBUTTONS " Cancel ",-27,"Retry",13 Lock:(KLock%) : re%=DIALOG : Lock:(KUnlock%) ende%=(re%<>13) cc%=-200 ENDIF  UNTIL ende% RefreshScreen:ENDPREM *** Protocols selected data fields and ***REM computes statistical valuesPROC Statistics: LOCAL format$(5),format2$(5),file$(255),str$(255) LOCAL steps&,stepmode%,step&,out% LOCAL c%,cc%,ende%,r%,line%,ce%,ch%(50),h% LOCAL sums(50),mins(50),maxs(50),dev(50) LOCAL cnt%(50),c3%,mcnt%,event&(16),eventstat%,key%  c%=0 WHILE c%<50 c%=c%+1 sums(50)=0 : cnt%(50)=0 ENDWH  format$=ChooseMaskDlg$:("Select datas for viewing",ADDR(ch%(1)),KTrue%,"(ignore),only view,average,deviation,min + max,all") IF format$="" : RETURN : ENDIF  dINIT "Messurements" dCHOICE stepmode%,"Stepping","manual,automatical" dCHOICE out%,"Output","Screen,File,Screen and File" dBUTTONS " Cancel ",-(27+$100),"Okay",13+$100 Lock:(KLock%) : r%=DIALOG : Lock:(KUnlock%) IF r%<>13 : RETURN : ENDIF  IF out%>1 file$=LastStatisticFile$ IF UseFastFileDialog% file$=FileDialog$:("Select output file",file$,KTrue%,"",&0) IF file$="" : RETURN : ENDIF ELSE Busy:("Building file list"+KDots$,1) dINIT "Select output file" dFILE file$,"Filename,Folder,Disk",17+UseSystemFolder& dBUTTONS " Cancel ",-(27+$100),"Okay",13+$100 Busy:(KBusyOff$,0) Lock:(KLock%) : r%=DIALOG : Lock:(KUnlock%) IF r%<>13 : RETURN : ENDIF ENDIF LastStatisticFile$=file$ ENDIF  IF stepmode%=2 dINIT "Automatical stepping" dLONG steps&,"Total number of messurements",0,9999 dLONG step&,"Step (sec)",1,3600 dBUTTONS " Cancel ",-(27+$100),"Start",13+$100 Lock:(KLock%) : r%=DIALOG : Lock:(KUnlock%) IF r%<>13 : RETURN : ENDIF ENDIF  REM read sentence by sentence and test, if REM it has the requested format => print selected fields ende%=KFalse% mcnt%=0  IF out%>1 DO r%=IOOPEN(h%,file$,$0122) IF r% IF NOT ErrorMessage%:("Open output file",r%,KTrue%) RETURN ENDIF ENDIF UNTIL r%=0 ELSE h%=0 ENDIF  ClearScreen: FONT 7,1 Busy:("Clearing buffer"+KDots$,1) ClearPortBuffer: Busy:(KBusyOff$,0) DO format2$=WaitForSentence$:(ADDR(format$),1,KTrue%) IF format2$<>"" REM correct sentence format r%=Parse%:(sentence$) IF r%=1 REM parsed successfully CLS  mcnt%=mcnt%+1 PRINT descr$ : PRINT PRINT "Number of messurement : "+FIX$(mcnt%,0,10) c%=1 line%=5 IF list_start%>0 ce%=list_start%-1 ELSE ce%=fields% ENDIF c3%=1 : REM counts only checked fields WHILE c%<=ce% IF ch%(c%)>1   IF ASC(values$(c%))<>KascBlank% IF cnt%(c3%)=0 mins(c3%)=values(c%) maxs(c3%)=values(c%) ELSE IF mins(c3%)>values(c%) mins(c3%)=values(c%) ENDIF IF maxs(c3%)0 IF ch%(c%)=3 OR ch%(c%)=6 line%=line%+1 PRINT "> Average value :" AT 20,line% PRINT FormatValue$:(c%,sums(c3%)/cnt%(c3%)) ENDIF IF (ch%(c%)=4 OR ch%(c%)=6) AND cnt%(c3%)>1 line%=line%+1 PRINT "> Standard Deviation :" AT 20,line% PRINT FormatValue_NoDirect$:(c%,(dev(c3%)-sums(c3%)*sums(c3%)/cnt%(c3%))/(cnt%(c3%)-1)) ENDIF IF ch%(c%)=5 OR ch%(c%)=6 line%=line%+1 PRINT "> Range :" AT 20,line% PRINT FormatValue$:(c%,maxs(c3%)) line%=line%+1 AT 20,line% PRINT FormatValue$:(c%,mins(c3%)) ENDIF ENDIF line%=line%+1 ENDIF IF out%>1 : PrintField%:(c%,-h%) : ENDIF  c3%=c3%+1 ENDIF c%=c%+1 ENDWH IF stepmode%=1 Busy:(KBusyOff$,0) gIPRINT "[ENTER] or [ESC]" ende%=(GET%:(KFalse%)=27) OR ende% IF CloseAppCmd% : BREAK :ENDIF ELSE ce%=step&*2 IF ce%>2 AND steps&<>1 GETEVENTA32 eventstat%,event&() ENDIF WHILE ce%>2 AND steps&<>1 BUSY GEN$(ce%/2,5)+"sec until next messurement",1 PAUSE 10 IOYIELD IF eventstat%>=0 IF event&(1)=$404 IF GETCMD$="X" CloseAppCmd%=KTrue% BREAK ENDIF ELSEIF (event&(1) AND $400)=0 IF event&(1)=27 : steps&=1 : BREAK : ENDIF ENDIF GETEVENTA32 eventstat%,event&() ENDIF ce%=ce%-1 IF ce%=2 IOYIELD IF eventstat%<0 GETEVENTC(eventstat%) BREAK ENDIF ENDIF ENDWH   key%=Key%: IF CloseAppCmd% : BREAK : ENDIF IF (steps&>0 OR key%=27) AND NOT ende% steps&=steps&-1 IF steps&=0 OR key%=27 Busy:(KBusyOff$,0) gIPRINT "All done, press any key",1 GET%:(KFalse%) ende%=KTrue% ENDIF ENDIF ENDIF ELSEIF r%=-1 ende%=KTrue% ELSE key%=Key%: ende%=ende% OR (key%=27) OR CloseAppCmd% ENDIF ELSE ende%=KTrue% ENDIF UNTIL ende% IF out%>1 AND mcnt%>0 IF CloseAppCmd% str$="*** aborted by system command ***" IOWRITE(h%,ADDR(str$)+1,LEN(str$)) ENDIF  c%=1 : c3%=1 IF list_start%>0 ce%=list_start%-1 ELSE ce%=fields% ENDIF WHILE c%1 IF ch%(c%)=3 AND cnt%(c3%)>0 str$=GEN$(c3%,-2)+". average value : "+FormatValue$:(c%,sums(c3%)/cnt%(c3%)) IOWRITE(h%,ADDR(str$)+1,LEN(str$)) ENDIF c3%=c3%+1 ENDIF c%=c%+1 ENDWH IOCLOSE(h%) ENDIF RefreshScreen:ENDPPROC ReadSunEclipseDataFormats%:(h%,artype&,artypes&) LOCAL r%,buffer$(255),rtype$(50),rtype%(12),rtypes% r%=IOREAD(h%,ADDR(buffer$)+1,255) IF r%>0 AND PEEKB(ADDR(buffer$)+1)=%# POKEB ADDR(buffer$),r% r%=1 buffer$=MID$(buffer$,2,255) DO rtype$=SubString$:(buffer$,r%) IF rtype$=KSoFiRTypeLat$ : rtype%(r%)=KSoFiRTypeLat% ELSEIF rtype$=KSoFiRTypeLonN$ : rtype%(r%)=KSoFiRTypeLonN% ELSEIF rtype$=KSoFiRTypeLonC$ : rtype%(r%)=KSoFiRTypeLonC% ELSEIF rtype$=KSoFiRTypeLonS$ : rtype%(r%)=KSoFiRTypeLonS% ELSEIF rtype$=KSoFiRTypeTimeN$ : rtype%(r%)=KSoFiRTypeTimeN% ELSEIF rtype$=KSoFiRTypeTimeC$ : rtype%(r%)=KSoFiRTypeTimeC% ELSEIF rtype$=KSoFiRTypeTimeS$ : rtype%(r%)=KSoFiRTypeTimeS% ELSEIF rtype$=KSoFiRTypeSunAlt$ : rtype%(r%)=KSoFiRTypeSunAlt% ELSEIF rtype$=KSoFiRTypeSunAz$ : rtype%(r%)=KSoFiRTypeSunAz% ELSEIF rtype$=KSoFiRTypePWidth$ : rtype%(r%)=KSoFiRTypePWidth% ELSEIF rtype$=KSoFiRTypeDuration$ : rtype%(r%)=KSoFiRTypeDuration% ELSEIF rtype$=KSoFiRTypeIgnore$ : rtype%(r%)=KSoFiRTypeIgnore% ELSEIF rtype$<>"" ShortMessagePrompt:("Sun Eclipse","Wrong format tags in data file.") RETURN KFalse% ENDIF r%=r%+1 UNTIL rtype$="" rtypes%=r%-2 POKEW artypes&,rtypes% ELSE rtype%(1)=KSoFiRTypeLat% rtype%(2)=KSoFiRTypeLonN% rtype%(3)=KSoFiRTypeLonS% rtype%(4)=KSoFiRTypeLonC% rtype%(5)=KSoFiRTypeTimeN% rtype%(6)=KSoFiRTypeTimeS% rtype%(7)=KSoFiRTypeTimeC% rtype%(8)=KSoFiRTypeSunAlt% rtype%(9)=KSoFiRTypeSunAz% rtype%(10)=KSoFiRTypePWidth% rtype%(11)=KSoFiRTypeDuration% rtypes%=11 POKEW artypes&,11 ENDIF r%=1 WHILE r%<=rtypes% POKEW artype&+(r%-1)*2,rtype%(r%) r%=r%+1 ENDWH RETURN KTrue%ENDPPROC ReadSunEclipseNextDataLine%:(h%,rtypes%,artype&,arec&,slen%) LOCAL r%,buffer$(255),p%,p1%  r%=IOREAD(h%,ADDR(buffer$)+1,255) IF r%<=0 : RETURN KFalse% : ENDIF POKEB ADDR(buffer$),r%  r%=1 WHILE r%<12 p%=1 IF r%=1 : p1%=KSoFiRTypeLat% ELSEIF r%=2 : p1%=KSoFiRTypeLonN% ELSEIF r%=3 : p1%=KSoFiRTypeLonS% ELSEIF r%=4 : p1%=KSoFiRTypeLonC% ELSEIF r%=5 : p1%=KSoFiRTypeTimeN% ELSEIF r%=6 : p1%=KSoFiRTypeTimeS% ELSEIF r%=7 : p1%=KSoFiRTypeTimeC% ELSEIF r%=8 : p1%=KSoFiRTypeSunAlt% ELSEIF r%=9 : p1%=KSoFiRTypeSunAz% ELSEIF r%=10 : p1%=KSoFiRTypePWidth% ELSEIF r%=11 : p1%=KSoFiRTypeDuration% ENDIF WHILE p%<=rtypes% IF PEEKW(artype&+(p%-1)*2)=p1% : BREAK : ENDIF p%=p%+1 ENDWH IF p%<=rtypes% POKE$ arec&+(r%-1)*(slen%+1),SubString$:(buffer$,p%) ELSE POKE$ arec&+(r%-1)*(slen%+1),"" ENDIF r%=r%+1 ENDWH RETURN KTrue%ENDPREM *** GPS and the SunEclipse ***REM *** THE Tool - (reason for writing this program!) ***REM Computes distances and times to/in total path.PROC SunEclipse:(enterpos%) LOCAL h%,r%,buffer$(255),file$(255),file2$(255) LOCAL rec1(11),rec1$(11,11),rec2(11),rec2$(11,11) LOCAL lat,long,height,time,p%,p1%,pl%,lat$(15),lon$(15) LOCAL px,py,px1,py1,px2,py2,d1,d2,d3,d4,d5,d6,v LOCAL d1o,d2o,d3o,R,lx,ly,t,t2,alm%,lastalm% LOCAL year%,mon%,day%,hour%,min%,sec%,flg1%,flg2% LOCAL id1&,id2&,id3&,radius,maxtime,dd&,ftime LOCAL bitid%,winid%,city$(100),country$(100) LOCAL rtype$(50),rtype%(11),rtypes%  alm%=0 file$=LastSunEclFile$ DO DO  IF enterpos% dINIT "Sun Eclipse",17 dTEXT "Datafile",ExtractFile$:(file$) dTEXT " "," " dTEXT "","",$800 dTEXT " "," " dEDIT lat$,"Latitude",10 dEDIT lon$,"Longitude",10 dFLOAT height,"Altitude (in m)",-10000,10000 dTEXT ""," " ELSE dINIT "Sun Eclipse" dTEXT "Datafile",ExtractFile$:(file$) dCHOICE alm%,"Alarm","None,Center reached,Zone reached,All" ENDIF  IF enterpos% dBUTTONS " Change datafile"+KDots$+" ",%F," Select waypoint"+KDots$+" ",%W,"Cancel",-(27+$100),"Compute",13+$100 ELSE dBUTTONS " Change datafile"+KDots$+" ",%F," Cancel ",-(27+$100),"Okay",13+$100 ENDIF Lock:(KLock%) : r%=DIALOG : Lock:(KUnlock%) IF r%=%w REM read location from database IF LocationFromDatabase%:(KTrue%,ADDR(city$),ADDR(country$),ADDR(lat),ADDR(long))>0 lat$=FormatStr_Latitude$:(lat,KTrue%) lon$=FormatStr_Longitude$:(long,KTrue%) ENDIF ELSEIF r%=%f IF UseFastFileDialog% file2$=FileDialog$:("Select datafile"+KDots$,file$,KFalse%,"",&0) IF file2$<>"" : file$=file2$ : ENDIF ELSE file2$=file$ Busy:("Building file list"+KDots$,1) dINIT "Select datafile"+KDots$ dFILE file2$,"Datafile,Folder,Disk",16+UseSystemFolder& dBUTTONS " Cancel ",-(27+$100),"Okay",13+$100 Busy:(KBusyOff$,0) Lock:(KLock%) : r%=DIALOG : Lock:(KUnlock%) IF r%=13 : file$=file2$ : ENDIF r%=0 ENDIF ELSEIF r%<>13 : RETURN ENDIF  UNTIL r%=13 IF enterpos% lat=Val_LatLonStr:(lat$,KTrue%,KTrue%) IF lat>-1000 long=Val_LatLonStr:(lon$,KFalse%,KTrue%) ENDIF ENDIF UNTIL (NOT enterpos%) OR (lat>-1000 AND long>-1000) LastSunEclFile$=file$  winid%=gCreateWindow%:(MAX(screen_xsize%/2-260,0),MAX(screen_ysize%/2-110,0),520,220,"Sun eclipse computation") IF winid%<0 : RETURN : ENDIF ONERR noload:: bitid%=gLOADBIT(MyDir$+SPicFile3$,0) ONERR off gUSE winid% : gAT 15,35 : gCOPY bitid%,0,0,100,100,3 gCLOSE bitid% GOTO isload::noload:: ONERR off ShortMessagePrompt:("Reading resource file","Resource file (MBM) not found.")isload:: IF NOT enterpos% gFONT 10 : gSTYLE 0 gAT 130,112 : gPRINT "Time of fix" ENDIF gFONT 11 : gSTYLE 0 gAT 130,55 : gPRINT "Location:" gAT 130,135 : gPRINT "Inside of the zone:" gAT 15,160 : gPRINT "Dist. to N-border:" gAT 15,180 : gPRINT "Dist. to center:" gAT 15,200 : gPRINT "Dist. to S-border:" gAT 245,160 : gPRINT "Time of maximum:" gAT 245,180 : gPRINT "Duration on center line:" gAT 245,200 : gPRINT "D. on current location:"  lastalm%=KFalse% DO  IF NOT enterpos% IF NOT ReadCurrentPosition%:(ADDR(lat),ADDR(long),ADDR(height),ADDR(time),KTrue%) gCLOSE winid% RETURN ENDIF IF lat=KMaxFloat Busy:("Location temporary not available",1) IF KEY=27 : BREAK : ENDIF CONTINUE ENDIF ENDIF  DO r%=IOOPEN(h%,file$,$0420) IF r% IF NOT ErrorMessage%:("Open data file",r%,KTrue%) gCLOSE winid% RETURN ENDIF ENDIF UNTIL r%=0 r%=IOREAD(h%,ADDR(buffer$)+1,255) IF r%<=0 ShortMessagePrompt:("Reading data file","No datas found.") IOCLOSE(h%) gCLOSE winid% RETURN ENDIF  REM read datum of sofi POKEB ADDR(buffer$),r% year%=VAL(LEFT$(buffer$,4)) mon% =VAL(MID$(buffer$,6,2)) day% =VAL(MID$(buffer$,9,2))  IF NOT ReadSunEclipseDataFormats%:(h%,ADDR(rtype%(1)),ADDR(rtypes%)) IOCLOSE(h%) gCLOSE winid% RETURN ENDIF  flg1%=KFalse% : flg2%=KFalse% Busy:("Computing"+KDots$,1) long=-long : REM I use inverse signs of longitude DO IF NOT ReadSunEclipseNextDataLine%:(h%,rtypes%,ADDR(rtype%(1)),ADDR(rec1$(1)),11) BREAK ENDIF IF rec1$(1)="" OR rec1$(2)="" OR rec1$(3)="" OR rec1$(4)="" OR rec1$(7)="" OR rec1$(11)="" Busy:(KBusyOff$,0) ShortMessagePrompt:("Sun Eclipse","Error: Not all needed datas in file.") IOCLOSE(h%) gCLOSE winid% RETURN ENDIF rec1(1)=VAL(LEFT$(rec1$(1),3))+VAL(MID$(rec1$(1),5,4))/60 IF RIGHT$(rec1$(1),1)="W" : rec1(1)=-rec1(1) : ENDIF rec1(2)=VAL(LEFT$(rec1$(2),2))+VAL(MID$(rec1$(2),4,5))/60 IF RIGHT$(rec1$(2),1)="S" : rec1(2)=-rec1(2) : ENDIF rec1(3)=VAL(LEFT$(rec1$(3),2))+VAL(MID$(rec1$(3),4,5))/60 IF RIGHT$(rec1$(3),1)="S" : rec1(3)=-rec1(3) : ENDIF rec1(4)=VAL(LEFT$(rec1$(4),2))+VAL(MID$(rec1$(4),4,5))/60 IF RIGHT$(rec1$(4),1)="S" : rec1(4)=-rec1(4) : ENDIF IF rec1$(5)<>"" : rec1(5)=VAL(LEFT$(rec1$(5),2))+VAL(MID$(rec1$(5),4,2))/60+VAL(MID$(rec1$(5),7,2))/3600 : ENDIF IF rec1$(6)<>"" : rec1(6)=VAL(LEFT$(rec1$(6),2))+VAL(MID$(rec1$(6),4,2))/60+VAL(MID$(rec1$(6),7,2))/3600 : ENDIF IF rec1$(7)<>"" : rec1(7)=VAL(LEFT$(rec1$(7),2))+VAL(MID$(rec1$(7),4,2))/60+VAL(MID$(rec1$(7),7,2))/3600 : ENDIF IF rec1$(8)<>"" : rec1(8)=VAL(rec1$(8)) : ENDIF IF rec1$(9)<>"" : rec1(9)=VAL(rec1$(9)) : ENDIF IF rec1$(10)<>"" : rec1(10)=VAL(rec1$(10)) : ENDIF IF rec1$(11)<>"" : rec1(11)=VAL(LEFT$(rec1$(11),2))+VAL(MID$(rec1$(11),4,4))/60 : ENDIF IF rec1(1)>long : flg2%=KTrue% : BREAK : ENDIF flg1%=KTrue%  p%=1 DO rec2(p%)=rec1(p%) : p%=p%+1 : UNTIL p%=12  UNTIL KFalse% IOCLOSE(h%)  Busy:(KBusyOff$,0) IF NOT flg1% OR NOT flg2% ShortMessagePrompt:("Sun Eclipse","You are not in the near area.") gCLOSE winid% RETURN ENDIF REM compute distances to center line and path borders R=KMeanEarthRadius+height px=long : py=lat px1=rec1(1) : py1=rec1(2) px2=rec2(1) : py2=rec2(2) d1=DistPointLine:(py,px,py1,px1,py2,px2,R) py1=rec1(4) py2=rec2(4) d2=DistPointLine:(py,px,py1,px1,py2,px2,R) py1=rec1(3) py2=rec2(3) d3=DistPointLine:(py,px,py1,px1,py2,px2,R)  gVISIBLE on gSTYLE 1 gAT 270,55 : gPRINTB FormatStr_Latitude$:(lat,KTrue%),200 gAT 270,75 : gPRINTB FormatStr_Longitude$:(-long,KTrue%),200 gAT 270,95 : gPRINTB FormatStr_Distance$:(height,KTrue%)+" about MSL",200 IF NOT enterpos% gAT 270,112 : gFONT 10 : gSTYLE 1 gPRINTB FormatStr_Time$:(values(1),utc_offs&,ADDR(dd&)),150 gFONT 11 : gSTYLE 1 ENDIF gAT 270,135  flg1%=(d1*d2<0 OR d1*d3<0 OR d2*d3<0) IF flg1% : gPRINTB "YES",50 ELSE : gPRINTB "NO",50 ENDIF gAT 145,160 : gPRINTB FormatStr_Distance$:(ABS(d1),KFalse%),80 gAT 145,180 : gPRINTB FormatStr_Distance$:(ABS(d2),KFalse%),80 gAT 145,200 : gPRINTB FormatStr_Distance$:(ABS(d3),KFalse%),80 IF flg1% IF d1*d2<=0 : radius=ABS(d1)+ABS(d2) ELSE : radius=ABS(d3)+ABS(d2) :ENDIF t=SQR(radius*radius-d2*d2)/radius  py1=rec1(4) : py2=rec2(4) d4=SphericalDistance:(py,px,py1,px1,R) d5=SQR(d4*d4-d2*d2) d4=SphericalDistance:(py1,px1,py2,px2,R) v=d5/d4 REM calculate lot, assume: lies between z1 and z2 lx=px1-(px1-px2)*v ly=py1-(py1-py2)*v REM if distance lot<->location not equal to REM distance of location to center line => lot REM not between z1 and z2 d4=SphericalDistance:(py,px,ly,lx,R) IF ABS(ABS(d2)-ABS(d4))>d2/50 : v=-v : ENDIF rec1(7) =rec1(7)-(rec1(7)-rec2(7))*v rec1(11)=rec1(11)-(rec1(11)-rec2(11))*v maxtime =rec1(11)*t  ftime=INTF(rec1(7)) ftime=ftime*10000+INT((rec1(7)-ftime)*60)*100+(rec1(7)*60-INT(rec1(7)*60))*60 gAT 410,160 : gPRINTB FormatStr_Time$:(ftime,utc_offs&,ADDR(dd&)),100 gAT 410,180 : gPRINTB FormatStr_Duration$:(rec1(11)*60),100 gAT 410,200 : gPRINTB FormatStr_Duration$:(maxtime*60),100 ELSE gAT 410,160 : gPRINTB " -",100 gAT 410,180 : gPRINTB " -",100 gAT 410,200 : gPRINTB " -",100 ENDIF IF enterpos% r%=GET%:(KFalse%) ELSE IF d1*d1o<=0 OR d2*d2o<=0 IF NOT lastalm% AND alm%>2 Alm:("BORDER OF TOTAL ZONE CROSSED") ENDIF lastalm%=KTrue% ELSEIF d3*d3o<=0 IF NOT lastalm% AND (alm%=2 OR alm%=4) Alm:("CENTER OF TOTAL ZONE CROSSED") ENDIF lastalm%=KTrue% ELSEIF ABS(d3o)>=200 AND ABS(d3)<200 IF NOT lastalm% AND (alm%=2 OR alm%=4) Alm:("CENTER OF TOTAL ZONE REACHED") ENDIF lastalm%=KTrue% ELSEIF ABS(d3o)<200 AND ABS(d3)>=200 IF NOT lastalm% AND (alm%=2 OR alm%=4) Alm:("CENTER OF TOTAL ZONE LEFT") ENDIF lastalm%=KTrue% ELSE lastalm%=KFalse%  ENDIF d1o=d1 : d2o=d2 : d3o=d3 r%=KEY%: ENDIF  UNTIL enterpos% OR (r%=27) OR CloseAppCmd% Busy:(KBusyOff$,0) gCLOSE winid%ENDPREM *** Alarm (not used in this version) ***PROC Alm:(msg$) SetForeground: : REM system.opx Busy:(KBusyOff$,0) gIPRINT msg$,1 BEEP 4,200 : PAUSE 4 BEEP 4,200 : PAUSE 4 BEEP 8,200ENDPREM *** Computes distance (in meters) of a point (lat/lon) ***REM to a line (lat1/lon1)-(lat2/lon2)PROC DistPointLine:(lat,lon,lat1,lon1,lat2,lon2,R) LOCAL a,b,c,gamma,h,det  a=SphericalDistance:(lat,lon,lat1,lon1,R) b=SphericalDistance:(lat,lon,lat2,lon2,R) c=SphericalDistance:(lat1,lon1,lat2,lon2,R) gamma=(c*c-a*a-b*b)/(-2*a*b) IF ABS(gamma)<1 : gamma=ACOS(gamma) ELSE gamma=0 ENDIF h=a*b*SIN(gamma)/c  REM compute sign for directed distance det=lat*lon1+lat1*lon2+lat2*lon-lat*lon2-lat1*lon-lat2*lon1 IF det<0 : h=-h :ENDIF  RETURN hENDPREM *** Computes distance (in meters) between 2 points ***REM (lat1/lon1) and (lat2/lon2) in a earth radius RPROC SphericalDistance:(la1,lo1,la2,lo2,R) LOCAL d,s1,s2,lat1,lon1,lat2,lon2,dlat,dlon lat1=RAD(la1) : lon1=RAD(lo1) lat2=RAD(la2) : lon2=RAD(lo2) dlat=lat1-lat2 dlon=lon1-lon2 IF SQR(dlat*dlat+dlon*dlon)>0.175 d=ACOS(SIN(lat1)*SIN(lat2)+COS(lat1)*COS(lat2)*COS(lon1-lon2)) ELSE s1=SIN(dlat/2) s2=SIN(dlon/2) d=2*ASIN(SQR(s1*s1+COS(lat1)*COS(lat2)*s2*s2)) ENDIF  RETURN d*RENDPREM *** Returns distance (in meters) between 2 points ***REM (lat1/lon1) and (lat2/lon2) in a earth radius Ra;REM al2& <- distance in earth radius RbREM al3& <- R1<>R2: direct euklidian distanceREM R1==R2: distance in earth radius RmPROC SphAndDirectDistance:(la1,lo1,la2,lo2,Ra,Rb,R1,R2,Rm,al2&,al3&) LOCAL d,s1,s2,lat1,lon1,lat2,lon2,dlat,dlon lat1=RAD(la1) : lon1=RAD(lo1) lat2=RAD(la2) : lon2=RAD(lo2) dlat=lat1-lat2 dlon=lon1-lon2 IF SQR(dlat*dlat+dlon*dlon)>0.175 d=ACOS(SIN(lat1)*SIN(lat2)+COS(lat1)*COS(lat2)*COS(lon1-lon2)) ELSE s1=SIN(dlat/2) s2=SIN(dlon/2) d=2*ASIN(SQR(s1*s1+COS(lat1)*COS(lat2)*s2*s2)) ENDIF POKEF al2&,d*Rb IF R1=R2 POKEF al3&,d*Rm ELSE POKEF al3&,SQR(R1*R1+R2*R2-2*R1*R2*COS(d)) ENDIF  RETURN d*RaENDPREM *** Check, if point (lat/lon) is inside map mapnew% ***REM else return mapold%; returns 0, if no map foundPROC TestMap%:(maps%,alati&,alata&,aloni&,alona&,lat,lon,mapnew%,mapold%) LOCAL buffer$(255),file$(255),pd$(KMaxCalibPoints%,255) LOCAL plat(KMaxCalibPoints%),plon(KMaxCalibPoints%) LOCAL ppx%(KMaxCalibPoints%),ppy%(KMaxCalibPoints%) LOCAL lati(KMaxMaps%),lata(KMaxMaps%),map_sx%,map_sy% LOCAL loni(KMaxMaps%),lona(KMaxMaps%),mapnum%(KMaxMaps%) LOCAL c%,c2%,map%,pnum%,offs&,r%  c%=1 : offs&=0 WHILE c%<=maps% POKEF ADDR(lati(c%)),PEEKF(alati&+offs&) POKEF ADDR(lata(c%)),PEEKF(alata&+offs&) POKEF ADDR(loni(c%)),PEEKF(aloni&+offs&) POKEF ADDR(lona(c%)),PEEKF(alona&+offs&) offs&=offs&+8 c%=c%+1 ENDWH  IF latlata(mapnew%) OR lonlona(mapnew%) REM current location outside of the new map dINIT "Open map" dTEXT "","The location is outside of the map.",2 dBUTTONS "Cancel",-27," Maps for current location"+KDots$+" ",13 Lock:(KLock%) : r%=DIALOG : Lock:(KUnlock%) IF r%=13 Busy:("Building map list"+KDots$,1) dINIT "Open map" c%=1 : c2%=0 : map%=1 : buffer$="" WHILE c%<=maps% IF NOT (latlata(c%) OR lonlona(c%)) IF buffer$<>"" dCHOICE map%,"Mapname",buffer$+",..." ENDIF c2%=c2%+1 mapnum%(c2%)=c% IF c%=mapold% : map%=c2% : ENDIF IF NOT GetMapRecord%:(c%,MyDir$+SMapFolder$+SMapCalibFile$,ADDR(file$),ADDR(buffer$),ADDR(map_sx%),ADDR(map_sy%),ADDR(pnum%),ADDR(ppx%(1)),ADDR(ppy%(1)),ADDR(plat(1)),ADDR(plon(1)),ADDR(pd$(1))) RETURN 0 ENDIF ENDIF c%=c%+1 ENDWH Busy:(KBusyOff$,0) IF buffer$="" ShortMessagePrompt:("Open map","No map of this area found.") RETURN 0 ENDIF  dCHOICE map%,"Mapname",buffer$ dBUTTONS " Cancel ",-(27+$100),"Okay",13+$100 Lock:(KLock%) : r%=DIALOG : Lock:(KUnlock%) IF r%=13 RETURN mapnum%(map%) ELSE RETURN 0 ENDIF ELSE RETURN 0 ENDIF ENDIF RETURN mapnew%ENDPREM **** Draws the cursor into the current map/drawable ***PROC DrawMapCursor:(x%,y%,xsize%,ysize%) VECTOR MapCursorMask% pmode1,pmode2,pmode3,pmode4,pmode5 ENDV gIPRINT "Draw Cursor: Unsupported cursor!",1 MapCursorMask%=1 PAUSE 10pmode1:: gAT 0,y% : gLINETO xsize%-1,y% gAT x%,0 : gLINETO x%,ysize%-1 RETURNpmode2:: gAT x%,y% : gCIRCLE 10 : gCIRCLE 3 gAT x%,y%-10 : gLINETO x%,0 gAT x%-10,y% : gLINETO 0,y% gAT x%,y%+10 : gLINETO x%,ysize% gAT x%+10,y% : gLINETO xsize%,y% RETURNpmode3:: gAT x%,y%-20 : gLINEBY 0,40 gAT x%-20,y% : gLINEBY 40,0 gAT x%-1,y%-15 : gLINEBY 0,30 gAT x%-15,y%-1 : gLINEBY 30,0 gAT x%+1,y%-15 : gLINEBY 0,30 gAT x%-15,y%+1 : gLINEBY 30,0 RETURNpmode4:: gAT x%-20,y%-20 : gLINEBY 40,40 gAT x%-20,y%+20 : gLINEBY 40,-40 gAT x%-20,y%-19 : gLINEBY 39,39 gAT x%-20,y%+19 : gLINEBY 39,-39 gAT x%-19,y%-20 : gLINEBY 39,39 gAT x%-19,y%+20 : gLINEBY 39,-39 RETURNpmode5:: gAT x%,y% : gCIRCLE 16 : gCIRCLE 6 gAT x%,y%-20 : gLINEBY 0,40 gAT x%-20,y% : gLINEBY 40,0 gAT x%-1,y%-20 : gLINEBY 0,40 gAT x%-20,y%-1 : gLINEBY 40,0 RETURNENDPREM *** The full functionallity for showing maps, ***REM add overlays, drawing routes, showing positionREM computing distances, ...REM *************************************************REM enterpos%=KTrue% -> user has to enter a location,REM which will be shown, else currentREM GPS location si usedREM tracking%=KTrue% -> Tracking modusREM rnum%>0 -> rlati,...,arheight contain a track,REM which will be shownREM mlat>90 -> shows the given Track on a SA-distance mapPROC RealMap:(enterpos%,tracking%,rnum%,rlati,rlata,rloni,rlona,arlat&,arlon&,artime&,arheight&,mlat,mlon,mheight) LOCAL mapdesc$(255),pnum%,pd$(KMaxCalibPoints%,255) LOCAL mapdescd$(255),pnumd%,pdummy(KMaxCalibPoints%) LOCAL plat(KMaxCalibPoints%),plon(KMaxCalibPoints%) LOCAL ppx%(KMaxCalibPoints%),ppy%(KMaxCalibPoints%) LOCAL dir1$(5),dir2$(5),inf&(48),offs%(6),x0%,y0%,k& LOCAL lati(KMaxMaps%),lata(KMaxMaps%),Track_desc$(255) LOCAL loni(KMaxMaps%),lona(KMaxMaps%),mapsol(KMaxMaps%) LOCAL Track_lat(KMaxTrackPoints%),Track_lon(KMaxTrackPoints%) LOCAL Track_height(KMaxTrackPoints%),Track_time(KMaxTrackPoints%) LOCAL file$(255),buffer$(255),c%,r%,h%,src% LOCAL Tracktime&,lasttime&,curtime&,newTrackpos% LOCAL map%,adaptmap%,oldmap%,adumm&,distmap% LOCAL map_id%,id%,map_sx%,map_sy%,flg%,col% LOCAL px%,py%,px_old%,py_old%,dpx%,dpy%,clat$(15),clon$(15) LOCAL lat,lon,lat1,lon1,clat,clon,height,time,sol,solmax LOCAL maps%,scaleid%,scaleon%,eventstat%,event&(16),eventrun% LOCAL dist,dist2,xptr%,yptr%,map_sxd%,map_syd%,init%,r_old%  LOCAL Track_num%,lati0,lata0,loni0,lona0,heighton%,heightid% LOCAL Track_lati,Track_lata,Track_loni,Track_lona,height_old LOCAL aoff&,cTrackpos%,city$(100),country$(100),yieldc%  distmap%=NOT (ABS(mlat)>90 OR ABS(mlon)>180)  IF rnum%>0 REM mode: draw route/track Track_num%=MIN(rnum%,KMaxTrackPoints%) cTrackpos%=1 c%=1 WHILE c%<=Track_num% Track_lat(c%) =PEEKF(arlat&+aoff&) Track_lon(c%) =PEEKF(arlon&+aoff&) Track_time(c%) =PEEKF(artime&+aoff&) Track_height(c%)=PEEKF(arheight&+aoff&) c%=c%+1 aoff&=aoff&+8 ENDWH Track_lati=rlati : Track_lata=rlata Track_loni=rloni : Track_lona=rlona ENDIF  IF distmap% maps%=0 : map%=2 : col%=2 GOTO nomaps:: ENDIF  init%=KTrue% : maps%=0 DO DO map%=1 IF NOT GetMapRecord%:(map%,MyDir$+SMapFolder$+SMapCalibFile$,ADDR(file$),ADDR(buffer$),ADDR(map_sx%),ADDR(map_sy%),ADDR(pnum%),ADDR(ppx%(1)),ADDR(ppy%(1)),ADDR(plat(1)),ADDR(plon(1)),ADDR(pd$(1))) ShortMessagePrompt:("Location on map","No maps registered.") RETURN ENDIF Busy:("Building map list"+KDots$,1)  IF enterpos% dINIT "Location on map",17 dEDIT clat$,"Latitude",10 dEDIT clon$,"Longitude",10 dTEXT ""," " ELSEIF tracking% dINIT "Track" dEDIT Track_desc$,"Track description",15 dLONG Tracktime&,"Steps of measurements (sec)",0,3600 lasttime&=-1 : newTrackpos%=KFalse% ELSEIF rnum%>0 dINIT "Show route" ELSE  dINIT "Location on map" ENDIF  DO IF maps%=KMaxMaps% Busy:("Limit of maps reached - Press Enter",1) GET Busy:(KBusyOff$,0) BREAK ENDIF  IF init%  IF NOT CalibDatasOK%:(map_sx%,map_sy%,pnum%,ADDR(ppx%(1)),ADDR(ppy%(1)),ADDR(plat(1)),ADDR(plon(1))) Busy:(KBusyOff$,0) dINIT "Map '"+buffer$+"'" dTEXT "","Contains bad calibration datas.",2 dTEXT "","Please, change its registration.",2 dBUTTONS " Okay ",13+$100 Lock:(KLock%) : DIALOG : Lock:(KUnlock%) RETURN ENDIF  maps%=maps%+1 ConvPixel2Location%:(0,0,pnum%,ADDR(ppx%(1)),ADDR(ppy%(1)),ADDR(plat(1)),ADDR(plon(1)),ADDR(lat),ADDR(lon)) ConvPixel2Location%:(map_sx%-1,map_sy%-1,pnum%,ADDR(ppx%(1)),ADDR(ppy%(1)),ADDR(plat(1)),ADDR(plon(1)),ADDR(lat1),ADDR(lon1))  lati(maps%)=MIN(lat,lat1) lata(maps%)=MAX(lat,lat1) loni(maps%)=MIN(lon,lon1) lona(maps%)=MAX(lon,lon1) mapsol(maps%)=FLT(map_sx%)*map_sy%/ABS(lat1-lat)/ABS(lon1-lon) ENDIF dCHOICE map%,"Map",buffer$+",..." map%=map%+1  UNTIL NOT GetMapRecord2%:(map%,MyDir$+SMapFolder$+SMapCalibFile$,ADDR(file$),ADDR(buffer$),ADDR(map_sx%),ADDR(map_sy%),ADDR(pnum%),ADDR(ppx%(1)),ADDR(ppy%(1)),ADDR(plat(1)),ADDR(plon(1)),ADDR(pd$(1))) init%=KFalse%  IF tracking% OR rnum%>0 dCHOICE map%,"Map","(automatic),(none)" ELSE dCHOICE map%,"Map","(automatic)" ENDIF col%=4 dCHOICE col%,"Color mode","2 colors,4 colors,16 colors,(automatic)" IF enterpos% dBUTTONS " Select waypoint"+KDots$+" ",%W,"Cancel",-(27+$100),"Show",13+$100 ELSE dBUTTONS " Cancel ",-(27+$100),"Start",13+$100 ENDIF Busy:(KBusyOff$,0) Lock:(KLock%) : r%=DIALOG : Lock:(KUnlock%)  IF r%=%w REM read location from database IF LocationFromDatabase%:(KTrue%,ADDR(city$),ADDR(country$),ADDR(clat),ADDR(clon))>0 clat$=FormatStr_Latitude$:(clat,KTrue%) clon$=FormatStr_Longitude$:(clon,KTrue%) ENDIF ELSEIF r%<>13 : RETURN ENDIF  UNTIL r%=13 nomaps::  IF enterpos% clat=Val_LatLonStr:(clat$,KTrue%,KTrue%) IF clat>-1000 clon=Val_LatLonStr:(clon$,KFalse%,KTrue%) ENDIF ELSEIF rnum%>0 IF distmap% clat=mlat clon=mlon height=mheight ELSE clat=Track_lat(1) clon=Track_lon(1) height=Track_height(1) ENDIF ENDIF  UNTIL (NOT enterpos%) OR (clat>-1000 ANDclon>-1000) adaptmap%=(map%=maps%+1) IF NOT adaptmap% IF map%=maps%+2 map%=0 ELSEIF enterpos% map%=TestMap%:(maps%,ADDR(lati(1)),ADDR(lata(1)),ADDR(loni(1)),ADDR(lona(1)),clat,clon,map%,map%) IF map%=0 : RETURN : ENDIF ENDIF ELSE map%=-1 ENDIF oldmap%=-2 col%=col%-1 ClearScreen:  gUSE 1 : gCOLOR $55,$55,$55 : gAT 0,0 : gFILL screen_xsize%,screen_ysize%,0 id%=0 : map_id%=0 px_old%=-1  ONERR nocr:: scaleon%=KTrue% scaleid%=gCREATE(0,0,170,35,0,0) scaleon%=KFalse% heightid%=gCREATE(0,0,50,200,0,0) heighton%=KFalse% ONERR off GOTO iscr::nocr:: ONERR off IF scaleon% : gCLOSE scaleid% : ENDIF RefreshScreen: ErrorMessage%:("Creating bitmaps",ERR,KFalse%) RETURN iscr:: pdummy(1)=1 pdummy(2)=2 menuinit2%=0 : adumm&=ADDR(pdummy(1))  IF NOT enterpos% AND rnum%=0 Busy:("Clearing buffer"+KDots$,1) ClearPortBuffer: Busy:(KBusyOff$,0) ENDIF  GETEVENTA32 eventstat%,event&() eventrun%=KTrue%  DO  yieldc%=1 IF map%=oldmap% AND NOT distmap% IF px_old%<>px% OR py_old%<>py% OR (heighton% AND height<>height_old) IF px_old%>=0 DrawMapCursor:(px_old%,py_old%,map_sx%,map_sy%) IF tracking% AND newTrackpos% gGMODE 0 gAT px_old%,py_old% : gLINETO px%,py% gGMODE 2 newTrackpos%=KFalse% ENDIF ENDIF DrawMapCursor:(px%,py%,map_sx%,map_sy%) ENDIF IF px%<>px_old% OR py%<>py_old% OR (height<>height_old AND heighton%) OR (NOT enterpos% AND rnum%=0) IF px%screen_ysize%-30: r%=3 : ELSE r%=1 : ENDIF IF heighton% IF height=KMaxFloat gIPRINT "("+FormatStr_Latitude$:(clat,KTrue%)+";"+FormatStr_Longitude$:(clon,KTrue%)+";???)",r% ELSE gIPRINT "("+FormatStr_Latitude$:(clat,KTrue%)+";"+FormatStr_Longitude$:(clon,KTrue%)+";"+FormatStr_Distance$:(height,KTrue%)+")",r% ENDIF ELSE gIPRINT "("+FormatStr_Latitude$:(clat,KTrue%)+";"+FormatStr_Longitude$:(clon,KTrue%)+")",r% ENDIF ENDIF px_old%=px% py_old%=py% height_old=height ENDIF   IF NOT enterpos% AND rnum%=0 IF NOT ReadCurrentPosition%:(ADDR(lat),ADDR(lon),ADDR(height),ADDR(time),KFalse%) lat=KMaxFloat ENDIF IF lat=KMaxFloat OR lon=KMaxFloat IF id%=0 IF eventrun% REM during dialogs no asyn. getevent allowed IOYIELD IF eventstat%<0 : GETEVENTC(eventstat%) : ENDIF eventrun%=KFalse% ENDIF  ShortMessagePrompt:("Reading location","Currently no location available.") IF (NOT enterpos%) AND rnum%=0 : ClearPortBuffer: : ENDIF BREAK ENDIF gIPRINT "Temporary no valid location found",1 yieldc%=10 ELSE clat=lat : clon=lon IF tracking% IF Tracktime&>0 curtime&=DATETOSECS(YEAR,MONTH,DAY,HOUR,MINUTE,SECOND) ENDIF IF Tracktime&=0 OR lasttime&=-1 OR curtime&-lasttime&>=Tracktime& Track_num%=Track_num%+1 Track_lat(Track_num%)=clat Track_lon(Track_num%)=clon Track_height(Track_num%)=height Track_time(Track_num%)=time IF Track_num%=1 Track_lati=clat : Track_lata=clat Track_loni=clon : Track_lona=clon ELSE IF Track_lati>clat : Track_lati=clat : ENDIF IF Track_lataclon : Track_loni=clon : ENDIF IF Track_lona=0 REM test, if location is inside the current map IF map%=0 IF clatlata0 OR clonlona0 oldmap%=-2 ENDIF ELSE IF clatlata(map%) OR clonlona(map%) IF tracking% OR rnum%>0 map%=0 ELSEIF NOT adaptmap% IF eventrun% REM during dialogs no asyn. getevent allowed IOYIELD IF eventstat%<0 : GETEVENTC(eventstat%) : ENDIF eventrun%=KFalse% ENDIF  dINIT "Location tracking" dTEXT "","Current location outside of specified map.",2 dBUTTONS "Cancel",-27," Set adaptive ",13 Lock:(KLock%) : r%=DIALOG : Lock:(KUnlock%) IF r%=13 map%=-1 : adaptmap%=KTrue% ELSE BREAK ENDIF IF (NOT enterpos%) AND rnum%=0 : ClearPortBuffer: : ENDIF ENDIF oldmap%=-2 ENDIF ENDIF ENDIF  IF map%<>oldmap% REM read new map  IF adaptmap%  c%=1 : solmax=KMaxFloat IF oldmap%<=0 sol=0 ELSEIF map%<=0 sol=mapsol(oldmap%) ELSE sol=mapsol(map%) ENDIF map%=0 WHILE c%<=maps%  IF (NOT (clatlata(c%) OR clonlona(c%))) AND (ABS(mapsol(c%)-sol)0 dBUTTONS "Abort",-27," Use no map ",13 ELSE dBUTTONS " Okay ",13+$100 ENDIF Lock:(KLock%) : r%=DIALOG : Lock:(KUnlock%) IF r%<>13 OR (NOT tracking% AND rnum%=0) BREAK ENDIF IF (NOT enterpos%) AND rnum%=0 : ClearPortBuffer: : ENDIF GETEVENTA32 eventstat%,event&() map%=0 : adaptmap%=KFalse% ENDIF ENDIF gUSE scaleid% gVISIBLE off scaleon%=KFalse% gUSE heightid% gVISIBLE off heighton%=KFalse%  IF id% : gCLOSE id% : ENDIF id%=0 IF (tracking% OR rnum%>0) AND map%=0 AND NOT adaptmap% map_sx%=638 : map_sy%=238 : c%=0 IF Track_lati=Track_lata AND Track_loni=Track_lona REM after first location measurement lati0=Track_lati-0.004 lata0=Track_lata+0.004 loni0=Track_loni-0.004 lona0=Track_lona+0.004 ELSE IF rnum%=0 lata0=0.008 WHILE (Track_lata-Track_lati)*1.5>lata0 : lata0=lata0*1.5 : ENDWH lona0=0.008 WHILE (Track_lona-Track_loni)*1.5>lona0 : lona0=lona0*1.5 : ENDWH ELSE lata0=(Track_lata-Track_lati)*1.1 lona0=(Track_lona-Track_loni)*1.1 ENDIF lati0=(Track_lata+Track_lati)/2-lata0/2 lata0=(Track_lata+Track_lati)/2+lata0/2 loni0=(Track_lona+Track_loni)/2-lona0/2 lona0=(Track_lona+Track_loni)/2+lona0/2 ENDIF dist=SphericalDistance:(lati0,loni0,lata0,loni0,KMeanEarthRadius) dist2=SphericalDistance:(lati0,loni0,lati0,lona0,KMeanEarthRadius) IF dist/dist2>238.0/638.0 dist2=(dist*638.0/238.0)/dist2 loni0=(Track_lona+Track_loni)/2-((Track_lona+Track_loni)/2-loni0)*dist2 lona0=(Track_lona+Track_loni)/2+(lona0-(Track_lona+Track_loni)/2)*dist2 ELSE dist=(dist2*238.0/638.0)/dist lati0=(Track_lata+Track_lati)/2-((Track_lata+Track_lati)/2-lati0)*dist lata0=(Track_lata+Track_lati)/2+(lata0-(Track_lata+Track_lati)/2)*dist ENDIF ELSE   IF NOT GetMapRecord%:(map%,MyDir$+SMapFolder$+SMapCalibFile$,ADDR(file$),ADDR(mapdesc$),ADDR(map_sx%),ADDR(map_sy%),ADDR(pnum%),ADDR(ppx%(1)),ADDR(ppy%(1)),ADDR(plat(1)),ADDR(plon(1)),ADDR(pd$(1))) BREAK ENDIF Busy:("Reading map"+KDots$,1) ONERR noload:: map_id%=gLOADBIT(file$,0) ONERR off Busy:(KBusyOff$,0)  GOTO isload::noload:: ONERR off Busy:(KBusyOff$,0) IF eventrun% REM during dialogs no asyn. getevent allowed IOYIELD IF eventstat%<0 : GETEVENTC(eventstat%) : ENDIF eventrun%=KFalse% ENDIF  ErrorMessage%:("Reading Map",ERR,KFalse%) BREAKisload::  ENDIF  IF col%>2 gINFO32 inf&() c%=inf&(30) AND $000F ELSE c%=col% ENDIF  ONERR nocr2:: id%=gCREATE(0,0,map_sx%,map_sy%,0,c%) ONERR off GOTO iscr2::nocr2:: ONERR off IF eventrun% REM during dialogs no asyn. getevent allowed IOYIELD IF eventstat%<0 : GETEVENTC(eventstat%) : ENDIF eventrun%=KFalse% ENDIF  ErrorMessage%:("Creating bitmap",ERR,KFalse%) BREAKiscr2:: gUSE id% IF map%<>0 AND map_id%<>0 gCOPY map_id%,0,0,map_sx%,map_sy%,3 gCLOSE map_id% : map_id%=0 ENDIF  IF tracking% OR rnum%>0 Busy:("Drawing route"+KDots$,1) IF distmap% dist=SphericalDistance:(lati0,loni0,lati0,lona0,KMeanEarthRadius) px%=map_sx%-(mlon-loni0)*map_sx%/(lona0-loni0) py%=map_sy%-(mlat-lati0)*map_sy%/(lata0-lati0) gGMODE 0 : gCOLOR 160,160,160 r%=INTF(LOG(dist)) IF r%<1 : r%=r%-1 : ENDIF sol=INTF(10)**INTF(r%) dist2=INTF(dist/sol) WHILE dist2>0 gGMODE modulo%:(INT(dist2),2) gAT px%,py% : gCIRCLE (dist2*sol)/dist*map_sx%,KTrue% dist2=dist2-1 ENDWH gFONT KFontCourierNormal8& gCOLOR 0,0,0 IF px%<=map_sx%/2 dpx%=px%+sol/dist*map_sx%-gTWIDTH(FormatStr_Distance$:(sol,KFalse%))/2 ELSE dpx%=px%-sol/dist*map_sx%-gTWIDTH(FormatStr_Distance$:(sol,KFalse%))/2 ENDIF IF py%<=200 dpy%=py%+10 ELSE dpy%=py%-2 ENDIF gAT dpx%,dpy% : gPRINT FormatStr_Distance$:(sol,KFalse%) gGMODE 2 gAT px%,0 : gLINETO px%,map_sy% gAT 0,py% : gLINETO map_sx%,py% ENDIF gGMODE 0  IF map%=0 DrawTrack:(map_sx%,map_sy%,lati0,lata0,loni0,lona0,Track_num%,ADDR(Track_lat(1)),ADDR(Track_lon(1)),ADDR(Track_height(1)),ADDR(Track_time(1)),ADDR(dpx%),ADDR(dpy%),(rnum%>0)) ELSE DrawTrack:(map_sx%,map_sy%,lati(map%),lata(map%),loni(map%),lona(map%),Track_num%,ADDR(Track_lat(1)),ADDR(Track_lon(1)),ADDR(Track_height(1)),ADDR(Track_time(1)),ADDR(dpx%),ADDR(dpy%),(rnum%>0)) ENDIF IF tracking% px_old%=dpx% : py_old%=dpy% gGMODE 2 DrawMapCursor:(px_old%,py_old%,map_sx%,map_sy%) ELSE px_old%=-1 ENDIF Busy:(KBusyOff$,0) ELSE px_old%=-1 ENDIF gORDER id%,1 gVISIBLE on oldmap%=map% ENDIF  IF (tracking% OR rnum%>0) AND map%=0 AND NOT adaptmap% px%=map_sx%-(clon-loni0)/(lona0-loni0)*map_sx% py%=map_sy%-(clat-lati0)/(lata0-lati0)*map_sy% ELSE ConvLocation2Pixel%:(clat,clon,map_sx%,map_sy%,pnum%,ADDR(ppx%(1)),ADDR(ppy%(1)),ADDR(plat(1)),ADDR(plon(1)),ADDR(px%),ADDR(py%)) ENDIF  IF map_sx%<=screen_xsize% x0%=screen_xsize%/2-map_sx%/2 ELSE x0%=MAX(MIN(screen_xsize%/2-px%,0),screen_xsize%-map_sx%) ENDIF IF map_sy%<=screen_ysize% y0%=screen_ysize%/2-map_sy%/2 ELSE y0%=MAX(MIN(screen_ysize%/2-py%,0),screen_ysize%-map_sy%) ENDIF gSETWIN x0%,y0% gGMODE 2  DO IOYIELD PAUSE 1 yieldc%=yieldc%-1 UNTIL yieldc%<=0 OR eventstat%>=0  IF eventstat%>=0 eventrun%=KFalse% k&=event&(KEvaType%)  r%=0 IF event&(1)=$404 IF GETCMD$="X" CloseAppCmd%=KTrue% BREAK ENDIF ELSEIF (k&=10003 or k&=10004) AND map%=0 REM zoom-sidebar-button gIPRINT "Zoom not available",1  ELSEIF (k&=10003 or k&=10004) AND map%<>0 IF k&=10003 : r%=%i ELSE r%=%u ENDIF  ELSEIF k&=KEvPtr& AND event&(KEvAPtrType%)=KEvPtrPenUp& REM pointer event xptr%=event&(KEvAPtrScreenPosX%)-x0% yptr%=event&(KEvAPtrScreenPosY%)-y0% IF (tracking% OR rnum%>0) AND map%=0 lat=FLT(map_sy%-yptr%)*(lata0-lati0)/map_sy%+lati0 lon=FLT(map_sx%-xptr%)*(lona0-loni0)/map_sx%+loni0 ELSE ConvPixel2Location%:(xptr%,yptr%,pnum%,ADDR(ppx%(1)),ADDR(ppy%(1)),ADDR(plat(1)),ADDR(plon(1)),ADDR(lat),ADDR(lon)) ENDIF  IF enterpos% AND MapPenAction%=2 REM set as current clat=lat : clon=lon ELSEIF MapPenAction%=3 REM set as waypoint NewWaypoint:(lat,lon,KMaxFloat) ELSE REM compute distance  dist=SphericalDistance:(clat,clon,lat,lon,KMeanEarthRadius) dINIT "Spherical Distance" IF enterpos% dTEXT "Entered location",FormatStr_Latitude$:(clat,KTrue%) ELSE dTEXT "Current location",FormatStr_Latitude$:(clat,KTrue%) ENDIF dTEXT " ",FormatStr_Longitude$:(clon,KTrue%),$200 dTEXT "Pointed location",FormatStr_Latitude$:(lat,KTrue%) dTEXT " ",FormatStr_Longitude$:(lon,KTrue%),$200 dTEXT "Distance",FormatStr_Distance$:(dist,KFalse%) IF enterpos% dBUTTONS " Set as current ",%C+$200," New waypoint"+KDots$+" ",%W+$200,"Okay",13+$100 ELSE dBUTTONS " New waypoint"+KDots$+" ",%W+$200,"Okay",13+$100 ENDIF Lock:(KLock%) : r%=DIALOG : Lock:(KUnlock%) IF r%=%c clat=lat : clon=lon ELSEIF r%=%w NewWaypoint:(lat,lon,KMaxFloat) ENDIF r%=0 IF (NOT enterpos%) AND rnum%=0 : ClearPortBuffer: : ENDIF ENDIF  ELSEIF (k&=KKeyMenu32%) OR (k&=KKeySidebarMenu32%) REM menu button Busy:(KBusyOff$,0) c%=0 : r%=0 : h%=0 : flg%=0 IF scaleon% c%=$2000 ELSE IF heighton% r%=$2000 ELSE h%=$2000 ENDIF ENDIF mINIT mCASC " Compute distance ","To waypoint"+KDots$,17,"To map point"+KDots$,-4,"Find nearest location"+KDots$,18 IF enterpos% IF map%=0 mCARD " Map "," Open"+KDots$,%o," Save as"+KDots$+" ",%s ELSE mCARD " Map "," Open"+KDots$,%o," Save as"+KDots$+" ",-%s," Zoom in",%i," Zoom out",%u ENDIF mCARD " View "," Scale ",-(11+$0800+c%)," Draw grid"+KDots$+" ",-20," Overlay"+KDots$+" ",19 mCARD " Extras "," Change location"+KDots$,%l," Compute distance >",-31," New waypoint"+KDots$,-%w," Settings"+KDots$,-8," Close",7 ELSE IF distmap% mCARD " Map "," Save as"+KDots$+" ",-%s," Close",7 ELSE IF tracking% OR rnum%>0 IF map%=0 AND NOT adaptmap% flg%=$2000 ENDIF IF map%=0 mCARD " Map "," Open"+KDots$,%o," Save as"+KDots$+" ",-%s, " None",9+$800+flg% ELSE mCARD " Map "," Open"+KDots$,%o," Save as"+KDots$+" ",-%s, " None",-(9+$800+flg%)," Zoom in",%i," Zoom out",%u ENDIF ELSE IF map%=0 mCARD " Map "," Open"+KDots$,%o," Save as"+KDots$+" ",%s ELSE mCARD " Map "," Open"+KDots$,%o," Save as"+KDots$+" ",-%s," Zoom in",%i," Zoom out",%u ENDIF ENDIF mCARD " View "," Nothing ",10+$0900+h%," Scale",11+$0A00+c%," Altitude",-(12+$0B00+r%)," Draw grid"+KDots$+" ",-20," Overlay"+KDots$+" ",19 IF rnum%>0 mCARD " Route ","First point",13,"Last point",-14,"Previous point",15,"Next point",16 ENDIF IF tracking% mCARD " Extras "," Compute distance >",-31," New waypoint"+KDots$,-%w," Settings"+KDots$,-8," Stop and save"+KDots$+" ",6," Abort",7 ELSE mCARD " Extras "," Compute distance >",-31," New waypoint"+KDots$,-%w," Settings"+KDots$,-8," Close",7 ENDIF ENDIF ENDIF Lock:(KLock%) : r%=MENU(menuinit2%) : Lock:(KUnlock%) ELSEIF (event&(1) AND $400)=0 REM key pressed IF event&(1)=27 r%=7 ELSEIF ((event&(4) AND $4)=$4) AND ((event&(4) AND $2)=0) REM ctrl-key r%=event&(1)+%a-1 ELSEIF rnum%>0 IF event&(1)=KKeyUpArrow32% OR event&(1)=KKeyLeftArrow32% r%=15 ELSEIF event&(1)=KKeyDownArrow32% OR event&(1)=KKeyRightArrow32% r%=16 ELSEIF event&(1)=KKeyPageUp32% OR event&(1)=KKeyPageLeft32% r%=13 ELSEIF event&(1)=KKeyPageDown32% OR event&(1)=KKeyPageRight32%  r%=14 ENDIF ENDIF ENDIF  IF (r%=%o AND (enterpos% OR NOT distmap%)) OR r%=9  IF r%=9 AND map%>0 map%=0 : adaptmap%=KFalse% ELSE REM open new map Busy:("Building map list"+KDots$,1) dINIT "Open map"  c%=1 WHILE c%<=maps% IF NOT GetMapRecord%:(c%,MyDir$+SMapFolder$+SMapCalibFile$,ADDR(file$),ADDR(buffer$),ADDR(map_sxd%),ADDR(map_syd%),ADDR(pnumd%),adumm&,adumm&,adumm&,adumm&,ADDR(pd$(1))) BREAK ENDIF IF c%13 : file$="" : ENDIF ENDIF IF file$<>"" Busy:("Saving"+KDots$,1) ONERR nosave:: gSAVEBIT file$ ONERR off Busy:(KBusyOff$,0) gIPRINT "Map saved",1 PAUSE 20 GOTO aftersave::nosave:: ONERR off Busy:(KBusyOff$,0) ErrorMessage%:("Bitmap not saved",ERR,KFalse%)aftersave:: ENDIF IF (NOT enterpos%) AND rnum%=0 : ClearPortBuffer: : ENDIF  ELSEIF r%=%l AND enterpos% REM change location (only availabe in "entered-location-mode") clat$=FormatStr_Latitude$:(clat,KTrue%) clon$=FormatStr_Longitude$:(clon,KTrue%) DO Busy:("Building map list"+KDots$,1) dINIT "Enter new location" dEDIT clat$,"Latitude",10 dEDIT clon$,"Longitude",10 dTEXT ""," "  c%=1 WHILE c%<=maps% IF NOT GetMapRecord%:(c%,MyDir$+SMapFolder$+SMapCalibFile$,ADDR(file$),ADDR(buffer$),ADDR(map_sxd%),ADDR(map_syd%),ADDR(pnumd%),adumm&,adumm&,adumm&,adumm&,ADDR(pd$(1))) BREAK ENDIF dCHOICE map%,"Map",buffer$+",..." c%=c%+1 ENDWH Busy:(KBusyOff$,0) IF c%<=maps% : BREAK : ENDIF  IF adaptmap% : map%=maps%+1 : ENDIF dCHOICE map%,"Map","(automatic)" dBUTTONS " Select waypoint"+KDots$+" ",%W,"Cancel",-(27+$100),"Okay",13+$100 Lock:(KLock%) : r%=DIALOG : Lock:(KUnlock%)  IF r%=%w REM read location from database IF LocationFromDatabase%:(KTrue%,ADDR(city$),ADDR(country$),ADDR(lat),ADDR(lon))>0 clat$=FormatStr_Latitude$:(lat,KTrue%) clon$=FormatStr_Longitude$:(lon,KTrue%) ENDIF ELSEIF r%=13 lat=Val_LatLonStr:(clat$,KTrue%,KTrue%) IF lat>-1000 lon=Val_LatLonStr:(clon$,KFalse%,KTrue%) ENDIF ENDIF  UNTIL r%<>%w AND lat>-1000 AND lon>-1000 IF r%=13 adaptmap%=(map%=maps%+1) IF NOT adaptmap% map%=TestMap%:(maps%,ADDR(lati(1)),ADDR(lata(1)),ADDR(loni(1)),ADDR(lona(1)),lat,lon,map%,oldmap%) IF map%=0 map%=oldmap% ELSE clat=lat : clon=lon ENDIF ELSE  c%=1 : map%=0 WHILE c%<=maps% IF lat>=lati(c%) AND lat<=lata(c%) AND lon>=loni(c%) AND lon<=lona(c%) map%=c% BREAK ENDIF c%=c%+1 ENDWH IF map%=0 map%=oldmap% ShortMessagePrompt:("Change location and/or map","No map for entered location found.") IF (NOT enterpos%) AND rnum%=0 : ClearPortBuffer: : ENDIF ELSE clat=lat : clon=lon map%=-1 ENDIF ENDIF ELSE map%=oldmap% ENDIF  ELSEIF r%=4 REM help for distance computation dINIT "Help: Compute distances" IF MapPenAction%<>1 dTEXT "","Switch setting of 'Pen mode' to 'compute distance'!",2 dTEXT "","After this for computation of distances between the",2 ELSE dTEXT "","For computation of distances between the",2 ENDIF dTEXT "","current location and another free point of the map",2 dTEXT "","you only have to tap on this point with the pen.",2 dBUTTONS " Okay ",13+$100 Lock:(KLock%) : DIALOG : Lock:(KUnlock%) IF (NOT enterpos%) AND rnum%=0 : ClearPortBuffer: : ENDIF  ELSEIF r%=10 OR r%=11 OR r%=12 IF (enterpos% OR r%=10 OR r%=12) AND scaleon% REM scale off scaleon%=KFalse% gUSE scaleid% : gVISIBLE off IF r%=11 : r%=0 : ENDIF ELSEIF (r%=10 OR r%=11) AND heighton% AND NOT enterpos% REM height off heighton%=KFalse% gUSE heightid% : gVISIBLE off ENDIF IF (r%=11) AND NOT scaleon% REM scale on  IF (tracking% OR rnum%>0) AND map%=0 AND NOT adaptmap% lat=lati0 : lat1=lata0 lon=loni0 : lon1=lona0 ELSE lat=lati(map%) : lat1=lata(map%) lon=loni(map%) : lon1=lona(map%) ENDIF IF ABS(lat1-lat)>20 OR ABS(lon1-lon)>20 OR MAX(ABS(lat),ABS(lat1))>80 dINIT "Scale of map" dTEXT "","Map extension too large.",2 dTEXT "","Very different scales in map.",2 dBUTTONS " Okay ",13+$100 Lock:(KLock%) : DIALOG : Lock:(KUnlock%) IF (NOT enterpos%) AND rnum%=0 : ClearPortBuffer: : ENDIF ELSE scaleon%=KTrue% gUSE scaleid% gCLS gBORDER $103 gFONT 10 dist=SphericalDistance:(lat,lon,lat,lon1,KMeanEarthRadius)/(map_sx%/KPixelPerCM) gAT 7,13 IF format%(6)=1 REM metric system gPRINT "X 1cm="+FormatStr_Distance$:(dist,KFalse%)  ELSE REM british system dist=dist*2.54 gPRINT "X 1in="+FormatStr_Distance$:(dist,KFalse%) ENDIF  dist=SphericalDistance:(lat,lon,lat1,lon,KMeanEarthRadius)/(map_sy%/KPixelPerCM) gAT 7,28 IF format%(6)=1 REM metric system gPRINT "Y 1cm="+FormatStr_Distance$:(dist,KFalse%)  ELSE REM british system dist=dist*2.54 gPRINT "Y 1in="+FormatStr_Distance$:(dist,KFalse%) ENDIF gFONT 12  IF px%MapCursorMask% DrawMapCursor:(px_old%,py_old%,map_sx%,map_sy%) MapCursorMask%=c% DrawMapCursor:(px_old%,py_old%,map_sx%,map_sy%) ENDIF MapPenAction%=h% ENDIF IF (NOT enterpos%) AND rnum%=0 : ClearPortBuffer: : ENDIF  ELSEIF r%=6  IF Track_num%<=1 REM stop and save - too less points ShortMessagePrompt:("Too less points","Only tracks with more than 1 point can be saved.") IF (NOT enterpos%) AND rnum%=0 : ClearPortBuffer: : ENDIF  ELSE REM stop and save file$=LastTrackFile$ r%=LPosInStr%:("/",file$) IF r% : file$=LEFT$(file$,r%) : ENDIF IF UseFastFileDialog% IF Track_desc$="" dINIT "Save track"+KDots$ dEDIT Track_desc$,"Track description",15 dBUTTONS " Cancel ",-(27+$100),"Save",13+$100 Lock:(KLock%) : r%=DIALOG : Lock:(KUnlock%) ELSE r%=13 ENDIF IF r%=13 file$=FileDialog$:("Save track"+KDots$,file$,KTrue%,KTrackExtension$,&0) ELSE file$="" ENDIF ELSEnewfile::  Busy:("Building list"+KDots$,1) dINIT "Save track"+KDots$ dEDIT Track_desc$,"Track description",15 dFILE file$,"Filename,Folder,Disk",17+UseSystemFolder& dBUTTONS " Cancel ",-(27+$100),"Save",13+$100 Busy:(KBusyOff$,0) Lock:(KLock%) : r%=DIALOG : Lock:(KUnlock%) IF r%<>13 : file$="" : ENDIF file$=AddExtension$:(file$,KTrackExtension$) IF EXIST(file$) dINIT "File exist" dTEXT "","Overwrite '"+ExtractFile$:(file$)+"' ?",2 dBUTTONS "No",%N+$300," Yes ",%Y+$300 Lock:(KLock%) : r%=DIALOG : Lock:(KUnlock%) IF r%=%n : GOTO newfile:: : ENDIF ENDIF ENDIF IF file$<>"" file$=AddExtension$:(file$,KTrackExtension$) LastTrackFile$=file$ DO r%=IOOPEN(h%,file$,$102) IF r% IF NOT ErrorMessage%:("Open output file",r%,KTrue%) BREAK ENDIF ENDIF UNTIL r%=0 IF r%=0 ONERR saveerr:: Busy:("Saving"+KDots$,1) aoff&=INT(FLT(Track_num%)*8.0) IOWRITE(h%,ADDR(Track_desc$),256) IOWRITE(h%,ADDR(Track_num%),2) IOWRITE(h%,ADDR(Track_lat(1)),aoff&) IOWRITE(h%,ADDR(Track_lon(1)),aoff&) IOWRITE(h%,ADDR(Track_height(1)),aoff&) IOWRITE(h%,ADDR(Track_time(1)),aoff&) IOWRITE(h%,ADDR(Track_lati),8) IOWRITE(h%,ADDR(Track_lata),8) IOWRITE(h%,ADDR(Track_loni),8) IOWRITE(h%,ADDR(Track_lona),8) ONERR off IOCLOSE(h%) Busy:(KBusyOff$,0) BREAKsaveerr:: ONERR off Busy:(KBusyOff$,0) ErrorMessage%:("Save track"+KDots$,ERR,KFalse%) ENDIF IF (NOT enterpos%) AND rnum%=0 : ClearPortBuffer: : ENDIF ENDIF ENDIF  ELSEIF r%=13 OR r%=14 OR r%=15 OR r%=16  IF r%=13 : cTrackpos%=1 ELSEIF r%=14 : cTrackpos%=Track_num% ELSEIF r%=15 : cTrackpos%=MAX(cTrackpos%-1,1) ELSEIF r%=16 : cTrackpos%=MIN(cTrackpos%+1,Track_num%) ENDIF clat=Track_lat(cTrackpos%) clon=Track_lon(cTrackpos%) height=Track_height(cTrackpos%)  ELSEIF r%=17 REM distance to city r%=LocationFromDatabase%:(KTrue%,ADDR(city$),ADDR(country$),ADDR(lat),ADDR(lon)) IF r%>0 dist=SphericalDistance:(clat,clon,lat,lon,KMeanEarthRadius) dINIT "Spherical Distance to "+city$ IF enterpos% dTEXT "Entered location",FormatStr_Latitude$:(clat,KTrue%) ELSE dTEXT "Current location",FormatStr_Latitude$:(clat,KTrue%) ENDIF dTEXT " ",FormatStr_Longitude$:(clon,KTrue%),$200 IF r%=1 dTEXT "City location",FormatStr_Latitude$:(lat,KTrue%) ELSE dTEXT "Waypoint location",FormatStr_Latitude$:(lat,KTrue%) ENDIF dTEXT " ",FormatStr_Longitude$:(lon,KTrue%),$200 dTEXT "Distance",FormatStr_Distance$:(dist,KFalse%) dBUTTONS " Okay ",13+$100 Lock:(KLock%) : DIALOG : Lock:(KUnlock%) IF (NOT enterpos%) AND rnum%=0 : ClearPortBuffer: : ENDIF ENDIF  ELSEIF r%=18 REM find nearest location file$=LastWaypointFile$ IF file$<>"" IF NOT EXIST(file$) : file$="" : ENDIF ENDIF DO dINIT "Nearest known location" IF file$<>"" dTEXT "Use waypoints from:",ExtractFile$:(file$) dBUTTONS " Change file"+KDots$+" ",%F," World database"+KDots$+" ",%W,"Cancel",-(27+$100),"Compute",13+$100 ELSE dBUTTONS "Waypointfile"+KDots$,%F," World database"+KDots$+" ",%W,"Cancel",-(27+$100) ENDIF Lock:(KLock%) : r%=DIALOG : Lock:(KUnlock%) IF r%=%f buffer$=GetWaypointFile$:("Select file",KFalse%,KTrue%) IF buffer$<>"" : file$=buffer$ : ENDIF ENDIF UNTIL r%<>%f city$="" IF r%=%w IF TestOwnWldDatabase%: Busy:("Searching"+KDots$,1) city$=GetNearestCity$:(clat,clon,ADDR(country$),ADDR(lat),ADDR(lon),ADDR(dist)) Busy:(KBusyOff$,0) ENDIF ELSEIF r%=13 LastWaypointFile$=file$ Busy:("Searching"+KDots$,1) city$=GetNearestWaypoint$:(file$,clat,clon,ADDR(country$),ADDR(lat),ADDR(lon),ADDR(dist)) Busy:(KBusyOff$,0) ENDIF IF city$<>"" IF r%=13 dINIT "Nearest waypoint",16 ELSE dINIT "Nearest city",16 ENDIF IF enterpos% dTEXT "Entered location",FormatStr_Latitude$:(clat,KTrue%) ELSE dTEXT "Current location",FormatStr_Latitude$:(clat,KTrue%) ENDIF dTEXT " ",FormatStr_Longitude$:(clon,KTrue%),$200 IF r%=13 dTEXT "Nearest waypoint",city$ ELSE dTEXT "Nearest city",city$+" ("+country$+")" ENDIF dTEXT " ",FormatStr_Latitude$:(lat,KTrue%) dTEXT " ",FormatStr_Longitude$:(lon,KTrue%),$200 dTEXT "Distance",FormatStr_Distance$:(dist,KFalse%) IF enterpos% dBUTTONS " Set as current ",%C+$200," New waypoint"+KDots$+" ",%W+$200,"Okay",13+$100 ELSE dBUTTONS " New waypoint"+KDots$+" ",%W+$200,"Okay",13+$100 ENDIF Lock:(KLock%) : r%=DIALOG : Lock:(KUnlock%) IF r%=%c REM set as current clat=lat : clon=lon ELSEIF r%=%w REM new waypoint NewWaypoint:(lat,lon,KMaxFloat) ENDIF IF (NOT enterpos%) AND rnum%=0 : ClearPortBuffer: : ENDIF ELSEIF r%=13 OR r%=%w gIPRINT "No location found.",1 ENDIF  ELSEIF r%=19 dINIT "Add overlay" dCHOICE src%,"Select source","all cities,all captitals,all countries,waypoints"+KDots$ dBUTTONS " Cancel ",-(27+$100),"Add",13+$100 Lock:(KLock%) : r%=DIALOG : Lock:(KUnlock%) gGMODE 2 DrawMapCursor:(px_old%,py_old%,map_sx%,map_sy%) gGMODE 0 IF r%=13 AND src%<4 REM all cities or capitals file$=MyDir$+SWldDatabase$ IF TestOwnWldDatabase%: AND EXIST(file$) mapdescd$=file$+" SELECT name, country, latitude, longitude FROM cities" IF src%>1 mapdescd$=mapdescd$+" WHERE capital="+FIX$(KTrue%,0,10) ENDIF DO ONERR notopen:: OPEN mapdescd$,A,n$,c%,la,lo ONERR off BREAKnotopen:: ONERR off IF NOT ErrorMessage%:("Open world database",ERR,KTrue%) GOTO nooverlay:: ENDIF UNTIL KFalse% Busy:("Printing overlay"+KDots$,1) FIRST gFONT 10 : gSTYLE 0 REM here I have to use this bad jumping REM because in a real while loop the known REM too-complex-error occurs:nextwhile::  IF EOF : GOTO endwhile:: : ENDIF IF (tracking% OR rnum%>0) AND map%=0 AND NOT adaptmap% dpx%=-1 : dpy%=-1 dist=map_sx%-(A.lo-loni0)/(lona0-loni0)*map_sx% IF dist>=0 AND dist=0 AND dist=0 AND dpx%=0 AND dpy%"" : file$=buffer$ : ENDIF ELSEIF r%=%f buffer$=file$ Busy:("Building file list"+KDots$,1) dINIT "Select waypoint file" dFILE buffer$,"File,Folder,Disk",16+UseSystemFolder& dBUTTONS " Cancel ",-(27+$100)," Select ",13+$100 Busy:(KBusyOff$,0) Lock:(KLock%) : r%=DIALOG : Lock:(KUnlock%) IF r%=13 : file$=buffer$ : ENDIF ELSEIF r%=13 : BREAK ELSE file$="" : BREAK ENDIF UNTIL KFalse%  IF file$="" : GOTO nooverlaywayp:: : ENDIF LastWaypointFile$=file$ REM add overlay from waypoints mapdescd$=file$+" SELECT name,description,latitude,longitude FROM waypoints"again:: ONERR notopenwayp:: OPEN mapdescd$,A,n$,d$,la,lo ONERR off GOTO done::notopenwayp:: ONERR off IF NOT ErrorMessage%:("Open waypoint file",ERR,KTrue%) GOTO nooverlaywayp:: ENDIF  GOTO again::done::  Busy:("Printing overlay"+KDots$,1) FIRSTnextwaypoint:: REM this loop must be realized with goto's REM because with loop constructs the known REM 'too complex' error will be raised  IF EOF : GOTO endwaypoints:: : ENDIF  IF (tracking% OR rnum%>0) AND map%=0 AND NOT adaptmap% dpx%=-1 : dpy%=-1 dist=map_sx%-(A.lo-loni0)/(lona0-loni0)*map_sx% IF dist>=0 AND dist=0 AND dist0) AND map%=0 AND NOT adaptmap% lat=lati0 : lat1=lata0 lon=loni0 : lon1=lona0 ELSE lat=lati(map%) : lat1=lata(map%) lon=loni(map%) : lon1=lona(map%) ENDIF dist=ABS(lon1-lon) dist2=ABS(lat1-lat) IF dist<10.0/60.0 OR dist2<10.0/60.0 dINIT "Draw grid" dTEXT "","Map area too small.",2 dTEXT "","You only can draw grid into maps with",2 dTEXT "","extensions greater than 0.1 degrees.",2 dBUTTONS " Okay ",13+$100 Lock:(KLock%) : DIALOG : Lock:(KUnlock%) IF (NOT enterpos%) AND rnum%=0 : ClearPortBuffer: : ENDIF ELSE dist =ABS(lat1-lat)/(8.0/3.0*map_sy%/screen_ysize%) dist =(ABS(lon1-lon)/(10*map_sx%/screen_xsize%)+dist)/2 sol =10**INTF(LOG(dist)) dist =INTF(dist/sol)*sol dist2=dist  dINIT "Distance between grid lines" dFLOAT dist,"Latitude (°)",0.1,45.0 dFLOAT dist2,"Longitude (°)",0.1,90.0 dBUTTONS " Cancel ",-(27+$100),"Okay",13+$100 Lock:(KLock%) : r%=DIALOG : Lock:(KUnlock%) IF r%=13  DrawMapCursor:(px_old%,py_old%,map_sx%,map_sy%) gGMODE 0 sol=INTF(lon/dist)*dist WHILE sol0) AND map%=0 AND NOT adaptmap% px%=map_sx%-(sol-loni0)/(lona0-loni0)*map_sx% py%=map_sy%-(lat-lati0)/(lata0-lati0)*map_sy% ELSE ConvLocation2Pixel%:(lat,sol,map_sx%,map_sy%,pnum%,ADDR(ppx%(1)),ADDR(ppy%(1)),ADDR(plat(1)),ADDR(plon(1)),ADDR(dpx%),ADDR(dpy%)) ENDIF gAT dpx%,0 gLINETO dpx%,map_sy% sol=sol+dist ENDWH sol=INTF(lat/dist2)*dist2 WHILE sol0) AND map%=0 AND NOT adaptmap% px%=map_sx%-(lon-loni0)/(lona0-loni0)*map_sx% py%=map_sy%-(sol-lati0)/(lata0-lati0)*map_sy% ELSE ConvLocation2Pixel%:(sol,lon,map_sx%,map_sy%,pnum%,ADDR(ppx%(1)),ADDR(ppy%(1)),ADDR(plat(1)),ADDR(plon(1)),ADDR(dpx%),ADDR(dpy%)) ENDIF gAT 0,dpy% gLINETO map_sx%,dpy% sol=sol+dist2 ENDWH  gGMODE 2 DrawMapCursor:(px_old%,py_old%,map_sx%,map_sy%) ENDIF ENDIF  ELSEIF r%=%w NewWaypoint:(clat,clon,height) IF (NOT enterpos%) AND rnum%=0 : ClearPortBuffer: : ENDIF  ELSEIF (r%=%i OR r%=%u) AND ((enterpos% AND map%<>0) OR ((NOT enterpos%) AND (NOT distmap%) AND (map%<>0))) REM zoom in/out c%=1 : map%=0 IF r%=%i solmax=KMaxFloat WHILE c%<=maps% IF clat>=lati(c%) AND clat<=lata(c%) AND clon>=loni(c%) AND clon<=lona(c%) IF mapsol(c%)>mapsol(oldmap%) AND mapsol(c%)=lati(c%) AND clat<=lata(c%) AND clon>=loni(c%) AND clon<=lona(c%) IF mapsol(c%)solmax solmax=mapsol(c%) map%=c% ENDIF ENDIF c%=c%+1 ENDWH ENDIF IF map%=0 gIPRINT "No other map found",2 map%=oldmap% ENDIF  ELSEIF r%=7 REM cancel IF tracking% dINIT "End tracking" dTEXT "","Do you really want to abort",2 dTEXT "","the tracking without saving ?",2 dBUTTONS "No",%N+$300," Yes ",%Y+$300 Lock:(KLock%) : r%=DIALOG : Lock:(KUnlock%) IF r%=%y : BREAK : ENDIF IF (NOT enterpos%) AND rnum%=0 : ClearPortBuffer: : ENDIF ELSE BREAK ENDIF ENDIF  GETEVENTA32 eventstat%,event&() eventrun%=KTrue% ENDIF IF heighton% gUSE heightid% IF px%height_old IF dist=KMaxFloat r%=4 ELSE r%=INT(dist/1000)+1 WHILE modulo%:(r%,4)>0 : r%=r%+1 : ENDWH ENDIF IF r_old%<>r% OR dist=KMaxFloat gCLS gBORDER $103 gAT 13,5 : gLINEBY 0,185 : gLINEBY 22,0 c%=1 WHILE c%0 IF NOT ErrorMessage%:("Open "+file$,r%,KTrue%) RETURN KFalse% ENDIF ENDIF UNTIL r%=0  REM read offset of list of image offsets in file off&=$0010 IOSEEK(h%,KIoSeekModeFromStart%,off&) IOREAD(h%,ADDR(buffer$),4) POKEL ADDR(off&),PEEKL(ADDR(buffer$)) REM test number  IOSEEK(h%,KIoSeekModeFromStart%,off&) IOREAD(h%,ADDR(buffer$),4) POKEL ADDR(num&),PEEKL(ADDR(buffer$)) IF num& add, else editPROC RegisterMaps:(new%) LOCAL file$(255),file2$(255),mapdesc$(255),r%,h%,map%,c% LOCAL lat,lon,plat(2),plon(2),ppx%(2),ppy%(2),pd$(2,255) LOCAL plat2(2),plon2(2),ppx2%(2),ppy2%(2),pd2$(2,255) LOCAL event&(16),k&,px%,py%,px_new%,py_new%,x0%,y0% LOCAL pdescr$(255),ch1%,ch2%,points%,map_sx%,map_sy% LOCAL buffer$(255),buffer2$(255),pnum%,pnum2% LOCAL map_sx2%,map_sy2%  IF new% file$=MyDir$+SMapFolder$ IF UseFastFileDialog% file$=FileDialog$:("Registering new map",file$,KFalse%,"",&0) IF file$="" : RETURN : ENDIF ENDIF  WHILE KTrue% REM register new map dINIT "Registering new map" IF NOT UseFastFileDialog% file$=MyDir$+SMapFolder$ Busy:("Building file list"+KDots$,1) dFILE file$,"MBM-file,Folder,Disk",16+UseSystemFolder& Busy:(KBusyOff$,0) ENDIF dEDIT mapdesc$,"Map description",20 dBUTTONS "Calibrate",13," Calibration from other map"+KDots$+" ",%C,"Cancel",-(27+$100) Lock:(KLock%) : r%=DIALOG : Lock:(KUnlock%) IF r%=13 r%=CalibrateMap%:(file$,ADDR(map_sx%),ADDR(map_sy%),ADDR(pnum%),ADDR(ppx%(1)),ADDR(ppy%(1)),ADDR(plat(1)),ADDR(plon(1)),ADDR(pd$(1))) IF r% REM write record Busy:("Adding new record"+KDots$,1) r%=AddMapRecord%:(MyDir$+SMapFolder$+SMapCalibFile$,file$,mapdesc$,map_sx%,map_sy%,pnum%,ADDR(ppx%(1)),ADDR(ppy%(1)),ADDR(plat(1)),ADDR(plon(1)),ADDR(pd$(1))) ENDIF Busy:(KBusyOff$,0) IF r% gIPRINT "New map is registered",1 ELSE gIPRINT "Map not registered",1 ENDIF BREAK  ELSEIF r%=%c REM use calibration datas of other map  r%=1 IF NOT GetMapRecord%:(r%,MyDir$+SMapFolder$+SMapCalibFile$,ADDR(file2$),ADDR(buffer$),ADDR(map_sx2%),ADDR(map_sy2%),ADDR(pnum2%),ADDR(ppx2%(1)),ADDR(ppy2%(1)),ADDR(plat2(1)),ADDR(plon2(1)),ADDR(pd2$(1))) ShortMessagePrompt:("Select corresponding map","No other maps registered.") ELSE Busy:("Building map list"+KDots$,1)  IF NOT GetMBMSize%:(file$,1,ADDR(map_sx%),ADDR(map_sy%)) CONTINUE ENDIF  dINIT "Select map" map%=0 DO  IF map%=0 AND map_sx%=map_sx2% AND map_sy%=map_sy2% map%=r% ENDIF r%=r%+1 IF GetMapRecord2%:(r%,MyDir$+SMapFolder$+SMapCalibFile$,ADDR(file2$),ADDR(buffer2$),ADDR(map_sx2%),ADDR(map_sy2%),ADDR(pnum2%),ADDR(ppx2%(1)),ADDR(ppy2%(1)),ADDR(plat2(1)),ADDR(plon2(1)),ADDR(pd2$(1))) buffer$=buffer$+",..." ELSE buffer2$="" ENDIF dCHOICE map%,"Mapname",buffer$ buffer$=buffer2$ UNTIL buffer2$=""  IF map%=0 dINIT "Select map" dTEXT "","No other map with same size found." dBUTTONS " Back ",13+$100 Busy:(KBusyOff$,0) Lock:(KLock%) : DIALOG : Lock:(KUnlock%) CONTINUE ENDIF  dBUTTONS " Back ",-27,"Use",13 Busy:(KBusyOff$,0) Lock:(KLock%) : r%=DIALOG : Lock:(KUnlock%) IF r%=13 GetMapRecord%:(map%,MyDir$+SMapFolder$+SMapCalibFile$,ADDR(file2$),ADDR(buffer2$),ADDR(map_sx2%),ADDR(map_sy2%),ADDR(pnum2%),ADDR(ppx2%(1)),ADDR(ppy2%(1)),ADDR(plat2(1)),ADDR(plon2(1)),ADDR(pd2$(1))) IF map_sx%<>map_sx2% OR map_sy%<>map_sy2% dINIT "Corresponding map" dTEXT "","Selected map does not have",2 dTEXT "","the same size as the new one.",2 dBUTTONS " Back ",13+$100 Lock:(KLock%) : DIALOG : Lock:(KUnlock%) CONTINUE ENDIF dINIT "Map Datas ("+file2$+")" dTEXT "Extention",GEN$(map_sx2%,5)+"*"+GEN$(map_sy2%,5)+" pixels" rem dTEXT "Calibration points",GEN$(pnum2%,3) c%=0 WHILE c%3 : dTEXT "Points 3.."+GEN$(pnum2%,3),"..." : ENDIF dBUTTONS "Back",-27," Use for new map ",13 Lock:(KLock%) : r%=DIALOG : Lock:(KUnlock%) IF r%=13 IF mapdesc$="" mapdesc$=MID$(file$,LPosInStr%:("\",file$)+1,255)+" [Copy of "+MID$(file2$,LPosInStr%:("\",file2$)+1,255)+"]" dINIT "New map" dTEXT "","Enter a map description for the new one:" dEDIT mapdesc$,"",15 dBUTTONS "Back",-27," Continue ",13 Lock:(KLock%) : r%=DIALOG : Lock:(KUnlock%) IF r%<>13 mapdesc$="" CONTINUE ENDIF ENDIF Busy:("Adding new record"+KDots$,1) r%=AddMapRecord%:(MyDir$+SMapFolder$+SMapCalibFile$,file$,mapdesc$,map_sx2%,map_sy2%,pnum2%,ADDR(ppx2%(1)),ADDR(ppy2%(1)),ADDR(plat2(1)),ADDR(plon2(1)),ADDR(pd2$(1))) Busy:(KBusyOff$,0) IF r% gIPRINT "New map is registered",1 ELSE gIPRINT "Map not registered",1 ENDIF BREAK ENDIF ENDIF ENDIF  ELSE BREAK ENDIF ENDWH ELSE REM change map registration r%=1 IF NOT GetMapRecord%:(r%,MyDir$+SMapFolder$+SMapCalibFile$,ADDR(file$),ADDR(buffer$),ADDR(map_sx%),ADDR(map_sy%),ADDR(pnum%),ADDR(ppx%(1)),ADDR(ppy%(1)),ADDR(plat(1)),ADDR(plon(1)),ADDR(pd$(1))) ShortMessagePrompt:("Edit map","No maps registered.") RETURN ENDIF Busy:("Building map list"+KDots$,1) dINIT "Edit map" DO r%=r%+1 IF GetMapRecord2%:(r%,MyDir$+SMapFolder$+SMapCalibFile$,ADDR(file$),ADDR(buffer2$),ADDR(map_sx%),ADDR(map_sy%),ADDR(pnum%),ADDR(ppx%(1)),ADDR(ppy%(1)),ADDR(plat(1)),ADDR(plon(1)),ADDR(pd$(1))) buffer$=buffer$+",..." ELSE buffer2$="" ENDIF dCHOICE map%,"Mapname",buffer$ buffer$=buffer2$ UNTIL buffer$="" dBUTTONS "Edit",13," Delete ",%D,"Cancel",-27 Busy:(KBusyOff$,0) Lock:(KLock%) : r%=DIALOG : Lock:(KUnlock%) IF r%=13 REM change selected map IF NOT GetMapRecord%:(map%,MyDir$+SMapFolder$+SMapCalibFile$,ADDR(file$),ADDR(mapdesc$),ADDR(map_sx%),ADDR(map_sy%),ADDR(pnum%),ADDR(ppx%(1)),ADDR(ppy%(1)),ADDR(plat(1)),ADDR(plon(1)),ADDR(pd$(1))) RETURN ENDIF DO dINIT "Map Datas ("+file$+")" dEDIT mapdesc$,"Description",27 dTEXT "Extention",GEN$(map_sx%,5)+"*"+GEN$(map_sy%,5)+" pixels" rem dTEXT "Calibration points",GEN$(pnum%,3) c%=0 WHILE c%3 : dTEXT "Points 3.."+GEN$(pnum%,3),"..." : ENDIF dBUTTONS " New calibration ",%C,"Cancel",-(27+$100),"Okay",13+$100 Lock:(KLock%) : r%=DIALOG : Lock:(KUnlock%) IF r%=13 BREAK ELSEIF r%=%c REM change points CalibrateMap%:(file$,ADDR(map_sx%),ADDR(map_sy%),ADDR(pnum%),ADDR(ppx%(1)),ADDR(ppy%(1)),ADDR(plat(1)),ADDR(plon(1)),ADDR(pd$(1))) ELSE RETURN ENDIF UNTIL KFalse% Busy:("Saving new map datas"+KDots$,1) r%=ReplaceMapRecord%:(map%,file$,mapdesc$,map_sx%,map_sy%,pnum%,ADDR(ppx%(1)),ADDR(ppy%(1)),ADDR(plat(1)),ADDR(plon(1)),ADDR(pd$(1))) Busy:(KBusyOff$,0) IF r% gIPRINT "Map datas changed",1 ELSE gIPRINT "Map datas are not changed",1 ENDIF  ELSEIF r%=%d REM delete selected map dINIT "Delete map" dTEXT "","Do you really want to delete",2 dTEXT "","the registration of the map ?",2 dBUTTONS "No",%N+$300," Yes ",%Y+$300 Lock:(KLock%) : r%=DIALOG : Lock:(KUnlock%) IF r%<>%y gIPRINT "Map record is not deleted",1 RETURN ENDIF Busy:("Deleting map datas"+KDots$,1) r%=DelMapRecord%:(map%) Busy:(KBusyOff$,0) IF r% gIPRINT "Map record deleted",1 ELSE gIPRINT "Map record is not deleted",1 ENDIF ENDIF ENDIFENDPREM *** Read datas of registered map% ***REM num% = number of mapREM calibfile$ = name of file with map datasREM afile&,...,apd& = buffers for datasPROC GetMapRecord%:(num%,calibfile$,afile&,adesc&,amap_sx&,amap_sy&,anum&,apx&,apy&,apla&,aplo&,apd&) RETURN _GetMapRecord%:(num%,calibfile$,afile&,adesc&,amap_sx&,amap_sy&,anum&,apx&,apy&,apla&,aplo&,apd&,KTrue%)ENDPPROC GetMapRecord2%:(num%,calibfile$,afile&,adesc&,amap_sx&,amap_sy&,anum&,apx&,apy&,apla&,aplo&,apd&) RETURN _GetMapRecord%:(num%,calibfile$,afile&,adesc&,amap_sx&,amap_sy&,anum&,apx&,apy&,apla&,aplo&,apd&,KFalse%)ENDPPROC _GetMapRecord%:(num%,calibfile$,afile&,adesc&,amap_sx&,amap_sy&,anum&,apx&,apy&,apla&,aplo&,apd&,dlg%) LOCAL c%,r%,h%,pc%,pnum%,aoffw&,aofff&,aoffs& IF NOT EXIST(calibfile$) : RETURN KFalse% : ENDIF c%=0 DO r%=IOOPEN(h%,calibfile$,$400) IF r% IF dlg% IF NOT ErrorMessage%:("Open map registry",r%,KTrue%) RETURN KFalse% ENDIF ELSE gIPRINT "ERROR: Open map registry - "+ERR$(r%),1 PAUSE 15 RETURN KFalse% ENDIF ENDIF UNTIL r%=0 DO r%=IOREAD(h%,afile&,256) IF r%<=0 : BREAK : ENDIF IOREAD(h%,adesc&,256) IOREAD(h%,amap_sx&,2) IOREAD(h%,amap_sy&,2) IOREAD(h%,ADDR(pnum%),2) : POKEW anum&,pnum% IF pnum%>KMaxCalibPoints% IF dlg% dINIT "Reading calibration datas" dTEXT "","Too much calbration points.",2 dTEXT "","Maybe a calibration record was created",2 dTEXT "","by another release of PsiNMEA.",2 dBUTTONS " Okay ",13+$100 Lock:(KLock%) : DIALOG : Lock:(KUnlock%) RETURN KFalse% ELSE gIPRINT "ERROR: Open map registry - Wrong calibration",1 PAUSE 15 RETURN KFalse% ENDIF ENDIF pc%=0 : aoffw&=0 : aofff&=0 : aoffs&=0 WHILE pc%0)ENDPREM *** Add datas for standard world map ***PROC AddStandardMap: LOCAL ppx%(2),ppy%(2),ppd$(2,255),plat(2),plon(2),r% LOCAL KStandardMapSX%,KStandardMapSY% IF NOT EXIST(MyDir$+SMapFolder$+KStandardMapFile$) ErrorMessageDirect:("Add standard map","MBM-File "+KStandardMapFile$+" does not exist.") RETURN ENDIF dINIT "Add standard map",17 dTEXT "File",KStandardMapFile$ dTEXT "Description",KStandardMapDesc$ dTEXT "1st Point","("+FIX$(KStandardMap1X%,0,10)+","+FIX$(KStandardMap1Y%,0,10)+")" dTEXT "1st Latitude",FormatStr_Latitude$:(KStandardMap1Lat,KTrue%) dTEXT "1st Longitude",FormatStr_Longitude$:(KStandardMap1Lon,KTrue%) dTEXT "2nd Point","("+FIX$(KStandardMap2X%,0,10)+","+FIX$(KStandardMap2Y%,0,10)+")" dTEXT "2nd Latitude",FormatStr_Latitude$:(KStandardMap2Lat,KTrue%) dTEXT "2nd Longitude",FormatStr_Longitude$:(KStandardMap2Lon,KTrue%) dBUTTONS " Cancel ",-(27+$100),"Add",13+$100 Lock:(KLock%) : r%=DIALOG : Lock:(KUnlock%) IF r%=13 ppx%(1)=KStandardMap1X% ppy%(1)=KStandardMap1Y% plat(1)=KStandardMap1Lat plon(1)=KStandardMap1Lon ppd$(1)=KStandardMap1Desc$ ppx%(2)=KStandardMap2X% ppy%(2)=KStandardMap2Y% plat(2)=KStandardMap2Lat plon(2)=KStandardMap2Lon ppd$(2)=KStandardMap2Desc$ IF NOT GetMBMSize%:(MyDir$+SMapFolder$+KStandardMapFile$,1,ADDR(KStandardMapSX%),ADDR(KStandardMapSY%)) gIPRINT "Error - no datas added",1 RETURN  ENDIF IF AddMapRecord%:(MyDir$+SMapFolder$+SMapCalibFile$,MyDir$+SMapFolder$+KStandardMapFile$,KStandardMapDesc$,KStandardMapSX%,KStandardMapSY%,2,ADDR(ppx%(1)),ADDR(ppy%(1)),ADDR(plat(1)),ADDR(plon(1)),ADDR(ppd$(1))) gIPRINT "Map datas added",1 ELSE gIPRINT "Error - no datas added",1 ENDIF ELSE gIPRINT "Canceled",1 ENDIFENDPREM *** Add datas for map into file calibfile$ ***PROC AddMapRecord%:(calibfile$,file$,mapdesc$,map_sx%,map_sy%,pnum%,appx&,appy&,aplat&,aplon&,apd&) LOCAL r%,h%,df$(255),dmd$(255),dmsx%,dmsy%,pc% LOCAL dnum%,dpx%,dpy%,dlat,dlon,dd$(255) LOCAL aoffw&,aofff&,aoffs& df$=file$ : dmd$=mapdesc$ dmsx%=map_sx% : dmsy%=map_sy% dnum%=pnum%  DO IF EXIST(calibfile$) r%=IOOPEN(h%,calibfile$,$103) ELSE r%=IOOPEN(h%,calibfile$,$102) ENDIF IF r% IF NOT ErrorMessage%:("Open map registry",r%,KTrue%) RETURN KFalse% ENDIF ENDIF UNTIL r%=0  IF dmd$="" dmd$=MID$(df$,LPosInStr%:("\",df$)+1,255) ENDIF IOWRITE(h%,ADDR(df$),256) IOWRITE(h%,ADDR(dmd$),256) IOWRITE(h%,ADDR(dmsx%),2) IOWRITE(h%,ADDR(dmsy%),2) IOWRITE(h%,ADDR(dnum%),2) pc%=0 : aoffw&=0 : aofff&=0 : aoffs&=0 WHILE pc%num% IF NOT GetMapRecord%:(c%,src$,ADDR(df$),ADDR(dmd$),ADDR(dmsx%),ADDR(dmsy%),ADDR(dnum%),ADDR(dpx%(1)),ADDR(dpy%(1)),ADDR(dlat(1)),ADDR(dlon(1)),ADDR(dd$(1))) BREAK ENDIF ELSE df$=file$ : dmd$=mapdesc$ dmsx%=map_sx% : dmsy%=map_sy% dnum%=pnum% pc%=1 aoffw&=0 : aofff&=0 : aoffs&=0 WHILE pc%<=pnum% POKEW ADDR(dpx%(pc%)),PEEKW(appx&+aoffw&) POKEW ADDR(dpy%(pc%)),PEEKW(appy&+aoffw&) POKEF ADDR(dlat(pc%)),PEEKF(aplat&+aofff&) POKEF ADDR(dlon(pc%)),PEEKF(aplon&+aofff&) POKE$ ADDR(dd$(pc%)) ,PEEK$(apd&+aoffs&) pc%=pc%+1 aoffw&=aoffw&+2 : aofff&=aofff&+8 : aoffs&=aoffs&+256 ENDWH ENDIF IF NOT AddMapRecord%:(dest$,df$,dmd$,dmsx%,dmsy%,dnum%,ADDR(dpx%(1)),ADDR(dpy%(1)),ADDR(dlat(1)),ADDR(dlon(1)),ADDR(dd$(1))) DELETE dest$ RETURN KFalse% ENDIF c%=c%+1 UNTIL KFalse% DELETE src$ RENAME dest$,src$ RETURN KTrue%ENDPREM *** Delete datas for map num% ***PROC DelMapRecord%:(num%) LOCAL c%,flg%,src$(255),dest$(255) LOCAL df$(255),dmd$(255),dmsx%,dmsy%,dnum% LOCAL dpx%(KMaxCalibPoints%),dpy%(KMaxCalibPoints%) LOCAL dlat(KMaxCalibPoints%),dlon(KMaxCalibPoints%) LOCAL dd$(KMaxCalibPoints%,255) c%=1 : flg%=KFalse% src$=MyDir$+SMapFolder$+SMapCalibFile$ dest$=src$+".CPY" IF EXIST(dest$) : DELETE dest$ : ENDIF DO IF NOT GetMapRecord%:(c%,src$,ADDR(df$),ADDR(dmd$),ADDR(dmsx%),ADDR(dmsy%),ADDR(dnum%),ADDR(dpx%(1)),ADDR(dpy%(1)),ADDR(dlat(1)),ADDR(dlon(1)),ADDR(dd$(1))) BREAK ENDIF IF c%<>num% IF NOT AddMapRecord%:(dest$,df$,dmd$,dmsx%,dmsy%,dnum%,ADDR(dpx%(1)),ADDR(dpy%(1)),ADDR(dlat(1)),ADDR(dlon(1)),ADDR(dd$(1))) DELETE dest$ RETURN KFalse% ENDIF flg%=KTrue% ENDIF c%=c%+1 UNTIL KFalse% DELETE src$ IF flg% RENAME dest$,src$ ENDIF RETURN KTrue%ENDPREM *** Check the registrated map datas ***REM for a valid calibration and if theREM corresponding file existsPROC CheckMapRegistration:(calibfile$) LOCAL c%,c2%,r%,re%,fok% LOCAL dmd$(255),dmsx%,dmsy%,dnum%,df$(255),file$(255) LOCAL dpx%(KMaxCalibPoints%),dpy%(KMaxCalibPoints%) LOCAL dlat(KMaxCalibPoints%),dlon(KMaxCalibPoints%) LOCAL dd$(KMaxCalibPoints%,255),aoffw&,aofff&,aoffs& IF NOT EXIST(calibfile$) ShortMessagePrompt:("Check calibration datas","No calibration file found.") RETURN ENDIF  Lock:(KLock%) Busy:("Testing registered maps"+KDots$,1)  c%=1 : c2%=0 DO IF NOT GetMapRecord%:(c%,calibfile$,ADDR(df$),ADDR(dmd$),ADDR(dmsx%),ADDR(dmsy%),ADDR(dnum%),ADDR(dpx%(1)),ADDR(dpy%(1)),ADDR(dlat(1)),ADDR(dlon(1)),ADDR(dd$(1))) BREAK ENDIF fok%=KTrue% IF NOT EXIST(df$) fok%=KFalse% c2%=c2%+1 Busy:(KBusyOff$,0) DO dINIT "Check failed" dTEXT "Mapfile",df$ dTEXT "Description",dmd$ dTEXT "Status","File not found" dBUTTONS "Browse"+KDots$,13," Delete entry ",%D,"Ignore",%I,"Cancel",-27 Lock:(KLock%) : r%=DIALOG : Lock:(KUnlock%) IF r%=13 IF UseFastFileDialog% file$=FileDialog$:("Find map file",df$,KFalse%,"",&0) IF file$<>"" : df$=file$ : ENDIF ELSE Busy:("Building file list"+KDots$,1) dINIT "Find map file" dFILE df$,"MBM-file,Folder,Disk",16+UseSystemFolder& dBUTTONS " Cancel ",-(27+$100),"Okay",13+$100 Busy:(KBusyOff$,0) Lock:(KLock%) : re%=DIALOG : Lock:(KUnlock%) IF re%<>13 : file$="" : ENDIF ENDIF IF file$<>"" : fok%=KTrue% : c2%=c2%-1 : BREAK : ENDIF ELSEIF r%=%d dINIT "Delete map entry" dTEXT "","Do you really want to",2 dTEXT "","delete the entry.",2 dBUTTONS "No",%N+$300," Yes ",%Y+$300 Lock:(KLock%) : r%=DIALOG : Lock:(KUnlock%) IF re%=%y Busy:("Delete record"+KDots$,1) DelMapRecord%:(c%) Busy:(KBusyOff$,0) r%=%i c%=c%-1 c2%=c2%-1 BREAK ENDIF ELSEIF r%=%i : BREAK ELSE : Lock:(KUnlock%) : RETURN ENDIF UNTIL KFalse% IF r%<>%i Busy:("Changing map datas"+KDots$,1) ReplaceMapRecord%:(c%,df$,dmd$,dmsx%,dmsy%,dnum%,ADDR(dpx%(1)),ADDR(dpy%(1)),ADDR(dlat(1)),ADDR(dlon(1)),ADDR(dd$(1))) Busy:(KBusyOff$,0) ENDIF Busy:("Testing registered maps"+KDots$,1) ENDIF IF fok% AND NOT CalibDatasOK%:(dmsx%,dmsy%,dnum%,ADDR(dpx%(1)),ADDR(dpy%(1)),ADDR(dlat(1)),ADDR(dlon(1))) c2%=c2%+1 Busy:(KBusyOff$,0) DO dINIT "Check failed" dTEXT "Mapfile",df$ dTEXT "Description",dmd$ dTEXT "Status","Bad calibration" dBUTTONS "Calibrate",13," Delete entry ",%D,"Ignore",%I,"Cancel",-27 Lock:(KLock%) : r%=DIALOG : Lock:(KUnlock%) IF r%=13 IF CalibrateMap%:(df$,ADDR(dmsx%),ADDR(dmsy%),ADDR(dnum%),ADDR(dpx%(1)),ADDR(dpy%(1)),ADDR(dlat(1)),ADDR(dlon(1)),ADDR(dd$(1))) c2%=c2%-1 BREAK ENDIF ELSEIF r%=%d dINIT "Delete map entry" dTEXT "","Do you really want to",2 dTEXT "","delete the entry.",2 dBUTTONS "No",%N+$300," Yes ",%Y+$300 Lock:(KLock%) : re%=DIALOG : Lock:(KUnlock%) IF re%=%y Busy:("Deleting record"+KDots$,1) DelMapRecord%:(c%) Busy:(KBusyOff$,0) r%=%i c%=c%-1 c2%=c2%-1 BREAK ENDIF ELSEIF r%=%i : BREAK ELSE : Lock:(KUnlock%) : RETURN ENDIF UNTIL KFalse% IF r%<>%i Busy:("Changing map datas"+KDots$,1) ReplaceMapRecord%:(c%,df$,dmd$,dmsx%,dmsy%,dnum%,ADDR(dpx%(1)),ADDR(dpy%(1)),ADDR(dlat(1)),ADDR(dlon(1)),ADDR(dd$(1))) Busy:(KBusyOff$,0) ENDIF Busy:("Testing registered maps"+KDots$,1) ENDIF c%=c%+1 UNTIL KFalse% Busy:(KBusyOff$,0)  dINIT "Check calibration datas" IF c2%=0 ShortMessagePrompt:("Check calibration datas","All registered maps are okay.") ELSE ShortMessagePrompt:("Check calibration datas",FIX$(c2%,0,5)+" wrong registered maps.") ENDIF Lock:(KUnlock%)ENDPREM ***** Enter calibration points for a new map ******PROC CalibrateMap%:(file$,amsx&,amsy&,apnum&,apx&,apy&,apla&,aplo&,apd&) LOCAL map_sx%,map_sy%,map_id%,id%,inf&(48),pdescr$(255),points% LOCAL lat,lon,plat(KMaxCalibPoints%),plon(KMaxCalibPoints%) LOCAL ppx%(KMaxCalibPoints%),ppy%(KMaxCalibPoints%) LOCAL pd$(KMaxCalibPoints%,255),aoffw&,aofff&,aoffs& LOCAL event&(16),k&,px%,py%,px_new%,py_new%,x0%,y0%,r% LOCAL city$(100),country$(100),lat$(15),lon$(15) REM init graphic ClearScreen:  gUSE 1 : gCOLOR $55,$55,$55 : gAT 0,0 : gFILL screen_xsize%,screen_ysize%,0 Busy:("Reading map"+KDots$,1) ONERR noload:: map_id%=gLOADBIT(file$,0) ONERR off Busy:(KBusyOff$,0) GOTO isload::noload:: ONERR off Busy:(KBusyOff$,0) RefreshScreen: ErrorMessage%:("Reading Map",ERR,KFalse%) RETURN KFalse%isload:: map_sx%=gWIDTH : map_sy%=gHEIGHT gINFO32 inf&()  ONERR nocr:: id%=gCREATE(0,0,map_sx%,map_sy%,0,inf&(30) AND $000F) ONERR off GOTO iscr::nocr:: ONERR off gCLOSE map_id% RefreshScreen: ErrorMessage%:("Creating bitmap",ERR,KFalse%) RETURN KFalse%iscr:: gUSE id% gCOPY map_id%,0,0,map_sx%,map_sy%,3 gCLOSE map_id% gORDER id%,1 gVISIBLE on  px%=map_sx%/2 : py%=map_sy%/2  points%=0  Lock:(KLock%) DO IF map_sx%<=screen_xsize% x0%=screen_xsize%/2-map_sx%/2 ELSE x0%=MAX(MIN(screen_xsize%/2-px%,0),screen_xsize%-map_sx%) ENDIF IF map_sy%<=screen_ysize% y0%=screen_ysize%/2-map_sy%/2 ELSE y0%=MAX(MIN(screen_ysize%/2-py%,0),screen_ysize%-map_sy%) ENDIF gSETWIN x0%,y0% gGMODE 2 IF px%screen_ysize%-30: r%=3 : ELSE r%=1 : ENDIF gIPRINT "Point "+GEN$(points%+1,3)+": ("+GEN$(px%,5)+";"+GEN$(py%,5)+")",r%  DO gAT 0,py% : gLINETO map_sx%-1,py% gAT px%,0 : gLINETO px%,map_sy%-1 GETEVENT32 event&() gAT 0,py% : gLINETO map_sx%-1,py% gAT px%,0 : gLINETO px%,map_sy%-1 k&=event&(KEvaType%) px_new%=px% : py_new%=py% IF (k&=KKeyMenu32%) OR (k&=KKeySidebarMenu32%) REM menu button pressed IF points%=0 : pdescr$="Set 1st lat/long" ELSEIF points%=1 : pdescr$="Set 2nd lat/long" ELSEIF points%=2 : pdescr$="Set 3rd lat/long" ELSE pdescr$="Set "+GEN$(points%+1,3)+"th lat/long" ENDIF  Lock:(KLock%) IF KMaxCalibPoints%>2 IF points%<2 : r%=$1000 : ELSE r%=0 : ENDIF r%=mPOPUP(0,0,0,pdescr$+KDots$,1,"All done",-(2+r%),"Cancel",3) ELSE r%=mPOPUP(0,0,0,pdescr$+KDots$,-1,"Cancel",3) ENDIF Lock:(KUnlock%)  IF r%=1 k&=KKeyEnter% : BREAK ELSEIF r%=2 k&=KKeyTab% : BREAK ELSEIF r%=3 k&=KKeyEsc% : BREAK ENDIF ELSEIF k&=KEvPtr& AND event&(KEvAPtrType%)=KEvPtrPenUp& REM pointer event px_new%=event&(KEvAPtrScreenPosX%)-x0% py_new%=event&(KEvAPtrScreenPosY%)-y0% ELSEIF (event&(4) AND $2) REM shift pressed IF k&=KKeyUpArrow32% : py_new%=py%-1 ELSEIF k&=KKeyDownArrow32% : py_new%=py%+1 ELSEIF k&=KKeyLeftArrow32% : px_new%=px%-1 ELSEIF k&=KKeyRightArrow32% : px_new%=px%+1 ELSE k&=0 ENDIF ELSE REM shift not pressed IF k&=KKeyUpArrow32% : py_new%=py%-10 ELSEIF k&=KKeyDownArrow32% : py_new%=py%+10 ELSEIF k&=KKeyLeftArrow32% : px_new%=px%-10 ELSEIF k&=KKeyRightArrow32% : px_new%=px%+10 ELSEIF k&=KKeyEsc% OR k&=KKeyEnter% : BREAK ELSEIF k&=KKeyTab% AND points%>=2 : BREAK ELSE k&=0 ENDIF ENDIF IF px_new%>=0 AND py_new%>=0 AND px_new%<=map_sx% AND py_new%<=map_sy% AND (px%<>px_new% OR py%<>py_new%) px%=px_new% py%=py_new% BREAK ENDIF UNTIL KFalse% IF k&=KKeyEnter% lat$="" : lon$="" pdescr$="Map-Pixel "+GEN$(points%+1,1)+" at ("+GEN$(px%,5)+";"+GEN$(py%,5)+")"  DO dINIT "Map coordinates ("+GEN$(px%,5)+";"+GEN$(py%,5)+")" dEDIT lat$,"Latitude",10 dEDIT lon$,"Longitude",10 dEDIT pdescr$,"Point description",20 dBUTTONS " Select waypoint"+KDots$+" ",%W,"Cancel",-(27+$100),"Okay",13+$100 Lock:(KLock%) : r%=DIALOG : Lock:(KUnlock%) IF r%=13 lat=Val_LatLonStr:(lat$,KTrue%,KTrue%) IF lat>-1000 lon=Val_LatLonStr:(lon$,KFalse%,KTrue%) ENDIF ELSEIF r%=%w REM read location from database IF LocationFromDatabase%:(KTrue%,ADDR(city$),ADDR(country$),ADDR(lat),ADDR(lon)) lat$=FormatStr_Latitude$:(lat,KTrue%) lon$=FormatStr_Longitude$:(lon,KTrue%) pdescr$=city$+" ("+country$+")" ENDIF ENDIF UNTIL r%<>%w AND (r%<>13 OR (lat>-1000 AND lon>-1000)) IF r%=13 points%=points%+1 ppx%(points%)=px% ppy%(points%)=py% plat(points%)=lat plon(points%)=lon pd$(points%) =pdescr$ ENDIF  ELSEIF k&=KKeyEsc% dINIT "Calibrate map" dTEXT "","Do you really want to abort",2 dTEXT "","the map calibration?",2 dBUTTONS "No",%N+$300," Yes ",%Y+$300 Lock:(KLock%) : r%=DIALOG : Lock:(KUnlock%) IF r%<>%y : k&=0 : ENDIF ENDIF UNTIL k&=KKeyEsc% OR k&=KKeyTab% OR points%=KMaxCalibPoints%  gCLOSE(id%) RefreshScreen: IF k&<>KKeyEsc% POKEW amsx&,map_sx% : POKEW amsy&,map_sy% POKEW apnum&,points% r%=1 aoffw&=0 : aofff&=0 : aoffs&=0 WHILE r%<=points% POKEW apx&+aoffw&,ppx%(r%) POKEW apy&+aoffw&,ppy%(r%) POKEF apla&+aofff&,plat(r%) POKEF aplo&+aofff&,plon(r%) POKE$ apd&+aoffs&,pd$(r%) r%=r%+1 aoffw&=aoffw&+2 : aofff&=aofff&+8 : aoffs&=aoffs&+256 ENDWH Lock:(KUnlock%) RETURN KTrue% ENDIF  Lock:(KUnlock%) RETURN KFalse%ENDPREM *** Checks for valid calibration datas ***PROC CalibDatasOK%:(map_sx%,map_sy%,pnum%,appx&,appy&,aplat&,aplon&) LOCAL c1%,c2%,pxmin%,pxmax%,pymin%,pymax% LOCAL lamin,lamax,lomin,lomax LOCAL ppx%(2),ppy%(2),plat(2),plon(2) LOCAL aoffw1&,aofff1&,aoffw2&,aofff2&  IF pnum%<2 : RETURN KFalse% : ENDIF  pxmin%=map_sx% : pymin%=map_sy% pxmax%=0 : pymax%=0 lamin =90 : lomin =180 lamax =-90 : lomax =-180  c1%=0 : aoffw1&=0 : aofff1&=0 WHILE c1%=map_sx% OR ppy%(1)>=map_sy% OR ABS(plat(1))>90 OR ABS(plon(1))>180 RETURN KFalse% ENDIF c2%=c1% aoffw2&=aoffw1& : aofff2&=aofff1& WHILE c2%pxmax% : pxmax%=ppx%(1) : ENDIF IF ppy%(1)>pymax% : pymax%=ppy%(1) : ENDIF IF ppx%(1)lamax : lamax =plat(1) : ENDIF IF plon(1)>lomax : lomax =plon(1) : ENDIF IF plat(1)pxmax% AND pymin%<>pymax% AND lamin<>lamax AND lomin<>lomax)ENDPREM *** Reads current GPS location from connected device ***PROC ReadCurrentPosition%:(alat&,along&,aheight&,atime&,dlg%) LOCAL lat,long,height,time,formats$(5,5),format$(5),datas% formats$(1)="GGA" formats$(2)="GLL" formats$(3)="RMC" formats$(4)="*GRMC" formats$(5)="*GRMZ" lat=KMaxFloat long=KMaxFloat height=KMaxFloat time=KMaxFloat datas%=0 DO  format$=WaitForSentence$:(ADDR(formats$(1)),5,dlg%) IF format$="GGA" NMEA_GGA%: IF Parse%:(sentence$)=1 IF ASC(values$(1))<>KascBlank% time=values(1) ENDIF  IF ASC(values$(2))<>KascBlank% lat=values(2) ENDIF  IF ASC(values$(3))<>KascBlank% long=values(3) ENDIF  IF ASC(values$(7))<>KascBlank% height=values(7) ENDIF datas%=3 ENDIF ELSEIF format$="GLL" IF ((datas% AND 1)=0) NMEA_GLL%: IF Parse%:(sentence$)=1 IF ASC(values$(3))<>KascBlank% time=values(3) ENDIF  IF ASC(values$(1))<>KascBlank% lat=values(1) ENDIF  IF ASC(values$(2))<>KascBlank% long=values(2) ENDIF  datas%=datas%+1 ENDIF ENDIF ELSEIF format$="RMC"  IF ((datas% AND 1)=0) NMEA_RMC%: IF Parse%:(sentence$)=1 IF ASC(values$(1))<>KascBlank% time=values(1) ENDIF  IF ASC(values$(3))<>KascBlank% lat=values(3) ENDIF  IF ASC(values$(4))<>KascBlank% long=values(4) ENDIF  datas%=datas%+1 ENDIF ENDIF  ELSEIF format$="*GRMC"  IF ((datas% AND 2)=0) NMEA_GRM_C%: IF Parse%:(sentence$)=1 IF ASC(values$(2))<>KascBlank% height=values(2) ENDIF datas%=datas%+2 ENDIF ENDIF ELSEIF format$="*GRMZ"  IF ((datas% AND 2)=0) NMEA_GRM_Z%: IF Parse%:(sentence$)=1 IF ASC(values$(1))<>KascBlank% height=values(1) ENDIF datas%=datas%+2 ENDIF ENDIF ELSE RETURN KFalse% ENDIF  UNTIL datas%=3 POKEF alat&,lat POKEF along&,long POKEF aheight&,height POKEF atime&,time RETURN KTrue%ENDPREM *** Reads current GPS date/time from connected device ***PROC ReadCurrentDateTime%:(ayear&,amon&,aday&,ahour&,amin&,asec&) LOCAL year%,mon%,day%,hour%,min%,sec%,sec,yearf LOCAL formats$(2,5),format$(5) formats$(1)="RMC" formats$(2)="ZDA" format$=WaitForSentence$:(ADDR(formats$(1)),2,KTrue%)  hour%=KMaxInt% min%=KMaxInt% sec%=KMaxInt% year%=KMaxInt% mon%=KMaxInt% day%=KMaxInt% IF format$="ZDA" NMEA_ZDA%: IF Parse%:(sentence$)=1 IF ASC(values$(1))<>KascBlank% AND ASC(values$(2))<>KascBlank% AND ASC(values$(3))<>KascBlank% AND ASC(values$(4))<>KascBlank% GetTime:(values(1),ADDR(hour%),ADDR(min%),ADDR(sec)) sec%=sec year%=values(2)/100+1900 IF year%<1970 : year%=year%+100 : ENDIF mon%=values(3)/100 day%=values(4)/100 ENDIF ENDIF ELSEIF format$="RMC" NMEA_RMC%: IF Parse%:(sentence$)=1 IF ASC(values$(1))<>KascBlank% AND ASC(values$(7))<>KascBlank% GetTime:(values(1),ADDR(hour%),ADDR(min%),ADDR(sec)) sec%=sec GetTime:(values(7),ADDR(day%),ADDR(mon%),ADDR(yearf)) year%=INT(yearf+0.5)+1900 IF year%<1970 : year%=year%+100 : ENDIF ENDIF ENDIF ELSE RETURN KFalse% ENDIF POKEW ayear&,year% POKEW amon&,mon% POKEW aday&,day% POKEW ahour&,hour% POKEW amin&,min% POKEW asec&,sec% RETURN KTrue%ENDPREM *** Waits for special NMEA sentence(s) ***REM aformats& = field of needed formatsREM fnum& = number of needed formatsREM dlg%=KTrue% -> Prompt for timeout, else return ""PROC WaitForSentence$:(aformats&,fnum%,dlg%) LOCAL p%,c%,format$(5),rformat$(5),aoff&,r% p%=0 DO GetSentence: IF LEN(sentence$)>5 IF MID$(sentence$,2,1)="P" IF PropDevice$<>"" format$=ManufacturersType$:(PropDevice$,0) IF format$<>"" format$=@$("SentenceType_"+PropDevice$):(sentence$,0) c%=0 : aoff&=0 WHILE c%3 IF LEFT$(rformat$,1)="*" AND PropDevice$=MID$(rformat$,2,3) AND format$=MID$(rformat$,5,255) RETURN rformat$ ENDIF ENDIF c%=c%+1 : aoff&=aoff&+6 ENDWH ENDIF ENDIF ELSE format$=SentenceType_Standard$:(sentence$,0) IF format$<>"" c%=0 : aoff&=0 WHILE c%100 IF dlg% dINIT "Read datas" dTEXT "","No valid information found." dBUTTONS " Cancel ",-27,"Retry",13 Lock:(KLock%) : r%=DIALOG : Lock:(KUnlock%) IF r%<>13 : RETURN "" : ENDIF p%=-200 ELSE RETURN "" ENDIF ENDIF UNTIL KFalse%ENDPREM *** Draws path of sun eclipse into a map ***PROC SunEclPath2Map: LOCAL r%,h%,c%,flg1%,flg2%,map%,buffer$(255),buffer2$(255) LOCAL file$(255),mapdesc$(255),rfile$(255) LOCAL ppx%(KMaxCalibPoints%),ppy%(KMaxCalibPoints%) LOCAL plat(KMaxCalibPoints%),plon(KMaxCalibPoints%) LOCAL pd$(KMaxCalibPoints%,255),pnum% LOCAL px%,py%,px_new%,py_new% LOCAL map_id%,id%,map_sx%,map_sy%,x0%,y0% LOCAL inf&(48),k&,event&(16),lat,lon,dir1$(5),dir2$(5) LOCAL datfile$(255),rec$(11,30),rec(11) LOCAL b1x0%,b1y0%,b1x1%,b1y1%,b2x0%,b2y0%,b2x1%,b2y1% LOCAL Zx0%,Zy0%,Zx1%,Zy1%,rtype%(12),rtype$(50),rtypes% LOCAL b1%,b2%,b3%,p1,p2,p3,p4  datfile$=LastSunEclFile$ : r%=0 IF datfile$="" OR NOT EXIST(datfile$) : r%=%f : ENDIF  DO IF r%=%f IF UseFastFileDialog% rfile$=FileDialog$:("Select sun eclipse file"+KDots$,datfile$,KFalse%,"",&0) IF rfile$<>"" : datfile$=rfile$ : ENDIF ELSE rfile$=datfile$ Busy:("Building file list"+KDots$,1) dINIT "Select sun eclipse file" dFILE rfile$,"Datafile,Folder,Disk",16+UseSystemFolder& dBUTTONS " Cancel ",-(27+$100),"Okay",13+$100 Busy:(KBusyOff$,0) Lock:(KLock%) : r%=DIALOG : Lock:(KUnlock%) IF r%=13 : datfile$=rfile$ : ENDIF ENDIF ENDIF  Busy:("Building map list"+KDots$,1) dINIT "Select map" dTEXT "Datafile",ExtractFile$:(datfile$)  r%=1 IF NOT GetMapRecord%:(r%,MyDir$+SMapFolder$+SMapCalibFile$,ADDR(file$),ADDR(buffer$),ADDR(map_sx%),ADDR(map_sy%),ADDR(pnum%),ADDR(ppx%(1)),ADDR(ppy%(1)),ADDR(plat(1)),ADDR(plon(1)),ADDR(pd$(1))) Busy:(KBusyOff$,0) ShortMessagePrompt:("Select map","No maps registered.") RETURN ENDIF DO r%=r%+1 IF GetMapRecord2%:(r%,MyDir$+SMapFolder$+SMapCalibFile$,ADDR(file$),ADDR(buffer2$),ADDR(map_sx%),ADDR(map_sy%),ADDR(pnum%),ADDR(ppx%(1)),ADDR(ppy%(1)),ADDR(plat(1)),ADDR(plon(1)),ADDR(pd$(1))) buffer$=buffer$+",..." ELSE buffer2$="" ENDIF dCHOICE map%,"Map",buffer$ buffer$=buffer2$ UNTIL buffer$="" dBUTTONS " Change datafile"+KDots$+" ",%F,"Cancel",-(27+$100),"Draw",13+$100 Busy:(KBusyOff$,0) Lock:(KLock%) : r%=DIALOG : Lock:(KUnlock%) IF r%<>13 AND r%<>%f : RETURN : ENDIF UNTIL r%=13  LastSunEclFile$=datfile$  DO r%=IOOPEN(h%,datfile$,$0420) IF r% IF NOT ErrorMessage%:("Open data file",r%,KTrue%) RETURN ENDIF ENDIF UNTIL r%=0 IF NOT GetMapRecord%:(map%,MyDir$+SMapFolder$+SMapCalibFile$,ADDR(file$),ADDR(buffer2$),ADDR(map_sx%),ADDR(map_sy%),ADDR(pnum%),ADDR(ppx%(1)),ADDR(ppy%(1)),ADDR(plat(1)),ADDR(plon(1)),ADDR(pd$(1))) IOCLOSE(h%) RETURN ENDIF REM show map Busy:("Reading map"+KDots$,1) ONERR noload:: map_id%=gLOADBIT(file$,0) ONERR off Busy:(KBusyOff$,0) GOTO isload::noload:: ONERR off Busy:(KBusyOff$,0) IOCLOSE(h%) ErrorMessage%:("Reading Map",ERR,KFalse%) RETURNisload:: map_sx%=gWIDTH : map_sy%=gHEIGHT  gUSE 1 : gCOLOR $55,$55,$55 : gAT 0,0 : gFILL screen_xsize%,screen_ysize%,0 gINFO32 inf&() ONERR nocr:: id%=gCREATE(0,0,map_sx%,map_sy%,0,inf&(30) AND $000F) ONERR off GOTO iscr::nocr:: gCLOSE map_id% ONERR off ErrorMessage%:("Creating bitmap",ERR,KFalse%) RETURNiscr:: gUSE id% gCOPY map_id%,0,0,map_sx%,map_sy%,3 gCLOSE map_id% REM drawing the path  r%=IOREAD(h%,ADDR(buffer$)+1,255) : REM date IF NOT ReadSunEclipseDataFormats%:(h%,ADDR(rtype%(1)),ADDR(rtypes%)) IOCLOSE(h%) gCLOSE id% RETURN ENDIF  c%=1 : flg1%=KFalse% : flg2%=KFalse% Busy:("Computing"+KDots$,1) DO IF NOT ReadSunEclipseNextDataLine%:(h%,rtypes%,ADDR(rtype%(1)),ADDR(rec$(1)),30) BREAK ENDIF IF rec$(1)="" OR rec$(2)="" OR rec$(3)="" OR rec$(4)="" Busy:(KBusyOff$,0) ShortMessagePrompt:("Sun Eclipse","Error: Not all needed datas in file.") IOCLOSE(h%) gCLOSE id% RETURN  ENDIF rec(1)=VAL(LEFT$(rec$(1),3))+VAL(MID$(rec$(1),5,4))/60 IF RIGHT$(rec$(1),1)="E" : rec(1)=-rec(1) : ENDIF rec(2)=VAL(LEFT$(rec$(2),2))+VAL(MID$(rec$(2),4,5))/60 IF RIGHT$(rec$(2),1)="S" : rec(2)=-rec(2) : ENDIF rec(3)=VAL(LEFT$(rec$(3),2))+VAL(MID$(rec$(3),4,5))/60 IF RIGHT$(rec$(3),1)="S" : rec(3)=-rec(3) : ENDIF rec(4)=VAL(LEFT$(rec$(4),2))+VAL(MID$(rec$(4),4,5))/60 IF RIGHT$(rec$(4),1)="S" : rec(4)=-rec(4) : ENDIF ConvLocation2Pixel%:(rec(2),rec(1),map_sx%,map_sy%,pnum%,ADDR(ppx%(1)),ADDR(ppy%(1)),ADDR(plat(1)),ADDR(plon(1)),ADDR(b1x1%),ADDR(b1y1%)) ConvLocation2Pixel%:(rec(3),rec(1),map_sx%,map_sy%,pnum%,ADDR(ppx%(1)),ADDR(ppy%(1)),ADDR(plat(1)),ADDR(plon(1)),ADDR(b2x1%),ADDR(b2y1%)) ConvLocation2Pixel%:(rec(4),rec(1),map_sx%,map_sy%,pnum%,ADDR(ppx%(1)),ADDR(ppy%(1)),ADDR(plat(1)),ADDR(plon(1)),ADDR(Zx1%),ADDR(Zy1%)) IF c%>1 p1=FLT(b1x0%)*b1x1% p2=FLT(b1x0%-map_sx%)*(b1x1%-map_sx%) p3=FLT(b1y0%)*b1y1% p4=FLT(b1y0%-map_sy%)*(b1y1%-map_sy%) b1%=(p1<=0 OR p2<=0 OR (p1>=0 AND p2>=0 AND b1x0%>=0 AND b1x0%=0 AND p4>=0 AND b2y0%>=0 AND b2y0%=0 AND p2>=0 AND b2x0%>=0 AND b2x0%=0 AND p4>=0 AND b2y0%>=0 AND b2y0%=0 AND p2>=0 AND Zx0%>=0 AND Zx0%=0 AND p4>=0 AND Zy0%>=0 AND Zy0%13 : datfile$="" : ENDIF ENDIF IF datfile$<>"" Busy:("Saving"+KDots$,1) gSAVEBIT datfile$ Busy:(KBusyOff$,0) gIPRINT "Map saved",1 ENDIF ELSEIF r%=2 k&=KKeyEsc% : BREAK ENDIF ELSEIF k&=KEvPtr& AND event&(KEvAPtrType%)=KEvPtrPenUp& REM pointer event px_new%=event&(KEvAPtrScreenPosX%)-x0% py_new%=event&(KEvAPtrScreenPosY%)-y0% ELSEIF (event&(4) AND $2) REM shift pressed IF k&=KKeyUpArrow32% : py_new%=py%-1 ELSEIF k&=KKeyDownArrow32% : py_new%=py%+1 ELSEIF k&=KKeyLeftArrow32% : px_new%=px%-1 ELSEIF k&=KKeyRightArrow32% : px_new%=px%+1 ELSE k&=0 ENDIF ELSE REM shift not pressed IF k&=KKeyUpArrow32% : py_new%=py%-10 ELSEIF k&=KKeyDownArrow32% : py_new%=py%+10 ELSEIF k&=KKeyLeftArrow32% : px_new%=px%-10 ELSEIF k&=KKeyRightArrow32% : px_new%=px%+10 ELSEIF k&=KKeyEsc% : BREAK ELSE k&=0 ENDIF ENDIF IF px_new%>=0 AND py_new%>=0 AND px_new%<=map_sx% AND py_new%<=map_sy% AND (px%<>px_new% OR py%<>py_new%) px%=px_new% py%=py_new% BREAK ENDIF UNTIL KFalse% UNTIL (k&=KKeyEsc%) OR CloseAppCmd%  gCLOSE id% RefreshScreen:ENDPREM *** Converts pixel coordinates in lat/lon ***PROC ConvPixel2Location%:(x%,y%,pnum%,apx&,apy&,apla&,aplo&,alat&,alon&) LOCAL lat,lon,vx,vy,c%,aoffw&,aofff& LOCAL px%(KMaxCalibPoints%),py%(KMaxCalibPoints%) LOCAL plat(KMaxCalibPoints%),plon(KMaxCalibPoints%) c%=1 : aoffw&=0 : aofff&=0 WHILE c%<=pnum% POKEW ADDR(px%(c%)),PEEKW(apx&+aoffw&) POKEW ADDR(py%(c%)),PEEKW(apy&+aoffw&) POKEF ADDR(plat(c%)),PEEKF(apla&+aofff&) POKEF ADDR(plon(c%)),PEEKF(aplo&+aofff&) c%=c%+1 : aoffw&=aoffw&+2 : aofff&=aofff&+8 ENDWH REM only calculation for 2 points vx=FLT((x%-px%(1)))/(px%(2)-px%(1)) vy=FLT((y%-py%(1)))/(py%(2)-py%(1)) lat=vy*(plat(2)-plat(1))+plat(1) lon=vx*(plon(2)-plon(1))+plon(1) POKEF alat&,lat POKEF alon&,lonENDPREM *** Converts lat/lon in pixel coordinates ***PROC ConvLocation2Pixel%:(lat,lon,map_sx%,map_sy%,pnum%,apx&,apy&,apla&,aplo&,ax&,ay&) LOCAL lat1,lon1,lat2,lon2,x%,y% LOCAL px%(KMaxCalibPoints%),py%(KMaxCalibPoints%) LOCAL plat(KMaxCalibPoints%),plon(KMaxCalibPoints%) ConvPixel2Location%:(0,0,pnum%,apx&,apy&,apla&,aplo&,ADDR(lat1),ADDR(lon1)) ConvPixel2Location%:(map_sx%-1,map_sy%-1,pnum%,apx&,apy&,apla&,aplo&,ADDR(lat2),ADDR(lon2)) x%=MIN(MAX(FLT(map_sx%)*(lon-lon1)/(lon2-lon1),-10000),10000) y%=MIN(MAX(FLT(map_sy%)*(lat-lat1)/(lat2-lat1),-10000),10000) POKEW ax&,x% POKEW ay&,y%ENDPREM *** View current GPS location in text format ***PROC ShowCurrentPosition: LOCAL lat,lon,height,time,str$(255),r% DO IF NOT ReadCurrentPosition%:(ADDR(lat),ADDR(lon),ADDR(height),ADDR(time),KTrue%) RETURN ENDIF dINIT "Current location" IF lat13ENDPREM *** View current date/time ***PROC ShowCurrentDateTime: LOCAL year%,mon%,day%,hour%,min%,sec%,yrday% LOCAL r%,c%,id&,secs&,dd& DO IF NOT ReadCurrentDateTime%:(ADDR(year%),ADDR(mon%),ADDR(day%),ADDR(hour%),ADDR(min%),ADDR(sec%)) RETURN ENDIF dINIT "Current Date and Time" IF year%13ENDPREM ***** EXTENSIONS TO RMRALARM.OPX *******************REM ***** (currently not used) *************************PROC AddAlarm%:(id&,msg$,snd$) LOCAL m$(KMaxAlarmMessage%),s$(KMaxAlarmSoundName%) LOCAL repeat&,alarmNo& m$=MID$(msg$,1,KMaxAlarmMessage%) s$=MID$(snd$,1,KMaxAlarmMessage%) repeat& =0 alarmNo&=AlmNextFreeNo%: IF alarmNo&<0 : RETURN KFalse% : ENDIF REM alarmno&=0..7 REM repeat& =0 Once only REM repeat& =1 In the next 24 hours REM repeat& =2 Daily REM repeat& =3 Weekly REM repeat& =4 On workdays REM sound$ =e.g. Rings,Fanfare AlmSetClockAlarm:(alarmNo&,id&, m$, s$, repeat&) RETURN KTrue%ENDPPROC AlmNextFreeNo%: LOCAL c%,state& c%=0 WHILE c%<8 state&=AlmAlarmState&:(c%) IF state&=KAlarmNotSet& : RETURN c% : ENDIF c%=c%+1 ENDWH RETURN -1ENDPPROC AlmTotalFreeNo%: LOCAL c%,state&,sum% c%=0 : sum%=0 WHILE c%<8 state&=AlmAlarmState&:(c%) IF state&=KAlarmNotSet& : sum%=sum%+1 : ENDIF c%=c%+1 ENDWH RETURN sum%ENDPPROC AlmKillAll: LOCAL c% c%=0 WHILE c%<8 AlmAlarmDelete:(c%) c%=c%+1 ENDWHENDPREM ***** EXTENSIONS TO DATE.OPX ***********************REM ***** (currently not used) *************************PROC DTDublicate&:(id&) LOCAL id2& id2&=DTNewDateTime&:(DTYear&:(id&),DTMonth&:(id&),DTDay&:(id&),DTHour&:(id&),DTMinute&:(id&),DTSecond&:(id&),DTMicro&:(id&)) RETURN id2&ENDPPROC DTAddSecs:(id&,add&) LOCAL secs&,year%,mon%,day%,hour%,min%,sec%,yrday% secs&=DATETOSECS(DTyear&:(id&),DTmonth&:(id&),DTday&:(id&),DThour&:(id&),DTminute&:(id&),DTsecond&:(id&)) secs&=secs&+add& SECSTODATE secs&,year%,mon%,day%,hour%,min%,sec%,yrday% DTSetYear:(id&,year%) DTSetMonth:(id&,mon%) DTSetDay:(id&,day%) DTSetHour:(id&,hour%) DTSetMinute:(id&,min%) DTSetSecond:(id&,sec%)ENDPREM *** Format values/units depend on user settings ***REM ***************************************************PROC FormatStr_Angle$:(a) LOCAL str$(50),u$(5),v,c% IF format%(5)=1 v=a u$="°" ELSEIF format%(5)=2 v=Convert:(a,KDegrees%,KRadiant%) u$="rad" ELSE v=Convert:(a,KDegrees%,KGrad%) u$="grd" ENDIF IF ABS(v)>=0.1 AND ABS(v)<10000 str$=FIX$(v,1,6)+u$ ELSE str$=SCI$(v,1,100) c%=PosInStr%:("E",str$,3) IF MID$(str$,c%+1,1)="+" str$=LEFT$(str$,c%-1)+"*10^"+MID$(str$,c%+2,2)+u$ ELSE str$=LEFT$(str$,c%-1)+"*10^"+MID$(str$,c%+1,3)+u$ ENDIF ENDIF RETURN str$ENDP PROC FormatStr_Temperature$:(t) LOCAL str$(50),v,c% IF format%(9)=1 v=t u$="°C" ELSEIF format%(9)=2 v=Convert:(t,KCelcius%,KKelvin%) u$="K" ELSEIF format%(9)=3 v=Convert:(t,KCelcius%,KFahrenheit%) u$="F" ELSE v=Convert:(t,KCelcius%,KReaumur%) u$="R" ENDIF  IF ABS(v)>=0.1 AND ABS(v)<10000 str$=FIX$(v,1,6)+u$ ELSE str$=SCI$(v,1,100) c%=PosInStr%:("E",str$,3) IF MID$(str$,c%+1,1)="+" str$=LEFT$(str$,c%-1)+"*10^"+MID$(str$,c%+2,2)+u$ ELSE str$=LEFT$(str$,c%-1)+"*10^"+MID$(str$,c%+1,3)+u$ ENDIF ENDIF RETURN str$ENDP  PROC FormatStr_Distance$:(lng,alt%) LOCAL str$(50),v,c% IF format%(6)=1 REM metric units IF lng=0 str$="0.0m" ELSEIF ABS(lng)<0.000001 str$=FIX$(lng*1e9,2,5)+"nm" ELSEIF ABS(lng)<0.001 str$=FIX$(lng*1e6,2,5)+"µm" ELSEIF ABS(lng)<0.01 str$=FIX$(lng*1000,2,5)+"mm" ELSEIF ABS(lng)<1 str$=FIX$(lng*100,2,6)+"cm" ELSEIF ABS(lng)<1000 str$=FIX$(lng,1,6)+"m" ELSEIF ABS(lng)<1e7 str$=FIX$(lng/1000,1,6)+"km" ELSE str$=SCI$(lng/1000,1,100) c%=PosInStr%:("E",str$,3) IF MID$(str$,c%+1,1)="+" str$=LEFT$(str$,c%-1)+"*10^"+MID$(str$,c%+2,2)+"km" ELSE str$=LEFT$(str$,c%-1)+"*10^"+MID$(str$,c%+1,3)+"km" ENDIF ENDIF ELSE REM British units v=Convert:(lng,KMeters%,KInches%) IF lng=0 str$="0.0ft" ELSEIF (ABS(v)<100) AND (NOT alt%) str$=FIX$(v,2,6)+CHR$(%") ELSE v=Convert:(lng,KMeters%,KFeets%) IF (ABS(v)<10000) OR (alt% AND ABS(v)<100000) str$=FIX$(v,1,6)+"ft" ELSE v=Convert:(lng,KMeters%,KNauticalMiles%) IF ABS(v)<100000 str$=FIX$(v,1,10)+"nm" ELSE str$=SCI$(v,1,100) c%=PosInStr%:("E",str$,3) IF MID$(str$,c%+1,1)="+" str$=LEFT$(str$,c%-1)+"*10^"+MID$(str$,c%+2,2)+"mil" ELSE str$=LEFT$(str$,c%-1)+"*10^"+MID$(str$,c%+1,3)+"mil" ENDIF ENDIF ENDIF ENDIF ENDIF RETURN str$ENDPPROC FormatStr_Velocity$:(spd) LOCAL str$(50),v,c% IF format%(7)=1 IF ABS(spd)>=0.1 AND ABS(spd)<10000 str$=FIX$(spd,2,50)+"m/s" ELSE str$=SCI$(spd,1,100) c%=PosInStr%:("E",str$,3) IF MID$(str$,c%+1,1)="+" str$=LEFT$(str$,c%-1)+"*10^"+MID$(str$,c%+2,2)+"m/s" ELSE str$=LEFT$(str$,c%-1)+"*10^"+MID$(str$,c%+1,3)+"m/s" ENDIF ENDIF ELSEIF format%(7)=2  v=Convert:(spd,KMetersPerSecond%,KKilometersPerHour%) IF ABS(v)>=0.1 AND ABS(v)<10000 str$=FIX$(v,1,50)+"km/h" ELSE str$=SCI$(v,1,100) c%=PosInStr%:("E",str$,3) IF MID$(str$,c%+1,1)="+" str$=LEFT$(str$,c%-1)+"*10^"+MID$(str$,c%+2,2)+"km/h" ELSE str$=LEFT$(str$,c%-1)+"*10^"+MID$(str$,c%+1,3)+"km/h" ENDIF ENDIF ELSEIF format%(7)=3 v=Convert:(spd,KMetersPerSecond%,KKnots%) IF ABS(v)>=0.1 AND ABS(v)<10000 str$=FIX$(v,1,50)+"kt" ELSE str$=SCI$(v,1,100) c%=PosInStr%:("E",str$,3) IF MID$(str$,c%+1,1)="+" str$=LEFT$(str$,c%-1)+"*10^"+MID$(str$,c%+2,2)+"kt" ELSE str$=LEFT$(str$,c%-1)+"*10^"+MID$(str$,c%+1,3)+"kt" ENDIF ENDIF ENDIF RETURN str$ENDP PROC FormatStr_Duration$:(time) LOCAL str$(100),t,c% IF format%(8)=2 AND ABS(time)>=0.1 REM separated t=ABS(time) str$=FIX$(modulo:(t,60),1,6) t=t/60 IF t>=1 str$=FIX$(modulo:(t,60),0,6)+"'"+str$+CHR$(%") t=t/60 ELSE str$=str$+"s" ENDIF IF t>=1 str$=FIX$(modulo:(t,24),0,6)+"h"+str$ t=t/24 ENDIF IF t>=1 str$=FIX$(modulo:(t,365),0,6)+"d"+str$ t=t/365 ENDIF IF t>=1 str$=FIX$(t,0,100)+"a"+str$ ENDIF IF time<0 : str$="-"+str$ : ENDIF ELSE REM floating point IF ABS(time)<0.1 str$=SCI$(time,1,100) c%=PosInStr%:("E",str$,3) IF MID$(str$,c%+1,1)="+" str$=LEFT$(str$,c%-1)+"*10^"+MID$(str$,c%+2,2)+"s" ELSE str$=LEFT$(str$,c%-1)+"*10^"+MID$(str$,c%+1,3)+"s" ENDIF ELSEIF ABS(time)<60 str$=FIX$(time,2,6)+"s" ELSEIF ABS(time)<3600 str$=FIX$(time/60,1,7)+"min" ELSEIF ABS(time)<24.0*3600.0 str$=FIX$(time/3600,2,7)+"h" ELSE str$=FIX$(time/(3600.0*24.0),2,100)+"d" ENDIF ENDIF RETURN str$ENDPPROC FormatStr_Time$:(time,offs&,adaydiff&) LOCAL str$(50),hour$(5),min$(5) LOCAL sec$(30),hour%,min%,sec,id& GetTime:(time,ADDR(hour%),ADDR(min%),ADDR(sec))  id&=DTNewDateTime&:(1970,1,15,hour%,min%,0,0) DTAddSecs:(id&,offs&) hour%=DTHour&:(id&) min% =DTMinute&:(id&) POKEL adaydiff&,(DTDay&:(id&)-15) DTDeleteDateTime:(id&) IF format%(3)=1 AND hour%>12 hour$=GEN$(hour%-12,5) ELSE hour$=GEN$(hour%,5) ENDIF IF hour%<10 : hour$="0"+hour$ : ENDIF min$ =GEN$(min%,5) : IF min%<10 : min$="0"+min$ : ENDIF IF sec=INTF(sec) sec$=GEN$(INT(sec),5) ELSE sec$ =FIX$(sec,1,30) ENDIF IF sec<10 : sec$="0"+sec$ : ENDIF IF format%(2)=1 str$=hour$+":"+min$+":"+sec$ ELSEIF format%(2)=2 str$=hour$+"h"+min$+"m"+sec$+"s" ELSE RETURN "" ENDIF IF format%(3)=1 IF hour%>12 str$=str$+" pm" ELSE str$=str$+" am" ENDIF ENDIF RETURN str$ENDPPROC FormatStr_Date$:(date,daydiff&) LOCAL str$(50),day$(5),mon$(5),year$(10),id&,secs&,d% LOCAL day%,month%,year%,yearf GetTime:(date,ADDR(day%),ADDR(month%),ADDR(yearf)) year%=INT(yearf+0.5)+1900 IF year%<1970 : year%=year%+100 : ENDIF secs&=DATETOSECS(year%,month%,day%,0,0,0) secs&=secs&+daydiff&*3600.0*24.0 SECSTODATE secs&,year%,month%,day%,d%,d%,d%,d% day$ =GEN$(day%,5) : IF day%<10 : day$="0"+day$ : ENDIF mon$ =GEN$(month%,5) : IF month%<10 : mon$="0"+mon$ : ENDIF year$ =GEN$(year%,10) IF format%(4)=1 str$=year$+"/"+mon$+"/"+day$ ELSEIF format%(4)=2 str$=year$+"/"+day$+"/"+mon$ ELSEIF format%(4)=3 str$=year$+"-"+mon$+"-"+day$ ELSEIF format%(4)=4 str$=day$+"."+mon$+"."+year$ ELSE RETURN "" ENDIF RETURN str$ENDPPROC FormatStr_Latitude$:(lat,dflag%) LOCAL g%,m%,s,g$(5),m$(5),s$(50),value,str$(255) value=ABS(lat) g%=INT(value) g$ =GEN$(g%,5) : IF g%<10 : g$="0"+g$ : ENDIF IF format%(1)=1 m%=INT((value-INT(value))*60) s =(value*60-INT(value*60))*60 m$=GEN$(m%,5) : IF m%<10 : m$="0"+m$ : ENDIF IF s=INTF(s) s$=GEN$(INT(s),50) ELSE s$ =FIX$(s,3,50) ENDIF IF s<10 : s$="0"+s$ : ENDIF str$=g$+"°"+m$+"'"+s$+CHR$(%") ELSEIF format%(1)=2 s =(value-INT(value))*60 s$=FIX$(s,5,50) str$=g$+"°"+s$+"'" ELSEIF format%(1)=3 s$=FIX$(value,7,50) IF value<10 : s$="0"+s$ : ENDIF str$=s$+"°" ELSE RETURN "" ENDIF IF dflag% IF lat<0 : str$=str$+"S" : ELSE str$=str$+"N" : ENDIF ENDIF RETURN str$ENDPPROC FormatStr_Longitude$:(long,dflag%) LOCAL g%,m%,s,g$(5),m$(5),s$(50),value,str$(255) value=ABS(long) g%=INT(value) g$ =GEN$(g%,5) : IF g%<10 : g$="0"+g$ : ENDIF IF format%(1)=1 m%=INT((value-INT(value))*60) s =(value*60-INT(value*60))*60 m$=GEN$(m%,5) : IF m%<10 : m$="0"+m$ : ENDIF IF s=INTF(s) s$=GEN$(INT(s),50) ELSE s$ =FIX$(s,3,50) ENDIF IF s<10 : s$="0"+s$ : ENDIF str$=g$+"°"+m$+"'"+s$+CHR$(%") ELSEIF format%(1)=2 s =(value-INT(value))*60 s$=FIX$(s,5,50) str$=g$+"°"+s$+"'" ELSEIF format%(1)=3 s$=FIX$(value,7,50) IF value<10 : s$="0"+s$ : ENDIF str$=s$+"°" ELSE RETURN "" ENDIF IF dflag% IF long<0 : str$=str$+"E" : ELSE str$=str$+"W" : ENDIF ENDIF RETURN str$ENDPREM *** Parser for inputs of latitude/longitude ***PROC Val_LatLonStr:(_str$,lat%,giprnt%) LOCAL mode%,c%,c1%,grad,mins,secs,value,char%,dir% LOCAL str$(30),t$(15) str$=UPPER$(_str$) IF lat% : t$="Latitude: " : ELSE t$="Longitude: " : ENDIF c%=1 REM remove all white spaces WHILE c%<=LEN(str$) IF PEEKB(ADDR(str$)+c%)=32 IF c%=1 str$=MID$(str$,2,255) ELSEIF c%=LEN(str$) str$=LEFT$(str$,c%-1) ELSE str$=LEFT$(str$,c%-1)+MID$(str$,c%+1,255) ENDIF ELSE c%=c%+1 ENDIF ENDWH  REM parse dir%=ASC(UPPER$(RIGHT$(str$,1))) IF ((dir%=%N OR dir%=%S) AND lat%) OR ((dir%=%E OR dir%=%W) AND NOT lat%) str$=LEFT$(str$,LEN(str$)-1) ELSE dir%=0 ENDIF IF LPosInStr%:("-",str$)>1 IF giprnt% : gIPRINT t$+"Wrong symbol '-'",2 : ENDIF RETURN -1000 ENDIF  grad=0 : mins=0 : secs=0 mode%=1 : c%=0 IF PEEKB(ADDR(str$)+1)=%- : c%=1 : ENDIF WHILE c%LEN(str$) : char%=0 : BREAK : ENDIF char%=PEEKB(ADDR(str$)+c%) UNTIL (char%<%0 OR char%>%9) AND char%<>%. value=StrVal:(MID$(str$,c1%,c%-c1%)) IF mode%=1 IF char%<>0 AND char%<>%° IF giprnt% : gIPRINT t$+"Wrong symbol '"+CHR$(char%)+"'",2 : ENDIF RETURN -1000 ENDIF grad=value IF (ABS(grad)>90 AND lat%) OR (ABS(grad)>180 AND NOT lat%) IF giprnt% : gIPRINT t$+"Wrong value for degrees",2 : ENDIF RETURN -1000 ENDIF IF PEEKB(ADDR(str$)+1)=%- : grad=-grad : ENDIF mode%=2 ELSEIF mode%=2 IF char%<>0 AND char%<>%' IF giprnt% : gIPRINT t$+"Wrong symbol '"+CHR$(char%)+"'",2 : ENDIF RETURN -1000 ENDIF mins=value IF mins>=60 IF giprnt% : gIPRINT t$+"Wrong value for minutes",2 : ENDIF RETURN -1000 ENDIF mode%=3 ELSE IF char%<>0 AND char%<>%" IF giprnt% : gIPRINT t$+"Wrong symbol '"+CHR$(char%)+"'",2 : ENDIF RETURN -1000 ENDIF secs=value IF secs>=60 IF giprnt% : gIPRINT t$+"Wrong value for seconds",2 : ENDIF RETURN -1000 ENDIF ENDIF ENDWH IF grad<0 AND dir%<>0 IF giprnt% : gIPRINT t$+"No signed value allowed",2 : ENDIF RETURN -1000 ENDIF grad=grad+(mins+secs/60.0)/60.0 IF dir%=%S OR dir%=%E : grad=-grad : ENDIF RETURN gradENDPREM *** Select location from waypoint/world database ***PROC LocationFromDatabase%:(openlast%,acity&,acountry&,alat&,alon&) LOCAL r%,c%,sel%,file$(255),q$(255),wayp$(255) LOCAL id$(10),desc$(100),alt,lat,lon,wnum% IF openlast% file$=LastWaypointFile$ IF file$<>"" IF NOT EXIST(file$) : file$="" : ENDIF ENDIF ELSE file$="" ENDIF DO IF file$<>"" DO q$=file$+" SELECT name FROM waypoints" ONERR notopen:: OPEN q$,Q,n$ ONERR off BREAKnotopen:: ONERR off IF NOT ErrorMessage%:("Open waypoint file",ERR,KTrue%) dINIT "Location from database" dTEXT "Waypoint file:",ExtractFile$:(file$)  dBUTTONS " Waypoint file"+KDots$+" ",%F," World database"+KDots$+" ",%W,"Cancel",-(27+$100) GOTO dlgdone:: ENDIF UNTIL KFalse% FIRST  dINIT "Location from database" dTEXT "Waypoint file:",ExtractFile$:(file$)  dTEXT "","",$800 IF EOF dTEXT "Waypoint:","No waypoint defined." dBUTTONS " Change file"+KDots$+" ",%F," World database"+KDots$+" ",%W,"Cancel",-(27+$100) ELSE wayp$=Q.n$ c%=2 sel%=1 Busy:("Building waypoint list"+KDots$,1) DO NEXT IF EOF dCHOICE sel%,"Waypoint:",wayp$ BREAK ENDIF dCHOICE sel%,"Waypoint:",wayp$+",..." wayp$=Q.n$ c%=c%+1 UNTIL KFalse% Busy:(KBusyOff$,0) dBUTTONS " Change file"+KDots$+" ",%F," World database"+KDots$+" ",%W,"Cancel",-(27+$100),"Okay",13+$100 ENDIF CLOSE  ELSE dINIT "Location from database" dBUTTONS " Waypoint file"+KDots$+" ",%F," World database"+KDots$+" ",%W,"Cancel",-(27+$100) ENDIFdlgdone:: Lock:(KLock%) : r%=DIALOG : Lock:(KUnlock%) IF r%=13 IF GetWaypoint%:(file$,sel%,acity&,acountry&,alat&,alon&,ADDR(alt)) RETURN 2 ELSE RETURN 0 ENDIF ELSEIF r%=%f file$=GetWaypointFile$:("Select waypoint file",KFalse%,KFalse%) IF file$="" : RETURN 0 : ENDIF LastWaypointFile$=file$ CONTINUE ELSEIF r%=%w IF ChooseCityDlg%:(acity&,acountry&,alat&,alon&) RETURN 1 ENDIF ENDIF RETURN 0 UNTIL KFalse%ENDPREM *** Dialog for selecting a city of world database ***PROC ChooseCityDlg%:(acity&,acountry&,alat&,alon&) LOCAL wid%,w%,h%,bw%,cur%,curold%,tw%,oldid% LOCAL event&(16),k&,xptr%,yptr%,lat,lon,td& LOCAL win_x0%,win_y0%,okay% LOCAL city$(255),country$(255),new$(255),iscapital%  IF NOT TestOwnWldDatabase%: : RETURN KFalse% : ENDIF  oldid%=gIDENTITY  REM create window, which looks like a dialog window REM and consists of 2 choice-boxes w%=400 : h%=135 : bw%=80 win_x0%=MAX((screen_xsize%-w%)/2,0) win_y0%=MAX((screen_ysize%-h%)/2,0) wid%=gCreateWindow%:(win_x0%,win_y0%,w%,h%,"Select city from world database") IF wid%<0 : RETURN KFalse% : ENDIF  Lock:(KLock%) cur%=1 : curold%=0  gAT 15,50 : gPRINT "Country" gAT 15,75 : gPRINT "City" gCOLOR 170,170,170 gAT w%/2-20,33 : gBOX w%/2-15,21 gAT w%/2-20,58 : gBOX w%/2-15,21 gCOLOR 0,0,0 gFONT 10 : gSTYLE 1 gAT w%/2-bw%-5,h%-40 : gBUTTON "Okay",2,bw%,25,0 gAT w%/2+5,h%-40 : gBUTTON "Cancel",2,bw%,25,0 gFONT 12 : gSTYLE 0 gVISIBLE on  city$=WldHome$: country$=SIHomeCountry$:  DO IF cur%<>curold% IF cur%=1 tw%=gTWIDTH("Country") gAT 14,35 : gINVERT tw%+2,19 IF curold%=2 tw%=gTWIDTH("City") gAT 14,60 : gINVERT tw%+2,19 ENDIF gTriang:(w%/2-25,36,48,-1,0) gTriang:(w%-30,36,48,1,0) ELSE tw%=gTWIDTH("City") gAT 14,60 : gINVERT tw%+2,19 IF curold%=1 tw%=gTWIDTH("Country") gAT 14,35 : gINVERT tw%+2,19 ENDIF gTriang:(w%/2-25,61,73,-1,0) gTriang:(w%-30,61,73,1,0) ENDIF IF curold%=1 gTriang:(w%/2-25,36,48,-1,1) gTriang:(w%-30,36,48,1,1) ELSEIF curold%=2 gTriang:(w%/2-25,61,73,-1,1) gTriang:(w%-30,61,73,1,1) ENDIF curold%=cur% ENDIF REM show current city and country gAT w%/2-15,49 : gPRINTB country$,w%/2-40 gAT w%/2-15,74 : gPRINTB city$,w%/2-40  GETEVENT32 event&() k&=event&(KEvaType%) IF k&=KEvPtr& REM pointer event xptr%=event&(KEvAPtrScreenPosX%)-win_x0% yptr%=event&(KEvAPtrScreenPosY%)-win_y0% IF event&(KEvAPtrType%)=KEvPtrPenDown& gFONT 10 : gSTYLE 1 IF xptr%>=w%/2-bw%-5 AND yptr%>=h%-40 AND xptr%<=w%/2-5 AND yptr%<=h%-15 REM OKAY gAT w%/2-bw%-5,h%-40 : gBUTTON "Okay",2,bw%,25,1 ELSEIF xptr%>=w%/2+5 AND yptr%>=h%-40 AND xptr%<=w%/2+5+bw% AND yptr%<=h%-15 REM CANCEL gAT w%/2+5,h%-40 : gBUTTON "Cancel",2,bw%,25,1 ENDIF gFONT 12 : gSTYLE 0 IF xptr%>10 AND xptr%=w%/2-35 AND xptr%<=w%/2-25 AND yptr%>=35 AND yptr%<=49 REM prev country Busy:("Searching"+KDots$,1) new$=GetPrevCountry$:(country$) IF new$<>"" country$=new$ city$=GetFirstCityOfCountry$:(country$) ENDIF  ELSEIF cur%=1 AND xptr%>=w%-30 AND xptr%<=w%-20 AND yptr%>=35 AND yptr%<=49 REM next country Busy:("Searching"+KDots$,1) new$=GetNextCountry$:(country$) IF new$<>"" country$=new$ city$=GetFirstCityOfCountry$:(country$)  ENDIF  ELSEIF cur%=2 AND xptr%>=w%/2-35 AND xptr%<=w%/2-25 AND yptr%>=60 AND yptr%<=74 REM prev city Busy:("Searching"+KDots$,1) new$=GetPrevCityOfCountry$:(city$,country$) IF new$<>"" : city$=new$ : ENDIF  ELSEIF cur%=2 AND xptr%>=w%-30 AND xptr%<=w%-20 AND yptr%>=60 AND yptr%<=74 REM next city Busy:("Searching"+KDots$,1) new$=GetNextCityOfCountry$:(city$,country$) IF new$<>"" : city$=new$ : ENDIF  ENDIF IF yptr%>=35 AND yptr%<=55 cur%=1 ELSEIF yptr%>=60 AND yptr%<=80 cur%=2 ENDIF Busy:(KBusyOff$,0) ENDIF ELSEIF event&(KEvAPtrType%)=KEvPtrPenUp& gFONT 10 : gSTYLE 1 gAT w%/2-bw%-5,h%-40 : gBUTTON "Okay",2,bw%,25,0 gAT w%/2+5,h%-40 : gBUTTON "Cancel",2,bw%,25,0 gFONT 12 : gSTYLE 0 IF xptr%>=w%/2-bw%-5 AND yptr%>=h%-40 AND xptr%<=w%/2-5 AND yptr%<=h%-15 REM OKAY okay%=KTrue% : BREAK ELSEIF xptr%>=w%/2+5 AND yptr%>=h%-40 AND xptr%<=w%/2+5+bw% AND yptr%<=h%-15 REM CANCEL okay%=KFalse% : BREAK ENDIF ENDIF Busy:(KBusyOff$,0) ELSEIF (event&(1) AND $400)=0 REM key pressed k&=event&(1) IF (k&>=%A AND k&<=%Z) OR (k&>=%a AND k&<=%z) OR k&=%Ö OR k&=%Ü OR k&=%Ä OR k&=%ö OR k&=%ü OR k&=%ä IF cur%=1 new$=GetFullCountry$:(CHR$(k&)) IF new$<>"" country$=new$ city$=GetFirstCityOfCountry$:(country$) ENDIF ELSE new$=GetFullCity$:(CHR$(k&),country$) IF new$<>"" : city$=new$ : ENDIF ENDIF ELSEIF k&=KKeyDownArrow32% cur%=2 ELSEIF k&=KKeyUpArrow32% cur%=1 ELSEIF k&=KKeyLeftArrow32% IF cur%=1 Busy:("Searching"+KDots$,1) new$=GetPrevCountry$:(country$) IF new$<>"" country$=new$ city$=GetFirstCityOfCountry$:(country$) ENDIF ELSE REM prev city Busy:("Searching"+KDots$,1) new$=GetPrevCityOfCountry$:(city$,country$) IF new$<>"" : city$=new$ : ENDIF ENDIF ELSEIF k&=KKeyRightArrow32% IF cur%=1 Busy:("Searching"+KDots$,1) new$=GetNextCountry$:(country$) IF new$<>"" country$=new$ city$=GetFirstCityOfCountry$:(country$)  ENDIF ELSE REM next city Busy:("Searching"+KDots$,1) new$=GetNextCityOfCountry$:(city$,country$) IF new$<>"" : city$=new$ : ENDIF ENDIF ELSEIF k&=KKeyESC% okay%=KFalse% : BREAK ELSEIF k&=KKeyEnter% okay%=KTrue% : BREAK ENDIF ENDIF skip:: ONERR off Busy:(KBusyOff$,0) UNTIL KFalse%  gCLOSE wid% gUSE oldid% Lock:(KUnlock%)  IF okay% GetCityInfos%:(city$,country$,ADDR(lat),ADDR(lon),ADDR(td&),ADDR(iscapital%)) POKEF alat&,PEEKF(ADDR(lat)) POKEF alon&,PEEKF(ADDR(lon)) POKE$ acity&,city$ POKE$ acountry&,country$ RETURN KTrue% ENDIF RETURN KFalse%ENDPREM *** draw a filled triangle ***REM x% = position of left/right sidePROC gTriang:(x%,y1%,y2%,dx%,gmode%) LOCAL c%,ya%,yb% gGMODE gmode% c%=x% IF y1%>y2% ya%=y2% : yb%=y1% ELSE ya%=y1% : yb%=y2% ENDIF WHILE ya%0.175 slat1=SIN(rlat1) : slat2=SIN(rlat2) c=ACOS(slat1*slat2+clat1*clat2*COS(rlon1-rlon2)) ELSE s1=SIN(dlat/2) s2=SIN(dlon/2) c=2*ASIN(SQR(s1*s1+clat1*clat2*s2*s2)) ENDIF c2=c*c  WHILE c%0.175 a=ACOS(slat*slat1+clat*clat1*COS(rlon-rlon1)) ELSE s1=SIN(dlat/2) s2=SIN(dlon/2) a=2*ASIN(SQR(s1*s1+clat*clat1*s2*s2)) ENDIF dlat=rlat-rlat2 dlon=rlon-rlon2 IF SQR(dlat*dlat+dlon*dlon)>0.175 b=ACOS(slat*slat2+clat*clat2*COS(rlon-rlon2)) ELSE s1=SIN(dlat/2) s2=SIN(dlon/2) b=2*ASIN(SQR(s1*s1+clat*clat2*s2*s2)) ENDIF IF ABS(a)<1e-20 OR ABS(b)<1e-20 dist=0 ELSE gamma=(c2-a*a-b*b)/(-2*a*b) IF ABS(gamma)<1 gamma=ACOS(gamma) ELSE gamma=0 ENDIF dist=ABS(a*b*SIN(gamma)/c) ENDIF IF dist>distmax distmax=dist : p%=c% ENDIF c%=c%+1 : aoff&=aoff&+8 ENDWH POKEF adist&,distmax RETURN p%ENDPPROC CompressTrack%:(tonum%,num%,alat&,alon&,aheight&,atime&,dlg%) LOCAL p1%(KMaxTrackPoints%),p2%(KMaxTrackPoints%) LOCAL p3%(KMaxTrackPoints%),d(KMaxTrackPoints%) LOCAL nextp%(KMaxTrackPoints%),pos1%,pos2%,d1,d2 LOCAL c%,c2%,i%,dmax,pmax%,aoff1&,aoff2& LOCAL lat,lon,lat1,lon1,lat2,lon2,h,h1,h2,R  pos1%=CutPointOfTrack%:(1,num%,alat&,alon&,ADDR(d1)) p1%(1)=1 : p2%(1)=num% : p3%(1)=pos1% d(1)=d1 : nextp%(1)=0 i%=1  WHILE i%+1dmax : dmax=d(c%) : pmax%=c% : ENDIF c%=c%+1 ENDWH IF dmax=0 : BREAK : ENDIF pos1%=CutPointOfTrack%:(p1%(pmax%),p3%(pmax%),alat&,alon&,ADDR(d1)) pos2%=CutPointOfTrack%:(p3%(pmax%),p2%(pmax%),alat&,alon&,ADDR(d2)) i%=i%+1 p1%(i%)=p3%(pmax%) : p2%(i%)=p2%(pmax%) : p3%(i%)=pos2% p2%(pmax%)=p3%(pmax%) : p3%(pmax%)=pos1% d(pmax%)=d1 : d(i%)=d2 nextp%(i%)=nextp%(pmax%) : nextp%(pmax%)=i% ENDWH  c%=0 : c2%=nextp%(1) : aoff1&=8 WHILE c2%>0 aoff2&=INT(FLT(p1%(c2%)-1)*8.0) POKEF alat&+aoff1&,PEEKF(alat&+aoff2&) POKEF alon&+aoff1&,PEEKF(alon&+aoff2&) POKEF atime&+aoff1&,PEEKF(atime&+aoff2&) POKEF aheight&+aoff1&,PEEKF(aheight&+aoff2&) c2%=nextp%(c2%) c%=c%+1 : aoff1&=aoff1&+8 ENDWH aoff2&=INT(FLT(num%-1)*8.0) POKEF alat&+aoff1&,PEEKF(alat&+aoff2&) POKEF alon&+aoff1&,PEEKF(alon&+aoff2&) POKEF atime&+aoff1&,PEEKF(atime&+aoff2&) POKEF aheight&+aoff1&,PEEKF(aheight&+aoff2&) i%=i%+1  IF dlg% c%=1 : dmax=0 WHILE c%<=i% IF d(c%)>dmax : dmax=d(c%) : pmax%=c% : ENDIF c%=c%+1 ENDWH IF dmax>0 aoff1&=INT(FLT(p3%(pmax%)-1)*8.0) lat =PEEKF(alat&+aoff1&) : lon =PEEKF(alon&+aoff1&) h =PEEKF(aheight&+aoff1&) aoff1&=INT(FLT(p1%(pmax%)-1)*8.0) lat1=PEEKF(alat&+aoff1&) : lon1=PEEKF(alon&+aoff1&) h1 =PEEKF(aheight&+aoff1&) aoff1&=INT(FLT(p2%(pmax%)-1)*8.0) lat2=PEEKF(alat&+aoff1&) : lon2=PEEKF(alon&+aoff1&) h2 =PEEKF(aheight&+aoff1&) dmax=ABS(DistPointLine:(lat,lon,lat1,lon1,lat2,lon2,(h+h1+h2)/3+KMeanEarthRadius)) ENDIF  Busy:(KBusyOff$,0) dINIT "Track compression results" dTEXT "Original point#",FIX$(num%,0,10) dTEXT "New point#",FIX$(i%,0,10) dTEXT "Rate",FIX$(100-FLT(i%)/num%*100,1,10)+"%" dTEXT "Maximal error",FormatStr_Distance$:(dmax,KFalse%) dBUTTONS " Okay ",13+$100 Lock:(KLock%) : DIALOG : Lock:(KUnlock%) ENDIF  RETURN i%ENDPREM *** Draw track into current drawable ***PROC DrawTrack:(map_sx%,map_sy%,lati,lata,loni,lona,num%,alat&,alon&,aheight&,atime&,apx&,apy&,thick%) LOCAL c%,cc%,px%,py%,lat,lon,aoff&,dx%(5),dy%(5) LOCAL inf&(48),col% dx%(1)=0 : dy%(1)=1 : dx%(2)=0 : dy%(2)=-1 dx%(3)=1 : dy%(3)=0 : dx%(4)=-1 : dy%(4)=0 dx%(5)=0 : dy%(5)=0 IF thick% : cc%=1 : ELSE cc%=5 : ENDIF gINFO32 inf&() col%=inf&(30) AND $000F IF col%=0 : col%=255 : ELSE col%=100 : ENDIF  DO IF cc%=5 : col%=0 : ENDIF gCOLOR col%,col%,col% lat=PEEKF(alat&) lon=PEEKF(alon&) px%=map_sx%-(lon-loni)*map_sx%/(lona-loni) py%=map_sy%-(lat-lati)*map_sy%/(lata-lati) gAT px%+dx%(cc%),py%+dy%(cc%) c%=2 : aoff&=8 WHILE c%<=num% lat=PEEKF(alat&+aoff&) lon=PEEKF(alon&+aoff&) px%=map_sx%-(lon-loni)*map_sx%/(lona-loni)+dx%(cc%) py%=map_sy%-(lat-lati)*map_sy%/(lata-lati)+dy%(cc%) gLINETO px%,py% c%=c%+1 : aoff&=aoff&+8 ENDWH cc%=cc%+1 UNTIL cc%>5 POKEW apx&,px% POKEW apy&,py%ENDPREM *** Analyse a track (statistic, diagrams, ...) ***PROC AnalyseTrack:(route%) LOCAL file$(255),file2$(255),Track_desc$(255),Track_num% LOCAL Track_lat(KMaxTrackPoints%),Track_lon(KMaxTrackPoints%) LOCAL Track_time(KMaxTrackPoints%),Track_height(KMaxTrackPoints%) LOCAL Track_velocity(KMaxTrackPoints%),Track_lng(KMaxTrackPoints%) LOCAL Track_lati,Track_lata,Track_loni,Track_lona,t,tl LOCAL daydiff&,c%,buffer$(255),r%,re%,h%,num%,aoff&,pos% LOCAL time,length,length2,velmin,velmax,hmax,hmin,l,l2,l3 LOCAL hour%,min%,sec,secs,lasttimepos%,lastheightpos% LOCAL R,R1,R2,mlat,mlon,mheight,slat,slon,sheight,ch% LOCAL maxheight,minheight,maxlat,maxlon,flag% LOCAL init1%,init2%,offs%(6),l&,lmin&,lmax&,winid%  IF route% REMselect route file and convert to track file$=GetRouteFile$:("Open route"+KDots$,KFalse%,KFalse%) IF file$="" : RETURN : ENDIF  file2$=file$+" SELECT * FROM header" ONERR notopen:: OPEN file2$,X,d$,wnum% Track_num%=X.wnum% Track_desc$=X.d$ CLOSE IF Track_num%>KMaxTrackPoints% Track_num%=KMaxTrackPoints% dINIT "Reading route"+KDots$ dTEXT "","This route contains too many waypoints.",2 dTEXT "","Only the first "+FIX$(KMaxTrackPoints%,0,10)+" waypoints can be used",2 dTEXT "","for the following procedures.",2 dBUTTONS " Okay ",13+$100 Lock:(KLock%) : DIALOG : Lock:(KUnlock%) ELSEIF Track_num%=0 ShortMessagePrompt:("Analyse route","Route is empty.") RETURN ELSEIF Track_num%=1 ShortMessagePrompt:("Analyse route","Route consits of only 1 waypoint.") RETURN ENDIF file2$=file$+" SELECT * FROM waypoints ORDER BY pos" OPEN file2$,Y,pos%,n$,lat,lon,alt ONERR off Busy:("Reading route"+KDots$,1) c%=1 : FIRST Track_lati=1000 : Track_lata=-1000 Track_loni=1000 : Track_lona=-1000 WHILE c%<=Track_num% IF Y.latTrack_lata : Track_lata=Y.lat : ENDIF IF Y.lonTrack_lona : Track_lona=Y.lon : ENDIF Track_lat(c%)=Y.lat Track_lon(c%)=Y.lon Track_height(c%)=Y.alt Track_time(c%)=KMaxFloat NEXT c%=c%+1 ENDWH Busy:(KBusyOff$,0) CLOSE GOTO wasopened:: notopen:: ONERR off ErrorMessage%:("Open route file",ERR,KFalse%) RETURN wasopened::  ELSE REM select and read track file file$=LastTrackFile$ IF UseFastFileDialog% file$=FileDialog$:("Open track"+KDots$,file$,KFalse%,"",&0) IF file$="" : RETURN : ENDIF ELSE Busy:("Building file list"+KDots$,1) dINIT "Open track"+KDots$ dFILE file$,"Trackfile,Folder,Disk",16+UseSystemFolder& dBUTTONS " Cancel ",-(27+$100),"Open",13+$100 Busy:(KBusyOff$,0) Lock:(KLock%) : r%=DIALOG : Lock:(KUnlock%) IF r%<>13 : RETURN : ENDIF ENDIF  LastTrackFile$=file$ DO r%=IOOPEN(h%,file$,$400) IF r% IF NOT ErrorMessage%:("Open track file",r%,KTrue%) RETURN ENDIF ENDIF UNTIL r%=0  Busy:("Reading track"+KDots$,1) ONERR readerr:: IOREAD(h%,ADDR(Track_desc$),256) IOREAD(h%,ADDR(Track_num%),2)  IF Track_num%>KMaxTrackPoints% OR Track_num%<=1 GOTO readerr:: ENDIF aoff&=INT(FLT(Track_num%)*8.0) IOREAD(h%,ADDR(Track_lat(1)),aoff&) IOREAD(h%,ADDR(Track_lon(1)),aoff&) c%=1 WHILE c%<=Track_num% IF (ABS(Track_lat(c%))>90 AND Track_lat(c%)180 AND Track_lon(c%)3 dBUTTONS "2nd page"+KDots$,%P+$200," Show on map"+KDots$+" ",%S+$200,"Compress"+KDots$,%C+$200,"Okay",13 ELSEIF Track_num%=3 dBUTTONS "2nd page"+KDots$,%P+$200," Show on map"+KDots$+" ",%S+$200,"Compress",%C+$200,"Okay",13 ELSE dBUTTONS "2nd page"+KDots$,%P+$200," Show on map"+KDots$+" ",%S+$200,"Okay",13 ENDIF ENDIF Lock:(KLock%) : r%=DIALOG : Lock:(KUnlock%) IF r%=%s REM show on map RealMap:(KFalse%,KFalse%,Track_num%,Track_lati,Track_lata,Track_loni,Track_lona,ADDR(Track_lat(1)),ADDR(Track_lon(1)),ADDR(Track_time(1)),ADDR(Track_height(1)),1000,1000,0)  ELSEIF r%=%p REM more information  IF init1% c%=1 : length=0 : length2=0 velmax=0 : velmin=KMaxFloat : time=0 hmax=0 : hmin=KMaxFloat lasttimepos%=0 : lastheightpos%=0 Track_lng(1)=0 WHILE c%<=Track_num%  Track_velocity(c%)=KMaxFloat IF c%>1 Busy:("Computing... "+FIX$(c%*100.0/Track_num%,0,3)+"%",1) R1=0 : R2=0 IF Track_height(c%-1)0 R=Track_height(lastheightpos%)+KMeanEarthRadius ELSE R=KMeanEarthRadius ENDIF ENDIF l=SphAndDirectDistance:(Track_lat(c%-1),Track_lon(c%-1),Track_lat(c%),Track_lon(c%),KMeanEarthRadius,R,R1,R2,R,ADDR(l3),ADDR(l2)) length=length+l length2=length2+l2 Track_lng(c%)=length2 ENDIF IF Track_time(c%)0  GetTime:(Track_time(c%),ADDR(hour%),ADDR(min%),ADDR(sec)) secs =FLT(hour%)*3600+FLT(min%)*60+sec GetTime:(Track_time(lasttimepos%),ADDR(hour%),ADDR(min%),ADDR(sec)) secs =secs-FLT(hour%)*3600-FLT(min%)*60-sec IF Track_time(c%)0 time=time+secs IF lasttimepos%<>c%-1 IF Track_height(c%)0 R=Track_height(lastheightpos%)+KMeanEarthRadius ELSE R=KMeanEarthRadius ENDIF l3=SphericalDistance:(Track_lat(c%),Track_lon(c%),Track_lat(lasttimepos%),Track_lon(lasttimepos%),R) ENDIF l3=l3/secs Track_velocity(c%)=l3 IF l3>velmax : velmax=l3 : ENDIF IF l3Track_height(c%) : hmin=Track_height(c%) : ENDIF ENDIF c%=c%+1 ENDWH Busy:(KBusyOff$,0) init1%=KFalse% ENDIF  DO IF route% dINIT "Route ("+ExtractFile$:(file$)+")",1 ELSE dINIT "Track ("+ExtractFile$:(file$)+")",1 ENDIF IF NOT route% : dTEXT ""," " : ENDIF dTEXT "Length above MSL",FormatStr_Distance$:(length,KFalse%) dTEXT "Real length",FormatStr_Distance$:(length2,KFalse%) dTEXT "Spherical distance",FormatStr_Distance$:(SphericalDistance:(Track_lat(1),Track_lon(1),Track_lat(Track_num%),Track_lon(Track_num%),(Track_height(1)+Track_height(Track_num%))/2+KMeanEarthRadius),KFalse%),$200 IF time>0 dTEXT "Time",FormatStr_Duration$:(time),$200 ELSE dTEXT "Time","(too less datas) ",$200 ENDIF IF NOT route% dTEXT "Extremal velocities",GEN$(velmin,10)+" ... "+GEN$(velmax,10)+"m/s " ENDIF IF hmin=KMaxFloat dTEXT "Extremal altitudes","(no datas) " ELSE dTEXT "Extremal altitudes",GEN$(hmin,10)+" ... "+GEN$(hmax,10)+"m " ENDIF IF route% dBUTTONS " Altitude diagram ",%D+$200,"Cancel",-(27+$100),"Back",13 ELSE dBUTTONS "SA"+KDots$,%S+$200," Diagrams"+KDots$+" ",%D+$200,"Cancel",-(27+$100),"Back",13 ENDIF Lock:(KLock%) : r%=DIALOG : Lock:(KUnlock%)  IF r%=%d AND Track_num%>5 IF NOT route% dINIT "Track diagrams" r%=1 dCHOICE r%,"Function","altitude(time),velocity(time),altitude(length),velocity(length)" dBUTTONS " Cancel ",-(27+$100),"Show",13+$100 Lock:(KLock%) : re%=DIALOG : Lock:(KUnlock%) IF re%<>13 : r%=0 : ENDIF ELSE r%=3 ENDIF  IF r%=1 AND hmax>0 winid%=gCreateWindow%:(MAX(screen_xsize%/2-300,0),MAX(screen_ysize%/2-100,0),600,200,"Altitude as a function of time") IF winid%<0 : CONTINUE : ENDIF Lock:(KLock%) gFONT 10 gAT 70,55 : gLINEBY 0,115 : gLINEBY 510,0 gAT 10,64 c%=1 : t=0 gVISIBLE on Busy:("Please wait",1) lastheightpos%=KFalse% : lasttimepos%=0 WHILE c%<=Track_num% IF Track_time(c%)0 GetTime:(Track_time(c%),ADDR(hour%),ADDR(min%),ADDR(sec)) secs =FLT(hour%)*3600+FLT(min%)*60+sec GetTime:(Track_time(lasttimepos%),ADDR(hour%),ADDR(min%),ADDR(sec)) secs =secs-FLT(hour%)*3600-FLT(min%)*60-sec IF Track_time(c%)0 gAT 10+t/time*510,185 gPRINT FormatStr_Time$:(Track_time(lasttimepos%),utc_offs&,ADDR(daydiff&)) ENDIF Busy:(KBusyOff$,0) GET gCLOSE winid% Lock:(KUnlock%)  ELSEIF r%=2 AND velmax>0 winid%=gCreateWindow%:(MAX(screen_xsize%/2-300,0),MAX(screen_ysize%/2-100,0),600,200,"Velocity diagram") IF winid%<0 : CONTINUE : ENDIF Lock:(KLock%) gFONT 10 gAT 70,55 : gLINEBY 0,115 : gLINEBY 510,0 gAT 5,64 c%=1 : t=0 : tl=0 lastheightpos%=KFalse% : lasttimepos%=0 gVISIBLE on Busy:("Please wait",1) WHILE c%<=Track_num% IF Track_time(c%)0 GetTime:(Track_time(c%),ADDR(hour%),ADDR(min%),ADDR(sec)) secs =FLT(hour%)*3600+FLT(min%)*60+sec GetTime:(Track_time(lasttimepos%),ADDR(hour%),ADDR(min%),ADDR(sec)) secs =secs-FLT(hour%)*3600-FLT(min%)*60-sec IF Track_time(c%)0 gAT 10+(t+tl)/2/time*510,185 gPRINT FormatStr_Time$:(Track_time(lasttimepos%),utc_offs&,ADDR(daydiff&)) ENDIF Busy:(KBusyOff$,0) GET gCLOSE winid% Lock:(KUnlock%) ELSEIF r%=3 AND hmax>0 winid%=gCreateWindow%:(MAX(screen_xsize%/2-300,0),MAX(screen_ysize%/2-100,0),600,200,"Altitude as a function of way length") IF winid%<0 : CONTINUE : ENDIF Lock:(KLock%) gFONT 10 gAT 70,55 : gLINEBY 0,115 : gLINEBY 510,0 gAT 10,64 c%=1 gVISIBLE on Busy:("Please wait",1) lastheightpos%=KFalse% WHILE c%<=Track_num% IF Track_height(c%)0 : mheight=mheight/ch% : ENDIF  c%=1 : slat=0 : slon=0 : sheight=0 maxlat=-1000 : maxlon=-1000 maxheight=-1e10 : minheight=1e10 WHILE c%<=Track_num% slat=slat+(Track_lat(c%)-mlat)*(Track_lat(c%)-mlat) slon=slon+(Track_lon(c%)-mlon)*(Track_lon(c%)-mlon) IF Track_height(c%)maxheight : maxheight=Track_height(c%) : ENDIF IF Track_height(c%)2 slat=SQR(slat/(c%-2)) slon=SQR(slon/(c%-2)) ENDIF maxheight=MAX(maxheight-mheight,mheight-minheight) maxlat =MAX(Track_lata-mlat,mlat-Track_lati) maxlon =MAX(Track_lona-mlon,mlon-Track_loni) IF ch%>2 : sheight=SQR(sheight/(ch%-2)) : ENDIF Busy:(KBusyOff$,0) init2%=KFalse% ENDIF  dINIT "Selective Availablity",1 dTEXT "Mean latitude",FormatStr_Latitude$:(mlat,KTrue%)+" (±"+FormatStr_Distance$:(Sphericaldistance:(mlat,mlon,mlat+maxlat,mlon,KMeanEarthRadius),KFalse%)+")" dTEXT "Mean longitude",FormatStr_Longitude$:(mlon,KTrue%)+" (±"+FormatStr_Distance$:(Sphericaldistance:(mlat,mlon,mlat,mlon+maxlon,KMeanEarthRadius),KFalse%)+")" IF ch%>0 dTEXT "Mean altitude",FormatStr_Distance$:(mheight,KTrue%)+" (±"+FormatStr_Distance$:(maxheight,KTrue%)+")" ELSE dTEXT "Mean altitude","(no datas)" ENDIF IF Track_num%>1 IF ch%<=0 : mheight=0 : ENDIF dTEXT "Deviation latitude",FormatStr_Latitude$:(slat,KFalse%)+" ("+FormatStr_Distance$:(SphericalDistance:(mlat,mlon,mlat+slat,mlon,mheight+KMeanEarthRadius),KFalse%)+")" dTEXT "Deviation longitude",FormatStr_Longitude$:(slon,KFalse%)+" ("+FormatStr_Distance$:(SphericalDistance:(mlat,mlon,mlat,mlon+slon,mheight+KMeanEarthRadius),KFalse%)+")" IF ch%>1 dTEXT "Deviation altitude",FormatStr_Distance$:(sheight,KTrue%) ELSE dTEXT "Deviation altitude","(too less datas)" ENDIF ELSE dTEXT "Deviation latitude","(too less datas)" dTEXT "Deviation longitude","(too less datas)" dTEXT "Deviation altitude","(too less datas)" ENDIF dBUTTONS " Distance map"+KDots$+" ",%D+$200," Cancel ",-(27+$100),"Back",13 Lock:(KLock%) : r%=DIALOG : Lock:(KUnlock%) IF r%=%d REM show on map IF SphericalDistance:(mlat,mlon,mlat+slat,mlon+slon,KMeanEarthRadius)>200 dINIT "Checking track" dTEXT "","Attention! This track does not seem to be",2 dTEXT "","an SA error tracking. If you continue",2 dTEXT "","the following draw could be incorrect.",2 dBUTTONS "Back",-27," Continue ",13 Lock:(KLock%) : re%=DIALOG : Lock:(KUnlock%) IF re%=13 RealMap:(KFalse%,KFalse%,Track_num%,Track_lati,Track_lata,Track_loni,Track_lona,ADDR(Track_lat(1)),ADDR(Track_lon(1)),ADDR(Track_time(1)),ADDR(Track_height(1)),mlat,mlon,mheight) ENDIF ELSE RealMap:(KFalse%,KFalse%,Track_num%,Track_lati,Track_lata,Track_loni,Track_lona,ADDR(Track_lat(1)),ADDR(Track_lon(1)),ADDR(Track_time(1)),ADDR(Track_height(1)),mlat,mlon,mheight) ENDIF ELSEIF r%<>13 RETURN ENDIF  ELSEIF r%=13 : BREAK ELSE RETURN ENDIF UNTIL KFalse%  ELSEIF r%=%c REM compress track IF Track_num%>3 lmax&=MIN(99,100-200/Track_num%) lmin&=MAX(1,100/Track_num%) l&=90 dINIT "Compress track" dLONG l&,"Select rate: (%)",lmin&,lmax& dBUTTONS "Cancel",-(27+$100)," Compress ",13+$100 Lock:(KLock%) : r%=DIALOG : Lock:(KUnlock%) l&=MAX(2,Track_num%*(100-l&)/100) ELSE r%=13 : l&=2 ENDIF IF r%=13 Busy:("Computing"+KDots$,1) Track_num%=CompressTrack%:(l&,Track_num%,ADDR(Track_lat(1)),ADDR(Track_lon(1)),ADDR(Track_height(1)),ADDR(Track_time(1)),KTrue%) Busy:(KBusyOff$,0) init1%=KTrue%  file2$=file$  IF UseFastFileDialog% dINIT "Enter track description" dEDIT Track_desc$,"Description",20 dBUTTONS " Cancel ",-(27+$100),"Okay",13+$100 Lock:(KLock%) : re%=DIALOG : Lock:(KUnlock%) IF re%=13 file2$=FileDialog$:("Save track"+KDots$,file2$,KTrue%,"",&0) ELSE file2$="" ENDIF ELSEnewfile::  Busy:("Building file list"+KDots$,1) dINIT "Save track"+KDots$  dEDIT Track_desc$,"Track description",20 dFILE file2$,"Filename,Folder,Disk",17+UseSystemFolder& dBUTTONS " Cancel ",-(27+$100),"Save",13+$100 Busy:(KBusyOff$,0) Lock:(KLock%) : re%=DIALOG : Lock:(KUnlock%) IF re%<>13 : file2$="" : ENDIF file$=AddExtension$:(file$,KTrackExtension$) IF EXIST(file$) dINIT "File exist" dTEXT "","Overwrite '"+ExtractFile$:(file$)+"' ?",2 dBUTTONS "No",%N+$300," Yes ",%Y+$300 Lock:(KLock%) : re%=DIALOG : Lock:(KUnlock%) IF re%=%n : GOTO newfile:: : ENDIF ENDIF ENDIF IF file2$<>"" file2$=AddExtension$:(file2$,KTrackExtension$)  LastTrackFile$=file2$ DO r%=IOOPEN(h%,file2$,$102) IF r% IF NOT ErrorMessage%:("Open output file",r%,KTrue%) BREAK ENDIF ENDIF UNTIL r%=0 IF r%=0  file$=file2$ Busy:("Saving"+KDots$,1) aoff&=INT(FLT(Track_num%)*8.0) IOWRITE(h%,ADDR(Track_desc$),256) IOWRITE(h%,ADDR(Track_num%),2) IOWRITE(h%,ADDR(Track_lat(1)),aoff&) IOWRITE(h%,ADDR(Track_lon(1)),aoff&) IOWRITE(h%,ADDR(Track_height(1)),aoff&) IOWRITE(h%,ADDR(Track_time(1)),aoff&) IOWRITE(h%,ADDR(Track_lati),8) IOWRITE(h%,ADDR(Track_lata),8) IOWRITE(h%,ADDR(Track_loni),8) IOWRITE(h%,ADDR(Track_lona),8) IOCLOSE(h%) Busy:(KBusyOff$,0) ENDIF ENDIF ENDIF  ELSE RETURN ENDIF UNTIL KFalse% RETURN readerr:: ONERR off IOCLOSE(h%) Busy:(KBusyOff$,0) ShortMessagePrompt:("Reading track","No correct track file.")ENDPREM *** extracts hour,min,sec from internal time format ***PROC GetTime:(time,ahour&,amin&,asec&) LOCAL hour%,min%,sec,pos%,buf$(255) buf$=FIX$(time,10,20) pos%=LPosInStr%:(".",buf$) IF pos%=0 : pos%=LEN(buf$)+1 : ENDIF WHILE pos%<7 : buf$="0"+buf$ : pos%=pos%+1 : ENDWH hour% =StrVal:(LEFT$(buf$,2)) min% =StrVal:(MID$(buf$,3,2)) sec =StrVal:(MID$(buf$,5,255)) POKEW ahour&,hour% POKEW amin&,min% POKEF asec&,secENDPREM *** Sets the background/data screen ***PROC SetScreen:(num%) LOCAL n%,id%,id2%,c% IF stdscreen%=0 gIPRINT "Error: Not enough memory",1 RETURN ENDIF IF num%=screen% : RETURN : ENDIF  IF num%<0 n%=UserScreen%: IF n%<0 : RETURN : ENDIF ELSE n%=num% ENDIF  gUSE stdscreen% gVISIBLE off IF n%=0 REM none ONERR noload:: id%=gLOADBIT(MyDir$+SPicFile1$,0) ONERR off GOTO isload::noload:: ONERR off Busy:(KBusyOff$,0) ErrorMessage%:("Loading title screen",ERR,KFalse%) gCLS gAT 50,70 : gFONT 12 : gSTYLE 17 : gPRINT "PsiNMEA" gAT 50,90 : gFONT 10 : gSTYLE 0 : gPRINT "missing title file" gVISIBLE on RETURNisload:: gUSE stdscreen% : gAT 0,0 gCOPY id%,0,0,640,320,3 gCLOSE id% ELSEIF n%=1 msg_all%=0 gCLS gAT 0,0 : gBORDER 1,180,240 gAT 183,0 : gBORDER 1,356,240 gAT 542,0 : gBORDER 1,97,240 gAT 90,90 gCIRCLE 25 : gCIRCLE 50 : gCIRCLE 75 : gLINEBY 0,0 gAT 5,210 : gLINETO 175,210 gFONT 11 : gSTYLE 8 gAT 210,40 : gPRINT "Latitude" gAT 210,70 : gPRINT "Longitude" gAT 210,100 : gPRINT "Altitude" gAT 210,140 : gPRINT "Time" gAT 210,180 : gPRINT "Direction (magnetic)" gAT 210,210 : gPRINT "Direction (true)" gFONT 10 : gSTYLE 1 gAT 550,20 : gPRINT "PsiNMEA" gSTYLE 0 gAT 550,35 : gPRINT KVerStr$ gAT 550,60 : gPRINT "GPS-" gAT 550,75 : gPRINT "SCREEN" gAT 550,213 : gPRINT "© "+KBuiltStr$ gAT 550,228 : gPRINT "T.Baumbach"  ONERR noload2:: id2%=gLOADBIT(MyDir$+SPicFile2$,0) ONERR off gUSE stdscreen% : gAT 573,120 gCOPY id2%,0,0,32,32,3 gCLOSE id2% GOTO isload2::noload2:: ONERR off ShortMessagePrompt:("Reading resource file","Resource file (MBM) not found.")isload2:: ELSEIF n%>1 gCLS gIPRINT "Sorry, not implemented yet",1 ENDIF gVISIBLE on screen%=n%ENDPREM *** Creation/Selection of user defined data screens ***PROC UserScreen%: gIPRINT "Sorry, not implemented yet",1 RETURN -1ENDPREM *** Read/show new datas of data screens ***PROC PaintScreen:(num%) LOCAL format$(10),px%,py%,rep%,nr%,t%,c%,dd& IF screen%=1 GetSentence: IF LEN(sentence$)>=6 format$=UPPER$(MID$(sentence$,4,3)) ELSE RETURN ENDIF IF format$="GSV" IF Parse%:(sentence$) t%=INT(values(1)) c%=INT(values(2)) IF t%<>msg_all% OR c%<>sats% msg_read%=0 : sats%=c% c%=1 WHILE c%<50 : satnr%(c%)=KFalse% : c%=c%+1 : ENDWH  msg_all%=t% ENDIF t%=VAL(MID$(FIX$(values(1),3,-7),4,3)) IF t%=msg_read%+1 rep%=1 WHILE rep%<=list_rep% nr%=values(3+(rep%-1)*list_cnt%) satnr%(nr%)=KTrue% sat1(nr%)=values(4+(rep%-1)*list_cnt%) sat2(nr%)=values(5+(rep%-1)*list_cnt%) sat3(nr%)=values(6+(rep%-1)*list_cnt%) rep%=rep%+1 ENDWH msg_read%=t% IF msg_read%=msg_all% c%=1 : dd&=0 WHILE c%<=50 IF satnr%(c%) AND sat1(c%)"" RETURN LastWaypointFile$ ENDIF file$=LastWaypointFile$ DO IF UseFastFileDialog% IF createnew% r%=1 : REM Button "Create new" file$=FileDialog$:(title$,file$,KFalse%,"",ADDR(r%)) IF r%=%N : r%=%n : ENDIF IF file$="" AND r%<>%n : RETURN "" : ENDIF IF file$<>"" : r%=13 : ENDIF ELSE file$=FileDialog$:(title$,file$,KFalse%,"",&0) IF file$="" : RETURN "" : ENDIF r%=13 ENDIF ELSE Busy:("Building file list"+KDots$,1) dINIT title$ dFILE file$,"File,Folder,Disk",16+32+UseSystemFolder& IF createnew% dBUTTONS " Create new"+KDots$+" ",%N,"Cancel",-(27+$100),"Select",13+$100 ELSE dBUTTONS " Cancel ",-(27+$100)," Select ",13+$100 ENDIF Busy:(KBusyOff$,0) Lock:(KLock%) : r%=DIALOG : Lock:(KUnlock%) ENDIF IF r%=%n file$=LastWaypointFile$ IF UseFastFileDialog% file$=FileDialog$:("Create waypoint file"+KDots$,file$,KTrue%,KWaypointExtension$,&0) IF file$="" : RETURN "" : ENDIF ELSEnewfile::  Busy:("Building file list"+KDots$,1) dINIT "Create waypoint file" dFILE file$,"File,Folder,Disk",1+UseSystemFolder& dBUTTONS " Cancel ",-(27+$100),"Create",13+$100 Busy:(KBusyOff$,0) Lock:(KLock%) : re%=DIALOG : Lock:(KUnlock%) IF re%<>13 : RETURN "" : ENDIF file$=AddExtension$:(file$,KWaypointExtension$) IF EXIST(file$) dINIT "File exist" dTEXT "","Overwrite '"+ExtractFile$:(file$)+"' ?",2 dBUTTONS "No",%N+$300," Yes ",%Y+$300 Lock:(KLock%) : re%=DIALOG : Lock:(KUnlock%) IF re%=%n : GOTO newfile:: : ENDIF ENDIF ENDIF  ONERR nowayp:: file$=AddExtension$:(file$,KWaypointExtension$) IF EXIST(file$) : DELETE file$ : ENDIF q$=file$+" FIELDS name(10), description(50), latitude, longitude, altitude TO waypoints" CREATE q$,W,n$,d$,la,lo,al CLOSE  ONERR off LastWaypointFile$=file$ RETURN file$nowayp:: ONERR off ErrorMessage%:("Create waypoint file",ERR,KFalse%)  ELSEIF r%=13 IF file$="" gIPRINT "None file selected",2 ELSE LastWaypointFile$=file$ RETURN LastWaypointFile$ ENDIF ELSE RETURN "" ENDIF UNTIL KFalse%ENDPREM *** Add Index to Route file ***PROC GenerateWaypointIndex%:(file$) LOCAL key& key&=DBNEWKEY&: ONERR noindex:: DBSETCOMPARISON:(key&,0) DBADDFIELD:(key&,"pos",kDbAscending&) DBCREATEINDEX:("index1",key&,file$,"waypoints") DBDELETEKEY:(key&) ONERR off RETURN KTrue%noindex:: ONERR off ErrorMessage%:("Generating index",ERR,KFalse%) RETURN KFalse%ENDPREM *** Returns name of route file ***PROC GetRouteFile$:(title$,uselast%,createnew%) LOCAL file$(255),q$(255),r%,re% IF uselast% AND EXIST(LastRouteFile$) AND ExtractFile$:(LastRouteFile$)<>"" RETURN LastRouteFile$ ENDIF file$=LastRouteFile$ DO IF UseFastFileDialog% IF createnew% r%=1 : REM Button "Create new" file$=FileDialog$:(title$,file$,KFalse%,"",ADDR(r%)) IF r%=%N : r%=%n : ENDIF IF file$="" AND r%<>%n : RETURN "" : ENDIF IF file$<>"" : r%=13 : ENDIF ELSE file$=FileDialog$:(title$,file$,KFalse%,"",&0) IF file$="" : RETURN "" : ENDIF r%=13 ENDIF ELSE Busy:("Building file list"+KDots$,1) dINIT title$ dFILE file$,"File,Folder,Disk",16+32+UseSystemFolder& IF createnew% dBUTTONS " Create new"+KDots$+" ",%N,"Cancel",-(27+$100),"Select",13+$100 ELSE dBUTTONS " Cancel ",-(27+$100)," Select ",13+$100 ENDIF Busy:(KBusyOff$,0) Lock:(KLock%) : r%=DIALOG : Lock:(KUnlock%) ENDIF IF r%=%n file$=LastRouteFile$ IF UseFastFileDialog% file$=FileDialog$:("Create route file"+KDots$,file$,KTrue%,KRouteExtension$,&0) IF file$="" : RETURN "" : ENDIF ELSEnewfile::  Busy:("Building file list"+KDots$,1) dINIT "Create route file" dFILE file$,"File,Folder,Disk",1+UseSystemFolder& dBUTTONS " Cancel ",-(27+$100),"Create",13+$100 Busy:(KBusyOff$,0) Lock:(KLock%) : re%=DIALOG : Lock:(KUnlock%) IF re%<>13 : RETURN "" : ENDIF file$=AddExtension$:(file$,KRouteExtension$) IF EXIST(file$) dINIT "File exist" dTEXT "","Overwrite '"+ExtractFile$:(file$)+"' ?",2 dBUTTONS "No",%N+$300," Yes ",%Y+$300 Lock:(KLock%) : re%=DIALOG : Lock:(KUnlock%) IF re%=%n : GOTO newfile:: : ENDIF ENDIF ENDIF file$=AddExtension$:(file$,KRouteExtension$)  ONERR nocreate:: Busy:("Create new route file"+KDots$,1) IF EXIST(file$) : DELETE file$ : ENDIF q$=file$+" FIELDS description(40),waypoints TO header" CREATE q$,A,d$,wp% INSERT : A.d$="" : A.wp%=0 : PUT CLOSE q$=file$+" FIELDS pos,id(6),latitude,longitude,altitude TO waypoints" CREATE q$,B,wpos%,wid$,lat,lon,alt CLOSE ONERR off Busy:(KBusyOff$,0) IF GenerateWaypointIndex%:(file$) LastRouteFile$=file$ RETURN file$ ENDIF CONTINUEnocreate:: ONERR off Busy:(KBusyOff$,0) ErrorMessage%:("Creating route file",ERR,KFalse%)  ELSEIF r%=13 IF file$="" gIPRINT "None file selected",2 ELSE LastRouteFile$=file$ RETURN LastRouteFile$ ENDIF ELSE RETURN "" ENDIF UNTIL KFalse%ENDPREM *** Enter datas of new waypoints ***PROC NewWaypoint:(la,lo,al) LOCAL buffer$(255),file$(255),id$(6),desc$(40),r% LOCAL lat,lon,alt,alt2,_alt,time,lat$(15),lon$(15) LOCAL city$(50),country$(50)  file$=GetWaypointFile$:("Select waypoint file",KTrue%,KTrue%) IF file$="" : RETURN : ENDIF IF la<>1000.0 lat$=FormatStr_Latitude$:(la,KTrue%) lon$=FormatStr_Longitude$:(lo,KTrue%) ENDIF IF al1 alt=Convert:(alt,KMeters%,KFeets%) ENDIF DO dINIT "New waypoint (to "+ExtractFile$:(file$)+")",17 dTEXT ""," " dEDIT id$,"ID name",6 dEDIT desc$,"Description",16 dTEXT ""," " dEDIT lat$,"Latitude",10 dEDIT lon$,"Longitude",10 IF format%(6)=1 dFLOAT alt,"Altitude (m)",-30000,30000 ELSE dFLOAT alt,"Altitude (ft)",-50000,50000 ENDIF IF la<>1000 OR connectmode%<>KModeNMEA% dBUTTONS " Change file"+KDots$+" ",%F," From database"+KDots$+" ",%W,"Cancel",-(27+$100),"Add",13+$100 ELSE dBUTTONS "Change file"+KDots$,%F," From database"+KDots$+" ",%W," Current location ",%C,"Cancel",-(27+$100),"Add",13+$100 ENDIF Lock:(KLock%) : r%=DIALOG : Lock:(KUnlock%) IF r%=%f buffer$=GetWaypointFile$:("Select waypoint file",KFalse%,KTrue%) IF buffer$<>"" : file$=buffer$ : ENDIF ELSEIF r%=%c IF ReadCurrentPosition%:(ADDR(lat),ADDR(lon),ADDR(alt2),ADDR(time),KTrue%) IF lat0 lat$=FormatStr_Latitude$:(lat,KTrue%) lon$=FormatStr_Longitude$:(lon,KTrue%) id$=MID$(city$,1,6) desc$=MID$(country$,1,40) ENDIF  ELSEIF r%<>13 : RETURN ELSE IF id$="" OR PosInStr%:(",",id$,1)>0 gIPRINT "Wrong waypoint ID",2 ELSE lat=Val_LatLonStr:(lat$,KTrue%,KTrue%) IF lat>-1000 lon=Val_LatLonStr:(lon$,KFalse%,KTrue%) IF lon>-1000 : BREAK : ENDIF ENDIF ENDIF ENDIF UNTIL KFalse%  Busy:("Saving"+KDots$,1) IF format%(6)<>1 alt=Convert:(alt,KFeets%,KMeters%) ENDIF  r%=KTrue% IF NOT EXIST(file$) r%=KFalse% ELSE file$=file$+" SELECT * FROM waypoints" DO ONERR notopen:: OPEN file$,W,n$,d$,la,lo,al ONERR off BREAKnotopen:: ONERR off IF NOT ErrorMessage%:("Open waypoint file",ERR,KTrue%) r%=KFalse% BREAK ENDIF  UNTIL KFalse% IF r% INSERT W.n$ =UPPER$(id$) W.d$ =UPPER$(desc$) W.la =lat W.lo =lon W.al =alt PUT ENDIF CLOSE ENDIF  Busy:(KBusyOff$,0) IF r% : gIPRINT "Datas added.",1 ELSE : gIPRINT "Addition of waypoint failed!",1 ENDIFENDPREM *** Edit datas of waypoints ***PROC EditWaypoint: LOCAL file$(255),file2$(255),r%,c%,q$(255),waynum% LOCAL buffer$(255),waypoints%,id$(6) LOCAL open%,lat,lon,alt,lat$(20),lon$(20),time LOCAL lat2,lon2,alt2,id2$(6),addmode%,desc$(255) file$=GetWaypointFile$:("Select waypoint file",KTrue%,KTrue%) IF file$="" : RETURN : ENDIF open%=KFalse% DO dINIT "Edit waypoints"+KDots$ dTEXT "File",ExtractFile$:(file$) IF file$<>"" AND EXIST(file$) IF NOT open% DO ONERR noopen:: q$=file$+" SELECT * FROM waypoints" OPENq$,W,id$,d$,lat,lon,alt ONERR off open%=KTrue% BREAKnoopen:: ONERR off IF NOT ErrorMessage%:("Open waypoint file",ERR,KTrue%) BREAK ENDIF UNTIL KFalse% ENDIF IF open% waypoints%=0 Busy:("Building waypoint list"+KDots$,1) FIRST q$=W.id$ WHILE NOT EOF waypoints%=waypoints%+1 NEXT IF EOF : BREAK : ENDIF dCHOICE waynum%,"Waypoints",FIX$(waypoints%,0,5)+". "+q$+",..." q$=W.id$ ENDWH IF waypoints%=0 dCHOICE waynum%,"Waypoints","(empty file)" ELSE dCHOICE waynum%,"Waypoints",FIX$(waypoints%,0,5)+". "+q$ ENDIF  Busy:(KBusyOff$,0) dBUTTONS "Change file"+KDots$,%F," Edit waypoints"+KDots$+" ",%W,"Okay",13+$100 ELSE  dINIT "Edit waypoints"+KDots$ dTEXT "File",ExtractFile$:(file$) dCHOICE waynum%,"Waypoints:","(wrong file)" dBUTTONS " Change file"+KDots$+" ",%F,"Cancel",-(27+$100) ENDIF  ELSE dCHOICE waynum%,"Waypoints:","(wrong file)" dBUTTONS " Change file"+KDots$+" ",%F,"Cancel",-(27+$100) ENDIF Lock:(KLock%) : r%=DIALOG : Lock:(KUnlock%) IF r%=%f REM change waypoint file IF open% CLOSE : waypoints%=0 : open%=KFalse% ENDIF file2$=GetWaypointFile$:("Select waypoint file",KFalse%,KTrue%) IF file2$<>"" : file$=file2$ : ENDIF  ELSEIF r%=%w REM edit waypoints DO dINIT "Edit waypoints"+KDots$ IF waypoints%=0  dCHOICE waynum%,"Waypoints","(empty file)" dBUTTONS " Add"+KDots$+" ",%A+$200,"Back",-(27+$100) ELSE Busy:("Building waypoint list"+KDots$,1) FIRST c%=1 q$=W.id$ : lat=W.lat : lon=W.lon WHILE c%1 alt=Convert:(alt,KMeters%,KFeets%) ENDIF id$=W.id$ ENDIF DO IF addmode% dINIT "Add waypoint (to "+ExtractFile$:(file$)+")",17 ELSE dINIT "Edit waypoint (of "+ExtractFile$:(file$)+")",17 ENDIF IF connectmode%=KModeNMEA% dTEXT ""," " ENDIF dEDIT id$,"ID name",6 dEDIT desc$,"Description",16 dEDIT lat$,"Latitude",10 dEDIT lon$,"Longitude",10 IF format%(6)=1 dFLOAT alt,"Altitude (m)",-30000,30000 ELSE dFLOAT alt,"Altitude (ft)",-50000,50000 ENDIF IF connectmode%<>KModeNMEA% IF addmode% dBUTTONS " From database"+KDots$+" ",%W,"Cancel",-(27+$100),"Add",13+$100 ELSE dBUTTONS " From database"+KDots$+" ",%W,"Cancel",-(27+$100),"Set",13+$100 ENDIf ELSE IF addmode% dBUTTONS " From database"+KDots$+" ",%W," Current location ",%C,"Cancel",-(27+$100),"Add",13+$100 ELSE dBUTTONS " From database"+KDots$+" ",%W," Current location ",%C,"Cancel",-(27+$100),"Set",13+$100 ENDIF ENDIF Lock:(KLock%) : r%=DIALOG : Lock:(KUnlock%) IF r%=%c IF ReadCurrentPosition%:(ADDR(lat),ADDR(lon),ADDR(alt2),ADDR(time),KTrue%) IF lat0 lat$=FormatStr_Latitude$:(lat,KTrue%) lon$=FormatStr_Longitude$:(lon,KTrue%) alt=0 id$=MID$(q$,1,6) desc$=MID$(buffer$,1,16) ENDIF  ELSEIF r%<>13 : BREAK ELSE IF id$="" OR PosInStr%:(",",id$,1)>0 gIPRINT "Wrong waypoint ID",2 ELSE IF format%(6)=1 : alt2=alt ELSE alt2=Convert:(alt,KFeets%,KMeters%) ENDIF lat=Val_LatLonStr:(lat$,KTrue%,KTrue%) IF lat>-1000 lon=Val_LatLonStr:(lon$,KFalse%,KTrue%) ENDIF IF lat>-1000 AND lon>-1000 AND NOT addmode% POSITION waynum% MODIFY W.lat=lat : W.lon=lon : W.alt=alt2 W.id$=UPPER$(id$) : W.d$=UPPER$(desc$) PUT BREAK ELSEIF lat>-1000 AND lon>-1000 AND addmode% waypoints%=waypoints%+1 INSERT W.lat=lat : W.lon=lon : W.alt=alt2 W.id$=UPPER$(id$) : W.d$=UPPER$(desc$) PUT waynum%=waypoints% BREAK ENDIF ENDIF ENDIF UNTIL KFalse%  ELSEIF r%=%r REM delete waypoint POSITION waynum% dINIT "Waypoint '"+W.id$+"'" dTEXT "","Do you really want to remove",2 dTEXT "","this waypoint from the opened file?",2 dBUTTONS "No",%N+$300," Yes ",%Y+$300 Lock:(KLock%) : r%=DIALOG : Lock:(KUnlock%) IF r%=%y ERASE waypoints%=waypoints%-1 IF waynum%>waypoints% : waynum%=waypoints% : ENDIF ENDIF   ELSE BREAK ENDIF  UNTIL KFalse% ELSE BREAK ENDIF UNTIL KFalse% IF open% Busy:("Close waypoint file...",1) CLOSE : COMPACT file$ Busy:(KBusyOff$,0) ENDIFENDPREM *** Read waypoint datas from database ***PROC GetWaypoint%:(file$,num%,aname&,adesc&,alat&,alon&,aheight&) LOCAL db$(255) db$=file$ IF NOT EXIST(db$) : RETURN KFalse% : ENDIF db$=db$+" SELECT * FROM waypoints" DO ONERR notopen:: OPEN db$,W,n$,d$,la,lo,al ONERR off BREAKnotopen:: ONERR off IF NOT ErrorMessage%:("Open waypoint file",ERR,KTrue%) RETURN KFalse% ENDIF  UNTIL KFalse%  POSITION num% POKE$ aname&,W.n$ POKE$ adesc&,W.d$ POKEF alat& ,W.la POKEF alon& ,W.lo POKEF aheight& ,W.al CLOSE RETURN KTrue%ENDPREM *** Find waypoint from given file with shortest ***REM spherical distance to current locationPROC GetNearestWaypoint$:(db$,clat,clon,adesc&,alat&,alon&,adist&) LOCAL id$(10),desc$(50),lat,lon,dist,distmin,c%,q$(255) IF NOT EXIST(db$) : RETURN "" : ENDIF q$=db$+" SELECT name,description,latitude,longitude FROM waypoints" DO ONERR notopen:: OPEN q$,A,n$,d$,la,lo ONERR off BREAKnotopen:: ONERR off IF NOT ErrorMessage%:("Open waypoint file",ERR,KTrue%) RETURN "" ENDIF  UNTIL KFalse%  FIRST IF EOF : CLOSE : RETURN "" : ENDIF id$=A.n$ desc$=A.d$ lat=A.la lon=A.lo distmin=SphericalDistance:(clat,clon,lat,lon,KMeanEarthRadius) rem Busy:("Searching"+KDots$,1) WHILE KTrue% NEXT IF EOF : BREAK : ENDIF dist=SphericalDistance:(clat,clon,A.la,A.lo,KMeanEarthRadius) IF distA.n$ : NEXT : ENDWH NEXT IF EOF : CLOSE : CLOSE : RETURN "" : ENDIF ret$=A.n$ CLOSE : CLOSE RETURN ret$ENDPREM *** Read prev city of a country from database ***PROC GetPrevCityOfCountry$:(city$,country$) LOCAL db$(255),q$(255),ret$(255),c% db$=MyDir$+SWldDatabase$ IF NOT EXIST(db$) : RETURN "" : ENDIF q$=db$+" SELECT nr FROM countries WHERE name='"+country$+"'" DO ONERR notopen:: OPEN q$,B,nr% ONERR off BREAKnotopen:: ONERR off IF NOT ErrorMessage%:("Open world database",ERR,KTrue%) RETURN "" ENDIF  UNTIL KFalse%  FIRST IF EOF : CLOSE : RETURN "" : ENDIF q$=db$+" SELECT name FROM cities WHERE country="+FIX$(B.nr%,0,3) OPEN q$,A,n$ FIRST IF EOF : CLOSE : CLOSE : RETURN "" : ENDIF WHILE (NOT EOF) AND city$<>A.n$ : NEXT : ENDWH c%=POS IF c%=0 : CLOSE : CLOSE : RETURN "" : ENDIF POSITION (c%-1)  ret$=A.n$ CLOSE : CLOSE RETURN ret$ENDPREM *** Get full name of first country beginning with pre$ ***PROC GetFullCountry$:(pre$) LOCAL db$(255),q$(255) db$=MyDir$+SWldDatabase$ IF NOT EXIST(db$) : RETURN "" : ENDIF q$=db$+" SELECT name FROM countries" DO ONERR notopen:: OPEN q$,B,n$ ONERR off BREAKnotopen:: ONERR off IF NOT ErrorMessage%:("Open world database",ERR,KTrue%) RETURN "" ENDIF  UNTIL KFalse%  FIRST WHILE NOT EOF IF UPPER$(pre$)=UPPER$(LEFT$(B.n$,LEN(pre$))) q$=B.n$ CLOSE RETURN q$ ENDIF NEXT ENDWH CLOSE RETURN ""ENDPREM *** Get full name of first city of a country ***REM beginning with pre$PROC GetFullCity$:(pre$,country$) LOCAL db$(255),q$(255) db$=MyDir$+SWldDatabase$ IF NOT EXIST(db$) : RETURN "" : ENDIF q$=db$+" SELECT nr FROM countries WHERE name='"+country$+"'" DO ONERR notopen:: OPEN q$,B,nr% ONERR off BREAKnotopen:: ONERR off IF NOT ErrorMessage%:("Open world database",ERR,KTrue%) RETURN "" ENDIF  UNTIL KFalse%  FIRST IF EOF : CLOSE : RETURN "" : ENDIF q$=db$+" SELECT name FROM cities WHERE country="+FIX$(B.nr%,0,3) OPEN q$,A,n$ FIRST WHILE NOT EOF IF UPPER$(pre$)=UPPER$(LEFT$(A.n$,LEN(pre$))) q$=A.n$ CLOSE : CLOSE RETURN q$ ENDIF NEXT ENDWH CLOSE : CLOSE RETURN ""ENDPREM *** Get all datas of a city from database ***PROC GetCityInfos%:(city$,country$,alat&,alon&,atd&,acap&) LOCAL db$(255),q$(255),c% db$=MyDir$+SWldDatabase$ IF NOT EXIST(db$) : RETURN KFalse% : ENDIF q$=db$+" SELECT nr FROM countries WHERE name='"+country$+"'" DO ONERR notopen:: OPEN q$,B,nr% ONERR off BREAKnotopen:: ONERR off IF NOT ErrorMessage%:("Open world database",ERR,KTrue%) RETURN KFalse% ENDIF  UNTIL KFalse%  FIRST IF EOF : CLOSE : RETURN KFalse% : ENDIF  q$=db$+" SELECT latitude, longitude, utcoff, capital FROM cities WHERE (name='"+city$+"' AND country="+FIX$(B.nr%,0,3)+")" OPEN q$,A,la,lo,off&,cap% FIRST IF EOF : CLOSE : CLOSE : RETURN KFalse% : ENDIF POKEF alat&,A.la POKEF alon&,A.lo POKEL atd&,A.off& POKEW acap&,A.cap% CLOSE : rem B CLOSE : rem A RETURN KTrue%ENDPREM *** Get city from database with the shortest ***REM distance to clat/clonPROC GetNearestCity$:(clat,clon,acountry&,alat&,alon&,adist&) LOCAL city$(255),country$(255),lat,lon,dist,distmin,c% LOCAL db$(255),q$(255) db$=MyDir$+SWldDatabase$ IF NOT EXIST(db$) : RETURN "" : ENDIF q$=db$+" SELECT name, country, latitude, longitude FROM cities" DO ONERR notopen:: OPEN q$,A,n$,c%,la,lo ONERR off BREAKnotopen:: ONERR off IF NOT ErrorMessage%:("Open world database",ERR,KTrue%) RETURN "" ENDIF  UNTIL KFalse%  FIRST IF EOF : CLOSE : RETURN "" : ENDIF city$=A.n$ lat=A.la lon=A.lo c% =A.c% distmin=SphericalDistance:(clat,clon,lat,lon,KMeanEarthRadius) rem Busy:("Searching"+KDots$,1) WHILE KTrue% NEXT IF EOF : BREAK : ENDIF dist=SphericalDistance:(clat,clon,A.la,A.lo,KMeanEarthRadius) IF dist13 : RETURN KFalse% : ENDIF Busy:("Creating database ... Please wait!",1) r%=CreateOwnWldDatabase%: Busy:(KBusyOff$,0) RETURN r%ENDPREM *** Create own world database file ***REM (for faster access)PROC CreateOwnWldDatabase%: LOCAL q$(255),key&,country$(100)  descr$=MyDir$+SWldDatabase$ IF EXIST(descr$) : RETURN KTrue% : ENDIF q$=descr$+" FIELDS nr, name(30), country, latitude, longitude, utcoff, capital TO cities" DO ONERR notcreated:: CREATE q$,A,nr%,n$,c%,la,lo,off&,cap% ONERR off BREAKnotcreated:: ONERR off IF NOT ErrorMessage%:("Creating database",ERR,KTrue%) RETURN KFalse% ENDIF UNTIL KFalse%  CLOSE q$=descr$+" FIELDS nr, name(30) TO countries" CREATE q$,B,nr%,n$ country$="" : list_cnt%=0 BEGINTRANS DO ONERR allfound:: country$=WldNextCountry$:(country$) ONERR off list_cnt%=list_cnt%+1 INSERT B.nr% =list_cnt% B.n$ =country$ PUT UNTIL KFalse%badtrans:: ONERR off IF NOT INTRANS : ROLLBACK : ENDIF CLOSE DELETE descr$ RETURN KFalse% allfound:: ONERR off COMMITTRANS CLOSE q$=descr$+" SELECT * FROM cities" OPEN q$,A,nr%,n$,c%,la,lo,off&,cap%  list_start%=KTrue% : list_cnt%=0 BEGINTRANS WldFindCity:("","Callback_Cities2Database") USE A COMMITTRANS CLOSE IF NOT list_start% DELETE descr$ RETURN KFalse% ENDIF COMPACT descr$ RETURN KTrue%ENDPREM *** Callback function for WldFindCity: ***REM (inserts current city into database file)PROC Callback_Cities2Database&:(cityName$, country$, lat&, lon&, area$, timediff&, dst&, natcode$, capital$, natpfx$, intpfx$) DO ONERR notopen:: OPEN descr$+" SELECT nr FROM countries WHERE name='"+country$+"'",B,nr% ONERR off BREAKnotopen:: ONERR off REM output error ??? RETURN 0 UNTIL KFalse%  FIRST IF EOF REM there is a bug in RMRalarm: REM it returns Ägypten as first, but there cities of REM Afganistan exist. These cities here will be ignored. CLOSE RETURN 0 ENDIF list_cnt%=list_cnt%+1 USE A  INSERT A.nr% =list_cnt% A.n$ =cityName$ A.c% =B.nr% A.la =FLT(lat&)/60 A.lo =FLT(lon&)/60 A.off&=timediff&*60 A.cap%=(cityName$=capital$) PUT  USE B CLOSE  RETURN 0ENDPREM ****** Garmin Protocol *******REM ******************************PROC GRMN_SendStr%:(cmd%, parm$) LOCAL buf$(255),len%,c%,ch%,chk% REM add DLE, Packet ID and Packet size len%=LEN(parm$) buf$=CHR$($10)+CHR$(cmd%)+CHR$(len%) IF len%=$10 : buf$=buf$+CHR$($10) : ENDIF chk%=len%+cmd% IF chk%>255 : chk%=chk%-255 : ENDIF  REM add Packet datas c%=1 WHILE c%<=len% ch%=ASC(MID$(parm$,c%,1)) chk%=chk%+ch% IF chk%>255 : chk%=chk%-256 : ENDIF buf$=buf$+CHR$(ch%) IF ch%=$10 : buf$=buf$+CHR$($10) : ENDIF c%=c%+1 ENDWH  REM add checksum chk%=256-chk% buf$=buf$+CHR$(chk%) IF chk%=$10 : buf$=buf$+CHR$($10) : ENDIF  REM add closing bytes DLE/XTE buf$=buf$+CHR$($10)+CHR$($03) len%=LEN(buf$) IOW(-1,2,#(ADDR(buf$)+1),len%) RETURN KTrue%ENDPREM Sends a string and waits for acknowledgementREM After 5 tries it returns unsuccessfulPROC GRMN_SendStrExt%:(cmd%,params$) LOCAL c%,cmd2% c%=1 WHILE c%<5 IF NOT GRMN_SendStr%:(cmd%,params$) : RETURN KFalse% : ENDIF IF NOT GRMN_GetStr%:(ADDR(cmd2%)) : RETURN KFalse% : ENDIF IF cmd2%=$06 : RETURN KTrue% : ENDIF IF cmd2%<>$15 : RETURN KFalse% : ENDIF c%=c%+1 ENDWH RETURN KFalse%ENDPPROC GRMN_GetStr%:(acmd&) LOCAL xbuf$(255),ch%,c%,pbuf1&,pbuf2&,len%,tlen%,cmd%  pbuf1&=ADDR(xbuf$) : pbuf2&=ADDR(len%) len%=2 REM Read Data Link Escape Char DLE (10hex) REM + Packet ID IF NOT ReadSerialAsync%:(pbuf1&,pbuf2&,5) RETURN KFalse% ENDIF IF PEEKB(pbuf1&)<>$10 : RETURN KFalse% : ENDIF  cmd%=PEEKB(pbuf1&+1) len%=1  REM read packet size IF NOT ReadSerialAsync%:(pbuf1&,pbuf2&,5) RETURN KFalse% ENDIF IF PEEKB(pbuf1&)=$10 REM any byte equal to DLE is followed by second DLE IF NOT ReadSerialAsync%:(pbuf1&,pbuf2&,5) RETURN KFalse% ENDIF ENDIF tlen%=PEEKB(pbuf1&)  REM read packet datas c%=1 sentence$="" WHILE c%<=tlen% IF NOT ReadSerialAsync%:(pbuf1&,pbuf2&,5) RETURN KFalse% ENDIF ch%=PEEKB(pbuf1&) sentence$=sentence$+CHR$(ch%) IF ch%=$10 REM any byte equal to DLE is followed by second DLE IF NOT ReadSerialAsync%:(pbuf1&,pbuf2&,5) RETURN KFalse% ENDIF ENDIF c%=c%+1 ENDWH   REM read checksum (value ignored) IF NOT ReadSerialAsync%:(pbuf1&,pbuf2&,5) RETURN KFalse% ENDIF IF PEEKB(pbuf1&)=$10 REM any byte equal to DLE is followed by second DLE IF NOT ReadSerialAsync%:(pbuf1&,pbuf2&,5) RETURN KFalse% ENDIF ENDIF  REM read the closing bytes (DLE+ETX) len%=2 IF NOT ReadSerialAsync%:(pbuf1&,pbuf2&,5) RETURN KFalse% ENDIF IF PEEKB(pbuf1&)<>$10 OR PEEKB(pbuf1&+1)<>$03 RETURN KFalse% ENDIF  POKEW acmd&,cmd% RETURN KTrue%ENDPPROC GRMN_SendAndGetStrExt%:(cmd_send%,params$,cmd_read%) LOCAL c%,cmd2% c%=1 WHILE c%<5 IF NOT GRMN_SendStr%:(cmd_send%,params$) : RETURN KFalse% : ENDIF IF NOT GRMN_GetStr%:(ADDR(cmd2%)) : RETURN KFalse% : ENDIF IF cmd2%<>$15 IF cmd2%=$06 IF NOT GRMN_GetStr%:(ADDR(cmd2%)) : RETURN KFalse% : ENDIF ENDIF IF cmd_read%=cmd2% GRMN_Ack:(cmd2%) RETURN KTrue% ENDIF RETURN KFalse% ENDIF c%=c%+1 ENDWH RETURN KFalse%ENDPPROC GRMN_Ack:(cmd%) GRMN_SendStr%:($06,CHR$(cmd%)+CHR$(0))ENDPPROC GRMN_Nak:(cmd%) GRMN_SendStr%:($15,CHR$(cmd%)+CHR$(0))ENDPPROC GRMN_Abort: GRMN_SendStrExt%:($0a,CHR$(0)+CHR$(0))ENDPREM *** Get datatype of connected device ***PROC GetGarminDatatype%:(transnum%,d%) LOCAL c%,c2% IF GRMN_capnum%=0 IF GetGarminProductDatas$:(KFalse%)="" REM no answer from device RETURN -1 ENDIF IFGRMN_capnum%=0 REM no protocol capabilities; return standards IF transnum%=100 REM Waypoint transfer RETURN 100 ELSEIF transnum%=200 REM Route transfer IF d%=0 : RETURN 200 ELSEIF d%=1 : RETURN 100 ENDIF ELSEIF transnum%=300 REM Track log transfer RETURN 300 ELSEIF transnum%=400 REM Proximity waypoint transfer RETURN 400 ELSEIF transnum%=500 REM Almanac transfer RETURN 500 ELSEIF transnum%=600 REM Date&Time initialization RETURN 600 ELSEIF transnum%=700 REM Position initialization RETURN 700 ELSEIF transnum%=800 REM PVT datas RETURN 800 ENDIF RETURN -1 ENDIF ENDIF c%=1 WHILE c%"D" : RETURN -1 : ENDIF ENDWH  RETURN GRMN_capdata%(c%+c2%) ENDIF c%=c%+1 ENDWH RETURN -1ENDPREM *** Get Product Datas of Garmin device ***PROC GetGarminProductDatas$:(dlg%) LOCAL c%,cmd%,id%,software%,prod$(10,255),p$(255),q$(255) LOCAL arraylng%,r%,cprod%,buffer$(255),str$(255),msg% Busy:("Reading Garmin datas"+KDots$,1) REM Product Data Protocol IF NOT GRMN_SendAndGetStrExt%:($FE,CHR$($00),$FF) Busy:(KBusyOff$,0) IF dlg% : gIPRINT "No response",1 : ENDIF RETURN "" ENDIF buffer$=sentence$ REM Try to read protocol capability protocol IF NOT GRMN_GetStr%:(ADDR(cmd%)) OR cmd%<>$FD arraylng%=0 ELSE arraylng%=LEN(sentence$)/3 GRMN_Ack:(cmd%) ENDIF id%=ASC(MID$(buffer$,2,1))+ASC(MID$(buffer$,1,1)) software%=ASC(MID$(buffer$,4,1))+ASC(MID$(buffer$,3,1)) prod$(1)="" : c%=5 : cprod%=1 WHILE c%<=LEN(buffer$) IF ASC(MID$(buffer$,c%,1))=0 cprod%=cprod%+1 IF cprod%>6 : BREAK : ENDIF prod$(cprod%)="" ELSE prod$(cprod%)=prod$(cprod%)+MID$(buffer$,c%,1) ENDIF c%=c%+1 ENDWH cprod%=cprod%-1  IF GRMN_capnum%=0 GRMN_capnum%=arraylng%+3 GRMN_captag$(1)="L" : GRMN_capdata%(1)=0 : REM basic link protocol GRMN_captag$(2)="A" : GRMN_capdata%(2)=0 : REM product data protocol GRMN_captag$(3)="A" : GRMN_capdata%(3)=1 : REM protocol capability protocol c%=4 WHILE c%<=GRMN_capnum% POKEB ADDR(GRMN_captag$(c%)),1 POKEB ADDR(GRMN_captag$(c%))+1,PEEKB(ADDR(sentence$)+(c%-4)*3+1) GRMN_capdata%(c%)=PEEKB(ADDR(sentence$)+(c%-4)*3+2)+PEEKB(ADDR(sentence$)+(c%-4)*3+3)*256 c%=c%+1 ENDWH ENDIF Busy:(KBusyOff$,0) IF NOT dlg% : RETURN prod$(1) : ENDIF  q$=MyDir$+SGPSProdIDFile$+" SELECT * FROM products WHERE id="+FIX$(id%,0,3) ONERR openerr:: OPEN q$,P,id%,n$ ONERR off p$="(" FIRST WHILE NOT EOF IF p$<>"(" : p$=p$+"/" : ENDIF p$=p$+P.n$ NEXT ENDWH CLOSE IF p$="(" : p$="(unknown device)" ELSE p$=p$+")" ENDIF  Busy:(KBusyOff$,0) IF NOT dlg% : RETURN prod$(1) : ENDIF  DO dINIT "Garmin Product Datas" dTEXT "Product ID",FIX$(id%,0,10)+" "+p$ dTEXT "Software Version",FIX$(FLT(software%)/100,2,10) dTEXT "Description",prod$(1) IF cprod%>1 IF arraylng%>0 dBUTTONS " Internal descriptions"+KDots$+" ",%I+$200," Protocol capability"+KDots$+" ",%P+$200," Back ",13+$100 ELSE dBUTTONS " Protocol capability"+KDots$+" ",%P+$200," Back ",13+$100 ENDIF ELSE IF arraylng%>0 dBUTTONS " Protocol capability"+KDots$+" ",%P+$200," Back ",13+$100 ELSE dBUTTONS " Okay ",13+$100 ENDIF ENDIF Lock:(KLock%) : r%=DIALOG : Lock:(KUnlock%) IF r%=%i dINIT "Full internal product description" c%=1 WHILE c%<=cprod% dTEXT FIX$(c%,0,10)+".",prod$(c%) c%=c%+1 ENDWH Lock:(KLock%) : r%=DIALOG : Lock:(KUnlock%)  ELSEIF r%=%p msg%=KFalse% dINIT "Protocol capabilities" c%=1 : r%=1 dTEXT "","Device supports following protocols:" WHILE c%<=GRMN_capnum% IF GRMN_captag$(c%)="P" IF GRMN_capdata%(c%)=0 str$=">Default physical protocol" ELSE str$=">Unknown physical protocol (P"+NumFormat$:(GRMN_capdata%(c%),3)+")" ENDIF ELSEIF GRMN_captag$(c%)="L" IF GRMN_capdata%(c%)=0 str$=">Basic link protocol" ELSEIF GRMN_capdata%(c%)<3 str$=">Link protocol "+FIX$(GRMN_capdata%(c%),0,3) IF GRMN_capdata%(c%)<>1 : msg%=KTrue% : ENDIF ELSE str$=">Unknown link protocol (L"+NumFormat$:(GRMN_capdata%(c%),3)+")" msg%=KTrue% ENDIF ELSEIF GRMN_captag$(c%)="A" IF GRMN_capdata%(c%)=0 str$=">Product data protocol" ELSEIF GRMN_capdata%(c%)=1 str$=">Protocol capabilities protocol" ELSEIF GRMN_capdata%(c%)=10 OR GRMN_capdata%(c%)=11 str$=">Device command protocol "+FIX$(GRMN_capdata%(c%)-9,0,3) IF GRMN_capdata%(c%)<>10 : msg%=KTrue% : ENDIF ELSEIF GRMN_capdata%(c%)=100 str$=">Waypoint transfer protocol" ELSEIF GRMN_capdata%(c%)=200 str$=">Route transfer protocol" ELSEIF GRMN_capdata%(c%)=300 str$=">Track log transfer protocol" ELSEIF GRMN_capdata%(c%)=400 str$=">Proximity waypoint transfer protocol" ELSEIF GRMN_capdata%(c%)=500 str$=">Almanac transfer protocol" ELSEIF GRMN_capdata%(c%)=600 str$=">Date&Time initialization protocol" ELSEIF GRMN_capdata%(c%)=700 str$=">Position initialization protocol" ELSEIF GRMN_capdata%(c%)=800 str$=">PVT data transfer protocol" ELSE str$=">Unknown application protocol A"+NumFormat$:(GRMN_capdata%(c%),3) ENDIF ELSEIF GRMN_captag$(c%)="D" str$=" Datatype D"+NumFormat$:(GRMN_capdata%(c%),3) ELSE str$=">"+GRMN_captag$(c%)+NumFormat$:(GRMN_capdata%(c%),3)+" (Unknown protocol/data tag)" ENDIF IF c%$0c Busy:(KBusyOff$,0) GRMN_Abort: gIPRINT "Wrong datas",1 RETURN ENDIF GRMN_Ack:(cmd%) UNTIL cmd%=$0c Busy:(KBusyOff$,0) sat%=1 DO dINIT "Almanac datas of satellite PRN-"+NumFormat$:(satid%(sat%),2),17 dTEXT "Data reference time",FormatStr_Duration$:(reftime(sat%)) dTEXT "Clock correction coefficients",FormatStr_Duration$:(clockc1(sat%))+", "+FormatStr_Duration$:(clockc2(sat%)) dTEXT "Eccentricity",SCI$(e(sat%),5,15) dTEXT "Semi-major axis",FormatStr_Distance$:(sqrta(sat%)*sqrta(sat%),KFalse%) dTEXT "Mean anomaly at reference time",FormatStr_Angle$:(m0(sat%)*180/PI) dTEXT "Argument of perigee",FormatStr_Angle$:(w(sat%)*180/PI) dTEXT "Right ascension",FormatStr_Angle$:(omg0(sat%)*180/PI) dTEXT "Rate of right ascension",FormatStr_Angle$:(odot(sat%)*180/PI)+"/s" dTEXT "Inclination angle",FormatStr_Angle$:(i(sat%)*180/PI) IF sat%>1 IF sat%13 : CONTINUE : ENDIF ENDIF DO r%=IOOPEN(h%,file$,$102) IF r% IF NOT ErrorMessage%:("Open output file",r%,KTrue%) BREAK ENDIF ENDIF UNTIL r%=0 IF r%<>0 : CONTINUE : ENDIF ONERR saveerr:: Busy:("Saving"+KDots$,1) IOWRITE(h%,ADDR(datatype%),2) addr&=satnum%*2 IOWRITE(h%,ADDR(satid%(1)),addr&) IOWRITE(h%,ADDR(weeknum%(1)),addr&) IOWRITE(h%,ADDR(hlth%(1)),addr&) addr&=satnum%*8 IOWRITE(h%,ADDR(reftime(1)),addr&) IOWRITE(h%,ADDR(clockc1(1)),addr&) IOWRITE(h%,ADDR(clockc2(1)),addr&) IOWRITE(h%,ADDR(e(1)),addr&) IOWRITE(h%,ADDR(sqrta(1)),addr&) IOWRITE(h%,ADDR(m0(1)),addr&) IOWRITE(h%,ADDR(w(1)),addr&) IOWRITE(h%,ADDR(omg0(1)),addr&) IOWRITE(h%,ADDR(odot(1)),addr&) IOWRITE(h%,ADDR(i(1)),addr&) ONERR off IOCLOSE(h%) Busy:(KBusyOff$,0) CONTINUEsaveerr:: ONERR off Busy:(KBusyOff$,0) ErrorMessage%:("Save almanac datas"+KDots$,ERR,KFalse%) ELSE RETURN ENDIF UNTIL KFalse%ENDPPROC UpdateAlmanac: LOCAL mode%,r%,h%,file$(255),str$(100),cmd%,addr& LOCAL lat,lon,lat$(15),lon$(15) LOCAL satnum%,satid%(35),weeknum%(35),reftime(35) LOCAL clockc1(35),clockc2(35),e(35),sqrta(35),m0(35) LOCAL w(35),omg0(35),odot(35),i(35),hlth%(35),datatype%  gIPRINT "Not implemented yet",1 RETURN IF UseFastFileDialog% dINIT "Update GPS alamanc" dCHOICE mode%,"Mode","Only almanacs,Almanac+Date/Time+Position" dBUTTONS "Cancel",-(27+$100)," Continue ",13+$100 Lock:(KLock%) : r%=DIALOG : Lock:(KUnlock%) IF r%<>13 : RETURN : ENDIF file$=FileDialog$:("Almanac datas"+KDots$,"",KFalse%,"",&0) IF file$="" : RETURN : ENDIF ELSE Busy:("Building file list"+KDots$,1) dINIT "Update GPS alamanc" dCHOICE mode%,"Mode","Only almanacs,Almanac+Date/Time+Position" dFILE file$,"Almanac file,Folder,Disk",16+UseSystemFolder& dBUTTONS "Cancel",-(27+$100)," Continue ",13+$100 Busy:(KBusyOff$,0) Lock:(KLock%) : r%=DIALOG : Lock:(KUnlock%) IF r%<>13 : RETURN : ENDIF ENDIF IF mode%=1 DO dINIT "Approximate position" dEDIT lat$,"Latitude",10 dEDIT lon$,"Longitude",10 dBUTTONS " Select waypoint"+KDots$+" ",%W,"Cancel",-(27+$100),"Okay",13+$100 Lock:(KLock%) : r%=DIALOG : Lock:(KUnlock%) IF r%=%w  IF LocationFromDatabase%:(KTrue%,ADDR(str$),ADDR(str$),ADDR(lat),ADDR(lon)) lat$=FormatStr_Latitude$:(lat,KTrue%) lon$=FormatStr_Longitude$:(lon,KTrue%) ENDIF ELSEIF r%=13 lat=Val_LatLonStr:(lat$,KTrue%,KTrue%) IF lat>-1000 lon=Val_LatLonStr:(lon$,KFalse%,KTrue%) IF lon>-1000 : BREAK : ENDIF ENDIF ELSE RETURN ENDIF UNTIL KFalse% ENDIF  DO r%=IOOPEN(h%,file$,$400) IF r% IF NOT ErrorMessage%:("Open almanac file",r%,KTrue%) RETURN ENDIF ENDIF UNTIL r%=0  ONERR readerr:: IOREAD(h%,ADDR(datatype%),2) IOREAD(h%,ADDR(satnum%),2) addr&=satnum%*2 IOREAD(h%,ADDR(satid%(1)),addr&) IOREAD(h%,ADDR(weeknum%(1)),addr&) IOREAD(h%,ADDR(hlth%(1)),addr&) addr&=satnum%*8 IOREAD(h%,ADDR(reftime(1)),addr&) IOREAD(h%,ADDR(clockc1(1)),addr&) IOREAD(h%,ADDR(clockc2(1)),addr&) IOREAD(h%,ADDR(e(1)),addr&) IOREAD(h%,ADDR(sqrta(1)),addr&) IOREAD(h%,ADDR(m0(1)),addr&) IOREAD(h%,ADDR(w(1)),addr&) IOREAD(h%,ADDR(omg0(1)),addr&) IOREAD(h%,ADDR(odot(1)),addr&) IOREAD(h%,ADDR(i(1)),addr&) IOCLOSE(h%) ONERR off REM ... code for sending datas to garmin... readerr:: ONERR off Busy:(KBusyOff$,0) ErrorMessage%:("Read almanac datas"+KDots$,ERR,KFalse%) ENDPREM *** Read PVT Datas ***PROC ReadPVTDatas: LOCAL type%,cmd%,addr&,buffer$(255),msh,lps%,wnd& LOCAL alt,epe,eph,epv,fix%,tow,lat,lon,ve,vn,vu LOCAL str$(50),y%,m%,d%,h%,mi%,s%,yd%,date,time,s&,dummy type%=GetGarminDatatype%:(800,0) IF type%<0 ShortMessagePrompt:("Serial port","No valid transfer could be established.") RETURN ENDIF IF type%<>800 ShortMessagePrompt:("Serial port","The protocol of this device is not supported yet.") RETURN ENDIF  REM Pid_Records Busy:("Reading datas"+KDots$,1) IF NOT GRMN_SendAndGetStrExt%:($0a,CHR$(49)+CHR$($00),51) Busy:(KBusyOff$,0) GRMN_Abort: gIPRINT "No response",1 RETURN ENDIF buffer$=sentence$ IF NOT GRMN_SendStrExt%:($0a,CHR$(50)+CHR$(0)) Busy:(KBusyOff$,0) GRMN_Abort: gIPRINT "No response",1 RETURN ENDIF Busy:(KBusyOff$,0)  addr&=ADDR(sentence$)+1 alt=IEEEfloat_GRM32_2_OPL64:(addr&) : addr&=addr&+4 epe=IEEEfloat_GRM32_2_OPL64:(addr&) : addr&=addr&+4 eph=IEEEfloat_GRM32_2_OPL64:(addr&) : addr&=addr&+4 epv=IEEEfloat_GRM32_2_OPL64:(addr&) : addr&=addr&+4 fix%=PEEKW(addr&) : addr&=addr&+2 tow =IEEEfloat_GRM64_2_OPL64:(addr&) : addr&=addr&+8 lat =IEEEfloat_GRM64_2_OPL64:(addr&)*180/PI : addr&=addr&+8 lon =-IEEEfloat_GRM64_2_OPL64:(addr&)*180/PI : addr&=addr&+8 ve =IEEEfloat_GRM32_2_OPL64:(addr&) : addr&=addr&+4 vn =IEEEfloat_GRM32_2_OPL64:(addr&) : addr&=addr&+4 vu =IEEEfloat_GRM32_2_OPL64:(addr&) : addr&=addr&+4 msh =IEEEfloat_GRM32_2_OPL64:(addr&) : addr&=addr&+4 lps%=PEEKW(addr&) : addr&=addr&+2 wnd&=PEEKL(addr&) IF fix%=1 str$="invalid or unavailable" ELSEIF fix%=2 str$="2 dimensional fix" ELSEIF fix%=3 str$="3 dimensional fix" ELSEIF fix%=4 str$="2D differential fix" ELSEIF fix%=5 str$="3D differential fix" ELSE str$="failed integrity check" ENDIF s&=DATETOSECS(1990,1,1,0,0,0) s&=s&+(wnd&-1)*86400+tow-lps% SECSTODATE s&,y%,m%,d%,h%,mi%,s%,yd% y%=modulo%:(y%,100) date=d% : date=date*100+m% : date=date*100+y% time=h% : time=time*100+mi% : time=time*100+s%  dINIT "GPS PVT Datas",16 dTEXT "State",str$ dTEXT "Altitude above MSL",FormatStr_Distance$:(alt+msh,KTrue%) dTEXT "Estimated position error",FormatStr_Distance$:(epe/2,KFalse%) dTEXT "EPE horizontal/vertical only",FormatStr_Distance$:(eph/2,KFalse%)+", "+FormatStr_Distance$:(epv/2,KFalse%) dTEXT "Location (WGS84)",FormatStr_Latitude$:(lat,KTrue%)+", "+FormatStr_Longitude$:(lon,KTrue%) dTEXT "Velocity north/west/up",FormatStr_Velocity$:(vn)+", "+FormatStr_Velocity$:(-ve)+", "+FormatStr_Velocity$:(vu) dTEXT "GPS date",FormatStr_Date$:(date,0) dTEXT "GPS time",FormatStr_Time$:(time,utc_offs&,ADDR(dummy)) dTEXT "GPS-UTC difference",FormatStr_Duration$:(lps%) Lock:(KLock%) : DIALOG : Lock:(KUnlock%)ENDPREM *** Reads date and time from Garmin ***PROC ReadGarminDateAndTime: LOCAL cmd%,addr&,d%,m%,y%,h%,mi%,s%,date,time,dummy,type% type%=GetGarminDatatype%:(600,0) IF type%<0 ShortMessagePrompt:("Serial port","No valid transfer could be established.") RETURN ENDIF IF type%<>600 ShortMessagePrompt:("Serial port","The protocol of this device is not supported yet.") RETURN ENDIF  REM Pid_Records Busy:("Reading datas"+KDots$,1) IF NOT GRMN_SendAndGetStrExt%:($0a,CHR$(5)+CHR$($00),14) Busy:(KBusyOff$,0) GRMN_Abort: gIPRINT "No response",1 RETURN ENDIF Busy:(KBusyOff$,0) addr&=ADDR(sentence$)+1 m% =PEEKB(addr&) : addr&=addr&+1 d% =PEEKB(addr&) : addr&=addr&+1 y% =PEEKW(addr&) : addr&=addr&+2 h% =PEEKW(addr&) : addr&=addr&+2 mi%=PEEKB(addr&) : addr&=addr&+1 s% =PEEKB(addr&) y%=modulo%:(y%,100) date=d% : date=date*100+m% : date=date*100+y% time=h% : time=time*100+mi% : time=time*100+s% dINIT "GPS Date and Time" dTEXT "Date",FormatStr_Date$:(date,0) dTEXT "Time",FormatStr_Time$:(time,utc_offs&,ADDR(dummy)) dBUTTONS " Okay ",13+$100 Lock:(KLock%) : DIALOG : Lock:(KUnlock%) ENDPREM *** Reads position from Garmin ***PROC ReadGarminPosition: LOCAL cmd%,addr&,lat,lon,type% type%=GetGarminDatatype%:(700,0) IF type%<0 ShortMessagePrompt:("Serial port","No valid transfer could be established.") RETURN ENDIF IF type%<>700 ShortMessagePrompt:("Serial port","The protocol of this device is not supported yet.") RETURN ENDIF  REM Pid_Records Busy:("Reading datas"+KDots$,1) IF NOT GRMN_SendAndGetStrExt%:($0a,CHR$(2)+CHR$($00),17) Busy:(KBusyOff$,0) GRMN_Abort: gIPRINT "No response",1 RETURN ENDIF Busy:(KBusyOff$,0) addr&=ADDR(sentence$)+1 lat =IEEEfloat_GRM64_2_OPL64:(addr&)*180/PI : addr&=addr&+8 lon =-IEEEfloat_GRM64_2_OPL64:(addr&)*180/PI dINIT "GPS Location (WGS84)" dTEXT "Latitude",FormatStr_Latitude$:(lat,KTrue%) dTEXT "Longitude",FormatStr_Longitude$:(lon,KTrue%) dBUTTONS " Okay ",13+$100 Lock:(KLock%) : DIALOG : Lock:(KUnlock%) ENDPREM *** Turn off Garmin power via Garmin protocol ***PROC GarminPowerOff: Busy:("Sending command"+KDots$,1) IF NOT GRMN_SendStr%:($0a,CHR$($08)+CHR$($00)) Busy:(KBusyOff$,0) GRMN_Abort: gIPRINT "No response",1 RETURN ENDIF Busy:(KBusyOff$,0) IF 1.0=CloseSerial:  gIPRINT "Serial port closed",1 ENDIFENDPREM *** Sends waypoints to GRMN-device ***PROC Waypoints2Garmin: LOCAL cmd%,numrec%,cnt%,c%,file$(255),q$(255) LOCAL a&,a2&,type% file$=LastWaypointFile$  IF ExtractFile$:(file$)="" OR NOT EXIST(file$) file$=GetWaypointFile$:("Source waypoint file",KFalse%,KFalse%) IF file$="" : RETURN : ENDIF ENDIF DO dINIT "Send waypoints to Garmin" dTEXT "Source file:",ExtractFile$:(file$) dBUTTONS " Change file"+KDots$+" ",%F,"Cancel",-(27+$100),"Send",13  Lock:(KLock%) : c%=DIALOG : Lock:(KUnlock%) IF c%=%f q$=GetWaypointFile$:("Select waypoint file"+KDots$,KFalse%,KFalse%) IF q$<>"" : file$=q$ : ENDIF ELSEIF c%<>13 RETURN ENDIF UNTIL c%=13 IF file$="" : RETURN : ENDIF LastWaypointFile$=file$ type%=GetGarminDatatype%:(100,0) IF type%<0 ShortMessagePrompt:("Serial port","No valid transfer could be established.") RETURN ENDIF IF type%<>100 AND type%<>101 AND type%<>102 AND type%<>103 AND type%<>104 AND type%<>151 AND type%<>152 AND type%<>154 AND type%<>155 ShortMessagePrompt:("Serial port","The protocol of this device is not supported yet.") RETURN ENDIF   q$=file$+" SELECT * FROM waypoints" DO ONERR notopen:: OPEN q$,W,n$,d$,la,lo,al ONERR off BREAKnotopen:: ONERR off IF NOT ErrorMessage%:("Open waypoint file",ERR,KTrue%) RETURN ENDIF UNTIL KFalse%  Busy:("Counting waypoints"+KDots$,1) FIRST numrec%=0 WHILE NOT EOF numrec%=numrec%+1 NEXT ENDWH  IF GRMNwaitforrequest% Busy:("Waiting for response"+KDots$,1) DO IF NOT GRMN_GetStr%:(ADDR(cmd%)) Busy:(KBusyOff$,0) CLOSE gIPRINT "No response",1 RETURN ENDIF IF cmd%=$0a AND PEEKW(ADDR(sentence$)+1)=7 BREAK ENDIF GRMN_Nak:(cmd%) IF KEY=27 GRMN_Abort: Busy:(KBusyOff$,0) CLOSE gIPRINT "Aborted by user",1 RETURN ENDIF UNTIL KTrue% GRMN_Ack:(cmd%) ENDIF  Busy:("Sending waypoints"+KDots$,1) REM Pid_Records IF NOT GRMN_SendStrExt%:($1b,CHR$(modulo%:(numrec%,256))+CHR$(numrec%/256)) Busy:(KBusyOff$,0) GRMN_Abort: gIPRINT "No response",1 CLOSE RETURN ENDIF  REM Pid_Wpt_Data cnt%=0 FIRST WHILE NOT EOF a& =ADDR(sentence$)+1 q$ =UPPER$(W.n$) a2&=ADDR(q$)+1 : c%=1 WHILE c%<=LEN(q$) POKEB a&,PEEKB(a2&) a&=a&+1 : a2&=a2&+1 : c%=c%+1 ENDWH WHILE c%<7 : POKEB a&,32 : a&=a&+1 : c%=c%+1 : ENDWH POKEL a&,INT(W.la*11930464.7111111111) a&=a&+4 : c%=c%+4 POKEL a&,INT(-W.lo*11930464.7111111111) a&=a&+4 : c%=c%+4 POKEL a&,0 a&=a&+4 : c%=c%+4 q$ =MID$(UPPER$(W.d$),1,40) a2&=ADDR(q$)+1 WHILE c%<=LEN(q$)+19 POKEB a&,PEEKB(a2&) a&=a&+1 : a2&=a2&+1 : c%=c%+1 ENDWH IF c%<59 POKEB a&,0 : a&=a&+1 : c%=c%+1 ENDIF WHILE c%<59 : POKEB a&,32 : a&=a&+1 : c%=c%+1 : ENDWH POKEW a&,0 POKEB ADDR(sentence$),60 IF NOT GRMN_SendStrExt%:($23,sentence$) Busy:(KBusyOff$,0) GRMN_Abort: gIPRINT "No response",1 CLOSE RETURN ENDIF cnt%=cnt%+1 NEXT ENDWH CLOSE  REM Pid_Xfer_Complete IF NOT GRMN_SendStrExt%:($0c,CHR$(7)+CHR$(0)) Busy:(KBusyOff$,0) GRMN_Abort: gIPRINT "No response",1 RETURN ENDIF Busy:(KBusyOff$,0) IF cnt%=1 : q$=" was" : ELSE q$="s were" : ENDIF  ShortMessagePrompt:("Transfer done",FIX$(cnt%,0,3)+" waypoint"+q$+" sent.")ENDPREM *** Reads waypoints from GRMN-device ***PROC WaypointsFromGarmin: LOCAL cmd%,numrec%,cnt%,file$(255),q$(255),r%,type%  file$=LastWaypointFile$ IF ExtractFile$:(file$)="" OR NOT EXIST(file$) file$=GetWaypointFile$:("Destination waypoint file",KFalse%,KTrue%) IF file$="" : RETURN : ENDIF ENDIF DO dINIT "Read waypoints from Garmin" dTEXT "Add to:",ExtractFile$:(file$) dBUTTONS " Change file"+KDots$+" ",%F,"Cancel",-(27+$100),"Read",13 Lock:(KLock%) : r%=DIALOG : Lock:(KUnlock%) IF r%=%f q$=GetWaypointFile$:("Select waypoint file"+KDots$,KFalse%,KTrue%) IF q$<>"" : file$=q$ : ENDIF ELSEIF r%<>13 RETURN ENDIF UNTIL r%=13 AND ExtractFile$:(file$)<>"" LastWaypointFile$=file$ type%=GetGarminDatatype%:(100,0) IF type%<0 ShortMessagePrompt:("Serial port","No valid transfer could be established.") RETURN ENDIF IF type%<>100 AND type%<>101 AND type%<>102 AND type%<>103 AND type%<>104 AND type%<>151 AND type%<>152 AND type%<>154 AND type%<>155 ShortMessagePrompt:("Serial port","The protocol of this device is not supported yet.") RETURN ENDIF   q$=file$+" SELECT * FROM waypoints" DO ONERR notopen:: OPEN q$,W,n$,d$,la,lo,al ONERR off BREAKnotopen:: ONERR off IF NOT ErrorMessage%:("Open waypoint file",ERR,KTrue%) RETURN ENDIF UNTIL KFalse%  BEGINTRANS REM Pid_Waypoints Busy:("Reading waypoints"+KDots$,1) IF NOT GRMN_SendAndGetStrExt%:($0a,CHR$($07)+CHR$($00),$1b) Busy:(KBusyOff$,0) GRMN_Abort: ROLLBACK : CLOSE gIPRINT "No response",1 RETURN ENDIF numrec%=ASC(MID$(sentence$,2,1))*256+ASC(LEFT$(sentence$,1)) cnt%=0 WHILE KTrue% IF NOT GRMN_GetStr%:(ADDR(cmd%)) Busy:(KBusyOff$,0) GRMN_Abort: ROLLBACK : CLOSE gIPRINT "No response",1 RETURN ENDIF IF cmd%=$23 INSERT W.la = PEEKL(ADDR(sentence$)+7)/11930464.7111111111 W.lo = -(PEEKL(ADDR(sentence$)+11)/11930464.7111111111) W.n$ = UPPER$(MID$(sentence$,1,6)) r%=1 WHILE r%<=40 IF PEEKB(ADDR(sentence$)+18+r%)<32 : BREAK : ENDIF r%=r%+1 ENDWH IF r%>1 W.d$=UPPER$(MID$(sentence$,19,r%-1)) ELSE W.d$="" ENDIF W.al = 0 : REM altitude will not be read  REM remove trail spaces in name and description WHILE LEN(W.n$)>1 IF RIGHT$(W.n$,1)<>" " : BREAK : ENDIF W.n$=LEFT$(W.n$,LEN(W.n$)-1) ENDWH WHILE LEN(W.d$)>1 IF RIGHT$(W.d$,1)<>" " : BREAK : ENDIF W.d$=LEFT$(W.d$,LEN(W.d$)-1) ENDWH PUT cnt%=cnt%+1 ENDIF GRMN_Ack:(cmd%) IF cmd%=$0c : BREAK : ENDIF ENDWH COMMITTRANS : CLOSE Busy:(KBusyOff$,0)  IF cnt%=1 : q$=" was" : ELSE q$="s were" : ENDIF  ShortMessagePrompt:("Transfer done",FIX$(cnt%,0,3)+" waypoint"+q$+" read.")ENDPREM ***** Export waypoints to text file *****PROC Waypoints2Textfile: LOCAL file$(255),out_id%,out_lat%,out_lon%,out_desc% LOCAL out$(255),q$(255),sep%,sep$(5),cnt%,r%,c%,h% file$=GetWaypointFile$:("Select source file"+KDots$,KTrue%,KFalse%) IF file$="" : RETURN KTrue% : ENDIF  sep%=(wayp_xch_setts& AND &F0000)/&10000 out_id% =(wayp_xch_setts& AND &000F) out_lat% =(wayp_xch_setts& AND &00F0)/&10 out_lon% =(wayp_xch_setts& AND &0F00)/&100 out_desc%=(wayp_xch_setts& AND &F000)/&1000 DO dINIT "Export waypoints to text file"  dTEXT "Source file",ExtractFile$:(file$) dTEXT "","",$800 dCHOICE out_id%,"Output waypoint id","1st column,2nd column,3rd column,4th column" dCHOICE out_lat%,"Output latitude","1st column,2nd column,3rd column,4th column" dCHOICE out_lon%,"Output longitude","1st column,2nd column,3rd column,4th column" dCHOICE out_desc%,"Output description","1st column,2nd column,3rd column,4th column,(hide)" dCHOICE sep%,"Seperate columns by","SPACE,COMMA,TAB" dBUTTONS " Change file"+KDots$+" ",%F,"Cancel",-(27+$100),"Continue"+KDots$,13+$100 Lock:(KLock%) : r%=DIALOG : Lock:(KUnlock%) IF r%=%f q$=GetWaypointFile$:("Select waypoint file"+KDots$,KFalse%,KFalse%) IF q$<>"" : file$=q$ : ENDIF ELSEIF r%=13 c%=out_id% : cnt%=3 c%=MAX(out_lat%,c%) c%=MAX(out_lon%,c%) IF out_desc%<5 : c%=MAX(out_desc%,c%) : cnt%=4 : ENDIF IF c%<>cnt% OR out_id%=out_lat% OR out_id%=out_lon% OR out_id%=out_desc% OR out_lat%=out_lon% OR out_lat%=out_desc% OR out_lon%=out_desc% gIPRINT "Wrong entry order",2 r%=0 ENDIF ELSE RETURN ENDIF UNTIL r%=13 IF file$="" : RETURN : ENDIF LastWaypointFile$=file$ wayp_xch_setts&=sep% wayp_xch_setts&=wayp_xch_setts&*&100+out_desc%*&10+out_lon% wayp_xch_setts&=wayp_xch_setts&*&100+out_lat%*&10+out_id% out$=LastWaypExportFile$ IF UseFastFileDialog% out$=FileDialog$:("Select output file",out$,KTrue%,"",&0) IF out$="" : RETURN : ENDIF ELSE Busy:("Building file list"+KDots$,1) dINIT "Select output file" dFILE out$,"Filename,Folder,Disk",17+UseSystemFolder& dBUTTONS " Cancel ",-(27+$100),"Okay",13+$100 Busy:(KBusyOff$,0) Lock:(KLock%) : r%=DIALOG : Lock:(KUnlock%) IF r%<>13 : RETURN : ENDIF ENDIF LastWaypExportFile$=out$ REM open waypoint file q$=file$+" SELECT * FROM waypoints" DO ONERR notopen:: OPEN q$,W,n$,d$,la,lo,al ONERR off BREAKnotopen:: ONERR off IF NOT ErrorMessage%:("Open waypoint file",ERR,KTrue%) RETURN ENDIF UNTIL KFalse%  REM open output file DO r%=IOOPEN(h%,out$,$0122) IF r% IF NOT ErrorMessage%:("Open output file",r%,KTrue%) CLOSE RETURN ENDIF ENDIF UNTIL r%=0  IF sep%=1 : sep$=" " ELSEIF sep%=2 : sep$="," ELSE sep$=CHR$(9) ENDIF cnt%=0  Busy:("Writing waypoints"+KDots$,1)  FIRST WHILE NOT EOF q$="" c%=1 WHILE c%<5 IF out_id%=c% IF q$<>"" : q$=q$+sep$ :ENDIF q$=q$+W.n$ ELSEIF out_lat%=c% IF q$<>"" : q$=q$+sep$ :ENDIF q$=q$+FormatStr_Latitude$:(W.la,KTrue%) ELSEIF out_lon%=c% IF q$<>"" : q$=q$+sep$ :ENDIF q$=q$+FormatStr_Longitude$:(W.lo,KTrue%) ELSEIF out_desc%=c% IF q$<>"" : q$=q$+sep$ :ENDIF q$=q$+W.d$ ENDIF c%=c%+1 ENDWH IOWRITE(h%,ADDR(q$)+1,LEN(q$)) cnt%=cnt%+1 NEXT ENDWH CLOSE IOCLOSE(h%) Busy:(KBusyOff$,0)  IF cnt%=1 : q$=" was" : ELSE q$="s were" : ENDIF  ShortMessagePrompt:("Export done",FIX$(cnt%,0,3)+" waypoint"+q$+" written to file.")ENDPREM *** Import waypoints from textfile ***PROC WaypointsFromTextfile: LOCAL file$(255),inp_id%,inp_lat%,inp_lon%,inp_desc%,r%,h% LOCAL inp$(255),q$(255),sep%,sep$(5),cnt%,p1%,p2%,p3%,c% LOCAL errstr$(50),clms%,clm%  inp$=LastWaypExportFile$ IF UseFastFileDialog% inp$=FileDialog$:("Select input file",inp$,KFalse%,"",&0) IF inp$="" : RETURN : ENDIF ELSE Busy:("Building file list"+KDots$,1) dINIT "Select input file" dFILE inp$,"Filename,Folder,Disk",16+UseSystemFolder& dBUTTONS " Cancel ",-(27+$100),"Okay",13+$100 Busy:(KBusyOff$,0) Lock:(KLock%) : r%=DIALOG : Lock:(KUnlock%) IF r%<>13 : RETURN : ENDIF ENDIF LastWaypExportFile$=inp$ file$=GetWaypointFile$:("Select destination file"+KDots$,KTrue%,KTrue%) IF file$="" : RETURN KTrue% : ENDIF  sep%=(wayp_xch_setts& AND &F0000)/&10000 inp_id% =(wayp_xch_setts& AND &000F) inp_lat% =(wayp_xch_setts& AND &00F0)/&10 inp_lon% =(wayp_xch_setts& AND &0F00)/&100 inp_desc%=(wayp_xch_setts& AND &F000)/&1000 DO dINIT "Import waypoints from "+ExtractFile$:(inp$) dTEXT "Add to:",ExtractFile$:(file$) dTEXT "","",$800 dCHOICE inp_id%,"Waypoint id from","1st column,2nd column,3rd column,4th column" dCHOICE inp_lat%,"Latitude from","1st column,2nd column,3rd column,4th column" dCHOICE inp_lon%,"Longitude from","1st column,2nd column,3rd column,4th column" dCHOICE inp_desc%,"Description from","1st column,2nd column,3rd column,4th column,(hidden)" dCHOICE sep%,"Columns seperated by","SPACE,COMMA,TAB" dBUTTONS " Change file"+KDots$+" ",%F,"Cancel",-(27+$100),"Okay",13+$100 Lock:(KLock%) : r%=DIALOG : Lock:(KUnlock%) IF r%=%f q$=GetWaypointFile$:("Select waypoint file"+KDots$,KFalse%,KTrue%) IF q$<>"" : file$=q$ : ENDIF ELSEIF r%=13  c%=inp_id% : clms%=3 c%=MAX(inp_lat%,c%) c%=MAX(inp_lon%,c%) IF inp_desc%<5 : c%=MAX(inp_desc%,c%) : clms%=4 : ENDIF IF c%<>clms% OR inp_id%=inp_lat% OR inp_id%=inp_lon% OR inp_id%=inp_desc% OR inp_lat%=inp_lon% OR inp_lat%=inp_desc% OR inp_lon%=inp_desc% gIPRINT "Wrong entry order",2 r%=0 ENDIF ELSE RETURN ENDIF UNTIL r%=13 IF file$="" : RETURN : ENDIF LastWaypointFile$=file$ wayp_xch_setts&=sep% wayp_xch_setts&=wayp_xch_setts&*&100+inp_desc%*&10+inp_lon% wayp_xch_setts&=wayp_xch_setts&*&100+inp_lat%*&10+inp_id% REM open waypoint file q$=file$+" SELECT * FROM waypoints" DO ONERR notopen:: OPEN q$,W,n$,d$,la,lo,al ONERR off BREAKnotopen:: ONERR off IF NOT ErrorMessage%:("Open waypoint file",ERR,KTrue%) RETURN ENDIF UNTIL KFalse%  REM open input file DO r%=IOOPEN(h%,inp$,$0420) IF r% IF NOT ErrorMessage%:("Open input file",r%,KTrue%) CLOSE RETURN ENDIF ENDIF UNTIL r%=0  IF sep%=1 : sep$=" " ELSEIF sep%=2 : sep$="," ELSE sep$=CHR$(9) ENDIF cnt%=0 : errstr$="" Busy:("Reading waypoints"+KDots$,1)  BEGINTRANS WHILE KTrue% r%=IOREAD(h%,ADDR(q$)+1,255) IF r%<=0 : BREAK : ENDIF POKEB ADDR(q$),r%  INSERT c%=1 : p1%=1 : clm%=0 WHILE c%<5 IF inp_id%=c% p2%=PosInStr%:(sep$,q$,p1%) IF p1%=p2% errstr$="Empty waypoint id entry" BREAK ENDIF IF p2%=0 : W.n$=MID$(q$,p1%,6) ELSE W.n$=MID$(q$,p1%,MIN(p2%-p1%,6)) ENDIF clm%=clm%+1 ELSEIF inp_lat%=c% p2%=PosInStr%:(sep$,q$,p1%) IF p1%=p2% errstr$="Empty latitude entry" BREAK ENDIF IF p2%=0  W.la=Val_LatLonStr:(MID$(q$,p1%,255),KTrue%,KFalse%) ELSE W.la=Val_LatLonStr:(MID$(q$,p1%,p2%-p1%),KTrue%,KFalse%) ENDIF IF W.la=-1000 errstr$="Wrong latitude format" BREAK ENDIF clm%=clm%+1 ELSEIF inp_lon%=c% p2%=PosInStr%:(sep$,q$,p1%) IF p1%=p2% errstr$="Empty longitude entry" BREAK ENDIF IF p2%=0  W.lo=Val_LatLonStr:(MID$(q$,p1%,255),KFalse%,KFalse%) ELSE W.lo=Val_LatLonStr:(MID$(q$,p1%,p2%-p1%),KFalse%,KFalse%) ENDIF IF W.lo=-1000 errstr$="Wrong longitude format" BREAK ENDIF clm%=clm%+1 ELSEIF inp_desc%=c% p2%=PosInStr%:(sep$,q$,p1%) IF p1%=p2% : W.d$="" ELSEIF p2%=0 : W.d$=MID$(q$,p1%,40) ELSE W.d$=MID$(q$,p1%,MIN(p2%-p1%,40)) ENDIF clm%=clm%+1 ENDIF IF p2%=0 OR p2%=LEN(q$) : BREAK : ENDIF p1%=p2%+1 c%=c%+1 ENDWH IF clms%<>clm% errstr$="Missing entry" ENDIF IF errstr$<>"" : BREAK : ENDIF W.al=0 PUT cnt%=cnt%+1 ENDWH Busy:(KBusyOff$,0) IF errstr$="" COMMITTRANS  ELSE PUT : ROLLBACK : cnt%=0 ShortMessagePrompt:("Line "+FIX$(cnt%+1,0,5),errstr$) ENDIF CLOSE IOCLOSE(h%)  IF cnt%=1 : q$=" was" : ELSE q$="s were" : ENDIF  ShortMessagePrompt:("Import done",FIX$(cnt%,0,3)+" waypoint"+q$+" read from file.")ENDPREM *** Edit route database ***PROC EditRoute: LOCAL file$(255),file2$(255),r%,c%,q$(255),waynum% LOCAL buffer$(255),waypoints%,rdesc$(40),id$(6) LOCAL open%,lat,lon,alt,lat$(20),lon$(20),time LOCAL lat2,lon2,alt2,id2$(6),addmode%,b1%,b2% file$=GetRouteFile$:("Select route file",KTrue%,KTrue%) IF file$="" : RETURN : ENDIF open%=KFalse% DO dINIT "Edit route"+KDots$ dTEXT "File",ExtractFile$:(file$)  IF file$<>"" AND EXIST(file$) IF NOT open% DO ONERR noopen:: q$=file$+" SELECT * FROM header" OPENq$,X,d$,wn% : FIRST  rdesc$=X.d$ waypoints%=X.wn% open%=KTrue% q$=file$+" SELECT * FROM waypoints ORDER BY pos" OPENq$,Y,pos%,id$,lat,lon,alt : FIRST  ONERR off BREAKnoopen:: ONERR off IF open% : USEX : CLOSE : open%=KFalse% : ENDIF IF NOT ErrorMessage%:("Open route file",ERR,KTrue%) BREAK ENDIF UNTIL KFalse% ENDIF IF open% dEDIT rdesc$,"Description",15 IF waypoints%=0 dCHOICE waynum%,"Waypoints","(empty route)" ELSE Busy:("Building waypoint list"+KDots$,1) USE Y : FIRST c%=1 q$=Y.id$ WHILE c%"" : file$=file2$ : ENDIF  ELSEIF r%=%w REM edit waypoint list DO dINIT "Edit waypoint list"+KDots$ dTEXT "Route",ExtractFile$:(file$) IF waypoints%=0  dCHOICE waynum%,"Waypoints","(empty route)" dBUTTONS " Add"+KDots$+" ",%A+$200,"Back",-(27+$100) ELSE Busy:("Building waypoint list"+KDots$,1) USE Y : FIRST c%=1 q$=Y.id$ : lat=Y.lat : lon=Y.lon WHILE c%1 dBUTTONS " Edit"+KDots$+" ",%E+$200,"Up",%U+$200,"Down",%D+$200," Remove ",%R+$200,"Add"+KDots$,%A+$200,"Back",-(27+$100) ELSE dBUTTONS " Edit"+KDots$+" ",%E+$200," Remove ",%R+$200,"Add"+KDots$,%A+$200,"Back",-(27+$100) ENDIF ENDIF Lock:(KLock%) : r%=DIALOG : Lock:(KUnlock%) IF r%=%a OR r%=%e REM add/edit waypoint addmode%=(r%=%a) IF addmode% lat$="" : lon$="" : id$="" : alt=0 ELSE USE Y POSITION waynum% lat$=FormatStr_Latitude$:(Y.lat,KTrue%) lon$=FormatStr_Longitude$:(Y.lon,KTrue%) alt=Y.alt IF format%(6)<>1 alt=Convert:(alt,KMeters%,KFeets%) ENDIF id$=Y.id$ ENDIF DO IF addmode% dINIT "Add waypoint (to "+ExtractFile$:(file$)+")",17 ELSE dINIT "Edit waypoint (of "+ExtractFile$:(file$)+")",17 ENDIF IF connectmode%=KModeNMEA% dTEXT ""," " ENDIF dEDIT id$,"ID name",6 dTEXT ""," " dEDIT lat$,"Latitude",10 dEDIT lon$,"Longitude",10 IF format%(6)=1 dFLOAT alt,"Altitude (m)",-30000,30000 ELSE dFLOAT alt,"Altitude (ft)",-50000,50000 ENDIF IF connectmode%<>KModeNMEA% IF addmode% dBUTTONS " From database"+KDots$+" ",%W,"Cancel",-(27+$100),"Add",13+$100 ELSE dBUTTONS " From database"+KDots$+" ",%W,"Cancel",-(27+$100),"Set",13+$100 ENDIF ELSE IF addmode% dBUTTONS " From database"+KDots$+" ",%W," Current location ",%C,"Cancel",-(27+$100),"Add",13+$100 ELSE dBUTTONS " From database"+KDots$+" ",%W," Current location ",%C,"Cancel",-(27+$100),"Set",13+$100 ENDIF ENDIF Lock:(KLock%) : r%=DIALOG : Lock:(KUnlock%) IF r%=%c IF ReadCurrentPosition%:(ADDR(lat),ADDR(lon),ADDR(alt2),ADDR(time),KTrue%) IF lat0 lat$=FormatStr_Latitude$:(lat,KTrue%) lon$=FormatStr_Longitude$:(lon,KTrue%) alt=0 id$=MID$(q$,1,6) ENDIF  ELSEIF r%<>13 : BREAK ELSE IF id$="" OR PosInStr%:(",",id$,1)>0 gIPRINT "Wrong waypoint ID",2 ELSE IF format%(6)=1 : alt2=alt ELSE alt2=Convert:(alt,KFeets%,KMeters%) ENDIF lat=Val_LatLonStr:(lat$,KTrue%,KTrue%) IF lat>-1000 lon=Val_LatLonStr:(lon$,KFalse%,KTrue%) ENDIF USE Y IF lat>-1000 AND lon>-1000 AND NOT addmode% POSITION waynum% MODIFY Y.lat=lat : Y.lon=lon : Y.alt=alt2 Y.id$=UPPER$(id$) PUT BREAK ELSEIF lat>-1000 AND lon>-1000 AND addmode% waypoints%=waypoints%+1 waynum%=waypoints% INSERT Y.lat=lat : Y.lon=lon : Y.alt=alt2 Y.id$=UPPER$(id$) : Y.pos%=waynum% PUT BREAK ENDIF ENDIF ENDIF UNTIL KFalse%  ELSEIF r%=%r REM delete waypoint USE Y : POSITION waynum% dINIT "Waypoint '"+Y.id$+"'" dTEXT "","Do you really want to remove",2 dTEXT "","this waypoint from the opened route?",2 dBUTTONS "No",%N+$300," Yes ",%Y+$300 Lock:(KLock%) : r%=DIALOG : Lock:(KUnlock%) IF r%=%y ERASE waypoints%=waypoints%-1 c%=waynum% BEGINTRANS WHILE c%<=waypoints% MODIFY : Y.pos%=Y.pos%-1 : PUT c%=c%+1 NEXT ENDWH COMMITTRANS IF waynum%>waypoints% : waynum%=waypoints% : ENDIF ENDIF  ELSEIF r%=%u REM waypoint up IF waynum%>1 BEGINTRANS POSITION waynum% b1%=BOOKMARK POSITION waynum%-1 b2%=BOOKMARK GOTOMARK b1% MODIFY Y.pos%=waynum%-1 PUT GOTOMARK b2% MODIFY Y.pos%=waynum% PUT KILLMARK b1% KILLMARK b2% COMMITTRANS waynum%=waynum%-1 ENDIF  ELSEIF r%=%d REM waypoint down IF waynum%"" : file$=q$ : ENDIF ELSEIF r%=13 BREAK ELSE RETURN ENDIF UNTIL r%=13 IF file$="" : RETURN : ENDIF type1%=GetGarminDatatype%:(200,0) IF type1%<0 ShortMessagePrompt:("Serial port","No valid transfer could be established.") RETURN ENDIF IF type1%<>200 AND type1%<>201 ShortMessagePrompt:("Serial port","The protocol of this device is not supported yet.") RETURN ENDIF  type2%=GetGarminDatatype%:(200,1) IF type2%<0 ShortMessagePrompt:("Serial port","No valid transfer could be established.") RETURN ENDIF IF type2%<>100 AND type2%<>101 AND type2%<>102 AND type2%<>103 AND type2%<>104 AND type2%<>151 AND type2%<>152 AND type2%<>154 AND type2%<>155 ShortMessagePrompt:("Serial port","The protocol of this device is not supported yet.") RETURN ENDIF  REM open route file open%=KFalse% DO ONERR notopen:: q$=file$+" SELECT * FROM header" OPEN q$,X,d$,wn% open%=KTrue% q$=file$+" SELECT * FROM waypoints ORDER BY pos" OPEN q$,Y,pos%,n$,la,lo,al ONERR off BREAKnotopen:: ONERR off IF open% : USEX : CLOSE : open%=KFalse% : ENDIF IF NOT ErrorMessage%:("Open route file",ERR,KTrue%) RETURN ENDIF UNTIL KFalse%  LastRouteFile$=file$   USE X : FIRST : waypoints%=X.wn% : d$=X.d$ : CLOSE IF waypoints%=0 ShortMessagePrompt:("Empty route","0 waypoints will be sent.") USEY : CLOSE RETURN ENDIF  USE Y : cnt%=0  IF GRMNwaitforrequest% Busy:("Waiting for response"+KDots$,1) DO IF NOT GRMN_GetStr%:(ADDR(cmd%)) Busy:(KBusyOff$,0) CLOSE gIPRINT "No response",1 RETURN ENDIF IF cmd%=$0a AND PEEKW(ADDR(sentence$)+1)=4 BREAK ENDIF IF KEY=27 Busy:(KBusyOff$,0) GRMN_Abort: CLOSE gIPRINT "Aborted by user",1 RETURN ENDIF UNTIL KTrue% GRMN_Ack:(cmd%) ENDIF numrec%=waypoints%+1 REM Pid_Route IFNOT GRMN_SendStrExt%:($1b,CHR$(modulo%:(numrec%,256))+CHR$(numrec%/256)) Busy:(KBusyOff$,0) GRMN_Abort: gIPRINT "No response",1 CLOSE RETURN ENDIF  REM Pid_Route_Hdr sentence$=CHR$(rnum&) IF type1%=201 IF d$="" : d$="PSIONROUTE" : ENDIF d$=UPPER$(MID$(d$,1,20)) IF PEEKB(ADDR(d$))<20 : d$=d$+CHR$(0) : ENDIF WHILE PEEKB(ADDR(d$))<20 : d$=d$+" " : ENDWH sentence$=sentence$+d$ ENDIF IF NOT GRMN_SendStrExt%:($1d,sentence$) Busy:(KBusyOff$,0) GRMN_Abort: gIPRINT "No response",1 CLOSE RETURN ENDIF  cnt%=0 FIRST WHILE NOT EOF a& =ADDR(sentence$)+1 q$ =UPPER$(Y.n$) a2&=ADDR(q$)+1 : c%=1 WHILE c%<=LEN(q$) POKEB a&,PEEKB(a2&) a&=a&+1 : a2&=a2&+1 : c%=c%+1 ENDWH WHILE c%<7 : POKEB a&,32 : a&=a&+1 : c%=c%+1 : ENDWH POKEL a&,INT(Y.la*11930464.7111111111) a&=a&+4 : c%=c%+4 POKEL a&,INT(-Y.lo*11930464.7111111111) a&=a&+4 : c%=c%+4 POKEL a&,0 a&=a&+4 : c%=c%+4 POKEB a&,0 a&=a&+1 : c%=c%+1 WHILE c%<59 : POKEB a&,32 : a&=a&+1 : c%=c%+1 : ENDWH POKEW a&,0 POKEB ADDR(sentence$),60 IF NOT GRMN_SendStrExt%:($1e,sentence$) GRMN_Abort: Busy:(KBusyOff$,0) gIPRINT "No response",1 CLOSE RETURN ENDIF cnt%=cnt%+1 NEXT ENDWH CLOSE REM Pid_Xfer_Complete  IF NOT GRMN_SendStrExt%:($0c,CHR$(4)+CHR$(0)) GRMN_Abort: Busy:(KBusyOff$,0) gIPRINT "No response",1 RETURN ENDIF Busy:(KBusyOff$,0)  IF cnt%=1 : q$=" was" : ELSE q$="s were" : ENDIF  ShortMessagePrompt:("Transfer done",FIX$(cnt%,0,3)+" waypoint"+q$+" sent to Garmin.")ENDPREM *** Reads route from GRMN-device ***PROC RoutesFromGarmin:  LOCAL file$(255),r%,q$(255),cnt%,c%,waypoints% LOCAL cmd%,routenum%,num&,route_found%,numrec%,type%  file$=GetRouteFile$:("Select route file"+KDots$,KTrue%,KTrue%) IF file$="" : RETURN : ENDIF DO dINIT "Read route from Garmin" dTEXT "Add to file:",ExtractFile$:(file$) dLONG num&,"Unique route number:",0,10240 dBUTTONS " Change file"+KDots$+" ",%F,"Cancel",-(27+$100),"Read",13+$100 Lock:(KLock%) : r%=DIALOG : Lock:(KUnlock%) IF r%=%f q$=GetRouteFile$:("Select route file"+KDots$,KFalse%,KTrue%) IF q$<>"" : file$=q$ : ENDIF ELSEIF r%=13 BREAK ELSE RETURN ENDIF UNTIL KFalse% IF file$="" : RETURN : ENDIF type%=GetGarminDatatype%:(200,0) IF type%<0 ShortMessagePrompt:("Serial port","No valid transfer could be established.") RETURN ENDIF IF type%<>200 AND type%<>201 ShortMessagePrompt:("Serial port","The protocol of this device is not supported yet.") RETURN ENDIF  type%=GetGarminDatatype%:(200,1) IF type%<0 ShortMessagePrompt:("Serial port","No valid transfer could be established.") RETURN ENDIF IF type%<>100 AND type%<>101 AND type%<>102 AND type%<>103 AND type%<>104 AND type%<>151 AND type%<>152 AND type%<>154 AND type%<>155 ShortMessagePrompt:("Serial port","The protocol of this device is not supported yet.") RETURN ENDIF   REM open route file DO r%=KFalse% ONERR notopen:: q$=file$+" SELECT * FROM header" OPEN q$,H,d$,waypoints% r%=KTrue% q$=file$+" SELECT * FROM waypoints ORDER BY pos" OPEN q$,W,pos%,n$,la,lo,al ONERR off BREAKnotopen:: ONERR off IF r% :USE H : CLOSE : ENDIF IF NOT ErrorMessage%:("Open route file",ERR,KTrue%) RETURN ENDIF UNTIL KFalse% USE H : FIRST : waypoints%=H.waypoints% Busy:("Reading waypoints"+KDots$,1)  USE W BEGINTRANS IF NOT GRMN_SendAndGetStrExt%:($0a,CHR$($04)+CHR$($00),$1b) GRMN_Abort: Busy:(KBusyOff$,0) ROLLBACK : CLOSE : USE H : CLOSE gIPRINT "No response",1 RETURN ENDIF  numrec%=PEEKW(ADDR(sentence$)+1)  cnt%=0 : routenum%=-1 : route_found%=KFalse% WHILE KTrue%  IF NOT GRMN_GetStr%:(ADDR(cmd%)) GRMN_Abort: Busy:(KBusyOff$,0) ROLLBACK : CLOSE : USE H : CLOSE gIPRINT "No response",1 RETURN ENDIF IF cmd%=$1d routenum%=PEEKB(ADDR(sentence$)+1) IF routenum%=num& : route_found%=KTrue% : ENDIF ELSEIF cmd%=$1e IF routenum%=num& INSERT waypoints%=waypoints%+1 W.pos%=waypoints% W.la = PEEKL(ADDR(sentence$)+7)/11930464.7111111111 W.lo = -(PEEKL(ADDR(sentence$)+11)/11930464.7111111111) W.n$ = UPPER$(MID$(sentence$,1,6)) W.al = 0 : REM altitude will not be read REM description will be ignored  REM remove trail spaces in name and description WHILE LEN(W.n$)>1 IF RIGHT$(W.n$,1)<>" " : BREAK : ENDIF W.n$=LEFT$(W.n$,LEN(W.n$)-1) ENDWH PUT cnt%=cnt%+1 ENDIF ELSEIF cmd%<>$0c GRMN_Abort: Busy:(KBusyOff$,0) ROLLBACK : CLOSE : USE H : CLOSE gIPRINT "Wrong datas",1 RETURN  ENDIF GRMN_Ack:(cmd%) IF cmd%=$0c : BREAK : ENDIF ENDWH  Busy:(KBusyOff$,0) IF routenum%=-1 ShortMessagePrompt:("Wrong transfer","No route could be read.") ROLLBACK : CLOSE : USE H : CLOSE RETURN ELSEIF NOT route_found% ShortMessagePrompt:("Unsuccessful transfer","Route with requested unique number was not sent.") ROLLBACK : CLOSE : USE H : CLOSE RETURN ENDIF  Busy:("Closing route",1) COMMITTRANS : CLOSE USE H : FIRST MODIFY : H.waypoints%=waypoints% : PUT CLOSE COMPACT file$ Busy:(KBusyOff$,0)  IF cnt%=1 : q$=" was" : ELSE q$="s were" : ENDIF  ShortMessagePrompt:("Transfer done",FIX$(cnt%,0,3)+" waypoint"+q$+" added to route.")ENDPREM *** Export routes to text file ***PROC Route2Textfile: LOCAL file$(255),out_id%,out_lat%,out_lon%,out_desc% LOCAL out$(255),q$(255),sep%,sep$(5),cnt%,r%,c%,h%,open% LOCAL waypoints% file$=GetRouteFile$:("Select route file"+KDots$,KTrue%,KFalse%) IF file$="" : RETURN KTrue% : ENDIF  sep%=(wayp_xch_setts& AND &F0000)/&10000 out_id% =(wayp_xch_setts& AND &000F) out_lat% =(wayp_xch_setts& AND &00F0)/&10 out_lon% =(wayp_xch_setts& AND &0F00)/&100 out_desc%=(wayp_xch_setts& AND &F000)/&1000 IF out_desc%<4 IF out_id%>3 : out_id%=out_desc% : ENDIF IF out_lat%>3 : out_lat%=out_desc% : ENDIF IF out_lon%>3 : out_lon%=out_desc% : ENDIF ENDIF DO dINIT "Export route entries to text file"  dTEXT "Source file",ExtractFile$:(file$) dTEXT "","",$800 dCHOICE out_id%,"Output waypoint id","1st column,2nd column,3rd column,4th column" dCHOICE out_lat%,"Output latitude","1st column,2nd column,3rd column,4th column" dCHOICE out_lon%,"Output longitude","1st column,2nd column,3rd column,4th column" dCHOICE sep%,"Seperate columns by","SPACE,COMMA,TAB" dBUTTONS " Change file"+KDots$+" ",%F,"Cancel",-(27+$100),"Continue"+KDots$,13+$100 Lock:(KLock%) : r%=DIALOG : Lock:(KUnlock%) IF r%=%f q$=GetRouteFile$:("Select route file"+KDots$,KFalse%,KFalse%) IF q$<>"" : file$=q$ : ENDIF ELSEIF r%=13 c%=out_id% : cnt%=3 c%=MAX(out_lat%,c%) c%=MAX(out_lon%,c%) IF c%<>cnt% OR out_id%=out_lat% OR out_id%=out_lon% OR out_lat%=out_lon% gIPRINT "Wrong entry order",2 r%=0 ENDIF ELSE RETURN ENDIF UNTIL r%=13 IF file$="" : RETURN : ENDIF LastRouteFile$=file$ out_desc%=5 wayp_xch_setts&=sep% wayp_xch_setts&=wayp_xch_setts&*&100+out_desc%*&10+out_lon% wayp_xch_setts&=wayp_xch_setts&*&100+out_lat%*&10+out_id% out$=LastWaypExportFile$ IF UseFastFileDialog% out$=FileDialog$:("Select output file",out$,KTrue%,"",&0) IF out$="" : RETURN : ENDIF ELSE Busy:("Building file list"+KDots$,1) dINIT "Select output file" dFILE out$,"Filename,Folder,Disk",17+UseSystemFolder& dBUTTONS " Cancel ",-(27+$100),"Okay",13+$100 Busy:(KBusyOff$,0) Lock:(KLock%) : r%=DIALOG : Lock:(KUnlock%) IF r%<>13 : RETURN : ENDIF ENDIF LastWaypExportFile$=out$ REM open route file open%=KFalse% DO ONERR notopen:: q$=file$+" SELECT * FROM header" OPEN q$,H,d$,wn% open%=KTrue% q$=file$+" SELECT * FROM waypoints ORDER BY pos" OPEN q$,W,pos%,n$,la,lo,al ONERR off BREAKnotopen:: ONERR off IF open% : USE H : CLOSE : open%=KFalse% : ENDIF IF NOT ErrorMessage%:("Open route file",ERR,KTrue%) RETURN ENDIF UNTIL KFalse%  USE H : FIRST : waypoints%=H.wn% : CLOSE IF waypoints%=0 ShortMessagePrompt:("Empty route","Nothing to be done.") USEW : CLOSE RETURN ENDIF REM open output file DO r%=IOOPEN(h%,out$,$0122) IF r% IF NOT ErrorMessage%:("Open output file",r%,KTrue%) CLOSE RETURN ENDIF ENDIF UNTIL r%=0  IF sep%=1 : sep$=" " ELSEIF sep%=2 : sep$="," ELSE sep$=CHR$(9) ENDIF cnt%=0  Busy:("Writing waypoints"+KDots$,1)  FIRST WHILE NOT EOF q$="" c%=1 WHILE c%<4 IF out_id%=c% IF q$<>"" : q$=q$+sep$ :ENDIF q$=q$+W.n$ ELSEIF out_lat%=c% IF q$<>"" : q$=q$+sep$ :ENDIF q$=q$+FormatStr_Latitude$:(W.la,KTrue%) ELSEIF out_lon%=c% IF q$<>"" : q$=q$+sep$ :ENDIF q$=q$+FormatStr_Longitude$:(W.lo,KTrue%) ENDIF c%=c%+1 ENDWH IOWRITE(h%,ADDR(q$)+1,LEN(q$)) cnt%=cnt%+1 NEXT ENDWH CLOSE IOCLOSE(h%) Busy:(KBusyOff$,0)  IF cnt%=1 : q$=" was" : ELSE q$="s were" : ENDIF  ShortMessagePrompt:("Export waypoints",FIX$(cnt%,0,3)+" waypoint"+q$+" written to file.")ENDPREM *** Import route from textfile ***PROC RouteFromTextfile: LOCAL file$(255),inp_id%,inp_lat%,inp_lon%,inp_desc%,r%,h% LOCAL inp$(255),q$(255),sep%,sep$(5),cnt%,p1%,p2%,p3%,c% LOCAL errstr$(50),clms%,clm%,waypoints%  inp$=LastWaypExportFile$ IF UseFastFileDialog% inp$=FileDialog$:("Select input file",inp$,KFalse%,"",&0) IF inp$="" : RETURN : ENDIF ELSE Busy:("Building file list"+KDots$,1) dINIT "Select input file" dFILE inp$,"Filename,Folder,Disk",16+UseSystemFolder& dBUTTONS " Cancel ",-(27+$100),"Okay",13+$100 Busy:(KBusyOff$,0) Lock:(KLock%) : r%=DIALOG : Lock:(KUnlock%) IF r%<>13 : RETURN : ENDIF ENDIF LastWaypExportFile$=inp$ file$=GetRouteFile$:("Select destination file"+KDots$,KTrue%,KTrue%) IF file$="" : RETURN KTrue% : ENDIF  sep%=(wayp_xch_setts& AND &F0000)/&10000 inp_id% =(wayp_xch_setts& AND &000F) inp_lat% =(wayp_xch_setts& AND &00F0)/&10 inp_lon% =(wayp_xch_setts& AND &0F00)/&100 inp_desc%=(wayp_xch_setts& AND &F000)/&1000 DO dINIT "Import waypoints from "+ExtractFile$:(inp$) dTEXT "Add to route:",ExtractFile$:(file$) dTEXT "","",$800 dCHOICE inp_id%,"Waypoint id from","1st column,2nd column,3rd column,4th column" dCHOICE inp_lat%,"Latitude from","1st column,2nd column,3rd column,4th column" dCHOICE inp_lon%,"Longitude from","1st column,2nd column,3rd column,4th column" dCHOICE inp_desc%,"Description (ignored)","1st column,2nd column,3rd column,4th column,(hidden)" dCHOICE sep%,"Columns seperated by","SPACE,COMMA,TAB" dBUTTONS " Change file"+KDots$+" ",%F,"Cancel",-(27+$100),"Okay",13+$100 Lock:(KLock%) : r%=DIALOG : Lock:(KUnlock%) IF r%=%f q$=GetRouteFile$:("Select route file"+KDots$,KFalse%,KTrue%) IF q$<>"" : file$=q$ : ENDIF ELSEIF r%=13  c%=inp_id% : clms%=3 c%=MAX(inp_lat%,c%) c%=MAX(inp_lon%,c%) IF inp_desc%<5 : c%=MAX(inp_desc%,c%) : clms%=4 : ENDIF IF c%<>clms% OR inp_id%=inp_lat% OR inp_id%=inp_lon% OR inp_id%=inp_desc% OR inp_lat%=inp_lon% OR inp_lat%=inp_desc% OR inp_lon%=inp_desc% gIPRINT "Wrong entry order",2 r%=0 ENDIF ELSE RETURN ENDIF UNTIL r%=13 IF file$="" : RETURN : ENDIF LastRouteFile$=file$ wayp_xch_setts&=sep% wayp_xch_setts&=wayp_xch_setts&*&100+inp_desc%*&10+inp_lon% wayp_xch_setts&=wayp_xch_setts&*&100+inp_lat%*&10+inp_id% REM open route file DO r%=KFalse%  ONERR notopen:: q$=file$+" SELECT * FROM header" OPEN q$,H,d$,waypoints% r%=KTrue% q$=file$+" SELECT * FROM waypoints ORDER BY pos" OPEN q$,W,pos%,n$,la,lo,al ONERR off BREAKnotopen:: ONERR off IF r% :USE H : CLOSE : ENDIF IF NOT ErrorMessage%:("Open route file",ERR,KTrue%) RETURN ENDIF UNTIL KFalse% USE H : FIRST waypoints%=H.waypoints% REM open input file DO r%=IOOPEN(h%,inp$,$0420) IF r% IF NOT ErrorMessage%:("Open input file",r%,KTrue%) USE H : CLOSE USE W : CLOSE RETURN ENDIF ENDIF UNTIL r%=0  IF sep%=1 : sep$=" " ELSEIF sep%=2 : sep$="," ELSE sep$=CHR$(9) ENDIF cnt%=0 : errstr$="" Busy:("Reading waypoints"+KDots$,1)  USE W BEGINTRANS WHILE KTrue% r%=IOREAD(h%,ADDR(q$)+1,255) IF r%<=0 : BREAK : ENDIF POKEB ADDR(q$),r%  INSERT c%=1 : p1%=1 : clm%=0 WHILE c%<5 IF inp_id%=c% p2%=PosInStr%:(sep$,q$,p1%) IF p1%=p2% errstr$="Empty waypoint id entry" BREAK ENDIF IF p2%=0 : W.n$=MID$(q$,p1%,6) ELSE W.n$=MID$(q$,p1%,MIN(p2%-p1%,6)) ENDIF clm%=clm%+1 ELSEIF inp_lat%=c% p2%=PosInStr%:(sep$,q$,p1%) IF p1%=p2% errstr$="Empty latitude entry" BREAK ENDIF IF p2%=0  W.la=Val_LatLonStr:(MID$(q$,p1%,255),KTrue%,KFalse%) ELSE W.la=Val_LatLonStr:(MID$(q$,p1%,p2%-p1%),KTrue%,KFalse%) ENDIF IF W.la=-1000 errstr$="Wrong latitude format" BREAK ENDIF clm%=clm%+1 ELSEIF inp_lon%=c% p2%=PosInStr%:(sep$,q$,p1%) IF p1%=p2% errstr$="Empty longitude entry" BREAK ENDIF IF p2%=0  W.lo=Val_LatLonStr:(MID$(q$,p1%,255),KFalse%,KFalse%) ELSE W.lo=Val_LatLonStr:(MID$(q$,p1%,p2%-p1%),KFalse%,KFalse%) ENDIF IF W.lo=-1000 errstr$="Wrong longitude format" BREAK ENDIF clm%=clm%+1 ELSEIF inp_desc%=c% p2%=PosInStr%:(sep$,q$,p1%) ENDIF IF p2%=0 OR p2%=LEN(q$) : BREAK : ENDIF p1%=p2%+1 c%=c%+1 ENDWH IF clm%<>3 : errstr$="Missing entry" : ENDIF IF errstr$<>"" : BREAK : ENDIF waypoints%=waypoints%+1 W.pos%=waypoints% PUT cnt%=cnt%+1 ENDWH Busy:(KBusyOff$,0) IF errstr$="" COMMITTRANS  ELSE PUT : ROLLBACK : cnt%=0 : waypoints%=H.waypoints% ShortMessagePrompt:("Line "+FIX$(cnt%+1,0,5),errstr$) ENDIF IOCLOSE(h%)  Busy:("Closing route",1) USE W : CLOSE USE H : FIRST MODIFY : H.waypoints%=waypoints% : PUT CLOSE COMPACT file$ Busy:(KBusyOff$,0)  IF cnt%=1 : q$=" was" : ELSE q$="s were" : ENDIF  ShortMessagePrompt:("Import waypoints",FIX$(cnt%,0,3)+" waypoint"+q$+" read from file.")ENDPREM *** Draw route into map ***PROC DrawRoute: LOCAL file$(255),q$(255),Track_desc$(255),Track_num% LOCAL Track_lat(KMaxTrackPoints%),Track_lon(KMaxTrackPoints%) LOCAL Track_time(KMaxTrackPoints%),Track_height(KMaxTrackPoints%) LOCAL Track_velocity(KMaxTrackPoints%) LOCAL Track_lati,Track_lata,Track_loni,Track_lona LOCAL open%,c% file$=GetRouteFile$:("Select route file"+KDots$,KTrue%,KFalse%) IF file$="" : RETURN KTrue% : ENDIF DO dINIT "Draw route"  dTEXT "Route file:",ExtractFile$:(file$) dBUTTONS " Change file"+KDots$+" ",%F,"Cancel",-(27+$100)," Continue"+KDots$+" ",13+$100 Lock:(KLock%) : c%=DIALOG : Lock:(KUnlock%) IF c%=%f q$=GetRouteFile$:("Select route file"+KDots$,KFalse%,KFalse%) IF q$<>"" : file$=q$ : ENDIF ELSEIF c%=13 BREAK ELSE RETURN ENDIF UNTIL KFalse% IF file$="" : RETURN : ENDIF  open%=KFalse% DO ONERR noopen:: q$=file$+" SELECT * FROM header" OPENq$,X,d$,wn% open%=KTrue% q$=file$+" SELECT * FROM waypoints ORDER BY pos" OPENq$,Y,pos%,id$,lat,lon,alt ONERR off BREAKnoopen:: ONERR off IF open% : USEX : CLOSE : open%=KFalse% : ENDIF IF NOT ErrorMessage%:("Open route file",ERR,KTrue%) RETURN ENDIF UNTIL KFalse%  USE X : FIRST : Track_num%=X.wn% : CLOSE IF Track_num%<2 USE Y : CLOSE ShortMessagePrompt:("Draw route","This route contains too less waypoints.") RETURN ENDIF IF KMaxTrackPoints%Track_lata : Track_lata=Y.lat : ENDIF IF Y.lonTrack_lona : Track_lona=Y.lon : ENDIF Track_lat(c%)=Y.lat Track_lon(c%)=Y.lon Track_height(c%)=Y.alt Track_time(c%)=0 NEXT c%=c%+1 ENDWH CLOSE RealMap:(KFalse%,KFalse%,Track_num%,Track_lati,Track_lata,Track_loni,Track_lona,ADDR(Track_lat(1)),ADDR(Track_lon(1)),ADDR(Track_time(1)),ADDR(Track_height(1)),1000,1000,0)ENDPREM *** Convert track 2 Route ***PROC Track2Route: LOCAL file$(255),Track_desc$(255),Track_num% LOCAL Track_lat(KMaxTrackPoints%),Track_lon(KMaxTrackPoints%) LOCAL Track_time(KMaxTrackPoints%),Track_height(KMaxTrackPoints%) LOCAL Track_velocity(KMaxTrackPoints%) LOCAL Track_lati,Track_lata,Track_loni,Track_lona LOCAL aoff&,r%,h%,c%,open%,q$(255),waypoints%,added%  file$=LastTrackFile$ IF UseFastFileDialog% file$=FileDialog$:("Select track"+KDots$,file$,KFalse%,"",&0) IF file$="" : RETURN : ENDIF ELSE Busy:("Building file list"+KDots$,1) dINIT "Select track"+KDots$ dFILE file$,"Trackfile,Folder,Disk",16+UseSystemFolder& dBUTTONS " Cancel ",-(27+$100),"Open",13+$100 Busy:(KBusyOff$,0) Lock:(KLock%) : r%=DIALOG : Lock:(KUnlock%) IF r%<>13 : RETURN : ENDIF ENDIF  LastTrackFile$=file$ DO r%=IOOPEN(h%,file$,$400) IF r% IF NOT ErrorMessage%:("Select track file",r%,KTrue%) RETURN ENDIF ENDIF UNTIL r%=0  Busy:("Reading track"+KDots$,1) ONERR readerr:: IOREAD(h%,ADDR(Track_desc$),256) IOREAD(h%,ADDR(Track_num%),2)  IF Track_num%>KMaxTrackPoints% OR Track_num%<=1 GOTO readerr:: ENDIF aoff&=INT(FLT(Track_num%)*8.0) IOREAD(h%,ADDR(Track_lat(1)),aoff&) IOREAD(h%,ADDR(Track_lon(1)),aoff&) c%=1 WHILE c%<=Track_num% IF (ABS(Track_lat(c%))>90 AND Track_lat(c%)180 AND Track_lon(c%)13 : RETURN : ENDIF ENDIF  open%=KFalse% DO ONERR noopen:: q$=file$+" SELECT * FROM header" OPENq$,X,d$,wn% open%=KTrue% q$=file$+" SELECT * FROM waypoints ORDER BY pos" OPENq$,Y,pos%,id$,lat,lon,alt ONERR off BREAKnoopen:: ONERR off IF open% : USEX : CLOSE : open%=KFalse% : ENDIF IF NOT ErrorMessage%:("Open route file",ERR,KTrue%) RETURN ENDIF UNTIL KFalse% Busy:("Adding to route"+KDots$,1) waypoints%=X.wn% USEY : BEGINTRANS c%=1 : added%=0 ONERR noinsert:: WHILE c%<=Track_num% IF Track_lat(c%)13 : RETURN : ENDIF file$=FileDialog$:("Save to track file"+KDots$,file$,KTrue%,KTrackExtension$,&0) ELSEnewfile:: Busy:("Building list"+KDots$,1) dINIT "Save to track file"+KDots$ dFILE file$,"Filename,Folder,Disk",17+UseSystemFolder& dEDIT Track_desc$,"Track description",15 dCHOICE ch%,"Read","1st segment,last segment,all segments" dCHOICE st%,"Steps","every point,every 2nd point,every 3rd point,every 5th point,every 10th point" dBUTTONS " Cancel ",-(27+$100),"Read",13+$100 Busy:(KBusyOff$,0) Lock:(KLock%) : r%=DIALOG : Lock:(KUnlock%) IF r%<>13 : RETURN : ENDIF file$=AddExtension$:(file$,KTrackExtension$) IF EXIST(file$) dINIT "File exist" dTEXT "","Overwrite '"+ExtractFile$:(file$)+"' ?",2 dBUTTONS "No",%N+$300," Yes ",%Y+$300 Lock:(KLock%) : r%=DIALOG : Lock:(KUnlock%) IF r%=%n : GOTO newfile:: : ENDIF ENDIF ENDIF type%=GetGarminDatatype%:(300,0) IF type%<0 ShortMessagePrompt:("Serial port","No valid transfer could be established.") RETURN ENDIF IF type%<>300 ShortMessagePrompt:("Serial port","The protocol of this device is not supported yet.") RETURN ENDIF   IF st%=4: st%=5 ELSEIF st%=5 : st%=10 ENDIF  REM --- track log transfer protocol Busy:("Reading track log"+KDots$,1) IF NOT GRMN_SendAndGetStrExt%:($0a,CHR$($06)+CHR$($00),$1b) GRMN_Abort: Busy:(KBusyOff$,0) gIPRINT "No response:1",1 RETURN ENDIF Track_num%=0 : m%=0 : all%=0 moretracks%=KFalse% : longtrack%=KFalse% : con%=KFalse% Track_lati=1000 : Track_lata=-1000 Track_loni=1000 : Track_lona=-1000 secoffs=DATETOSECS(1990,01,01,00,00,00) IF secoffs<0 : secoffs=4294967296+secoffs : ENDIF  WHILE KTrue% IF NOT GRMN_GetStr%:(ADDR(cmd%)) GRMN_Abort: Busy:(KBusyOff$,0) gIPRINT "No response",1 RETURN ENDIF IF cmd%=$22 AND NOT moretracks% AND NOT longtrack% IF (Track_num%>0) AND (PEEKB(ADDR(sentence$)+13)<>0) REM new track log starts con%=KTrue% IF ch%=1 moretracks%=KTrue% ELSEIF ch%=2 Track_num%=0 Track_lati=1000 : Track_lata=-1000 Track_loni=1000 : Track_lona=-1000 ENDIF ENDIF all%=all%+1 : m%=m%+1 IF (NOT moretracks%) AND (m%=st%) m%=0 Track_num%=Track_num%+1 Track_lat(Track_num%) = PEEKL(ADDR(sentence$)+1)/11930464.7111111111 Track_lon(Track_num%) = -(PEEKL(ADDR(sentence$)+5)/11930464.7111111111) Track_height(Track_num%) = 0 Track_time(Track_num%) = PEEKL(ADDR(sentence$)+9) IF Track_time(Track_num%)<0 Track_time(Track_num%)=4294967296+Track_time(Track_num%) ENDIF Track_time(Track_num%)=Track_time(Track_num%)+secoffs IF Track_time(Track_num%)>2147483647 Track_time(Track_num%)=Track_time(Track_num%)-4294967296 ENDIF SECSTODATE INT(Track_time(Track_num%)),yr%,mo%,da%,hr%,mi%,sc%,yd% Track_time(Track_num%)=hr% Track_time(Track_num%)=Track_time(Track_num%)*100+mi% Track_time(Track_num%)=Track_time(Track_num%)*100+sc% IF Track_lati>Track_lat(Track_num%) : Track_lati=Track_lat(Track_num%) : ENDIF IF Track_lataTrack_lon(Track_num%) : Track_loni=Track_lon(Track_num%) : ENDIF IF Track_lona$22 AND cmd%<>$0c GRMN_Abort: Busy:(KBusyOff$,0) gIPRINT "Wrong datas" RETURN ENDIF GRMN_Ack:(cmd%) IF cmd%=$0c : BREAK : ENDIF ENDWH REM -------  IF Track_num%=0 ShortMessagePrompt:("Empty track","No track file was created.") RETURN ENDIF file$=AddExtension$:(file$,KTrackExtension$) LastTrackFile$=file$ DO r%=IOOPEN(h%,file$,$102) IF r% IF NOT ErrorMessage%:("Create track file",r%,KTrue%) RETURN ENDIF ENDIF UNTIL r%=0  ONERR saveerr:: Busy:("Saving"+KDots$,1) aoff&=INT(FLT(Track_num%)*8.0) IOWRITE(h%,ADDR(Track_desc$),256) IOWRITE(h%,ADDR(Track_num%),2) IOWRITE(h%,ADDR(Track_lat(1)),aoff&) IOWRITE(h%,ADDR(Track_lon(1)),aoff&) IOWRITE(h%,ADDR(Track_height(1)),aoff&) IOWRITE(h%,ADDR(Track_time(1)),aoff&) IOWRITE(h%,ADDR(Track_lati),8) IOWRITE(h%,ADDR(Track_lata),8) IOWRITE(h%,ADDR(Track_loni),8) IOWRITE(h%,ADDR(Track_lona),8) ONERR off IOCLOSE(h%) Busy:(KBusyOff$,0) IF Track_num%=1 : file$=" was" : ELSE file$="s were" : ENDIF  dINIT "Transfer done" IF con% dTEXT "","The read track log consists of several",2 IF ch%=1 dTEXT "","segments. Only the first one was noticed.",2 ELSEIF ch%=2 dTEXT "","segments. Only the last one was noticed.",2 ELSE dTEXT "","segments. All segments were connected.",2 ENDIF ENDIF IF longtrack% dTEXT "","The track was longer than the internal buffer.",2 dTEXT "","Not the whole track could be stored.",2 ENDIF IF Track_num%=all% dTEXT "","All "+FIX$(Track_num%,0,3)+" track point"+file$+" written to file.",2 ELSE dTEXT "",FIX$(Track_num%,0,3)+" of "+FIX$(all%,0,3)+" read track point"+file$+" written to file.",2 ENDIF dBUTTONS " Okay ",13+$100 Lock:(KLock%) : DIALOG : Lock:(KUnlock%) RETURNsaveerr:: ONERR off Busy:(KBusyOff$,0) ErrorMessage%:("Save track"+KDots$,ERR,KFalse%)ENDPREM *** Fast File Dialog (includes some bugs) ***PROC FileDialog$:(title$,file$,save%,ext$,ar&) LOCAL setupFlags%,contentFlags%,r% LOCAL details$(255),size&,attribs&,uid&,dr$(255) setupFlags%=0 contentFlags%=0 setupFlags%=KDNavButRight% contentFlags% = contentFlags% OR KDNavSortByType%  contentFlags% = contentFlags% OR KDNavContentHiddenFiles%  contentFlags% = contentFlags% OR KDNavHasInfobar%  IF UseSystemFolder& contentFlags% = contentFlags% OR KDNavContentSystemFiles% ENDIF IF save% contentFlags% = contentFlags% OR KDNavHasEditor% ENDIF DO DNavInit:(title$,setupFlags%,contentFlags%)  IF ar&<>0 IF PEEKW(ar&)=1 DNavAddButton:(" Create new"+KDots$+" ",%N,"","",0, -1, 0) ENDIF ENDIF DNavAddButton:(" Cancel ",27 OR $100,"","",0,-1,0) DNavAddButton:("Okay",13 OR $100,"","",0,-1,0)   DNavSetPosition:(MAX(screen_xsize%/2-250,0),MAX(screen_ysize%/2-105,0))  dr$=file$ IF dr$<>"" r%=LPosInStr%:("\",dr$) IF r%>0 : dr$=LEFT$(dr$,r%) : ENDIF IF NOT EXIST(dr$) : dr$=MyDir$ : ENDIF ELSE dr$=MyDir$ ENDIF IF save% : DNavSetSize:(400,5) ELSE : DNavSetSize:(400,6) ENDIF r%=DNavDisplay%:(dr$,"","")  IF r%<>13 IF ar&<>0 : POKEW ar&,r% : ENDIF RETURN "" ENDIF  details$=DNavSelAt$:(1) DNavUItemDetails:(details$,size&,attribs&,uid&) IF NOT save% IF (attribs& AND 8)=8 OR (attribs& AND 16)=16 REM volume or folder gIPRINT "No filename entered.",2 ELSE BREAK ENDIF ELSE IF DNavSelGetEditor$:<>"" IF LPosInStr%:("\",details$)>0 details$=LEFT$(details$,LPosInStr%:("\",details$))+DNavSelGetEditor$: ENDIF ENDIF IF RIGHT$(details$,1)="\" details$=details$+DNavSelGetEditor$: ENDIF IF ext$<>"" : details$=AddExtension$:(details$,ext$) : ENDIF IF RIGHT$(details$,1)="\" gIPRINT "No filename entered.",2 ELSEIF EXIST(details$) dINIT "Overwriting file" dTEXT "","Overwrite """+ExtractFile$:(details$)+""" ?",2 dBUTTONS "No",%N+$300," Yes ",%Y+$300 Lock:(KLock%) : r%=DIALOG : Lock:(KUnlock%) IF r%=%y : BREAK : ENDIF ELSE BREAK ENDIF ENDIF  UNTIL KFalse% RETURN details$ENDPPROC DNavCallBackManager%:(item%, procedure$) ONERR CallbackError:: RETURN @%(procedure$):(item%) CallbackError:: ONERR OFF ALERT("Callback "+ERRX$,procedure$+" "+ERR$(ERR)+" ("+GEN$(ERR,4)+")") ENDPREM ***** Tool: Unit Converter ******PROC UnitConverter: LOCAL u1%,u2%,val1,val2,r%,s$(40,30),u%(40),g%(40),c% g%(1)=1 : s$(1)="Nautical Miles" : u%(1)=KNauticalMiles% g%(2)=1 : s$(2)="Statute Miles" : u%(2)=KStatuteMiles% g%(3)=1 : s$(3)="Meters" : u%(3)=KMeters%  g%(4)=1 : s$(4)="Feets" : u%(4)=KFeets% g%(5)=1 : s$(5)="Fathoms" : u%(5)=KFathoms% g%(6)=1 : s$(6)="Inches" : u%(6)=KInches% g%(7)=0 : s$(7)="------" : u%(7)=-1 g%(8)=2 : s$(8)="Knots" : u%(8)=KKnots% g%(9)=2 : s$(9)="Meters per Second" : u%(9)=KMetersPerSecond% g%(10)=2 : s$(10)="Kilometers per Hour" : u%(10)=KKilometersPerHour% g%(11)=2 : s$(11)="Statute Miles per Hour" : u%(11)=KStatuteMilesPerHour% g%(12)=0 : s$(12)="------" : u%(12)=-1 g%(13)=3 : s$(13)="Liters" : u%(13)=KLiters% g%(14)=3 : s$(14)="Cubicmeters" : u%(14)=KCubicMeters% g%(15)=0 : s$(15)="------" : u%(15)=-1 g%(16)=4 : s$(16)="Seconds" : u%(16)=KSeconds% g%(17)=4 : s$(17)="Minutes" : u%(17)=KMinutes% g%(18)=4 : s$(18)="Hours" : u%(18)=KHours% g%(19)=4 : s$(19)="Days" : u%(19)=KDays% g%(20)=4 : s$(20)="Siderical Days" : u%(20)=KSidericalDays% g%(21)=0 : s$(21)="------" : u%(21)=-1 g%(22)=5 : s$(22)="Inches of Mercury" : u%(22)=KInchesOfMercury% g%(23)=5 : s$(23)="Bars" : u%(23)=KBars% g%(24)=0 : s$(24)="------" : u%(24)=-1 g%(25)=6 : s$(25)="Revolutions per Minute" : u%(25)=KRevolutionsPerMinute% g%(26)=6 : s$(26)="Degrees per Minute" : u%(26)=KDegreesPerMinute% g%(27)=0 : s$(27)="------" : u%(27)=-1 g%(28)=7 : s$(28)="Degrees" : u%(28)=KDegrees% g%(29)=7 : s$(29)="Radiant" : u%(29)=KRadiant% g%(30)=7 : s$(30)="Grad" : u%(30)=KGrad% g%(31)=0 : s$(31)="------" : u%(31)=-1 g%(32)=8 : s$(32)="Celcius" : u%(32)=KCelcius% g%(33)=8 : s$(33)="Kelvin" : u%(33)=KKelvin% g%(34)=8 : s$(34)="Fahrenheit" : u%(34)=KFahrenheit% g%(35)=8 : s$(35)="Reaumur" : u%(35)=KReaumur%  DO val1=1 dINIT "Unit converter" dFLOAT val1,"Value",-KMaxFloat,KMaxFloat c%=1 DO dCHOICE u1%,"Source unit",s$(c%)+",..." c%=c%+1 UNTIL c%=35 dCHOICE u1%,"Source unit",s$(c%) c%=1 DO dCHOICE u2%,"Destination unit",s$(c%)+",..." c%=c%+1 UNTIL c%=35 dCHOICE u2%,"Destination unit",s$(c%) dBUTTONS "Cancel",-(27+$100)," Calculate ",13+$100 Lock:(KLock%) : r%=DIALOG : Lock:(KUnlock%)  IF r%=13 IF u%(u1%)=-1 OR u%(u2%)=-1 gIPRINT "No correct unit selected.",2 ELSEIF g%(u1%)<>g%(u2%) gIPRINT "No convertion possible.",2 ELSE val2=Convert:(val1,ABS(u%(u1%)),ABS(u%(u2%))) dINIT "Unit converter" dTEXT s$(u1%),FIX$(val1,5,10) dTEXT s$(u2%),FIX$(val2,5,10) dBUTTONS " Cancel ",-(27+$100),"Next",13+$100 Lock:(KLock%) : r%=DIALOG : Lock:(KUnlock%) ENDIF ENDIF UNTIL r%<>13ENDPREM ***** Tool: Distance Calculator ******PROC DistanceCalculator: LOCAL lat1$(15),lon1$(15),lat2$(15),lon2$(15),dist LOCAL lat1,lon1,lat2,lon2,alt,alt2,r%,n1$(50),n2$(50) DO dINIT "Compute spherical distance",1 dEDIT lat1$,"1st Latitude",10 dEDIT lon1$,"1st Longitude",10 dTEXT "","",$800 dEDIT lat2$,"2nd Latitude",10 dEDIT lon2$,"2nd Longitude",10 dTEXT "","",$800 IF format%(6)=1 dFLOAT alt,"Altitude (m)",-30000,30000 ELSE dFLOAT alt,"Altitude (ft)",-50000,50000 ENDIF dBUTTONS " 1st Waypoint"+KDots$+" ",%W," 2nd Waypoint"+KDots$+" ",%X,"Cancel",-(27+$100)," Compute ",13+$100 Lock:(KLock%) : r%=DIALOG : Lock:(KUnlock%) IF r%=13 lat1=Val_LatLonStr:(lat1$,KTrue%,KTrue%) IF lat1<>-1000 lon1=Val_LatLonStr:(lon1$,KFalse%,KTrue%) IF lon1<>-1000 lat2=Val_LatLonStr:(lat2$,KTrue%,KTrue%) IF lat2<>-1000 lon2=Val_LatLonStr:(lon2$,KFalse%,KTrue%) IF lon2<>-1000 IF format%(6)=1 alt2=alt ELSE alt2=Convert:(alt,KFeets%,KMeters%) ENDIF  dist=SphericalDistance:(lat1,lon1,lat2,lon2,alt2+KMeanEarthRadius) dINIT "Spherical distance" dTEXT "1st Location",FormatStr_Latitude$:(lat1,KTrue%)+", "+FormatStr_Longitude$:(lon1,KTrue%) dTEXT "2nd Location",FormatStr_Latitude$:(lat2,KTrue%)+", "+FormatStr_Longitude$:(lon2,KTrue%) dTEXT "Altitude",FormatStr_Distance$:(alt2,KTrue%) dTEXT "Distance",FormatStr_Distance$:(dist,KFalse%) dBUTTONS " Cancel ",-(27+$100)," Next ",13+$100 Lock:(KLock%) : r%=DIALOG : Lock:(KUnlock%) ENDIF ENDIF ENDIF ENDIF ELSEIF r%=%w OR r%=%x IF LocationFromDatabase%:(KTrue%,ADDR(n1$),ADDR(n2$),ADDR(lat1),ADDR(lon1)) IF r%=%w lat1$=FormatStr_Latitude$:(lat1,KTrue%) lon1$=FormatStr_Longitude$:(lon1,KTrue%) ELSE lat2$=FormatStr_Latitude$:(lat1,KTrue%) lon2$=FormatStr_Longitude$:(lon1,KTrue%) ENDIF ENDIF r%=13 ENDIF UNTIL r%<>13ENDPREM ******** End of PsiNMEA ******************************REM HistoryREM 30.03.2000 v2.00bREM *deviation in SA track analysis changed to euclidian distanceREM *extended input formats for latitude/longitudeREM *bug: change of filename in draw-path-proc didn't workREM *bug: after a canceled filedialog the new-waypoint-proc REM showed an empty filename instead the last nameREM *bug: read waypoints contained wrong spacesREM *changed button shortcuts in dialogsREM *menu shortcuts in RealMapREM *unit converter, distance calculatorREM *unit of altitude inputs depends on output format settingREM *waypoint export/import to/from text fileREM *better handling of other screen resolutionsREM (in order to support of other epoc devices)REM *bug: sometimes the same file dialog was open twiceREM *route handling + Garmin-transfer + import/export + analysingREM *track log could be read from GarminREM *some changes in waypoint handlingREM *most important Garmin protocol capabilities implementedREM *bug. wrong cursor after zoom in map modus changedREM *bug: in world database dialog the city name was not changed,REM if the country was selected by the first letterREM *standart extensions rte/wpt/trk will be forcedREM *some more diagrams for track/route analysingREM *bug: description of waypoints was not transferedREM correctly via Garmin protocolREM *bug: wrong convertion from meters 2 inchesREM *unit inch is not used for altitudesREM 02.02.2000 v1.20bREM *handling of system commandsREM *the first keypress during the aboutbox appearsREM on the screen will be analysedREM *you can use calibration datas of registered mapsREM for new maps of the same areaREM *user can set time steps of route trackingREM *manufacturer IDs from txt into database fileREM *user can add manufacturers to this databaseREM *user can choose different map cursorsREM *bug: internal protocol flag was not set, ifREM the connection was etablished during app.startREM *bug: program was aborted, if a connection should beREM etablished but the port was used by another prog.REM *bug: endless loop after successful queryREM *Alarm settings for sun eclipse times removedREM *faster file dialog (nDirNav)REM *changed format of sun eclipse data filesREM *waypoint transfer to and from Garmin deviceREM *general waypoint handling functions addedREM *general error handling improvedREM *order of items in main menu changedREM *bug: if the program is ended now the backlight timerREM is switched on only if it was on during startREM *bug: real year 2000 bug (if year<1970 : year=year+1000(!) : endif)REM *bug: endless loop during parsing userdefined sentencesREM *bug: empty unit fields in nmea sentences raised an errorREM *bug: wrong track file raised an errorREM *PsiNMEA now looks for location datas in all NMEA sentences.REM 03.12.1999 v1.10b (SE)REM *new grid overlay for mapsREM *bug: program was aborted during map registrationREM (missing variable)REM 02.12.1999 v1.10bÐР   \c¡.efd\c©.efdý‚.ÆA…*TextEd.app…±.‰8/