' Program TraceCopy, version 2.0 written by John J. Miller, 1993
'USGS Open-File Report OF93-226

'Modification of TraceCopy Version 1.1; USGS Open File Report OF93-5

' Program TraceCopy, version 1.1written by John J. Miller, 1992
' Program to copy SEG-Y format seismic data traces on the Macintosh,
' modified from TracePlot, Version 1.1
 
' History of program development:
'December, 1992:  Began with TracePlot, version 1.1
'                            removed plot-specific parameters
'                            changed paramter labels to reflect copying rather than plotting
'                            modified help accordingly
'                            added error checks for copy
'                            added file-open dialog for Input and output
'                            removed END menu; added Quit to File menu
'March 1992:       Incorporate items from TracePlot version 2..0

DIM a(1)
DIM Thdrlabl$(10), ThdrIndex%(10)

DIM ReelHeader&(60), TraceHeader&(101)

'# of buttons including COPY 
numbuttons%=9

'# of edit field requestors
numfields%=numbuttons% - 2

DIM curbutton%(2),params$(numbuttons%)
DIM SHARED y1%(numbuttons%),y2%(numbuttons%),labls$(numbuttons%)

'   Global parameters that can be shared between subroutines without
'   being formal arguments

DIM SHARED gmnx%, gmny%, gmnx1%, gmny1%, gmxx%, gmxy%, gmxx1%, gmxy1%
DIM SHARED tg%, mul!, tm%,  tmx%, stx%, dtr%, dx% ,mxpix
DIM SHARED File$, pdfflag%
DIM SHARED  bcw%, bht%, gmxx%, gmxy%, plns,exitmenu%
DIM SHARED mtsamp, datafmt$, datafmt%
DATA File
DATA Open Input, Open Output, -, Quit
DATA Stop Copying
DATA Close files; Activate Parameter Screen
DATA Help
DATA Input File Name,1st Trace to Copy,Minimum Copy Time,Maximum Copy Time
DATA No. of Traces to Copy, Copy Trace Increment, Output File Name

DATA SEGY File Name-->
DATA 1 st trace-->
DATA Min. Time (ms)--->
DATA Max. Time (ms)-->
DATA # Traces-->
DATA Trace Increment-->
DATA Output File Name-->

' common parameters for input parameter screen graphics

gmnx% = 0                              'min x coordinate FOR screen
gmny% = 0                              'min y coordinate FOR screen
gmxx%=SYSTEM(5)-1
bcw% = 8                               'size of character, in pixels
gmxy% = SYSTEM(6)-47        'max y coordinate for screen
 b%=16
 mn% = b% / 2                        'min y coordinate FOR plot
 mx% = gmxy% - b% -2           'max y coordinate for plot

ON DIALOG GOSUB bob1
ON ERROR GOTO echk1

WINDOW 1,"",(0,20)-(gmxx%,SYSTEM(6)),2
WINDOW OUTPUT 1

'  set up pull down menus

nmenus% = 3
num%(1)=4:num%(2)=1:num%(3)=7

FOR i% = 1 TO nmenus%     

READ softk$
MENU i%,0,1,softk$

FOR j% = 1 TO num%(i%)
READ hlable$
MENU i%,j%,1,hlable$
NEXT j%

NEXT i%
cmdkey 1,1,"I"
cmdkey 1,2,"O"
cmdkey 1,4,"Q"

MENU ON
ON MENU GOSUB menuflag
FOR i%=2 TO nmenus%
MENU i%,0,0
NEXT
MENU 1, 1, 0
MENU 1, 2, 0
MENU 1, 3, 1
ON ERROR GOTO echk1

FOR i%=1 TO numfields%
READ labls$(i%)
NEXT

esc$ = CHR$(27)

params$(1)=""

ystart%=2
tcol%=25:tcol1%=10
yheight%=15
IF SYSTEM(6)>470 THEN
 yinc%=32
 rowinc%=2
 trow%=8:
ELSE
 yinc%=16
 rowinc%=1
 trow%=3
END IF

FOR i%=1 TO numfields%            
y1%(i%)= ystart%+(i%-1)*yinc%
y2%(i%)=y1%(i%)+yheight%
NEXT
x1field%=160
x2field%=x1field%+100   

x1butt%=x2field%+15
x2butt%=x1butt%+50

'initialize text size, font, etc.

CALL backcolor  (273)
CALL TEXTFONT(3)
CALL TEXTMODE(8)
CALL TEXTSIZE(12)
CALL TEXTFACE(1)

startflag%=0
CLS

CALL forecolor (30)
CALL TEXTFONT(3)
CALL TEXTMODE(8)
CALL TEXTSIZE(36)
LOCATE 1,3:
PRINT "Program TraceCopy;
LOCATE ,6
PRINT "Version 2.0"
CALL TEXTSIZE(24)
LOCATE ,7
PRINT "Seismic trace copying
LOCATE ,5
PRINT "program for the Macintosh"
PRINT
CALL TEXTSIZE(14)
LOCATE ,14
PRINT "USGS Open File Report OF93-226
 LOCATE ,21
PRINT "by John J. Miller
'GOTO skip4devel
CALL forecolor(33)
kk=mn%-mn%+1: kkk=mx%-mn%+1:si=1
RANDOMIZE TIMER
ERASE a
kk=1:kkk=300
DIM a(kkk-kk+1)
pi=3.14156

tot1=RND*24*pi
tot2=RND*24*pi
tot3=RND*24*pi
tot4=RND*24*pi
tot5=RND*24*pi
tot6=RND*24*pi
tot=kkk-kk+1
FOR i%=kk TO kkk
f1=tot1*(i%/tot)
f2=tot2*(i%/tot)
f3=tot3*(i%/tot)
f4=tot4*(i%/tot)
f5=tot5*(i%/tot)
f6=tot6*(i%/tot)

a(i%)=((SIN(f1)*SIN(f2)+COS(f3)+SIN(f4)+COS(f5)+COS(f6))/6)*20

NEXT

ix=25: va$="WG": pixdiff%=10: mint=0

FOR ix=15 TO 490 STEP 475
 IF ix>15 THEN
  FOR i%=kk TO kkk:a(i%)=-a(i%):NEXT
 END IF
CALL PlotVAorVAWG(a(), mint, si, kk, kkk, va$,ix,pixdiff%)
NEXT
skip4devel:
BUTTON 1,1,"Continue",(225,280)-(325,300)

nsamt=0
si=0
numtraces&=0
CALL forecolor (30)

LOCATE ,11
PRINT "Press any key or click continue to begin ..."

ON DIALOG GOSUB start
DIALOG ON

'Wait 9 seconds or click in continue button

j$=TIME$
j%=0
WHILE j%<9
 k$=RIGHT$(TIME$,2)
 IF k$<>j$ THEN
  j%=j%+1
  j$=k$
 END IF
IF INKEY$<>"" THEN GOTO start
WEND

start:
BUTTON CLOSE 1
DIALOG OFF

WINDOW 2,"",(5,SYSTEM(6)-99)-(275,SYSTEM(6)-5),2
WINDOW OUTPUT 2
CALL forecolor (30)
CALL backcolor  (273)
CALL TEXTFONT(3)
CALL TEXTMODE(8)
CALL TEXTSIZE(12)
CALL TEXTFACE(1)
CLS
WINDOW 3,"",(280,SYSTEM(6)-99)-(gmxx%-1,SYSTEM(6)-5),2
WINDOW OUTPUT 3
CALL forecolor (30)
CALL backcolor  (273)
CALL TEXTFONT(3)
CALL TEXTMODE(8)
CALL TEXTSIZE(12)
CALL TEXTFACE(1)
CLS
start1:
WINDOW 1,"",(0,20)-(gmxx%,SYSTEM(6)-105),2  'SYSTEM(6)-200),5
WINDOW OUTPUT 1
start2:
ON ERROR GOTO echk1
CALL forecolor (30)
CALL backcolor  (273)
CALL TEXTFONT(3)
CALL TEXTMODE(8)
CALL TEXTSIZE(12)
CALL TEXTFACE(1)
CLS

MENU 1,0,1:MENU 2,0,0:MENU 3,0,0
MENU 1,1,1:MENU 1,2,1
exitmenu%=0
pflag%=0
'initialize active field and button

curfield%=2
curbutton%(2)=curfield%

win =2
CALL ListHeadParams (win,nsamt,si,numtraces&)
WINDOW OUTPUT 1

redraw:
CALL DrawInputScreen(numfields%,numbuttons%,rowinc%,params$(), x1field%,x2field%,x1butt%,x2butt%,fileonly$,ofileonly$)


FOR i%=1 TO 10:act=DIALOG(0):NEXT

IF oldfile$ = "" THEN

getfile:
MENU 1,1,0: MENU 1,2,0: MENU 3,0,0             'Turn off open file and Help

 newfile$=FILES$(1,"TEXT")                                            'select new file to open

 IF newfile$<>"" AND newfile$<>params$(1) THEN         'new file selected

  flag%=0
  tfileonly$=newfile$
  tpathonly$=""
  FOR i%=LEN(newfile$) TO 1 STEP -1                          'Get file name only (strip path)
   IF MID$(newfile$,i%,1) = ":"  AND flag%=0 THEN
   IF i%< LEN(newfile$) THEN tfileonly$=MID$(newfile$,i%+1)
   IF i%>0 THEN tpathonly$=LEFT$(newfile$,i%)
   flag%=1
   END IF
  NEXT

 ON ERROR GOTO echk3

filnum%=1
OPEN newfile$ AS #filnum% LEN = 400
FIELD #filnum% ,400 AS hhead$

IF LOF(filnum%)<3200+400+240+4 THEN

CLS
CALL DrawInputScreen(numfields%,numbuttons%,rowinc%,params$(), x1field%,x2field%,x1butt%,x2butt%,tfileonly$,ofileonly$)

WINDOW OUTPUT 3
BEEP
CLS
LOCATE ,2
PRINT "The file you specified may not be a SEGY file!"
LOCATE ,2
PRINT "It's length is too short ("+STR$(LOF(filnum%))+" bytes)"
LOCATE ,2
PRINT "for there to be any traces in the file"
LOCATE ,10
PRINT "Try another file."
CLOSE #filnum%
newfile$=""
WINDOW OUTPUT 1
GOTO getfile
ELSE
WINDOW OUTPUT 3
CLS
WINDOW OUTPUT 1
END IF

sitmp = si
nstmp =nsamt
numtmp&=numtraces&
maxtmp = maxtrtime
datatmp%=datafmt%
Thdrtmp%=Thdrsize%
samptmp%=samplesize%
hdrsiztmp%=hdrsize%
datatmp$=datafmt$

CALL ReadReelHeader(filnum%, hhead$, nsamps% ,si , ReelHeader&())

datafmt%=ReelHeader&(10)

bob3:

Thdrsize%=60          'size of trace header (4-byte samples)
samplesize%=4                      'size of data sample
hdrsize%=900          'size of reel header (4-byte samples)

IF datafmt%=1 THEN
datafmt$="32-bit Floating Point"
ELSEIF datafmt%=2 THEN
datafmt$="32-bit Integer"
ELSEIF datafmt%=3 THEN
Thdrsize%=120        'size of trace header (2-byte samples)
samplesize%=2                      'size of data sample
hdrsize%=1800        'size of reel header (2-byte samples)
datafmt$="16-bit Integer"
ELSEIF datafmt%=4 THEN
datafmt$="16-bit Integer*Gain"
ELSE
datafmt$="Unknown"
END IF

bob2:
nsamt = nsamps%
osi = si
OPEN newfile$ AS #filnum% LEN = 1
filesize&=LOF(filnum%)
CLOSE #filnum%
tracesize%=Thdrsize%+nsamt
numbytes&=tracesize%*samplesize%
numtraces&= (filesize&-3600) / numbytes&
maxtrtime=(nsamt-1)*si

win = 2
CALL ListHeadParams (win,nsamt,si,numtraces&)

IF datafmt$="Unknown" THEN
WINDOW 1
CLS
CALL DrawInputScreen(numfields%,numbuttons%,rowinc%,params$(), x1field%,x2field%,x1butt%,x2butt%,fileonly$,ofileonly$)
WINDOW 3
BEEP
CLS
LOCATE 1,1
PRINT "There is a problem with the SEG-Y file header !!"
PRINT "The data format code is NOT valid!"
PRINT "You can override this parameter, or"
PRINT "select a different file."
BUTTON 20,1,"New File",(10,70)-(90,85)
BUTTON 21,1,"Override",(110,70)-(190,85)
loop3:
FOR i%=1 TO 10:act=DIALOG(0):NEXT
act1=0
WHILE act1 = 0:act1=DIALOG(0):WEND

IF act1 <> 1 THEN GOTO loop3

BUTTON CLOSE 20
BUTTON CLOSE 21
act1 = DIALOG(1) 
IF act1= 21 THEN                         'override format code (data sample type)
overrideflag%=1
CLS
PRINT "Select the desired data format:"
BUTTON 20,1,"32-bit Floating Point",(10,30)-(160,45)
BUTTON 21,1,"32-bit Integer",(170,30)-(320,45)
BUTTON 22,1,"16-bit Integer",(10,50)-(160,65)
BUTTON 23,1,"32-bit (16-bit * gain)",(170,50)-(320,65)
loop4:
FOR i%=1 TO 10:act=DIALOG(0):NEXT
act1=0
WHILE act1 = 0:act1=DIALOG(0):WEND

IF act1 <> 1 THEN GOTO loop4

BUTTON CLOSE 20
BUTTON CLOSE 21
BUTTON CLOSE 22
BUTTON CLOSE 23

datafmt%=DIALOG(1)-19

CLS
WINDOW 1
GOTO bob3

ELSEIF act1 = 20 THEN         ''Get new file, rather than override sample type
 CLS
 WINDOW 1
File$=""
si=sitmp
nsamt=nstmp
numtraces&=numtmp&
maxtrtime=maxtmp
osi=sitmp
datafmt%=datatmp%
Thdrsize%=Thdrtmp%
samplesize%=samptmp%
hdrsize%=hdrsiztmp%
datafmt$=datatmp$
win =2
CALL ListHeadParams (win,nsamt,si,numtraces&)
GOTO getfile
END IF

END IF

IF nsamt <1 OR si<=0 OR numtraces&<=0 THEN

WINDOW 1
CLS
CALL DrawInputScreen(numfields%,numbuttons%,rowinc%,params$(), x1field%,x2field%,x1butt%,x2butt%,fileonly$,ofileonly$)
WINDOW 3
BEEP
CLS
LOCATE 1,1
PRINT "There is a problem with the SEG-Y file header !!"
PRINT "# of samples, sample interval or # of traces is"
PRINT "NOT valid (see left).  You can override these"
PRINT "Parameters or enter a new file name."
BUTTON 20,1,"New File",(10,70)-(90,85)
BUTTON 21,1,"Override",(110,70)-(190,85)
loop1:
FOR i%=1 TO 10:act=DIALOG(0):NEXT
act1=0
WHILE act1 = 0:act1=DIALOG(0):WEND

IF act1 <> 1 THEN GOTO loop1

BUTTON CLOSE 20
BUTTON CLOSE 21
act1 = DIALOG(1)

IF act1= 21 THEN
CLS
overrideflag%=1
PRINT "No. of Samples:-->
LOCATE 3,1
PRINT "Sample Interval-->"
IF nsamt>=1 THEN nsamp$=STR$(nsamt)
IF si>0 THEN si$=STR$(si)
ltrim si$:ltrim nsamp$
EDIT FIELD 20,nsamp$,(150,4)-(250,19)
EDIT FIELD 21,si$,(150,32)-(250,47)
BUTTON 20,1,"Accept",(150,55)-(250,70)
one%=20: two%=21
EDIT FIELD one%,nsamp$,(150,4)-(250,19)

loop2:
FOR i%=1 TO 10:act=DIALOG(0):NEXT
act1=0
WHILE act1 = 0:act1=DIALOG(0):WEND
IF act1=1 OR act1=2 OR act1=6 THEN

IF act1 = 1 THEN                      'Accept button pressed

 nsamp$=EDIT$(20)
 si$=EDIT$(21)
 EDIT FIELD CLOSE 20
 EDIT FIELD CLOSE 21
 BUTTON CLOSE 20
 nsamps%=VAL(nsamp$)
 si = VAL(si$)
 CLS
 WINDOW 1
 GOTO bob2                'Override #samps and si; check to see if parameters are reasonable

ELSE                          'field changed or enter pressed

 SWAP one%,two%
 a$=EDIT$(two%)

 IF one%=20 THEN       'Current field is  20
 si$=a$
  EDIT FIELD 20,nsamp$,(150,4)-(250,19)
 ELSE
  nsamp$=a$
  EDIT FIELD 21,si$,(150,32)-(250,47)
 END IF

 GOTO loop2

END IF

ELSE
 GOTO loop2
END IF

ELSEIF act1 = 20 THEN     'Get new file, rather than override nsamps and si
File$=""
si=sitmp
nsamt=nstmp
numtraces&=numtmp&
maxtrtime=maxtmp
osi=sitmp
datafmt%=datatmp%
Thdrsize%=Thdrtmp%
samplesize%=samptmp%
hdrsize%=hdrsiztmp%
datafmt$=datatmp$
CLS
WINDOW 1
win =2
CALL ListHeadParams (win,nsamt,si,numtraces&)
GOTO getfile
END IF

END IF


params$(2)="1"
params$(3) = "0"
mint=VAL(mint$)
maxt = (nsamt - 1) * si
params$(4) = STR$(maxt)
ltrim params$(4)
params$(5) = "50"
params$(6)= "1"
IF params$(7)="" THEN
 ofileonly$="Copy of "+ tfileonly$
 params$(7)=tpathonly$+ofileonly$
END IF

'Redraw screen with new default parameters

  params$(1)=newfile$
  oldfile$=newfile$
  fileonly$=tfileonly$
  pathonly$=tpathonly$
CLS
CALL DrawInputScreen(numfields%,numbuttons%,rowinc%,params$(), x1field%,x2field%,x1butt%,x2butt%,fileonly$,ofileonly$)

 ELSEIF params$(1)<>"" THEN              'File has already been selected

 CLS
 CALL DrawInputScreen(numfields%,numbuttons%,rowinc%,params$(), x1field%,x2field%,x1butt%,x2butt%,fileonly$,ofileonly$)

 ELSEIF params$(1)="" THEN               'No file has been selected

 CLS
 CALL DrawInputScreen(numfields%,numbuttons%,rowinc%,params$(), x1field%,x2field%,x1butt%,x2butt%,fileonly$,ofileonly$)
 WINDOW 3
 CLS
 BEEP
 LOCATE 1,1
 PRINT "You MUST select a file to continue!"
 BUTTON 20,1,"Continue",(10,40)-(90,55)
 BUTTON 21,1,"End",(110,40)-(190,55)
 FOR i%=1 TO 10:act=DIALOG(0):NEXT
 act1=0
 WHILE act1 = 0:act1=DIALOG(0):WEND

 BUTTON CLOSE 20
 BUTTON CLOSE 21
 act1 = DIALOG(1)
 IF act1= 21 THEN END
 CLS
 WINDOW 1
 GOTO getfile
 END IF

ELSE

END IF

MENU 1,0,1:MENU 1,1,1: MENU 1,2,1:MENU 2,0,0:MENU 3,0,1
exitmenu%=0
pflag%=0

'initialize active field and button
'turn on initial button and field

onbutt%=curbutton%(2)
EDIT FIELD onbutt%,params$(onbutt%),(x1field%,y1%(onbutt%))-(x2field%,y2%(onbutt%))

bob1:

WINDOW OUTPUT 1

FOR i%=1 TO 10:act=DIALOG(0):NEXT

act=0
WHILE act = 0:act=DIALOG(0):WEND
WINDOW OUTPUT 3
CLS                                  'Clear message in error/help window
WINDOW OUTPUT 1

IF (act=1 OR act=2 OR act=6) THEN

IF pflag%=1 THEN  pflag%=0


 IF act=1 THEN                                                      'Button Pressed
   IF DIALOG(1) < numbuttons%-1 THEN    'User has clicked an OK button
     curfield%=curfield%+1                                    'Other than copy
     IF curfield%=numfields% THEN curfield%=2
   END IF
 ELSEIF act=2 THEN            'User has moved to another edit field
  curfield%=DIALOG(2)
 ELSE                                    'User has Pressed the enter button in a field
  curfield%=curfield%+1
  IF curfield%=numfields% THEN curfield%=2
 END IF

chkbutton%=curbutton%(2)
temp$=EDIT$(chkbutton%)
 
ON ERROR GOTO echk1

'Transfer value from field to array

 params$(curbutton%(2))=EDIT$(curbutton%(2))

  curbutton%(2) = curfield%
  onbutt%=curbutton%(2)
  EDIT FIELD onbutt%,params$(onbutt%),(x1field%,y1%(onbutt%))-(x2field%,y2%(onbutt%))

'ĘCopy button pushed
  IF act = 1 AND DIALOG(1) = numbuttons%-1 THEN GOTO copy
 
  IF overrideflag%=1 THEN overrideflag%=0

GOTO bob1
ELSE
 GOTO bob1
END IF


copy:

mint=VAL(params$(3))
maxt=VAL(params$(4))
mnsamp = INT(mint / si) + 1
t=(mnsamp-1)*si
IF t<mint THEN mnsamp = mnsamp+1
nsamp = INT(maxt / si) + 1
mxt = (nsamp-1)*si
IF mxt>maxt THEN nsamp = nsamp-1
IF nsamp>nsamt THEN nsamp = nsamt
mtsamp = nsamp - mnsamp + 1


WINDOW OUTPUT 3
IF mint>maxtrtime THEN
 PRINT "Minimum Time is greater than last
 PRINT "sample's time!  No data can possibly
 PRINT "be copied using these parameters."
 onbutt%=3
 pflag%=1
ELSEIF mint <0 THEN
 PRINT "Minimum Time MUST be greater than 0!"
 onbutt%=3
 pflag%=1
ELSEIF maxt<mint THEN
 PRINT "Maximum time must be greater
 PRINT"than minimum time!"
 onbutt%=4
 pflag%=1
ELSEIF maxt<=0 THEN
 PRINT "Maximum time must be greater than 0!"
 onbutt%=4
 pflag%=1
ELSEIF maxt>maxtrtime THEN
PRINT "Maximum time is too large! ! !
PRINT "It cannot be greater than the largest trace time.
 onbutt%=4
 pflag%=1
ELSEIF VAL(params$(2)) < 1 THEN
PRINT "First trace to copy MUST be >0 !"
 onbutt%=2
 pflag%=1
END IF

WINDOW OUTPUT 1

IF pflag%=1 THEN
 BEEP
 curbutton%(2) = onbutt%
 EDIT FIELD onbutt%,params$(onbutt%),(x1field%,y1%(onbutt%))-(x2field%,y2%(onbutt%))
 GOTO bob1
END IF

ofile%=2
outfile$=params$(7)

'Check that input and output are different files

IF UCASE$(params$(7))=UCASE$(params$(1)) THEN
 WINDOW OUTPUT 3
 CLS
 BEEP
 LOCATE 2,1
 PRINT "The Input and Output Files MUST be different!"
 WINDOW OUTPUT 1
 GOTO bob1
END IF

'Check if output file exists

ON ERROR GOTO echk4
OPEN outfile$ FOR APPEND AS #ofile%
a&=0
a&=LOF(ofile%)
CLOSE #ofile%

act2 = 0
IF a&>0 THEN
 WINDOW 3
 MENU 3,0,0:
 MENU 1,1,0:MENU 1,2,0
 CLS
 BEEP
 PRINT "The output file specified is not empty
 PRINT "Please select whether to provide a new
 PRINT "file name, to append traces to the end
 PRINT "of the file, or to overwrite the file.
pflag%=1
BUTTON 20,1,"New File",(10,70)-(90,85)
BUTTON 21,1,"Append",(110,70)-(190,85)
BUTTON 22,1,"Overwrite",(210,70)-(290,85)

FOR i%=1 TO 10:act=DIALOG(0):NEXT
act2=0
WHILE act2 = 0:act2=DIALOG(0):WEND

BUTTON CLOSE 20
BUTTON CLOSE 21
BUTTON CLOSE 22
MENU 1,1,1:MENU 1,2,1
MENU 3,0,1
CLS

act2 = DIALOG(1)
IF act2= 20 THEN                  'New file
  WINDOW 1
  GOTO bob1
ELSEIF act2 = 21 THEN         'Append to existing file

'Open output file, read header, make sure sample interval and 
'# of samples are equal to input file being copied

OPEN outfile$ AS #ofile% LEN = 400
FIELD #ofile% ,400 AS hhead$
CALL ReadReelHeader(ofile%, hhead$, ns%, ssi , ReelHeader&())
CLOSE #ofile%

IF ns%<> mtsamp THEN
 BEEP
 PRINT "# of samples in output file: ";ns%
 PRINT "# of samples to be copied: ";mtsamp
 PRINT "The above two #'s MUST be equal in
 PRINT "order to append traces to the output file."
 WINDOW 1
 GOTO bob1
ELSEIF ssi < si THEN
 BEEP
 PRINT "Sample interval of ouput file: ";ssi
 PRINT "This # is not equal to the  sample
 PRINT "interval of the input file ! ! !
 WINDOW 1
 GOTO bob1
END IF

ELSEIF act2 = 22 THEN         'Overwrite existing file
 WINDOW 1
END IF

END IF

WINDOW OUTPUT 1

CALL CloseInput(numfields%)
CLS
ON ERROR GOTO echk2

' Calculate final copying parameters
jj& = 1
File%=1

IF datafmt%=3 THEN
Thdrsize%=120        'size of trace header (2-byte samples)
samplesize%=2                      'size of data sample
hdrsize%=1800        'size of reel header (2-byte samples)
ELSE
Thdrsize%=60          'size of trace header (4-byte samples)
samplesize%=4                      'size of data sample
hdrsize%=900          'size of reel header (4-byte samples)
END IF

tracesize%=Thdrsize%+nsamt                             'size of trace, in 4- or 2-byte blocks

numbytes&=tracesize%*samplesize%                 'size of trace, in bytes
numtraces&= (filesize&-3600) / numbytes&      '# of traces in current data file

jj&=VAL(params$(2))
ntrpanl = VAL(params$(5))
trinc& = VAL(params$(6))


tg%=5

oldmtsamp=mtsamp
oldsi = si

ERASE a
DIM a(mtsamp)

' Routine to copy traces

MENU 1,1,0: MENU 1,2,0: MENU 2,0,1:MENU 3,0,0

ON ERROR GOTO echk2

j=1
scale=1
s1=1
nplot=0
IF nplot = 0 THEN

'  Open SEGY input file and position pointer to the 1st trace
infile$=params$(1)
 LOCATE 1,2:PRINT "File being copied now . . .
 LOCATE  2,2:PRINT "Opening Input file: "
 LOCATE 3,2: PRINT infile$

IF act2 <> 21 THEN                            'Copy header(s) from input file

 OPEN outfile$ FOR OUTPUT AS #ofile%

 LOCATE 4,2:PRINT "Copying traces to NEW Output file: "
 LOCATE 5,2: PRINT outfile$

'copy 3200 byte header
OPEN infile$ AS #filnum% LEN = 400
FIELD #filnum% ,400 AS hhead$
FOR i%=1 TO 8
 GET #filnum%
 PRINT #ofile%,hhead$;
NEXT

'read 400 byte header
 GET #filnum%

' Create # samples for THIS file
 mts%=mtsamp         
 aa$=MKI$(mts%)
 hhead$=LEFT$(hhead$,20)+aa$+MID$(hhead$,23)

' Create Sample Interval for THIS file
 si%=si * 1000
 aa$=MKI$(si%)
 hhead$=LEFT$(hhead$,16)+aa$+MID$(hhead$,19)

' Create Data format type for THIS file
 aa$=MKI$(datafmt%)
 hhead$=LEFT$(hhead$,24)+aa$+MID$(hhead$,27)

 PRINT #ofile%,hhead$;
 
 CLOSE #filnum%

ELSE                                           'Open output file to append traces

 LOCATE 4,2:PRINT "Appending traces to EXISTING Output file: "
 LOCATE 5,2: PRINT outfile$
 OPEN outfile$ FOR APPEND AS #ofile%

END IF

 LOCATE tg%+4,2:PRINT  "CDP/FFID being written:  ";
 LOCATE tg%+5,2:PRINT "Total traces copied: "
 LOCATE tg%+7,2:PRINT "Number of samples being copied: ";mtsamp
 LOCATE tg%+9,2:PRINT SPACE$(150);
 LOCATE tg%+9,2: PRINT "Press ESC to pause . . .";

 File%=1: nplot=1
 OPEN infile$  AS #File% LEN = samplesize%
 FIELD #File%, samplesize% AS head1$
 GET #File%, hdrsize%

END IF

nsamps%=nsamt

WHILE EOF(1) = 0

  IF j>ntrpanl THEN             '# of traces to copy reached
    LOCATE tg%+9,2:PRINT SPACE$(150);
    LOCATE tg%+9,2:PRINT "Specified # of traces copied.  Press ANY key . . "
   confirm b$
   GOTO exitFromMenu           
  END IF

 IF exitmenu%=1 THEN GOTO exitFromMenu
 k$=INKEY$
 IF k$=esc$ THEN
  LOCATE tg%+9,2:PRINT SPACE$(150);
  LOCATE tg%+9,2: PRINT "Temporary pause; Press ESC to  stop copying and activate menu. . .";
  confirm k$
  IF exitmenu%=1 THEN GOTO exitFromMenu
  IF k$=esc$ THEN
exitFromMenu:
    CLOSE
    startflag%=1
    GOTO start 
  END IF

LOCATE tg%+9,2:PRINT SPACE$(150);
LOCATE tg%+9,2: PRINT "Press ESC to pause . . .";
 
END IF

'  Read 240 Byte Trace Header, mtsamp samples and copy both

'Position file pointer

position& = hdrsize% + (jj&-1) * tracesize%
GET #File%,position&
scale = 1

CALL ReadTrace (File%,mnsamp, nsamp, position&,head1$, TraceHeader&(), a(),ofile%,nsamt,eflag%,Thdrsize%)
IF eflag%=1 THEN
  LOCATE tg%+9,2:PRINT SPACE$(150);
  LOCATE tg%+9, 2
  PRINT "End of input file reached.  Press ANY KEY . . .";
  confirm a$
  CLOSE
  startflag%=1
  GOTO start
END IF


LOCATE tg%+4,30:PRINT SPACE$(50);
LOCATE tg%+4,30:PRINT TraceHeader&(6);" / ";TraceHeader&(3);
LOCATE tg%+5,30:PRINT SPACE$(50);
LOCATE ,30:PRINT j;
 
j = j + 1
jj&=jj&+trinc&     

WEND

CLOSE
startflag%=1
GOTO start

 
END


menuflag:
Menuitem=MENU(0)
IF Menuitem = 1 THEN
MENU 1,0,0
iflag%=MENU(1)
IF iflag%=1 THEN              'open new input file

MENU 1,0,1
RETURN getfile

ELSEIF iflag%=2 THEN        'open new ouput file

 ofile$=FILES$(0,"Output File:")

 IF ofile$<>"" THEN     'AND ofile$<>params$(7) THEN         'new file selected

  flag%=0
  FOR i%=LEN(ofile$) TO 1 STEP -1                          'Get file name only (strip path)
   IF MID$(ofile$,i%,1) = ":"  AND flag%=0 THEN
   IF i%<LEN(ofile$) THEN ofileonly$=MID$(ofile$,i%+1)
   IF i%>0 THEN pathonly$=LEFT$(ofile$,i%)
   flag%=1
   END IF
  NEXT
  params$(7)= ofile$
 END IF
 
CLS
CALL DrawInputScreen(numfields%,numbuttons%,rowinc%,params$(), x1field%,x2field%,x1butt%,x2butt%,fileonly$,ofileonly$)

MENU 1,0,1
ELSEIF iflag%=4 THEN
 END
END IF

RETURN

ELSEIF Menuitem=2 THEN 
   MENU 2,0,0
   iflag%=MENU(1)
   exitmenu%=1
   RETURN

ELSEIF Menuitem=3 THEN

MENU 3,0,0
WINDOW OUTPUT 3
CLS
iflag%=MENU(1)
LOCATE 1,1
IF iflag%=1 THEN
PRINT "The file name that contains the SEG-Y data."
PRINT "This can be any valid Macintosh file name that
PRINT "actually exists.  If the # of samples per trace"
PRINT "and sample interval cannot be determined"
PRINT "from the file header, you will be able to"
PRINT "override these values.";

ELSEIF iflag%=2 THEN
PRINT "The SEQUENTIAL trace in the file at which
PRINT "to begin copying.
PRINT "Example:  If the file contains shot gathers
PRINT "composed of 96 traces each and you wish to
PRINT "begin copying at the second shot gather,
PRINT "type 97 for this parameter.";

ELSEIF iflag%=3 THEN
PRINT "The time at of the 1st sample to copy, in ms.
PRINT "This time must be >=0 AND <= the maximum
PRINT "time of the traces.  See window to the left
PRINT "for the maximum trace time of the current
PRINT "file.";

ELSEIF iflag%=4 THEN
PRINT "The time of the last sample to copy, in ms.
PRINT "This must be >= minimum time and also
PRINT "must be <= maximum time.";

ELSEIF iflag%=5 THEN
PRINT "The number of traces to copy.
PRINT "To copy all traces, enter a number that
PRINT "is larger than the maximum # of traces
PRINT "in the file.";

ELSEIF iflag%=6 THEN
PRINT "Increment at which to  copy traces.
PRINT "Example:  Type 2 if you want every 2nd trace
PRINT " copied, (beginning at the 1st trace specified).";

ELSEIF iflag%=7 THEN
PRINT "The file name  that will contain the copied data."
PRINT "This can be any valid Macintosh file name."
PRINT "If the file already exists, you can provide"
PRINT "a new file name, overwrite the file, or append"
PRINT "traces to the end of the file.";

ELSE
BEEP
PRINT "Sorry, help is not available for this item."
END IF
pflag%=1
WINDOW OUTPUT 1
MENU 3,0,1
RETURN

END IF

echk2:

WINDOW 2,"Copying Error",(100,100)-(500,300),5
WINDOW OUTPUT 2
BEEP
LOCATE 2,1
PRINT " An Error Occurred When Copying. 
PRINT
PRINT " NOTE:  You will have to restart the program.
PRINT
PRINT " If you cannot solve the problem, make a note of the error
PRINT " number below and call (303) 236-5752 for assistance."
PRINT " Error number: "; ERR
PRINT
PRINT "                               Press a key . . .";
k$=INPUT$(1)
WINDOW CLOSE 2
WINDOW CLOSE 1
END

echk1:
' error recovery handler
CLS : BEEP
'WINDOW OUTPUT 3
LOCATE 2,2: PRINT "An unrecoverable error occurred ! ! !
LOCATE ,2: PRINT "You will have to restart the program.
LOCATE ,2: PRINT " If you cannot solve the problem, make a note of the error
LOCATE ,2: PRINT " number below and call (303) 236-5752 for assistance."
LOCATE ,2: PRINT " Error number: "; ERR
LOCATE ,2: PRINT
LOCATE ,2: PRINT "Press a key . . .
k$=INPUT$(1)
ON ERROR GOTO 0

echk3:   

WINDOW OUTPUT 3

LOCATE 2,3
SELECT CASE ERR
CASE 52
PRINT "The file name that you typed was bad."
CASE 53
PRINT "The file that you typed was not found.
CASE 64
PRINT "The file name that you typed was bad."
CASE 75
PRINT "A path- OR file- access error has occured."
CASE 76
PRINT "The PATH that you provided to the file is bad."
CASE ELSE
PRINT "The following unrecoverable error has occurred:"
LOCATE , 5: PRINT ""
PRINT i%
ON ERROR GOTO 0
END SELECT


PRINT "              Try another file."
File$=""
WINDOW OUTPUT 1
RESUME start2

echk4:
RESUME NEXT


pdferr:
pdfflag% = 1
RESUME NEXT

SUB ListHeadParams (win,nsamt,si,numtraces&) STATIC

WINDOW OUTPUT win
CLS
LOCATE 1,2
PRINT "Determined from Header:"
LOCATE ,2
PRINT "Sample Interval (ms): ";si
LOCATE ,2
PRINT "Number of Samples/trace: ";nsamt
LOCATE ,2
PRINT"Maximum trace time (ms): "; (nsamt-1)*si
LOCATE ,2
PRINT "Number of traces in file: "; numtraces&
LOCATE ,2
PRINT "Format: "; datafmt$;
WINDOW OUTPUT 1
END SUB

SUB CloseInput(n%) STATIC
  FOR i%=1 TO n%+7
   IF i%<=n% THEN EDIT FIELD CLOSE i%
   BUTTON CLOSE i%
  NEXT
END SUB

SUB ltrim(a$) STATIC

'  Trim leading blanks from a string

FOR i%=1 TO LEN(a$)
 IF MID$(a$,i%,1)<> " " THEN
  a$=MID$(a$,i%)
  EXIT SUB
 END IF
NEXT i%
END SUB

SUB rtrim(a$) STATIC

'  Trim trailing blanks from a string

FOR i%=LEN(a$) TO 1 STEP -1
 IF MID$(a$,i%,1)<> " " THEN
  a$=MID$(a$,1,i%)
  EXIT SUB
 END IF
NEXT i%
END SUB


SUB make2byte (aa$, n%, j%) STATIC

'Subroutine to convert a 2-byte string to an integer
' aa$ = string containing the bytes to be converted
' n%  = starting byte # (starting byte counter = 1)
' j%  = integer (returned)

'extract bytes (12)

c$=MID$(aa$,n%,2)

'convert bytes into integer

j% = CVI(c$)

END SUB

SUB Make4Byte (aa$, n%, kl&) STATIC

'Subroutine to convert a 4-byte string to a long integer
' aa$ = string containing the bytes to be converted
' n%  = starting byte # (starting byte counter = 1)
' kl& = long integer (returned)

'extract bytes (1234)

E$=MID$(aa$,n%,4)

'convert 4-byte string into long integer

kl& = CVL(E$)

END SUB

SUB ReadReelHeader(filnum%, hhead$, nsamps% ,si, ReelHeader&()) STATIC
' ---------------------------------------------------------------------
'  Subroutine to read and decode 400 byte Reel Header
' ---------------------------------------------------------------------

'  Read 400 Byte Reel Header

'PRINT "reading 400 byte header: "

GET #filnum%, 9

'  Decode items from Reel Header, store information in array ReelHeader&()

i% = 0      'Counter for items decoded

FOR n% = 1 TO 9 STEP 4
 CALL Make4Byte(hhead$, n%, kl&)
 i% = i% + 1
 ReelHeader&(i%) = kl&
'PRINT "Bytes "; n%; " - "; n% + 3; ": "; ReelHeader&(i%)
NEXT

FOR n% = 13 TO 55 STEP 2
 CALL make2byte(hhead$, n%, j%)
 i% = i% + 1
 ReelHeader&(i%) = j%
' PRINT "Bytes "; n%; " - "; n% + 1; ": "; ReelHeader&(i%)
NEXT

nsamps%=ReelHeader&(8)
si = ReelHeader&(6) / 1000
CLOSE

END SUB

SUB ReadTrace(filnum%,mnsamp, nsamp, position&,head1$, TraceHeader&(), trace(),ofile%,nsamt,eflag%,Thdrsize%) STATIC

' ---------------------------------------------------------------------
'  Subroutine to read and copy 240 byte Trace Header and mtsamp samples
' ---------------------------------------------------------------------

eflag%=0
thead$=""

FOR i% = 1 TO Thdrsize%
 GET #filnum%
IF EOF(1) THEN 
 eflag%=1
 EXIT SUB
END IF
 thead$ = thead$ + head1$
NEXT i%

CALL Make4Byte (thead$, 9, TraceHeader&(3))          'FFID
CALL Make4Byte (thead$, 21, TraceHeader&(6))         'CDP
mts% = nsamp - mnsamp + 1

IF mts%<nsamt THEN
 aa$=MKI$(mts%)
 thead$=LEFT$(thead$,114)+aa$+MID$(thead$,117)
END IF

PRINT #ofile%,thead$;


'Position File Pointer
position&=position&+Thdrsize%+mnsamp-1
GET #filnum%,position&             

'READ Trace Samples AND copy them

FOR i% = mnsamp TO nsamp
 GET #filnum%
 PRINT #ofile%,head1$;
NEXT i%

END SUB

SUB confirm (a$) STATIC
a$=""
WHILE a$=""
IF exitmenu%=1 THEN EXIT SUB
a$=INKEY$
WEND
END SUB

SUB PlotVAorVAWG (ss(), mint, si, kk, kkk, va$,ix,pixdiff%)  STATIC
Plotva:
'  Subroutine PlotVAorVAWG, written Jan 4, 1990 by John J. Miller
'  This routine plots a seismic trace contained in array ss() in either
'  Variable area or Variable area+Wiggle style, depending on the value of va$.

 LINE (ix+ss(kk), gmny1%+pixdiff%)-(ix+ss(kk), gmny1%+pixdiff%)
 FOR i = kk + 1 TO kkk
 IF ss(i) > 0 THEN
 '  Current sample value is >0

  '  If previous sample value was < 0 and Plot style is VAWG, draw connecting line
  IF ss(i - 1) < 0 AND va$ <> "VA" THEN LINE -(ix+ss(i), (i - kk) * si + gmny1%+pixdiff%)

  '   Plot VA portion of trace
   LINE (ix, (i - kk) * si + gmny1%+pixdiff%)-(ix+ss(i), (i - kk) * si + gmny1%+pixdiff%)

 ELSEIF va$ <> "VA" THEN
'  Current sample value is negative and plot style is
'  VAWG, so draw connecting line.
  LINE -(ix+ss(i), (i - kk) * si + gmny1%+pixdiff%)
 END IF
 NEXT i

END SUB
SUB DrawInputScreen(numfields%,numbuttons%,rowinc%,params$(),x1field%,x2field%,x1butt%,x2butt%,fileonly$,ofileonly$)  STATIC

'Subroutine to draw Input Parameter Screen

frow%=INT(y2%(1)/15+.5)-rowinc%

FOR i%=1 TO numbuttons%
frow%=frow%+rowinc%
LOCATE frow%,2:PRINT labls$(i%)
IF i%>1 AND i%< numfields% THEN
 'BUTTON i%,0,"Accept",(x1butt%,y1%(i%))-(x2butt%,y2%(i%))
 EDIT FIELD i%,params$(i%),(x1field%,y1%(i%))-(x2field%,y2%(i%))
ELSEIF i%=1 THEN
 LOCATE frow%,18
 PRINT fileonly$
ELSEIF i%=numfields% THEN         'specific to TraceCopy
 LOCATE frow%,18
 PRINT ofileonly$
END IF
NEXT
BUTTON numbuttons%-1,1,"Copy",(x1butt%, y1%(2))-(x2butt%,y2%(2))
'BUTTON numbuttons%,1,"Quit",(x1butt%+75,y1%(1))-(x2butt%+75,y2%(1))
END SUB