on error goto handle
f$=command$
if f$="?" then
gosub info
else
if f$<>"" then
map$=f$+".SUR"
else
map$="atlant.sur"
end if
end if
key off
dim cs(17),cl(17),cd(17),fr$(17)
dim pout(3,600)
cls
'set up graphics screen - checks for screen type (not hercules)

if ucase$(f$)="H" then

xx2=720:yy2=348:xx1=0:yy1=0
sc=2:screen 2:bl=25:bl1=0

else
xx2=639:xx1=0:yy1=0
sc=12:screen 12:yy2=479:bl=31:bl1=1:exit if
sc11:
sc=11:screen 11:yy2=479:bl=31:bl1=1:exit if
sc10:
sc=10:screen 10:yy2=349:bl=25:exit if
sc09:
sc=9:screen 9:yy2=349:bl=25:exit if
sc08:
sc=8:screen 8:yy2=199:bl=25:exit if
sc07:
sc=7:screen 7:yy2=199:bl=25:exit if
sc02:
sc=2:screen 2:yy2=199:bl=25:exit if
end if
ycomp=yy2/20 'supresses vertical width by 5%
xxx2=xx2

locate 3,1
Input "Enter Name of Data File (ICES Format) "; B$
OPEN "I",#1,B$

minp:
if rec$="" then rec$="3":npar=12

print:print "Parameter list:"
'Print" 1- cou/ship, 2 -number 3- lat, 4 - long, 5- quadr, 6 - year, 7 - month"
'Print" 8 - sounding,"
'print "<1> - pressure <2> - temperature <3> - salinity <4> - 0xygen"
'if rec$="6" then
'Print"<5> - phosphate <6> - silicate <7> - nitrate <8> - nitrite <9> - ammonia"
'end if
'print
'dsp$(1)="p  ":dsp$(2)="t  ":dsp$(3)="S":dsp$(4)="O2"
'dsp$(5)="PO4":dsp$(6)="SiO":dsp$(7)="NO3":dsp$(8)="NO2":dsp$(9)="NH4"

' ICES format - start, field width and No of decimals

data 1,4,0,5,4,0,9,4,0,13,5,0,18,1,0,20,2,0,22,2,0
data 28,4,0,28,4,0,32,4,2,36,4,2,40,3,2,43,3,2
data 49,3,1,52,3,1,55,3,2,58,3,1

for i = 1 to npar
  read cs(i),cl(i),cd(i)
next i

'if rec$="3" then cs(npar)=58:cl(npar)=3:cd(npar)=2
'input "1st parameter no - y-axis (default 2):";par1(1)
'par1(1)=par1(1)+8
'if par1(1)=8 or par1(1)>npar then par1(1)=10
'input "2nd parameter no - x-axis (default 3):";par1(2)
'par1(2)=par1(2)+8
'if par1(2)=8 or par1(2)>npar then par1(2)=11
'Print "(3rd parameter is 1 (depth) - y-axis)":par1(3)=9
'print:

'max coordinates
input "Northmost Latitude (default 60)    ";max$
if max$="" then y1top(1)=60 else y1top(1)=val(max$)
input "Southmost Latitude (default 50) ";max$
if max$="" then y1bot(1)=50 else y1bot(1)=val(max$)
input "Westmost Longitude (default -10)   ";max$
if max$="" then xleft(1)=-10 else xleft(1)=val(max$)

xright(1)=xleft(1)+1.33*(y1top(1)-y1bot(1))/cos((y1top(1)+y1bot(1))*0.01745329/2)
xright(1)=int(xright(1))
merc=xright(1)
Print "Eastmost Longitude (default (Mercator) ";xright(1);:input max$
if max$<>"" then xright(1)=val(max$)
if xright(1)<=merc then
xxx2=(xleft(1)-xright(1))/(xleft(1)-merc)*xx2
xxx2=int(xxx2)
end if
print:

xleft(4)=xleft(1)
xright(4)=xright(1)

'input "Depth parameter - value at top (default -1) ";max$
'if max$="" then y1top(2)=-1 else y1top(2)=val(max$)
'Input "Depth parameter - value at bottom (default 100) ";max$
'if max$="" then y1bot(2)=100 else y1bot(2)=val(max$)

y1top(3)=y1top(2)
y1bot(3)=y1bot(2)
y1top(4)=y1top(1)
y1bot(4)=y1bot(1)

 ' divides screen into three equal portions, with 10% gaps between
win:
cls
grsc=sc:sc=0
winfr=xxx2
wixa(1)=winfr-90*winfr/100
wixb(1)=winfr-10*winfr/100
wixa(2)=2*winfr-90*winfr/100
wixb(2)=2*winfr-10*winfr/100
wixa(3)=3*winfr-90*winfr/100
wixb(3)=3*winfr-10*winfr/100
wixa(4)=0:wixb(4)=xxx2

window screen (xx1,yy2) - (xx2,yy1)

for ii = 1 to 1
fram=4:gosub vew:gosub box
next ii

col=1:yw=1
dspcol:
dsp$(1)="LAT":dsp$(2)="LONG"
locate bl/2,col
for ii = 1 to 3
print mid$(dsp$(1),ii,1)
locate ,col
next ii

locate 1+bl*(yy2-ycomp)/yy2,(xxx2/xx2)*36:print dsp$(2);
locate 1+(bl-10)*(ycomp)/(yy2),1:print y1top(1);
locate 1+(bl-1)*(yy2-ycomp)/yy2,1:print y1bot(1);
locate 1+bl*(yy2-ycomp)/yy2,1:print xleft(1);
:locate ,(xxx2/xx2)*77:print xright(1);
stn=-1
while not eof(1)
Line input #1,A$
gosub cycl
wend
gosub drawing:goto lst
cycl:
COD$=mid$(A$,79%,2%):cd$=mid$(a$,80%,1%)
if cod$="0J" or cod$="01" or cod$="02" then
if first = 1 then gosub drawing
numb$=mid$(a$,5,4):Lat$=mid$(a$,9,4):long$=mid$(a$,13,5)
quad$=mid$(a$,18,1):hr$=mid$(a$,20,6):ship$=mid$(a$,1,4)
if quad$="1" or quad$="3" then qua$="W" else qua$="E"
if quad$="0" or quad$="1" then hem$="N" else hem$="S"
lat1=val(left$(lat$,2)):lat2=val(right$(lat$,2))
long1=val(left$(long$,3)):long2=val(right$(long$,2))
lat2=lat2/60:long2=long2/60
pout(2,1)=lat1+lat2:pout(1,1)=long1+long2
if hem$="S" then pout(2,1)=-pout(2,1)
if qua$="W" then pout(1,1)=-pout(1,1)
if first =0 then gosub drawing:first=1
prof=1
snd$=mid$(a$,28,4):goto nxt
end if

'if COD$="P6" then de=1
'if CD$="3" or cd$="2" then hd=1
'if cd$=REC$ then
' incr prof:gosub make:de=0
'end if
'print pout(1,1),pout(2,1):end
nxt:
return

lst:
s$=input$(1)
s=asc(s$)
if s<>27 then

fram=4:gosub vew:
gosub coast
s$=input$(1)
end if
end

drawing:
'if prof=0 then return

fram=4
gosub vew

locate 1,3
incr stn
print "Station: ";numb$; " Position: ";lat$;hem$;" ";long$;qua$;" ";" Date: ";hr$;
print " Ship: ";ship$;" Profile: ";stn;
fram=4 'frame 1
par=pout(2,1)'lat
gosub ypos
par=pout(1,1)'long
gosub xpos

gosub vew
if ucase$(f$)="B" then
   circle (x,y),1
   paint (x,y)
   else
   pset (x,y),15
end if
if inkey$=" " then
 while not instat
 wend
end if
return

vew:
view screen (wixa(fram),yy1+ycomp) - (wixb(fram),yy2-ycomp)
return

box:
line (wixa(fram),yy1+ycomp) - (wixb(fram),yy1+ycomp)
line -(wixb(fram),yy2-ycomp)
line -(wixa(fram),yy2-ycomp)
line -(wixa(fram),yy1+ycomp)
return

ypos: ' position y component
y=((yy1+ycomp-yy2+ycomp)/(y1top(fram)-y1bot(fram)))*par
y=y+((yy2-ycomp)*y1top(fram)-(yy1+ycomp)*y1bot(fram))/(y1top(fram)-y1bot(fram))
return

xpos:
x=((wixa(fram)-wixb(fram))/(xleft(fram)-xright(fram)))*par
x=x+(wixb(fram)*xleft(fram)-wixa(fram)*xright(fram))/(xleft(fram)-xright(fram))
'print x,wixa(1),wixb(1)
'end
return

make: 'sub to prepare output

for ird= 1 to 3
i=par1(ird)
po=cs(i):ln=cl(i)
if i>12 then dec=cd(i)-de else dec=cd(i)
if i = 11 and cd$="3" then
 dec=cd(i)+hd:ln=ln+1:
end if
if i = 8 then
  pr$=SND$
  else
  pr$=mid$(a$,po,ln)
end if
for t= 1 to len(pr$)
 if mid$(pr$,t,1)<>" " then po1
next t
no=-90:dec=1:goto po2

po1:

 if po<8 then ' don't check overpunch
 pout(ird,prof)=val(pr$)
 goto po3
 end if
 call opunch(pr$,ln-1,po,no,tp,cd$)
 if tp=1 then end
po2:
 no=no/10^dec:

 pout(ird,prof)=no
po3:
 rem print #2:tab(j);no;

'print pout(ird,prof);
if pout(ird,prof)<-8 then decr prof:exit for
next ird

RETURN

info:
cls
locate 3,5:
print "STAPLOT functions only on station data files in the ICES format"
locate ,5
print "This must be available in your current directory":print
locate ,5
print "The following screen types are supported:"
print:locate ,25:Print "CGA/EGA/MCGA/VGA"
print
'locate ,5:Print "If you have a HERCULES card, press 'H' on leaving this screen"
'locate ,5:
'print "You may also implement the Hercules option by returning to DOS"
'locate ,5:print "and typing TSPLOT H"
print:locate ,5
print "When running the program, you will notice that progress through"
locate ,5
print "the data file is continuous. To stop on each station press the space"
locate ,5
print "bar; press any other key to return to the default mode. On completion"
locate ,5
print "you can leave the program by pressing <Esc>"
print:print:print
locate ,15:
print "Press any key to continue - but <Esc> aborts!"
do until s$<>""
while not instat
wend
s$=inkey$
s=asc(s$)
wend
cls
if s=27 then end
if ucase$(s$)="H" then f$=ucase$(s$)
return

$include "d:\bas\opunch.bas"


handle:
if err=5 and sc>0 then
 if sc=12 then resume sc11
 if sc=11 then resume sc10
 if sc=10 then resume sc09
 if sc=9 then resume sc08
 if sc=8 then resume sc07
 if sc=7 then resume sc02
 if sc=2 then
  cls:locate 5,5
  print "Sorry, graphics screen type not supported - run aborted"
  end
 end if
end if
 screen 0
if err= 53 then
 if nwel=1 then end
locate 10,1
 print "Data file ";b$;" not available on current directory ... run aborted"

else
print "error is ";err;" screen ";grsc
end if
while not instat
wend
s$=inkey$
end

coast:
resol=1:

nwel=1
res=-1
open "I",#2,map$
yyy1!=int(y1top(1)*10000):yyy2!=int(y1bot(1)*10000)
xxx1!=int(xleft(1)*10000):xxx2!=int(xright(1)*10000)
while not eof(2)
input #2,cn,dum
for ll=1 to cn
input #2,lg1,lt1
lat!=lt1*10000
long!=lg1*10000

incr res

  if (lat!>yyy1! or lat!<yyy2!)  then pset (x,y),0:jmp=1:goto jmp1
  if (long!<xxx1! or long!>xxx2!)  then pset (x,y),0:jmp=1:goto jmp1
  if (lat! <yyy1! and lat!>yyy2!) and (long!> xxx1! and long!<xxx2!) then

   incr fixt

   par=lt1:gosub ypos
   par=lg1:gosub xpos

   fram=4:gosub vew

   if fixt=1 then line (x,y)-(x,y):exit if
   if ll=1 then pset (x,y),0:exit if
   if jmp=1 then pset(x,y),0:jmp=0:exit if
   line (x1,y1)-(x,y)
      end if

x1=x:y1=y
jmp1:

next ll

wend
return
end
