OPL source

SITEIT:

siteit:
global SIANG$(9),SIBEAR,TEMPE,TEMPN,SIDIS,SIRAD,SISE,SISN,SITE,SITN,SIGANG,SIP,SIQ
local m%
MBODY::
CLS
m%=menun(2,"Quit,Rectangle,Polar,Intersect,Rotate,Offset,Stations,Help")
IF M%=0  OR M%=1 :STOP :ENDIF
IF M%=2 :SREC: :ENDIF
IF M%=3 :SPOL: :ENDIF
IF M%=4 :SINT: :ENDIF
IF M%=5 :SROT: :ENDIF
IF M%=6 :SOFF: :ENDIF
IF M%=7 :SSTN: :ENDIF
GOTO MBODY::

SREC:
LOCAL RADANG,M%
SGETPT:("Station")
SISE=TEMPE 
SISN=TEMPN
LBL::
SGETPT:("Target")
SITE=TEMPE :SITN=TEMPN
RADANG=FLPOLA:(SITE-SISE,SITN-SISN)
SIDIS=SQR((SITE-SISE)**2+(SITN-SISN)**2)
RADANG=180*RADANG/PI
SIANG$=FLDMS$:(RADANG)
CLS
PRINT "Bearing ",SIANG$
PRINT "Distance",FIX$(SIDIS,3,9)
PRINT REPT$(CHR$(25),20)
M%=MENUN(2,"Again,Main,Quit")
IF M%=0 OR M%=3 :STOP :ENDIF
IF M%=1 :GOTO LBL:: :ENDIF
IF M%=2 :RETURN :ENDIF

SPOL:
LOCAL M%
SGETPT:("Station")
LBL::
CLS
PRINT "Enter Bearing"
SIBEAR=FLINA:
AT 7,2 :PRINT FLDMS$:(SIBEAR);CHR$(26)
PRINT "Enter Distance"
INPUT SIDIS
SIRAD=RAD(SIBEAR)
SITE=TEMPE+SIDIS*SIN(SIRAD)
SITN=TEMPN+SIDIS*COS(SIRAD)
PRINT SIDIS*COS(SIRAD)
CLS
PRINT "East ",FIX$(SITE,3,9)
PRINT "North",FIX$(SITN,3,9)
PRINT REPT$(CHR$(25),20)
M%=MENUN(2,"Again,Main,Quit")
IF M%=0 OR M%=3 :STOP :ENDIF
IF M%=1 :GOTO LBL:: :ENDIF
IF M%=2 :RETURN :ENDIF

SOFF:
LOCAL M%,MNU%,RADANG
UDG 2,0,0,0,0,0,0,0,31
PRINT "Coords";CHR$(126);"chain+offset"
PRINT "Chain+offset";CHR$(126);"Coords"
PRINT REPT$(CHR$(2),20)
M%=MENUN(2,"Coords,Chain+Off")
IF M%=0 :STOP :ENDIF
SGETPT:("Station") :SISE=TEMPE :SISN=TEMPN
CLS
PRINT "Gridline Bearing "
SIGANG=FLINA:
AT 7,2 :PRINT FLDMS$:(SIGANG);CHR$(26)
LBL::
IF M%=2
 PRINT "Chainage ";CHR$(63)
 INPUT SIP
 PRINT "Offset ";CHR$(63)
 INPUT SIQ
 RADANG=FLPOLA:(SIQ,SIP)
 SIRAD=RADANG+RAD(SIGANG)
 SIDIS=SQR(SIP**2+SIQ**2)
 SITE=SISE+SIDIS*SIN(SIRAD)
 SITN=SISN+SIDIS*COS(SIRAD)
 CLS
 PRINT "East ",FIX$(SITE,3,9)
 PRINT "North",FIX$(SITN,3,9)
ELSE
 SGETPT:("Offset Pt")
 RADANG=FLPOLA:(TEMPE-SISE,TEMPN-SISN)
 SIDIS=SQR((TEMPE-SISE)**2+(TEMPN-SISN)**2)
 SIRAD=RADANG-RAD(SIGANG)
 SIP=SIDIS*COS(SIRAD)
 SIQ=SIDIS*SIN(SIRAD)
 CLS
 PRINT "Offset  ",FIX$(SIQ,3,9)
 PRINT "Chainage",FIX$(SIP,3,9)
ENDIF
PRINT REPT$(CHR$(25),20)
MNU%=MENUN(2,"Again,Main,Quit")
IF MNU%=0 OR MNU%=3 :STOP :ENDIF
IF MNU%=1 :GOTO LBL:: :ENDIF

SDEL:
LOCAL K%,PAK$(2),FNAME$(8),NAME$(8),RNUM%
IF EXIST("C:SISTN") :PAK$="C"
ELSEIF EXIST("B:SISTN") :PAK$="B:"
ELSEIF EXIST("A:SISTN") :PAK$="A:"
ENDIF
IF LEN(PAK$) < 1 :CLS 
FNAME$=PAK$+"SISTN"
PRINT "STATION FILE DOES"
PRINT "NOT EXIST" :PAUSE 40 :RETURN :ENDIF
FNAME$=PAK$+"SISTN"
OPEN FNAME$,A,NM$,EAST,NORTH,HEIGHT
FIRST :CLS :PRINT "Erase Stat name",CHR$(63)
INPUT NAME$
RNUM%=FIND(NAME$)
IF RNUM%=0
 CLS :PRINT NAME$,"Not Found" :PAUSE 40 :CLOSE :RETURN
ENDIF
DO
 KSTAT 1 :CLS :PRINT "Erase",A.NM$,"Y/N"
 K%=GET
 IF K%=%Y :ERASE 
 ELSE NEXT :RNUM%=FIND(NAME$)
 ENDIF
UNTIL EOF 
CLOSE :RETURN

SROT:
LOCAL SROTE,SNEWE,SNEWN,SROTN,RADANG,M%
SGETPT:("Origin")
SISE=TEMPE :SISN=TEMPN
CLS :PRINT "Angle of Rotation"
SIGANG=FLINA:
AT 7,2 :PRINT FLDMS$:(SIGANG);CHR$(26)
SGETPT:("Rotated Origin")
SROTE=TEMPE :SROTN=TEMPN
LBL::
SGETPT:("Target")
SITE=TEMPE :SITN=TEMPN
RADANG=FLPOLA:(SITE-SISE,SITN-SISN)
RADANG=RADANG-RAD(SIGANG)
SIDIS=SQR((SITE-SISE)**2+(SITN-SISN)**2)
SNEWE=SROTE+SIDIS*SIN(RADANG)
SNEWN=SROTN+SIDIS*COS(RADANG)
CLS
PRINT "East ",FIX$(SNEWE,3,9)
PRINT "North",FIX$(SNEWN,3,9)
PRINT REPT$(CHR$(25),20)
M%=MENUN(2,"Again,Main,Quit")
IF M%=0 OR M%=3 :STOP :ENDIF
IF M%=1 :GOTO LBL:: :ENDIF
IF M%=2 :RETURN :ENDIF

SGETPT:(SPT$)
LOCAL M%
CLS
PRINT "Choose method of"
PRINT "input for",SPT$
PRINT CHR$(25)
M%=MENUN(2,"Keypad,File")
IF M%=1
 PRINT SPT$+" East ";chr$(63)
 INPUT TEMPE
 PRINT SPT$+" North ";CHR$(63)
 INPUT TEMPN
ENDIF
IF M%=0 :STOP :ENDIF
IF M%=2 :SVIEW: :ENDIF
RETURN 

SIPSTN:
LOCAL FNAME$(7),PAK$(2),RNUM%,M%,IPUT$(4,10),TEMP$(10),G%,FLG%,LIN%
IF EXIST("C:SISTN") :PAK$="C:" 
ELSEIF EXIST("B:SISTN") :PAK$="B:"
ELSEIF EXIST("A:SISTN") :PAK$="A:" 
ENDIF
FNAME$=PAK$+"SISTN"
IF LEN(PAK$) < 1 :CREATE "A:SISTN",A,NM$,EAST,NORTH,HEIGHT 
ELSE : OPEN FNAME$,A,NM$,EAST,NORTH,HEIGHT :ENDIF
TOP::
LIN%=1 :G%=32 :TEMP$=""
PRINT "Name"
PRINT "East"
PRINT "North"
PRINT "Height"
DO
 AT 8,LIN%
 FLG%=1
DO
CURSOR ON
IF LIN% > 1
 KSTAT 3 :G%=GET 
 IF G%=1 :CLOSE :RETURN :ENDIF
 IF G% > 47 AND G% < 58 :TEMP$=TEMP$+CHR$(G%) :ENDIF
 IF FLG% AND G%=46 :FLG%=0 :TEMP$=TEMP$+CHR$(G%) :ENDIF
 IF LEN(TEMP$)=0 AND G%=45 :TEMP$=TEMP$+CHR$(G%) :ENDIF
ELSE
  KSTAT 1 :G%=GET
  IF G%=1 :CLOSE :RETURN :ENDIF  
  IF G% > 32 :TEMP$=TEMP$+CHR$(G%) :ENDIF
ENDIF
  AT 8,LIN% :PRINT TEMP$
  IF G%=2 :BREAK :ENDIF 
 UNTIL G%=13 OR G%=4 OR G%=3
 IF LIN%=1 :RNUM%=FIND(TEMP$) :ENDIF
 IF RNUM% > 0 :CLS :PRINT "NAME EXISTS " :PAUSE 20 :GOTO TOP:: :ENDIF
 IPUT$(LIN%)=TEMP$
 IF G%=3 AND LIN% > 1
  LIN%=LIN%-1
 ELSE :LIN%=LIN%+1 :IF LIN% > 4 :BREAK :ENDIF :ENDIF 
 TEMP$="" :AT 8,LIN% :PRINT CHR$(26)
UNTIL G%=2
AT 1,4
M%=MENUN(2,"Save,Back,Retype")
IF M%=0 :STOP :ENDIF
IF M%=1
 A.NM$=IPUT$(1) 
 IF LEN(IPUT$(2)) > 0 :A.EAST=VAL(IPUT$(2)) 
 ELSE :A.EAST=0 :ENDIF
 IF LEN(IPUT$(3)) > 0 :A.NORTH=VAL(IPUT$(3))
 ELSE :A.NORTH=0 :ENDIF
 IF LEN(IPUT$(4)) > 0 :A.HEIGHT=VAL(IPUT$(4)) 
 ELSE :A.HEIGHT=0 :ENDIF
 APPEND
 GOTO TOP::
ENDIF
IF M%=2 :CLOSE :RETURN :ENDIF
IF M%=3 :GOTO TOP:: :ENDIF

SVIEW:
LOCAL PAK$(2),FNAME$(8),G%,NEOF%
IF EXIST("C:SISTN") :PAK$="C:" 
ELSEIF EXIST("B:SISTN") :PAK$="B:" 
ELSEIF EXIST("A:SISTN") :PAK$="A:" :ENDIF
IF LEN(PAK$) < 1 :CLS :PRINT "STATION FILE DOES"
 PRINT "NOT EXIST" :PAUSE 40 :RETURN 
ENDIF 
FNAME$=PAK$+"SISTN"
OPEN FNAME$,A,NM$,EAST,NORTH,HEIGHT
PRINT "NAME   ",A.NM$
PRINT "EAST   ",A.EAST
PRINT "NORTH  ",A.NORTH
PRINT "HEIGHT ",A.HEIGHT
IF NOT EOF :AT 9+LEN(A.NM$),1 :PRINT CHR$(126) :ENDIF
G%=GET
IF G%=13 :TEMPE=A.EAST :TEMPN=A.NORTH :CLOSE :RETURN :ENDIF
IF G%=1 :CLOSE :RETURN :ENDIF
DO 
IF G%= 6 :NEXT :NEXT :IF EOF :NEOF%=-1 :ELSE NEOF%=0 :ENDIF :BACK :ENDIF
IF G%= 5 :BACK :NEOF%=0 :ENDIF
AT 9,1 :PRINT A.NM$,CHR$(26)
AT 9,2 :PRINT A.EAST,CHR$(26)
AT 9,3 :PRINT A.NORTH,CHR$(26)
AT 9,4 :PRINT A.HEIGHT,CHR$(26)
AT 8,1 :IF POS=1 :PRINT CHR$(32) :ELSE PRINT CHR$(127) :ENDIF 
AT 9+LEN(A.NM$),1
IF NEOF% :PRINT CHR$(26) :ELSE PRINT CHR$(126) :ENDIF
G%=GET
IF G%=1 :CLOSE :RETURN :ENDIF
UNTIL G%=13
TEMPE=A.EAST :TEMPN=A.NORTH
CLOSE :RETURN

SSTN:
LOCAL M%
DO
M%=MENU("Input,View,Erase,Main,Quit")
IF M%=0 :STOP 
ELSEIF M%=1 :SIPSTN:
ELSEIF M%=2 :SVIEW:
ELSEIF M%=3 :SDEL:
ELSEIF M%=4 :RETURN
ELSEIF M%=5 :STOP 
ENDIF
UNTIL 0

FLINA:
LOCAL FSIGN,ANG,ANG$(9),T%,LE%,DEG$(3),MIN$(2),SEC$(2),CNT%,BOOL%,TRY$(1)
KSTAT 3
MBODY::
FSIGN=1 :ANG=0 :CNT%=0 :BOOL%=0 :DEG$="" :MIN$="" :SEC$=""
ONERR ETRAP::
AT 1,2
PRINT "ANGLE (DDD:MM:SS)";CHR$(63)
INPUT ANG$
LE%=LEN(ANG$)
IF LEFT$(ANG$,1)="-" 
 FSIGN=-1
 LE%=LE%-1
 ANG$=RIGHT$(ANG$,LE%)
ENDIF
T%=1
DO
TRY$=MID$(ANG$,T%,1)
T%=T%+1
IF ASC(TRY$) < 48 OR ASC(TRY$) > 57 :BOOL%=-1 :CNT%=CNT%+1
ELSE
 IF CNT%=1 :MIN$=MIN$+TRY$ 
 ELSEIF CNT%=2 :SEC$=SEC$+TRY$ 
 ELSE :DEG$=DEG$+TRY$ :ENDIF
ENDIF
UNTIL T% > LE%
IF LEN(DEG$) < 1 :DEG$="0" :ENDIF
IF LEN(MIN$) < 1 :MIN$="0" :ENDIF
IF LEN(SEC$) < 1 :SEC$="0" :ENDIF
IF VAL(MIN$) > 59 OR VAL(SEC$) > 59
 GOTO ETRAP:: 
ENDIF
ANG=VAL(DEG$)+VAL(MIN$)/60+VAL(SEC$)/3600
ANG=ANG*FSIGN
RETURN ANG
ETRAP::
ONERR OFF :IF ERR=194 :RAISE ERR :ENDIF
AT 1,2
PRINT "INVALID INPUT",CHR$(26)
PRINT "Any key to contiue"
IF GET=1 :STOP :ENDIF
PRINT CHR$(22);CHR$(23)
GOTO MBODY::

SINT:
LOCAL R1,R2,TANG,SANG,TEMPA,RADANG,MNU%,M%,I2E,I2N,TDIS
PRINT "2 angles,2 distance"
PRINT "or angle + distance"
PRINT REPT$(CHR$(25),20)
MNU%=MENUN(2,"Ang,Dist,Both")
IF MNU%=0 :STOP :ENDIF
IF MNU%=1 
 SGETPT:("First Pt")
 SISE=TEMPE :SISN=TEMPN
 CLS
 PRINT "Enter 1st Bearing"
 SIBEAR=FLINA:
 AT 7,2 :PRINT FLDMS$:(SIBEAR);CHR$(26)
 SGETPT:("Second Pt")
 I2E=TEMPE :I2N=TEMPN
 CLS
 PRINT "Enter 2nd Bearing"
 SIGANG=FLINA:
 CLS :AT 5,2 :PRINT "Computing......"
 TEMPA=FLPOLA:(I2E-SISE,I2N-SISN) 
 SIDIS=SQR((I2E-SISE)**2+(I2N-SISN)**2)
 SANG=RAD(SIBEAR)-TEMPA
 TANG=TEMPA+PI-RAD(SIGANG)
 SIP=(SIDIS*TAN(TANG))/(TAN(SANG)+TAN(TANG))
 SIQ=SIP*TAN(SANG)
 RADANG=FLPOLA:(SIQ,SIP)
 RADANG=RADANG+TEMPA
 SIDIS=SQR(SIP**2+SIQ**2)
 SITE=SISE+SIDIS*SIN(RADANG)
 SITN=SISN+SIDIS*COS(RADANG)
 CLS
 PRINT "East ",FIX$(SITE,3,9)
 PRINT "North",FIX$(SITN,3,9)
 GET
ELSEIF MNU%=2
 SGETPT:("1st Centre")
 SISE=TEMPE :SISN=TEMPN 
 CLS :PRINT "Enter 1st Distance"
 INPUT R1
 SGETPT:("2nd Centre")
 I2E=TEMPE :I2N=TEMPE
 CLS :PRINT "Enter 2nd Distance"
 INPUT R2
 CLS :AT 5,2 : PRINT"Computing......"
REM TDIS=SQR((I2E-SISE)**2+(I2N-SISN)**2)
REM TANG=FLPOLA:(I2E-SISE,I2N-SISN)
 TEMPA=R1+R2 
 IF TDIS > TEMPA :CLS :PRINT "No Intersection" :PAUSE 40 :RETURN :ENDIF 
 SIP=(TDIS**2+R1**2+R2**2)/(2*TDIS) 
 SIQ=SQR(R1**2-SIP**2)
REM RADANG=FLPOLA:(SIQ,SIP)
 SANG=RADANG+TANG
 SITE=SISN+R1*SIN(SANG) 
 SITN=SISN+R1*COS(SANG)
 PRINT "East ",FIX$(SITE,3,9) 
 PRINT "North",FIX$(SITN,3,9)
GET
ENDIF

FLPOLA:(MYE,MYN)
LOCAL ANS,QUAD
QUAD=1
IF MYN < 0 :IF MYE < 0 :QUAD=3 :ELSE :QUAD=2 :ENDIF :ENDIF 
IF MYN > 0 :IF MYE < 0 :QUAD=4 :ENDIF :ENDIF
IF ABS(MYN) > 0 :ANS=ATAN(MYE/MYN):ELSE :ANS=PI/2 :IF MYE < 0 :ANS=ANS+PI :ENDIF :ENDIF
IF QUAD=2 :ANS=ANS+PI :ENDIF
IF QUAD=3 :ANS=ANS+PI :ENDIF
IF QUAD=4 :ANS=ANS+PI*2 :ENDIF
IF ABS(MYE) < 0.001 :IF ABS(MYN) < 0.001 :ANS=0 :ENDIF :ENDIF
RETURN ANS

FLDMS$:(ANG)

LOCAL ANS$(9),DEGS,MINS,SECS,TEMP,DECA,MIN$(2),SEC$(2)
DECA=ANG
WHILE DECA<0 :DECA=DECA+360 :ENDWH
WHILE DECA>=360 :DECA=DECA-360 :ENDWH
DEGS=INT(DECA)
MINS=INT((DECA-DEGS)*60)
SECS=(DECA-DEGS-MINS/60)*3600
TEMP=SECS-INT(SECS)
IF TEMP>0.5 :SECS=SECS+1 :ENDIF
SECS=INT(SECS)
IF SECS=60 :SECS=0 :MINS=MINS+1 :ENDIF
IF MINS=60 :MINS=0 :DEGS=DEGS+1 :ENDIF
IF DEGS=360 :DEGS=0 :ENDIF
MIN$=NUM$(MINS,2)
IF LEN(MIN$)<2 :MIN$="0"+MIN$ :ENDIF
SEC$=NUM$(SECS,2)
IF LEN(SEC$)<2 :SEC$="0"+SEC$ :ENDIF
ANS$=NUM$(DEGS,3)+":"+MIN$+":"+SEC$
RETURN ANS$