* Select subroutine - multisel, (C) EMA 1997-1999          LM:13.08.1999
* syntax EXEC EMASEL1 STRING,CEMA,ERRMSG,STK,N,ER
INTERNAL
  INTEGER I,J,K,END,SET,JP,JB,JT,JL,TYP,COL,LAY FORMAT 3,MOD,MAT(6),
  %       STKTRP,STKPT,STK1,NPT,NUM
  REAL    TAB(2,99),X(4),Y(5),THICK,CENT(3),SCALE,R
  UNDEFLM ELM,PT,PLN,FAC,E(99),L1(99),LX,SHAP,VI,BPLN,WSP,AXS
  CHAR*35 MSG2 INIT 'SEL ELM // YES:END SEL             '
  CHAR*35 MSG3 INIT 'IND PT // YES:END OF TRP // NO:EXIT'
  CHAR*35 MSG4 INIT 'YES:ACCEPT TRP SELECTION // NO:EXIT'
  CHAR*35 CHAR,FNTNAM,TEST,VU
  LN      L(99)
  PT      P(99)
  PTD     PD(99)
EXTERNAL
  CHAR*35 STRING,CEMA,ERRMSG
  INTEGER STK,N,ER INIT 0
PROC
  LOAD GUEACT 0,ER
  LET ERRMSG='                                   '
  LOAD GUSINI 4,STK,ER
  LOAD GUSEMP STK,ER
  LOAD GUMKHN 1,CEMA,35,TEST,N,ER
  IF(N EQ 0)LET CEMA='Multisel subroutine,(C) Ema 1998,V2'
  LET STRING=CHUPC(STRING)
  LOAD GUMKHN 3,STRING,35,STRING,N,ER
  BLOCKIF(STRING(1:4) EQ '*SEL')THEN 
    DO
      MSGCNTL 'INDIVIDUAL SELECTION'
      SELECT MSG2//CEMA ELM,YES
      IF(KODE NE YES)LOAD GUSPUS STK,ELM,N,ER
      IF(KODE NE YES)LOAD GIIHLT 1,ELM,1,ER
      MSGCNTL 'ELEMENT SELECTED'
    WHILE(KODE NE YES)
    LET I=0
    DO
      LET I=I+1
      LOAD GUSREA STK,I,ELM,ER
      LOAD GIIHLT 1,ELM,0,ER
    WHILE(I LT N)
    BRANCH EOE
  ENDIF
  BLOCKIF((STRING(1:4) EQ '*COL')AND(N EQ 4)) THEN
    MSGCNTL 'SELECTION BY COLOR'
    SELECT MSG2//CEMA ELM,YES
    LET ER=2
    IF(KODE EQ YES)THEN EOE
    LOAD GIRVIS 1,ELM,SET,JP,COL,JB,JT,JL,ER
    IF(COL EQ 0) LOAD GIRLAY 1,ELM,LAY,ER
    IF(COL EQ 0) LOAD GIRMCO 1,LAY,2,COL,ER
    LET LAY=COL
    LET STRING='*COL'//CHCONV(LAY)
  ENDIF
  BLOCKIF((STRING(1:4) EQ '*LAY')AND(N EQ 4)) THEN
    MSGCNTL 'SELECTION BY LAYER'
    SELECT MSG2//CEMA ELM,YES
    LET ER=2
    IF(KODE EQ YES)THEN EOE
    LOAD GIRLAY 1,ELM,LAY,ER
    LET STRING='*LAY'//CHCONV(LAY) 
  ENDIF
  BLOCKIF((STRING(1:3) EQ '*VU')AND(N EQ 3)) THEN
    MSGCNTL 'SELECTION BY VIEW'
    SELECT MSG2//CEMA ELM,YES
    LET ER=2
    IF(KODE EQ YES)THEN EOE
LOAD GIRSBW 1,ELM,WSP,J,K,BPLN,ER
LOAD GICBPL 1,BPLN,ER
LOAD GIRCUR 1,WSP,J,K,BPLN,VI,K,ER
LOAD GIRVIE 1,VI,J,J,J,BPLN,AXS,SCALE,J,R,R,R,J,ER
LOAD GIRIDE 1,VI,N,VU,ER
    LET STRING=VU(1:N)
  ENDIF
  BLOCKIF((STRING(1:4) EQ '*TYP')AND(N EQ 4)) THEN
    MSGCNTL 'SELECTION BY TYP'                      
    SELECT MSG2//CEMA ELM,YES
    LET ER=2
    IF(KODE EQ YES)THEN EOE
    IF(TYPP(ELM)EQ  1)LET STRING='*PT'
    IF(TYPP(ELM)EQ  2)LET STRING='*LN'
    IF(TYPP(ELM)EQ  3)LET STRING='*CRV'
    IF(TYPP(ELM)EQ  4)LET STRING='*PLN'
    IF(TYPP(ELM)EQ  5)LET STRING='*SUR'
    IF(TYPP(ELM)EQ  6)LET STRING='*FAC'
    IF(TYPP(ELM)EQ  7)LET STRING='*VOL'
    IF(TYPP(ELM)EQ  8)LET STRING='*AXS'
    IF(TYPP(ELM)EQ  9)LET STRING='*TRA'
    IF(TYPP(ELM)EQ 13)LET STRING='*SKI'
    IF(TYPP(ELM)EQ 14)LET STRING='*CST'
    IF(TYPP(ELM)EQ 15)LET STRING='*CST'
    IF(TYPP(ELM)EQ 16)LET STRING='*SOL'
    IF(TYPP(ELM)EQ 17)LET STRING='*SOL'
    IF(TYPP(ELM)EQ 24)LET STRING='*CCV'
    IF(TYPP(ELM)EQ 25)LET STRING='*NET'
    LOAD GUMKHN 3,STRING,35,STRING,N,ER 
    BLOCKIF(N EQ 0)THEN
      BEEP
      LET ERRMSG="ELEMENT TYPE DON'T RECOGNICED"
    ENDIF
  ENDIF
  BLOCKIF((STRING(1:4) EQ '*SEQ')AND(N EQ 4)) THEN
    BEEP
    LET ERRMSG='*SEQ NOT ALLOWED'
  ENDIF
  BLOCKIF((STRING(1:4) EQ '*SET')AND(N EQ 4)) THEN
    MSGCNTL 'SELECTION BY SET'
    SELECT MSG2//CEMA ELM,YES
    LET ER=2
    IF(KODE EQ YES)THEN EOE
    LOAD GIRSBW 1,ELM,I,J,SET,K,ER
    LOAD GIRIDE 1,SET,N,STRING,ER
  ENDIF
  BLOCKIF((STRING(1:4) EQ '*THK')AND(N EQ 4)) THEN
    MSGCNTL 'SELECTION BY THICKNES'
    SELECT MSG2//CEMA ELM,YES
    LET ER=2
    IF(KODE EQ YES)THEN EOE
    LOAD GIRVIS 1,ELM,SET,JP,COL,JB,JT,JL,ER
    LET LAY=JT
    LET STRING='*THK'//CHCONV(LAY)
  ENDIF
  BLOCKIF((STRING(1:4) EQ '*LNT')AND(N EQ 4)) THEN
    MSGCNTL 'SELECTION BY LINE TYPE'
    SELECT MSG2//CEMA ELM,YES
    LET ER=2
    IF(KODE EQ YES)THEN EOE
    LET TYP=TYPP(ELM)
    IF(TYP EQ 1)LET ER=3
    IF(TYP GE 4)AND(TYP LE 7)LET ER=3
    IF(TYP GE 9)AND(TYP LE 19)LET ER=3
    IF(TYP GE 25)AND(TYP LE 66)LET ER=3
    IF(TYP EQ 80)LET ER=3
    IF(TYP EQ 84)LET ER=3
    IF(TYP EQ 85)LET ER=3
    IF(TYP GE 93)LET ER=3
    IF(ER NE 3)LOAD GIRVIS 1,ELM,SET,JP,COL,JB,JT,JL,ER
    LET LAY=JL
    IF(ER EQ 0)LET STRING='*LNT'//CHCONV(LAY)
    IF(ER EQ 3)LET ERRMSG='ONLY MONOPARAM.ELM ALLOWED'
  ENDIF
*********************************************TRP*TRP*TRP************
BLOCKIF((STRING(1:4) EQ '*TRP')AND(N EQ 4)) THEN
  MSGCNTL 'SELECTION BY TRAP'
  LOAD GIRMOD 1,MOD,ER
  IF(MOD EQ 1)LET ERRMSG='FULL DRAW MODE NOT READY,10.10.98'
  IF(MOD EQ 2)LET ERRMSG='2D SPACE MODE NOT SUPPORTED'
**************************************MOD 2D AND 3D SPACE***********
  BLOCKIF(MOD EQ 3)THEN
    LOAD GUMSEL 1,4,'*SPC',1,1,1,1,STK1,ER
************************************FOR EMAC1B**********************
****LOAD GUMSEL 1,9,'*SUR+*FAC',2,1,1,1,STK1,ER*********************
********************************************************************
    IF(ER NE 0)THEN EOE
    LOAD GUMSEL 1,9,'*SPC-*AXS',1,1,1,1,STKTRP,ER
    LET END=0
    DO
      LOAD GUSPOP STKTRP,ELM,END,ER
      LOAD GICTEM ER
      LOAD GSOIET 1,ELM,0,NPT,STKPT,ER
      LOAD GUSPOP STKPT,ELM,NPT,ER
      LOAD GIRMAT 1,ELM,I,X,ER
      LET CENT(1)=CENT(1)+X(1)
      LET CENT(2)=CENT(2)+X(2)
      LET CENT(3)=CENT(3)+X(3)
      LET NUM=NUM+1
    WHILE(END EQ 0)
    LOAD GIDELT 1,0,ER
    LET CENT(1)=CENT(1)/NUM
    LET CENT(2)=CENT(2)/NUM
    LET CENT(3)=CENT(3)/NUM
    LOAD GICTEM ER
    LOAD GIWPT 1,CENT,PT,ER
    LOAD GICSHO 1,PT,0,ER
    LET I=1
    DO
      LOAD GICTEM ER
      IF(MOD EQ 2)SELECT MSG3//CEMA P(I),YES,NO
      IF(MOD EQ 3)SELECT MSG3//CEMA L(I),YES,NO
      BLOCKIF(KODE EQ NO)THEN
        LOAD GIDELT 1,0,ER
        LET ERRMSG='TEMPORARY ELEMENTS DELETED'
        LET ER=1
        BRANCH EOE
      ENDIF
      BLOCKIF(KODE EQ YES)THEN
        LET N=I-1
        BLOCKIF(N GT 2)THEN
          LET L1(N)=LX
          LOAD GICTMM 0,ER
          LOAD GCWPL3 1,P(1),P(2),P(3),PLN,ER
          LOAD GICSHO 1,PLN,0,ER
          LET I=1
          DO
            LOAD GSLPLP 1,L1(I),PLN,L(I),J,ER
            LOAD GICSHO 1,L(I),0,ER
            LOAD GISEDG 1,L(I),0,E(I),J,END,ER
            LET I=I+1
          WHILE(I LE N)
          LOAD GCWFAC 1,1,N,E,FAC,ER
          LOAD GICSHO 1,FAC,0,ER
          LOAD GUSINI 4,STK,ER
          LOAD GUSEMP STK,ER
          LOAD GICTMM 1,ER
          LET END=0
          DO
            LOAD GUSPOP STK1,ELM,END,ER
            BLOCKIF(END EQ 0)THEN
              BLOCKIF(TYPP(ELM)EQ 1)THEN
                LOAD GSOPOB 1,ELM,FAC,N,STKPT,ER
                IF(N GT 0)LOAD GUSPUS STK,ELM,N,ER
                IF(N GT 0)LOAD GIIHLT 1,ELM,1,ER
              ELSE
                LOAD GCWBOX 1,ELM,1,X,Y,ER
                LOAD GIWPT 1,X,P(1),ER
                LOAD GSOPOB 1,P(1),FAC,N,STKPT,ER
                IF(N GT 0)THEN PRJOK
                LOAD GIWPT 1,Y,P(1),ER
                LOAD GSOPOB 1,P(1),FAC,N,STKPT,ER
                IF(N GT 0)THEN PRJOK
                LET X(1)=(X(1)+Y(1))/2
                LET X(2)=(X(2)+Y(2))/2
                LET X(3)=(X(3)+Y(3))/2
                LOAD GIWPT 1,X,P(1),ER
                LOAD GSOPOB 1,P(1),FAC,N,STKPT,ER
                BLOCKIF(N GT 0)THEN
LABEL PRJOK
                  LOAD GUSPUS STK,ELM,N,ER
                  LOAD GIIHLT 1,ELM,1,ER
                ENDIF
              ENDIF
              LOAD GIDELT 1,0,ER 
            ENDIF
          WHILE(END EQ 0)
          LOAD GICTMM 0,ER
          LOAD GUSINF STK,I,N,ER
          IF(N EQ 0)THEN EOE
          MSGCNTL 'TRAP CLOSED'
          MSG MSG4//CEMA YES,NO
          LET I=0
          DO
            LET I=I+1
            LOAD GUSREA STK,I,ELM,ER
            LOAD GIIHLT 1,ELM,0,ER
          WHILE(I LT N)
          ERASE FAC,PLN
          LET I=1
          DO
            ERASE L(I),E(I)
            LET I=I+1                                       
          WHILE(I LE N)AND(I LE 99)
          IF(KODE EQ NO)LOAD GUSEMP STK,ER
        ELSE
          BEEP
          LET ERRMSG='CAN NOT CLOSE TRAP                 '
          LET ER=1
        ENDIF
        LOAD GIDELT 1,0,ER
        BRANCH EOE
      ENDIF
      LET J=I-1 
      LOAD GICTMM 1,ER
      IF(MOD EQ 3)LOAD GSOPOL 1,PT,L(I),P(I),ER
      HIGHLT P(I)
      IF(I GT 1)LOAD GICSHO 1,P(J),0,ER
      IF(I GT 1)LOAD GICSHO 1,P(I),0,ER
      IF(I GT 1)LOAD GSLCOO 1,P(I),1,P(J),1,L1(J),ER
      IF(I GT 2)ERASE LX  
      IF(I GT 2)LOAD GSLCOO 1,P(I),1,P(1),1,LX,ER
      IF(I GT 1)HIGHLT L1(J)
      IF(I GT 2)HIGHLT LX
      MSGCNTL 'OPEN TRAP'
      LOAD GICTMM 0,ER
      LET I=I+1
    WHILE(KODE NE YES)
  ENDIF
**********************************************MOD DRAW**************
  BLOCKIF(MOD EQ 1)THEN
    LOAD GUMSEL 1,4,'*DRW',1,1,1,1,STK1,ER
    IF(ER NE 0)THEN EOE
    LOAD GICTMM 1,ER
    LET I=1
    DO
      SELECT MSG3//CEMA PD(I),YES,NO
      BLOCKIF(KODE EQ NO)THEN
        LOAD GIDELT 1,0,ER
        LET ERRMSG='TEMPORARY ELEMENTS DELETED'
        LET ER=1
        BRANCH EOE
      ENDIF
      BLOCKIF(KODE EQ YES)THEN
        LET N=I-1
        BLOCKIF(N GT 2)THEN
          LOAD GIDELT 1,0,ER
          LOAD GIDSHA 1,0,1,N,TAB,SHAP,ER
          DO
            LOAD GUSPOP STK1,ELM,END,ER
            BLOCKIF(END EQ 0)THEN
              LET TYP=TYPP(ELM)
              IF(TYP EQ 80)LET PT=ELM
              BLOCKIF(TYP EQ 81)THEN
                LOAD GDOILL 1,ELM,J,PD(1),K,PD(2),ER
                LOAD GIRMAT 1,PD(1),K,X,ER
                LOAD GIRMAT 1,PD(2),K,Y,ER
                LET X(1)=(X(1)+Y(1))/2
                LET X(2)=(X(2)+Y(2))/2
                LOAD GIDPT 1,X,PT,ER
                ERASE PD(1),PD(2)
              ENDIF
              BLOCKIF(TYP EQ 82)OR((TYP GE 86)AND(TYP LE 88))THEN
                LOAD GIRMAT 1,ELM,K,X,ER
                LOAD GIDPT 1,X,PT,ER
              ENDIF
              BLOCKIF(TYP EQ 100)THEN
                LOAD GIRMAT 1,ELM,K,X,ER
                LOAD GIDPT 1,X,PT,ER
              ENDIF
              BLOCKIF(TYP EQ 89)THEN
                LOAD GDOICL 1,ELM,PD(1),PD(2),ER
                LOAD GIRMAT 1,PD(1),K,X,ER
                LOAD GIRMAT 1,PD(2),K,Y,ER
                LET X(1)=(X(1)+Y(1))/2
                LET X(2)=(X(2)+Y(2))/2
                LOAD GIDPT 1,X,PT,ER
                ERASE PD(1),PD(2)
              ENDIF
*              BLOCKIF(TYP EQ 98)AND(TYPS(ELM)EQ 1)THEN
*                LOAD GYGAXG 1,ELM,1,JP,JB,CHAR,FNTNAM,JT,X,Y, 
*                %           MAT,THICK,COL,JL,ER
*                LOAD GIDPT 1,X,PT,ER
*              ENDIF
              LET N=0
              IF(PT NE NULL)LOAD GCDIOS 1,PT,SHAP,N,X,ER
              IF(TYPP(ELM)NE 80)ERASE PT
              BLOCKIF(N EQ 1)THEN
                LOAD GUSPUS STK,ELM,N,ER
                LOAD GIIHLT 1,ELM,1,ER
              ENDIF
            ENDIF
          WHILE(END EQ 0)
          ERASE SHAP
          LOAD GUSINF STK,I,N,ER
          IF(N EQ 0)THEN EOE
          MSGCNTL 'TRAP CLOSED'
          MSG MSG4//CEMA YES,NO
          LET I=0
          DO
            LET I=I+1
            LOAD GUSREA STK,I,ELM,ER
            LOAD GIIHLT 1,ELM,0,ER
          WHILE(I LT N)
          IF(KODE EQ NO)LOAD GUSEMP STK,ER
        ELSE
          BEEP
          LET ERRMSG='CAN NOT CLOSE TRAP                 '
          LET ER=1
        ENDIF
        LOAD GIDELT 1,0,ER
        BRANCH EOE
      ENDIF
      LET J=I-1
      LOAD GIRMAT 1,PD(I),K,X,ER
      LET TAB(1,I)=X(1)
      LET TAB(2,I)=X(2)
      BLOCKIF(I GT 1)THEN
        LOAD GIRMAT 1,PD(J),K,Y,ER
        LOAD GICSHO 1,PD(J),0,ER
        LOAD GICSHO 1,PD(I),0,ER
        LOAD GCDLN  1,X,1,Y,1,L1(J),ER
        HIGHLT L1(J)
      ENDIF
      BLOCKIF(I GT 2)THEN
        ERASE LX
        LOAD GIRMAT 1,PD(1),K,Y,ER
        LOAD GCDLN  1,X,1,Y,1,LX,ER
        HIGHLT LX
        MSGCNTL 'OPEN TRAP'
      ENDIF
      LET I=I+1
    WHILE(KODE NE YES)
    LOAD GICTMM 0,ER
  ENDIF
ENDIF
********************************************************************
  LOAD GUMKHN 3,STRING,35,STRING,N,ER
  LOAD GUMSEL 1,N,STRING,2,1,1,1,STK,ER
LABEL EOE
  IF(ER EQ 0)LOAD GUSINF STK,I,N,ER
  BLOCKIF((N EQ 0)OR(ER NE 0)OR(STK EQ 0))THEN
    LET ER=1
    BLOCKIF(ERRMSG EQ '                                   ')THEN
      LET ERRMSG='EMPTY BATCH                        '
    ENDIF
  ELSE
    LET ER=0
  ENDIF
END