* Point - inters,proj,limits,median, (C) EMA 1997-2002 LM:20.08.2002 * 20.08.2002 proj,limits,median * 11.04.2001 multi-use INTERNAL INTEGER ER,I,J,M1,M2,STKPT,ARC(2) REAL DEV FORMAT 6/3,PAR(2) CHAR*35 CEMA INIT ' POINT PRJ/INT/LIMITS, (C) Ema 1997' UNDEFLM E1,E2,PT,PTX,PT2(2) LN LN PROC LOAD GUEACT 0,ER LOAD GUSINI 4,STKPT,ER LABEL AGAIN NOHIGHLT E1 LOAD GUSINF STKPT,J,I,ER BLOCKIF(I GT 0)AND(ER EQ 0)THEN SELECT 'SEL ELEMENT 1, YES:END '//CEMA E1,NO,YES ELSE SELECT 'SEL ELEMENT 1, YES:END '//CEMA E1,YES ENDIF IF(KODE EQ YES)THEN EOE BLOCKIF(KODE EQ NO)THEN DO LOAD GUSPOP STKPT,PT,I,ER ERASE PT WHILE(I EQ 0) MSGCNTL 'PT DELETED' BRANCH AGAIN ENDIF HIGHLT E1 MSGCNTL 'TO CREATE LIMITS SEL AGAIN' LET LN=NULL SELECT 'SEL ELEMENT 2, IND PT, YES:END '//CEMA E2,NO,YES,LN IF(KODE EQ SEL)AND(E2 EQ NULL)LET E2=E1 IF(KODE EQ YES)THEN EOE IF(KODE EQ NO)BRANCH AGAIN BLOCKIF(E1 EQ E2)THEN IF(TYPP(E1)EQ 2)LOAD GSLIMP 1,E1,1,ARC,PAR,PT2,I,ER IF(TYPP(E1)EQ 2)AND(I EQ 0)LOAD GUSPUS STKPT,PT2(1),J,ER IF(TYPP(E1)EQ 2)AND(I EQ 0)LOAD GUSPUS STKPT,PT2(2),J,ER IF(TYPP(E1)NE 2)LOAD GSOIET 1,E1,0,I,STKPT,ER MSGCNTL 'SOME POINTS CREATED (MAYBE NOT)' BRANCH AGAIN ENDIF NOHIGHLT E1 IF(LN NE NULL)LET E2=LN LET I=TYPP(E1) LET J=TYPP(E2) LET M1=0 LET M2=0 IF(I EQ 2)OR(I EQ 3)OR(I EQ 12)OR(I EQ 14)LET M1=1 IF(I EQ 20)OR(I EQ 21)OR(I EQ 22)OROR(I EQ 23)OR(I EQ 24)LET M1=1 IF(J EQ 2)OR(J EQ 3)OR(J EQ 12)OR(J EQ 14)LET M2=1 IF(J EQ 20)OR(J EQ 21)OR(J EQ 22)OROR(J EQ 23)OR(J EQ 24)LET M2=1 IF(I EQ 4)OR(I EQ 5)OR(I EQ 6)OR(I EQ 7)OR(I EQ 15)OR(I EQ 16)LET M1=2 IF(I EQ 17)OR(I EQ 25)LET M1=2 IF(J EQ 4)OR(J EQ 5)OR(J EQ 6)OR(J EQ 7)OR(J EQ 15)OR(J EQ 16)LET M2=2 IF(J EQ 17)OR(J EQ 25)LET M2=2 LET I=0 IF(M1 EQ 1)AND(M2 EQ 1)LOAD GSOXM2 1,E1,E2,I,STKPT,ER IF(M1 EQ 1)AND(M2 EQ 2)LOAD GSOXMB 1,E1,E2,I,STKPT,ER IF(M1 EQ 2)AND(M2 EQ 1)LOAD GSOXMB 1,E2,E1,I,STKPT,ER IF(TYPP(E1)EQ 1)AND(M2 EQ 1)LOAD GSOPOM 1,E1,E2,I,STKPT,ER IF(TYPP(E1)EQ 1)AND(M2 EQ 2)LOAD GSOPOB 1,E1,E2,I,STKPT,ER IF(TYPP(E2)EQ 1)AND(M1 EQ 1)LOAD GSOPOM 1,E2,E1,I,STKPT,ER IF(TYPP(E2)EQ 1)AND(M1 EQ 2)LOAD GSOPOB 1,E2,E1,I,STKPT,ER BLOCKIF(I EQ 0)OR(ER NE 0)THEN BLOCKIF(M1*M2 GT 0)THEN BLOCKIF(M1 EQ 1)AND(M2 EQ 1)THEN LOAD GSOICC 1,E1,E2,DEV,PT,PTX,ER ELSE IF(TYPP(E1)EQ 6)LOAD GIRBAS 1,E1,E1,J,ER IF(TYPP(E2)EQ 6)LOAD GIRBAS 1,E2,E2,J,ER LOAD GSOIPP 1,E1,E2,DEV,PT,PTX,ER ENDIF BLOCKIF(KODE EQ IND)THEN ERASE LN,PTX BLOCKIF(ER EQ 0)AND(PT NE NULL)THEN LOAD GUSPUS STKPT,PT,I,ER MSGCNTL 'POINT PROJECTED' ENDIF ELSE BLOCKIF(ER EQ 0)THEN MSGCNTL 'NEAREST PT CREATED, '// % 'MIN DIST '//CHCONV(DEV) MSG 'YES:CONTINUE, NO:REMOVE NEAREST PT '//CEMA NO,YES IF(KODE EQ NO)ERASE PT,PTX ELSE MSGCNTL 'NO POINT(S) CREATED' ENDIF ENDIF ELSE BEEP IF(KODE EQ IND)MSGCNTL 'NO PROJECTION' IF(KODE NE IND)MSGCNTL 'NO POINT(S) CREATED' ENDIF ELSE IF(KODE EQ IND)ERASE LN MSGCNTL 'POINT(S) CREATED' ENDIF BRANCH AGAIN LABEL EOE NOHIGHLT E1 END