$lib graph on
data 0,1 , 200,1 , 440,1 , 680,2 , 880,2 , 1040,1 , 1200,1
data 1360,0 , 1520,0 , 1720,0 , 1880,3 , 1960,3 , 2040,4   'file structure
paldata:      'startup palette set
data 0,0,15 , 0,0,30 , 0,0,45
data 0,8,53 , 0,18,43 , 0,25,25 , 0,28,7 , 0,33,0
data 29,34,0 , 36,35,0 , 47,34,0 , 53,25,0 , 63,17,0 , 63,0,0 , 63,63,63

dim rowdata%(13 , 1) , spots%(600 , 2) , default%(15) , bitpatt$(3)
dim getarray(6000), sitenames$(1000 , 2)
pi = 3.141592653589
readfonts
ReadInDBase
for rowcount% = 0 to 12
	read rowdata%(rowcount% , 0)
	read rowdata%(rowcount% , 1)
next rowcount%
rowdata%(13 , 0) = 4
rowdata%(13 , 0) = 2120     ' End of file

f$ = "heights2.dat"
if dir$(f$) = "" then
	f$ = "d:" + f$
	if dir$(f$) > "" then exit if
	sound 500 , 2
	color 12 + 16
	print "Height database missing"
	end
end if
open "b" , 1 , f$

'==========================================================

screen 12
maxtext% = 640
color 15
line (200 , 80) - (410 , 55) , 8 , bf
line (200 , 80) - (410 , 55) , 15 , b
call textxy("HEIGHT MAP OF LOCAL AREA" , 210 , 75 , 11 , -1 , 3)

color 7
line (45 , 170) - (595 , 260) , 10 , b
line (46 , 171) - (594 , 259) , 2 , b
locate 12 , 10
if command$ > "" then centrelo$ = command$ else _
input;"BASE LOCATION  (NGR , Locator  or  Sitename)      ",centrelo$
if centrelo$ = "" then end
call LocationIn(centrelo$ , ecentre , ncentre)
locate 14 , 10
input "PLOT SIZE  (20, 40, 60, 80, 120, 240 km)   [120]  ",sqsize%
if sqsize% = 0 then sqsize% = 120
if sqsize% < 20 then sqsize% = 20
boxint% = max(240 \ sqsize% , 1)    'pixels per 0.5km interval
if boxint% > 6 then boxint% = 12
if boxint% > 4 and boxint% < 12 then boxint% = 6
sqsize% = 240 \ boxint%                                 'adjust for integer number of pixels

locate 16 , 10
input "MAXIMUM HEIGHT DISPLAYED                   [300]  " , maxh
if maxh = 0 then maxh = 300
colscale = (maxh ^ (1 / 1.32)) / 14

ebase = ecentre
nbase = ncentre
call ENtoNGR(ebase , nbase , basengr$)
call ENtoLoc(ebase , nbase , baseloc$)
ecentre = 10 * (ecentre \ 10)
ncentre = 10 * (ncentre \ 10)                   'nearest 10km square below left
eref% = ecentre - sqsize% \ 2
nref% = ncentre + (sqsize% - 20) \ 2                    'top left of screen

do until nref% - sqsize% > -10
	nref% = nref% + 10
	ncentre = ncentre + 10
loop

n100% = ((ncentre - sqsize \ 2) \ 100)
estart% = rowdata%(n100% , 1) * 100

do until eref% > estart%
	eref% = eref% + 10
	ecentre = ecentre + 10
loop

estop% = max ((rowdata%(n100% + 1 , 0) - rowdata%(n100% ,0)) / .4 , estart% + sqsize%)

do until eref% <= (estop% - sqsize% + 100)
	eref% = eref% - 10
	ecentre = ecentre - 10
loop

call ENtoNGR(ecentre , ncentre , centrelo$)
cls
SetUpPalette
ChangePalette

do
	reg 1 , 0                  'reset mouse
	call interrupt &h33
	maxst% = 0
	for ycount% = 0 to sqsize% - 10 step 10
		n% = nref% - ycount%        'count DOWN screen
		if n% < 0 or n% > 1300 then iterate for
		n10% = (n% \ 10) mod 10
		n100% = n% \ 100
      estart% = rowdata%(n100% , 1)
		estop% = (rowdata%(n100% + 1 , 0) - rowdata%(n100% ,0)) / 40 + estart%
		for xcount% = 0 to sqsize% - 10 step 10
			e% = eref% + xcount%
			e10% = (e% \ 10) mod 10
			e100% = e% \ 100
			if e100% >= estop% or e100% < estart% then iterate for
			filebreak& = rowdata%(n100% , 0) * 1000
			km100sq% = e100% - estart%
			km10sq% = n10% + e10% * 10
			offset10& = km100sq% * 40000  +  km10sq% * 400
			pointer& = offset10& + filebreak&
			if pointer& < 0 then pointer& = 0
			seek 1 , pointer&
			get$ 1 , 400 , ch400$
			for g% = 0 to 399
				ch1$ = mid$(ch400$ , g% + 1 , 1)
				h% = asc(ch1$)
				maxst% = max(maxst% , h%)
				col% = min(h% / colscale + .5 , 14)
				if col% = 0 then col% = 1
				if h% > 0 and col% = 1 then col% = 2
				e1% = g% mod 20
				n1% = g% \ 20
				x% = (e1% + xcount% * 2) * boxint%
				y% = (n1% + ycount% * 2) * boxint%
				if boxint% > 1 then
					line (x% , y%) - (x% + boxint% , y% + boxint%) , col% , BF
				else
					pset (x% , y%) , col%
				end if
			next g%
			if inkey$ = chr$(27) then finish
		next xcount%
	next ycount%
	plotno% = 0
finish:
   if showsite% then
		line (485 , 300) - (639 , 435) , 15 , b
		line (486 , 301) - (638 , 434) , 1 , bf
		call TextXY("N" , 493 , 430 , 15 , 1 , 1)
		call TextXY("earest site" , 500 , 430 , 9 , 1 , 1)
	else
		line (485 , 300) - (639 , 415) , 15 , b
		line (486 , 301) - (638 , 414) , 1 , bf
	end if

	line (563 , 132) - (639 , 173) , 15 , b
	line (564 , 133) - (638 , 172) , 3 , bf
	call TextXY("LOCALMAP" , 568 , 150 , 14 , 3 , 3)
	call TextXY("G4JNT" , 582 , 160 , 14 , 3 , 2)
	call TextXY("1997" , 586 , 170 , 14 , 3 , 2)


	call TextXY("CHANGE DISPLAY" , 510 , 315 , 14 , 1 , 2)
	call TextXY("P" , 493 , 330 , 15 , 1 , 1) : call TextXY("alette" , 500 , 330 , 9 , 1 , 1)
	call TextXY("A" , 493 , 340 , 15 , 1 , 1) : call TextXY("djust " , 500 , 340 , 9 , 1 , 1)
	call TextXY("H" , 535 , 340 , 15 , 1 , 1) : call TextXY("eight /" , 542 , 340 , 9 , 1 , 1)
	call TextXY("[ctl]-H" , 591 , 340 , 15 , 1 , 1)

	call TextXY("S" , 493 , 350 , 15 , 1 , 1) : call TextXY("how / Hide sites" , 500 , 350 , 9 , 1 , 1)
	call TextXY("T" , 493 , 360 , 15 , 1 , 1) : call TextXY("errain" , 500 , 360 , 9 , 1 , 1)
	call TextXY("F1" , 550 , 360 , 15 , 1 , 1) : call TextXY(".BMP file" , 565 , 360 , 9 , 1 , 1)

	call TextXY("[Home]" , 493 , 370 , 15 , 1 , 1) : call TextXY(" Set base" , 531 , 370 , 9 , 1 , 1)
	call TextXY("G" , 493 , 380 , 15 , 1 , 1) : call TextXY("o to" , 500 , 380 , 9 , 1 , 1)
	call TextXY("I" , 493 , 390 , 15 , 1 , 1) : call TextXY("n" , 500 , 390 , 9 , 1 , 1)
	call TextXY("O" , 518 , 390 , 15 , 1 , 1) : call TextXY("ut" , 525 , 390 , 9 , 1 , 1)
	call TextXY("C" , 546 , 390 , 15 , 1 , 1) : call TextXY("entre" , 553 , 390 , 9 , 1 , 1)

	call TextXY("L" , 493 , 400 , 15 , 1 , 1) : call TextXY("eft" , 500 , 400 , 9 , 1 , 1)
	call TextXY("R" , 530 , 400 , 15 , 1 , 1) : call TextXY("ight" , 537 , 400 , 9 , 1 , 1)
	call TextXY("U" , 572 , 400 , 15 , 1 , 1) : call TextXY("p" , 579 , 400 , 9 , 1 , 1)
	call TextXY("D" , 599 , 400 , 15 , 1 , 1) : call TextXY("own" , 606 , 400 , 9 , 1 , 1)
	call TextXY("B" , 493 , 410 , 15 , 1 , 1) : call TextXY("ackground colour" , 500, 410 , 9 , 1 , 1)

	line (485 , 290) - (560 , 100) , 0 , bf
	line (485 , 290) - (560 , 100) , 15 , b
	for col% = 1 to 14
		h = ((col% - 1) * colscale) ^ 1.32
		y% = 290 - col% * 12
		line (510 , y%) - (520 , y% - 10) , col% , bf
		call textXY(using$("####" , h) , 521 , y% + 5 , 12 , 0 , 1)
	next col%
	maxhdisp = maxst% ^ 1.32
	if maxhdisp > maxh then
		ml =  round(maxhdisp , 0)
	else
		ml =  round(maxh , 0)
		plhm% = 278 - maxst% / colscale * 12
		line (522 , plhm%) - (524 , plhm%) , 14
	end if
	call TextXY(using$("####m" , ml) , 521 , 115 , 12 , 0 , 1)

	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
		call GetEN(stloc$ , e , n)
		x% = (e - eref%) * 2 * boxint%
		y% = (nref% - n + 10) * 2 * boxint%
		if x% > 0 and x% < 479 and y% > 0 and y% < 479 then
			spots%(plotno% , 0) = x%
			spots%(plotno% , 1) = y%
			spots%(plotno% , 2) = point(x% , y%)
			incr plotno%
		end if
	next n%
	line (0 , 0) - (480 , 479) , 15 , b

	reg 1 , 1
	call interrupt &h33
	reg 1 , 7
	reg 3 , 0
	reg 4 , 481
	call interrupt &h33
	reg 1 , 80
	reg 3 , 0
	reg 4 , 480
	call interrupt &h33
	reg 1 , 4
	reg 3 , 240
	reg 4 , 240
	call interrupt &h33
   line (500 , 0) - (639 , 70) , 15 , b
	line (501 , 1) - (638 , 69) , 1 , bf

	call TextXY(using$("### km Square" , sqsize%) , 512 , 16 , 15 , 1 , 2)
	call TextXY("Centre " + centrelo$ , 512 , 30 , 15 , 1 , 2)
	call TextXY("Base " + basengr$ , 512 , 50 , 15 , 1 , 2)
	call TextXY("     " + baseloc$ , 512 , 64 , 15 , 1 , 2)

	he% = (ebase - eref%) * 2 * boxint%
	hn% = (nref% - nbase + 10) * 2 * boxint%
	colhm% = point(he% , hn%)
	reg 3 , he%
	reg 4 , hn%
	reg 1 , 4
	call interrupt &h33
	on timer (.2) gosub flash
	timer on
	if showsite% then showsites
	line (563 , 208) - (639 , 290) , 1 , bf
	line (563 , 208) - (639 , 290) , 15 , b
	circle (635 , 268) , 1 , 14 'deg sign for bearing!!
	call textxy("CURSOR" , 576 , 222 , 13 , 1 , 2)
	do
		reg 1 , 3
		call interrupt &h33
		me = eref% + .5 * (reg(3) / boxint% )
		mn = nref% - .5 * (reg(4) / boxint%) + 10
		call ENtoNGR(me , mn , lo$)
		call GetHeight(me , mn , hm%)
		call DistBear (ebase , nbase , me , mn , distance , bearing)
		call ENtoLOC(me , mn , locator$)

		call textxy(using$ ("NGR \      \" , lo$) , 565 , 235 , 14 , 1 , 1)
		call textxy(using$ ("LOC \      \" , locator$) , 565 , 245 , 14 , 1 , 1)
		call textxy(using$ ("Dist    ### " , distance)  , 565 , 265 , 14 , 1 , 1)
		call textxy(using$ ("Bearing ###" , bearing) , 565 , 275 , 14 , 1 , 1)
		call textxy(using$ ("Height ####m" , hm% ^ 1.32) , 565 , 285 , 14 , 1 , 1)
		plhm% = min(hm% / colscale * 12 , 180)
		line (500 , 278) - (503 , 278 - plhm%) , 14 , bf
		line (500 , 278 - plhm%) - (503 , 104) , 0 , bf

		if not instat and reg(2) = 0 then iterate loop
		ik$ = inkey$
		if ucase$(ik$) = "T" and dir$("terrain.exe") > "" then
			reg 1 , 3
			call interrupt &h33
			mx% = reg(3)
			my% = reg(4)
			 reg 1 , 0
			call interrupt &h33
			timer off
			cls
			showsite% = 0
			shell "terrain " + basengr$ + " " + lo$
			decr pal%
			SetUpPalette
			ChangePalette
	 reg 1 , 0
			call interrupt &h33
			reg 1 , 4
			reg 3 , mx%
			reg 4 , my%
			call interrupt &h33
			exit loop
		end if

		if ucase$(ik$) = "P" then ChangePalette

		if ucase$(ik$) = "A" then
			for li% = 9 to 11
				locate li% , 23
				print space$(18)
			next li%
			locate 10 , 25
			color 13
			input "Max height ",newmaxh
			if newmaxh > 0 then maxh = newmaxh
			colscale = (maxh ^ (1 / 1.32)) / 14
			timer off
			reg 1 , 2
			call interrupt &h33
			cls
			exit loop
		end if

		if ucase$(ik$) = "M" then
			markonmap% = not markonmap%
			 if showsite% then
				if markonmap% then
					call TextXY("M" , 493 , 420 , 15 , 1 , 1)
					call TextXY("ark sites NOT on map" , 500, 420 , 9 , 1 , 1)
				else
					call TextXY("M" , 493 , 420 , 15 , 1 , 1)
					call TextXY("ark sites on map    " , 500, 420 , 9 , 1 , 1)
				end if
			else
				markonmap% = 0
			end if
		end if

		if ucase$(ik$) = "S" then
			showsite% = not showsite%
			showsites
			if showsite% then
				line (485 , 300) - (639 , 435) , 15 , b
				line (486 , 410) - (638 , 434) , 1 , bf
				call TextXY("N" , 493 , 430 , 15 , 1 , 1)
				call TextXY("earest site" , 500 , 430 , 9 , 1 , 1)
				call TextXY("M" , 493 , 420 , 15 , 1 , 1)
				call TextXY("ark sites on map    " , 500, 420 , 9 , 1 , 1)
			else
				line (485 , 415) - (639 , 435) , 0 , bf
				line (485 , 300) - (639 , 415) , 15 , b
				line (486 , 410) - (638 , 414) , 1 , bf
			end if

		end if


		if ucase$(ik$) = "H" then
			maxh = maxh * 1.1
			colscale = (maxh ^ (1 / 1.32)) / 14
			exit loop
		end if

		if ucase$(ik$) = "G" then
			reg 1 , 2 : call interrupt &h33
			get (72 , 150) - (400 , 185) , getarray
			color 14
			line (72 , 150) - (400 , 185) , 0 , bf
			locate 11 , 11 : input; "Go to location  ",wherego$
			call LocationIn(wherego$ , ewhere , nwhere)
			mx% = (ewhere - eref%) * 2 * boxint%
			my% = (nref% - nwhere + 10) * 2 * boxint%
			reg 1 , 4
			reg 3 , mx%
			reg 4 , my%
			call interrupt &h33

			put (72 , 150) , getarray , pset
			reg 1 , 1 : call interrupt &h33
		end if

		if ik$ = chr$(8) then
			maxh = maxh / 1.1
			colscale = (maxh ^ (1 / 1.32)) / 14
			exit loop
		end if

		if ik$ = chr$(0 , 71) or reg(2) = 2 then     'home
			basengr$ = lo$
			baseloc$ = locator$
			nbase = mn
			ebase = me
			line (he% , hn%) - (he% + 1 , hn% + 1) , colhm% , bf
	 he% = (ebase - eref%) * 2 * boxint%
			hn% = (nref% - nbase + 10) * 2 * boxint%
			colhm% = point(he% , hn%)
	 call TextXY("Base " + basengr$ , 512 , 50 , 15 , 1 , 2)
			call TextXY("     " + baseloc$ , 512 , 64 , 15 , 1 , 2)
		end if

		if (ucase$(ik$) = "N" or reg(2) = 1) then
			call NearestSite (me , mn , sitename$ , stloc$)
			mx% = (me - eref%) * 2 * boxint%
			my% = (nref% - mn + 10) * 2 * boxint%
			reg 1 , 4
			reg 3 , mx%
			reg 4 , my%
			call interrupt &h33
			prsit1$ = "" : prsit2$ = "" : prsit3$ = ""
			if len(sitename$) < 20 then
				prsit1$ = sitename$
			else
				spz1% = 21
				do
					decr spz1%
					fsp$ = mid$(sitename$ , spz1% , 1)
				loop until spz1% = 0 or fsp$ = " "
				if spz1% > 0 and spz1% < 20 then
					prsit1$ = left$(sitename$ , spz1% - 1)
				else
					prsit1$ = left$(sitename$ , 20)
				end if

				spz2% = min(21 + spz1% , len(sitename$))
				do
					decr spz2%
					fsp$ = mid$(sitename$ , spz2% , 1)
				loop until spz2% = 0 or fsp$ = " "
				if spz2% > spz1% and spz2% < 20 + spz1% then
					prsit2$ = mid$(sitename$ , spz1% + 1 , spz2% - spz1%)
				else
					prsit2$ = mid$(sitename$ , spz1% + 1 , 20)
				end if

				spz3% = min(21 + spz2% , len(sitename$))
				do
					decr spz3%
					fsp$ = mid$(sitename$ , spz3% , 1)
				loop until spz3% = 0 or fsp$ = " "
				if spz3% > spz2% and spz3% < 20 + spz2% then
					prsit3$ = mid$(sitename$ , spz2% + 1 , spz3% - spz2%)
				else
					prsit3$ = mid$(sitename$ , spz2% + 1 , 20)
				end if
				if prsit3$ = prsit2$ then prsit3$ = ""
			end if
			if prsit3$ = "" then prsit3$ = stloc$ else prsit3$ = prsit3$ + " " + stloc$
			line (485 , 472) - (639 , 439) , 15 , bf
			call textXY(prsit1$ , 487 , 451 , 0 , 15 , 2)
			call textXY(prsit2$ , 487 , 461 , 0 , 15 , 2)
			call textXY(prsit3$ , 487 , 471 , 0 , 15 , 2)
			if markonmap% and showsite% then
				maxtext% = 478
				call textXY(prsit1$ + prsit2$ , mx% , my% , 15 , -1 , 1)
				maxtext% = 640
			end if
		end if

		if ik$ = chr$(9) then                 'CTL-I  Invert all colours
			invertcol% = not invertcol%
			decr pal%
			changepalette
		end if

		if ucase$(ik$) = "B" then
			lightback% = not lightback%
			if lightback% then palette 0 , 35 else palette 0 , 0
		end if
		zoom$ = ucase$(ik$)
		if instr(zoom$ , any "IOCLRUD") > 0 then
			redrawflag% = 0 : pan% = 0
			if zoom$ = "I" and boxint% < 12 then
				incr boxint%
				if boxint% = 5 then boxint% = 6
				if boxint% = 7 then boxint% = 12
				redrawflag% = -1
			else
				if zoom$ = "O" and boxint% > 1 then
					decr boxint%
					if boxint% = 5 then boxint% = 4
					if boxint% = 11 then boxint% = 6
					redrawflag% = -1
				else
					if zoom$ = "C" then redrawflag% = -1
				end if
			end if
			if instr(zoom$ , any "LRUD") > 0 then redrawflag% = -1 : pan% = -1
			if not redrawflag% then exit if
			timer off
			reg 1 , 2
			call interrupt &h33    'hide mouse due to cls
			cls
			sqsize% = 240 \ boxint%
			if pan% then
				if zoom$ = "L" then ecentre = ecentre - sqsize% / 2
	    if zoom$ = "R" then ecentre = ecentre + sqsize% / 2
				if zoom$ = "U" then ncentre = ncentre + sqsize% / 2
				if zoom$ = "D" then ncentre = ncentre - sqsize% / 2
			else
				ecentre = me
				ncentre = mn
				ecentre = 10 * (ecentre \ 10)
				ncentre = 10 * (ncentre \ 10)
			end if
			call ENtoNGR(ecentre , ncentre , centrelo$)
			eref% = ecentre - sqsize% \ 2
			nref% = ncentre + (sqsize% - 20) \ 2
			exit loop
		end if

		if left$(ik$ , 1) = chr$(0) then
			ik2$ = right$(ik$ , 1)
			reg 1 , 3
			call interrupt &h33
			select case ik2$
			case "H"
				reg 4 , reg(4) - 2
			case "K"
				reg 3 , reg(3) - 2
			case "M"
				reg 3 , reg(3) + 2
			case "P"
				reg 4 , reg(4) + 2
			case chr$(141)
				reg 4 , reg(4) - 10
			case chr$(145)
				reg 4 , reg(4) + 10
			case chr$(115)
				reg 3 , reg(3) - 10
			case chr$(116)
				reg 3 , reg(3) + 10
			case ";"
				DumpVGAToBmp
			end select
	 reg 1 , 4
			call interrupt &h33
		end if

	loop until ik$ = chr$(27)
loop until ik$ = chr$(27)
end

Sub LocationIn(lo$ , e , n)
	shared sitenames$() , maxcounter%
	lo$ = ucase$(lo$)
	q1$="AA00AA  "
	q2$="RR99XX99"
	q3$="HA000000"
	q4$="YZ999999"
	whichtype%=0:notloc%=0:notngr%=0:found%=0
	for chk%=1 to len(lo$)
		a$=mid$(lo$,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% and notngr%) or len(lo$) < 6 then
		found%=0
		OSITE$=lo$
		searchloop%=0
		for n% = 0 to maxcounter%
			sitename$=sitenames$(n% , 0)
			stloc$=ucase$(sitenames$(n% , 1))
			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 for
			end if
		next n%
		lo$ = stloc$
		if found% = 0 then
			sound 300,1
			print "Not stored"
			end
		else
	print " ";lo$
		end if
	end if
	call GetEN(lo$ , e , n)
end sub

sub GetHeight(ein , nin, h%)
	shared rowdata%()
	'need results in metres!!
	e = ein * 1000
	n = nin * 1000
	n100% = n \ 100000       '100 km row
	e100% = e \ 100000
	n10% = n \ 10000 mod 10
	e10% = e \ 10000 mod 10

	npoint% = n \ 500 mod 20
	epoint% = e \ 500 mod 20

	estart% = rowdata%(n100% , 1)
	filebreak& = rowdata%(n100% , 0) * 1000

	km100sq% = e100% - estart%
	km10sq% = n10% + e10% * 10

	offset10& = km100sq% * 40000  +  km10sq% * 400

	fineoffset% = epoint% + 380 - 20 * npoint%

	offset& = offset10& + fineoffset%
	pointer& = offset& + filebreak&

	if pointer& > 0 then
		seek 1 , pointer&
		get$ 1 , 1 , ch1$
		h% = asc(ch1$)
	end if
end sub

sub ENtoNGR(e,n,ngr$)
	 e1% = e \ 100
	 n1% = n \ 100
	 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% * 100) * 10
	 n2&=(n - n1% * 100) * 10
	 ce$=mid$(STR$(e2&),2)
	 cn$=mid$(STR$(n2&),2)
	 while len(ce$)<3
		ce$="0"+ce$
	 wend
	 while len(cn$)<3
		cn$="0"+cn$
	 wend
	 NGR$=CHR$(C1%)+CHR$(C2%)+CE$+CN$
end sub

sub SetUpPalette
	for a% = 0 to 15
		palette a% , a%
	next a%
end sub

sub ChangePalette
	shared default%() , pal% , invertcol%
	incr pal%
	pal% = pal% mod 5
	for co% = 1 to 15
		select case pal%
		case 2
			r% = co% * 4 + 3
			g% = co% * 4 + 3
			b% = co% * 4 + 3
		case 3
			if co% >= 8 then r% = (co% - 8) * 9
			if co% >= 2 then g% = min((co% - 2) * 6 , 63)
			if co% <= 5 then b% = co% * 10 else b% = max((10 - co%) * 10 , 0)
			if co% >= 12 then b% = (co% - 12) * 18
		case 4
			if co% > 6 then r% = min ((co% - 5) * 8 , 63) else r% = 0
			if co% > 2 then g% = min(co% * 8  , 63)
			if co% > 5 then g% = max((12 - co%) * 6 , 0)
			if co% > 13 then g% = min((co% - 13) * 32 , 63)
			b% = min(co% * 12  , 63)
			if co% > 3 then b% = max((7 - co%) * 5 , 0)
			if co% > 11 then b% = min((co% - 11) * 15 , 63)
		case 0
			if co% > 7 then g% = min ((co% - 6) * 8 , 63) else g% = 0
			if co% > 2 then r% = min(co% * 5  , 63)
			b% = min(co% * 12  , 63)
			if co% > 3 then b% = max((7 - co%) * 5 , 0)
			if co% > 11 then b% = min((co% - 11) * 15 , 63)
		case 1
			read r% , g% , b%
		end select
		reg 1 , &h1010
		reg 2 , co%
		reg 3 , 256 * g% + b%
		reg 4 , r% * 256
		call interrupt &h10
	next co%
	restore paldata
end sub


prop:
	howfar% = (39 * xcount%) \ sqsize%
	locate 12 , 1
	print string$(howfar% + 1 , 219) + string$(79 - howfar% , 176)
return

sub distBear (he , hn , de , dn , dist , bearing)
	shared pi
	x = de - he
	y = dn - hn
	dist = sqr(x * x + y * y)
	if dist = -x then
		angle = pi / 2
	else
		angle = 2 * atn(y / (x + dist))
	end if
	bearing = 90 - angle * 180 / pi
	if bearing < 0 then bearing = bearing + 360
	if bearing > 360 then bearing = bearing - 360
end sub

sub ENtoLoc (e , n , locator$)
	dr = 180 / 3.141593
	T1=(N+5548.79)/6371.28
	T2=2*ATN(EXP((E-400)/6389.7))
	LONG=ATN(-COS(T2)/(COS(T1)*SIN(T2)))-2/DR
	LA=SIN(T1)*SIN(T2)
	LAT=ATN(LA/SQR(1-LA*LA))
	latd = lat*dr
	longd=long*dr
	locator$=chr$(65+int((longd+180)/20))+chr$(65+int((latd+90)/10))+_
	chr$(48+int((longd+180)/2 mod 10))+chr$(48+int((latd+90) mod 10))+_
	chr$(65+int((longd+180)*12 mod 24))+chr$(65+int((latd+90)*24 mod 24))
	locator$ = locator$ + chr$(48+int((longd+180)*120 mod 10))+chr$(48+int((latd+90)*240 mod 10))
end sub

sub GetEN(lo$ , e , n)
	c6% = asc(mid$(lo$ , 6 , 1))
	c5% = asc(mid$(lo$ , 5 , 1))
	if c5% >= 48 and c5% <= 57 then
		HN%=VAL(MID$(lo$,6,3))
		HE%=VAL(MID$(lo$,3,3))
		T1%=ASC(MID$(lo$,1,1))-65:IF T1%>8 THEN T1%=T1%-1
		T2%=ASC(MID$(lo$,2,1))-65:IF T2%>8 THEN T2%=T2%-1
		E = 500 * (T1% MOD 5) + 100 * (T2% MOD 5) - 1000 + HE% / 10
		N = 1900 - 500 * (T1% \ 5) - 100 * (T2% \ 5) + HN% / 10
	else
		if len(lo$) <= 6 then lo$ = lo$ + "55"
		longd=20*(asc(mid$(lo$,1,1))-74)+2*(asc(mid$(lo$,3,1))-48)_
				+(asc(mid$(lo$,5,1))-65)/12 _
				+(asc(mid$(lo$,7,1))-48)/120

		latd= 10*(asc(mid$(lo$,2,1))-74)+asc(mid$(lo$,4,1))-48_
				+(asc(mid$(lo$,6,1))-65)/24_
				+(asc(mid$(lo$,8,1))-48)/240

		DR = 180/3.141592654
		LATR = LATD / DR
		LO = LONGD / DR
		Y = SQR(1 - .00667054# * SIN(LATR) * SIN(LATR))
		N = -100 + 111.0793 * (LATD - 49)
		N = N - 31.947 * SIN((LATD - 49) / DR) * COS(LATR + 49 / DR) + .971 * (2 + LONGD) ^ 2 * SIN(LATR) * COS(LATR) / Y
		E = 400 + 111.2651 * (2 + LONGD) * COS(LATR) / Y
		E = E - .0056 * (2 + LONGD) ^ 3 * (COS(LATR)) ^ 3 * ((TAN(LATR)) ^ 2 - 1)
	end if
end sub

sub showsites
	shared spots%() , plotno% , showsite%
	for zz% = 0 to plotno%
		thisx% = spots%(zz% , 0)
		thisy% = spots%(zz% , 1)
		col% = spots%(zz% , 2)
		if showsite% then col% = 0
		line(thisx% , thisy%) - (thisx% + 1, thisy% + 1) , col% , bf
	next zz%
end sub

sub NearestSite(me , mn , foundname$ , foundloc$)
	shared sitenames$() , maxcounter%
	found%=0
	nearest=9999
	foundname$=""
	for n% = 0 to maxcounter%
		sitename$=sitenames$(n% , 0)
		location$=ucase$(sitenames$(n% , 1))
		call GetEN(location$ , e , n)
		dist = sqr((e - me) ^ 2 + (n - mn) ^ 2)
		if dist <= nearest then
			nearest = dist
			foundname$=sitename$
			foundloc$ = location$
			founde = e
			foundn = n
		end if
	next n%
	me = founde
	mn = foundn               'move mouse to nearest site on return
	sound 5000 , .054
end sub



sub textxy(text$ , x% , y% , colour% , background% , fontno%)
	shared bitpatt$() , maxtext%
	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)
		if xbase% > maxtext% then exit for
		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 DumpVGAToBmp       'Palette table assumes EGA compatibility
	basename$ = "LOCAL"
	filename$ = dir$(basename$ + "???.bmp")
	n% = val(mid$(filename$ , 6, 3))
	do
		f$ = dir$
		n% = max(val(mid$(f$ , 6, 3)) , n%)
	loop until f$ = ""
	n$ = mid$(str$(min(n% + 1, 999)) , 2)
	do while len(n$) < 3
		n$ = "0" + n$
	loop
	f$ = basename$ + n$ + ".BMP"
	line (515 , 93) - (619 , 78) , 15 , b
	call TextXY(f$ , 520 , 90 , 15 , 0 , 2)
	bwidth& = 640           'previously set by   PALETTE CO%,CO%
	bheight& = 480
	ColoursInTable& = 16
	BitsPerPixel% = 4        '1 / 4 / 8 / 24  only
	NPlanes% = 1             '1 only
	InfoSize& = 40

	ImageSize& = bwidth& * bheight& * BitsperPixel% / 8
	dataoffset& = 54 + ColoursInTable& * 4
	filesize& = dataoffset& + ImageSize&

	t = timer
	fi% = freefile
	open "b" , fi% , f$
	i1% = 0 : i2% = 0 : compression& = 0
	bm$ = "BM"
	put$ fi% , bm$
	put fi% , 2 , filesize&
	put fi% ,, i1%
	put fi% ,, i2%
	put fi% ,, DataOffset&
	put fi% ,, InfoSize&
	put fi% ,, bwidth&
	put fi% ,, bheight&
	put fi% ,, NPlanes%
	put fi% ,, BitsPerPixel%
	put fi% ,, compression&
	put fi% ,, ImageSize&
	put fi% ,, XPelsPerMetre&
	put fi% ,, YPelsPerMetre&
	put fi% ,, ColoursInTable&
	put fi% ,, ImportantColours&

	seek fi% , 54
	for rgb% = 0 to 15
		reg 1 , &h1015
		reg 2 , rgb%
		call interrupt &h10
		b% = (reg(3) mod 256) * 4
		g% = (reg(3) \ 256) * 4
		r% = (reg(4) \ 256) * 4
		pa$ = chr$(b%) + chr$(g%) + chr$(r%) + chr$(0)
		put$ fi% , pa$
	next rgb%

	seek fi% , dataoffset&         'data starts at bottom left of picture
	nibble% = 0
	for y% = bheight& - 1 to 0 step -1
		dat$ = ""
		for x% = 0 to bwidth& - 2 step 2
				d% = 16 * point (x% , y%) + point (x% + 1 , y%)
				dat$ = dat$ + chr$(d%)
		next x%
      put$ fi% , dat$
	next y%
	close fi%
	sound 1750 , 2
	line (515 , 95) - (639 , 75) , 0 , bf
end sub

flash:
	flcount% = not flcount%
	if flcount% = 0 then colflash% = colhm% else if colhm% > 10 then colflash% = 0 else colflash% = 15
	line (he% , hn%) - (he% + 1 , hn% + 1) , colflash% , bf
return

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
	close 1
	decr maxcounter%
end sub


