' Program TracePlot, version 2.2, Seismic trace plotting program for the Macintosh ' USGS Open-File Report OF93-226: ' Version 2.1 was a modification of Version 2.0 to add trace bias, annotation increment ' and overlap parameter correction. Open File number did not change ' Version 2.2 was a modification of Version 2.1 to add trace weighting factor for ' integer formats (stored in trace header bytes 169-170) ' Version 2.0 was a modification of: ' Program TracePlot, version 1.1, Seismic trace plotting program for the Macintosh ' USGS Open-File Report OF93-5 ' by John J. Miller ' History of development: ' TRACEPLT, Version 1.1; Jan 26, 1990: Completed development of trace-plotting ' program for IBM/PC computer for internal use (plots non-standard ASCII and Binary ' files only). ' Sept 16, 1992; Began MacIntosh port. ' Sept 17, 1992; Completed port for ASCII file ' Sept 21, 1992; Began to adapt SEGY reading routine to program ' SEG-Y read algorithm developed after consultation with F.N. Zihlman and his publication: ' PLOTSEGY, V1..0: A DOS graphics program to display SEG-Y disk-image seismic DATA, ' USGS Open-File Report 92-349A and B." ' Sept 21, 1992; Completed development of initial program ' Sept 22, 1992; Modified to plot starting at any trace ' Sept 24, 1992; Modified input screen to use edit fields and buttons ' October, 1992; Added error window and override for file with invalid header ' November, 1992; Added help ' added trace increment for plotting ' added normalization option for scaling ' added buttons for VA, WG, and VAWG ' added buttons for LR and RL ' December, 1992: Added standard Open-file dialog; ' removed END menu added Quit to File menu ' January, 1993: Began development of version 2.0 ' Made Quit in file menu active at all times; ' Removed Quit button on parameter input screen ' Removed "accept" buttons ' Jan-Feb, 1993: Added annotation at top of display ' Feb, 1993: Added user-selection of header words for annotation at top of display; ' Narrowed requestor boxes ' Added ability to read all 4 types of SEG-Y data samples: ' 32-bit float, 32-bit integer, 16-bit integer, 32-bit gain*16-bit integer ' Ability for user to specify data sample type if not in header. ' March, 1993: Corrected problem with exponents <0 and with write-locked volume for ' PDF-file. ' March 1993: Found error in calculation of # of traces in file during menu input. 'This problem caused the program to fail is the # of samples/trace 'in the header had a value of 0. ' APRIL 1993: Added trace bias parameter, Changed Version to 2.1 ' Added annotation increment parameter ' MAY 1993: Made overlap (clip) parameter work properly ' March 1994: Added trace weighting factor from bytes 169-170 of the trace header; ' as per standard SEG-Y. DIM a(1),sa1(1000) DIM ReelHeader&(60), TraceHeader&(101) numfields%=9 'Number of text fields numparams%=17 'Number of elements in parameter array DIM curbutton%(2),params$(numparams%) DIM SHARED y1%(numparams%),y2%(numparams%),labls$(numfields%+7) ' 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$, clabel$(15), pdfflag% DIM SHARED bcw%, bht%, gmxx%, gmxy%, plns,exitmenu% DIM SHARED fcolor%, bcolor%, datafmt%, datafmt$ DATA File DATA Open, -, Quit DATA Stop Plotting DATA Return to Parameter Screen DATA Help DATA Input File Name,1st Trace to Plot,Minimum Plot Time,Maximum Plot Time,Plot Style DATA Gain,Timing Lines,No. of Traces on Screen,Overlap Between Traces (clip),Trace Increment DATA Plot Direction, Header Annotation, Trace Bias, Annotation Increment DATA LNSQ, RLSQ, FFID, FFTR, ESP#, CDP, CDPTR, TRID, VSUM, HSUM, TYPE, DIST DATA RELEV, SELEV, SRCZ, RDATM, SDATM,SW-Z, GRW-Z, ESCAL, CSCAL, SRC-X, SRC-Y DATA GRP-X, GRP-Y, UNITS, WVEL, SWVEL, S-UH, GR-UH, SSTAT, GSTAT, TSTAT DATA LAG-A, LAG-B, DELAY, MSTRT, M-END, NSAMP, SINT, GAINT, GAINC, INITG, ‚ORR DATA SWFRS, SWFRE, SWLN, SWTYP, STAPS, STAPE, TAPTY, FRALS, SLALS, NOTCH DATA NOTSL, LC-FR, HC-FR, LC-SL, HC-CT, YEAR, DAY, HOUR, MIN, SEC, TIMBS, TRWT DATA SWPOS, G#TR1, G#LST, GAPSZ, OVER DATA SEGY File Name--> DATA 1 st trace--> DATA Min. Time (ms)---> DATA Max. Time (ms)--> DATA Gain--> DATA Timing (ms)--> DATA # Traces--> DATA Overlap--> DATA Trace Increment--> DATA Style--> DATA Plot Direction--> DATA Header Words, <--Hdr Word#, (Max = 101) DATA <--Trace Bias, <--Annot. Incr ' 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)-31 '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 ERASE sa1 DIM sa1(mx%-mn%+1) numbuttons%=1 stylebutton1%=numbuttons%+1 stylebutton2%=numbuttons%+2 stylebutton3%=numbuttons%+3 dirbutton1%=numbuttons%+4 dirbutton2%=numbuttons%+5 hdrbutton1% = numbuttons%+6 'Button for CDP # (word 6) hdrbutton2% = numbuttons%+7 'Button for FFID# (word 3) hdrbutton3% = numbuttons%+8 'Button for ESP# (word 5) hdrbutton4% = numbuttons%+9 'Button for S-REC DIST (word 12) WINDOW 1," Seismic Trace Plot, Version 2.2",(0,20)-(gmxx%,SYSTEM(6)),2 WINDOW OUTPUT 1 ' set up pull down menus nmenus% = 3 '# of main menus num%(1)=3:num%(2)=1:num%(3)=14 '# of menu items in each menu FOR i% = 1 TO nmenus% 'Read main menu labels READ softk$ MENU i%,0,1,softk$ FOR j% = 1 TO num%(i%) 'Read sub-menu labels READ hlable$ MENU i%,j%,1,hlable$ 'create menus NEXT j% NEXT i% cmdkey 1,1,"O" cmdkey 1,3,"Q" MENU ON ON MENU GOSUB menuflag FOR i%=2 TO nmenus% 'Create menus MENU i%,0,0 NEXT MENU 1,1,0: MENU 1,2,1 'Turn off Open, Turn on QUIT ON ERROR GOTO echk1 DIM SHARED Thdritems% Thdritems% = 101 DIM SHARED Thdrlabl$(Thdritems%) FOR i% = 1 TO 71 'Read labels for trace header READ Thdrlabl$(i%) NEXT FOR i%=72 TO Thdritems% 'Create Labels for undefined header words num$=STR$(i%) ltrim num$ Thdrlabl$(i%)="H"+num$ NEXT FOR i%=1 TO numfields%+7 'Read Labels for input parameter screen 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%+2 y1%(i%)= ystart%+(i%-1)*yinc% y2%(i%)=y1%(i%)+yheight% NEXT x1field%=160 x2field%=x1field%+100 '200 x1butt%=x2field%+15 x2butt%=x1butt%+50 'Colors supported by QuickBasic: '205 = red '69 = yellow '33 = black '30 = white '341 = green '409 = blue '273 = cyan '137 = magenta 'initialize text size, font, etc. ' NOTE: set fcolor%=33 (black) and bcolor%=30 (white) ' for black-and-white version of TracePlot fcolor%=30 'white foreground color bcolor%=273 'cyan background color writepdflag% = 0 'flag for write protect when saving pdf-file CALL backcolor (bcolor%) CALL TEXTFONT(3) CALL TEXTMODE(8) CALL TEXTSIZE(12) CALL TEXTFACE(1) startflag%=0 CLS CALL forecolor (fcolor%) CALL TEXTFONT(3) CALL TEXTMODE(8) CALL TEXTSIZE(36) LOCATE 1,3: PRINT "Program TracePlot; LOCATE ,6 PRINT "Version 2.2" CALL TEXTSIZE(14) LOCATE 6,2 PRINT "(Ver 2.0 modified to add trace bias and annotation increment)" PRINT "(Ver 2.1 modified to incorporate scalar for 16 & 32 bit formats)" PRINT CALL TEXTSIZE(24) LOCATE ,6 PRINT "Seismic trace plotting LOCATE ,5 PRINT "program for the Macintosh" 'PRINT CALL TEXTSIZE(14) LOCATE ,12 PRINT "USGS Open File Report OF93-226 LOCATE ,19 PRINT "by John J. Miller 'GOTO skip4devel CALL forecolor(33) 'foreground to black for "seismic" trace kk=mn%-mn%+1: kkk=mx%-mn%+1:si=1 RANDOMIZE TIMER kk=1:kkk=300 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) sa1(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:sa1(i%)=-sa1(i%):NEXT END IF CALL PlotVAorVAWG(sa1(), mint, si, kk, kkk, va$,ix,pixdiff%, biasx) NEXT skip4devel: BUTTON 1,1,"Continue",(200,280)-(300,300) nsamt=0 si=0 numtraces&=0 CALL forecolor (fcolor%) LOCATE ,9 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 (fcolor%) CALL backcolor (bcolor%) 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 (fcolor%) CALL backcolor (bcolor%) CALL TEXTFONT(3) CALL TEXTMODE(8) CALL TEXTSIZE(12) CALL TEXTFACE(1) CLS start1: WINDOW 1," Seismic Trace Plot, Version 1.1",(0,20)-(gmxx%,SYSTEM(6)-105),2 WINDOW OUTPUT 1 start2: ON ERROR GOTO echk1 CALL forecolor (fcolor%) CALL backcolor (bcolor%) CALL TEXTFONT(3) CALL TEXTMODE(8) CALL TEXTSIZE(12) CALL TEXTFACE(1) CLS MENU 1,0,1: MENU 1,1,1 'Turn on menu; Turn on Open File MENU 2,0,0:MENU 3,0,0 'Turn off Menus 2 and 3 exitmenu%=0 pflag%=0 'initialize active field and button curfield%=2 curbutton%(2)=curfield% hdrflag%=0 win =2 CALL ListHeadParams (win,nsamt,si,numtraces&) WINDOW OUTPUT 1 redraw: CALL DrawInputScreen(numfields%,numbuttons%,rowinc%,params$(), x1field%,x2field%,x1butt%,x2butt%,fileonly$) FOR i%=1 TO 10:act=DIALOG(0):NEXT IF oldfile$ = "" THEN getfile: MENU 1,1,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 FOR i%=LEN(newfile$) TO 1 STEP -1 'Get file name only (strip path) IF MID$(newfile$,i%,1) = ":" AND flag%=0 THEN tfileonly$=MID$(newfile$,i%+1) 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$) 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 END IF sitmp = si nstmp =nsamt numtmp&=numtraces& maxtmp = maxtrtime datatmp%= datafmt% hdrtmp%=Tdhrsize% samptmp% = samplesize% hdrsiztmp% = hdrsize% datatmp$ = datafmt$ CALL ReadReelHeader(filnum%, hhead$, nsamps% ,si ,ReelHeader&()) datafmt%=ReelHeader&(10) 'datafmt%=0 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% IF numbytes&>0 THEN 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%,tfileonly$) 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 data 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%,tfileonly$) 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 #samps and si 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 'create .PDF file name and check if it exists a$=tfileonly$ FOR i = LEN(a$) TO 1 STEP -1 IF MID$(a$, i, 1) = "." THEN a$ = LEFT$(a$, i - 1) END IF NEXT i a$ = a$ + ".PDF" pdfflag% = 0 ON ERROR GOTO pdferr dnum = 2 OPEN a$ FOR INPUT AS #dnum IF pdfflag% = 0 THEN 'if PDF file exists, read contents and set up initial defaults ON ERROR GOTO pdferr1 INPUT #dnum, frst$, mint$, maxt$, gain$, tstep$,ntrpanl$,clip$,incr$,va$,lr$,hdr$,bias$,ticksp$ params$(2)=frst$ mint= VAL(mint$):params$(3)=mint$ maxt= VAL(maxt$):params$(4)=maxt$ gain = VAL(gain$):params$(5)=gain$ tstep= VAL(tstep$):params$(6)=tstep$ ntrpanl=VAL(ntrpanl$):params$(7)=ntrpanl$ clip = VAL(clip$):params$(8)=clip$ params$(9)=incr$ IF va$<>"VA" AND va$<>"WG" AND va$<>"BOTH" THEN va$="BOTH" params$(10) = va$ IF lr$<>"LR" AND lr$<>"RL" THEN lr$="LR" params$(11) = lr$ params$(12) = hdr$ IF params$(12) = "" THEN params$(12) = "6" params$(13) = bias$ IF params$(13) = "" THEN params$(13) = "0" params$(14) = ticksp$ ELSE 'PDF file does not exist; set initial defaults pdferr2: params$(2)="1" params$(3) = "0" mint=VAL(mint$) maxt = (nsamt - 1) * si params$(4) = STR$(maxt) ltrim params$(4) params$(5) = "1" gain=VAL(gain$) params$(6)= "1000" tstep = VAL(tstep$) params$(7)="50" params$(8)="1.2" params$(9)="1" params$(10) = "BOTH" params$(11) = "LR" params$(12) = "6" params$(13) = "0" params$(14) = "Auto" CLS END IF CLOSE #dnum ' if Flag to override # samples and sample interval set; use new file name 'Redraw screen with new default parameters params$(1)=newfile$ oldfile$=newfile$ fileonly$=tfileonly$ CLS CALL DrawInputScreen(numfields%,numbuttons%,rowinc%,params$(), x1field%,x2field%,x1butt%,x2butt%,fileonly$) ELSEIF params$(1)<>"" THEN 'File has already been selected win = 2 CALL ListHeadParams (win,nsamt,si,numtraces&) CLS CALL DrawInputScreen(numfields%,numbuttons%,rowinc%,params$(), x1field%,x2field%,x1butt%,x2butt%,fileonly$) ELSEIF params$(1)="" THEN 'No file has been selected CLS CALL DrawInputScreen(numfields%,numbuttons%,rowinc%,params$(), x1field%,x2field%,x1butt%,x2butt%,fileonly$) 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,1,1: MENU 3,0,1 'turn on initial field onbutt%=curbutton%(2) EDIT FIELD onbutt%,params$(onbutt%),(x1field%,y1%(onbutt%))-(x2field%,y2%(onbutt%)) bob1: WINDOW OUTPUT 1 act=0 WHILE act = 0:act=DIALOG(0):WEND WINDOW OUTPUT 3 CLS 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) >= stylebutton1% AND DIALOG(1)<= stylebutton3% THEN IF DIALOG(1) = stylebutton1% THEN 'User has clicked plot style button params$(10)="VA" ELSEIF DIALOG(1) = stylebutton2% THEN params$(10)="WG" ELSEIF DIALOG(1) = stylebutton3% THEN params$(10)="BOTH" END IF CALL Drawbuttons(2, params$(),x1field%,numfields%,numbuttons%, x1butt%, x2butt%) ELSEIF DIALOG (1) >=dirbutton1% AND DIALOG(1) <=dirbutton2% THEN IF DIALOG(1) = dirbutton1% THEN 'User has clicked plot direction button params$(11)="LR" ELSEIF DIALOG(1) = dirbutton2% THEN params$(11)="RL" END IF CALL Drawbuttons(3,params$(),x1field%,numfields%,numbuttons%, x1butt%, x2butt%) ELSEIF DIALOG(1) >=hdrbutton1% AND DIALOG(1) <=hdrbutton4% THEN IF DIALOG(1) = hdrbutton1% THEN 'User has clicked CDP header word button params$(12)="6" ELSEIF DIALOG(1) = hdrbutton2% THEN 'User has clicked FFID header word button params$(12)="3" ELSEIF DIALOG(1) = hdrbutton3% THEN 'User has clicked ESP# header word button params$(12)="5" ELSEIF DIALOG(1) = hdrbutton4% THEN 'User has clicked DIST header word button params$(12)="12" END IF CALL Drawbuttons(4, params$(),x1field%,numfields%,numbuttons%, x1butt%, x2butt%) END IF ELSEIF act=2 THEN 'User has moved to another edit field curfield%=DIALOG(2) IF curbutton%(2)=numfields%+1 THEN hdrflag%=1 'flag to indicate that last field was 'header word ELSE 'User has Pressed the enter button in a field IF curbutton%(2)=numfields%+1 THEN hdrflag%=1 curfield%=curfield%+1 IF curfield%>numfields%+3 THEN curfield%=2 'changed END IF chkbutton%=curbutton%(2) temp$=EDIT$(chkbutton%) IF chkbutton%=1 AND UCASE$(temp$)<>UCASE$(File$) THEN File$=temp$ infile$=temp$ END IF ON ERROR GOTO echk1 'Transfer value from field to array cur%=curbutton%(2) IF curbutton%(2) = numfields%+1 THEN cur% =12 IF curbutton%(2) = numfields%+2 THEN cur% =13 IF curbutton%(2) = numfields%+3 THEN cur% = 14 params$(cur%)=EDIT$(curbutton%(2)) ' determine current field; turn off previous field, turn on current one curbutton%(2) = curfield% onbutt%=curbutton%(2) IF onbutt%<=numfields% THEN IF hdrflag%>0 THEN CALL Drawbuttons(4, params$(),x1field%,numfields%,numbuttons%, x1butt%, x2butt%) hdrflag%=0 EDIT FIELD onbutt%,params$(onbutt%),(x1field%,y1%(onbutt%))-(x2field%,y2%(onbutt%)) ELSEIF onbutt%=numfields%+1 THEN CALL Drawbuttons(4, params$(),x1field%,numfields%,numbuttons%, x1butt%, x2butt%) ELSEIF onbutt%=numfields%+2 THEN CALL Drawbuttons(5, params$(),x1field%,numfields%,numbuttons%, x1butt%, x2butt%) ELSEIF onbutt%=numfields%+3 THEN CALL Drawbuttons(6, params$(),x1field%,numfields%,numbuttons%, x1butt%, x2butt%) END IF 'ĘPlot button pushed IF act = 1 AND DIALOG(1) = numbuttons% THEN GOTO plot IF overrideflag%=1 THEN overrideflag%=0 GOTO bob1 ELSE GOTO bob1 END IF END plot: 'Determine if plotting parameters are valid mint=VAL(params$(3)) maxt=VAL(params$(4)) WINDOW OUTPUT 3 IF mint>maxtrtime THEN PRINT "Minimum Time is greater than last PRINT "sample's time! No data can possibly PRINT "be plotted using these parameters." pflag%=1 onbutt%=3 ELSEIF mint <0 THEN PRINT "Minimum Time MUST be greater than 0!" onbutt%=3 pflag%=1 ELSEIF maxt101 THEN PRINT "The header word number MUST be PRINT "between 1 AND 101." onbutt%=numfields%+1 pflag%=1 ELSEIF VAL(params$(2))<1 THEN PRINT "First trace to plot must be >0!" onbutt%=2 pflag%=1 ELSEIF VAL(params$(13)) > 1 OR VAL(params$(13)) < -1 THEN PRINT "Bias MUST be between -1 and +1 !!!" onbutt%=numfields%+2 pflag%=1 END IF WINDOW OUTPUT 1 IF pflag%=1 THEN curbutton%(2) = onbutt% IF onbutt%maxt THEN nsamp = nsamp-1 IF nsamp>nsamt THEN nsamp = nsamt mtsamp = nsamp - mnsamp + 1 'Total # of samples to plot ERASE a DIM a(nsamp) ' Call subroutine that gets plotting parameters and plots traces MENU 1,1,0:MENU 2,0,1:MENU 3,0,0 File$=params$(1) CALL plottraces(params$(),filesize&,nsamt, si, a(),sa1(),TraceHeader&(), ReelHeader&() ,filnum%) si = osi 'Re-set sample interval CLOSE startflag%=1 GOTO start END menuflag: Menuitem=MENU(0) IF Menuitem = 1 THEN iflag%=MENU(1) IF iflag%=1 THEN RETURN getfile ELSEIF iflag%=3 THEN END END IF ELSEIF Menuitem=2 THEN 'Menu item to end plotting selected; set flags MENU 2,0,0 iflag%=MENU(1) exitmenu%=1 RETURN 'Return to current subroutine ELSEIF Menuitem=3 THEN 'HELP item selected 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 "appears in the File-Open menu. If the # of" PRINT "samples per trace and sample interval cannot" PRINT "be determined from the file header, you will be" PRINT "able to override these values"; ELSEIF iflag%=2 THEN PRINT "The SEQUENTIAL trace in the file to plot at the PRINT "left or right edge of the plotting screen." PRINT "Example: If the file contains shot gathers PRINT "composed of 96 traces each and you wish to PRINT "begin plotting at the second shot gather, PRINT "type 97 for this parameter."; ELSEIF iflag%=3 THEN PRINT "The time at the top of the display, 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 at the bottom of the display, in ms. PRINT "This must be >= minimum time. PRINT "If this value is greater than the maximum PRINT "trace time, then the display will be compressed PRINT "in the vertical direction."; ELSEIF iflag%=5 THEN PRINT "The plot style that you desire. PRINT "Click button WG for Wiggle-trace only. PRINT "Click VA for Variable area only (no PRINT "negative trace samples will be plotted). PRINT "Click VA+WG for Variable area AND wiggle."; ELSEIF iflag%=6 THEN PRINT "The scalar by which to multiply all sample PRINT "values, prior to plotting. Type a negative PRINT "value to reverse the polarity of the traces. PRINT "Type Norm to calculate a normalized scalar PRINT "for EACH trace based on its maximum amplitude"; ELSEIF iflag%=7 THEN PRINT "The increment, in ms, to draw timing lines. PRINT "Example: 100 means to draw timing lines at PRINT "integer multiples of 100 ms (100, 200, etc.)."; ELSEIF iflag%=8 THEN PRINT "The number of traces to plot on the screen. PRINT "The larger that this number is, the closer PRINT "together the traces will be plotted."; ELSEIF iflag%=9 THEN PRINT "If GAIN is a scalar, then this value defines the PRINT "overlap between traces, in terms of trace widths PRINT "Example: A number of 1.5, will cause amplitudes PRINT "greater than 1.5 trace widths to be truncated" PRINT "If GAIN = Norm, then this value is the distance PRINT "at which the max. amplitude is plotted."; ELSEIF iflag%=10 THEN PRINT "Increment at which to plot traces. PRINT "Example: Type 2 if you want every 2nd trace PRINT "plotted (beginning at the 1st trace specified)."; ELSEIF iflag%=11 THEN PRINT "Choose Left-to-right or Right-to-left. PRINT "Click the button labeled LR to plot the 1st PRINT "trace at the left edge of the screen; PRINT "Click the button labeled RL to plot the 1st PRINT "trace at the right edge of the screen."; ELSEIF iflag%=12 THEN PRINT "The trace-header word to use for annotation" PRINT "of approximately 20 tick marks." PRINT "Click on the button of the four preset choices" PRINT "or type the # of the Header word to use." PRINT "There are 71 words defined by the SEG and 30" PRINT "optional words for a maximum of 101."; ELSEIF iflag%=13 THEN PRINT "Bias for Variable area portion of trace, PRINT "in terms of trace widths. Values MUST be PRINT "between -1 and +1. Example: PRINT "a value of .5 causes the variable area PRINT "to begin plotting at 1/2 the distance to PRINT "the trace to the right."; ELSEIF iflag%=14 THEN PRINT "SEQUENTIAL Increment at which to" PRINT "annotate traces at the top of the display." PRINT "Care should be taken to avoid overlap" PRINT "when trace #'s are very large. Type" PRINT "AUTO for automatic determination" PRINT "of the annotation increment."; ELSE BEEP PRINT "Sorry, help is not available for this item." END IF pflag%=1 MENU 3,0,1 WINDOW OUTPUT 1 RETURN END IF echk2: WINDOW 2,"Plotting Error",(100,100)-(500,300),5 WINDOW OUTPUT 2 BEEP LOCATE 2,1 PRINT " An Error Occurred When Plotting. A possible cause is" PRINT " that the Gain is too large. Reduce the gain and try again." 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 LOCATE 2,2: PRINT "An unrecoverable error occurred ! ! ! LOCATE ,2: PRINT "You will have to restart the program. LOCATE ,2: PRINT "Press a key . . . k$=INPUT$(1) ON ERROR GOTO 0 echk3: 'Path/file error recovery routine 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 pdferr: pdfflag% = 1 RESUME NEXT pdferr1: WINDOW 3 CLS BEEP PRINT "Error reading PDF file: ";a$ PRINT "Default parameters will be PRINT "determined from binary header. PRINT "Press a key to continue. .. " confirm k$ CLS WINDOW 1 RESUME pdferr2 writepdf: 'error writing pdf file writepdflag% = 1 WINDOW 3 CLS BEEP LOCATE 1,1 PRINT " Cannot write file "; a$ PRINT " on this device!!! No PDF file will PRINT " be saved. Press a key to continue" confirm k$ CLS WINDOW 1 RESUME NEXT SUB ListHeadParams (win,nsamt,si,numtraces&) STATIC 'Subroutine to list parameters determined from file header 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%, m%) STATIC 'Subroutine to close all text fields and buttons 'n%= number of text fields 'm%= number of buttons k%=m% 'determine which number is larger IF n%>m% THEN k%=n% FOR i%=1 TO k% IF i%<=n% THEN EDIT FIELD CLOSE i% IF i%<=m% THEN BUTTON CLOSE i% NEXT END SUB SUB Drawtiminglines (mint, maxt, tstep) STATIC 'Draw and annotate timing lines on seismic plotting screen FOR i = 0 TO maxt STEP tstep IF i < mint THEN GOTO ELOOP b=(i-mint)/(maxt-mint)*(mxpix-1) c=(i-mint)/(maxt-mint)*mul! k% = CINT(c) + 3 '1 IF k% = 0 THEN k% = 1 LINE (tm%,b+gmny1%)-(gmxx%,b+gmny1%) IF k% > mul! + 2 THEN GOTO ELOOP a$=STR$(i/1000) ltrim a$ LOCATE k%, 1: PRINT LEFT$(a$,5); ELOOP: NEXT i END SUB SUB DrawTopGrid(ntrpanl, dir$, jj&, trinc&, ticksp%, indx$) STATIC 'Draw and label top Grid above plot CALL TEXTSIZE(8) LOCATE 1,1: PRINT Thdrlabl$(VAL(indx$)) LOCATE 2,1:PRINT "SEQ#" kk&=jj& LINE (gmnx1%, gmny1%-2)-(gmxx1%, gmny1%-2) dtr1%=dtr% IF dir$="RL" THEN dtr1%=-dtr1% a$="8" cw=WIDTH(a$) ticktop%=gmny1%-7: tickbot%=gmny1%-2 numsp&=ticksp%*trinc& ' increment at which to number ticks FOR i%=1 TO ntrpanl STEP ticksp% ix%=stx%+(i%-1)*dtr1% LINE (ix%,ticktop%)-(ix%,tickbot%) kk$=STR$(kk&) ltrim kk$ w%=INT(WIDTH(kk$)/2) cx%=ix%-w% col%=INT(cx%/cw) +1 IF col%<5 THEN col%=5 LOCATE 2,col%:PRINT kk$ kk&=kk&+numsp& NEXT CALL TEXTSIZE(12) END SUB SUB plottraces (params$(),filesize&,nsamt, si, a(),sa1(),TraceHeader&(), ReelHeader&(),filnum%) STATIC ' Subroutine to draw plotting screen and plot seismic traces using the following sequence: ' 1. Interactive parameters are recovered ' 2. detemination is made whether # of samples to be plotted is >= # of pixels available ' in the vertical direction; if not, set appropriate flags ' 3. Seismic plotting area is drawn ' 4. Timing lines are drawn and annotated ' 5. Traces are drawn esc$=CHR$(27) ON ERROR GOTO echk2 ' Calculate and/or request plot 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)) '1st trace to plot mint = VAL(params$(3)) maxt = VAL(params$(4)) gain = VAL(params$(5)) gain$=UCASE$(LEFT$(params$(5),1)) tstep = VAL(params$(6)) ntrpanl = VAL(params$(7)) clip= VAL(params$(8)) clipnorm = clip/.5 trinc& = VAL(params$(9)) va$=params$(10) dir$=params$(11) hdr%=VAL(params$(12)) bias = VAL(params$(13)) ticksp$=params$(14) CLS 'Minimum sample to plot mnsamp = INT(mint / si) + 1 t=(mnsamp-1)*si IF tmaxt THEN nsamp = nsamp-1 IF nsamp>nsamt THEN nsamp = nsamt mtsamp = nsamp - mnsamp + 1 'Total # of samples to plot bht%=16 'height of character, in pixels mul!=25 tg%=gmxy%/bht% '# of text lines available on screen mul!=tg%-2 '# of text lines to use for timing line annotation ' Set parameters that can be calculated from above 'gmny1% = bht% / 2 ' min y coordinate FOR plot gmny1% = bht% * 2.5 ' min y coordinate FOR plot gmxy1% = gmxy% - bht% -2 'max y coordinate FOR plot gmxx1% = gmxx% - bcw% 'max x coordinate FOR plot gmnx1% = 6 * bcw% 'min x coordinate FOR plot tm% = gmnx1% - bcw% / 2 'x for left timing lines mul!=(gmxy1%-gmny1%)/bht% dtr% = (gmxx1% - gmnx1%) / (ntrpanl) ' trace spacing in pixels IF dtr%<1 THEN dtr%=1 biasx = bias*dtr% 'Bias offset in pixels IF ABS(biasx)<1 THEN biasx = 0 half% = dtr% /2 '1/2 trace WIDTH in pixels dx=half% IF dx<1 THEN dx=1 clip% = clip * dtr% 'trace clip in pixels stx% = gmnx1% + dtr%/2 'x coordinate of far left trace IF dir$="RL" THEN stx%=gmxx1%-dtr%/2 mxpix = gmxy1% - gmny1% + 1 IF UCASE$( LEFT$(ticksp$,1)) = "A" THEN IF ntrpanl >=500 THEN ticksp%=25 ELSEIF ntrpanl >=200 THEN 'spacing of ticks for top lable ticksp%=10 ELSEIF ntrpanl>=100 THEN ticksp%=5 ELSEIF ntrpanl>=50 THEN ticksp%=2 ELSE ticksp%=1 END IF ELSE ticksp%=VAL(ticksp$) END IF numsp&=ticksp%*trinc& ' increment at which to number ticks IF trinc&=0 THEN numsp&=ticksp% CALL TEXTSIZE(8) cw=WIDTH("8") 'size of top label annotation character, in pixels CALL TEXTSIZE(12) IF avg = 0 THEN avg=1 scale = (dx / avg) s1=1 mntime = (mnsamp - 1) *si 'Time of minimum SAMPLE to be plotted mxtime = (nsamp - 1) * si 'Time of Maximum SAMPLE to be plotted screentime = maxt - mint 'Total time on SCREEN tracetime = mxtime - mntime 'Total time of "live" TRACE samples ratio = tracetime / screentime 'Ratio of "live" trace time to screen time npix% = INT(ratio * mxpix) '# of pixels taken up by "live" samples ttracetime = mxtime - mint 'Total time of trace, including any "lead" time 'before 1st live sample ratio = ttracetime / screentime 'Ratio of plotted trace time to screen time npix1% = INT(ratio * mxpix) '# of pixels taken up by plotted trace pixdiff% = npix1% - npix% 'difference in pixels between plotted trace 'and live trace samples ' Modify Min and Max sample #' s if VA plot style is needed kk = mnsamp '1st sample to plot kkk = nsamp 'last sample to plot 'If wiggle trace, OR # of samples to plot >= # of pixels available for plotting 'then skip next calculations IF mtsamp >= npix% OR va$="WG" THEN GOTO sttit kk=1 '1st sample to plot kkk=npix% 'Last sample to plot = # of pixels available for plotting sttit: ' jjj=kkk-kk n=npix% si = (n-1)/jjj 'New sample interval for PLOTTING (1-pixel) nplot=0 sttit1: a$="" CLS ' Set up plotting window and draw box LINE (gmnx1%, gmny1%)-(gmxx1%, gmxy1%), , b ' Draw and label timing lines IF tstep>0 THEN CALL Drawtiminglines(mint, maxt, tstep) IF ticksp%>0 THEN CALL DrawTopGrid(ntrpanl,dir$, jj&, trinc&, ticksp%, params$(12)) LOCATE tg%,8: PRINT "Press ESC to pause . . ."; LOCATE tg%,30:PRINT "CDP/FFID being plotted: "; LOCATE tg%,50:PRINT SPACE$(95); ' Plot traces j=1 scale=1 s1=1 IF nplot = 0 THEN ' Open SEGY input file and position pointer to the 1st trace File%=1: nplot=1 OPEN File$ AS #File% LEN = samplesize% FIELD #File%, samplesize% AS head1$ GET #File%, hdrsize% END IF ftr&=jj& WHILE EOF(1) = 0 ' If Current trace coordinates are beyond border, stop and ask instructions IF dir$="LR" THEN ix = stx% + (j - 1) * dtr% IF ix > gmxx1% THEN GOTO sk6 ELSE ix = stx% - (j - 1) * dtr% IF ix < gmnx1% THEN GOTO sk6 END IF IF exitmenu%=1 THEN GOTO ExitFromMenu k$=INKEY$ IF k$=esc$ THEN LOCATE tg%,8:PRINT SPACE$(150); LOCATE tg%,8: PRINT "Temporary pause; Press ESC to return to main screen. . ."; confirm k$ IF exitmenu%=1 THEN GOTO ExitFromMenu IF k$=esc$ THEN ExitFromMenu: IF groutput%=1 THEN CLOSE #10 CLOSE EXIT SUB END IF LOCATE tg%,8:PRINT SPACE$(150); LOCATE tg%,8: PRINT "Press ESC to pause . . ."; LOCATE tg%,30:PRINT "CDP/FFID being plotted: "; END IF 'Clear Trace header and Trace nsamps%=nsamt 'Position file pointer position&=hdrsize%+(jj&-1)*tracesize% IF position&0 THEN IF ((jj&-ftr&) MOD numsp&) = 0 THEN 'annotate trace with trace-header value CALL TEXTSIZE(8) kk$=STR$(TraceHeader&(hdr%)) ltrim kk$ w%=INT(WIDTH(kk$)/2) cx%=ix-w% col%=INT(cx%/cw) +1 IF col%<5 THEN col%=5 LOCATE 1,col%:PRINT kk$ CALL TEXTSIZE(12) END IF END IF IF j=1 OR gain$="N" THEN 'For 1st trace OR Normalized scaling avg=0:cnt%=0 IF gain$<>"N" THEN FOR i%=mnsamp TO nsamp IF a(i%)<>0 THEN avg = avg+ABS(a(i%)) cnt%=cnt%+1 END IF NEXT i% IF cnt%<1 THEN 'No "live" sample found WINDOW 2,"Scaling Error",(100,100)-(500,300),5 WINDOW OUTPUT 2 BEEP LOCATE 2,1 PRINT " An Error Occurred When Calculating the scale factor." PRINT "The 1st trace selected for ploting contains no non-zero PRINT "samples in its plotting window!" PRINT " PRINT "Please select a different first trace or time window." PRINT PRINT " Press a key . . ."; confirm k$ WINDOW CLOSE 2 CLOSE EXIT SUB END IF avg = avg/cnt% IF avg = 0 THEN avg=1 scale = (dx / avg)*gain ELSE 'normalize current trace FOR i%=mnsamp TO nsamp IF ABS(a(i%))>avg THEN avg = ABS(a(i%)) NEXT i% s1=scale IF avg>0 THEN scale = (dx / avg) ELSE scale = 1 scale = scale*clipnorm END IF FOR i% = mnsamp TO nsamp a(i%) = a(i%) * scale NEXT i% END IF IF gain$<>"N" THEN FOR i%=mnsamp TO nsamp IF ABS(a(i%))>clip% THEN IF a(i%)>0 THEN a(i%) = clip% ELSE a(i%) = -clip% END IF NEXT END IF IF va$ = "WG" THEN 'Wiggle-style plot, draw trace LINE (ix+a(kk), gmny1%+pixdiff%)-(ix+a(kk), gmny1%+pixdiff%) FOR i = kk + 1 TO kkk LINE -(ix+a(i), (i - kk) * si+gmny1%+pixdiff%) NEXT i ELSEIF mtsamp < npix% THEN 'Interpolate trace so every pixel had a sample CALL ResampleInterpolateTrace(a(),sa1(), maxt, mint, mnsamp, mtsamp, nsamp, si) 'Plot VA or VAWG from interpolated array sa1() CALL PlotVAorVAWG(sa1(), mint, si, kk, kkk, va$,ix,pixdiff%, biasx) ELSE ' Plot VA or VAWG from array A (Non-interpolated) CALL PlotVAorVAWG(a(), mint, si, kk, kkk, va$,ix,pixdiff%, biasx) END IF j = j + 1 'update # of traces counter jj&=jj&+trinc& 'update trace # to plot counter WEND sk5: ' End or beginning of seismic trace file detected ' Redraw and label timing lines IF tstep>0 THEN CALL Drawtiminglines(mint, maxt, tstep) LOCATE tg%,8:PRINT SPACE$(150); LOCATE tg%, 8 PRINT "There are NO MORE traces to plot. Press ANY KEY to clear screen . . ."; confirm a$ EXIT SUB sk6: ' Border of plotting area reached ' Redraw and label timing lines IF tstep>0 THEN CALL Drawtiminglines(mint, maxt, tstep) LOCATE tg%,8:PRINT SPACE$(150); LOCATE tg%, 8 PRINT "There are MORE traces to plot. Press ANY KEY to continue or ESC to end."; confirm a$ ploterror: IF a$ <>CHR$(27) AND exitmenu%<>1 THEN GOTO sttit1 CLOSE END SUB SUB PlotVAorVAWG (ss(), mint, si, kk, kkk, va$,ix,pixdiff%, biasx) 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$. ' April, 1993: Added bias to va plot LINE (ix+ss(kk), gmny1%+pixdiff%)-(ix+ss(kk), gmny1%+pixdiff%) x1 = ix + biasx FOR i = kk + 1 TO kkk x2 = ix + ss(i) IF x2 > x1 THEN ' Current sample value is > bias ' If previous sample value was < bias and Plot style is VAWG, draw connecting line IF ss(i - 1)+ix < x1 AND va$ <> "VA" THEN LINE -(x2, (i - kk) * si + gmny1%+pixdiff%) ' Plot VA portion of trace LINE ( x1, (i - kk) * si + gmny1%+pixdiff%)-(x2, (i - kk) * si + gmny1%+pixdiff%) ELSEIF va$ <> "VA" THEN ' Current sample value is negative and plot style is ' VAWG, so draw connecting line. LINE -(x2, (i - kk) * si + gmny1%+pixdiff%) END IF NEXT i END SUB SUB ResampleInterpolateTrace (a(), sa1(), maxt, mint, mnsamp, mtsamp, nsamp, si) STATIC Resample: ' Subroutine ResampleInterpolateTrace, written Jan 4, 1990 by John J. Miller ' This subroutine will resample a seismic trace contained in array a() into ' array sa1(). It is called when the # of samples in array a() is less than ' the maximum # of pixels used for plotting in the vertical direction AND ' when Variable Area style plotting is needed. After mapping the samples from ' array a() into their appropriate locations in array sa1(), array sa1() is ' linearly interpolated in order to fill "blank" samples. ' set all elements of sa1() to zero (0) CALL zero(sa1()) ' Routine to Map samples from array a() into array sa1() FOR i = mnsamp TO nsamp J1 = INT(((i - mnsamp) * (mxpix - 1)) / (mtsamp - 1)) sa1(J1 + 1) = a(i) NEXT i ' Routine to interpolate array sa1(). ' All samples having a value of Zero will be replaced by a new value, ' determined by linear interpolation using the non-zero values that ' surround them, except for "Leading" and "trailing" samples that have ' a value of 0; these samples will NOT be interpolated. N1 = 0 FOR i = 1 TO mxpix IF (sa1(i) = 0) THEN GOTO sk3 N2 = i IF N2 = N1 + 1 THEN GOTO sk2 IF N1 > 0 THEN GOTO sk1 GOTO sk2 sk1: g = N2 - N1 FOR jj = N1 + 1 TO N2 - 1 f = jj - N1 DIFF = sa1(N2) - sa1(N1) sa1(jj) = sa1(N1) + f / g * DIFF NEXT jj sk2: N1 = N2 sk3: NEXT i END SUB SUB zero(d()) STATIC 'set all elements of floating-point array = 0 FOR i%=1 TO mxpix d(i%)=0 NEXT i% 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 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& NEXT FOR n% = 13 TO 55 STEP 2 CALL make2byte(hhead$, n%, j%) i% = i% + 1 ReelHeader&(i%) = j% NEXT nsamps%=ReelHeader&(8) si = ReelHeader&(6) / 1000 CLOSE END SUB SUB ReadTrace(filnum%,mnsamp, nsamp, position&,head1$, TraceHeader&(), trace(),Thdrsize%,scale,eflag%) STATIC ' --------------------------------------------------------------------- ' Subroutine to read and decode 240 byte Trace Header and Nsamps% samples ' --------------------------------------------------------------------- eflag%=0 two7th%=2^7 thead$="" 'Read 240-byte trace header in 4-byte groups (4*60), or 2-byte groups (2*120) FOR i% = 1 TO Thdrsize% GET #filnum% IF EOF(1) THEN eflag%=1 EXIT SUB END IF thead$ = thead$ + head1$ NEXT i% ' Decode items from Trace Header, store information in array TraceHeader&() i% = 0 FOR n% = 1 TO 25 STEP 4 CALL Make4Byte(thead$, n%, kl&) i% = i% + 1 TraceHeader&(i%) = kl& NEXT FOR n% = 29 TO 35 STEP 2 CALL make2byte(thead$, n%, j%) i% = i% + 1 TraceHeader&(i%) = j% NEXT FOR n% = 37 TO 65 STEP 4 CALL Make4Byte(thead$, n%, kl&) i% = i% + 1 TraceHeader&(i%) = kl& NEXT FOR n% = 69 TO 71 STEP 2 CALL make2byte(thead$, n%, j%) i% = i% + 1 TraceHeader&(i%) = j% NEXT FOR n% = 73 TO 85 STEP 4 CALL Make4Byte(thead$, n%, kl&) i% = i% + 1 TraceHeader&(i%) = kl& NEXT FOR n% = 89 TO 239 STEP 2 '179 STEP 2 CALL make2byte(thead$, n%, j%) i% = i% + 1 TraceHeader&(i%) = j% NEXT 'Position File Pointer to first sample to read by reading the 2 or 4 bytes immediate 'preceding it + (sample-to-read) -1 position&=position&+Thdrsize%+mnsamp-1 GET #filnum%,position& 'READ Trace Samples AND convert them IF datafmt%=1 THEN '32-bit floating point FOR i% = mnsamp TO nsamp GET #filnum% ' Create Mantissa man$=CHR$(0)+MID$(head1$,2,3) mantiss&=CVL(man$) mantissa = mantiss&*2^-24 'Create Exponent expon$=CHR$(0)+MID$(head1$,1,1) expon%=CVI(expon$) 'if exponent is >= 2^7, then number if negative sign = 1 IF expon%>=two7th% THEN expon%=expon%-two7th% sign = -1 END IF expon%=expon%-64 'Create Sample value six = 0 IF expon% >= -31 AND expon%<=32 THEN six = 16^expon% trace(i%) = sign * mantissa* six * scale NEXT i% ELSEIF datafmt%=2 THEN '32-bit integer trwt = 2 ^ -(TraceHeader&(66)) FOR i% = mnsamp TO nsamp GET #filnum% ' Create data sample trace(i%)=CVL(head1$) * trwt * scale NEXT ELSEIF datafmt%=3 THEN '16-bit integer trwt = 2 ^ -(TraceHeader&(66)) FOR i% = mnsamp TO nsamp GET #filnum% ' Create data sample trace(i%)=CVI(head1$) * trwt * scale NEXT ELSEIF datafmt%=4 THEN FOR i% = mnsamp TO nsamp '16-bit integer * gain (8-bit integer) GET #filnum% ' Create data sample man$ = MID$(head1$,3,2) man% = CVI(man$) man1$ = CHR$(0)+MID$(head1$,2,1) expon%=CVI(man1$) trace(i%)= expon% * man% * scale NEXT END IF END SUB SUB confirm (a$) STATIC ' Subroutine to check for a key pressed or menu item #2 selected a$="" WHILE a$="" IF exitmenu%=1 THEN EXIT SUB a$=INKEY$ WEND END SUB SUB Drawbuttons(Drawflag%,params$(),x1field%,numfields%,numbuttons%, x1butt%, x2butt%) STATIC 'Subroutine to draw and activate buttons for Plotting style, plot direction, and header 'word to use when annotating 'drawflag%=1: Update all buttons 'drawflag%=2: Update style buttons only 'drawflag%=3: Update direction buttons only 'drawflag%=4: Update header buttons only stylebutton1%=numbuttons%+1 stylebutton2%=numbuttons%+2 stylebutton3%=numbuttons%+3 dirbutton1%=numbuttons%+4 dirbutton2%=numbuttons%+5 hdrbutton1% = numbuttons%+6 'Button for CDP # (word 6) hdrbutton2% = numbuttons%+7 'Button for CDP trace # (word 7) hdrbutton3% = numbuttons%+8 'Button for FFID # (word 3) hdrbutton4% = numbuttons%+9 'Button for FFID trace # (word 4) IF (Drawflag%=1) OR (Drawflag%=2) THEN st1%=1:st2%=1:st3%=1 'Flag for buttons to be active but not selected IF params$(10)="VA" THEN 'Activate VA button st1%=2 ELSEIF params$(10)="WG" THEN 'Activate WG button st2%=2 ELSEIF params$(10)="BOTH" THEN 'Activate VA+WG button st3%=2 ELSE 'Requestor is empty; draw buttons deactivated st1%=0:st2%=0:st3%=0 END IF BUTTON stylebutton1%,st1%,"VA",(x1field%,y1%(numfields%+1))-(x1field%+50,y2%(numfields%+1)),3 BUTTON stylebutton2%,st2%,"WG",(x1field%+60,y1%(numfields%+1))-(x1field%+110,y2%(numfields%+1)),3 BUTTON stylebutton3%,st3%,"VA+WG",(x1field%+120,y1%(numfields%+1))-(x1field%+190,y2%(numfields%+1)),3 END IF IF (Drawflag%=1) OR (Drawflag%=3) THEN dir1%=1:dir2%=1 'Flag for buttons to be active but not selected IF params$(11)="LR" THEN 'Activate LR button dir1%=2 ELSEIF params$(11)="RL" THEN 'Activate RL button dir2%=2 ELSE 'Requestor is empty; draw buttons deactivated dir1%=0:dir2%=0 END IF BUTTON dirbutton1%,dir1%,"LR",(x1field%,y1%(numfields%+2))-(x1field%+50,y2%(numfields%+2)),3 BUTTON dirbutton2%,dir2%,"RL",(x1field%+60,y1%(numfields%+2))-(x1field%+110,y2%(numfields%+2)),3 END IF IF (Drawflag%=1) OR (Drawflag%=4) THEN hdr1%=1:hdr2%=1:hdr3%=1:hdr4%=1 'Flag for buttons to be active but not selected IF params$(12)="6" THEN 'Activate CDP button hdr1%=2 ELSEIF params$(12)="3" THEN 'Activate FFID button hdr2%=2 ELSEIF params$(12)="5" THEN 'Activate ESP# button hdr3%=2 ELSEIF params$(12)="12" THEN 'Activate DIST button hdr4%=2 ELSEIF params$(12)="" THEN 'Requestor is empty; draw buttons deactivated hdr1%=0:hdr2%=0:hdr3%=0:hdr4%=0 END IF ib%=4 EDIT FIELD numfields%+1,params$(12),(x1butt%,y1%(ib%+4))-(x2butt%,y2%(ib%+4)) BUTTON hdrbutton1%,hdr1%,Thdrlabl$(6),(x1butt%, y1%(ib%))-(x2butt%+20, y2%(ib%)),3 BUTTON hdrbutton2%,hdr2%, Thdrlabl$(3) ,(x1butt%, y1%(ib%+1))-(x2butt%+20, y2%(ib%+1)),3 BUTTON hdrbutton3%,hdr3%, Thdrlabl$(5),(x1butt%, y1%(ib%+2))-(x2butt%+20, y2%(ib%+2)),3 BUTTON hdrbutton4%,hdr4%,Thdrlabl$(12) ,(x1butt%, y1%(ib%+3))-(x2butt%+20, y2%(ib%+3)),3 END IF IF (Drawflag%=1) OR (Drawflag%=5) THEN EDIT FIELD numfields%+2,params$(13),(x1butt%,y1%(9))-(x2butt%,y2%(9)) END IF IF (Drawflag%=1) OR (Drawflag%=6) THEN EDIT FIELD numfields%+3,params$(14),(x1butt%,y1%(11))-(x2butt%,y2%(11)) END IF END SUB SUB DrawInputScreen(numfields%,numbuttons%,rowinc%,params$(),x1field%,x2field%,x1butt%,x2butt%,fileonly$) STATIC 'Subroutine to draw Input Parameter Screen frow%=INT(y2%(1)/15+.5)-rowinc% FOR i%=1 TO numfields%+2 frow%=frow%+rowinc% LOCATE frow%,2:PRINT labls$(i%) IF i%>1 AND i%<= numfields% THEN EDIT FIELD i%,params$(i%),(x1field%,y1%(i%))-(x2field%,y2%(i%)) END IF IF i%=1 THEN LOCATE frow%,18 PRINT fileonly$ ELSEIF i%=3 THEN LOCATE frow%,31 'Header word button label PRINT labls$(numfields%+3) ELSEIF i%=8 THEN LOCATE frow%,38 'Header word # PRINT labls$(numfields%+4) IF rowinc%>1 THEN LOCATE frow%+1,39 PRINT labls$(numfields%+5) END IF ELSEIF i%=9 THEN LOCATE frow%,38 'Trace bias PRINT labls$(numfields%+6) ELSEIF i%=numfields%+2 THEN LOCATE frow%,38 'Annotation Increment PRINT labls$(numfields%+7) END IF NEXT BUTTON numbuttons%,1,"Plot",(x1butt%, y1%(2))-(x2butt%, y2%(2)) CALL Drawbuttons(1,params$(),x1field%,numfields%,numbuttons%, x1butt%, x2butt%) END SUB