	$lib graph off
	dim sitenames$(1000 , 1)
	KEY OFF
	key 15,chr$(0,1,255)               'esc
	on key (15) gosub escape
	key (15) on
	ON ERROR GOTO ErrorHandler
	PROGNAME$="SITECALC "
	TITLE$="  MICROWAVE SITES - Bearing and distance calculations"
	COPYRIGHT$="A C Talbot    G4JNT  13/4/93"
	HEADER$=PROGNAME$+TITLE$
	letter%=0
	palette 5,38
	CLS
	DEFDBL A-Z
	KEY OFF
	F$="SITES.DAT"
	fx$=dir$(f$)
	if fx$<>f$ then
		sound 400,1:sound 500,1
		locate 10,30
		color 28
		print "Site database missing"
		locate 12,20
		color 2
		print "SITES.DAT must be in the default directory"
		end
	else
		open "i",1,"sites.dat"
	end if
	handle% = fileattr(1,2)
	reg 1,&h57*256+00
	reg 2,handle%
	call interrupt &h21
	tim% = reg(3)
	hr%=tim%\2048
	mi%=tim%\32 mod 64
	dat% = reg(4)
	yr% = dat%\512+1980
	mo%= dat%\32 mod 16
	da%= dat% mod 32
	close 1
	da$ = using$("##" , da%) : if da% < 10 then da$ = "0" + mid$(da$ , 2)
	mo$ = using$("##" , mo%) : if mo% < 10 then mo$ = "0" + mid$(mo$ , 2)
	whendatabase$= da$ + "/" + mo$ + using$("/##" , yr% - 1900)
	DEF FNMAGVAR(X,Y)=.09*Y-.5*X
	PI = 3.1415926535898#
	DR=180 / PI
	FORMLENGTH% = 20
	DEF FNACS(X)=ATN((SQR(1-X*X))/X)+PI/2*(1-SGN(X))

MainStart:
	h%=0
	sp%=0
	ma%=0
	dmin=0
	dmax=10000
	rsb%=0
	l$=""
	baseloc$=""
	fpr%=0
	aa%=0
	popular%=0
	boxcol%=7
	bordercol%=9
	gosub border
	now$=mid$(date$,4,2)+"/"+left$(date$,2)+"/"+right$(date$,2)
	locate 25,5
		color 11,0
		PRINT "Todays date ";now$;"         Database last updated ";whendatabase$;
	if command$>"" then
		location$=ucase$(command$)
	else
SiteIn:
		color 0,7
		locate 8,5
		print string$(72," ")
		locate 8,10
		input "Own  Sitename , NGR  or Locator ",location$
		location$=ucase$(location$)
		if location$="" then
			Sitebrowse
			color letter%,boxcol%
			gosub border
			goto SiteIn
			end if
		location$=ucase$(location$)
		locate 8,42
		color 0,7
		print location$

		if len(location$) < 3 then sound 700,1:goto Sitein
		end if

	gosub HowStored
	locate 8,60
	select case filetype%
	case 1
		locator$=location$
		gosub DecodeLocator
		color 0,7
		print "Locator";

	case 2
		ngr$=location$
		gosub DecodeNgr
		color 0,7
		print "NGR";

	case 0
		color 0,7
		print "Searching"
		gosub SearchForSite
		if found%=0 then
			locate 8,60
			print "Not Found "
			sound 700,1
			delay .5
			goto SiteIn
			else
			color 0
			locate 8,60
			print "Found     "
			end if
	end select
	baseloc$=locator$
	basengr$=ngr$

	color 14,boxcol%
	gosub line25
	LOCATE 11,10
	color letter%
	print "To specific site only y/N";
	locate 11,37
	while not instat:wend
	sp$=ucase$(inkey$)
	locate 11,40
	IF SP$="Y" THEN
		SP%=-1
		print "Y"
		do
			LOCATE 12,10
			LINE INPUT; "To site  -  ";SPSITE$
			if len (spsite$)>2 then exit loop
			sound 700,1
		loop
		SPSITE$=UCASE$(SPSITE$)
		locate 12,22
		print spsite$

	else

		print "N"
		locate 12,10
		print "To 'popular' sites only y/N";
		while not instat:wend
		pop$=ucase$(inkey$)
		if pop$="Y" then popular%=-1
		locate 12,40
		print mid$("YN",popular%+2,1)
	end if

	LOCATE 14,10
	PRINT "Magnetic Bearings   y/N"
	while not instat:wend
	ma$=ucase$(INKEY$)
	IF MA$="Y" or ma$="M" THEN
		MA%=-1
		BTYPE$="Mag"
		LOCATE 15,10
		INPUT; "Magnetic variation    [rtn] for estimated value";magvar
		LOCATE 16,20
		IF MAGVAR>0 THEN
			PRINT "Estimated value will be used for back bearings";
		else
			MAGVAR=FNMAGVAR(LONG,LAT)
			print using "Estimated variation ##.#ø";magvar
		end if
	else
			BTYPE$="True"
			magvar=0
			ma%=0
			locate 15,10
			print "True Bearings"
	end if

	IF SP% THEN
		DMAX=99999
	else
		do
			locate 18,41:print space$(6)
			locate 19,41:print space$(6)
			LOCATE 18,10:INPUT; "Minimum distance     [zero])   ",DMIN
			LOCATE 19,10:INPUT; "Maximum distance     [high]    ",DMAX
			IF DMAX = 0 THEN DMAX=10000
			IF DMAX > DMIN THEN exit loop
			sound 400,1:sound 500,1
			COLOR 26
			LOCATE 17,40:PRINT "Maximum Distance less than Minimum";
			color letter%
		loop
		LOCATE 20,10
		print "Restrict bearing printout  y/N";
		while not instat:wend
		RSB$=ucase$(inkey$)
		IF RSB$="Y" THEN
			RSB%=-1
			do
				   LOCATE 21,10
				INPUT; "Valid bearing range for printout;  clockwise  A , B";BA,BB
				if ba>0 or bb>0 then exit loop
				sound 400,1:sound 500,1
			loop
		end if
	end if
	color 7,0
	cls
	gosub border
	color 15,0
	locate 11,29:print "                      "
	LOCATE 12,29:PRINT "     Hardcopy y/N     "
	locate 13,29:print "                      "
	while not instat:wend
	h$=ucase$(inkey$)
	IF H$="Y" THEN
		H%=-1
		GOSUB PtrMenu
		IF (h% or fpr%) and NOT FOUND% THEN
			cls
			color 15
			locate 22,25
			LINE INPUT "Name of site for printout  ";ownsite$
			ownsite$=UCASE$(ownsite$)
			gosub Line25
		end if
	end if
	BASELAT=LAT
	BASELONG=LONG
	BASELATR=LATR
	BASELONGR=LONGR
	CLS
	boxcol%=0
	gosub line25
	if fpr% then
		PRINT #3,USING " \                                       \";ownsite$
		print #3,using " \       \   \       \";basengr$,baseloc$
		print #3," "+btype$;" bearings ";
		if magvar>0 then print #3,using " Variation #.#ø";magvar else print #3,chr$(10)
		IF DMIN > 0 THEN PRINT #3," Distances over     ";DMIN;"km"
		IF DMAX<10000 THEN PRINT #3, " Distances less than";DMAX;"km"
		IF RSB% THEN PRINT #3, USING " Bearings within range ###ø Ä ###ø";BA,BB
		print #3,chr$(10)
		if fpbreak% then
			print #3 , space$(40) + "NGR    LOCATOR     DIST    TO   FROM  "
			print #3 , " "
		end if
	end if
	IF H% THEN
		LPRINT PRINIT$;PRFONT$;DBLP$;
		lprint
		LPRINT USING "           \                                      \";ownsite$
		if dblcol% then lprint
		LPRINT USING "           NGR  -  \      \    LOC -  \      \";NGR$,BASELOC$
		lprint
		LPRINT	tab(12);BTYPE$;" Bearings";
		IF MA% THEN LPRINT USING ": variation #.#!";MAGVAR,PRNDEG$ else LPRINT
		lprint
		IF DMIN > 0 THEN LPRINT tab(12);"Distances over     ";DMIN;"km"
		IF DMAX < 10000 THEN LPRINT tab(12);"Distances less than";DMAX;"km"
		IF RSB% THEN LPRINT tab(12);USING "Bearings within range ###! to ###! ";BA,PRNDEG$,BB,PRNDEG$
		LPRINT NORP$
		LPRINT tab(20);"This printout ";now$;tab(50);"Database dated ";whendatabase$
		LPRINT
		GOSUB HardHeader
	end if
	GOSUB DispHeader
	if h% then aa% = 12
	close 1
	open "i",1,F$
	tt%=0

'main loop starts here ============================================

	do
		incr TT%
		line input #1,readline$
		if instr(ucase$(readline$) , "ENDENDEND") > 0 then exit loop
		gosub SplitLine
		if (popular% and (not popsite%)) or_
			(SP% and (INSTR(UCASE$(sitename$),SPSITE$)=0)) THEN iterate loop
		location$=ucase$(stloc$)
		gosub HowStored
		if filetype%=0  then iterate loop ' Invalid stored location
		if filetype% =1 then locator$=location$:gosub DecodeLocator
		if filetype% =2 then ngr$=location$:gosub DecodeNgr
		GOSUB DistBearCalcs
		IF MA% THEN BMVAR=FNMAGVAR(LONG,LAT)
		SECTOR%=BEARING/45+1
		SECTOR$=MID$("N NEE SES SWW NWN ",2*SECTOR%-1,2)
		PBEAR=BEARING+MAGVAR:IF PBEAR>=360 THEN PBEAR=PBEAR-360
		PBACK=BACKBEARING+BMVAR:IF PBACK>=360 THEN PBACK=PBACK-360
		IF DIST < DMIN OR DIST > DMAX or dist < .1 THEN iterate loop
		IF RSB% THEN
			IF BA < BB AND (PBEAR < BA OR PBEAR>BB) THEN  iterate loop
			IF BA > BB AND PBEAR < BA AND PBEAR > BB THEN iterate loop
			end if
		incr aa%
		IF AA% MOD 6 =0 THEN SETUL%=-1 else SETUL%=0
		if h% and not dblcol% and not basicprint% then lprint tab(7);
		IF SETUL% THEN
			color 15
			IF H% AND NOT DBLCOL% THEN LPRINT ULINE$;
		end if
		PRINT USING "\                                    \ \      \ \      \ ####.# km ###ø (###ø)";sitename$,NGR$,locator$,DIST,PBEAR,PBACK;
		if fpr% then PRINT #3, USING "\                                   \ \      \ \      \ ####.# km ###ø (###ø)";sitename$,NGR$,locator$,DIST,PBEAR,PBACK
		color 7
		IF DBLCOL% THEN LPRINT USING "\                                        \ ####km ###ø(###ø) \      \ \      \ !";sitename$,DIST,PBEAR,PBACK,NGR$,locator$;vbar$;
		IF (NOT DBLCOL%) AND H% THEN
			if not basicprint% then
				LPRINT USING "\                                                 \ ###!  (###!) ####.# km  \\     \      \   \      \";sitename$,PBEAR,PRNDEG$,PBACK,PRNDEG$,DIST,SECTOR$,NGR$,locator$;
			else
				LPRINT USING "\                                      \ ###! (###!)####km  \      \ \      \";sitename$,PBEAR,PRNDEG$,PBACK,PRNDEG$,DIST,NGR$,locator$;
			end if
            if setul% then lprint offuline$;
		end if
		IF SETUL% AND DBLCOL% THEN LPRINT STRING$(79,".")+vbar$+string$(79,".")+vbar$;
		Z$=INKEY$
		IF (AA% MOD FORMLENGTH%=0) THEN
			if fpr% and fpbreak% then
				print #3 , chr$(12);
				print #3 , space$(40) + "NGR    LOCATOR     DIST    TO   FROM  "
				print #3 , ""
			end if

			IF H% THEN
				aa%=0
				LPRINT CHR$(12)
				GOSUB HardHeader
			else
				if not fpr% then
					print
					GOSUB AnyKey
					GOSUB DispHeader
				end if
			end if
		end if
	loop until eof(1)

'end of main loop    ===============================================

	close
	IF H% THEN
		LPRINT CHR$(12);
		print : print
	else
		for gg%= csrlin+1 to 24
			locate gg%,1
			print string$(80," ");
		next gg%
	end if
	locate min(csrlin + 1 , 23) , 1
	if not fpr% then print "[esc] to end ";
	GOSUB AnyKey
	cls
	if fpr% then
		locate 8,20
		print "Sort ";fpr$;" by -"
		locate 13,15:color 12:print "N";:color 7:print "GR"
		locate 13,20:color 12:print "L";:color 7:print "ocator"
		locate 13,30:color 12:print "D";:color 7:print "istance"
		locate 13,41:color 12:print "B";:color 7:print "earing"
		locate 13,51:color 12:print "U";:color 7:print "nsorted [rtn]"
		locate 16,15:color 28:print ">";:color 7
PrintIn:
		while not instat:wend
		gg%=instr("NLDBU"+chr$(13),ucase$(inkey$))
		select case gg%
		case 0
			goto PrintIn
		case 5
			end
		case 6
			end
		case 1
			sortloc$="39"
			howsort$="NGR"
		case 2
			sortloc$="48"
			howsort$="Locator"
		case 3
			sortloc$="57"
			howsort$="Distance"
		case 4
			sortloc$="67"
			howsort$="Bearing"
		end select
		print "Sorted by ";howsort$
		color 20
		print "Sorting ..."
		shell "copy "+fpr$+" unsort.prn > nul:"
		shell "sort < unsort.prn > "+fpr$+" /+"+sortloc$
		kill "unsort.prn"
	else
		goto MainStart
	end if
	cls
	palette
	end
'==========================================================
SplitLine:
	posn1%=instr(readline$,"~")
	posn2%=instr(posn1%+7,readline$,"~")
	popsite%=0
	if posn2%>0 then
		flags$=ucase$(mid$(readline$,posn2%+1,3))
		if instr(flags$,"P")>0 then popsite%=-1 else popsite%=0
		end if
	sitename$=left$(readline$,posn1%-1)
	stloc$=mid$(readline$,posn1%+1,8)
	if instr(stloc$,"~")>0 then stloc$=left$(stloc$,6)  ' 6 Digit loc stored
	return

DecodeLocator:
	'        Enter with Locator$, exit with Lat/Long + NGR$
	IF LEN(locator$)<8 or right$(locator$,2)="  " THEN LC8%=0 else LC8%=-1
	LAT=10*(ASC(MID$(locator$,2,1))-65)+(ASC(MID$(locator$,4,1))-48)
	LAT=LAT+(ASC(MID$(locator$,6,1))-65)/24-90+1.25/60
	IF LC8% THEN LAT=LAT+(ASC(MID$(locator$,8,1))-48)*.25/60-1.125/60
	LONG=20*(ASC(MID$(locator$,1,1))-65)+2*(ASC(MID$(locator$,3,1))-48)
	LONG=LONG+(ASC(MID$(locator$,5,1))-65)/12-180+2.5/60
	IF LC8% THEN LONG=LONG+(ASC(MID$(locator$,7,1))-48)*.5/60-2.25/60
    LATR=LAT/DR
	LONGR=LONG/DR
	if long > -6 and long< 2 and lat >48 and lat < 60 then
		Y=SQR(1-.00667054#*SIN(LATR)*SIN(LATR))
		N=-100+111.0793*(LAT-49)
		N=N-31.947*SIN((LAT-49)/DR)*COS(LATR+49/DR)+.971*(2+LONG)^2*SIN(LATR)*COS(LATR)/Y
		E=400+111.2651*(2+LONG)*COS(LATR)/Y
		E=E-.0056*(2+LONG)^3*(COS(LATR))^3*((TAN(LATR))^2-1)
		C1%=83-5*((N-.5)\500)+((E-.5)\500)
		IF C1%=73 THEN C1%=72
		EH%=((E MOD 500)-.5)\100
		NH%=((N MOD 500)-.5)\100
		C2%=(4-NH%)*5+EH%+65
		IF C2%>72 THEN C2%=C2%+1
		C35%=(E*10) MOD 1000
		C35$=RIGHT$(STR$(C35%),1-(C35%>9)-(C35%>99))
		while LEN(C35$)<3
			C35$="0"+C35$
			wend
		C68%=(N*10) MOD 1000
		C68$=RIGHT$(STR$(C68%),1-(C68%>9)-(C68%>99))
		while LEN(C68$)<3
			C68$="0"+C68$
			wend
		if lc8% then
			NGR$=CHR$(C1%)+CHR$(C2%)+C35$+C68$
			else
			ngr$="["+chr$(C1%)+chr$(C2%)+left$(C35$,2)+left$(C68$,2)+"]"
			end if
		else
		ngr$="   --   "
		end if
	return

DecodeNgr:
	N=VAL(MID$(NGR$,6,3))/10
	E=VAL(MID$(NGR$,3,3))/10
	T1%=ASC(MID$(NGR$,1,1))-65:IF T1%>8 THEN T1%=T1%-1
	T2%=ASC(MID$(NGR$,2,1))-65:IF T2%>8 THEN T2%=T2%-1
	E=500* (T1% MOD 5) + 100*(T2% MOD 5)-1000+E
	N=1900-500*(T1% \5)-100*(T2%\5)+N

	T1=(N+5548.79)/6371.28
	T2=2*ATN(EXP((E-400)/6389.7))
	LONGR=ATN(-COS(T2)/(COS(T1)*SIN(T2)))-2/DR
	LA=SIN(T1)*SIN(T2)
	LATR=ATN(LA/SQR(1-LA*LA))
	LAT=LATR*DR
	LONG=LONGR*DR

	LOCATOR$="":V=LAT/180+.5:H=LONG/360+.5:locator$=""
	T=65:F=18:GOSUB NextChr
	T=48:F=10:GOSUB NextChr
	T=65:F=24:GOSUB NextChr
	T=48:F=10:GOSUB NextChr
	RETURN
NextChr:
	V=F*(V-INT(V)):H=F*(H-INT(H))
	LOCATOR$=LOCATOR$+CHR$(INT(T+H))+CHR$(INT(T+V))
	RETURN

HowStored:
	' Enter with location$, Exit with filetype% 1 = LOC  2 = NGR  0 = Error
	q1$="AA00AA  "
	q2$="RR99XX99"
	q3$="HA000000"
	q4$="YZ999999"
	filetype%=0:notloc%=0:notngr%=0
	if len(location$)<>6 and len(location$)<>8 then filetype%=0:return
	for chk%=1 to len(location$)
		a$=mid$(location$,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 not notloc% then filetype%=1
	if not notngr% then filetype%=2
	if notloc% and notngr% then filetype%=0

	return

DistBearCalcs:
	CSARC=SIN(BASELATR)*SIN(LATR)+COS(BASELATR)*COS(LATR)*COS(LONGR-BASELONGR)
	IF CSARC>=1 THEN MathsError
	ARC=FNACS(CSARC)
	DIST=ABS(6371.29*ARC)
	CSBEAR=(SIN(LATR)-SIN(BASELATR)*CSARC)/(COS(BASELATR)*SIN(ARC))
	BACKCSBEAR=(SIN(BASELATR)-SIN(LATR)*CSARC)/(COS(LATR)*SIN(ARC))
	IF ABS(CSBEAR)>1 OR ABS(BACKCSBEAR)>1 THEN MathsError
	BEAR=FNACS(CSBEAR)
	BACKBEAR=FNACS(BACKCSBEAR)
	BEARING=BEAR*DR
	BACKBEARING=BACKBEAR*DR
	IF LONG<BASELONG THEN BEARING = 360-BEARING
	IF BASELONG<LONG THEN BACKBEARING = 360-BACKBEARING
	IF BEARING=360 THEN BEARING=0
	IF BACKBEARING=360 THEN BACKBEARING=0
	RETURN
MathsError:
	Y=N%-HN%:X=E%-HE%
	DIST=SQR(X*X+Y*Y)/10
	IF DIST<.2 THEN DIST=0:BEARING=0:BACKBEARING=0:RETURN
	BEARING=90-2*DR*ATN(Y/(X+SQR(X*X+Y*Y)))
	IF BEARING<0 THEN BEARING=360+BEARING
	BACKBEARING=BEARING-180
	IF BACKBEARING<0 THEN BACKBEARING=360+BACKBEARING
	RETURN

AnyKey:
	color 6
	PRINT "Any key to continue..";
	color 7
	while not instat:wend
	A$=ucase$(INKEY$)
	AA%=0
	RETURN

SearchForSite:
	found%=0
	OSITE$=UCASE$(location$)
	SITEINCMND%=0
	searchloop%=0
	close 1
	open "i",1,f$
	do
		incr searchloop%
		line input #1,readline$
		gosub SplitLine
		b%=instr(ucase$(sitename$),osite$)
		IF B%>0 THEN
			found%=-1
			exit loop
		end if
		if inkey$>"" then exit loop
		loop until eof(1)

	if FOUND%=0 then return
	location$=ucase$(stloc$)
	gosub HowStored
	if filetype% =1 then locator$=location$:gosub DecodeLocator
	if filetype% =2 then ngr$=location$:gosub DecodeNgr
	baselat=lat:baselong=long
	baselatr=latr:baselongr=longr
	baseloc$=locator$:basengr$=ngr$
	ownsite$=sitename$
return

Line25:
	color 14,0
	LOCATE 25,1
	print string$(80," ");
	locate 25,1
	PRINT ownsite$;
	locate 25,40
	PRINT USING "\      \ \      \ ";basengr$,BASELOC$;
	locate 25,58
	if btype$>"" then PRINT BTYPE$;" Bearings";
	IF MAGVAR>0 THEN LOCATE 25,71:PRINT USING "Var =##.#ø";MAGVAR;
	color letter%,boxcol%
return

DispHeader:
	cls
	gosub Line25
	LOCATE 1,1
	color 14
	PRINT "     SITE NAME                           NGR      LOC       DIST    TO   FROM":color 7:PRINT
RETURN

HardHeader:
	IF NOT DBLCOL% and not basicprint% THEN
		LPRINT TAB(56);"    TO    FROM     DIST   Sect      NGR      LOCATOR"
		lprint
	end if

	if basicprint% then
		lprint TAB(41);"BEARING (Deg)  DIST   NGR    LOCATOR"
		lprint TAB(42);"To    From"
		lprint
	end if

	IF DBLCOL% THEN
		FOR COLTAB%=46 TO  126 STEP 80
		LPRINT TAB(COLTAB%);"DIST   TO  BACK    NGR     LOC";
		NEXT COLTAB%
		LPRINT:LPRINT
		end if
RETURN


PtrMenu:
	color 7,9
	locate 10,21
	print string$(39,"°")
	for t%=11 to 21
		locate t%,21
		print "°°";
		color 7,0
		print space$(35);
		color 7,9
		print "°°";
		next t%
	locate 22,21
	print string$(39,"°")
	color 14,0
	LOCATE 12,24:PRINT "Which printer :";
	color 7
	LOCATE 13,26:PRINT "HP ";:color 12:print"L";:color 7:print"aserjet 2";
	LOCATE 14,26:PRINT "HP ";:color 12:print"D";:color 7:print"eskjet/ Laserjet IBM chars";
	LOCATE 15,26:PRINT "Epson L";:color 12:print"Q";:color 7:print"2500, FX1000";
	LOCATE 16,26:PRINT "Epson F";:color 12:print"X";:color 7:print"80";
	LOCATE 17,26:print "Basic HP laser";:color 12:print"J";:color 7:print"et (80 col)";
	LOCATE 18,26:color 12:print"O";:color 7:print"ther 80 column printer";
	LOCATE 19,26:print "Print to ";:color 12:print"F";:color 7:print"ile ";
	LOCATE 20,26:PRINT "";:color 12:print"C";:color 7:print"ancel hardcopy";
	color 14
HardCopyMenu:
	LOCATE 21,30:print ">";
	while not instat:wend
	prdrv$=ucase$(inkey$)
	PRDRV%=INSTR("LXQDFCJO",PRDRV$)
	select case prdrv%
	case 6
		h%=0
		RETURN

	case 5
		cls
		h% = 0
		fpr% = -1
		color 15
		locate 12 , 10
		print;"Filename,   [rtn] for SITES.PRN ";
		input;, fpr$
      fpr$=ucase$(fpr$)
		if fpr$="" then fpr$="SITES.PRN"
		LOCATE 14 , 10
		PRINT "Page breaks and headers to be included in file  Y / n"
		while not instat : wend
		if ucase$(inkey$) <> "N" then
			fpbreak% = -1
			locate 16 , 10
			input "Lines per page  ",formlength%
			if formlength% = 0 then formlength% = 47
			decr formlength% , 2
         aa% = 10   'for header space
		end if
		open "o",3,fpr$

	case 0
		goto HardCopyMenu

	case 1  'HP Laserjet with condensed
		lreset$=CHR$(27)+"@"
		PRFONT$=""
		DBLP$=CHR$(27)+"&k0S":REM 10 PITCH
		NORP$=CHR$(27)+"&k2S":REM CONDENSED
		PRINIT$=""
		PRNDEG$=CHR$(179):   REM    DEGREE SIGN
		ULINE$=CHR$(27)+"&d0D
		OFFULINE$=CHR$(27)+"&d0@
		WIDTH "LPT1:",120
		FORMLENGTH%=58
		basicprint%=0
		vbar$="|"

	case 2  'fx80
		lreset$=CHR$(27)+"@"
		PRFONT$=CHR$(27)+"x"+CHR$(0)+CHR$(15):REM DRAFT CONDENSED
		DBLP$=CHR$(27)+"W"+CHR$(1):REM DOUBLE WIDTH
		NORP$=CHR$(27)+"W"+CHR$(0):REM CANCEL DOUBLE WIDTH
		PRINIT$=CHR$(27)+"2" :REM   6 LPI
		PRNDEG$=CHR$(248):   REM    DEGREE SIGN
		ULINE$=CHR$(27)+"-1"
		OFFULINE$=CHR$(27)+"-0"
		WIDTH "LPT1:",120
		FORMLENGTH%=58
		basicprint%=0
		vbar$=chr$(179)

	case 3  'lq2500
		lreset$=CHR$(27)+"@"
		locate  21,30
		print "Double column y/N";
		while not instat:wend
		IF ucase$(inkey$)="Y" THEN DBLCOL%=-1 else dblcol%=0
		IF DBLCOL% THEN
			PRFONT$=CHR$(27)+"x"+CHR$(0)+CHR$(15)+CHR$(27)+"M"+CHR$(27)+"S"+CHR$(0)
			DBLP$=CHR$(27)+"T"
			NORP$=PRFONT$
			PRINIT$=CHR$(27)+"A"+CHR$(6)
			width "LPT1:",160
			formlength%=134
			else
			PRFONT$=CHR$(27)+"x"+CHR$(0)+CHR$(27)+"g"
			DBLP$=CHR$(27)+"W"+CHR$(1)
			NORP$=CHR$(27)+"W"+CHR$(0)
			PRINIT$=CHR$(27)+"A"+CHR$(9)
			width "LPT1:",120
			formlength%=58
			end if
		PRNDEG$=CHR$(248):   REM    DEGREE SIGN
		ULINE$=CHR$(27)+"-1"
		OFFULINE$=CHR$(27)+"-0"
		basicprint%=0
        vbar$=chr$(179)

	case 4   'deskjet
		lreset$=CHR$(27)+"E"
        locate  21,30
		print "Double column y/N";
		while not instat:wend
		IF ucase$(inkey$)="Y" THEN DBLCOL%=-1 else dblcol%=0

		IF DBLCOL% THEN
			PRFONT$=CHR$(27)+"(s20H"
			DBLP$=CHR$(27)+"(s10H"
			NORP$=PRFONT$
			PRINIT$=chr$(27)+"&l8D"
			width "LPT1:",160
			formlength%=116

			else

			PRFONT$=""
			DBLP$=CHR$(27)+"&k0S":REM 10 PITCH
			NORP$=CHR$(27)+"&k2S":REM CONDENSED
			prinit$=chr$(27)+"&l6D"
			WIDTH "LPT1:",120
			FORMLENGTH%=58
			basicprint%=0
		end if

		PRNDEG$=CHR$(248):   REM    DEGREE SIGN
		ULINE$=CHR$(27)+"&d0D
		OFFULINE$=CHR$(27)+"&d0@
        vbar$=chr$(179)

	case 7  'Basic Laserjet    80 column
		lreset$=CHR$(27)+"@"
		PRFONT$=""
		PRINIT$=""
		PRNDEG$=CHR$(179):   REM    DEGREE SIGN
		ULINE$=CHR$(27)+"&d0D
		OFFULINE$=CHR$(27)+"&d0@
		WIDTH "LPT1:",80
		FORMLENGTH%=58
		basicprint%=-1
		vbar$="|"

	case 8  'Other  80 column printer
		PRFONT$=""
		PRINIT$=""
		PRNDEG$=" "
		ULINE$=""
		OFFULINE$=""
		WIDTH "LPT1:",80
		FORMLENGTH%=58
		basicprint%=-1
		vbar$="|"

	end select

2430	if h% then lprint lreset$;
2431	RETURN

ErrorHandler:
	if erl=2430 then
		sound 400,1:sound 500,1
		locate 22,30
		color 28
		PRINT "Printer error";
		color 7
		delay 1
		H%=0
		formlength%=21
		RESUME 2431
	end if
	PRINT "Error";err;"at ";eradr;erl:END

border:
	cls
	for a%=0 to 24 step 1
		delay .02
		for b%=1 to a%
			locate 24-a%+b%,40-a%*1.625
			color bordercol%,boxcol%
			print "Û"+string$(a%*3.25," ")+"Û";
			next b%
		next a%
	locate 1,1
	print "Û"+string$(78,"ß")+"Û";
	locate 24,1
	print "Û"+string$(78,"Ü")+"Û";
	color 15,0
	for a%=3 to 7
		locate a%,5
		print string$(72," ");
		next a%
	LOCATE 4,10
	color 12
	PRINT PROGNAME$;
	color 15
	PRINT TITLE$;
	LOCATE 6,22
	color 7
	PRINT "(c)  ";COPYRIGHT$;
    locate 25,1
	print space$(80);
	color 7,boxcol%
	return


escape:
	color 7,0
	cls
	palette
	end

sub SiteBrowse
	shared sitenames$()
	static maxcounter% , subseqbr% , offset%
	screen 0 ,, 1
	color 6 , 3
	cls
	locate 25 , 15 : print "Review site database SITES.DAT  -  [rtn] to end";
	color 0
	if not subseqbr% then
		open "i" , 2 , "sites.dat"
		while not eof(2)
			line input #2 , l$
			if instr(l$ , "ENDENDEND") > 0 then l$ = "" : exit loop
			p1% = instr(l$ , "~")
			n$ = left$(l$ , p1% - 1)
			p2% = instr(p1% + 1 , l$ , "~")
			if p2% > 0 then lc$ = mid$(l$ , p1% + 1 , p2% - p1% - 1) else lc$ = mid$(l$ , p1% + 1)
			sitenames$(maxcounter% , 0) = n$
			sitenames$(maxcounter% , 1) = lc$
			incr maxcounter%
		wend
		close 2
		subseqbr% = -1
	end if

	do
		for lin% = 0 to 23
			locate lin% + 1, 60 : print space$(10);
			locate lin% + 1, 10
			print sitenames$(lin% + offset% , 0);tab(60);sitenames$(lin% + offset% , 1)
		next lin%
		while not instat : wend
		ik$ = ucase$(inkey$)
		select case ik$
		case chr$(0 , 72)
			offset% = max(offset% - 1 , 0)
		case chr$(0 , 80) , chr$(32)
			offset% = min(offset% + 1 , maxcounter% - 24)
		case chr$(0 , 73)
			offset% = max(offset% - 24 , 0)
		case chr$(0 , 81)
			offset% = min(offset% + 24 , maxcounter% - 24)
		case chr$(0 , 79)
			offset% = maxcounter% - 24
		case chr$(0 , 71)
			offset% = 0
		end select
	loop until ik$ = chr$(13)
	screen 0 ,, 0
end sub