1 : C SAIS SOURCE CHAT 11/05/27 21:15:28 6984 2 : C Saisie interactive d'un objet 3 : C 4 : SUBROUTINE SAIS 5 : IMPLICIT INTEGER(I-N) 6 : IMPLICIT REAL*8 (A-H,O-Z) 7 : -INC CCOPTIO 8 : -INC SMTEXTE 9 : character*8 LEGEND(1),type 10 : character*45 text 11 : character*80 chaine 12 : LEGEND(1)=' Ok ' 12 : call lircha(chaine,1,iretou) 12 : call lircha(type,1,iretou) 13 : if (ierr.ne.0) return 14 : ncou=16 14 : CALL TRINIT(25,DIOCAD,DIOCAD,TITREE,0.15,.TRUE.,ncou) 15 : 400 CONTINUE 15 : CALL MENU(LEGEND,2,8) 16 : text=' ' 16 : call trget(chaine,text) 17 : if( text(1:1) .ne. '''') then 18 : segini mtexte 19 : mtext=text 20 : ncart=45 20 : call ecrobj('TEXTE',mtexte) 20 : call lirobj(type,iobj,0,iretou) 21 : segsup mtexte 22 : if (iretou.ne.0) goto 500 22 : call razpil 23 : goto 400 24 : else 25 : if( type.eq.'MOT ') then 26 : do ifi=45,1,-1 27 : if(text(ifi:ifi).ne.' ') go to 401 28 : enddo 29 : 401 continue 30 : ifi = ifi-1 31 : do ide=2,45 32 : if(text(ide:ide).ne.' ') go to 402 33 : enddo 34 : 402 continue 35 : if(ide.gt.ifi) then 35 : call razpil 36 : go to 400 37 : endif 37 : call ecrcha(text(ide:ifi)) 37 : call ecrcha('MOT' ) 38 : go to 500 39 : else 39 : call razpil 40 : go to 400 41 : endif 42 : endif 43 : 500 CONTINUE 43 : call refus 44 : END 45 : 46 : 47 : 48 : 49 : 50 : 51 : 52 : 53 :
© Cast3M 2003 - All rights reserved.
Disclaimer