on error goto handle

r1:
cls
r1=1
f$=command$
locate 2,25:print "*****ICE-EXT******"
locate ,5:print "Extract utility for ICES data records including from compacted files"
locate 8,10:print "Data File MUST have .ice extension OR be MASTER.SEL"
Locate 10,10:input "Enter name of data file ";b$

if ucase$(b$)="MASTER.SEL" then
dim ice$(200),ind$(200),izip$(200)
mastsel=1
bout$="master.ext"
open bout$ for output as #3
open b$ for input as #1
ii=1

ag:
print "   Start Year ";:xpos=pos(1):input yrs(ii)
locate csrlin-1,xpos+10
print "   End Year ";:input yre(ii)
if yrs(ii)>yre(ii) then
beep:locate ,21:
Print "Not allowed"
goto ag
end if

fiy=yrs(1)
liy=yre(1)
j=1
while not eof(1)
input #1,ind$(j)
ind$(j)=left$(ind$(j),8)
for i = 8 to 1 step -1
if mid$(ind$(j),i,i)=" " then ind$(j)=left$(ind$(j),len(ind$(j))-1)
next i
fiy1=val(mid$(ind$(j),3,2))
liy1=val(mid$(ind$(j),5,2))
if fiy1>=fiy and liy1<=liy then gon=1
if fiy1<=fiy and liy1>=fiy then gon=1
if fiy1<=liy and liy1>=liy then gon=1
if fiy1<=fiy and liy1>=liy then gon=1

'if (fiy>=fiy1 and fiy<=liy1) or (liy<=liy1 and liy>=fiy1) then
if gon=1 then
gon=0
ice$(j)=ind$(j)+".ICE"
izip$(j)=ind$(j)+".ZIP"
ice$(j)="\"+left$(ice$(j),2)+"\"+ice$(j)
izip$(j)="\"+left$(izip$(j),2)+"\"+izip$(j)
ind$(j)=ind$(j)+".IND"
j=j+1
end if
wend
if j<=1 then print "No appropriate index files available":end
mastno=j

i=0:j=0
close #1
cls
locate ,20:print "Super - Multi-file Extract"
goto men
end if

if ucase$(right$(b$,4))<>".ICE"  then
print "Sorry, for operational reasons only .ice files area acceptable"
print "                              RUN ABORTED!!"
end
end if
j=instr(b$,".")

if j = 0 then
bind$=b$
else
bind$=left$(b$,j-1)
end if
bind1$=bind$+".ind"
bout$=bind$+".EXT"
bzip$=bind$+".zip"
open b$ for input as #1
close #1
zip1:
if r1=3 then
open bzip$ for input as #1
zip1=1
close #1
end if


if f$= "-" then noin=1:goto noin 'do not use index file
r1=2
open bind1$ for input as #2

noin:
r1=0
open bout$ for output as #3
mrest:
cls
if noin=0 then
LOcate,20:print "Extract using Index File"
else
locate,20:print "Extract - Index file not available"
end if
men:
locate ,20:Print "Station Extraction Criteria":print
locate ,13:Print "Type <YR> for year extractions,e.g. 89"
locate ,5:print "<PN> for position extraction e.g. 5608 (for lat) etc (RHS coordinates)"
locate ,5:print "<SN> for section extraction - (Extremeties + distance off)"
if noin=1 then
locate ,5:print "<SH> for country/ship, e.g. 74SC"
locate ,5:print "<MO> for month, eg 09"
locate ,5:print "<DY> for day, eg 08"
end if
locate ,15:Print "Type ZZ to finish sequence":print
mre:
print "(YR/PN/SN";
if noin=1 then print "/SH/MO/DY/ZZ)"; else print "/ZZ)";
s$=ucase$(INPUT$(2))
select case s$

case="YR"
incr ii:
print "   Start Year ";:xpos=pos(1):input yrs(ii)
locate csrlin-1,xpos+10
print "   End Year ";:input yre(ii)
if yrs(ii)>yre(ii) then beep:locate ,21:Print "Not allowed":decr ii

case= "PN"
incr ij
print " Min Latitude ";:xpos=pos(1):input milat(ij)
locate csrlin-1,xpos+10
Print "  Max Latitude ";:input malat(ij)
locate ,23:
print "Min Longitude ";:xpos=pos(1):input milon(ij)
locate csrlin-1,xpos+10
print " Max Longitude ";:input malon(ij)
if (milat(ij)>malat(ij)) or (milon(ij)>malon(ij)) then
beep
locate ,25:print "Not allowed":decr ij
end if

case = "SN"
incr ik
print " 1st Latitude ";:xpos=pos(1):input latd
gosub mins:y1(ik)=latd
locate csrlin-1,xpos+10
print " 1st Longitude ";:input latd
gosub mins:x1(ik)=latd
locate ,22
print " 2nd Latitude ";:xpos=pos(1):input latd
gosub mins:y2(ik)=latd
locate csrlin-1,xpos+10
print " 2nd Longitude ";:input Latd
locate ,22
gosub mins:x2(ik)=latd
print " Normal distance from section axis (nms) ";:input dist
dist(ik)=dist/60

case="SH"
incr il
print "   Country/Ship ";:input sh$(il)
do while right$(sh$(il),1)="?"
sh$(il)=left$(sh$(il),len(sh$(il))-1)
wend

case="MO"
incr im
print "   Start month ";:xpos=pos(1):input mns(im)
locate csrlin-1,xpos+10
print "   End month ";:input mne(im)
if mns(im)>mne(im) then beep:locate ,21:Print "Not allowed":decr im

case="DY"
incr in
print "   Start day ";:xpos=pos(1):input dys(in)
locate csrlin-1,xpos+10
print "   End day ";:input dye(in)
if dys(in)>dye(in) then beep:locate ,21:Print "Not allowed":decr in

end select

if s$<>"ZZ" then mre
print:print
if ii+ij+ik+il+im+in=0 then
locate ,10:print "WARNING - no selections have been made!"
end if
locate ,10:Print "Confirm (Y)"
while not instat
wend
s$=ucase$(inkey$)
if s$<>"Y" then  ik=0:ij=0:ii=0:il=0:im=0:in=0:goto mrest
if ij+ii+ik+il+im+in = 0 then
locate ,10:Print "You've been warned - no selections means no extractions!":end
end if
if ik<>0 then
for i = 1 to ik
gosub secext
next i
end if
cls
locate 5,5:print stn;
locate 5,10:Print "    Stations read";
locate 5,30:print wrt;
locate 5,35:print "    Stations Written";

if mastsel=1 then
ind=1
open ind$(ind) for input as #2
locate 10,1:print string$(80,32);
locate 10,15:print "Scanning file ...";ice$(ind)
goto wh
end if

if noin=0 and zip1=0 then
open b$ as #1 len=82
field #1, 82 as a$
end if

if noin=1 then
if zip1=1 then gosub unzip
zip2=1
open b$ for input as #1
line input #1,a$
end if

if noin=1 then nowhile
wh:
while not eof(2)

nowhile:
if noin=0 then
input #2,ayr,alat,alon,recn
else
ship$=mid$(a$,1,4)
amn=val(mid$(a$,22,2))
ady=val(mid$(a$,24,2))
ayr=val(mid$(a$,20,2)):alat=val(mid$(a$,9,4))
alon=val(mid$(a$,13,5))
if mid$(a$,18,1)="1" then alon=-alon
end if
stpper$=inkey$
if stpper$=" " then end
incr stn
if int(stn/100)=stn/100 then locate 5,5:print stn;
goyr=0:gola=0:gosn=0:gosh=0:gomn=0:gody=0

if ii<>0 then
 for i= 1 to ii
 if yrs(i)<=ayr and yre(i)>=ayr then goyr=1:exit for
 next i
else
goyr=1
end if

if ij<>0 then
for i = 1 to ij
if (milat(i)<=alat and malat(i)>=alat) and (milon(i)<=alon and malon(i)>=alon) then gola=1:exit for
next i
else
gola=1
end if

if ik<>0 then
for i = 1 to ik
gosub ident
if hit=1 then hit=0:gosn=1:exit for
next i
else
gosn=1
end if

if il<>0 then
for i = 1 to il
if left$(ship$,len(sh$(i)))=sh$(i) then gosh=1:exit for
next i
else
gosh=1
end if

if im<>0 then
 for i= 1 to im
 if mns(i)<=amn and mne(i)>=amn then gomn=1:exit for
 next i
else
gomn=1
end if

if in<>0 then
 for i= 1 to in
 if dys(i)<=ady and dye(i)>=ady then gody=1:exit for
 next i
else
gody=1
end if

if goyr+gola+gosn+gosh+gomn+gody<>6 then rein

if noin=0 then
if zip1=1 and zip2=0 then
gosub unzip
zip2=1
open b$ as #1 len=82
field #1, 82 as a$
if lof(1)<82 then
print "File ";b$; " was not unzipped from ";bzip$;". Run aborted"
kill b$
end
end if 
end if
if mastsel=1 and mzip2=0 then
mzip2=1
gosub opind
end if
get #1,recn

  if mid$(a$,80,1)="J" or mid$(a$,80,1)="2" then
  ' continue
 else   
 cls
   locate 10,1
   if b$="" then print b$; else print ice$(ind);
   print " has not got a compatible index file - regenerate using program INDEX"
   end
  end if
end if
go=0
incr wrt
locate 5,30
print wrt;
if noin=1 then goto reot
cyc:
get #1,recn

if mid$(a$,80,1)="J" or mid$(a$,80,1)="2" then incr go
if go=2 then go=0:goto rein
print #3,left$(a$,80)
incr recn
if recn>lof(1)/82 then rein
goto cyc

reot: ' sequential read

print #3,a$
line input #1,a$
if mid$(a$,80,1)="J" or mid$(a$,80,1)="2" then nowhile

if eof(1) then print #3,a$ else goto reot
goto fin

rein:
if noin=1 then
nogain:
line input #1,a$
if eof(1) then fin
if mid$(a$,80,1)="J" or mid$(a$,80,1)="2" then nowhile else nogain
end if

wend

if mastsel=1 then
ind=ind+1
if ind=mastno then fin:

close #1
close #2

open ind$(ind) for input as #2
if mzip=1 then kill b$
mzip=0
mzip2=0

locate 10,1:print string$(80,32);
locate 10,15:print "Scanning file....";ice$(ind)
goto wh
end if
fin:
locate 5,5:print stn;
if zip1=1 and zip2=1 then kill b$
if mzip=1 then kill b$
print:
if wrt=0 then
locate ,5
print
print "Very sorry but no relevant stations have been located"
kill bout$
else
locate,10:print "Extracted stations are in file ";bout$
end if
end



mins:  'converts minutes to fractions
latdif=(latd/100-int(latd/100))*100/60
latd=int(latd/100)+latdif
return

secext: 'prepare box round section
if x1(i)<>x2(i) then
 m0(i)=(y1(i)-y2(i))/(x1(i)-x2(i))
c0(i)=y1(i)-(m0(i)*x1(i))
else
C0(i)=Y1(i):m0(i)=10000
end if
ang(i)=atn(abs(m0(i)))
if abs(ang(i))<0.5 then
m90(i)=10000
else

ang90(i)=ang(i)/0.01745329+90

ang90(i)=ang90(i)*0.01745329
m90(i)=tan(ang90(i))
end if

c1(i)=c0(i)+dist(i)/cos(ang(i))
c2(i)=c0(i)-dist(i)/cos(ang(i))

c3(i)=y1(i)-m90(i)*x1(i)
c4(i)=y2(i)-m90(i)*x2(i)
return

ident: 'Is point within section box?

latd=alat
gosub mins:yin=latd
latd=alon
gosub mins:xin=latd
p0=yin-xin*m0(i)-c0(i)
p1=yin-xin*m0(i)-c1(i)
p2=yin-xin*m0(i)-c2(i)
p3=yin-xin*m90(i)-c3(i)
p4=yin-xin*m90(i)-c4(i)
if m0(i)=10000 then p1=0:p2=0
if (sgn(p1)+sgn(p2)=0) and (sgn(p3)+sgn(p4)=0) then hit=1

return

unzip:
screen ,1,1
cls
locate 1,1
if noin=0 or mastsel=1 then
print " Hit encountered in ";b$;" ..unzipping it to procede with extract"
else
print " Unzipping ";b$
end if
bb$="pkunzip "+bzip$+" "+b$+">nul"
shell bb$
screen ,1,0
return

opind: ' open ice file in multi-file extract
r2=0:mzip=0
b$=ice$(ind)
open b$ as #1 len=82
field #1, 82 as a$
if lof(1)<82 then
close #1
kill b$
r2=1
open izip$(ind) for input as #1
close #1
b$=right$(ice$(ind),len(ice$(ind))-4)
bzip$=izip$(ind)
gosub unzip
mzip=1
open b$ as #1 len=82
field #1, 82 as a$
if lof(1)<82 then
close #1
kill b$
print "File ";b$;" not unzipped from ";izip$(ind);". Run aborted"
end
end if
end if
return

handle:
if err=53 and r1=1 then
r1=3
resume next
end if
if err=53 and r1=3 then
color 31,0
print
print "    File ";b$;" or ";bzip$;" not available. Run aborted"
end
end if
if err = 53 and r1=2 then
noin=1:resume next
end if
if err = 53 and zip1=1 then
print "    File ";b$;" was not unzipped from ";bzip$; " Run aborted"
end
end if
if err=53 and r2=1 then
print "   File ";ice$(ind);" or ";izip$(ind); "not available. Run aborted"
end
end if
print "Error is ";err
end