$lib graph on
data 0 , 1 , 10 , 20 , 40 , 60 , 90 , 120 , 150 , 200 , 250
data 300 , 400 , 600 , 800

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 , 2120,0

dim hbreak%(15) , rowdata%(13 , 1) , pa%(95)
pi = 3.141592653589
cls
for hb% = 1 to 15
	read hbreak%(hb%)
next hb%
for rowcount% = 0 to 13
	read rowdata%(rowcount% , 0)
	read rowdata%(rowcount% , 1)
next rowcount%

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
screen 12
open "b" , 1 , f$
if instr(ucase$(command$) , "IM") = 0 then
	input "100 km Northings start            ",nstart%
   input "Pixel resolution      1 or 2 km   ",resolution%
end if
if nstart% > 100 then nstart% = nstart% / 100
if resolution% = 0 then resolution% = 1 : print "1"
resolution% = resolution% * 2
if resolution% = 4 then resuloffset% = 100
ybase% = 475
cls
hei = 5

' palette sets

data 0,8,9,9,27,27,18,18,54,54,36,36,45,45,63,63
data 0,8, 1, 9,25, 3,10,34,28,60,36,52,38,54,55,63
data 0,8,24,16,10,19,6,20,28,37,60,36,52,38,62,63
data 0,7,11,14,17,21,23,29,30,31,32,33,35,40,41,43 'arbitrary set not used elsewhere


for a% = 0 to 63
	read pa%(a%)
next a%

'      remap greys into remaining palette nos used in last set
for i% = 0 to 15
	r% = i% * 4 + 3
	g% = i% * 4 + 3
	b% = i% * 4 + 3
	reg 1 , &h1010
	reg 2 , pa%(i% + 48)
	reg 3 , 256 * g% + b%
	reg 4 , r% * 256
	call interrupt &h10
next i%

cls
changepal
pointer& = rowdata%(nstart% , 0) * 1000
thisdatasize& = pointer&
if resolution% = 4 then numbvert% = 9 else numbvert% = 4
for n100% = nstart% to nstart% + numbvert%
	if n100% > 12 then exit for
	e100% = rowdata%(n100% , 1)       'stored eastings start point
	fileoffset& = thisdatasize&
	thisdatasize& = 1000 * rowdata%(n100% + 1 , 0)
	x100% = 200 * e100%
	y100% = 200 * (n100% - nstart%)
	do while pointer& < thisdatasize&
		en10% = (pointer& - fileoffset&) \ 400
		e10% = en10% \ 10
		n10% = en10% mod 10
		seek 1 , pointer&
		get$ 1 , 800 , ch400$
		for g% = 1 to 400 step resolution%
			h% = asc(mid$(ch400$ , g% , 1))
			col% = 1
			if h% > 0 then col% = 2
			if h% > 6 then col% = 3
			if h% > 10 then col% = 4
			if h% > 16 then col% = 5
			if h% > 22 then col% = 6
			if h% > 30 then col% = 7
			if h% > 38 then col% = 8
			if h% > 45 then col% = 9
			if h% > 55 then col% = 10
			if h% > 66 then col% = 11
			if h% > 75 then col% = 12
			if h% > 94 then col% = 13
			if h% > 127 then col% = 14
			if h% > 158 then col% = 15

			e1% = g% mod 20
			n1% = (g% \ 20) mod 20
			x% = (x100% + e10% * 20 + e1% ) \ resolution% - 40 + resuloffset%
			y% = ybase% - (y100% + n10% * 20 + (20 - n1%)) \ resolution%
			pset (x% , y%) , col%
		next g%
		incr pointer& , 400
		ik$ = ucase$(inkey$)
		if ik$ = chr$(27) then exit for
		if ik$ = "P" then changepal
		if ik$ = "S" then seacolour
		if eof(1) then exit for
	loop
next n100%
for n% = 75 to 475 step 200 / resolution%
	line (-40 + resuloffset%, n%) - (1320 / resolution% + resuloffset% , n%) , 2 ,, &H1111
next n%
for e% = -40 to 1320 / resolution% step 200 / resolution%
	line (e% + resuloffset% , 75) - ( e% + resuloffset% , 475) , 2 ,, &H1111
next e%
reg 1 , 0
call interrupt &h33
reg 1 , 1
call interrupt &h33
locate 1 , 1
print space$(80);
do
	reg 1 , 3
	call interrupt &h33
	mx% = reg (3)
	my% = reg (4)
	me = (mx% + 40 - resuloffset%) * resolution% / 2
	mn = (ybase% - my%) * resolution% / 2 + nstart% * 100
	call WhereAmI (me , mn , ngr$ , locator$)
	locate 1 , 10
	print using "NGR  \      \         Locator  \      \";ngr$,locator$
	ik$ = ucase$(inkey$)
	if ik$ = "P" then changepal
	if ik$ = "S" then seacolour
loop until ik$ = chr$(27)
palette
end

sub changepal
	static whichset%
	shared pa%() , nstart% , resolution% , hbreak%() , sea%
	sea% = 0
	incr whichset% , 16
	whichset% = whichset% mod 64
	if nstart% < 3 or nstart% > 7 then column% = 1 else column% = 73
	if resolution% = 4 then column% = 70
	for a% = 1 to 15
		palette a% , pa%(a% + whichset%)
		color a%
		locate 17 - a% , column%
		print "Û";
		color 15
		print hbreak%(a%)
	next a%
	locate 2 , column% + 6
	print "m";
end sub

sub click
	sound 300 , .05
end sub

sub WhereAmI(e,n,ngr$,locator$)
	dr = 180 / 3.141593
	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$

	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))+_
	chr$(48+int((longd+180)*120 mod 10))+chr$(48+int((latd+90)*240 mod 10))
end sub

sub seacolour
	shared sea%
	if sea% then palette 1, 8 else palette 1 , 0
	sea% = not sea%
end sub