	$lib graph on
	screen 12
	dim colour%(15)
	gosub setupcolours
	locate 10,26
	color colour%(10)
	print "'PLSITES' ";
	color colour%(14)
	print "Site database plot"
	color colour%(14)
	locate 13,23
	print "(c)  A C Talbot   G4JNT    Sept  1992"
	locate 19,10
	color colour%(7)
	print "Use mouse or cursor keys and shifted cursor keys to move around"
	locate 25,1
	color colour%(6) + 16
	print "Any key to continue"
	color colour%(7)
	while inkey$="":wend
	cls
	dr=180/3.141592654
	DEF FNE(N$)=VAL(MID$(N$,3,3))+5000*((ASC(MID$(N$,1,1))-65+(MID$(N$,1,1)>"H")) MOD 5)+1000*((ASC(MID$(N$,2,1))-65+(MID$(N$,2,1)>"H")) MOD 5)-10000
	DEF FNN(N$)=VAL(MID$(N$,6,3))+19000-5000*((ASC(MID$(N$,1,1))-65+(MID$(N$,1,1)>"H")) \ 5)-1000*((ASC(MID$(N$,2,1))-65+(MID$(N$,2,1)>"H"))\5)
	if command$>"" then location$=command$:goto incmnd
InAgain:
	color colour%(7)
	locate 10,54
	print space$(25)
	locate 10,25
	print "Own Sitename, NGR or Locator ";
	color colour%(10)
	input ;, location$
	color colour%(15)
	if location$="" then sound 500,1:goto inagain
incmnd:
	location$=ucase$(location$)
	locate 10,54
	print location$
	gosub HowStored
	if whichtype% = 1 then gosub DecodeLoc
	if whichtype% = 2 then e%=fne(location$):n%=fnn(location$)
	if whichtype% = 0 then sound 500 , 3 : goto inagain
	gosub makeNGR
	basengr$ = ngr$
	centree%=e%:centren%=n%
	basee%=centree%
	basen%=centren%
	locate 12,25
	color colour%(7)
	input "Distance from base  [300]    ", maxdist
	if maxdist=0 then maxdist =300
	reg 1,0
	call interrupt &h33                          'reset mouse
	reg 1,1
	call interrupt &h33                          'show mouse cursor
	scratio=1.3
	colcoast%=colour%(12)
	colown%=colour%(11)
   gosub Redraw
   x%=pmap(centree%,0)
	y%=pmap(centren%,1)
	call setmouse(x%,y%)
do
	e=xcoord%/10
	n=ycoord%/10
	x%=pmap(xcoord%,0)
	y%=pmap(ycoord%,1)
	call setmouse(x%,y%)
	gosub MakeNgr
	gosub MakeLoc
	gosub DistBear
	distngr$ = ngr$
	color colour%(7)
	locate 30,45
	print distngr$;" ";locator$;
	print using "####.# km  ###ø";dist,bear;

	a$=ucase$(inkey$)
	if a$=chr$(27) then end
	call ReadMouse(x%,y%,button%,moved%)
	if a$="N" or button%=1 then
		gosub NameSite
		namedflag%=-1
		x% = pmap(xcoord% , 0)
		y% = pmap(ycoord% , 1)
		call setmouse(x% , y%)
	end if
	if (a$ = "P" or button%=2) and dir$("terrain.exe") > "" then
		cls
		shell "terrain " + basengr$ + " " + distngr$
		gosub redraw
		reg 1 , 0
		call interrupt &h33
		reg 1 , 1
		call interrupt &h33
		iterate loop
	end if
	if a$ > "" then
		if a$="I" then
			maxdist=maxdist / 2
			centree%=xcoord%
			centren%=ycoord%
			gosub redraw
			iterate loop
		end if
        if a$="O" then
			maxdist=maxdist*2
			centree%=xcoord%
			centren%=ycoord%
			gosub redraw
			iterate loop
		end if

		if a$="8" then ycoord%=ycoord%+interval*10
		if a$="2" then ycoord%=ycoord%-interval*10
		if a$="4" then xcoord%=xcoord%-interval*10
		if a$="6" then xcoord%=xcoord%+interval*10
		if len(a$)=2 then
			if namedflag% then locate 30,15:print space$(40);:namedflag%=0
			a%=asc(right$(a$,1))
			if a%=72 then ycoord%=ycoord%+interval
			if a%=80 then ycoord%=ycoord%-interval
			if a%=75 then xcoord%=xcoord%-interval
			if a%=77 then xcoord%=xcoord%+interval
			if a%=71 then xcoord%=basee%:ycoord%=basen%  'home
		end if
		x%=pmap(xcoord%,0)
		y%=pmap(ycoord%,1)
		call setmouse(x%,y%)
	end if
	call readmouse (x%,y%,button%,mousemoved%)
	if mousemoved% then
		xcoord%=pmap(x%,2)
		ycoord%=pmap(y%,3)
	end if
	e1=centree%-md%*scratio+interval*12
	e2=centree%+md%*scratio-interval*12
	n1=centren%-md%+interval*12
	n2=centren%+md%-interval*12
	if xcoord% < e2 and xcoord% > e1 and ycoord% < n2 and ycoord% > n1 then
	else
		centree%=xcoord%
		centren%=ycoord%
		gosub ReDraw
		x%=pmap(centree%,0)
		y%=pmap(centren%,1)
		call setmouse(x%,y%)
	end if
loop
end

coastline:
	recordno%=0
	open "r",2,"eucoast.dat",9
	field 2,1 as col$,4 as ml$,4 as ma$
	do
		incr recordno%
		get 2,recordno%
		col%=val(col$)
		if asc(col$)=255 then exit loop
		long=cvs(ml$)
		lat=cvs(ma$)
		gosub llen
		if col%=0 then
			pset (e%,n%),colcoast%
		else
			line -(e%,n%),colcoast%
		end if
	loop
	close 2
	return

llen:
	LAT=LAT/DR:LONG=LONG/DR
	Y=SQR(1-.00667054#*SIN(LAT)*SIN(LAT))
	N=-100+111.0793*(LAT*dr-49)
	N=N-31.947*SIN((LAT*dr-49)/DR)*COS(LAT+49/DR)+.971*(2+LONG*dr)^2*SIN(LAT)*COS(LAT)/Y
	E=400+111.2651*(2+LONG*dr)*COS(LAT)/Y
	E=E-.0056*(2+LONG*dr)^3*(COS(LAT))^3*((TAN(LAT))^2-1)
	e%=10*e
	n%=10*n
return

DecodeLoc:
'		Enter with location$ = loc,  exit with e%,n%
	IF LEN(location$)<8 or right$(location$,2)="  " THEN LC8%=0 else LC8%=-1
	LAT=10*(ASC(MID$(location$,2,1))-65)+(ASC(MID$(location$,4,1))-48)
	LAT=LAT+(ASC(MID$(location$,6,1))-65)/24-90+1.25/60
	IF LC8% THEN LAT=LAT+(ASC(MID$(location$,8,1))-48)*.25/60-1.125/60
	LONG=20*(ASC(MID$(location$,1,1))-65)+2*(ASC(MID$(location$,3,1))-48)
	LONG=LONG+(ASC(MID$(location$,5,1))-65)/12-180+2.5/60
	IF LC8% THEN LONG=LONG+(ASC(MID$(location$,7,1))-48)*.5/60-2.25/60
    LATR=LAT/DR
	LONGR=LONG/DR
	Y=SQR(1-.00667054#*SIN(LATR)*SIN(LATR))
	N=-100+111.0793*(LAT-49)
	N=N-31.947*SIN((LAT-49)/DR)*COS(LATR+49/DR)+.971*(2+LONG)^2*SIN(LATR)*COS(LATR)/Y
	E=400+111.2651*(2+LONG)*COS(LATR)/Y
	E=E-.0056*(2+LONG)^3*(COS(LATR))^3*((TAN(LATR))^2-1)
	e%=e*10:n%=n*10
return

HowStored:
	q1$="AA00AA  "
	q2$="RR99XX99"
	q3$="HA000000"
	q4$="YZ999999"
	whichtype%=0:notloc%=0:notngr%=0:found%=0
	for chk%=1 to len(location$)
		a$=mid$(location$,chk%,1)
		if a$ < mid$(q1$,chk%,1) or a$ > mid$(q2$,chk%,1) then notloc%=-1
		if a$ < mid$(q3$,chk%,1) or a$ > mid$(q4$,chk%,1) then notngr%=-1
		next chk%
	if notloc% then whichtype%=2
	if notngr% then whichtype%=1
	if notloc% and notngr% and not nosearch% then whichtype%=0
	select case whichtype%
		case 1
			IF LEN(location$)<8 or right$(location$,2)="  " THEN LC8%=0 else LC8%=-1
		LAT=10*(ASC(MID$(location$,2,1))-65)+(ASC(MID$(location$,4,1))-48)
		LAT=LAT+(ASC(MID$(location$,6,1))-65)/24-90+1.25/60
		IF LC8% THEN LAT=LAT+(ASC(MID$(location$,8,1))-48)*.25/60-1.125/60
		LONG=20*(ASC(MID$(location$,1,1))-65)+2*(ASC(MID$(location$,3,1))-48)
		LONG=LONG+(ASC(MID$(location$,5,1))-65)/12-180+2.5/60
		IF LC8% THEN LONG=LONG+(ASC(MID$(location$,7,1))-48)*.5/60-2.25/60

		case 2
			N=VAL(MID$(location$,6,3))/10
			E=VAL(MID$(location$,3,3))/10
			T1%=ASC(MID$(location$,1,1))-65
			IF T1%>8 THEN T1%=T1%-1
			T2%=ASC(MID$(location$,2,1))-65
			IF T2%>8 THEN T2%=T2%-1
			E=500* (T1% MOD 5) + 100*(T2% MOD 5)-1000+E
			N=1900-500*(T1% \5)-100*(T2%\5)+N
			T1=(N+5548.79)/6371.28
			T2=2*ATN(EXP((E-400)/6389.7))
			LONGR=ATN(-COS(T2)/(COS(T1)*SIN(T2)))-2/DR
			LA=SIN(T1)*SIN(T2)
			LATR=ATN(LA/SQR(1-LA*LA))
			LAT=LATR*DR
			LONG=LONGR*DR

		case else
			found%=0
			OSITE$=UCASE$(location$)
			searchloop%=0
			close 3             ' In case
			open "i",3,"sites.dat"
			do
				incr searchloop%
				line input #3,readline$
				if readline$ = "" then iterate loop
				posn1%=instr(readline$,"~")
				posn2%=instr(posn1%+7,readline$,"~")
				sitename$=left$(readline$,posn1%-1)
				if posn2%=0 then
					stloc$ = mid$(readline$ , posn1% + 1 , 8)
				else
					stloc$ = mid$(readline$ , posn1%+ 1 , posn2% - posn1% - 1)
				end if
				stloc$=ucase$(stloc$)
				if instr(stloc$,"~") > 0 then stloc$=left$(stloc$,6)  ' 6 Digit loc stored
				b% = instr(ucase$(sitename$),osite$)
				IF B% > 0 THEN
					found% = -1
					exit loop
				end if
			loop until eof(3)
			close 3
			if not found%  and dir$("auxsites.dat") > "" then
			open "i",3,"auxsites.dat"
			searchloop% = 0
			do
				incr searchloop%
				line input #3,readline$
				posn1%=instr(readline$,"~")
				posn2%=instr(posn1%+7,readline$,"~")
					sitename$=left$(readline$,posn1%-1)
				if posn2%=0 then
					stloc$=mid$(readline$,posn1%+1,8)
				else
					stloc$=mid$(readline$,posn1%+1,posn2%-posn1%-1)
					posnhgt% = instr(posn2% , ucase$(readline$) , "H")
					if posnhgt% > 0 then mastheight = val(mid$(readline$ , posnhgt% + 1))_
								else mastheight = 0
				end if

				stloc$=ucase$(stloc$)
				if instr(stloc$,"~")>0 then stloc$=left$(stloc$,6)  ' 6 Digit loc stored
				b%=instr(ucase$(sitename$),osite$)
				IF B%>0 THEN
					found%=-1
					exit loop
				end if
			loop until eof(3)
		end if
			if found% then
				location$=ucase$(stloc$)
				whichtype% = 3
				goto HowStored
			end if
	end select
return


MakeNgr:
	C1%=83-5*((N-.5)\500)+((E-.5)\500)
	IF C1%=73 THEN C1%=72
	EH%=((E MOD 500)-.5)\100
	NH%=((N MOD 500)-.5)\100
	C2%=(4-NH%)*5+EH%+65       'this one goes wrong at s/n boundary
	IF C2%>72 THEN C2%=C2%+1
	C35%=(E*10) MOD 1000
	C35$=RIGHT$(STR$(C35%),1-(C35%>9)-(C35%>99))
	while LEN(C35$)<3:C35$="0"+C35$:wend
	C68%=(N*10) MOD 1000
	C68$=RIGHT$(STR$(C68%),1-(C68%>9)-(C68%>99))
	while LEN(C68$)<3:C68$="0"+C68$:wend
	NGR$=CHR$(C1%)+CHR$(C2%)+C35$+C68$
	if e<0 or n<0 or e>700 or n> 1400 then ngr$="   --   "
return

MakeLoc:
	T1=(N+5548.79)/6371.28
	T2=2*ATN(EXP((E-400)/6389.7))
	LONGR=ATN(-COS(T2)/(COS(T1)*SIN(T2)))-2/DR
	LA=SIN(T1)*SIN(T2)
	LATR=ATN(LA/SQR(1-LA*LA))
	LAT=LATR*DR
	LONG=LONGR*DR
	LOCATOR$="":V=LAT/180+.5:H=LONG/360+.5:L$=""
	T=65:F=18:GOSUB 3020
	T=48:F=10:GOSUB 3020
	T=65:F=24:GOSUB 3020
	T=48:F=10:GOSUB 3020
RETURN
3020	V=F*(V-INT(V)):H=F*(H-INT(H))
	LOCATOR$=LOCATOR$+CHR$(INT(T+H))+CHR$(INT(T+V))
RETURN

NameSite:
	locate 30,15
	color colour%(5)
	print "Searching"+space$(57);
	color colour%(14)
	found%=0
	nearest=9999
	foundname$=""
	for filecount% = 0 to 1
		close 1
		if filecount% = 0 then fi$ = "sites.dat" else fi$ = "auxsites.dat"
		open "i",1,fi$
		while not eof(1)
			line input #1,l$
			if l$ = "" then iterate loop
			posn1%=instr(l$,"~")
			posn2%=instr(posn1%+7,l$,"~")
			sitename$=left$(l$,posn1%-1)
			if posn2%=0 then
				location$=mid$(l$,posn1%+1,8)
			else
				location$=mid$(l$,posn1%+1,posn2%-posn1%-1)
			end if
			location$=ucase$(location$)
			if instr(stloc$,"~")>0 then location$=left$(location$,6)  ' 6 Digit loc stored
			gosub HowStored
			if whichtype%=1 then gosub DecodeLoc
			if whichtype%=2 then	e%=fne(location$):n%=fnn(location$)
			distsq = (e% - xcoord%) ^ 2 + (n% - ycoord%) ^ 2
			if distsq <= nearest or distsq < interval * 2 then
				nearest = distsq
				foundname$=sitename$
				foundx = e%
				foundy = n%
			end if
		wend
	next filecount%
	locate 30,15
	print using "\                             \ ";foundname$;
	close 1
	xcoord% = foundx
	ycoord% = foundy
return

SetUpColours:
	for a%=0 to 15
		colour%(a%)=a%
	next a%
	if dir$("colours.dat")="COLOURS.DAT" then
		open "i",1,"colours.dat"
		for a%=0 to 15
			input #1,colour%(a%)
		next a%
		close 1
	end if
return

DistBear:
	dx=xcoord%-basee%
	dy=ycoord%-basen%
	dist=sqr(dx*dx+dy*dy)
	if (dx+dist)>0 then bear=360/3.1415927*atn(dy/(dx+dist)) else bear=0
	bear =90-bear
	if bear<0 then bear=bear+360
	dist=dist/10
return

sub ReadMouse(x%,y%,button%,m%)
	static moved%
	reg 1,3
	call interrupt &h33
	x%=reg(3)
	y%=reg(4)
	button%=reg(2)
	if x%<>oldx% or y%<>oldy% then
		moved%=-1
		oldx%=x%
		oldy%=y%
	else
		moved%=0
	end if
	m% = moved%
end sub

sub SetMouse (x%,y%)
	reg 3 , x%
	reg 4 , y%
	reg 1 , 4
	call interrupt &h33
end sub



Redraw:
	reg 1,2
	call interrupt &h33      'hide mouse while redrawing
	md%=maxdist*10
	x1% = centree% - md% * scratio
	y1% = centren% - md%
	x2% = centree% + md% * scratio
	y2% = centren% + md%
	window (x1% , y1%) - (x2% , y2%)
	interval=md%/200
	cls
	circle (basee%,basen%),5,colown%
	paint (basee%,basen%),colown%,colown%
	gosub coastline
	open "i",1,"sites.dat"
	while not eof(1)
		if inkey$ = chr$(27) then end
		incr a%
		line input #1,l$
      if l$ = "" then iterate loop
		posn1%=instr(l$,"~")
		posn2%=instr(posn1%+7,l$,"~")
		sitename$=left$(l$,posn1%-1)
		if posn2%=0 then
			colm%=colour%(10)
			location$=mid$(l$,posn1%+1,8)
		else
			colm%=colour%(14)
			location$=mid$(l$,posn1%+1,posn2%-posn1%-1)
		end if
		location$=ucase$(location$)
		if instr(stloc$,"~")>0 then location$=left$(location$,6)  ' 6 Digit loc stored
		nosearch%=-1
		gosub HowStored
		if whichtype%=1 then
			gosub DecodeLoc
		else
			e%=fne(location$)
			n%=fnn(location$)
		end if
		pset (e% , n%),colm%
		circle (e% , n%),2,colm%
	wend
	close 1
	xcoord%=centree%
	ycoord%=centren%
	locate 30,1
	color colour%(9):print "N";:color colour%(7):print "ear ";
	color colour%(9):print "I";:color colour%(7):print "n ";
	color colour%(9):print "O";:color colour%(7):print "ut ";
	reg 1,1
	call interrupt &h33      'show mouse agian
return

erh:
print readline$;l$