7m…ôcU/s\cd “rem this file is "pSurvex-alpha"rem see include file, "pSurvex.oph" forrem compile time optionsrem wish listrem ~~~~~~~~~rem trap errors in reading .svx filesrem deal with unconnected surveys betterrem various tidying of coderem blank lines (test thoroughly)rem dynamic memory allocationrem loop closure dispacementsrem loop lengthsrem error if output file cannot be openedrem plot points on screenrem rotate points on screenrem integrated output file viewerrem integrated text editorrem offering to plot elevation anglerem Code tidyingrem ~~~~~~~~~~~~rem move gfx out of main into drawConsole: and call from initrem put ini file location in headerrem write and use testFlags:rem wrtie and use warn:rem wrtie and use error:rem wrtie and use fatalError:rem rename globals for consistencyinclude "pSurvex.oph"declare externalconst VERSION$="pSurvex 0.22 (alpha) (Series 5)"rem APP pSurvexß,&093B7073 rem tab ; p s rem FLAGS 1 rem use documentsrem ENDAPROC init: rem Memory management stuff rem ~~~~~~~~~~~~~~~~~~~~~~~ global stringTable&, nextString&, maxString& global surveys&, nextSurvey&, maxSurvey& global stations&, nextStation&, maxStation& global legs&, nextLeg&, maxLeg& global stackBase&,stackPtr&,stackLimit& rem Misc global variables rem ~~~~~~~~~~~~~~~~~~~~~ global survCurrent& rem which survey are we currently working on ? global statusLast% rem what was the last line angle drawn ? global DEBUG% rem are we degugging ?  rem now do something with ... rem ~~~~~~~~~~~~~~~~~~~~~~~~~ print VERSION$; " initialising..." stringTable& = alloc(stringALU%) surveys& = alloc(sizeofSurvey% * surveyALU&) stations& = alloc(sizeofStation% * stationALU&) legs& = alloc(sizeofLeg% * legALU&) stackBase& = alloc(stackALU%) if (stringTable&=0) or (surveys&=0) or (stations&=0) or (legs&=0) or (stackBase&=0) dInit("Error") dText "","Unable to allocate memory." dText "","Close some other programs and" dText "","try again, or lower allocation sizes" dText "","in pSurvex.oph and recompile" dButtons "OK",(13 or $300) dialog stop endif nextString& = stringTable& survCurrent& = surveys& nextSurvey& = surveys& + sizeofSURVEY% nextStation& = stations& nextLeg& = legs& stackPtr& = stackBase& maxString& = stringTable& + stringALU% maxSurvey& = surveys& + sizeofSurvey% * surveyALU& maxStation& = stations& + sizeofStation% * stationALU& maxLeg& = legs& + sizeofLeg% * legALU& stackLimit& = stackBase& + stackALU% zeroFlags:(survCurrent&) setName:(survCurrent&,"") setParent:(survCurrent&,NULL%) setDaughter:(survCurrent&,NULL%) setSister:(survCurrent&,NULL%) setStationHead:(survCurrent&,NULL%) setStationTail:(survCurrent&,NULL%) setTapeCalib:(survCurrent&,0) setCompassCalib:(survCurrent&,0) setClinoCalib:(survCurrent&,0) screen 88,12 main:ENDPPROC main: external DEBUG%,surveys& global directory$(255) local file$(255),off%(6),places&,fIni%,error% places&=2 gCreate(0,0,640,40,1) rem Title window gStyle 9 :gAt 8,26 :gPrint VERSION$ rem Title text gAt 0,36 :gFill 640,3,0 rem Title rule gCreate(0,210,640,30,1) rem Status Window gFill 640,3,0 rem Status rule cls error% = ioopen(fIni%,"d:\system\apps\pSurvex\pSurvex.ini",$0020) if error%=0 error%=ioread(fIni%,addr(file$)+1,255) pokeb addr(file$),error% else  file$="C:\Documents\*.svx" if error% <> -33 rem file does not exist print "Error "+fix$(error%,0,3)+", ";err$(error%);" reading .ini file" endif endif ioclose (fIni%) statusText:("waiting for file selector...") dInit VERSION$ dFile file$,"file,folder,disk",146 dLong places&,"Decimal places to output",0,9 if ALLOWDEBUG% :dCheckBox DEBUG%,"Debug Mode" :endif dButtons "Cancel",-27,"OK",13 statusText:("") if dialog=0 :stop :endif setdoc file$ error% = ioopen(fIni%,"d:\system\apps\pSurvex\pSurvex.ini",$0122) if error% = 0 iowrite(fIni%,addr(file$)+1,len(file$)) else print "Error "+fix$(error%,0,3)+", ";err$(error%);" writing to .ini file" endif ioclose(fIni%) parse$(file$,"",off%()) directory$=left$(file$,off%(4)-1) lopen left$(file$,off%(5)-1)+".alpha.pos.txt" rem FIXME - need to notice if fail to open above file rem since nothing gets written if it is already open  print "Warning: no error raised or output generated if "+left$(file$,off%(5)-1)+".pos.txt is already open" readFile:(file$) statusText:("Computing...") compute: rem statusText:("Writing positions to file...") rem doOutput:(places&) beep 8,300 drawSurvey:(surveys&)ENDPrem ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~rem This procedure takes a filename and passesrem it line by line to the parser. Welcome torem the hell that is EPOCs / OPL file io !rem ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~PROC readFile:(filename$) global line$(LINELENGTH%),lc% local fin%, err%, ptr& err% = ioopen(fin%,filename$,$0020) if err% print "Error "; err%; " opening file "; filename$ lprint "Error "; err%; " opening file "; filename$ else statusText:("parsing file: "+filename$) ptr& = addr(line$) while err% <> -36 err% = ioread(fin%,ptr&+1,LINELENGTH%)  lc%=lc%+1 if (err% >= 0) pokeb ptr&,err% statusText:("parsing line "+fix$(lc%,0,4)+" in "+filename$) parseLine: status: elseif (err% = -43) lprint "Warning line ";lc%;" is over "; LINELENGTH%; " characters in length. Modifier header file to change line length limit" print "Warning line ";lc%;" is too long" pokeb ptr&,LINELENGTH% parseLine: elseif (err% <> -36) print "Error "; err% ;" reading file ";filename$  endif endwh endifENDPrem ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~rem This procedure takes a line and decides what to dorem with it then passes to the appropriate procedurerem ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~PROC parseLine: external line$ rem the line defined as global from readFile: external DEBUG%,survCurrent& global count% rem how many characters in we are (for nextToken:) local token$(LINELENGTH%) if DEBUG% :print line$ :endif token$=nextToken$: if token$="" rem noop elseif asc(mid$(token$,1,1))=%* token$=upper$(token$) @("parse"+(mid$(token$,2,len(token$)))): rem FIXME - this may be neat but it doesn't generate rem a very nice error if the procedure doesn't rem exist. else parseData:(token$) endifENDPrem ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~rem this procedure looks at line$ andrem returns the next token from therem count%+1 character and advances count%rem to the last character in the tokenrem ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~PROC nextToken$: external line$,count% local token$(LINELENGTH%), ch$(1), chAsc% do count%=count%+1 if count%>len(line$): chAsc%=0 :break :endif ch$ = mid$(line$,count%,1) chAsc% = asc(ch$) until (chAsc%<>32) and (chAsc%<>9) and (chAsc%<>0) while (chAsc%<>32) and (chAsc%<>9) and (chAsc%<>0) and (chAsc%<>%;) token$=token$+ch$ ch$ = mid$(line$,count%+1,1) chAsc% = asc(ch$) count%=count%+1 endwh count%=count%-1 return token$ENDPrem ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~rem this procedure takes two station names andrem data adds the leg to the treerem ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~PROCaddLeg:(from$, to$, tape, compass, clino, flags%) local fromStation&, toStation&, leg& fromStation& = getStation&:(from$) toStation& = getStation&:(to$) leg& = newLeg&:(fromStation&,toStation&) setleg:(leg&, tape, compass, clino, flags%)ENDPPROC setLeg:(leg&,tape,compass,clino,flags%) pokef leg&+OFFtape%,tape pokef leg&+OFFcompass%,compass pokef leg&+OFFclino%,clino setFlags:(leg&,flags%)ENDPrem ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~rem This creates and returns the address of arem new blank entry in the leg structure forrem given station addressesrem ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~PROC newLeg&:(from&,to&) external nextLeg&,maxLeg&,stations&,nextStation&,survCurrent& local node&,test$(LINELENGTH%) if (to&nextStation&) or (from&nextStation&) print print " *** INTERNALERROR *** " print " tried to create a leg to or " print " from an invalid station " print endif if nextLeg&>maxLeg& reallocLegs: endif setFrom:(nextLeg&,from&) setTo:(nextLeg&,to&) setFromSister:(nextLeg&,NULL%) setToSister:(nextLeg&,NULL%) zeroFlags:(nextLeg&) setFlags:(nextLeg&,getFlags%:(survCurrent&)) if getLegHead&:(from&)=NULL% setLegHead:(from&,nextLeg&) else node& = getLegHead&:(from&) while getFromSister&:(node&)<>NULL% node& = getFromSister&:(node&) endwh setFromSister:(node&,nextLeg&) endif if getBacklegHead&:(to&)=NULL% setBacklegHead:(to&,nextLeg&) else node& = getBacklegHead&:(to&) while getToSister&:(node&)<>NULL% node& = getToSister&:(node&) endwh setToSister:(node&,nextLeg&) endif nextLeg&=nextLeg&+sizeofLEG% return nextLeg&-sizeofLEG%ENDPrem ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~rem This returns the station index for arem given station name, creating one if itrem the station name isn't found amongstrem those listedrem ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~PROC getStation&:(sName$) external survCurrent&, nextStation&, maxStation& local stat&,surv&,subSurvey$(LINELENGTH%),name$(LINELENGTH%) name$=sName$ surv&=survCurrent& while loc(name$,".")<>0  subSurvey$=left$(name$,loc(name$,".")-1) name$=right$(name$,len(name$)-loc(name$,".")) surv&=getSurvey&:(subSurvey$,surv&) endwh stat&=getStationHead&:(surv&) while stat&<>NULL% if upper$(getName$:(stat&))=upper$(name$) break endif stat&=getNext&:(stat&) endwh if stat&=NULL% if nextStation&>maxStation& reallocStations: endif stat&=nextStation& nextStation&=nextStation&+sizeofSTATION% setName:(stat&,name$) zeroFlags:(stat&) setInSurvey:(stat&,surv&) setNext:(stat&,NULL%) setLegHead:(stat&,NULL%) setBacklegHead:(stat&,NULL%) setEast:(stat&,0) setNorth:(stat&,0) setHeight:(stat&,0) if getStationHead&:(surv&)=NULL% setStationHead:(surv&,stat&) else setNext:(getStationTail&:(surv&),stat&) endif setStationTail:(surv&,stat&) endif return stat&ENDPPROC getSurvey&:(name$,root&) external survCurrent&,nextSurvey&,maxSurvey& local surv& surv&=getDaughter&:(root&) while surv&<>NULL% if upper$(getName$:(surv&))=upper$(name$) break endif surv&=getSister&:(surv&) endwh if surv&=NULL% if nextSurvey&>maxSurvey& reallocSurveys: endif setParent:(nextSurvey&,root&) surv&=getDaughter&:(root&) if surv& = NULL% setDaughter:(root&,nextSurvey&) else while getSister&:(surv&)<>NULL% surv&=getSister&:(surv&) endwh setSister:(surv&,nextSurvey&) endif surv&=nextSurvey& nextSurvey&=nextSurvey&+sizeofSURVEY% setName:(surv&,name$) zeroFlags:(surv&) setFlags:(surv&,getFlags%:(root&)) setDaughter:(surv&,NULL%) setSister:(surv&,NULL%) setStationHead:(surv&,NULL%) setStationTail:(surv&,NULL%) setTapeCalib:(surv&,0) rem FIXME - should these be setCompassCalib:(surv&,0) rem inherited from setClinoCalib:(surv&,0) rem parent survey ? endif return surv&ENDPrem ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~rem This procedure traverses the tree andrem computes the surveyrem ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~PROC compute: rem this is quick and dirty external DEBUG%,stations&,nextStation& local dE,dN,dH,tape,compass,clino local stat&, stat2&, leg&, changes% stat&=stations&-sizeofSTATION% :while stat&-1 setFlags:(stations&,flagCALC%) print "WARNING: no fixed points, fixing station ";getName$:(stations&);" to 0,0,0" endif changes%=1 :while changes%=1 :changes%=0 stat&=stations&-sizeofSTATION% :while stat&NULL% stat2&=getTo&:(leg&) if (getFlags%:(stat2&) and flagCALC%) <> flagCALC% rem can't do loop closures this way ! tape=getTape:(leg&) compass=rad(getCompass:(leg&)) clino=rad(getClino:(leg&)) dE=sin(compass)*cos(clino)*tape dN=cos(compass)*cos(clino)*tape dH=sin(clino)*tape setEast:(stat2&,getEast:(stat&)+dE) setNorth:(stat2&,getNorth:(stat&)+dN) setHeight:(stat2&,getHeight:(stat&)+dH) setFlags:(stat2&,flagCALC%) changes%=1 endif leg&=getFromSister&:(leg&) endwh leg&=getBacklegHead&:(stat&) while leg&<>NULL% stat2&=getFrom&:(leg&) if (getFlags%:(stat2&) and flagCALC%) <> flagCALC% tape=getTape:(leg&) compass=rad(getCompass:(leg&)+180) clino=rad(getClino:(leg&)*-1) dE=sin(compass)*cos(clino)*tape dN=cos(compass)*cos(clino)*tape dH=sin(clino)*tape setEast:(stat2&,getEast:(stat&)+dE) setNorth:(stat2&,getNorth:(stat&)+dN) setHeight:(stat2&,getHeight:(stat&)+dH) setFlags:(stat2&,flagCALC%) changes%=1 endif leg&=gettoSister&:(leg&) endwh endif endwh endwhENDPPROC doOutput:(dp&) external surveys&,nextSurvey&,stations&,nextStation&,legs&,nextLeg& local survey&,survTrace&,station&,leg&,fullName$(255) local east, north, height local minEast,maxEast,minNorth,maxNorth,minHeight,maxHeight local surfLength,ugLength,totalSurfLength,totalUgLength minEast=getEast:(stations&) minNorth=getNorth:(stations&) minHeight=getHeight:(stations&) station&=stations&-sizeofSTATION% :while station&NULL% while getParent&:(survTrace&)<>NULL% fullName$=getName$:(survTrace&)+"."+fullName$ survTrace&=getParent&:(survTrace&) endwh endif station&=getStationHead&:(survey&) while station&<>NULL% east = getEast:(station&) north = getNorth:(station&) height = getHeight:(station&) lprint fullName$;".";getName$:(station&);chr$(9); lprint fix$(east,dp&,-14);" "; lprint fix$(north,dp&,-14);" "; lprint fix$(height,dp&,-14) if northmaxNorth :maxNorth=north :endif if eastmaxEast :maxEast=east :endif if heightmaxHeight :maxHeight=height :endif station&=getNext&:(station&) status: endwh rem station loop endwh rem survey loop lprint lprint "Eastings range from ";fix$(minEast,dp&+2,16); lprint " to ";fix$(maxEast,dp&+2,16);" ("; lprint fix$(maxEast-minEast,dp&,16);"m)" lprint "Northings range from ";fix$(minNorth,dp&+2,16); lprint " to ";fix$(maxNorth,dp&+2,16);" ("; lprint fix$(maxNorth-minNorth,dp&,16);"m)" lprint "Heights range from ";fix$(minHeight,dp&+2,16); lprint " to ";fix$(maxHeight,dp&+2,16);" ("; lprint fix$(maxHeight-minHeight,dp&,16);"m)" lprint survey&=surveys&-sizeofSURVEY% :while survey&NULL% while getParent&:(survTrace&)<>NULL% fullName$=getName$:(survTrace&)+"."+fullName$ survTrace&=getParent&:(survTrace&) endwh else fullName$="root survey" endif lprint "Surface survey for ";fullName$;" is ";fix$(surfLength,dp&+2,16);"m" lprint "Underground survey for ";fullName$;" is ";fix$(ugLength,dp&+2,16);"m" totalSurfLength=totalSurfLength+surfLength totalUgLength=totalUgLength+ugLength surfLength=0 :ugLength=0 endwh lprint lprint "Surface survey length: ";fix$(totalSurfLength,dp&+2,16);"m" lprint "Underground survey length: ";fix$(totalUgLength,dp&+2,16);"m" lprint "Total survey length: ";fix$(totalSurfLength+totalUgLength,dp&+2,16);"m"ENDPPRoC drawSurvey:(root&) local survey&,station&,leg& local winID%,minEast,maxEast,minNorth,maxNorth rem winID% = gCreate(0,0,640,240,1,0) rem find min and max for North and East survey&=root& do print getName$:(survey&) survey&=getDaughter&:(survey&) if survey& <> NULL% pushl:(survey&) if getSister&:(survey&)<>NULL% survey&=getSister&:(survey&) endif else survey&=popl&: endif  until survey&=root& rem for survey and each subsurvey rem for each station in survey rem test min and max for rem next station rem next survey  rem for survey and each subsurvey rem for each station in survey rem draw all legs rem next station rem next surveyENDPPROC reallocLegs: print print "Dynamic memory not yet implemented" print "increase legALU& in pSurvex.h and recompile" print :get :stopENDPPROC reallocStations: print print "Dynamic memory not yet implemented" print "increase statonALU& in pSurvex.h and recompile" print :get :stopENDPPROCreallocSurveys: print print "Dynamic memory not yet implemented" print "increase surveyALU& in pSurvex.h and recompile" print :get :stopENDPPROCreallocStringTable:(min%) print print "Dynamic memory not yet implemented" print "increase stringALU% in pSurvex.h and recompile" print :get :stopENDPPROC stackOverflow: print print "Stack Overflow" print "increase stackALU% in pSurvex.h and recompile" print :get :stopENDPPROC pushw:(w%) external stackBase&,stackPtr&,stackLimit& if stackPtr&+sizeofInt%>stackLimit& :stackOverflow: :endif pokew stackPtr&,w% stackPtr&=stackPtr&+sizeofInt%ENDPPROC pushl:(l&) external stackBase&,stackPtr&,stackLimit& if stackPtr&+sizeofLong%>stackLimit& :stackOverflow: :endif pokew stackPtr&,l& stackPtr&=stackPtr&+sizeofLong%ENDPPROC pushf:(f) external stackPtr&,stackLimit& if stackPtr&+sizeofFloat%>stackLimit& :stackOverflow: :endif pokew stackPtr&,f stackPtr&=stackPtr&+sizeofFloat%ENDPPROC popw%: external stackPtr&,stackBase& stackPtr&=stackPtr&-sizeofInt% if stackPtr&3 :statusLast%=0 :endifENDPPROC printStation:(stat&) if stat&=NULL% print "station is NULL" else print "station ";stat&;" is ";getName$:(stat&) print "flags: ";getFlags%:(stat&); print " survey is ";getInSurvey&:(stat&) print "next is ";getNext&:(stat&); print " legHead is ";getLegHead&:(stat&) print "backlegHead is ";getBacklegHead&:(stat&) endif getENDPPROC printLeg:(leg&) if leg&=NULL% print "Leg is NULL" else print "Leg ";leg&;" flags:";getFlags%:(leg&) print "from ";getFrom&:(leg&); print " fromSister ";getFromSister&:(leg&) print "to ";getTo&:(leg&); print " toSister ";getToSister&:(leg&) endif getENDPPROC parseData:(token1$) external DEBUG%,survCurrent& local token$(LINELENGTH%), from$(LINELENGTH%), to$(LINELENGTH%), tape, compass, clino from$ = token1$ to$ = nextToken$: tape = val(nextToken$:) if (tape<=0) or (tape>100) print"WARNING suspicious tape reading, ";tape;" from ";from$;" to ";to$ endif token$ = upper$(nextToken$:) if token$="UP" compass=999 clino=90 elseif token$="DOWN" compass=999 clino=-90 else if token$="-" compass=999 else compass=val(token$) if (compass < 0) or (compass > 359.5) print "Warning suspicious compass reading, ";compass;" from ";from$;" to ";to$ endif endif token$=upper$(nextToken$:) if token$="UP" clino = 90 elseif token$="DOWN" clino = -90 else clino=val(token$) if (clino>90) or (clino<-90) print "WARNING suspicious clino reading, ";clino;" from ";from$;" to ";to$ endif endif endif if compass=999 addleg:(from$,to$,tape+getTapeCalib:(survCurrent&),999,clino,0) else addleg:(from$,to$,tape+getTapeCalib:(survCurrent&),compass+getCompassCalib:(survCurrent&),clino+getClinoCalib:(survCurrent&),0) endifENDPPROC parseBegin: external survCurrent& local newSurvey$(LINELENGTH%) newSurvey$ = nextToken$: survCurrent&=getSurvey&:(newSurvey$,survCurrent&)ENDPPROC parseEnd: external survCurrent&,surveys& local token$(LINELENGTH%) token$=nextToken$: if survCurrent&=surveys& print "Warning *END "; token$; " in root survey" elseif upper$(token$)<>upper$(getName$:(survCurrent&)) print "Warning expecting *END "; getName$:(survCurrent&); " got *END "; token$ else survCurrent&=getParent&:(survCurrent&) endifENDPPROC parseFix: external DEBUG% local statName$(LINELENGTH%),stat&,east,north,height statName$=nextToken$: stat&=getStation&:(statName$) pokef stat&+OFFeast%,val(nextToken$:) pokef stat&+OFFnorth%,val(nextToken$:) pokef stat&+OFFheight%,val(nextToken$:) setFlags:(stat&,flagCALC%)ENDPPROC parseEquate: external DEBUG% local from$(LINELENGTH%),to$(LINELENGTH%) from$ = nextToken$: to$ = nextToken$: addleg:(from$,to$,0,888,0,0)ENDPPROC parseInclude: external directory$ readFile:(directory$+nextToken$:)ENDPPROC parseExport:ENDPPROC parseFlags: external survCurrent&,lc% local token$(LINELENGTH%),flag%,not% not%=FALSE% flag%=0 token$=upper$(nextToken$:) while token$<>"" if token$="NOT" if not%=true% print "Warning: ignoring double negative in *FLAGS on line ";lc% endif not%=TRUE% else if token$="SURFACE": flag%=flagSURFACE% elseif token$="SPLAY": flag%=flagSPLAY% elseif token$="DUPLICATE": flag%=flagDUPLICATE% else print "Warning: *FLAGS (NOT)";token$;" not recognised" endif if not%=TRUE% unsetFlags:(survCurrent&,flag%) else setFlags:(survCurrent&,flag%) endif not%=FALSE% flag%=0 endif token$=upper$(nextToken$:) endwh if not%=TRUE% print "Warning: *FLAGS ends with a NOT on line ";lc% endifENDPPROC parseCalibrate: external survCurrent&,lc% local what$(linelength%),amount what$=upper$(nextToken$:) amount=val(nextToken$:) if nextToken$:<>"" print "Error: can only calibrate one thing at once (line ";lc%;")" endif if what$="TAPE" setTapeCalib:(survCurrent&,amount) elseif what$="COMPASS" setCompassCalib:(survCurrent&,amount) elseif what$="CLINO" setClinoCalib:(survCurrent&,amount) else print "Error: cannot calibrate a ";what$; "(line ";lc%;")" endifENDPPROC parseTeam:ENDPPROC parseDate:ENDPPROC parseTitle:ENDPPROC parseEntrance:ENDPPROC parseInstrument: rem FIXME - which one is valid ?ENDPPROC parseInstruments: rem FIXME - which one is valid ?ENDPrem parameters for both surveys and stationsrem ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~PROC getFlags%:(s&) return peekw(s&+OFFflags%)ENDPPROC setFlags:(s&,flags%) pokew s&+OFFflags%,(peekw(s&+OFFflags%) or flags%)ENDPPROC unsetFlags:(s&,flags%) pokew s&+OFFflags%,(peekw(s&+OFFflags%) and not(flags%))ENDPPROC zeroFlags:(s&) pokew s&+OFFflags%,0ENDPPROC getName$:(s&) return peek$(peekl(s&+OFFname%))ENDPPROC setName:(s&,name$) external nextString&,maxString& if nextString&+len(name$)+1 > maxString& reallocStringTable:(len(name$)+1) endif pokel s&+OFFname%,nextString& poke$ nextString&,name$ nextString&=nextString&+len(name$)+1ENDPrem parameters for surveysrem ~~~~~~~~~~~~~~~~~~~~~~PROC getParent&:(survey&) return peekl(survey&+OFFparent%)ENDPPROC setParent:(survey&,parent&) pokel survey&+OFFparent%,parent&ENDPPROC getDaughter&:(survey&) return peekl(survey&+OFFdaughter%)ENDPPROC setDaughter:(survey&,daughter&) pokel survey&+OFFdaughter%,daughter&ENDPPROC getSister&:(survey&) return peekl(survey&+OFFsister%)ENDPPROC setSister:(survey&,sister&) pokel survey&+OFFsister%,sister&ENDPPROC getStationHead&:(survey&) return peekl(survey&+OFFstationHead%)ENDPPROC setStationHead:(survey&,stationHead&) pokel survey&+OFFstationHead%,stationHead&ENDPPROC getStationTail&:(survey&) return peekl(survey&+OFFstationTail%)ENDPPROC setStationTail:(survey&,stationTail&) pokel survey&+OFFstationTail%,stationTail&ENDPPROC getTapeCalib:(survey&) return peekf(survey&+OFFtapeCalib%)ENDPPROC setTapeCalib:(survey&,tapeCalib) pokef survey&+OFFtapeCalib%,tapeCalibENDPPROC getCompassCalib:(survey&) return peekf(survey&+OFFcompassCalib%)ENDPPROC setCompassCalib:(survey&,compassCalib) pokef survey&+OFFcompassCalib%,compassCalibENDPPROC getClinoCalib:(survey&) return peekf(survey&+OFFclinoCalib%)ENDPPROC setClinoCalib:(survey&,clinoCalib) pokef survey&+OFFclinoCalib%,clinoCalibENDPrem Station parametersPROC getInSurvey&:(station&) return peekl(station&+OFFsurvey%)ENDPPROC setInSurvey:(station&,survey&) pokel station&+OFFsurvey%,survey&ENDPPROC getNext&:(station&) return peekl(station&+OFFnext%)ENDPPROC setNext:(station&,next&) pokel station&+OFFnext%,next&ENDPPROC getLegHead&:(station&) return peekl(station&+OFFlegHead%)ENDPPROC setLegHead:(station&,legHead&) pokel station&+OFFlegHead%,legHead&ENDPPROC getBacklegHead&:(station&) return peekl(station&+OFFbacklegHead%)ENDPPROC setBacklegHead:(station&,backlegHead&) pokel station&+OFFbacklegHead%,backlegHead&ENDPPROC getEast:(station&) return peekf(station&+OFFeast%)ENDPPROC setEast:(station&,east) pokef station&+OFFeast%,eastENDPPROC getNorth:(station&) return peekf(station&+OFFNorth%)ENDPPROC setNorth:(station&,north) pokef station&+OFFnorth%,northENDPPROC getHeight:(station&) return peekf(station&+OFFheight%)ENDPPROC setHeight:(station&,height) pokef station&+OFFheight%,heightENDPrem parameters for legsrem ~~~~~~~~~~~~~~~~~~~PROC getFrom&:(leg&) return peekl(leg&+OFFfrom%)ENDPPROC setFrom:(leg&,from&) pokel leg&+OFFfrom%,from&ENDPPROC getFromSister&:(leg&) return peekl(leg&+OFFfromSister%)ENDPPROC setFromSister:(leg&,sister&) pokel leg&+OFFfromSister%,sister&ENDPPROC getTo&:(leg&) return peekl(leg&+OFFto%)ENDPPROC setTo:(leg&,to&) pokel leg&+OFFto%,to&ENDPPROC getToSister&:(leg&) return peekl(leg&+OFFtoSister%)ENDPPROC setToSister:(leg&,sister&) pokel leg&+OFFtoSister%,sister&ENDPPROC getTape:(leg&) return peekf(leg&+OFFtape%)ENDPPROC setTape:(leg&,tape) pokef leg&+OFFtape%,tapeENDPPROC getCompass:(leg&) return peekf(leg&+OFFcompass%)ENDPPROC setCompass:(leg&,compass) pokef leg&+OFFcompass%,compassENDPPROC getClino:(leg&) return peekf(leg&+OFFclino%)ENDPPROC setClino:(leg&,clino) pokef leg&+OFFclino%,clinoENDPÐР   \c‰refd\c‘refdý‚.ÆA…*TextEd.app…™r‰ s