1 : C FSCREE SOURCE CHAT 05/01/13 00:10:06 5004 2 : C CE SOUS PROGRAMME A AFFICHER UN ECRAN ET A RECUPERER UN NUMERO 3 : C DE CLE AINSI QUE LA POSITION DU CURSEUR 4 : C 5 : SUBROUTINE FSCREE(ECRAN,ICLE,ICURSR,JCURSR) 6 : IMPLICIT INTEGER(I-N) 7 : SEGMENT ECRAN 8 : CHARACTER*80 LIGNE(NBLIG) 9 : ENDSEGMENT 10 : CHARACTER*80 LIGAF(24),LIGDU(24) 11 : CHARACTER*1 LIGAF2(24*80) 12 : DATA INIT/0/ 13 : DATA LIGAF/24*' '/,LIGDU/24*' '/ 14 : IF (INIT.EQ.0) THEN 15 : * ON INITIALISE UNE FOIS GDDM 15 : CALL FSINIT 16 : INIT=1 16 : CALL ASDFLD(1234,1,1,24,80,0) 16 : CALL ASFCOL(1234,3) 16 : CALL ASFTRN(1234,1) 16 : CALL ASFTRA(1234,1) 17 : ENDIF 18 : * ON VERIFIE QU'ON N'A PAS ETE CASSE 18 : CALL ASQMAX(NFIELD,MFIELD) 19 : IF (MFIELD.NE.1234) THEN 19 : CALL FSRNIT 19 : * CALL ASDFMT(0,5,IBID) 19 : CALL ASDFLD(1234,1,1,24,80,0) 19 : CALL ASFCOL(1234,3) 19 : CALL ASFTRN(1234,1) 19 : CALL ASFTRA(1234,1) 20 : ENDIF 21 : IPO2=0 22 : NBLIG=LIGNE(/2) 23 : IPOS=0 24 : JPOS=0 25 : LONG=1 26 : DO 20 ILIG=1,NBLIG 27 : DO 21 ICHAR=80,LONG,-1 28 : IF (LIGNE(ILIG)(ICHAR:ICHAR).EQ.' ') GOTO 21 29 : GOTO 22 30 : 21 CONTINUE 31 : GOTO 20 32 : 22 CONTINUE 33 : LONG=ICHAR 34 : 20 CONTINUE 35 : IPD=MAX(0,(24-NBLIG)/2) 36 : IPF=(80-LONG)/2 37 : IF (IPD.NE.0) THEN 38 : * CARRE AUTOUR DE LA FENETRE 39 : LIGAF(IPD)(IPF+1:IPF+LONG)= 40 : # '------------------------------------------------------------' 41 : #//'----------------------' 42 : IF (IPF.NE.0) LIGAF(IPD)(IPF:IPF)='+' 43 : IF (IPF+LONG.NE.80) 44 : # LIGAF(IPD)(IPF+LONG+1:IPF+LONG+1)='+' 45 : ENDIF 46 : IF (IPD+NBLIG+1.LE.24) THEN 47 : LIGAF(IPD+NBLIG+1)(IPF+1:IPF+LONG)= 48 : # '------------------------------------------------------------' 49 : #//'----------------------' 50 : IF (IPF.NE.0) LIGAF(IPD+NBLIG+1)(IPF:IPF)='+' 51 : IF (IPF+LONG.NE.80) 52 : # LIGAF(IPD+NBLIG+1)(IPF+LONG+1:IPF+LONG+1)='+' 53 : ENDIF 54 : * 55 : 30 CONTINUE 56 : DO 25 ILIG=1,MIN(24,NBLIG) 57 : IF (IPF.NE.0) LIGAF(IPD+ILIG)(IPF:IPF)='|' 58 : IF (IPF+LONG.NE.80) 59 : # LIGAF(IPD+ILIG)(IPF+LONG+1:IPF+LONG+1)='|' 60 : LIGAF(IPD+ILIG)(IPF+1:IPF+LONG)=LIGNE(ILIG+IPO2)(1:LONG) 61 : 25 CONTINUE 62 : * 62 : CALL ASCPUT(1234,80*24,LIGAF) 62 : * CALL ASFCUR(0,IPD+1-IPO2,IPF+41) PAS TRES HEUREUX 62 : CALL ASREAD(ITYP,ICLE,ICOUNT) 63 : IF (ITYP.EQ.0) ICLE=0 64 : IF (ICLE.GT.12) ICLE=ICLE-12 65 : IF (ICLE.EQ.7) IPO2=MAX(0,IPO2-24) 66 : IF (ICLE.EQ.8) IPO2=MAX(0,MIN(NBLIG-24,IPO2+24)) 67 : IF (ICLE.EQ.7.OR.ICLE.EQ.8) GOTO 30 67 : CALL ASQCUR(0,FIELD,ICURSR,JCURSR) 68 : ICURSR=ICURSR+IPO2 69 : ICURSR=ICURSR-IPD 70 : JCURSR=JCURSR-IPF 70 : CALL ASCGET(1234,80*24,LIGDU) 71 : IF (IPD+1-IPO2.GE.1.AND.IPD+1-IPO2.LE.24.AND.NBLIG.GE.2) 72 : # LIGNE(2)(1:LONG)=LIGDU(IPD+2-IPO2)(IPF+1:IPF+LONG) 73 : RETURN 74 : END 75 : 76 :
© Cast3M 2003 - All rights reserved.
Disclaimer