Télécharger ktrini.eso

Retour à la liste

Numérotation des lignes :

  1. C KTRINI SOURCE BP208322 16/11/18 21:18:34 9177
  2. SUBROUTINE KTRINI(NOL,AXAX,AYAY,TITRE,HAUTT,VALEU,NCOUMA)
  3. C
  4. C INITIALISATION D'UN TRACE
  5. C 1 TATB 2 TEKTRO 3 GDDM (3179 G )
  6. C 4 GKS 5 GDDM (FICHIER GDF)
  7. C
  8. C ATTENTION AVEC LE GKS IBM IL PEUT Y AVOIR UN PROBLEME EN CAS
  9. C D'UNDERFLOW QUI NE SONT PAS ACTUELLEMENT MASQUES PAR GKS
  10. C ET PROVOQUE DES ARITHMETICS ERRORS
  11. C
  12. C INITIALISATION D'UN TRACE
  13. C NOL : NON UTILISE
  14. C AX ,AYAX : DIMENSION POUR LA FEUILLE DE PAPIER
  15. C TITRE : TITRE (CHAINE DE CARACTERES)
  16. C HAUT : HAUTEUR DES CARACTERES
  17. C VALEUR : ECRAN OU ECRAN PLUS MARGE
  18. C NCOUMA : NOMBRE DE COULEUR DU TERMINAL
  19. C ICCOL : INDICE COULEUR COURANTE
  20. C ICOISO :
  21. C
  22. IMPLICIT INTEGER(I-N)
  23. external long
  24. SAVE IWKIDLI,KMETA,WKTY,INWISS,INMETA,FENE
  25. SAVE ICCOL,ICOISI,WKID,X1,X2,Y1,Y2,WRATIO,INUSEG
  26. SAVE XINID,YINID,IDSG,SXMIN,SXXAX,SYMIN,SYYAX,RX,RY,AX,AY
  27. SAVE TEXTX,TEXTY,INCOOR,TEXTE,ICCLE,IACT,IDWISS,IWISS,VALEUR
  28. SAVE NHAUT,HAUT
  29. SAVE IPF
  30. DIMENSION IPF(24)
  31. CHARACTER*(*) TITRE
  32. DIMENSION XTR(*),YTR(*)
  33. DIMENSION RMAT(9)
  34. REAL SEGTM(2,3)
  35. CHARACTER*8 NAME
  36. CHARACTER*(*) CARACT
  37. LOGICAL VALEUR,FENET,VALEU,FENE
  38. CHARACTER*(*) LEGEND(*)
  39. C VALEURS POUR LES ENTRY
  40. CHARACTER*20 STRING
  41. DIMENSION SEGT(6),SEGMT(6),ROUT(6)
  42. C MEMOIRES DES POINTS COINS DES PAVES DE COULEUR DES MENUS
  43. DIMENSION PXA(4),PYA(4)
  44. C CORRESPONDING CERN COLOR INDICES - FOR CERN PURPOSE
  45. DIMENSION ICCC(10)
  46. C
  47. DIMENSION TEXTX(50),TEXTY(50)
  48. C VARIABLES CARACTERES POUR NOMMER LE FICHIER METAFILE
  49. CHARACTER*1 CARELE(10)
  50. CHARACTER*6 STR
  51. CHARACTER*4 STR1
  52. C
  53. CHARACTER*15 TEXTE(50)
  54. C
  55. C
  56. C ASF
  57. DIMENSION IASF(13)
  58. C INITIALISATION GKS (IDENTIFICATEUR, CONNECTION, TYPE)
  59. INTEGER WKID,WKCON,WKTY
  60. INTEGER STAT
  61. C
  62. *-INC CCOPTIO
  63. *-INC CCGEOME
  64. DATA ICCOUN/0/
  65. C DATA POUR LE NOM DU FICHIER METAFILE
  66. DATA CARELE /'0','1','2','3','4','5','6','7','8','9'/
  67. DATA STR1 /'META'/
  68. C DATA POUR LE TABLEAU DES COULEURS ICCC(K) POUR GKS
  69. DATA ICCC/4,2,6,3,7,5,1,8,9,10/
  70. C
  71. DATA WKID/3/
  72. DATA ICCOL/7/
  73. DATA IASF/1,1,1,1,1,1,1,1,1,1,1,1,1/
  74. DATA IDSG/0/
  75. DATA IACT/0/
  76. DATA IDWISS/2/
  77. DATA IWISS/0/
  78. C NB DE COULEUR SI PAS AUTRE INDICATION
  79. NCOUMA=7
  80. C SAUVER HAUT
  81. HAUT=HAUTT
  82. NHAUT=31
  83. C SAUVER VALEUR
  84. VALEUR=VALEU
  85. C O SEGMENT POUR COMMENCER
  86. KSEGN=0
  87. C INITIALISATION DE L'UNITE PHYSIQUE
  88. AX=AXAX
  89. AY=AYAY
  90. DO 1 NBCR=72,2,-1
  91. IF (TITRE(NBCR:NBCR).NE.' ') GOTO 2
  92. 1 CONTINUE
  93. 2 CONTINUE
  94. X1=0.
  95. X2=0.
  96. Y1=0.
  97. Y2=0.
  98. C POUR LA GESTION DES TEXTES
  99. INCOOR=0
  100. INUSEG=50+(100*(WKID-1))
  101. IXSEG=0
  102. ICCLE=0
  103. C
  104. C INITIALISATION GKS
  105. C CHANNEL 1 WORKSTATION 1 METAFILE
  106. C CHANNEL 2 WORKSTATION 2 WISS
  107. C CHANNEL 3 WORKSTATION 3,4,.. ECRAN
  108. C ATTENTION IL FAUT FERMER LA WORKSTATION
  109. C POUR REVENIR EN MODE ALPHA
  110. IF(IACT.EQ.1) THEN
  111. CALL GQOPS(ISTA)
  112. IF(ISTA.EQ.4) CALL GCLSG
  113. C INQUIRE SET MEMBER OF OPEN WORKSTATION
  114. NWAC=0
  115. 5002 CALL GQOPWK(NWAC,IERR,NTWAC,NWID)
  116. IF(NWID.EQ.WKID)GOTO 5001
  117. IF(NWAC.EQ.NTWAC)GOTO 5003
  118. NWAC=NWAC+1
  119. GOTO 5002
  120. 5001 CALL GQOPS(ISTA)
  121. IF (ISTA.EQ.3) CALL GDAWK(WKID)
  122. IF (ISTA.EQ.3.OR.ISTA.EQ.2) CALL GCLWK(WKID)
  123. C
  124. 5003 CALL GDAWK(IDWISS)
  125. CALL GCLWK(IDWISS)
  126. CALL GOPWK(IDWISS,2,INWISS)
  127. CALL GACWK(IDWISS)
  128. GOTO 5000
  129. ENDIF
  130. C
  131. C OUVERTURE GKS
  132. C FILE 22 ERROR FILE FOR GKS
  133. IF (WKID.EQ.3) CALL GOPKS(22,1)
  134. C
  135. C OUVERTURE WORKSTATIONS -> ECRAN, METAFILE
  136. C ECRAN -> IDENTIFICATEUR:1
  137. C CONNECTION :1
  138. C TYPE :4(SUN) 5001 (GKS GRAL IBM 3279)
  139. C ON NE GARDE QUE TROIS WORKSTATIONS SIMULTANEES (UNE SUR IBM)
  140. C ( CAS DU SUN)
  141. 5000 CONTINUE
  142. WKCON=3
  143. C LECTURE DE DIVERS PARAMETRES EN FILE 97 CASTEM2 GRAFPARM
  144. * OPEN (UNIT=97,FILE='GKS.DATA',FORM='FORMATTED')
  145. REWIND 97
  146. C LECTURE DU NOMBRE MAX DE WKID AUTORISE POUR LA VERSION DE GKS
  147. READ(97,*)IWKIDLI
  148. C PV UNE SEULE WKID => 3 MAXIMUM
  149. IWKIDLI=3
  150. C LECTURE DU COMPTEUR DE METAFILE
  151. READ (97,*)KMETA
  152. C LECTURE DU WORKSTATION-TYPE POUR L'ECRAN
  153. READ (97,*) WKTY
  154. C LECTURE DU WORKSTATION-TYPE POUR LA WISS
  155. READ(97,*) INWISS
  156. C LECTURE DU WORKSTATION-TYPE POUR LES METAFILES
  157. READ(97,*) INMETA
  158. C OUVERTURE ET ACTIVATION DE LA WISS
  159. IF(IWISS.EQ.0) THEN
  160. CALL GOPWK(IDWISS,2,INWISS)
  161. CALL GACWK(IDWISS)
  162. IWISS=1
  163. ENDIF
  164. C
  165. C OUVERTURE DE L'ECRAN
  166. CALL GOPWK(WKID,WKCON,WKTY)
  167. C
  168. C CHARGEMENT DES PATTERN
  169. C
  170. C INITIALISATION DE LA TABLE DES COULEURS
  171. C IND RED GREEN BLUE
  172. C NOIR 0 0.0 0.0 0.0
  173. C BLEU 4 0.0 0.0 1.0
  174. C ROUGE 2 1.0 0.0 0.0
  175. C ROSE 6 1.0 0.0 1.0
  176. C VERT 3 0.0 1.0 0.0
  177. C TURQUOI 7 0.0 1.0 1.0
  178. C JAUNE 5 1.0 1.0 0.0
  179. C BLANC 8 1.0 1.0 1.0
  180. C NOIR 1 0.0 0.0 0.0
  181. CALL GSCR(WKID,0,0.0,0.0,0.0)
  182. CALL GSCR(WKID,4,0.0,0.0,1.0)
  183. CALL GSCR(WKID,2,1.0,0.0,0.0)
  184. CALL GSCR(WKID,6,1.0,0.0,1.0)
  185. CALL GSCR(WKID,3,0.0,1.0,0.0)
  186. CALL GSCR(WKID,7,0.0,1.0,1.0)
  187. CALL GSCR(WKID,5,1.0,1.0,0.0)
  188. CALL GSCR(WKID,1,1.0,1.0,1.0)
  189. CALL GSCR(WKID,8,0.0,0.0,0.0)
  190. C ACTIVATION DE L'ECRAN
  191. CALL GACWK(WKID)
  192. IACT=1
  193. C
  194. C OUVERTURE SEGMENT 6
  195. ISEG=6+(100*(WKID-1))
  196. CALL GCRSG(ISEG)
  197. CALL GSVIS(ISEG,1)
  198. CALL GSDTEC(ISEG,0)
  199. C
  200. C DIMENSION DE L'ECRAN (RX,RY EN METRES, LX ET LY EN PIXELS)
  201. CALL GQDSP(WKTY,ERR,DC,RX,RY,LX,LY)
  202. C
  203. C METTRE LES ASF EN INDIVIDUAL
  204. CALL GSASF(IASF)
  205. C
  206. C MODE DE MISE A JOUR (MODE PAR DEFAUT)CD CEA.SUN
  207. C
  208. CALL GSDS(WKID,1,0)
  209. C
  210. C DEFINITION DE LA FENETRE DE LA WORKSTATION (ECRAN)
  211. WRATIO=RY/RX
  212. R=RY
  213. IF(WRATIO.GT.1)THEN
  214. R=RX
  215. WRATIO=1./WRATIO
  216. END IF
  217. CALL GSWKWN(WKID,0.,1.,0.,RY/RX)
  218. CALL GSWKVP(WKID,0.,RX,0.,RY)
  219. C EFFACEMENT DE LADITE
  220. CALL GSFAIS(1)
  221. CALL GSFACI(8)
  222. CALL GSWN(4,0.,1.,0.,1.)
  223. CALL GSVP(4,0.,1.,0.,(RY/RX))
  224. CALL GSELNT(4)
  225. PXA(1)=0
  226. PyA(1)=0
  227. PXA(2)=0
  228. PyA(2)=1
  229. PXA(3)=1
  230. PyA(3)=1
  231. PXA(4)=1
  232. PyA(4)=0
  233. CALL GFA(4,PXA,PYA)
  234. C
  235. C DEFINITION DE LA FENETRE ET CLOTURE DE LA DEUXIEME WORKSTATION (PLOTTE
  236. C
  237. C DEFINITION DE LA TRANSFORMATION DE NORMALISATION 1 POUR LE TITRE
  238. CALL GSWN(1,0.,80.,0.,2.)
  239. CALL GSVP(1,0.,1.,0.,(RY/RX)*0.1)
  240. CALL GSELNT(1)
  241. C
  242. C INITIALISATION DES ATTRIBUTS CARACTERES
  243. CALL GSCHH(1.0)
  244. CALL GSTXCI(ICCC(7))
  245. CALL GSTXFP(1,2)
  246. CALL GSCHXP(1.)
  247. CALL GSCHSP(0.1)
  248. C ECRITURE TITRE
  249. CALL GTX(68.,1.,'CASTEM 2000')
  250. CALL GTX(0.,1.,TITRE)
  251. C
  252. C FERMETURE SEGMENT
  253. CALL GCLSG
  254. C
  255. RETURN
  256. *
  257. ENTRY KDFENE(XMIN,XXAX,YMIN,YYAX,XR1,XR2,YR1,YR2,FENET)
  258. C
  259. C DEFINITION DE LA FENETRE UTILISATEUR
  260. C XMIN,X,X,YMIN,YYAX : COORDONNEES DE LA FENETRE UTILISATEUR
  261. C XR1,XR2,YR1,YR2 : COORDONNEES RETOURNEES
  262. C (EFFECTIVEMENT UTILISEES)
  263. C FENET : CALCUL DU RATIO (OUI OU NON) NON UTILISE
  264. C
  265. EC1=AX-3.
  266. EC2=AY-3.
  267. C DEFINITION UNITE UTILISATEUR FENETRE UTILISEE MARGES A RESPECTER
  268. C RETOUR X1 X2 Y1 Y2 FENETRE EFFECTIVEMENT UTILISEE ????
  269. C OUVERTURE SEGMENT
  270. C CALCUL DE LA FENETRE (XMIN,XXA,YMIN,YYA) -> DETERMINATION DE LA TRANSF
  271. C DE NORMALISATION 2
  272. C ON COMPLETE LA FENETRE UTILISATEUR POUR RENTRER DANS LA FENETRE REELL
  273. SXMIN=XMIN
  274. SXXAX=XXAX
  275. SYMIN=YMIN
  276. SYYAX=YYAX
  277. C MARGE POUR LES QUAL ET NUMERO DE NOEUDS OU ELEMENTS
  278. XDIFF=(XXAX-XMIN)/2.*1.10
  279. YDIFF=(YYAX-YMIN)/2.*1.10
  280. XMILL=(XXAX+XMIN)/2.
  281. YMILL=(YYAX+YMIN)/2.
  282. C NECESSAIRE POUR OPERATEUR DESSIN
  283. FENE=FENET
  284. IF (FENE) THEN
  285. RAP=(XDIFF/YDIFF)/(RX/RY)
  286. ELSE
  287. RAP=1.
  288. ENDIF
  289. IF (RAP.GE.1) THEN
  290. X1=XMILL-XDIFF
  291. X2=XMILL+XDIFF
  292. Y1=YMILL-(YDIFF*RAP)
  293. Y2=YMILL+(YDIFF*RAP)
  294. ELSE
  295. X1=XMILL-(XDIFF/RAP)
  296. X2=XMILL+(XDIFF/RAP)
  297. Y1=YMILL-YDIFF
  298. Y2=YMILL+YDIFF
  299. ENDIF
  300. IF(VALEUR) THEN
  301. C LA FENETRE EST XMIN,XXAX,YMIN,YYAX
  302. CALL GSWN(2,X1,X2,Y1,Y2)
  303. CALL GSVP(2,0.,0.8,(RY/RX)*0.1,(RY/RX)*0.9)
  304. ELSE
  305. C LA FENETRE EST RECALCULEE POUR GARDER LES BONS RAPPORTS
  306. CALL GSWN(2,X1,X2,Y1,Y2)
  307. CALL GSVP(2,0.,0.9,(RY/RX)*0.1,(RY/RX))
  308. ENDIF
  309. C
  310. CALL GSELNT(2)
  311. C
  312. C INITIALISATION DE LA POSITION DU LOCATOR
  313. XINID=(X1+X2)/2.
  314. YINID=(Y1+Y2)/2.
  315. C
  316. C INITIALISATION DES VALEURS RENDUES
  317. XR1=XMIN
  318. XR2=XXAX
  319. YR1=YMIN
  320. YR2=YYAX
  321. C
  322. C OUVERTURE SEGMENT 1
  323. C DEMANDE DU NOM DU SEGMENT OUVERT (FERMETURE)
  324. CALL GQOPS(ISTA)
  325. IF (ISTA.EQ.4) THEN
  326. CALL GQOPSG(IIERRI,INUM)
  327. CALL GCLSG
  328. CALL GDSG(INUM)
  329. ENDIF
  330. INUM=8+(100*(WKID-1))
  331. CALL GQSGUS(0,IERGK,NBSEG,ISEGNA)
  332. DO 4461 ISEG=1,NBSEG
  333. CALL GQSGUS(ISEG,IERGK,NBSE,ISEGNA)
  334. IF (ISEGNA.EQ.INUM) THEN
  335. CALL GDSG(INUM)
  336. GOTO 4462
  337. ENDIF
  338. 4461 CONTINUE
  339. 4462 CONTINUE
  340. ISEG=1+(100*(WKID-1))
  341. CALL GCRSG(ISEG)
  342. IXSEG=1
  343. C
  344. C ATTRIBUT VISIBILITE
  345. CALL GSVIS(ISEG,1)
  346. C DETECTABILITE
  347. CALL GSDTEC(ISEG,0)
  348. C
  349. C MODE VECTEUR (POUR LES CARACTERES)
  350. CALL GSTXFP(1,2)
  351. C
  352. C TAILLE DES CARACTERES PAR DEFAUT
  353. C DETERMINATION DE LA HAUTEUR DES CARACTERES, DE L'ESPACE ENTRE CARACTER
  354. CHH=(Y2-Y1)/50.0
  355. CALL GSCHH(CHH)
  356. CALL GQCHXP(INDERR,CHXPO)
  357. CHXP=(X2-X1)/(Y2-Y1)/RX*RY*CHXPO
  358. CALL GSCHXP(CHXP)
  359. CALL GSCHSP(0.1)
  360. C
  361. C
  362. C COULEUR COURANTE (ICCOL)
  363. CALL GSFACI(ICCC(ICCOL))
  364. CALL GSPLCI(ICCC(ICCOL))
  365. CALL GSPMCI(ICCC(ICCOL))
  366. CALL GSTXCI(ICCC(ICCOL))
  367. C
  368. C OVERPAINT
  369. C
  370. ICOISI=-100
  371. C
  372. RETURN
  373. C
  374. ENTRY KTRLAB(X,Y,CARACT,NCAR,HAUTT)
  375. C
  376. C ECRITURE D'UN TEXTE EN (X,Y)
  377. C X,Y : COORDONNEES DE L'ORIGINE DU TEXTE
  378. C CARACT : TEXTE
  379. C NCAR : NOMBRE DE CARACTERES A ECRIRE
  380. C HAUT :
  381. C
  382. HAUT=HAUTT
  383. DO 201 ICAR=NCAR,1,-1
  384. IF (CARACT(ICAR:ICAR).NE.' ') GOTO 202
  385. 201 CONTINUE
  386. C CHAINE VIDE
  387. RETURN
  388. 202 CONTINUE
  389. C ECRITURE TEXTE EN (X,Y)
  390. CALL GTX(X,Y,CARACT)
  391. RETURN
  392. C
  393. ENTRY KTRBOX (HAUTX,HAUTY)
  394. C CARACTERES EN MODE VECTEUR (STROKE)
  395. CALL GSTXFP(1,2)
  396. C INTERROGATION SUR LA TAILLE DE DEFAUT
  397. CALL GQCHH(ERR,CHH)
  398. CALL GQCHXP(INDERR,CHXP)
  399. C MISE A JOUR DE LA TAILLE
  400. * CALL GSCHH(CHH*HAUTX)
  401. * CALL GSCHXP(CHXP*HAUTY)
  402. * CALL GSCHSP(0.1)
  403. RETURN
  404. C
  405. ENTRY KCHCOU(JCOLO)
  406. C
  407. C CHANGEMENT COULEUR (8 DOIT CORRESPONDRE A L'EFFACEMENT)
  408. C JCOLO : INDICE DE LA NOUVELLE COULEUR
  409. C CHANGEMENT DE COULEUR (VOIR LA TABLE DES COULEUR)
  410. C
  411. CALL GSFACI(ICCC(JCOLO))
  412. CALL GSPLCI(ICCC(JCOLO))
  413. CALL GSPMCI(ICCC(JCOLO))
  414. CALL GSTXCI(ICCC(JCOLO))
  415. RETURN
  416. C
  417. ENTRY KFVALI(IFENI,IRESU,NH)
  418. C
  419. IF (IFENI.EQ.1) THEN
  420. WRATIO=1
  421. IRESU=0
  422. CALL GSWN(3,0.,1.,2.,33.)
  423. CALL GSVP(3,0.8,1.,(RY/RX)*0.1,(RY/RX)*0.9)
  424. CALL GSELNT(3)
  425. CALL GSCHH(1.0)
  426. CALL GSCHXP(0.06)
  427. CALL GSCHSP(0.1)
  428. ELSE
  429. CALL GCLSG
  430. CALL GSCHXP(1.)
  431. CALL GSELNT(2)
  432. ENDIF
  433. NH=31
  434. RETURN
  435. C
  436. ENTRY KMENU(LEGEND,NCASE,LLONG)
  437. C AFFICHAGE DU MENU
  438. C
  439. DO 805 II=1,24
  440. IPF(II)=0
  441. 805 CONTINUE
  442. C TEST SUR L'EXISTENCE DES SEGMENTS 10 A 22
  443. C SELECTION TRANSFORMATION 1
  444. CALL GSELNT(1)
  445. CALL GQOPS(ISTA)
  446. IF (ISTA.EQ.4) CALL GCLSG
  447. DO 446 KBOIT=1,13
  448. CALL GQSGUS(0,IERGK,NBSEG,ISEGNA)
  449. DO 4460 ISEG=1,NBSEG
  450. CALL GQSGUS(ISEG,IERGK,NBSE,ISEGNA)
  451. IF (ISEGNA.EQ.9+KBOIT+(100*(WKID-1))) THEN
  452. CALL GDSG(9+KBOIT+(100*(WKID-1)))
  453. GOTO 446
  454. ENDIF
  455. 4460 CONTINUE
  456. 446 CONTINUE
  457. C CREATION DU MENU
  458. XB=1.
  459. CALL GQWKS(WKID,IERGK,ISTA)
  460. IF (ISTA.NE.1) CALL GACWK(WKID)
  461. DO 445 KBOIT=1,13
  462. KKIMP=0
  463. IF (KBOIT.LE.NCASE) THEN
  464. MLONG=LONG(LEGEND(KBOIT))
  465. ELSE
  466. MLONG=1
  467. ENDIF
  468. IF (KBOIT.EQ.12.AND.IPF(2).NE.0.AND.MLONG.EQ.1) KKIMP=1
  469. IF (KKIMP.EQ.1) MLONG=4
  470. IF (MLONG.EQ.1) GOTO 447
  471. ISEG=KBOIT+9+(100*(WKID-1))
  472. CALL GCRSG(ISEG)
  473. IF (KBOIT.NE.1) IPF(KBOIT-1)=1
  474. CALL GSVIS(ISEG,1)
  475. CALL GSDTEC(ISEG,1)
  476. C PAVE DE COULEUR POUR LOCATOR INPUT
  477. CALL GSFAIS(1)
  478. CALL GSFACI(ICCC(2))
  479. PXA(1)=XB
  480. PXA(2)=PXA(1)+2.
  481. PXA(3)=PXA(2)
  482. PXA(4)=PXA(1)
  483. PYA(1)=0.6
  484. PYA(2)=PYA(1)
  485. PYA(3)=PYA(1)+0.4
  486. PYA(4)=PYA(3)
  487. CALL GFA(4,PXA,PYA)
  488. C FIN DE CONSTRUCTION DU PAVE DE COULEUR
  489. CALL GSTXCI(ICCC(2))
  490. CALL GSTXFP(1,2)
  491. CALL GSCHH(0.7)
  492. CALL GSCHSP(0.1)
  493. CALL GSCHXP(1.0)
  494. IF (KKIMP.EQ.1) THEN
  495. CALL GTX(PXA(1),0.,'Meta')
  496. ELSE
  497. CALL GTX(PXA(1),0.,LEGEND(KBOIT)(1:MLONG))
  498. ENDIF
  499. XB=XB+80./(NCASE+1)
  500. CALL GCLSG
  501. 447 CONTINUE
  502. 445 CONTINUE
  503. IDSG=1
  504. CALL GSCHH(1.0)
  505. CALL GSCHXP(1.0)
  506. CALL GSCHSP(0.1)
  507. CALL GSELNT(2)
  508. RETURN
  509. C
  510. ENTRY KINSEG(NBSEGT,IRESS)
  511. C
  512. C INITIALISATION D'UN SEGMENT
  513. C NBSEGT : NUMERO DU SEGMENT
  514. C IRESS : SELON SA VALEUR, ON FERME LE SEGMENT PRECEDENT
  515. C
  516. IF (IRESS.NE.2) THEN
  517. IF (IRESS.LT.2.OR.IRESS.GT.5) THEN
  518. C FERMETURE SEGMENT
  519. CALL GCLSG
  520. ENDIF
  521. ELSE
  522. IRESS=7
  523. ENDIF
  524. CALL GQOPS(IOP)
  525. IF (IOP.EQ.4) CALL GCLSG
  526.  
  527. C
  528. C CREATION SEGMENT NBSEGT
  529. ISEG=NBSEGT+(100*(WKID-1))
  530. CALL GCRSG(ISEG)
  531. C
  532. C ATTRIBUT DE VISIBILITE
  533. CALL GSVIS(ISEG,1)
  534. C DETECTABILITE
  535. CALL GSDTEC(ISEG,0)
  536. C
  537. C MODE VECTEUR POUR LES CARACTERES (STROKE)
  538. C CALL GSTXFP(1,2)
  539. C
  540. C TAILLE DES CARACTERES
  541. IF (NBSEGT.NE.7) THEN
  542. * SAUF CAS DES LEGENDES ISOVALEURS
  543. CHH=(Y2-Y1)/50.0
  544. CALL GSCHH(CHH)
  545. CALL GQCHXP(INDERR,CHXPO)
  546. CHXP=(X2-X1)/(Y2-Y1)/RX*RY*CHXPO
  547. CALL GSCHXP(CHXP)
  548. CALL GSCHSP(0.1)
  549. ELSE
  550. * CAS DES LEGENDES ISOVALEURS
  551. CALL GSCHH(0.9)
  552. CALL GSCHXP(1./21.)
  553. CALL GSCHSP(0.1)
  554. ENDIF
  555. RETURN
  556. C
  557. ENTRY KPOLRL(NTRSTU,XTR,YTR)
  558. C
  559. C TRACE D'UNE POLYLIGNE DANS LA VALEUR COURANTE
  560. C NTR : NOMBRE DE POINTS
  561. C XTR,YTR : COORDONNEES DES POINTS
  562. C
  563. NTR=NTRSTU
  564. IF (NTR.LE.1) RETURN
  565. C
  566. IF (NTR.LE.1) RETURN
  567. C
  568. C TRACE D'UNE POLYLIGNE
  569. CALL GSELNT(2)
  570. CALL GPL(NTR,XTR(1),YTR(1))
  571. C
  572. RETURN
  573. C
  574. ENTRY KTRDIG(X,Y,INCLE)
  575. C
  576. C DIGITALISATION D'UN POINT
  577. C X,Y : COORDONNEES DU POINT DESIGNE
  578. C
  579. INCLE=0
  580. C DEMANDE D'ENTREE DU LOCATOR
  581. CALL GSLCM(WKID,1,0,1)
  582. CALL GUWK(WKID,1)
  583. ITNR=2
  584. CALL GINLC(WKID,1,ITNR,XINID,YINID,1,0.,RX,0.,RY,0,0)
  585. CALL GRQLC(WKID,1,ISTAT,ITNR,X,Y)
  586. C
  587. C CALCUL DE CONVERSION NDC -> WC
  588. X=X2-((0.9-X)/0.9)*(X2-X1)
  589. Y=Y2-((WRATIO-Y)/0.9/WRATIO)*(Y2-Y1)
  590. IF((X.LT.X1).OR.(X.GT.X2))INCLE=3
  591. IF((Y.LT.Y1).OR.(Y.GT.Y2))INCLE=3
  592. C
  593. C MISE A JOUR DE LA NOUVELLE POSITION DU LOCATOR
  594. XINID=X
  595. YINID=Y
  596. C
  597. C REPASSER SUR LE SEGMENT ISGOLD
  598. ISGNEW=9+(100*(WKID-1))
  599. ISGOLD=8+(100*(WKID-1))
  600. CALL GQOPS(ISTA)
  601. IF (ISTA.EQ.4) THEN
  602. CALL GQOPSG(IIERRI,INUM)
  603. IF(INUM.NE.ISGOLD) CALL GCLSG
  604. ELSE
  605. IERGK=1
  606. CALL GQSGUS(0,IERGKK,NBSEG,ISEGNA)
  607. DO 4463 ISEG=1,NBSEG
  608. CALL GQSGUS(ISEG,IERGKK,NBSE,ISEGNA)
  609. IF (ISEGNA.EQ.ISGOLD) THEN
  610. IERGK=0
  611. GOTO 4464
  612. ENDIF
  613. 4463 CONTINUE
  614. 4464 CONTINUE
  615. IF (IERGK.EQ.0) THEN
  616. CALL GRENSG(ISGOLD,ISGNEW)
  617. C CREATION DU SEGMENT COURANT
  618. CALL GCRSG(ISGOLD)
  619. RMAT(1)=1.
  620. RMAT(2)=0.
  621. RMAT(3)=0.
  622. RMAT(4)=1.
  623. RMAT(5)=0.
  624. RMAT(6)=0.
  625. CALL GINSG(ISGNEW,RMAT)
  626. CALL GDSG(ISGNEW)
  627. ELSE
  628. CALL GCRSG(ISGOLD)
  629. ENDIF
  630. C ATTRIBUT VISIBILITE
  631. CALL GSVIS(ISGOLD,1)
  632. C DETECTABILITE
  633. CALL GSDTEC(ISGOLD,0)
  634. C MODE VECTEUR (POUR LES CARACTERES)
  635. CALL GSTXFP(1,2)
  636. C TAILLE DES CARACTERES PAR DEFAUT
  637. C DETERMINATION DE LA HAUTEUR DES CARACTERES, DE L'ESPACE ENTRE CARACTER
  638. CHH=(Y2-Y1)/50.0
  639. CALL GSCHH(CHH)
  640. CALL GQCHXP(INDERR,CHXPO)
  641. CHXP=(X2-X1)/(Y2-Y1)/RX*RY*CHXPO
  642. CALL GSCHXP(CHXP)
  643. CALL GSCHSP(0.1)
  644. C COULEUR COURANTE (ICCOL)
  645. CALL GSFACI(ICCC(ICCOL))
  646. CALL GSPLCI(ICCC(ICCOL))
  647. CALL GSPMCI(ICCC(ICCOL))
  648. CALL GSTXCI(ICCC(ICCOL))
  649. C
  650. ENDIF
  651. C
  652. RETURN
  653. C
  654. ENTRY KTRFAC(NP,XTR,YTR,ZN,ICOLE,IEFF)
  655. C
  656. C TRACE D'UNE FACE AVEC DEGRADE
  657. C NP : NOMBRE DE POINTS
  658. C XTR,YTR : COORDONNEES DES POINTS
  659. C ICOLE : COULEUR
  660. C KP : ECLAIRAGE
  661. C
  662. IEFF=0
  663. KP=INT(ZN*4./1.58)+1
  664. C
  665. IEFF=0
  666. CALL GSELNT(2)
  667. C
  668. C EFFACEMENT DE LA ZONE (FAUT-IL LE FAIRE AVEC GKS?)
  669. IEFF=1
  670. C IF (KP.GE.3) IEFF=1
  671. IF (KP.NE.4) THEN
  672. C COULEUR EFFACEMENT -> 8
  673. C PATTERN PLEIN
  674. C TRACE DE LA ZONE PLEINE
  675. ENDIF
  676. C
  677. C COULEUR (ICOLE)
  678. CALL GSFACI(ICCC(ICOLE))
  679. C
  680. CALL GSFAIS(1)
  681. C
  682. C TRACE DE LA ZONE PLEINE
  683. CALL GFA(NP,XTR,YTR)
  684. RETURN
  685. C
  686. ENTRY KTRAIS(NP,XTR,YTR,ICOLE)
  687. C
  688. C TRACE D'UNE FACE SANS CALCUL DE DEGRADE
  689. C NP : NOMBRE DE POINTS
  690. C XTR,YTR : COORDONNEES DES POINTS
  691. C ICOLE : COULEUR
  692. C
  693. C CHANGEMENT DE COULEUR SI CE N'EST PAS LA MEME
  694. IF (ICOLE.NE.ICOISI) THEN
  695. ICOISI=ICOLE
  696. C CALL GSELNT(2)
  697. C COULEUR (ICOISI)
  698. CALL GSFACI(ICCC(ICOISI))
  699. ENDIF
  700. C
  701. C TRACE DU POLYGONE
  702. CALL GSFAIS(1)
  703. CALL GFA(NP,XTR,YTR)
  704. C
  705. RETURN
  706. C
  707. C EFFACEMENT ECRAN ON UTILISE GDDM OU CE QU'ON PEUT
  708. ENTRY KTREFF
  709. * A VOIR SELON LES TERMINAUX
  710. C IMPLANTATION CERN
  711. C ROUTINE VMCMS DANS KERNLIB
  712. * CALL VMCMS('CLRSCRN',IRC)
  713. RETURN
  714. C REINITIALISATION CHAMP TEXT
  715. C
  716. C AFFICHAGE RETOUR CLE TAPEE
  717. ENTRY KTRAFF(ICLE)
  718. C
  719. C AFFICHAGE RETOUR CLE TAPEE
  720. C ICLE : NUMERO DE CLE RENDUE
  721. C
  722. 1540 CONTINUE
  723. ICLE=0
  724. C DEMANDE DU NOM DU SEGMENT OUVERT (FERMETURE)
  725. ISGNEW=9+(100*(WKID-1))
  726. ISGOLD=8+(100*(WKID-1))
  727. CALL GQOPS(ISTA)
  728. IF (ISTA.EQ.4) THEN
  729. CALL GQOPSG(IIERRI,INUM)
  730. IF(INUM.NE.ISGOLD) CALL GCLSG
  731. ELSE
  732. IERGK=1
  733. CALL GQSGUS(0,IERGKK,NBSEG,ISEGNA)
  734. DO 4466 ISEG=1,NBSEG
  735. CALL GQSGUS(ISEG,IERGKK,NBSE,ISEGNA)
  736. IF (ISEGNA.EQ.ISGOLD) THEN
  737. IERGK=0
  738. GOTO 4467
  739. ENDIF
  740. 4466 CONTINUE
  741. 4467 CONTINUE
  742. IF (IERGK.EQ.0) THEN
  743. CALL GRENSG(ISGOLD,ISGNEW)
  744. C CREATION DU SEGMENT COURANT
  745. CALL GCRSG(ISGOLD)
  746. RMAT(1)=1.
  747. RMAT(2)=0.
  748. RMAT(3)=0.
  749. RMAT(4)=1.
  750. RMAT(5)=0.
  751. RMAT(6)=0.
  752. CALL GINSG(ISGNEW,RMAT)
  753. CALL GDSG(ISGNEW)
  754. ELSE
  755. CALL GCRSG(ISGOLD)
  756. ENDIF
  757. C ATTRIBUT VISIBILITE
  758. CALL GSVIS(ISGOLD,1)
  759. C DETECTABILITE
  760. CALL GSDTEC(ISGOLD,0)
  761. C MODE VECTEUR (POUR LES CARACTERES)
  762. CALL GSTXFP(1,2)
  763. C TAILLE DES CARACTERES PAR DEFAUT
  764. C DETERMINATION DE LA HAUTEUR DES CARACTERES, DE L'ESPACE ENTRE CARACTER
  765. CHH=(Y2-Y1)/50.0
  766. CALL GSCHH(CHH)
  767. CALL GQCHXP(INDERR,CHXPO)
  768. CHXP=(X2-X1)/(Y2-Y1)/RX*RY*CHXPO
  769. CALL GSCHXP(CHXP)
  770. CALL GSCHSP(0.1)
  771. C COULEUR COURANTE (ICCOL)
  772. CALL GSFACI(ICCC(ICCOL))
  773. CALL GSPLCI(ICCC(ICCOL))
  774. CALL GSPMCI(ICCC(ICCOL))
  775. CALL GSTXCI(ICCC(ICCOL))
  776. C
  777. ENDIF
  778. C
  779. ISEG=0
  780. C INITIALISATION PICK
  781. CALL GSPKM(WKID,1,0,1)
  782. C DEMANDE D'ENTREE
  783. * CALL GRSGWK(WKID)
  784. CALL GUWK(WKID,1)
  785. CALL GRQPK(WKID,1,ISTAT,ICHNR,PCID)
  786. C CONVERSION NUMERO DE SEGMENT SAISI
  787. ISEG=ICHNR-(100*(WKID-1))
  788. IF (ISTAT.NE.1) GOTO 1540
  789. C
  790. IF(ISEG.GE.50) THEN
  791. C DEMANDE ENTREE STRING
  792. CALL GSSTM(WKID,1,0,1)
  793. CALL GRQST(WKID,1,ISTAT,IL,STRING)
  794. C DESTRUCTION DU SEGMENT DESIGNE
  795. CALL GDSG(ICHNR)
  796. C REECRITURE DU SEGMENT AVEC LA NOUVELLE CHAINE
  797. CALL GCRSG(ICHNR)
  798. XX=TEXTX(ISEG-50+1)
  799. YY=TEXTY(ISEG-50+1)
  800. CALL GTX(XX,YY,STRING)
  801. CALL GCLSG
  802. CALL GSDTEC(ICHNR,1)
  803. C MODIFICATION DANS LE TABLEAU
  804. TEXTE(ISEG-50+1)(1:15)=STRING(1:15)
  805. ENDIF
  806. ICLE=ISEG
  807. ICLE=ICLE-10
  808. * WRITE (6,*) ' ICLE ',ICLE
  809. IF (ICLE.NE.0.AND.IPF(ICLE).EQ.0) GOTO 1540
  810. C
  811. C CHANGEMENT MODE DE MISE A JOUR (BLOCAGE)
  812. CALL GSDS(WKID,1,0)
  813. C
  814. RETURN
  815. C
  816. * ROUTINE POUR SORTIR CORRECTEMENT DE GKS AVEC MODIFIER
  817. ENTRY KTRMFI
  818. IACT=0
  819. IWISS=0
  820. CALL GQWKS(WKID,IERGK,ISTA)
  821. IF (IERGK.EQ.0) THEN
  822. IF(ISTA.EQ.1) CALL GDAWK(WKID)
  823. CALL GCLWK(WKID)
  824. ENDIF
  825. IDSG=0
  826. RETURN
  827. C
  828. * ENTRY KZOOM(IRESU,ISORT,IQUALI,INUMNO,INUMEL,XMI,XMA,YMI,YMA)
  829. ENTRY KZOOM(IZOOM,XMI,XMA,YMI,YMA)
  830. C
  831. C XMI,XMA,YMI,YMA POINTS RENDUS APRES LE ZOOM
  832. C
  833. IRESU=1
  834. C ENTREE DES DEUX POINTS POUR LE RECTANGLE DU ZOOM
  835. ITNR=2
  836. CALL GINLC(WKID,1,ITNR,XINID,YINID,1,0.,RX,0.,RY,0,0)
  837. CALL GSELNT(0)
  838. CALL GSLCM(WKID,1,0,1)
  839. C ACCUMULATION DE MATRICES
  840. CALL GRQLC(WKID,1,STAT,ITNR1,XRO,YRO)
  841. CALL GINLC(WKID,1,ITNR1,XRO,YRO,1,0.,RX,0.,RY,0,0)
  842. CALL GRQLC(WKID,1,STAT,ITNR1,XCOL,YCOL)
  843. C GESTION DU CADRE DU ZOOM : CARRE
  844. XMI=MIN(XRO,XCOL)
  845. XMA=MAX(XRO,XCOL)
  846. YMI=MIN(YRO,YCOL)
  847. YMA=MAX(YRO,YCOL)
  848. XMA=MAX(XMA,YMA-YMI+XMI)
  849. YMI=MIN(YMI,-XMA+XMI+YMA)
  850. IF (VALEUR) THEN
  851. PAS=MIN(0.8/(XMA-XMI),(RY/RX)*0.8/(YMA-YMI))
  852. ELSE
  853. PAS=MIN(0.9/(XMA-XMI),(RY/RX)*0.9/(YMA-YMI))
  854. ENDIF
  855. C INTERROGATION SUR LA MATRICE PRECEDENTE
  856. ISEG=1+(100*(WKID-1))
  857. CALL GQSGA(ISEG,ERR,SEGT,VIS,HIGH,GRPR,DET)
  858. C INITIALISATION DES MATRICES
  859. ISW=1
  860. SEGMT(1)=PAS
  861. SEGMT(2)=0.
  862. SEGMT(3)=0.
  863. SEGMT(4)=PAS
  864. IF (VALEUR) THEN
  865. XVALEU=0.8
  866. YVALEU=0.9*(RY/RX)
  867. ELSE
  868. XVALEU=0.9
  869. YVALEU=1.0*(RY/RX)
  870. ENDIF
  871. SEGMT(5)=XVALEU/2-(XMA+XMI)/2*PAS
  872. SEGMT(6)=(YVALEU+0.1*(RY/RX))/2-(YMA+YMI)/2*PAS
  873. ROUT(1)=SEGMT(1)*SEGT(1) + SEGMT(2)*SEGT(3)
  874. ROUT(2)=SEGMT(2)*SEGT(1) + SEGMT(4)*SEGT(2)
  875. ROUT(3)=SEGMT(1)*SEGT(3) + SEGMT(3)*SEGT(4)
  876. ROUT(4)=SEGMT(2)*SEGT(3) + SEGMT(4)*SEGT(4)
  877. ROUT(5)=SEGMT(1)*SEGT(5) + SEGMT(3)*SEGT(6) + SEGMT(5)
  878. ROUT(6)=SEGMT(2)*SEGT(5) + SEGMT(4)*SEGT(6) + SEGMT(6)
  879. C TRANSFORMATION PAR LA MATRICE
  880. CALL GSSGT(ISEG,ROUT)
  881. C
  882. * IF (IDEFOR.NE.0) THEN
  883. *1093 ISORT=0
  884. * RETURN
  885. * ENDIF
  886. C SUPPRESSION DE SEGMENTS
  887. IDEL1=0
  888. IDEL2=0
  889. IDEL3=0
  890. *1093 IF (IQUALI.NE.0) IDEL1=3+(100*(WKID-1))
  891. *1093 IF (INUMNO.NE.0) IDEL2=4+(100*(WKID-1))
  892. *1093 IF (INUMEL.NE.0) IDEL3=5+(100*(WKID-1))
  893. IF (IDEL1.NE.0) CALL GDSG(IDEL1)
  894. IF (IDEL2.NE.0) CALL GDSG(IDEL2)
  895. IF (IDEL3.NE.0) CALL GDSG(IDEL3)
  896. *1093 IF (IQUALI.EQ.10) IQUALI=0
  897. *1093 IF (INUMNO.EQ.10) INUMNO=0
  898. *1093 IF (INUMEL.EQ.10) INUMEL=0
  899. *1093 ISORT=1
  900. IRESU=2
  901. C
  902. IF (VALEUR) THEN
  903. ROUT(5)=ROUT(5)*(X2-X1)/0.8+X1
  904. ROUT(6)=ROUT(6)*(Y2-Y1)/(0.8*RY/RX)+(9*Y1-Y2)/8.
  905. ELSE
  906. ROUT(5)=ROUT(5)*(X2-X1)/0.9+X1
  907. ROUT(6)=ROUT(6)*(Y2-Y1)/(0.9*RY/RX)+(10*Y1-Y2)/9.
  908. ENDIF
  909. C CALCUL DES COORDONNEES APRES LE ZOOM
  910. XMI=(SXMIN-ROUT(5))/ROUT(1)+X1
  911. XMA=(SXXAX-ROUT(5))/ROUT(1)+X1
  912. IF (VALEUR) THEN
  913. YMI=(SYMIN-ROUT(6))/ROUT(4)+(9*Y1-Y2)/8.
  914. YMA=(SYYAX-ROUT(6))/ROUT(4)+(9*Y1-Y2)/8.
  915. ELSE
  916. YMI=(SYMIN-ROUT(6))/ROUT(4)+(10*Y1-Y2)/9.
  917. YMA=(SYYAX-ROUT(6))/ROUT(4)+(10*Y1-Y2)/9.
  918. ENDIF
  919. CALL GSELNT(2)
  920. RETURN
  921. C
  922. ENTRY KCHANG(IRESU,ISORT,ICHANG,JSEG)
  923. C
  924. C VISUALISATION OU NON DU SEGMENT JSEG
  925. C POUR LES CLES QUAL, NOEUD OU ELEM
  926. C
  927. ISEG=JSEG+(100*(WKID-1))
  928. IF (ICHANG.EQ.1) THEN
  929. ICHANG=10
  930. CALL GSVIS(ISEG,0)
  931. ISORT=0
  932. RETURN
  933. ELSEIF (ICHANG.EQ.10) THEN
  934. ICHANG=1
  935. CALL GSVIS(ISEG,1)
  936. ISORT=0
  937. RETURN
  938. ENDIF
  939. ISORT=1
  940. IRESU=JSEG
  941. ICHANG=1
  942. RETURN
  943. C
  944. ENTRY KINI(IRESU,ISORT,IQUALI,INUMNO,INUMEL,XMI,XMA,YMI,YMA)
  945. C
  946. C RETOUR AU DESSIN INITIAL - SUPPRESSION DES SEGMENTS
  947. C CONCERNANT QUAL, NOEUD ET ELEM
  948. CALL GSELNT(2)
  949. PAS=1
  950. RMAT(1)=1.
  951. RMAT(2)=0.
  952. RMAT(3)=0.
  953. RMAT(4)=1.
  954. RMAT(5)=0.
  955. RMAT(6)=0.
  956. ISEG=1+(100*(WKID-1))
  957. C APPLICATION DE LA MATRICE AU SEGMENT 1
  958. CALL GSSGT(ISEG,RMAT)
  959. * IF (IDEFOR.NE.0) THEN
  960. * ISORT=0
  961. * RETURN
  962. * ENDIF
  963. IDEL1=0
  964. IDEL2=0
  965. IDEL3=0
  966. IF (IQUALI.NE.0) IDEL1=3+(100*(WKID-1))
  967. IF (INUMNO.NE.0) IDEL2=4+(100*(WKID-1))
  968. IF (INUMEL.NE.0) IDEL3=5+(100*(WKID-1))
  969. IF (IDEL1.NE.0) CALL GDSG(IDEL1)
  970. IF (IDEL2.NE.0) CALL GDSG(IDEL2)
  971. IF (IDEL3.NE.0) CALL GDSG(IDEL3)
  972. IF (IQUALI.EQ.10) IQUALI=0
  973. IF (INUMNO.EQ.10) INUMNO=0
  974. IF (INUMEL.EQ.10) INUMEL=0
  975. C RESTITUTION DES COORDONNEES
  976. XMI=SXMIN
  977. XMA=SXXAX
  978. YMI=SYMIN
  979. YMA=SYYAX
  980. CALL GSWN(2,X1,X2,Y1,Y2)
  981. ISORT=1
  982. IRESU=2
  983. C CALL GSELNT(2)
  984. RETURN
  985. C
  986. ENTRY KFLGI
  987. C
  988. C en fait c'est l'impression que l'on demande
  989. ENTRY KIMPR
  990. C
  991. C EN GKS : SAUVEGARDE DU DESSIN SUR METAFILE METAXX
  992. C AVEC XX = NUMERO DE 01 A 99
  993. C INCREMENTATION DU COMPTEUR METAFILE
  994. KMETA=KMETA+1
  995. IF (KMETA.GT.99) THEN
  996. CALL GTX(25.,6.,'COMPTEUR DE MATAFILE SUPERIEUR A 99')
  997. CALL GTX(25.,4.,'SAUVEGARDE IMPOSSIBLE')
  998. RETURN
  999. ENDIF
  1000. I10=KMETA/10
  1001. IREST=KMETA-10*I10
  1002. I10=I10+1
  1003. IREST=IREST+1
  1004. STR=STR1//CARELE(I10)//CARELE(IREST)
  1005. * OPEN(UNIT=1,FILE=STR,STATUS='NEW',IOSTAT=JERROR)
  1006. * IF (JERROR.NE.0) THEN
  1007. * CALL GTX(25.,4.,'SAUVEGARDE IMPOSSIBLE')
  1008. * CALL GTX(25.,6.,'CANNOT OPEN METAFILE')
  1009. * RETURN
  1010. * ENDIF
  1011. KCON=1
  1012. METAID=1
  1013. CALL GQOPS(ISTA)
  1014. IF (ISTA.EQ.4) CALL GCLSG
  1015. CALL GOPWK(METAID,KCON,INMETA)
  1016. CALL GACWK(METAID)
  1017. CALL GSWKWN(METAID,0.,1.,0.,1.)
  1018. CALL GSWKVP(METAID,0.,0.20,0.,0.20)
  1019. ISEG=6+(100*(WKID-1))
  1020. CALL GASGWK(METAID,ISEG)
  1021. ISEG=1+(100*(WKID-1))
  1022. CALL GASGWK(METAID,ISEG)
  1023. IF (FENE) THEN
  1024. IF (VALEUR) THEN
  1025. ISEG=7+(100*(WKID-1))
  1026. CALL GASGWK(METAID,ISEG)
  1027. ELSE
  1028. ISEG=3+(100*(WKID-1))
  1029. IF (IQUALI.EQ.1) CALL GASGWK(METAID,ISEG)
  1030. ISEG=4+(100*(WKID-1))
  1031. IF (INUMNO.EQ.1) CALL GASGWK(METAID,ISEG)
  1032. ISEG=5+(100*(WKID-1))
  1033. IF (INUMEL.EQ.1) CALL GASGWK(METAID,ISEG)
  1034. ENDIF
  1035. ENDIF
  1036. CALL GQWKS(METAID,IERGK,ISTA)
  1037. IF (IERGK.EQ.0) THEN
  1038. IF (ISTA.EQ.1) CALL GDAWK(METAID)
  1039. CALL GCLWK(METAID)
  1040. ENDIF
  1041. CLOSE(UNIT=1,STATUS='KEEP')
  1042. RETURN
  1043. C
  1044. ENTRY KVAL(IRESU,ISORT,NISO)
  1045. C
  1046. RETURN
  1047. C
  1048. ENTRY KMAJSE(IMAJ,IRESU,IQUALI,INUMNO,INUMEL)
  1049. C
  1050. IF (IMAJ.EQ.1) THEN
  1051. IF (IRESU.NE.2.OR.IQUALI.NE.0.OR.INUMNO.NE.0.OR.INUMEL.NE.0)
  1052. & CALL GCLSG
  1053. ELSE
  1054. IF (IQUALI.EQ.10) IQUALI=0
  1055. IF (INUMNO.EQ.10) INUMNO=0
  1056. IF (INUMEL.EQ.10) INUMEL=0
  1057. C
  1058. IF (IRESU.LT.2.OR.IRESU.GT.5) THEN
  1059. C EFFACEMENT DU DESSIN (A VOIR)
  1060. ENDIF
  1061. C FERMETURE DE LA WORKSTATION WKID POUR POUVOIR PASSER EN MODE
  1062. C ALPHANUMERIQUE A LA FIN DU DESSIN
  1063. CALL GQOPS(ISTA)
  1064. IF (ISTA.EQ.4) CALL GCLSG
  1065. IF (ISTA.EQ.4.OR.ISTA.EQ.3) CALL GDAWK(WKID)
  1066. IF (ISTA.EQ.4.OR.ISTA.EQ.3.OR.ISTA.EQ.2) CALL GCLWK(WKID)
  1067. ENDIF
  1068. RETURN
  1069. C
  1070. ENTRY KTRANI(IANIM,NDEF)
  1071. * INITIALISATION POUR ANIMATION
  1072. * IANIM 1 ALLER SIMPLE
  1073. * IANIM 2 ALLER RETOUR
  1074. * NDEF NOMBRE D'IMAGE
  1075. RETURN
  1076. C
  1077. ENTRY KTRIMA(IDEF)
  1078. * NOUVELLE IMAGE
  1079. * IDEF NUMERO DE L'IMAGE
  1080. C
  1081. RETURN
  1082. C
  1083. C MESSAGE EN BAS DE L'ECRAN
  1084. ENTRY KTRMES(TITRE)
  1085. CALL GMSG(WKID,TITRE(1:LEN(TITRE)))
  1086. RETURN
  1087. C
  1088. C INPUT AVEC PROMPT
  1089. ENTRY KTRGET(TITRE,CARACT)
  1090. RETURN
  1091. END
  1092.  
  1093.  
  1094.  
  1095.  
  1096.  
  1097.  
  1098.  
  1099.  
  1100.  
  1101.  
  1102.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales