$lib graph off
$stack 8000
defdbl a-z
dim l$(4) , sitenames$(1000 , 2)
on error goto ErrorHandler
on key(1) gosub help
key (1) on
ReadInDbase
def seg = &h40
nlines% = peek(&h84) + 1
cls
textcol% = 15 : entrycol% = 0 : backentry% = 3
backcol% = 1 : discol% = 15 : disbackcol% = 6
color 15 , 4 : locate 1 , 2
print " LOCATOR CONVERSIONS AND DISTANCE BEARING CALCULATIONS  AC Talbot G4JNT May 94 "
color textcol% , backcol%
pi=3.141592653589793238462643383279
dr=180 / pi
DEF FNACS(X) = ATN((SQR(1 - X * X)) / X) + PI / 2 * (1 - SGN(X))
sel% = 1
locate 2 , 5
print "É" + string$(72 , 205) + "»"
for l% = 3 to 19
	locate l% , 5
	print "º" + space$(72) + "º"
next l%

locate 20 , 5
print "È" + string$(72 , 205) + "¼"
locate nlines% , 3
color 11 , 0
print "F1 for help";
color 9
locate nlines% - 1, 30 : print "Move to required field";
locate nlines%, 30 : print "and enter value";

mainmenu:   'return here from error, needs to be a jump for error handler

locate sel% * 2 + 2 , 23
color entrycol% , backentry%
print space$(12)
color textcol% , backcol%
do
	if SomethingEntered% and not baseset% then
		color 9 , 0
		locate nlines% - 1 , 3
		print "HOME  to set current location as base for distance and bearing calculations"
		locate nlines% , 3
		print "CTL - L  to change  Lat / Long   display format";
		color textcol% , backcol%
	end if
	locate 4 , 10 : print "NGR "
	locate 6 , 10 : print "UTM (WGS84)"
	locate 8 , 10 : print "Lat / Long"
	locate 10, 10 : print "Locator "
	locate 12, 10 : print "QRA"
	locate 14, 10 : print "Sitename"
	locate 16, 10 : print "Quit"


	do
		locate sel% * 2 + 2 , 7
		color 15
		print ">";
		color textcol% , backcol%
		while not instat : wend
		ik$ = inkey$
		sitename$ = ""
		for rw% = 4 to 16
			locate rw% , 21 : print space$(24)
			locate rw% , 7  : print " "
		next rw%
		if ik$ = chr$(13) then
			if len(code$) < 3 then
				if sel% = 7 then exit , exit
				if sel% = 6 then call SiteBrowse
				code$ = ""
				ik$ = ""
			end if
			locate sel% * 2 + 2 , 23
			color entrycol% , backentry%
			if code$ > "" then print code$ else	print space$(12)
			color textcol% , backcol%
			SomethingEntered% = -1
		end if

		if (ik$ = "~" or ik$ = "?") and sel% = 6 then
			call SiteBrowse
		end if

		if ik$ = chr$(12) then
			dms% = (dms% + 1) mod 4
			call LLfmt(lat , long , ll$ , dms%)
			locate 8 , 45
			print ll$
		end if

		if ik$ = chr$(0 , 71) and SomethingEntered% then    'HOME
			baseset% = -1
			baselat = lat
			baselong = long
			baseresolution = resolution
			locate 18 , 5
			print "Ì" + string$(72 , 205) + "¹"
			locate 19 , 9
			print space$(67)
			color discol% , disbackcol%
			locate nlines% , 2
			print using "  Base location  \          \   \        \   \                             \  ";ngr$,locator$,ll$;
			color 7 , 0
			locate nlines% - 1 , 1
			print space$(79);
         color textcol% , backcol%
		end if

		if ik$ = chr$(0 , 72) then     'UP
			sel% = max(sel% - 1 , 1)
			code$ = ""
			subsqhelp% = -1
		end if

		if ik$ = chr$(0 , 80) then    'DOWN
			sel% = min(sel% + 1 , 7)
			code$ = ""
         subsqhelp% = -1
		end if

		if ik$ = chr$(27) or ik$ = chr$(0 , 79) then sel% = 7 : code$ = "" 'ESC , END
		if ik$ = chr$(0 , 73) then sel% = 1   'PG UP
		if ik$ = chr$(0 , 81) then sel% = 6   'PG DN

		if len(ik$) = 2 or instr(chr$(12) + chr$(27)+"?~" , ik$) > 0 then
			locate sel% * 2 + 2 , 21 : print space$(24)
			locate sel% * 2 + 2 , 23
         color entrycol% , backentry%
			print space$(12)               'bar moves up & down
			color textcol% , backcol%
			code$ = ""
		else
			if ik$ < chr$(31) and ik$ <> chr$(8) then exit if
			code$ = code$ + ucase$(ik$)
			if len(code$) > 22 then
				sound 4000 , .1
				code$ = ""
			end if
			if ik$ = chr$(8) then                'BACKSP
				if len(code$) <= 2 then code$ = "" else_
					 code$ = left$(code$ , len(code$) - 2)
			end if
			locate sel% * 2 + 2 , 23
			color entrycol% , backentry%
			print code$;          'show entry as each key is pressed
		end if
	loop until ik$ = chr$(13)

	if len(code$) < 3 and code$ > ""  then
		sound 400 , .1
		code$ = ""
		iterate loop
	end if
	ClearBottom
	select case sel%
	case 1
		ngr$=code$
		call NGRtoEN(ngr$ ,e , n , digits%)
		call ENtoLL(e , n ,lat , long)
		call LLtoUTM(lat , long , utm$ , digits%)
		call LLtoLoc(lat , long , locator$ , digits%)
		call LLfmt(lat , long , ll$ , dms%)
		call LLtoQRA(lat , long , qra$)
		call ENtoNGR(e , n , ngr$ , en$ , digits%)
		resolution = 10 ^ (5 - digits%)
	case 2
		utm$ = code$
		call UTMtoLL(utm$ , lat , long , digits%)
		call LLtoLoc(lat , long , locator$ , digits%)
		call LLtoUTM(lat , long , utm$ , digits%)
		call LLfmt(lat , long , ll$ , dms%)
		call LLtoQRA(lat , long , qra$)
		call LLtoEN(lat , long , e , n)
		call ENtoNGR(e , n , ngr$ , en$ , digits%)
		resolution = 10 ^ (5 - digits%)
	case 3
		ll$ = code$
		call STRtoLL(ll$ , lat , long)
		digits% = 4
		call LLtoUTM(lat , long , utm$ , digits%)
		call LLtoEN(lat , long , e , n)
		call LLtoLoc(lat , long , locator$ , digits%)
		call ENtoNGR(e , n , ngr$ , en$ , digits%)
		call LLfmt(lat , long , ll$ , dms%)
		call LLtoQRA(lat , long , qra$)
		resolution = 10 ^ ( 5 - digits%)
	case 4
		locator$ = code$
		call LocToLL(locator$ , lat , long , digits%)
		call LLtoUTM(lat , long , utm$ , digits%)
		call LLtoEN(lat , long , e , n)
		call ENtoNGR(e , n , ngr$ , en$ , digits%)
		call LLtoQRA(lat , long , qra$)
		call LLfmt(lat , long , ll$ , dms%)
		if digits% = 2 and instr(qra$ , "  ") = 0 then
			qra$ = "(" + qra$ + ")"
			deltalong = 5 / 60 / 2     'distance of corners of
			deltalat = 2.5 / 60 / 2    'square from middle in ø
		else
			deltalong = .5 / 60 / 2
			deltalat = .25 / 60 / 2
		end if
		if instr(ngr$ , "    ") = 0 and digits% < 4 then call DrawSquare(lat , long , deltalat , deltalong)
		resolution = max(230 , 460 * cos(lat / dr))
		if digits% = 2 then resolution = 10 * resolution
		if digits% = 4 then resolution = resolution / 24

	case 5
		qra$ = code$
		call QRAtoLL(qra$ , lat , long)
		call LLtoUTM(lat , long , utm$ , 2)
		call LLtoLoc(lat , long , locator$ , digits%)
		call LLtoEN(lat , long , e , n)
		call ENtoNGR(e , n , ngr$ , en$ , 2)
		call LLfmt(lat , long , ll$ , dms%)
		deltalat = 2.5 / 60 / 2
		deltalong = 4 / 60 / 2
		if instr(ngr$ , "   ") = 0 then call DrawSquare(lat , long , deltalat , deltalong)
		resolution = max(2300 , 3700 * cos(lat / dr))
	case 6
		call LocationIn(code$ , lat , long , digits%)
		color entrycol% , backentry%
		sitename$ = code$
		if instr(sitename$ , "Not Stored") > 0 then exit select
		color textcol% , backcol%
		call LLtoEN(lat , long , e , n)
		call ENtoNGR(e , n , ngr$ , en$ , digits%)
		call LLtoUTM(lat , long , utm$ , digits%)
		call LLfmt(lat , long , ll$ , dms%)
		call LLtoLoc(lat , long , locator$ , digits%)
		call LLtoQRA(lat , long , qra$)
		resolution = 100
		if digits% = 2 then
			qra$ = "(" + qra$ + ")"
			locator$ = left$(locator$ , 6)
			resolution = max(2300 , 4600 * cos(lat / dr))
		end if
	case 7
		exit loop
	end select

	color textcol% , backcol%
	code$ = ""
	for rw% = 4 to 17
		locate rw% , 45
		print space$(33)
	next rw%

	if n = 0 or e = 0 then en$ = ""
	if resolution > 1000 then
		resol$ = using$(" ##.# km     " , round(resolution / 1000 , 1))
	else
		resol$ = using$(" #### m      " , resolution)
	end if
	locate 4 , 45 : print using "\              \\              \";ngr$ , en$
	locate 6 , 45 : print utm$
	locate 8 , 45 : print ll$
	locate 10 , 45 : print locator$
	locate 12 , 45: print qra$
	locate 14 , 45: print sitename$
	color 1 , 3
	locate 16 , 55: print " Resolution  "
	locate 17 , 55: print resol$
	color textcol% , backcol%
	code$ = ""
	if baseset% then
		call DistBear(lat , long , baselat , baselong , distance , bearing , backbearing , distuncert , bearuncert)
		color 11
		locate 19 , 9
		print using "Distance #####.#km (ñ##.##)   Bearing ###.#ø (ñ##.#ø)  Back ###.#ø";_
					 distance , distuncert, bearing, bearuncert , backbearing;
		color textcol% , backcol%
	end if
loop
color 7 , 0
locate nlines% - 1 , 1
print space$(79)
locate nlines% , 1
print space$(79);
locate nlines% - 1 , 1
end

'=============================================================
ErrorHandler:
	ngr$ = "" : ll$ = "" : locator$ = "" : qra$ = ""
	code$ = "" : en$ = "" : utm$ = ""
	SomethingEntered% = 0
	sound 400 , .1
	color textcol% , backcol%
	locate sel% * 2 + 2 , 21 : print "  Error" + space$(17)
	delay .5
	locate sel% * 2 + 2 , 21 : print space$(24)
resume mainmenu
'=============================================================

Help:
	screen 0 ,, 1
	color 0 , 3
	cls
	locate 2 , 3
	color 15 , 4
	print "LOCATOR CONVERSIONS AND DISTANCE BEARING CALCULATIONS    A C Talbot G4JNT"
	print : print
	color 0 , 3
	if subsqhelp% then helpsel% = sel% else helpsel% = 0
	select case helpsel%
	case 0 , 7
		print "  Use cursor keys to move the entry bar to whichever input format is"
		print "  required, type in entry then press [rtn] to calculate other formats."
		print
		print "  Once a location has been entered it can be made the base for distance"
		print "  and bearing calculations by pressing [HOME]."
		print
		print "  An estimate of the accuracy of the conversion is shown by the box
		print "  labelled resolution.  This is nearly always dictated by the input data"
		print "  type and number of characters.  The figure is the worst case of linear"
		print "  easting or northing potential error.  The resolution (displayed digits) for"
		print "  generated NGR and Locators is set approximately to that of the input data."
		print
		print "  Context sensitive help is available for each input format by"
		print "  pressing F1 at the appropriate field.
	case 1
		print "  NGR can be of any accuracy but must include the initial letter field"
		print "  eg. SU 4991 1257    ST800080."
		print
		print "  Numerical entry of Easting , Northing will also be accepted.  This must be"
		print "  specified in kilometres and separated by a comma   eg 449.9 , 112.6 "
	case 2
		print "  Universal Transverse Mercator projection (a sort of Worldwide NGR), "
		print "  provided as an output option on some GPS systems.  Assumes the WGS84"
		print "  spheroid as used by GPS and could therefore be in error by several"
		print "  hundred metres when compared with other mapping references."
		print
		print "  Format is   Zone , Eastings , Northings , N/S   eg.  30 620.21  5641.16 N "
		print "  Values must be in km  and valid separators are a single space or comma. "
		print
		print "  N or S is the standard way of specifying hemisphere but negative numbers "
		print "  will be accepted for southern lattitudes in which case N/S need not be"
		print "  specified."
	case 3
		print "  Free format entry of Lat / Long.  This may be entered in any of several ways"
		print "  and decimal or Degree / Minute / Seconds format can be used interchangably."
		print "  Separators for DMS entry can be any of  / , or [sp] but only one is to occur"
		print "  between DMS fields.   Decimal numbers may be used in fields"
		print "  N/S and E/W  is required to separate Lat and Long which may be expressed"
		print "  either way round.
		print
		print "  The special entry case of   Lat , Long   may be used (in this order) and here"
		print "  one comma only is required between the numbers.  Negative numbers will be"
		print "  interpreted for this case only and will be ignored for all other formats"
		print "  ie. if N/S E/W is specified or more than one comma is present in the entry."
		print
		print "  The following are all valid :-"
		print "  50.91 N 1.29 W    50 54.6N 1 17.4W    50 54 36 N  1 17 24 W    50.91 , -1.29
		print "  1.29W  50 54 36 N     50/54.6/n  1.29/w     1,17.4W,50,54.6N"
		print
		print "  50.91 , 1.29W    50 54.6N , -1.29  ARE NOT VALID
		print
		print "  CTRL - L may be pressed at any time to change the format of"
		print "  the displayed Lat / Long."
	case 4
		print "  6, 8 or 10 digit locators, sometimes referred to as Maidenhead."
		print "  The centre of the locator square is used as the reference point."
		print
		print "  The display at the bottom of the screen shows the NGRs of the"
		print "  corners of the square for 6 and 8 digit locators where the NGR is valid.
	case 5
		print "  This is the old geriatric QRA locator system used pre 1985 (ish)
		print "  and is included for use with older logs etc.  If shown bracketed"
		print "  this means that the conversion from the six digit Locator may not"
		print "  be correct over the whole square since the two systems do not line"
		print "  up in longitude at the sub square level.  Conversley, a Locator "
		print "  generated from a QRA is only valid for the centre of the QRA square."
	case 6
		print "  The sitename can be any of the sites stored in the file SITES.DAT. "
		print "  Just enough of the name is needed to identify the site.  See README for"
		print "  details about this file including structure and editing."
		print
		print "  The contents of SITES.DAT may be examined by pressing  ?  at this field"
	end select
	locate nlines%  , 50
	print "Press any key to continue";
	while inkey$ = "" : wend
	screen 0 ,, 0
	color textcol% , backcol%
	subsqhelp% = -1
return
'=============================================================

sub LLtoEN (k , l , e , n)              'Lat , Long [k,l]   in Degrees
	shared dr
	if k < 49 or k > 61 or l < -8 or l > 1.8 then
		e = 0
		n = 0
		exit sub
	end if
	a1=6377563.396*.9996012717
	b1=6356256.91*.9996012717
	n1 = (a1 - b1) / (a1 + b1)
	e2 = (a1 ^ 2 - b1 ^ 2) / a1 ^ 2
	k3=(k-49)/dr
	k4=(k+49)/dr
	k1 = k / dr
	j3=(1+n1+5/4*n1^2+5/4*n1^3)*k3
	j4=(3*n1+3*n1^2+21/8*n1^3)*sin(k3)*cos(k4)
	j5=(15/8*n1^2+15/8*n1^3)*sin(2*k3)*cos(2*k4)
	j6=35/24*n1^3*sin(3*k3)*cos(3*k4)
	m=b1*(j3-j4+j5-j6)
	v=a1/sqr(1-e2*sin(k1)^2)
	r=v*(1-e2)/(1-e2*sin(k1)^2)
	h2=v/r-1

	p=(l+2)/dr
	j3=m-100000
	j4=v/2*sin(k1)*cos(k1)
	j5=v/24*sin(k1)*cos(k1)^3*(5-tan(k1)^2+9*h2)
	j6=v/720*sin(k1)*cos(k1)^5*(61-58*tan(k)^2+tan(k1)^4)
	n=j3+p^2*j4+p^4*j5+p^6*j6

	j7=v*cos(k1)
	j8=v/6*cos(k1)^3*(v/r-tan(k1)^2)
	j9=v/120*cos(k1)^5
	j9=j9*(5-18*tan(k1)^2+tan(k1)^4+14*h2-58*tan(k1)^2*h2)
	e=400000+p*j7+p^3*j8+p^5*j9
end sub

		'lines marked œœœœœœœ  are differences between NGR and UTM projections
sub LLtoUTM(k , l , utm$ , digits%)
	shared dr
	if digits% > 2 then decimal$ = "." + string$(digits% - 2 , "#")
	if k > 84 or k < -80 then utm$ = "" : exit sub
	zone% = (int(l + 180)) \ 6 + 1
	l0 = zone% * 6 - 183
	a1 = 6378137 *.9996
	b1 = 6356752.31 *.9996          'WGS84 figures
	n1 = (a1 - b1) / (a1 + b1)
	e2 = (a1 ^ 2 - b1 ^ 2) / a1 ^ 2
	k3=(k-0)/dr            'œœœœœœœ
	k4=(k+0)/dr            'œœœœœœœ
	k1 = k / dr
	j3=(1+n1+5/4*n1^2+5/4*n1^3)*k3
	j4=(3*n1+3*n1^2+21/8*n1^3)*sin(k3)*cos(k4)
	j5=(15/8*n1^2+15/8*n1^3)*sin(2*k3)*cos(2*k4)
	j6=35/24*n1^3*sin(3*k3)*cos(3*k4)
	m=b1*(j3-j4+j5-j6)
	v=a1/sqr(1-e2*sin(k1)^2)
	r=v*(1-e2)/(1-e2*sin(k1)^2)
	h2=v/r-1

	p=(l-l0)/dr
	j3=m-0                    'œœœœœ
	j4=v/2*sin(k1)*cos(k1)
	j5=v/24*sin(k1)*cos(k1)^3*(5-tan(k1)^2+9*h2)
	j6=v/720*sin(k1)*cos(k1)^5*(61-58*tan(k)^2+tan(k1)^4)
	n=j3+p^2*j4+p^4*j5+p^6*j6

	j7=v*cos(k1)
	j8=v/6*cos(k1)^3*(v/r-tan(k1)^2)
	j9=v/120*cos(k1)^5
	j9=j9*(5-18*tan(k1)^2+tan(k1)^4+14*h2-58*tan(k1)^2*h2)
	e=500000+p*j7+p^3*j8+p^5*j9                              'œœœœœœ
	if n < 0 then ns$ = " S" else ns$ = " N"
	utm$ = using$("##" , zone%) + using$(" ###" + decimal$ + "   " , e / 1000) +_
						 using$("#####" + decimal$ + ns$ , abs(n / 1000))
end sub

sub UTMtoLL(utm$ , k , l , digits%)
	shared dr
	utm$ = ucase$(utm$)
	if instr(utm$ , any "ABCDEFGHIJKLMOPQRTUVWXYZ") > 0 then error 5
	sp1% = instr(utm$ , any " ,/")
	sp2% = instr(sp1% + 1 , utm$ , any " ,/")
	if sp1% = 0 or sp2% = 0 then error 5
	wheredec% = instr(sp1% , mid$(utm$ , sp1% + 1 , sp2% - sp1%), ".")
	if wheredec% = 0 then digits% = 2 else digits% = sp2% - wheredec% - 2

	wheredec% = instr(sp2% , utm$ , ".")    'another . in northings
	sp3% = instr(sp2% + 1 , utm$ , any "NS ")
	if sp3% = 0 then sp3% = len(utm$) + 1
	if wheredec% > 0 then digits% = max(digits% , sp3% - wheredec% + 1)

	zone% = val(mid$(utm$ , 1 , sp1% - 1))
	e = 1000 * val(mid$(utm$ , sp1% + 1 , sp2% - sp1%))
	n = 1000 * val(mid$(utm$ , sp2% + 1))
	if instr(mid$(utm$ , sp2% + 1) , "S") > 1 or n < 0 then ns% = -1 else ns% = 1
	n = abs(n)
	a1 = 6378137 *.9996
	b1 = 6356752.31 *.9996          'WGS84 figures
	n1 = (a1 - b1) / (a1 + b1)
	e2 = (a1 ^ 2 - b1 ^ 2) / a1 ^ 2
	k=(n+100000)/a1      'œœœœœœ
	do
		k3=k-00/dr        'œœœœœœ
		k4=k+00/dr        'œœœœœœ
		j3=(1+n1+5/4*n1^2+5/4*n1^3)*k3
		j4=(3*n1+3*n1^2+21/8*n1^3)*sin(k3)*cos(k4)
		j5=(15/8*n1^2+15/8*n1^3)*sin(2*k3)*cos(2*k4)
		j6=35/24*n1^3*sin(3*k3)*cos(3*k4)
		m=b1*(j3-j4+j5-j6)
		if abs(n-m)<.001 then exit loop    'œœœœœœ
		k=k+(n-m)/a1                       'œœœœœœ
	loop
	v=a1/sqr(1-e2*sin(k)^2)
	r=v*(1-e2)/(1-e2*sin(k)^2)
	h2=v/r-1
	y1=e-500000
	j3=tan(k)/(2*r*v)
	j4=tan(k)/(24*r*v^3)*(5+3*tan(k)^2+h2-9*tan(k)^2*h2)
	j5=tan(k)/(720*r*v^5)*(61+90*tan(k)^2+45*tan(k)^4)
	k9=k-y1^2*j3+y1^4*j4-y1^6*j5
	j6=1/(cos(k)*v)
	j7=1/(cos(k)*6*v^3)*(v/r+2*tan(k)^2)
	j8=1/(cos(k)*120*v^5)*(5+28*tan(k)^2+24*tan(k)^4)
	j9=1/(cos(k)*5040*v^7)
	j9=j9*(61+662*tan(k)^2+1320*tan(k)^4+720*tan(k)^6)
	l=dr*(y1*j6-y1^3*j7+y1^5*j8-y1^7*j9)              'œœœœœœœ
	k = ns% * k9 * dr
	l = l + zone% * 6 - 183
end sub

sub  ENtoLL (e , n , k , l)              'Lat , Long [k,l]  in Degrees
	shared dr
	a1=6377563.396*.9996012717
	b1=6356256.91*.9996012717
	n1 = (a1 - b1) / (a1 + b1)
	e2 = (a1 ^ 2 - b1 ^ 2) / a1 ^ 2
	k=(n+100000)/a1+49/dr
	do
		k3=k-49/dr
		k4=k+49/dr
		j3=(1+n1+5/4*n1^2+5/4*n1^3)*k3
		j4=(3*n1+3*n1^2+21/8*n1^3)*sin(k3)*cos(k4)
		j5=(15/8*n1^2+15/8*n1^3)*sin(2*k3)*cos(2*k4)
		j6=35/24*n1^3*sin(3*k3)*cos(3*k4)
		m=b1*(j3-j4+j5-j6)

		if abs(n+100000-m)<.001 then exit loop
		k=k+(n+100000-m)/a1
	loop
	v=a1/sqr(1-e2*sin(k)^2)
	r=v*(1-e2)/(1-e2*sin(k)^2)
	h2=v/r-1
	y1=e-400000
	j3=tan(k)/(2*r*v)
	j4=tan(k)/(24*r*v^3)*(5+3*tan(k)^2+h2-9*tan(k)^2*h2)
	j5=tan(k)/(720*r*v^5)*(61+90*tan(k)^2+45*tan(k)^4)
	k9=k-y1^2*j3+y1^4*j4-y1^6*j5
	j6=1/(cos(k)*v)
	j7=1/(cos(k)*6*v^3)*(v/r+2*tan(k)^2)
	j8=1/(cos(k)*120*v^5)*(5+28*tan(k)^2+24*tan(k)^4)
	j9=1/(cos(k)*5040*v^7)
	j9=j9*(61+662*tan(k)^2+1320*tan(k)^4+720*tan(k)^6)
	l=-2+dr*(y1*j6-y1^3*j7+y1^5*j8-y1^7*j9)
	k=k9*dr
end sub

sub NGRtoEN (n$ , e , n , pr%)
	do
		sp1% = instr(n$ , any " ()")
		if sp1% > 0 then n$ = left$(n$ , sp1% - 1) + mid$(n$ , sp1% + 1)
	loop until sp1% = 0

	poscomma% = instr(n$ , ",")         'Numeric format
	if poscomma% > 0 then
		if instr(poscomma% + 1 , n$ , ",") > 0 then error 5
		e = 1000 * val(left$(n$ , poscomma% - 1))
		n = 1000 * val(mid$(n$ , poscomma% + 1))
		pr% = 4
		call ENtoNGR(e , n , n$ , en$ , pr%)
		exit sub
	end if
	lett$ = left$(n$ , 2)
	if instr(lett$ , any "0123456789I") > 0 then error 5
	if instr(left$(lett$ , 1) , any "STNHO") = 0 then error 5
	num$ = mid$(n$ , 3)
	le% = len(num$)
	if instr(num$ , any "ABCDEFGHIJKLMNOPQRSTUVWXYZ") > 0 or_
								le% mod 2 = 1 then error 5
	pr% = le% / 2
	N = VAL(MID$(num$ , pr% + 1 , pr%))
	E = VAL(MID$(num$ , 1 , pr%))
	pr=10 ^ (5 - pr%)                          'multiplier to get metres
	T1%=ASC(MID$(lett$,1,1))-65:IF T1%>8 THEN T1%=T1%-1
	T2%=ASC(MID$(lett$,2,1))-65:IF T2%>8 THEN T2%=T2%-1
	E=500000* (T1% MOD 5) + 100000*(T2% MOD 5)-1000000 + E * pr
	N=1900000-500000*(T1% \5)-100000*(T2%\5) + N * pr
end sub

sub ENtoNGR(e , n , ngr$ , en$ , digits%)
	if e <= 0 or e > 700e3 or n <= 0 or n > 1400e3 then
		ngr$ = "      "
		e = 0
		n = 0
		exit sub
	end if
	e1%=e \ 100000
	n1%=n \ 100000
	c1%=83-5*(n1%\5)+(e1%\5)
	if c1%=73 then c1%=72
	eh%=(e1% mod 5)
	nh%=(n1% mod 5)
	c2%=(4-nh%)*5+eh%+65
	IF c2%>72 then incr c2%
	e2&=(e-e1%*100000)/(10^(5-digits%))
	n2&=(n-n1%*100000)/(10^(5-digits%))
	ce$ = mid$(STR$(e2&) , 2)
	do while len(ce$) < digits%
		ce$ = "0" + ce$
	loop
	cn$ = mid$(STR$(n2&) , 2)
	do while len(cn$) < digits%
		cn$ = "0" + cn$
	loop
	NGR$ = CHR$(C1%) + CHR$(C2%) + " " + CE$ + " " + CN$
	en$ = using$ ("[###.##" , e / 1000) + "," + using$("####.##]" , n / 1000)
end sub

sub LLtoLoc(lat , long , locator$ , digits%)
	locator$=chr$(65+int((long+180)/20))+chr$(65+int((lat+90)/10))+_
	chr$(48+int((long+180)/2 mod 10))+chr$(48+int((lat+90) mod 10))+_
	chr$(65+int((long+180)*12 mod 24))+chr$(65+int((lat+90)*24 mod 24))+_
	chr$(48+int((long+180)*120 mod 10))+chr$(48+int((lat+90)*240 mod 10))
	if digits% > 3 then
		locator$ = locator$ + chr$(97+int((long+180)*2880 mod 24))+chr$(97+int((lat+90)*5760 mod 24))
	end if
end sub

sub LoctoLL(lc$ , lat , long , ngrdigits%)
	ngrdigits% = 4
	do
		sp1% = instr(lc$ , any " ,.()")
		if sp1% > 0 then lc$ =left$(lc$ , sp1% - 1) + mid$(lc$ , sp1% + 1)
	loop until sp1%=0
	le% = len(lc$)
	if le% <> 10 and le% <> 8 and le% <> 6 then error 5     'force dummy error
	if len(lc$) = 8 then ngrdigits% = 3
   if len(lc$) = 6 then ngrdigits% = 2

	if instr(left$(lc$ , 2) , any "0123456789TUVWXYZ" ) > 0 or _
		instr(mid$(lc$ , 3 , 2) , any "ABCDEFGHIJKLMNOPQRSTUVWXYZ") > 0 OR _
		instr(mid$(lc$ , 5 , 2) , any "0123456789YZ") > 0 then error 5
	long = 20 * (asc(mid$(lc$,1,1))-74)+2*(asc(mid$(lc$,3,1))-48)_
				+(asc(mid$(lc$,5,1))-65)/12
	lat = 10*(asc(mid$(LC$,2,1))-74)+asc(mid$(lc$,4,1))-48_
				+(asc(mid$(lc$,6,1))-65)/24 'bottom LH corner
	if ngrdigits% = 2 then
		long = long + .04167
		lat = lat + .02083
		lc$ = left$(lc$ , 6)   'restore 6 digit if entered
	end if
	if ngrdigits% = 3 then
		if instr(mid$(lc$ , 7 , 2) , any "ABCDEFGHIJKLMNOPQRSTUVWXYZ") > 0 then error 5
		long = long + (asc(mid$(lc$,7,1))-48)/120+ .004167
		lat = lat +(asc(mid$(lc$,8,1))-48)/240 + .002083
	end if
	if ngrdigits% = 4 then
		if instr(mid$(lc$ , 7 , 2) , any "ABCDEFGHIJKLMNOPQRSTUVWXYZ") > 0 or _
				instr(mid$(lc$ , 9 , 2) , any "0123456789YZ") > 0 then error 5
		long = long + (asc(mid$(lc$,7,1))-48)/120 + (asc(mid$(lc$,9,1))-65)/2880 + .000174
		lat = lat +(asc(mid$(lc$,8,1))-48)/240 + (asc(mid$(lc$,10,1))-65)/5760 + .0000868
		mid$(lc$ , 9 , 2) = lcase$(right$(lc$ , 2))
	end if
end sub

sub LLFmt(lat , long , ll$ , dms%)
	if lat  < 0 then ns$ = " S" else ns$ = " N"
	if long < 0 then ew$ = " W" else ew$ = " E"
	alat = abs(lat)
	along = abs(long)
	select case dms%

	case 0
		ll$ = using$("Lat +##.####ø" , lat)
		ll$ = ll$ + using$("  Long +###.####ø " , long) + " "

	case 1
		ll$ = using$("##.####ø" , alat) + ns$
		ll$ = ll$ + using$("    ###.####ø" , along) + ew$ + "      "

	case 2
		ll$ = using$("##ø ", int(alat)) + using$("##.##'" , 60 * (alat - int(alat))) + ns$ + _
				using$("   ###ø ", int(along)) + using$("##.##'" , 60 * (along - int(along))) + ew$
		ll$ = ll$ + "    "

	case 3
		secs& = alat * 3600
		ll$ = using$("##ø " , secs& \ 3600) +_
				using$("##' " , (secs& \ 60) mod 60) + _
				using$("##" , (secs& mod 60)) + chr$(34) + ns$
		secs& = along * 3600
		ll$ = ll$ + using$("   ###ø " , secs& \ 3600) +_
					 using$("##' " , (secs& \ 60) mod 60) + _
					 using$("##" , (secs& mod 60)) + chr$(34) + ew$  + "  "
	end select
end sub

sub STRtoLL(ll$ , lat , long)
	shared backcol%
	ll$ = ucase$(ll$)
	ns% = instr(ll$ , any "NS")
	ew% = instr(ll$ , any "EW")
	if ns% = 0 or ew% = 0 then
		poscomma% = instr(ll$ , ",")      'test for  (lat,long) format - one comma only
		if poscomma% = 0 or instr(poscomma% + 1 , ll$ , ",") > 0 or_
				ns% + ew% > 0 then
			error 5
			exit sub
		else
			lat = val(left$(ll$ , poscomma% - 1))
			long = val(mid$(ll$ , poscomma% + 1))
			exit sub
		end if
	end if
	if ns% < ew% then                            'separate lat and long components
		lat$ = left$(ll$ , ns% - 1)
		long$ = mid$(ll$ , ns% + 1 , ew% - ns% - 1)
	else
		long$ = left$(ll$ , ew% - 1)
		lat$ = mid$(ll$ , ew% + 1 , ns% - ew% - 1)
	end if

	do until instr(left$(lat$ , 1) , any " ,/") = 0
		lat$ = mid$(lat$ , 2)
	loop

	do until instr(left$(long$ , 1) , any " ,/") = 0
		long$ = mid$(long$ , 2)
	loop
	call parse(lat$ , lat )
	call parse(long$ , long )
	if mid$(ll$ , ns% , 1) = "S" then lat = -lat
	if mid$(ll$ , ew% , 1) = "W" then long = -long
end sub

sub Parse(t$, value )    'extract value from separated lat & long strings
	shared l$()
	l$(0) = "" : l$(1) = "" : l$(2) = "" : l$(3) = ""
	do
		x% = instr(lastx% + 1 , t$ , any " ,/")
		if x% = 0 then exit loop
		l$(g%) = mid$(t$ , lastx% + 1 , x% - lastx% - 1)
		lastx% = x%
		incr g%
	loop
	l$(g%) = mid$(t$ , lastx% + 1)
	value = abs(val(l$(0))) + abs(val(l$(1))) / 60 + abs(val(l$(2))) / 3600
end sub

sub QRAtoLL(qra$ , lat , long)
	do
		sp1% = instr(qra$," ")
		if sp1% > 0 then qra$ =left$(qra$ , sp1% - 1) + mid$(qra$ , sp1% + 1)
	loop until sp1%=0
	if len(qra$) <> 5 then error 5
	if instr(mid$(qra$ , 3 , 2) , any "ABCDEFGHIJKLMONPQRSTUVWXYZ") > 0 then error 5
	if instr(right$(qra$ , 1) , any "IKLMONPQRSTUVWXYZ") > 0 then error 5

	LONG=2*(ASC(MID$(qra$,1,1))-65)+52*(MID$(qra$,1,1)>"R")+_
			.2*((VAL(MID$(qra$,3,2))-1)MOD 10)+_
			(.5+(INSTR("HGFAJEBCD",MID$(qra$,5,1))-1)\3)/15
	LAT=ASC(MID$(qra$,2,1))-25+.125*(7-(VAL(MID$(qra$,3,2))-1)\10)+_
			(.5+(INSTR("FEDGJCHAB",MID$(qra$,5,1))-1)\3)/24
end sub

sub LLtoQRA(lat , long , qra$)
	if lat < 40 or lat > 66 or long < -12 or long > 30 then qra$ = "     " : exit sub
	c1% = int(long / 2)
	c2% = int(lat)
	c3% = int((long / 2 - c1%) * 10)
	c4% = int((lat - c2%) * 8)
	c5% = int((long / 2 - c1% - c3% / 10) * 30)
	c6% = int((lat - c2% - c4% / 8) * 24)
	select case c5%
	case 0
		if c6% = 0 then ch5$ = "F"
		if c6% = 1 then ch5$ = "G"
		if c6% = 2 then ch5$ = "H"
	case 1
		if c6% = 0 then ch5$ = "E"
		if c6% = 1 then ch5$ = "J"
		if c6% = 2 then ch5$ = "A"
	case 2
		if c6% = 0 then ch5$ = "D"
		if c6% = 1 then ch5$ = "C"
		if c6% = 2 then ch5$ = "B"
	end select
	if c1% < 0 then c1% = c1% + 26
	c2% = c2% - 40
	c3% = c3% + 1
	c4% = 7 - c4%
	if c3% = 10 then
		c3% = 0
		c4% = c4% + 1
	end if
	qra$ = chr$(c1% + 65) + chr$(c2% + 65) + chr$(c4% + 48) + chr$(c3% + 48) + ch5$
end sub

Sub LocationIn(lo$ , lat , long , ngrdigits%)
	shared sitenames$() , maxcounter%
	for n% = 0 to maxcounter%
		sitename$ = sitenames$(n% , 0)
		stloc$ = sitenames$(n% , 1)
		stloc$=ucase$(stloc$)
		if instr(stloc$,"~") > 0 then stloc$=left$(stloc$,6)  ' 6 Digit loc stored
		b% = instr(ucase$(sitename$) , lo$)
		IF B%>0 THEN
			found% = -1
			exit for
		end if
	next n%

	lo$ = stloc$
	if found% = 0 then
		locate csrlin - 1 , 21
		lo$ = "Not Stored, ? to browse database"
		sound 300 , 1
		exit sub
	end if

	c6% = asc(mid$(lo$ , 6 , 1))
	c5% = asc(mid$(lo$ , 5 , 1))
	ngrdigits% = 3
	if c5% >= 48 and c5% <= 57 then
		call NGRtoEN(lo$ , e , n, ngrdigits%)
		call ENtoLL(e , n , lat , long )
	else
		if len(lo$) <= 6 then
			lo$ = lo$ + "44"
			ngrdigits% = 2
		else
		end if
		call LocToLL(lo$ , lat , long , dummy%)
	end if
	lo$ = ucase$(sitename$)
	possp% = instr(27 , lo$ , any " ,(")
	if possp% > 0 then lo$ = left$(lo$ , possp% -ssp% -ssp% - 1) else lo$ = left$(lo$ , 33)
end sub

sub DistBear(lat , long , baselat , baselong , dist , bearing , backbearing , distuncert , bearuncert)
	shared dr , resolution , baseresolution
	aa = baselat / dr
	ab = lat / dr
	csarc = sin(aa) * sin(ab) + cos(aa) * cos(ab) * cos((baselong - long) / dr)
	IF abs(csarc) < 1 then arc = fnacs(csarc) else arc=0
	dist = abs(6371.29 * arc)
	if dist < .001 then
		bearing = 0
		backbearing = 0
		distuncert = 0
		bearuncert = 0
		exit sub
	end if
	csbear = (sin(ab)-sin(aa) * cos(arc)) / (cos(aa) * sin(arc))
	backcsbear = (sin(aa) - sin(ab) * cos(arc)) / (cos(ab) * sin(arc))
	IF abs(csbear) > 1 then csbear = sgn(csbear)
	IF abs(backcsbear) > 1 then backcsbear = SGN(backcsbear)
	bearing = dr * fnacs(csbear)
	backbearing=dr * fnacs(backcsbear)
	IF long < baselong then bearing = 360 - bearing
	IF baselong < long then backbearing = 360 - backbearing
	distuncert = (resolution + baseresolution) / 1000
	bearuncert = dr * (atn(resolution / dist / 1000) +_
			atn(baseresolution / dist / 1000))
end sub

sub DrawSquare(lat , long , dlat , dlong)
	call LLtoEN(lat + dlat , long - dlong , e , n)
	call ENtoNGR(e , n , topleft$ , dummy$ , 3)
	call LLtoEN(lat - dlat , long - dlong , e , n)
	call ENtoNGR(e , n , botleft$ , dummy$  , 3)
	call LLtoEN(lat + dlat , long + dlong , e , n)
	call ENtoNGR(e , n , topright$ , dummy$  , 3)
	call LLtoEN(lat - dlat , long + dlong , e , n)
	call ENtoNGR(e , n , botright$ , dummy$  , 3)
	color 3 , 0
	locate 21 , 37 : print "É" + string$(5 , 205) + "»"
	locate 22 , 37 : print "º" + "     " + "º"
	locate 23 , 37 : print "È" + string$(5 , 205) + "¼"
	color 7 , 0
	locate 21 , 26 : print topleft$
	locate 23 , 26 : print botleft$
	locate 21 , 45 : print topright$
	locate 23 , 45 : print botright$
	color 15
	locate 22 , 40 : print "+"
end sub

Sub ClearBottom
	color 7 , 0
	for l% = 21 to 23
		locate l% , 1
		print space$(80);
	next l%
end sub

sub SiteBrowse
	shared textcol% , backcol% , sitenames$() , maxcounter% , nlines%
	
	static offset%
	screen 0 ,, 1
	color 6 , 3
	cls
	locate nlines% , 15 : print "Review site database SITES.DAT  -  [esc] to end";
	color 0
	do
		for lin% = 0 to nlines% - 2
			locate lin% + 1, 60 : print space$(10);
			locate lin% + 1, 10
			print sitenames$(lin% + offset% , 0);tab(60);sitenames$(lin% + offset% , 1)
		next lin%
		while not instat : wend
		ik$ = ucase$(inkey$)
		select case ik$
		case chr$(0 , 72)
			offset% = max(offset% - 1 , 0)
		case chr$(0 , 80) , chr$(32) , chr$(13)
			offset% = min(offset% + 1 , maxcounter% - (nlines% - 1))
		case chr$(0 , 73)
			offset% = max(offset% - (nlines% - 1) , 0)
		case chr$(0 , 81)
			offset% = min(offset% + (nlines% - 1) , maxcounter% - (nlines% - 1))
		case chr$(0 , 79)
			offset% = maxcounter% - (nlines% - 1)
		case chr$(0 , 71)
			offset% = 0
		end select
	loop until ik$ = chr$(27)

	screen 0 ,, 0
	color textcol% , backcol%
end sub

sub ReadInDBase
	shared sitenames$(), maxcounter%
	open "i" , 1 , "sites.dat"
	while not eof(1)
		line input #1 , l$
		if l$ = "" then exit loop
		if instr(l$ , "ENDEND") > 0 then exit loop
		sp1% = instr(l$ , "~")
		sitenames$(maxcounter% , 0) = left$(l$ , sp1% - 1)
		sp2% = instr(sp1% + 1 , l$ , "~")
		if sp2% > 0 then
			sitenames$(maxcounter% , 1) = ucase$(mid$(l$ , sp1% + 1 , sp2% - sp1% - 1))
			sitenames$(maxcounter% , 2) = mid$(l$ , sp2% + 1)
		else
			sitenames$(maxcounter% , 1) = ucase$(mid$(l$ , sp1% + 1))
		end if
		incr maxcounter%
	wend
	close 1
	f$ = dir$ ("Auxsites.dat")
	if f$ > "" then
		open "i" , 1 , f$
		while not eof(1)
			line input #1 , l$
			if l$ = "" then exit loop
			sp1% = instr(l$ , "~")
			sitenames$(maxcounter% , 0) = left$(l$ , sp1% - 1)
			sp2% = instr(sp1% + 1 , l$ , "~")
			if sp2% > 0 then
				sitenames$(maxcounter% , 1) = ucase$(mid$(l$ , sp1% + 1 , sp2% - sp1% - 1))
				sitenames$(maxcounter% , 2) = mid$(l$ , sp2% + 1)
			else
				sitenames$(maxcounter% , 1) = ucase$(mid$(l$ , sp1% + 1))
			end if
			incr maxcounter%
		wend
	end if
end sub