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
dim rowdata%(12 , 1) , co%(12) , palcols%(79) , bitpatt$(3)
pi = 3.141592653589
bf = 2
rf = 2
gf = 2
cls
color 14
print tab(15);"LOCAL HEIGHT MAP FOR VESA BIOS SVGA SYSTEMS ONLY"
color 7
readfonts
for rowcount% = 0 to 12
	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
open "b" , 1 , f$

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

if command$ > "" then
	centrelo$ = command$
else
	locate 3 , 5
	input "Location of centre of plot as NGR , Locator or Sitename   ",centrelo$
end if
locate 5 , 1
print "When plotting is complete use these keys to change  height v colour/brightness -"
print
print tab(5) "R   /  ctrl-R"
print tab(5) "G   /  ctrl-G"
print tab(5) "B   /  ctrl-B"
print
print tab(5) "+ / -"
print tab(5) "X    reset to default"
print tab(5) "M    Mono / Colour

color 7

locate 18 ,1
print "Choose a suitable SVGA (VESA) mode"
print
print tab(20);"1       -         640 x 480       (240 km square)
print tab(20);"2       -         800 x 600       (300 km square)
print tab(20);"3       -        1024 x 768       (384 km square)
print tab(20);"4       -        1280 x 1024      (512 km square)

color 28
locate 23 , 10 : print ">"
color 7
do
	sound 2000 , .1
	while not instat : wend
	vmode% = asc(inkey$)
loop until vmode% > 48 and vmode% < 53
vmode% = vmode% - 49

call SetupVesa(vmode%)
sqsize% = ysize% \ 2
call LocationIn(centrelo$ , ecentre , ncentre)
ebase = ecentre
nbase = ncentre
call ENtoNGR(ebase , nbase , baselo$)
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

xhome% = 2 * (ebase - eref%)
yhome% = 2 * (nref% - nbase)
homeaddr& = xhome% + 10 + (yhome% + 20) * xsize%
markadr& = homeaddr& mod 65536
markpage% = homeaddr& \ 65536

call ENtoNGR(ecentre , ncentre , centrelo$)
t1$ = str$(sqsize%) + "km square
t2$ = "Centre " + centrelo$

def seg = &hA000
reg 1 , &h13
SetUpPalette
call page(0)
call TextXY256(t1$ , ysize% + 35 , 30 , 255 , 0 , vmode% + 2)
call TextXY256(t2$ , ysize% + 35 , 50 , 255 , 0 , vmode% + 2)

call page(0)

for ycount% = 0 to sqsize% step 10
	for xcount% = 0 to sqsize% step 10
		e% = eref% + xcount%
		n% = nref% - ycount%        'count DOWN screen
		e10% = (e% \ 10) mod 10
		n10% = (n% \ 10) mod 10
		e100% = e% \ 100
		n100% = n% \ 100
		estart% = rowdata%(n100% , 1)
		filebreak& = rowdata%(n100% , 0) * 1000
		thisdatasize& = 1000 * rowdata%(n100% + 1 , 0)

		km100sq% = e100% - estart%
		km10sq% = n10% + e10% * 10
		offset10& = km100sq% * 40000  +  km10sq% * 400
		pointer& = offset10& + filebreak&
		if pointer& > thisdatasize& then exit for

		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$)
			e1% = g% mod 20
			n1% = g% \ 20
			x% = (e1% + xcount% * 2)
			y% = (n1% + ycount% * 2)
			fulladr& = x% + 10 + xsize% * y%
			adr& = fulladr& mod 65536
			pageno% = fulladr& \ 65536
			if pageno% <> lastpageno% then
				call page(pageno%)
				lastpageno% = pageno%
			end if
			poke adr& , h%
		next g%
		if inkey$ = chr$(27) then finish
	next xcount%
next ycount%

finish:
call page(markpage%)
basecol% = peek(markadr&)
on timer(.15) gosub flash

call page(0)
for y% = 0 to 255
	for x% = xsize% - 40 to xsize% - 20
		fullpaladr& = x% + (y% + 100) * xsize%
		paladr& = fullpaladr& mod 65536
		palpageno% = fullpaladr& \ 65536
		if palpageno% <> lastpalpage% then
			call page(palpageno%)
			lastpalpag% = palpageno%
		end if
		poke paladr& , 255 - y%
	next x%
next y%

call page(0)
for y% = 0 to 255 step 17
	height = (255 - y%) ^ 1.32
	call TextXY256(using$("####" , height) , xsize% - 80 , y% + 105 , 255 , 0 , vmode% + 1)
next y%

call TextXY256("F1  .BMP File" ,  xsize% - 110 , ysize% - 105 , 128 , 0 , vmode% + 2)
call TextXY256("Change Colours" ,  xsize% - 110 , ysize% - 90 , 255 , 0 , vmode% + 2)
call TextXY256("R / ctl-R" ,  xsize% - 100 , ysize% - 75 , 128 , 0 , vmode% + 2)
call TextXY256("G / ctl-G" ,  xsize% - 100 , ysize% - 60 , 128 , 0 , vmode% + 2)
call TextXY256("B / ctl-B" ,  xsize% - 100 , ysize% - 45 , 128 , 0 , vmode% + 2)
call TextXY256("  + / -  "   ,  xsize% - 110 , ysize% - 30 , 128 , 0 , vmode% + 2)
call TextXY256("(N)ormalise" ,  xsize% - 100 , ysize% - 15 , 128 , 0 , vmode% + 2)
call TextXY256("(P)allete" ,  xsize% - 100 , ysize% , 128 , 0 , vmode% + 2)


timer on
do
	ik$ = ucase$(inkey$)
	select case ik$
	case "R"
		rf = rf * 1.05
		call SetUpPalette
	case chr$(18)
		rf = rf / 1.05
      call SetUpPalette
	case "G"
		gf = gf * 1.05
      call SetUpPalette
	case chr$(7)
		gf = gf / 1.05
      call SetUpPalette
	case "B"
		bf = bf * 1.05
      call SetUpPalette
	case chr$(2)
		bf = bf / 1.05
		call SetUpPalette
	case "+"
		bf = bf * 1.05
		gf = gf * 1.05
		rf = rf * 1.05
      call SetUpPalette
	case "-"
		bf = bf / 1.05
		gf = gf / 1.05
		rf = rf / 1.05
		call SetUpPalette
	case "T"
		incr threshold%
      call SetUpPalette
	case chr$(20)
		decr threshold%
      call SetUpPalette
	case "X" , "N"
		bf = 2
		gf = 2
		rf = 2
		threshold% = 0
		call SetUpPalette
	case "P"
		palset% = (palset% + 1) mod 6
      bf = 2
		gf = 2
		rf = 2
		threshold% = 0
		call SetUpPalette
	case chr$(0 , 59)
		call MakeBMP("LCLVE")
	end select
loop until ik$ = chr$(27)
screen 0 , 0 , 0
end
'=======================================================
flash:
	fc% = (fc% + 1) mod 3
	if fc% = 0 then fcol% = basecol%
	if fc% = 1 then fcol% = 255
	if fc% = 2 then fcol% = 0
	call page(markpage%)
	poke markadr& , fcol%
return

Sub LocationIn(lo$ , e , n)
	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% then
		found%=0
		OSITE$=lo$
		searchloop%=0
		close 3             ' In case
		open "i",3,"sites.dat"
		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)
			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
					basename$ = sitename$
					exit loop
				end if
			loop until eof(3)
		end if
		lo$ = stloc$
		if found%=0 then	sound 300,1 : end
	end if

	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 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
	shared  bf , rf , gf , palset% , threshold%
	out &h3c6 , &hff
	for i% = 1 to 255
		select case palset%
		case 5
			r% = min((i% \ 4) * rf , 63)
			g% = min((i% \ 4) * gf , 63)
			b% = min((i% \ 4) * bf , 63)
		case 1
			if i% * rf > 60 then r% = min ((rf * i% - 60) , 63) else r% = 0
			if i% * gf > 15 then g% = min((gf * i% - 15)  , 63)
			if i% * gf> 120 then g% = max((183 - gf * i%)  , 0)
			if i% * gf> 200 then g% = min((gf * i% - 200) , 63)
			b% = min(bf * i%  , 63)
			if i% * bf> 50 then b% = max((113 - bf * i%) , 0)
			if i% * bf > 180 then b% = min((bf * i% - 180) , 63)
		case 2
			r% = 0
			if i% * rf >= 36 and i% < 144 then r% = min((rf * i% - 36) * 1.5 , 56) else r% = 0
			if i% * rf >= 144 and i% < 180 then r% = 56 - (rf * i% - 144) * 1.5
			if i% * rf >= 216 then r% = min((rf * i% - 216) * 1.5 , 56)
			g% = 0
			if i% * gf >= 108 then g% = min((gf * i% - 108) * 1.3, 50)
			b% = 0
			if i% * bf < 72 then b% = min(bf * i% * 1.6 + 10 , 63)
			if i% * bf >= 72 then b% = max((108 - bf * i%) * 1.75 , 0)
			if i% * bf >= 180 then b% = min((bf * i% - 180) * 1.75 , 63)
		case 3
			if i% * bf < 128 then b% = (128 - i% * bf) / 4 else b% = (i% * bf - 128) / 2
			r% = rf * i% / 2
			g% = gf * i% / 4
		case 4
			b% = bf * (24 - bf * i% \ 4)
			r% = rf * (rf * i% \ 8)
			g% = gf * (gf * i% \ 4)
		case 0
			if i% * rf > 110 then r% = min ((rf * i% - 111) , 63) else r% = 0
			if i% * gf > 40 then g% = min((gf * i% - 40)  , 63)
			if i% * gf > 195 then g% = max((258 - gf * i%)  , 0)
			b% = min((bf * i%) , 63)
			if i% * bf > 63 then b% = max((128 - bf * i%) , 0)
		end select
		r% = r% + threshold%
		g% = g% + threshold%
		b% = b% + threshold%
		if r% < 0 then r% = 0
		if g% < 0 then g% = 0
		if b% < 0 then b% = 0
		if r% > 63 then r% = 63
		if g% > 63 then g% = 63
		if b% > 63 then b% = 63
		out &h3c8 , i%
		out &h3c9 , r%
		out &h3c9 , g%
		out &h3c9 , b%
	next i%
end sub

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

sub page(pageno%)
	shared pageshift%
	reg 1 , &h4f05
	reg 2 , 0
	reg 3 , 0
	reg 4 , pageno% * pageshift%
	call interrupt &h10
end sub

sub SetupVesa (screenmode%)
	shared  xsize% , ysize% , pageshift%
	if screenmode% > 3 then screenmode% = 3
	vidmode% = screenmode% * 2 +  &h0101

	vb$ = string$(300 , "0")
	segment% = strseg(vb$)
	baseadr% = strptr(vb$)

	reg 1 , &h4F00
	reg 6 , baseadr%
	reg 9 , segment%
	call interrupt &h10                         'Get VESA Bios Parameters
	if instr(vb$ , "VESA") = 0 then exit sub
	vesaok% = -1

	if not vesaok% then sound 400 , 1 : print "NO VESA BIOS" : end
	vi$ = string$(300 , "0")
	segment% = strseg(vi$)
	baseadr% = strptr(vi$)
	def seg = segment%

	vi$ = string$(300 , "0")
	segment% = strseg(vi$)
	baseadr% = strptr(vi$)
	reg 1 , &h4F01
	reg 3 , vidmode%
	reg 6 , baseadr%
	reg 9 , segment%
	call interrupt &h10                       ' Get VESA information
	xsize% =(cvi(mid$(vi$ , 19 , 2)))
	ysize% =(cvi(mid$(vi$ , 21 , 2)))
	Gran% = cvi(mid$(vi$ , 5 , 2))
	Windowsize% = cvi(mid$(vi$ , 7 , 2))
	pageshift% = windowsize% \ gran%
	reg 1 , &h4f02
	reg 2 , vidmode%
	call interrupt &h10                       ' Set Actual mode and go.
end sub

$include "\pb3\library\txtxy256"

sub MakeBMP(basename$)
	shared  xsize% , ysize%
	timer off
	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"
	call TextXY256(f$ + " " ,  xsize% - 110 , ysize% - 105 , 128 , 0 , vmode% + 2)
	bwidth& = xsize%
	bheight& = ysize%
	ColoursInTable& = 256
	BitsPerPixel% = 8        '1 / 4 / 8 / 24  only
	NPlanes% = 1             '1 only
	InfoSize& = 40
	ImageSize& = bwidth& * bheight& * BitsperPixel% / 8
	dataoffset& = 62 + ColoursInTable& * 4
	filesize& = dataoffset& + ImageSize&
	fino% = freefile
	open "b" , fino% , f$
	bm$ = "BM"
	put$ fino% , bm$
	put fino% , 2 , filesize&
	put fino% ,, i1%
	put fino% ,, i2%
	put fino% ,, DataOffset&
	put fino% ,, InfoSize&
	put fino% ,, bwidth&
	put fino% ,, bheight&
	put fino% ,, NPlanes%
	put fino% ,, BitsPerPixel%
	put fino% ,, compression&
	put fino% ,, ImageSize&
	put fino% ,, XPelsPerMetre&
	put fino% ,, YPelsPerMetre&
	put fino% ,, ColoursInTable&
	put fino% ,, ImportantColours&
	seek fino% , 54
	for c% = 0 to coloursintable& - 1
		reg 1 , &h1015
		reg 2 , c%
		call interrupt &h10
		g% = reg(3) \ 256
		b% = reg(3) mod 256
		r% = reg(4) \ 256
		cd$ = chr$(4 * b%) + chr$(4 * g%) + chr$(4 * r%) + chr$(0)
		put$ fino% , cd$
	next c%
	seek fino% , dataoffset&      'data starts at bottom left of picture
	for linecount% = ysize% - 1 to 0 step -1
		ad& = linecount% * xsize%
		pageno% = ad& \ 65536
		call page(pageno%)
		subad& = ad& mod 65536
		if subad& >= (65536 - xsize%) then
			dat$ = peek$(subad& , 65536 - subad&)
			call page(pageno% + 1)
			dat$ = dat$ + peek$(0 , xsize% - 65536 + subad&)
		else
			dat$ = peek$(subad& , xsize%)
		end if
		put$ fino% , dat$
	next linecount%
	close fino%
	sound 1750 , 2
   call TextXY256("F1  .BMP File" ,  xsize% - 110 , ysize% - 105 , 128 , 0 , vmode% + 2)
	timer on
end sub

