* Create draft text with point coord, (C) EMA 1997-2000    LM:28.11.2000
* 28.11.2000 radius of holes
* 20.11.2000 size of text
INTERNAL 
  INTEGER ER,I,J,N,SJU,IPOSDF(2)INIT 1 1,SIDE,IPAGRA(2)INIT 1,IS INIT 1,
  %       IDIRDF(3) INIT 1 3 1,ITXTDF(4) INIT 0 0 1 1,COL(3) INIT 3*1,
  %       N2(2),EDGE
  CHAR*16 FR INIT 'FRM_RECT',GR INIT 'EUDT_VCF'
  CHAR*35 CEMA INIT ' POINT COORDINATES, (C) Ema 2000,V3',CHAR,RADIUS
  UNDEFLM POINT,SPT,TEXT,BPLN,WSP,ELM,VI,P2(2),P1(10),P(10),PLN,CRV,CIR
  PTD     PTD
  REAL    XM(15)FORMAT 5/3,POSPT(2),PARGRA(6)INIT 3.5 1.75,R FORMAT 4/2,
  %       THK(3)INIT .35 .18 .18,UHA,PAR(2),VEC(3,7),VAL(5),U,V,
  %       DEV FORMAT 4/3,SIZE(6) FORMAT 2/1 INIT 0 3.5 5 7.5 10 20
EXTERNAL 
  TXTD    COORD
PROC 
LABEL AGAIN
  LET RADIUS='                                   '
  LET R=0
  BLOCKIF(IS EQ 1)THEN
    MENU 'H = DEF'
  ELSE
    MENU 'H = '//CHCONV(SIZE(IS))
    LET PARGRA(1)=SIZE(IS)
    LET PARGRA(2)=SIZE(IS)/2
  ENDIF
  NOHIGHLT ELM
  SELECT 'SEL PT/CRV/FAC, MENU, YES:END      '//CEMA ELM,YES,MENU
  BLOCKIF(KODE EQ MENU)THEN
    LET IS=IS+1
    IF(IS GT 6)LET IS=1
    BRANCH AGAIN
  ENDIF
  MENU
  HIGHLT ELM
  LET SIDE=5
  IF(KODE EQ YES)THEN EOE
  BLOCKIF(TYPP(ELM)EQ 3)THEN
    LOAD GSDICV 1,ELM,N,N2,PAR,N,R,I,DEV,DEV,ER
    LET PAR(1)=PAR(1)+.01
    LET PAR(2)=PAR(2)-.01
    LOAD GSOIMP 1,ELM,N2(1),PAR(1),1,VEC,VAL,ER
    LOAD GIWPT 1,VEC,P2(1),ER
    LOAD GSOIMP 1,ELM,N2(2),PAR(2),1,VEC,VAL,ER
    LOAD GIWPT 1,VEC,P2(2),ER
    LOAD GSOOOC 1,ELM,P2(1),P2(2),0.0,10,P1,ER
    ERASE CRV,P2(1),P2(2)
    LOAD GSPAPT 1,10,P1,PLN,DEV,ER
    LET I=1
    DO
      LOAD GSOPOP 1,P1(I),PLN,P(I),U,V,ER
      ERASE P1(I)
      LET I=I+1
    WHILE(I LE 10)
    LOAD GCWCI3 1,P(1),P(4),P(7),0,CIR,ER
    ERASE P(1),P(2),P(3),P(4),P(5),P(6),P(7),P(8),P(9),P(10)
    LOAD GICPIC 1,CIR,0,ER
    LOAD GIRMAT 1,CIR,N,XM,ER
    LOAD GSOIE3 1,ELM,CIR,DEV,P(1),P(2),ER
    ERASE P(1),P(2)
    LET XM(1)=XM(10)
    LET XM(2)=XM(11)
    LET XM(3)=XM(12)
    LET R=XM(13)
    BLOCKIF (R EQ 0) THEN
      BEEP
      MSGCNTL 'INFINITE RADIUS'
      BRANCH AGAIN
    ELSE
      LOAD GIWPT 1,XM,POINT,ER
      LET RADIUS='  RADIUS='//CHCONV(R)//', DEV='//CHCONV(DEV)
    ENDIF
    BRANCH GO
  ENDIF
  BLOCKIF(TYPP(ELM)EQ 6)THEN
    LOAD GIDELT 1,0,ER
    LOAD GICTMM 1,ER
    LET I=0
    DO
      LOAD GISLIM 1,ELM,I,EDGE,N,ER
      LET I=EDGE
      BLOCKIF(N EQ 0)THEN
        LOAD GSCTED 1,EDGE,CRV,J,ER
        BLOCKIF(J EQ 1)THEN
          LOAD GICSHO 1,CRV,1,ER
          LOAD GICPIC 1,CRV,1,ER
        ENDIF
        LOAD GICCOL 1,CRV,1,ER
      ENDIF
    WHILE(N EQ 0)
    LOAD GICTMM 0,ER
    MSGCNTL 'BOUNDARY CREATED'
    BRANCH AGAIN
  ENDIF
  LET POINT=ELM
  BLOCKIF(TYPP(POINT)EQ 80)THEN
    LOAD GSO3PT 1,POINT,SPT,ER
    LOAD GIRMAT 1,SPT,I,XM,ER
    LOAD GIRSBW 1,POINT,WSP,I,J,BPLN,ER
    LOAD GICBPL 1,BPLN,ER
  ELSE
    LOAD GIRMAT 1,POINT,I,XM,ER
*    LOAD GIRCUR 1,WSP,I,J,BPLN,VI,N,ER
  ENDIF
LABEL GO
  BLOCKIF(TYPP(POINT)EQ 80)OR(TYPP(POINT)EQ 1)THEN
    BLOCKIF(TYPP(POINT)EQ 1)THEN
  MSGCNTL 'PT: '//CHCONV(XM(1))//' '//CHCONV(XM(2))//' '//CHCONV(XM(3))
  %             //RADIUS
    ELSE
  MSGCNTL 'PTD:'//CHCONV(XM(1))//' '//CHCONV(XM(2))//' '//CHCONV(XM(3))
    ENDIF
    SELECT 'IND TEXT POSITION, YES:NEXT        '//CEMA PTD,YES
    NOHIGHLT ELM
    IF(KODE EQ YES)THEN EOE
    LOAD GIRMAT 1,PTD,I,POSPT,ER
    IF(KODE EQ IND) ERASE PTD
    LOAD GYRCPN 1,'SJUSTE  ',4,1,SJU,I,ER
    LOAD GYMCPN 1,'SJUSTE  ',4,1,1,ER
*    LOAD GYRCPN 1,'UHAULI  ',8,1,UHA,I,ER
    LOAD GYRCPN 1,'UPACLN  ',8,1,UHA,I,ER
    IF(IS GT 1)LOAD GYMCPN 1,'UPACLN  ',8,1,SIZE(IS),ER
    LET CHAR='X='//CHCONV(XM(1))
    LOAD GUMKHN 3,CHAR,35,CHAR,N,ER
    LET ITXTDF(3)=1
    LOAD GYCTTC 1,2,IDIRDF,0,0.0,IPOSDF,POSPT,0.0,0,N,CHAR,COORD,ER
    IF(IS NE 1)LOAD GYMAXD 
    %          1,COORD,ITXTDF,1,-1,GR,PARGRA,IPAGRA,1,FR,1,THK,COL,ER
    LET CHAR='Y='//CHCONV(XM(2))
    LOAD GYMAXC 1,COORD,ITXTDF,1,1,N,CHAR,ER
    LET ITXTDF(3)=2
    IF(IS NE 1)LOAD GYMAXD
    %          1,COORD,ITXTDF,1,-1,GR,PARGRA,IPAGRA,1,FR,1,THK,COL,ER
    LET CHAR='Z='//CHCONV(XM(3))
    LOAD GYMAXC 1,COORD,ITXTDF,1,1,N,CHAR,ER
    LET ITXTDF(3)=3
    IF(IS NE 1)LOAD GYMAXD
    %          1,COORD,ITXTDF,1,-1,GR,PARGRA,IPAGRA,1,FR,1,THK,COL,ER
    LOAD GYMAFS 1,COORD,ITXTDF,2,FR,1,.18,COL,ER
    LOAD GYATLP 1,COORD,2,POSPT,SIDE,2,1,POINT,ER
    BLOCKIF(R GT 0)THEN
      LET RADIUS=CHCONV(R)//'                                   '
      LOAD GUMKHN 3,RADIUS,35,RADIUS,N,ER
      LET  CHAR='R'//RADIUS(1:N)
      LET N=N+1
      LOAD GYMAXC 1,COORD,ITXTDF,1,1,N,CHAR,ER
      LET ITXTDF(3)=4
      IF(IS NE 1)LOAD GYMAXD
      %          1,COORD,ITXTDF,1,-1,GR,PARGRA,IPAGRA,1,FR,1,THK,COL,ER
      LOAD GYMAFS 1,COORD,ITXTDF,2,FR,1,.18,COL,ER
    ENDIF
    LOAD GYMCPN 1,'SJUSTE  ',4,1,SJU,ER
    LOAD GYMCPN 1,'UPACLN  ',8,1,UHA,ER
    MSGCNTL 'TEXT CREATED'
    DO
      SELECT 'IND POSITION, SEL TEXT, YES:NEXT   '//CEMA TEXT,PTD,YES,NO
      BLOCKIF(IRET EQ 2)THEN
        LOAD GIRMAT 1,PTD,I,POSPT,ER
        IF(KODE EQ IND)ERASE PTD
        LOAD GYMTPO 1,COORD,1,POSPT,ER
        MSGCNTL 'TEXT MOVED'
      ENDIF
      BLOCKIF(IRET EQ 1)AND(TEXT EQ COORD)THEN
        BLOCKIF(SIDE EQ 5)THEN
          LET SIDE=7 
        ELSE
          LET SIDE=5
        ENDIF
        LOAD GYDTLP 1,COORD,1,POSPT,ER
        LOAD GYATLP 1,COORD,2,POSPT,SIDE,2,1,POINT,ER
        MSGCNTL 'LEADER SWAPED'
      ENDIF
      BLOCKIF(KODE EQ NO)THEN
        ERASE COORD
        NOHIGHLT ELM
        MSGCNTL 'TEXT DELETED'
      ENDIF
    WHILE(KODE NE YES)AND(KODE NE NO)
    BRANCH AGAIN
  ENDIF
  NOHIGHLT ELM
  BEEP
  MSGCNTL 'INVALID ELEMENT'
  BRANCH AGAIN
LABEL EOE
  LOAD GIDELT 1,0,ER
  NOHIGHLT ELM
  MSGCNTL 'EXIT'
END