$lib graph on
$stack 8192
pi = 3.141592654
dim bitpatt$(3)
readfonts
screen 12
palette 1 , 8
plot
grid
cities
reg 1 , 0: call interrupt &h33
reg 1 , 1: call interrupt &h33
reg 1 , 7
reg 3 , 27
reg 4 , 613
call interrupt &h33
reg 1 , 8
reg 3 , 0
reg 4 , 440
call interrupt &h33
color 2
locate 29 , 1
print "Base 50.9 N  1.3 W Loc IO90IV ";
color 7
baselong = -1.29
baselat = 50.91
mx% = 320 + baselong * 1.33333 * 220 / 180
my% = 220 - baselat * 220 / 90
reg 1 , 4
reg 3 , mx%
reg 4 , my%
call interrupt &h33

do
	reg 1 , 3
	call interrupt &h33
	mx% = reg(3)
	my% = reg(4)
	x = (mx% - 320) / 1.33333 * 180 / 220
	y = (220 - my%) * 90 / 220

	if x < 0 then ew$ = "W" else ew$ = "E"
	if y < 0 then ns$ = "S" else ns$ = "N"
	button% = reg(2)
	if button% = 2  then
		baselong = x
		baselat = y
		button% = 0
		color 2
		locate 29 , 1
		print using "Base ##.# ! ###.# ! Loc \    \ ";_
					abs(y), ns$ , abs(x) , ew$ , locator$;
		color 7
	end if
	if button% = 1 then
		call search(x , y , pref$ , n$)
		mx% = 320 + x * 1.33333 * 220 / 180
		my% = 220 - y * 220 / 90
		reg 1 , 4
		reg 3 , mx%
		reg 4 , my%
		call interrupt &h33
		locate 30 , 33 : color 13
		print using "\   \  \                               \"; pref$ , n$;
      on timer(3) gosub BlankLine
		timer on
		color 7
	end if
	call DistBear(y , x , baselat , baselong , dist , bearing , backbear)
	call MakeLocator(x , y , locator$)
	locate 29 , 33
	print using "##.#!  ###.#!  Loc \    \   #####km ###ø (###ø)";abs(y), ns$ , abs(x) , ew$ , locator$ , dist , bearing , backbear
loop until inkey$ = chr$(27)
end
'======================================================================
sub grid
	for xgrid = -180 to 180 step 20
		if xgrid = 0 then patt% = &hffff else patt% = &hcccc
		line (320 + xgrid * 1.33333 * 220 / 180 , 0) - (320 + xgrid * 1.333333 * 220 / 180 , 440) , 8 ,, patt%
	next xgrid
	for ygrid = -90 to 90 step 10
		if ygrid = 0 then patt% = &hffff else patt% = &hcccc
		line (27 , 220 - ygrid * 220 / 90) - (613 , 220 - ygrid * 220 / 90) , 8 ,, patt%
	next ygrid
	for longd = -180 to 170 step 20
		for latd = -90 to 80 step 10
			sq$ = chr$(longd \ 20 + 74) + chr$(latd \ 10 + 74)
			px% = 330 + longd * 1.3333 * 220 / 180
			py% = 212 - latd * 220 / 90
			call textxy(sq$ , px% , py% , 8 , -1 , 1)
		next latd
	next longd
end sub

sub MakeLocator(lon , lat , locator$)
	locator$=chr$(65+int((lon+180)/20))+chr$(65+int((lat+90)/10))+_
	chr$(48+int((lon+180)/2 mod 10))+chr$(48+int((lat+90) mod 10))+_
	chr$(65+int((lon+180)*12 mod 24))+chr$(65+int((lat+90)*24 mod 24))+_
	chr$(48+int((lon+180)*120 mod 10))+chr$(48+int((lat+90)*240 mod 10))
end sub

sub plot
	shared pi
	open "b" , 1, "earth.dat"
	co% = 3
	sf = 220 / pi / 1e4  'to plot units for degrees given stored numbers = 1 / 10000 radian
	grid
	while not eof(1)
		seek 1 , counter&
		get$ 1 , 2 , c$
		if c$ = "" or inkey$ = chr$(27) then exit loop
		x% = 320 + 1.333333 * cvi(c$) * sf
		get$ 1 , 2 , c$
		y% = 220 - cvi(c$) * sf * 2
		if z% then
			pset (x% , y%) , co%
			z% = 0
		else
			if y% > 20 then
				line - (x% , y%) , co%
			else
				z% = -1
			end if
		end if
		incr counter& , 4
	wend
	close 1
end sub

sub cities
	open "i" , 1 , "cities.dat"
	while not eof(1)
		input #1 , pref$ , nam$ , lat , long
		x% = 320 - long / 180 * 220 * 1.3333
		y% = 220 - lat / 90 * 220
		pset (x% , y%) , 14
	wend
	close 1
end sub

DEF FNACS(X) = ATN((SQR(1 - X * X)) / X) + pi / 2 * (1 - SGN(X))

sub DistBear(lat , long , baselat , baselong , dist , bearing , backbearing)
	dr = 57.29577951
	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 < .01 then bearing = 0 : backbearing = 0 : exit sub
	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
end sub

sub textxy(text$ , x% , y% , colour% , background% , fontno%)
	shared bitpatt$()
	select case fontno%
	case 1 , 5 , 7                '7x5 font
		rowsperchar% = 8
		colsperchar% = 6
		arrayref% = 0
	case 2 , 8
		rowsperchar% = 8
		colsperchar% = 8
		arrayref% = 1
	case 3 , 14
		rowsperchar% = 14
		colsperchar% = 8
		arrayref% = 2
	case 4 , 16
		rowsperchar% = 16
		colsperchar% = 9
		arrayref% = 3
	end select

	for charcount% = 1 to len(text$)
		ch% = asc(mid$(text$ , charcount% , 1))
		xbase% = x% + colsperchar% * (charcount% - 1)
		for rw% = 0 to rowsperchar% - 1
			thisch% = asc(mid$(bitpatt$(arrayref%) , 1 + rw% + ch% * rowsperchar% , 1))
			for bitno% = 0 to colsperchar% - 1
				if bit(thisch% , colsperchar% - bitno% - 1) then
					pset (xbase% + bitno%  , y% + rw% - rowsperchar% ) , colour%
				else
					if background% >= 0 then pset (xbase% + bitno%  , y% + rw% - rowsperchar% ) , background%
				end if
			next bitno%
		next rw%
	next charcount%
end sub

sub ReadFonts
'dim bitpatt$(3)                    'make sure this is in main part
	shared bitpatt$()
	fino% = freefile
	open "b" , fino% , "allfonts"
	get$  fino% , 2048 , bitpatt$(0)
	get$  fino% , 2048 , bitpatt$(1)
	get$  fino% , 3584 , bitpatt$(2)
	get$  fino% , 4096 , bitpatt$(3)
	close fino%
end sub

sub search (mlong , mlat , p$ , n$)
	fino% = freefile
	open "i" , fino% , "cities.dat"
	lastdist = 30000
	while not eof(fino%)
		input #fino% , pref$ , nam$ , lat , long
		long = -long   'stored as deg W !!!!
		call DistBear(mlat , mlong , lat , long , dist , b , b)
		if dist < lastdist then
			n$ = nam$
			p$ = pref$
			lastdist = dist
			zlong = long
			zlat = lat      'actual location to place cursor on city
		end if
	wend
	close fino%
	mlat = zlat
	mlong = zlong
	sound 4000 , .054
end sub

BlankLine:
	locate 30 , 33
	print space$(47);
	timer off
return