NGRCalc.bbc

10 REM > NGRCalc 1.03

20 REM

30 REM 28-Feb-1997 v1.00 Program written by Len Killip, G0APZ, for his own interest.

40 REM

50 REM 15-Oct-1999 v1.01 JGH: Tidied output slightly, QUITs on exit if possible,

60 REM windows not defined

70 REM 18-Apr-2009 v1.02 JGH: UTM grid for Channel Islands, command line access

80 REM 25-Jun-2009 v1.03 JGH: Works in interactive mode on Windows

90 REM Note: Some issues on SDL and Brandy

100 REM

110 REM Len's original comments

120 REM -----------------------

130 REM This program converts National Grid References to latitude and

140 REM longitude, and calculates the deviation between true north and grid

150 REM north.

160 REM

170 REM Also the reverse, lat and long to easting and northing and NGR.

180 REM Also the bearing and distance between NGRs.

190 REM The "mathematical engine" is derived from the Ordnance Survey

200 REM "Geodetic Information Paper No 1: 2/1996 (Version 2.0)

210 REM 10 and 8 figure as well as 6 figure NGRs may be entered. Also

220 REM Eastings and Northings (to nearest millimetre if desired!).

230 REM Using OS worked examples, eastings and northings entered directly

240 REM to the nearest millimetre(!) result agrees to within 0.0004

250 REM seconds lat. and is exact to four decimal places of seconds long.

260 REM (Exact to four decimal places in both cases using BASIC VI).

270 REM Deviation checks correct at sheet corners, and exact at Caister.

280 REM Bearings checked on p19 Fram to Caister 7.488 seconds v. 7.487

290 REM Caister to Fram 10.833 seconds v. 10.832. I'll settle for these!

300 REM Scale factor for mid-point of that line also checks.

310 :

320 A$=FNOS_GetEnv:ver$="1.03":IF os%=32 THEN *FLOAT 64

330 IF A$<>"":PROCcmd(A$):PROCexit(0)

340 IF os%=32:SYS "ShowWindow",@hwnd%,3:PROC_setfocus(@hwnd%)

350 :

360 MODE 27+128

370 PROCborder

380 ON ERROR PROCerror

390 :

400 PROCconstants_OSGB

410 :

420 repeat=TRUE

430 REPEAT

440 PROCchoice1

450 UNTILrepeat<>TRUE

460 END

470 :

480 DEFPROCchoice1

490 CLS:PRINT'TAB(15)"GRID REFERENCE CONVERTOR"'TAB(15)STRING$(24,"=")'

500 PRINTTAB(18)"CURRENT GRID: ";grid$''

510 PRINTTAB(5)"(A) CONVERT GRID REFERENCE TO LATITUDE AND LONGITUDE"'

520 PRINTTAB(5)"(B) BEARING AND DISTANCE BETWEEN TWO POINTS"'

530 PRINTTAB(5)"(C) CONVERT LATITUDE AND LONGITUDE TO GRID REFERENCE"'

540 PRINTTAB(5)"(D) SELECT A BASE GRID"'

550 PRINTTAB(5)"(E) EXIT"'

560 PRINTTAB(5)"Press a key:";

570 CASE FNanswer("ABCDE") OF

580 WHEN 1

590 latlongrepeat=TRUE

600 WHILE latlongrepeat=TRUE

610 CLS:PRINT''

620 PROClatlong

630 ENDWHILE

640 WHEN 2

650 bdrepeat=TRUE

660 WHILE bdrepeat=TRUE

670 CLS:PRINT''

680 PROC_bd

690 ENDWHILE

700 WHEN 3

710 lltongr=TRUE

720 WHILE lltongr=TRUE

730 CLS:PRINT''

740 PROC_lltongr

750 ENDWHILE

760 WHEN 4

770 PROCchoosegrid

780 WHEN 5

790 PRINT:quit%=TRUE:ON ERROR quit%=FALSE

800 IFquit%:QUIT

810 END

820 ENDCASE

830 ENDPROC

840 :

850 DEFPROCchoosegrid

860 PRINT''TAB(5)"SELECT GRID:"'

870 PRINTTAB(5)"(A) OSGB - Great Britain & Isle of Man"

880 PRINTTAB(5)"(B) UTM - Channel Islands"

890 PRINTTAB(5)"(C) ITM - Ireland (new grid)"

900 PRINTTAB(5)"(D) OSI - Ireland (old grid)"

910 PRINT'TAB(5)"Press a key:";

920 CASE FNanswer("ABCD") OF

930 WHEN 1:PROCconstants_OSGB

940 WHEN 2:PROCconstants_UTM

950 WHEN 3:PROCconstants_ITM

960 WHEN 4:PROCconstants_OSI

970 ENDCASE

980 ENDPROC

990 :

1000 DEFPROClatlong

1010 PROCchoice2

1020 CLS:PRINT''

1030 PRINT TAB(10)"GRID REFERENCE: "G$'

1040 PROC_Mvrho(E,N)

1050 PROC_toll

1060 PROC_C_EN

1070 PROCoutput(lambda,phi,C):PROClldisplay

1080 PRINT 'TAB(10) "Do you want another Lat Long calculation? Y/N";

1090 IF FNanswer("YN")<>1 latlongrepeat=FALSE

1100 ENDPROC

1110 :

1120 DEFPROC_bd

1130 PRINT TAB(20)"FIRST POSITION"'

1140 PROCchoice2

1150 E1=E:N1=N

1160 PROC_Mvrho(E1,N1):y1%=y:F1=F

1170 PROC_toll

1180 PROC_C_EN

1190 PRINT TAB(20)"SECOND POSITION"'

1200 PROCchoice2

1210 E2=E:N2=N

1220 PROC_Mvrho(E2,N2):y2%=y:F2=F

1230 PROC_toll

1240 CASE N2 OF

1250 WHEN N1

1260 alpha=PI/2

1270 OTHERWISE

1280 alpha=ATN((E2-E1)/(N2-N1))

1290 ENDCASE

1300 CASE E2 OF

1310 WHEN E1

1320 alpha=0

1330 ENDCASE

1340 IF N2<N1 alpha=alpha+PI:ENDIF

1350 IF E2<E1 THEN

1360 IF N2>N1 THEN

1370 alpha=alpha+2*PI

1380 ENDIF

1390 ENDIF

1400 Nm=(N1+N2)/2:q=N1-N2:Em=(E1+E2)/2

1410 IF y1%<0 EOR y2%<0 THEN

1420 PROCalphasplit

1430 ELSE

1440 PROC_converge

1450 ENDIF

1460 PROC_distance

1470 PROC_bd_output

1480 PRINT TAB(15)"Another bearing/dist calculation? Key Y/N";

1490 IF FNanswer("YN")<>1 bdrepeat=FALSE

1500 ENDPROC

1510 :

1520 DEFPROC_lltongr

1530 PRINT TAB(15)"Enter latitude north in form deg, min, sec"'

1540 INPUT TAB(15)deg%, min%,sec':degN=deg%:minN=min%:secN=sec

1550 PRINT TAB(15)"Enter longitude in form deg, min, sec, E/W"'

1560 INPUT TAB(15)deg%, min%, sec,ew$':degE=deg%:minE=min%:secE=sec

1570 PROC_lltoEN:CLS:PRINT''TAB(15)"Easting= ";E;" Northing= ";N'

1580 PRINT TAB(15) "Latitude "; degN; " Degs "; minN; " Mins "; secN;

1590 PRINT " Secs North"'

1600 PRINT TAB(15) "Longitude "; degE; " Degs "; minE; " Mins "; secE;

1610 PRINT " Secs "; ew$'

1620 PROC_ENtongr(E,N)

1630 PROC_ngrdisplay

1640 ENDPROC

1650 :

1660 DEFPROC_lltoEN

1670 REM On entry, degN, minN, secN = latitude north

1680 REM degE, minE, secE, ew$ = longitude west/east

1690 phi=FNconvert(degN,minN,secN):phi=RAD(phi)

1700 v=FNA(phi):rho=FNB(phi):itasqd=v/rho-1

1710 lambda=FNconvert(degE, minE, secE):lambda=RAD(lambda)

1720 ew$=LEFT$(ew$,1):IF ew$="W" OR ew$="w" THEN lambda=-lambda:ew$="West" ELSE ew$="East"

1730 P=lambda-lambda0:phip=phi

1740 M=FNM(b,n,phip,phi0)

1750 I=M+N0

1760 II=(v/2)*SIN(phi)*COS(phi)

1770 III=(v/24)*SIN(phi)*(COS(phi))^3*(5-(TAN(phi))^2+9*itasqd)

1780 IIIA=(v/720)*SIN(phi)*(COS(phi)^5)*(61-58*(TAN(phi)^2)+(TAN(phi)^4))

1790 N=I+P^2*II+P^4*III+P^6*IIIA

1800 IV=v*COS(phi)

1810 V=(v/6)*(COS(phi))^3*(v/rho-(TAN(phi)^2))

1820 VI=(v/120) * (COS(phi)^5)

1830 VI=VI*(5-18*(TAN(phi)^2)+(TAN(phi)^4)+14*itasqd-58*(TAN(phi)^2)*itasqd)

1840 E=E0+P*IV+P^3*V+P^5*VI

1850 ENDPROC

1860 :

1870 DEFPROC_ENtongr(E,N)

1880 IFgrid$="ITM":E=E+100000

1890 IF E<0:E=E+.1:REM IF E<0 E=E-1

1900 IF N<0:N=N+.1:REM IF N<0 N=N-1

1910 PROCen_string(E)

1920 east$=en$

1930 PROCen_string(N)

1940 north$=en$

1950 :

1960 PROCgrid_letters

1970 :

1980 easting$=RIGHT$(east$,5): northing$=RIGHT$(north$,5)

1990 IF E<0 THEN

2000 easting$=RIGHT$(STR$(1000000-VAL(MID$(east$,2))),5)

2010 ENDIF

2020 IF N<0 THEN

2030 northing$=RIGHT$(STR$(500000-VAL(MID$(north$,2))),5)

2040 ENDIF

2050 NGR$=A$+B$+easting$+northing$

2060 ENDPROC

2070 :

2080 DEFPROC_ngrdisplay

2090 PRINT TAB(15)"10-digit National Grid Reference is ";NGR$'

2100 PROCcurtail(easting$)

2110 easting$=en$

2120 PROCcurtail(northing$)

2130 northing$=en$

2140 NGR$=A$+B$+easting$+northing$

2150 PRINT TAB(15)"6-digit National Grid Reference is ";NGR$'

2160 PRINT TAB(15)"4-digit National Grid Reference is ";LEFT$(NGR$,4);MID$(NGR$,6,2)'

2170 :

2180 PRINT 'TAB(15)"Another lat/long to NGR calculation? Key Y/N";

2190 :

2200 IF FNanswer("YN")<>1 lltongr=FALSE

2210 ENDPROC

2220 :

2230 DEFPROCcurtail(EN$)

2240 en%=INT(VAL(EN$)/100)

2250 en$=RIGHT$("0000"+STR$(en%),3)

2260 ENDPROC

2270 :

2280 DEFPROCchoice2

2290 PRINT TAB(15)"DO YOU WISH TO ENTER AS"'

2300 PRINT TAB(15)"(A) NATIONAL GRID REFERENCE, OR"'

2310 PRINT TAB(15)"(B) EASTING AND NORTHING?"'

2320 PRINT TAB(15)"KEY A OR B"'

2330 CASE FNanswer("AB") OF

2340 WHEN 1

2350 PRINT TAB(2)"Enter the NGR, with grid letters, in 10, 8, 6 or 4 ";

2360 PRINT "numeral form "'

2370 INPUT TAB(15) G$'

2380 PROCngr

2390 WHEN 2

2400 PRINT TAB(10) "ENTER FULL EASTING AND NORTHING, IN FORM E,N"'

2410 PRINT TAB(5 ) "(six or seven figures in each, plus decimals if need be)"'

2420 INPUT TAB(20) E,N'

2430 G$=STR$E+","+STR$N

2440 ENDCASE

2450 ENDPROC

2460 :

2470 REM This puts NGR into easting and northing

2480 DEFPROCngr

2490 IF (LEN G$ AND 1)=1:G$="I"+G$

2500 IF LEFT$(G$,1)>"`":G$=CHR$(ASCG$-32)+MID$(G$,2)

2510 IF MID$(G$,2,1)>"`":G$=LEFT$(G$,1)+CHR$(ASCMID$(G$,2)-32)+MID$(G$,3)

2520 PROCconstants_OSGB

2530 IF LEFT$(G$,1)="I":PROCconstants_ITM

2540 IF LEFT$(G$,1)="W":PROCconstants_UTM

2550 :

2560 X% = (LEN(G$) - 2) / 2

2570 Y% = 10^(5-X%)

2580 X$ = LEFT$(G$, 1): Y$ = MID$(G$, 2, 1)

2590 E = VAL(MID$(G$, 3, X%)) * Y%: N = VAL(RIGHT$(G$, X%)) * Y%

2600 IF LEFT$(G$,1)="W" THEN

2610 a%=ASCMID$(G$,2,1)AND&DF:IFa%=ASC"A":a%=ASC"W"

2620 N=N+(a%-32)*100000:E=E+500000

2630 ELSE

2640 PROC_div(X$,500000,2,4)

2650 PROC_div(Y$,100000,0,5)

2660 IF LEFT$(G$,1)="I" THEN

2670 IF grid$="OSI":E=E-500000:N=N-1000000

2680 IF grid$="ITM":E=E-100000:N=N-500000

2690 ENDIF

2700 ENDIF

2710 :

2720 ENDPROC

2730 :

2740 REM columns count from 0 to 4 from left, rows 1 to 5 from top.

2750 DEFPROC_div(Q$,m%,c%,r%)

2760 a%=(ASC(Q$) AND &DF)-ASC("A")+5: IF a%>13 THEN a%=a%-1

2770 row%=a% DIV 5: column%=a% MOD 5

2780 E=E+(column%-c%)*m% : N=N+(r%-row%)*m%

2790 ENDPROC

2800 :

2810 DEFFNA(phip)=a/SQR(1-esqd*(SIN(phip))^2) :REM rad of curv of lat at lat phip

2820 DEFFNB(phip)=v*(1-esqd)/(1-esqd*(SIN(phip))^2) :REM same for long at lat phip

2830 :

2840 DEFFNM(b,n,phip,phi0)=b*(((1+n+(5/4)*n^2+(5/4)*n^3)*(phip-phi0))-((3*n+3*n^2+(21/8)*n^3)*SIN(phip-phi0)*COS(phip+phi0))+(((15/8)*n^2+(15/8)*n^3)*SIN(2*(phip-phi0))*COS(2*(phip+phi0)))-((35/24)*n^3*SIN(3*(phip-phi0))*COS(3*(phip+phi0))))

2850 tmp=b * (((1+n+(5/4)*n^2+(5/4)*n^3)*(phip-phi0))-((3*n+3*n^2+(21/8)*n^3)*SIN(phip-phi0)*COS(phip+phi0))+(((15/8)*n^2+(15/8)*n^3)*SIN(2*(phip-phi0))*COS(2*(phip+phi0)))-((35/24)*n^3*SIN(3*(phip-phi0))*COS(3*(phip+phi0))))

2860 =tmp

2870 :

2880 REM This takes easting and northing, does iteration for M, returns phip,

2890 REM v, rho, y, and itasqd.

2900 :

2910 DEFPROC_Mvrho(E,N)

2920 y=E-E0

2930 phip=(N-N0)/a+phi0

2940 M=FNM(b,n,phip,phi0)

2950 REPEAT

2960 phin=(N-N0-M)/a+phip

2970 phip=phin

2980 M=FNM(b,n,phip,phi0)

2990 UNTIL ABS(N-N0-M)<.0015

3000 :

3010 v=FNA(phip)

3020 rho=FNB(phip)

3030 itasqd=v/rho-1

3040 PROC_F

3050 ENDPROC

3060 :

3070 REM This contains equations leading to phi, lambda. For equation IX I

3080 REM need to divide (720*rho*v^5) by v^2 to get within range, which

3090 REM multiplies IX by v^2. So then divide IX by v^2. Similarly for XIIA;

3100 REM v^7 outside number range. In XIIA reduce v^7 to v^3 and divide XIIA

3110 REM by v^4

3120 :

3130 DEFPROC_toll

3140 VII=TAN(phip)/(2*rho*v)

3150 VIII=(TAN(phip)/(24*rho*v^3))*(5+3*TAN(phip)^2+itasqd-9*TAN(phip)^2*itasqd)

3160 IX= (TAN(phip)/(720*rho*v^3))*(61+90*TAN(phip)^2+45*TAN(phip)^4)

3170 IX=IX/v^2

3180 phi=phip-y^2*VII+y^4*VIII-y^6*IX

3190 X=1/(v*COS(phip))

3200 XI=1/(6*v^3*COS(phip))*(v/rho+2*(TAN(phip))^2)

3210 XII=(1/(120*v^5*COS(phip)))*(5+28*(TAN(phip))^2+24*(TAN(phip))^4)

3220 XIIA=(1/(5040*v^3*COS(phip)))*(61+662*(TAN(phip))^2+1320*(TAN(phip))^4+720*(TAN(phip))^6)

3230 XIIA=XIIA/v^4

3240 lambda=lambda0+y*X-y^3*XI+y^5*XII-y^5*XIIA*y^2

3250 P=lambda-lambda0

3260 ENDPROC

3270 :

3280 REM This derives deviation (C) between true north and grid north from

3290 REM phi and lambda (PROC_toll) and itasqd (PROC_Mvrho). When C is

3300 REM negative, true N is East of grid north.

3310 DEFPROC_C

3320 XIII=SIN(phi)

3330 XIV=((SIN(phi)*(COS(phi))^2)/3)*(1+3*itasqd+2*itasqd^2)

3340 XV=((SIN(phi)*(COS(phi))^4)/15)*(2-(TAN(phi))^2)

3350 C=(P*(XIII)+P^3*(XIV)+P^5*(XV))

3360 ENDPROC

3370 :

3380 REM This derives deviation (C) from E and N

3390 DEFPROC_C_EN

3400 XVI=TAN(phip)/v

3410 XVII=TAN(phip)/(3*v^3)*(1+TAN(phip)^2-itasqd-2*itasqd^2)

3420 XVIII=TAN(phip)/(15*v^5)*(2+5*TAN(phip)^2+3*TAN(phip)^4)

3430 C=y*XVI-y^3*XVII+y^5*XVIII

3440 ENDPROC

3450 :

3460 DEFPROCoutput(lambda,phi,C)

3470 lambda=DEG(lambda): phi=DEG(phi)

3480 ew$ = "East"

3490 IF lambda <=0:ew$="West":lambda=-lambda

3500 PROCdegminsec(phi)

3510 degN=deg: minN=min: secN=sec

3520 PROCdegminsec(lambda)

3530 degE=deg: minE=min: secE=sec

3540 ENDPROC

3550 :

3560 DEFPROClldisplay

3570 PRINT TAB(10) "The Latitude is "; degN; " Degs "; minN; " Mins "; secN;

3580 PRINT " Secs North"'

3590 PRINT TAB(10) "The Longitude is "; degE; " Degs "; minE; " Mins "; secE;

3600 PRINT " Secs "; ew$'

3610 C=DEG(C)

3620 IF C>0 C$="West" ELSE C$="East": C=-C

3630 PROCdegminsec(C)

3640 PRINT TAB(10) "True North is ";deg " Degs ";min " Mins ";sec;" Secs ";C$;" of grid North"'

3650 PRINT TAB(10) "easting= ";E;" northing=";N'

3660 ENDPROC

3670 :

3680 DEFPROC_bd_output

3690 G=DEG(alpha)

3700 PROCdegminsec(G)

3710 PROCnumplace(sec," ")

3720 sec=num

3730 PRINT TAB(15)"Grid bearing is ";deg" deg ";min" min ";sec" sec"'

3740 IF C<0 AND alpha<=ABS(C) THEN alpha=alpha+2*PI

3750 TBg=DEG(alpha+C-convangle)

3760 PROCdegminsec(TBg)

3770 PROCnumplace(sec," ")

3780 sec=num

3790 PRINT TAB(15)"True bearing is ";deg;" deg ";min" min ";sec" sec"'

3800 PROCnumplace(s," ")

3810 s=num

3820 PRINT TAB(15)"Grid distance is ";s;" metres"'

3830 PROCnumplace(dist," ")

3840 dist=num

3850 PRINT TAB(15)"True distance is ";dist;" metres"'

3860 PRINT TAB(20)"Print vars? Y/N";

3870 IF FNanswer("YN")=1 PROC_variables

3880 ENDPROC

3890 :

3900 DEFPROCerror

3910 IF ERR=17 THEN ENDPROC:REM REPORT:PRINT:END

3920 REM IF ERL<>1240 THEN REPORT:PRINT" at line ";ERL

3930 PRINT

3940 PRINT TAB(13)"Press any key";

3950 REPEAT UNTIL GET

3960 ENDPROC

3970 :

3980 REM This draws yellow border, with blue background

3990 DEFPROCborder

4000 VDU19,0,4,0,0;19,3,3,0,0; :REM select yellow/blue

4010 MOVE 0,0:DRAW 0,959:DRAW 1279,959 :REM draw border

4020 DRAW 1279,0:DRAW 0,0 :REM draw border

4030 REM VDU 28,4,58,78,4 :REM set up text window

4040 REM VDU 24,10;10;1269;949; :REM set up graphics window

4050 ENDPROC

4060 :

4070 DEFFNanswer(alternatives$)

4080 *FX 15,1

4090 REPEAT

4100 A%=INSTR(alternatives$, CHR$(GET AND &DF))

4110 UNTIL A%>0

4120 =A%

4130 :

4140 REM converts decimal degrees to degrees, minutes, seconds

4150 DEFPROCdegminsec(theta)

4160 ang=theta*3600+0.0005 : sec=(ang*1000)MOD60000 /1000

4170 deg=ang DIV60 : min=deg MOD60 : deg=deg DIV60

4180 ENDPROC

4190 :

4200 REM removes last j$ sig figs.Pass space string to j$

4210 DEFPROCnumplace(Y,j$)

4220 num$=STR$(Y)

4230 RIGHT$(num$)=j$

4240 num=VAL(num$)

4250 ENDPROC

4260 :

4270 REM Corrects for convergence as in navigation,and checks with OS calc page 18

4280 DEFPROC_converge

4290 f=2*y1%+y2%

4300 PROC_Mvrho(E1,Nm)

4310 XXIII=1/(6*rho*v)

4320 convangle=(f*q*XXIII)

4330 ENDPROC

4340 :

4350 REM Case when E1 and E2 opposite sides central meridian. Nc is point of

4360 REM crossing central meridian

4370 DEFPROCalphasplit

4380 ratio=ABS((y1%)/(E2-E1))

4390 Nc=N1+ratio*(N2-N1)

4400 Nm1=(Nc+N1)/2: Nm2=(Nc+N2)/2

4410 Nm=Nm1: y2%=0: q=N1-Nc

4420 PROC_converge

4430 convangle1=convangle

4440 Nm=Nm2:y1%=0:y2%=E2-E0:q=Nc-N2

4450 PROC_converge

4460 convangle2=convangle

4470 convangle=convangle1+convangle2

4480 ENDPROC

4490 :

4500 DEFPROC_F

4510 XXI=1/(2*rho*v)

4520 XXII=(1-4*itasqd)/(24*rho^2*v^2)

4530 F=F0*(1+y^2*XXI+y^4*XXII)

4540 ENDPROC

4550 :

4560 REM s is grid distance; dist is True distance

4570 DEFPROC_distance

4580 s=SQR((E2-E1)^2+(N2-N1)^2)

4590 PROC_Mvrho(Em,Nm):Fm=F

4600 X=(1/6)*(1/F1+4/Fm+1/F2)

4610 F=1/X

4620 dist=s/F

4630 ENDPROC

4640 :

4650 DEFPROC_variables

4660 PRINT"F= ";F

4670 PRINT"phip= ";phip

4680 PRINT"v= ";v

4690 PRINT"rho= ";rho

4700 PRINT"itasqd= ";itasqd

4710 PRINT"M= ";M

4720 PRINT"y= ";y

4730 PRINT"VII= ";VII

4740 PRINT"VIII= ";VIII

4750 PRINT"IX= ";IX

4760 PRINT"X= ";X

4770 PRINT"XI= ";XI

4780 PRINT"XII= ";XII

4790 PRINT"XIIA= ";XIIA

4800 PRINT"XIII= ";XIII

4810 PRINT"XIV= ";XIV

4820 PRINT"XV= ";XV

4830 PRINT"XXI= ";XXI

4840 PRINT"XXII= ";XXII

4850 PRINT"XXIII= ";XXIII

4860 ENDPROC

4870 :

4880 DEFFNconvert(deg,min,sec)=(min*60+sec)/3600+deg

4890 :

4900 DEFPROCgrid_letters

4910 IF grid$="OSGB" THEN

4920 PROCfirst_letter(east$,north$) :A$=CHR$(a%)

4930 PROCsecond_letter(east$,north$):B$=CHR$(a%)

4940 ENDPROC

4950 ENDIF

4960 IF grid$="OSI" THEN

4970 PROCfirst_letter(east$,north$) :A$=CHR$(a%):A$="I"

4980 PROCsecond_letter(east$,north$):B$=CHR$(a%)

4990 ENDPROC

5000 ENDIF

5010 IF grid$="ITM" THEN

5020 PROCfirst_letter(east$,north$) :A$=CHR$(a%):A$="I"

5030 PROCsecond_letter(east$,north$):B$=CHR$(a%)

5040 ENDPROC

5050 ENDIF

5060 IF grid$="UTM" THEN

5070 A$=CHR$(ASCLEFT$(north$,1)+34)

5080 B$=CHR$(VALLEFT$(north$,2)+32)

5090 IF B$>"V":B$=CHR$(VALLEFT$(north$,2)+10)

5100 north$=MID$(north$,2)

5110 ENDPROC

5120 ENDIF

5130 A$="?":B$="?"

5140 ENDPROC

5150 :

5160 DEFPROCfirst_letter(E$,N$)

5170 column=0:row=0

5180 PROCcolumn_row(E$)

5190 IF E<0 THEN

5200 column=init DIV 5 + 2

5210 ELSE

5220 column=init DIV 5 + 3

5230 ENDIF

5240 PROCcolumn_row(N$)

5250 IF N<0 THEN

5260 row=4

5270 ELSE

5280 row=3-init DIV 5

5290 ENDIF

5300 PROCread_letter

5310 ENDPROC

5320 :

5330 DEFPROCsecond_letter(E$,N$)

5340 PROCcolumn_row(E$)

5350 IF E<0 THEN

5360 column=5+init MOD 5

5370 ELSE

5380 column=1+init MOD 5

5390 ENDIF

5400 PROCcolumn_row(N$)

5410 IF N<0 THEN

5420 init=init+.1:N=N-.1

5430 IF RIGHT$(STR$INTN,2)<>"00":init=init-.1

5440 row= -init MOD 5

5450 ELSE

5460 row=4-init MOD 5

5470 ENDIF

5480 PROCread_letter

5490 ENDPROC

5500 :

5510 REM "column_row" returns the initial one or two numbers, with "-"

5520 REM if present, as "init".

5530 :

5540 DEFPROCcolumn_row(EN$)

5550 neg$=LEFT$(EN$,1)

5560 M%=LEN(EN$)

5570 IF neg$="-" THEN

5580 IF M% =8 THEN

5590 PROCleft(EN$,3)

5600 ENDIF

5610 IF M% =7 THEN

5620 PROCleft(EN$,2)

5630 ENDIF

5640 ELSE

5650 IF M%=7 THEN

5660 PROCleft(EN$,2)

5670 ENDIF

5680 IF M%=6 THEN

5690 PROCleft(EN$,1)

5700 ENDIF

5710 ENDIF

5720 ENDPROC

5730 :

5740 REM Preserves leading zeros, and repositions "-" when necessary.

5750 DEFPROCen_string(EN)

5760 EN$=STR$(INT((EN+0.5)*10/10))

5770 L%=LEN(EN$)

5780 IF EN<0 THEN

5790 L%=L%-1

5800 neg$="-"

5810 IF L%>7 THEN

5820 EN$=RIGHT$(EN$,7)

5830 en$=RIGHT$("0000000"+EN$,7)

5840 ELSE

5850 EN$=RIGHT$(EN$,L%)

5860 en$=RIGHT$("000000"+EN$,6)

5870 ENDIF

5880 en$=("-"+en$)

5890 ENDIF

5900 IF EN>=0 THEN

5910 IF L%>6 THEN

5920 en$=RIGHT$("0000000"+EN$,7)

5930 ELSE

5940 en$=RIGHT$("000000"+EN$,6)

5950 ENDIF

5960 ENDIF

5970 ENDPROC

5980 :

5990 DEFPROCleft(x$,y)

6000 IF VAL(x$)<0 THEN y=2

6010 init=VAL(LEFT$(x$,y))

6020 ENDPROC

6030 :

6040 DEFPROCread_letter

6050 a%=5*row+column

6060 IF a%<9 a%=a%-1

6070 a%=a%+65

6080 ENDPROC

6090 :

6100 DEFPROCconstants_OSGB

6110 E0=400000: N0=-100000 : REM grid coords of True origin

6120 phi0=RAD(49) : REM latitude of True origin

6130 lambda0=RAD(-2) : REM longitude of True origin (West -)

6140 F0=0.9996012717 : REM scale on central meridian

6150 a=6375020.481 : REM semi-major axis in metres scaled by F0

6160 b=6353722.490 : REM semi-minor similarly scaled

6170 esqd=0.006670539762 : REM e is eccentricity

6180 n=(a-b)/(a+b) : REM 0.001673220250 : REM n is (a-b)/(a+b)

6190 east%=0:grid$="OSGB"

6200 ENDPROC

6210 :

6220 DEFPROCconstants_OSI

6230 E0=200000: N0=250000 : REM grid coords of True origin

6240 phi0=RAD(53.50) : REM latitude of True origin

6250 lambda0=RAD(-8) : REM longitude of True origin (West -)

6260 F0=1.000035 : REM scale on central meridian

6270 a=6377563.395906615 : REM semi-major axis in metres scaled by F0

6280 b=6356256.908205645 : REM semi-minor similarly scaled

6290 esqd=0.00667054015 : REM e is eccentricity

6300 n=(a-b)/(a+b) : REM n is (a-b)/(a+b)

6310 east%=0:grid$="OSI"

6320 ENDPROC

6330 :

6340 DEFPROCconstants_ITM

6350 E0=600000: N0=750000 : REM grid coords of True origin

6360 phi0=RAD(53.50) : REM latitude of True origin

6370 lambda0=RAD(-8) : REM longitude of True origin (West -)

6380 F0=0.999820 : REM scale on central meridian

6390 a=6376988.93534 : REM semi-major axis in metres scaled by F0

6400 b=6355608.0987234548 : REM semi-minor similarly scaled

6410 esqd=0.00669438002301 : REM e is eccentricity

6420 n=(a-b)/(a+b) : REM n is (a-b)/(a+b)

6430 east%=0:grid$="ITM"

6440 ENDPROC

6450 :

6460 DEFPROCconstants_UTM

6470 E0=500000: N0=0 : REM grid coords of True origin

6480 phi0=RAD(0) : REM latitude of True origin

6490 lambda0=RAD(-3) : REM longitude of True origin (West -)

6500 F0=0.9996 : REM scale on central meridian

6510 a=6378388.000 : REM semi-major axis in metres scaled by F0

6520 b=6356911.946 : REM semi-minor similarly scaled

6530 esqd=0.0067226700223333 : REM e is eccentricity

6540 n=(a-b)/(a+b) : REM 0.0016863407 : REM n is (a-b)/(a+b)

6550 east%=0:grid$="UTM"

6560 ENDPROC

6570 :

6580 DEFPROCcmd(A$):REM Command line access

6590 ON ERROR REPORT:PROCClose_All:PRINTERL:PROCexit(ERR):END

6600 IF os%=32:PROCWin_TextIO

6610 in$=FNcl("-i ",1):IF in$="":PROCline ELSE PROCinput

6620 ENDPROC

6630 :

6640 DEFPROCline

6650 IF FNcl("-?",0):PROCsyntax:ENDPROC

6660 IF FNcl("-help",0):PROChelp:ENDPROC

6670 PROCconstants_OSGB

6680 IF LEFT$(A$,1)>"@" THEN

6690 G$=FNcl("",0):comment$=A$

6700 PROCngr

6710 PROC_Mvrho(E,N):PROC_toll:PROC_C_EN

6720 PROCoutput(lambda,phi,C)

6730 IF comment$<>"":PRINT comment$;SPC(16-LENcomment$);

6740 PRINT ;degN;",";minN;",";secN;",N ";

6750 PRINT ;degE;",";minE;",";secE;",";LEFT$(ew$,1);" ";

6760 PRINT

6770 ELSE

6780 IF FNcl("-osgb",0):PROCconstants_OSGB

6790 IF FNcl("-osi",0):PROCconstants_OSI

6800 IF FNcl("-itm",0):PROCconstants_ITM

6810 IF FNcl("-utm",0):PROCconstants_UTM

6820 lat$=FNcl("",0):long$=FNcl("",0):comment$=A$

6830 degN=VALlat$:A%=INSTR(lat$+",",","):lat$=MID$(lat$,A%+1)

6840 minN=VALlat$:A%=INSTR(lat$+",",","):lat$=MID$(lat$,A%+1)

6850 secN=VALlat$:A%=INSTR(lat$+",",","):lat$=MID$(lat$,A%+1)

6860 :

6870 degE=VALlong$:A%=INSTR(long$+",",","):long$=MID$(long$,A%+1)

6880 minE=VALlong$:A%=INSTR(long$+",",","):long$=MID$(long$,A%+1)

6890 secE=VALlong$:A%=INSTR(long$+",",","):long$=MID$(long$,A%+1)

6900 ew$=long$

6910 :

6920 PROC_lltoEN:PROC_ENtongr(E,N)

6930 :

6940 GL$=LEFT$(NGR$,2):NGR$=MID$(NGR$,3)

6950 IF comment$<>"":PRINT comment$;SPC(16-LENcomment$);

6960 PRINT GL$;NGR$;" ";

6970 PRINT GL$;LEFT$(NGR$,4);MID$(NGR$,6,4);" ";

6980 PRINT GL$;LEFT$(NGR$,3);MID$(NGR$,6,3);" ";

6990 PRINT GL$;LEFT$(NGR$,2);MID$(NGR$,6,2);" ";

7000 PRINT GL$;LEFT$(NGR$,1);MID$(NGR$,6,1);" ";

7010 PRINT GL$;" ";

7020 PRINT ;east$;" ";north$;" ";

7030 PRINT

7040 ENDIF

7050 :

7060 ENDPROC

7070 :

7080 DEFPROCinput

7090 in%=OPENIN(in$):IFin%=0:ENDPROC

7100 REPEAT:REPEAT:A$=GET$#in%:UNTILEOF#in% OR A$<>""

7110 IF A$<>"" AND LEFT$(A$,1)<>"#":PROCline

7120 UNTILEOF#in%:CLOSE#in%:in%=0:ENDPROC

7130 :

7140 DEFPROCsyntax:PRINT"Syntax: NGRCalc <lat/long> <gridref> [-i infile] [-help]":ENDPROC

7150 DEFPROChelp

7160 PRINT"NGRCalc ";ver$" - Convert National Grid References"

7170 PRINT" NGRCalc <lat> <long> [-osgb -osi -itm -utm]"

7180 PRINT" Converts comma-seperated latitude and longitude to grid reference"

7190 PRINT" -osgb - Use OSGB (Great Britain) grid (default)"

7200 PRINT" -osi - Use OSI (old Irish) grid"

7210 PRINT" -itm - Use ITM (new Irish) grid"

7220 PRINT" -utm - Use UTM (Channel Islands) grid"

7230 PRINT" Outputs space-seperated string of grid references"

7240 PRINT" Examples:"

7250 PRINT" Command: NGRCalc 50,0,0,N 3,0,0,W"

7260 PRINT" Output: SY2834011644 SY28341164 SY283116 SY2811 SY21 SY "

7270 PRINT" Command: NGRCalc 49,15,0,N 2,5,0,W"

7280 PRINT" Output: XD9393627793 XD93932779 XD939277 XD9327 XD92 XD "

7290 PRINT" Command: NGRCalc 49,15,0,n 2,5,0,w -utm"

7300 PRINT" Output: WV6674157944 WV66745794 WV667579 WV6657 WV65 WV "

7310 PRINT

7320 PRINT" NGRCalc <gridref>"

7330 PRINT" Converts grid reference to latitude and longitude"

7340 PRINT" Examples:"

7350 PRINT" Command: NGRCalc NZ9011"

7360 PRINT" Output: 54,29,10.375,N 0.36,38.071,W"

7370 PRINT" Command: NGRCalc IN0050"

7380 PRINT" Output: 53,30,0,N 8,0,0,W"

7390 ENDPROC

7400 :

7410 REM > BLib.Generic.ProgEnv 1.06 20Apr2020

7420 DEFFNOS_GetEnv:LOCALA$,A%,X%,Y%:X%=1:os%=((USR&FFF4)AND&FF00)DIV256

7430 IF!PAGE=&D7C1C7C5:run$=ARGV$(0):FORA%=0TOARGC:A$=A$+ARGV$(A%)+" ":NEXT:=MID$(A$,LENrun$+1)

7440 REM How do I detect SDL *before* filtering out DOS which has no INKEY-256 ?

7450 REM How do I detect that SDL is actually running on Unix-y?

7460 IFos%>31:IFPAGE>&FFFFF:os%=32:DIMX%LOCAL256:SYS"GetModuleFileName",0,X%,255:run$=$$X%:=@cmd$

7470 A%=&600-&7B00*(PAGE>&8000)-&3F00*(PAGE>&C000):IF!(PAGE-&100)=@%:A%=PAGE-&300

7480 IF?(TOP-3)=0:A%=&100:IFHIMEM<&FFFF:A%=PAGE-&300:IF!(HIMEM+512)=@%:A%=HIMEM

7490 A$=$A%:IFPAGE=&8F00:run$=A$:SYS16TOA$,,A%:SYS72,"",A%:A$=MID$(A$,1+INSTR(A$+" "," ",1+INSTR(A$," "))):IFLENA$=0:A$=run$

7500 FORY%=-1TO0:A$=" "+A$:REPEATA$=MID$(A$,2):UNTILASCA$<>32:IFASCA$=34:A%=INSTR(A$,"""",2)+1 ELSE A%=INSTR(A$+" "," ")

7510 IFY%:run$=MID$(A$,1-(ASCA$=34),A%-1+2*(ASCA$=34)):A$=MID$(A$,A%+1)

7520 NEXT:=A$

7530 DEFPROCos(A$):IFASCA$=42:OSCLIA$ ELSE IFLENA$:CHAINA$

7540 ENDPROC

7550 DEFPROCexit(A%):OSCLI"FX1,"+STR$(A%AND255):quit$=quit$:A$=quit$:quit$="":PROCos(A$)

7560 IFPAGE>&FFFFF:QUIT A% ELSE END

7570 ENDPROC

7580 :

7590 REM > BLib.CmdLine 1.10 27Jul2009

7600 DEFFNcl(l$,n%):IFl$="":A$=FNs(A$):IFASCA$=34:A%=INSTR(A$+" "" ",""" ",2):l$=MID$(A$,2,A%-2):A$=FNs(MID$(A$,A%+1)):=l$

7610 IFl$="":A%=INSTR(A$+" "," "):l$=LEFT$(A$,A%-1):A$=FNs(MID$(A$,A%+1)):=l$

7620 IFn%=0:IFl$<>"":A%=INSTR(A$,l$):IFA%:A$=FNs(LEFT$(A$,A%-1)+MID$(A$,INSTR(A$," ",A%)+1))+" ":=TRUE

7630 IFn%=0:IFl$<>"":=FALSE

7640 A%=INSTR(LEFT$(" ",ASCl$=32)+A$,l$):IFA%=0:=""

7650 A$=LEFT$(A$,A%-1)+FNs(MID$(A$,INSTR(A$," ",A%)+1))

7660 IFASCl$=32:l$=MID$(A$,A%):A$=LEFT$(A$,A%-1):=MID$(l$,1-(ASCl$=34),LENl$+2*(ASCl$=34))

7670 IFASCMID$(A$,A%,1)<>34:l$=MID$(A$,A%,INSTR(A$+" "," ",A%)-A%):A$=LEFT$(A$,A%-1)+MID$(A$,A%+LENl$+1):=l$

7680 l$=MID$(A$,A%+1,INSTR(A$+""" ",""" ",A%+1)-A%-1):A$=LEFT$(A$,A%-1)+MID$(A$,A%+LENl$+3):=l$

7690 DEFFNs(A$):IFLEFT$(A$,1)=" ":REPEATA$=MID$(A$,2):UNTILLEFT$(A$,1)<>" "

7700 IFRIGHT$(A$,1)=" ":REPEATA$=LEFT$(A$,LENA$-1):UNTILRIGHT$(A$,1)<>" "

7710 =A$

7720 :

7730 REM > TextIO

7740 DEFPROCWin_TextIO

7750 SYS "GetStdHandle",-10 TO @hfile%(1):*INPUT 13

7760 SYS "GetStdHandle",-11 TO @hfile%(2):*OUTPUT 14

7770 SYS "SetConsoleMode",@hfile%(1),0

7780 ENDPROC

7790 :

7800 REM > BLib.Close 1.00 09Aug1998

7810 DEFPROCClose_All:*EXEC

7820 in%=in%:IFin%:A%=in%:in%=0:CLOSE#A%

7830 out%=out%:IFout%:A%=out%:out%=0:CLOSE#A%

7840 ENDPROC

7850 :

7860 REM WINLIB5.BBC Version 1.5

7870 DEFPROC_setfocus(H%)

7880 LOCAL K%,M%,O%,P%

7890 DIM P% LOCAL 30

7900 [OPT 2

7910 .K% push H% : call "SetFocus" : ret 16

7920 .M% cmp dword [esp+8],&500 : jz K% : jmp [^O%]

7930 ]

7940 SYS "GetWindowLong", @hwnd%, -4 TO O%

7950 SYS "SetWindowLong", @hwnd%, -4, M%

7960 SYS "SendMessage", @hwnd%, &500, 0, 0

7970 SYS "SetWindowLong", @hwnd%, -4, O%

7980 SYS "Sleep", 0

7990 ENDPROC