|
DECLARE SUB affiche (s$, w$)
DECLARE SUB afformate (nm%, m$(), erreur%)
DECLARE SUB ajoutertexte (nbtextes%, titre$(), m$(), parag$(),
nbparag%(), pp$())
DECLARE SUB attendre (tx!)
DECLARE SUB cadre (v%, h%, l%, nli%, c%)
DECLARE SUB centre (v%, coul%, ph$)
DECLARE SUB choixtexte (nbtextes%, titre$(), nbparag%(), pp$(),
parag$())
DECLARE SUB efface (v%, hk%)
DECLARE SUB effacer (nbtextes%, titre$(), m$(), parag$(), nbparag%(),
pp$())
DECLARE SUB enregistrer (nbtextes%, titre$(), nbparag%(), parag$())
DECLARE SUB entree (rr%, y%, z%)
DECLARE SUB entree_echap (rr%)
DECLARE SUB epuration (mo$)
DECLARE SUB exporter (texte$, nbtextes%, titre$(), parag$(), nbparag%())
DECLARE SUB fleches (v%, h%, w$(), np%, r%, coul%, drap%, v2%, h3%)
DECLARE SUB getinvi (r%, r$)
DECLARE SUB impression (parag$(), nbparag%(), t%)
DECLARE SUB imprime2 (s$, w$)
DECLARE SUB imprimer (nbtextes%, titre$(), parag$(), nbparag%(),
pp$())
DECLARE SUB inputline (r$, nl%)
DECLARE SUB inserer (nbtextes%, titre$(), m$(), parag$(),
nbparag%(), pp$())
DECLARE SUB lire (nbtextes%, titre$(), parag$(), nbparag%(), s$(),
s%(), m$(), te$(), r%(), pp$())
DECLARE SUB listeecran (nbtextes%, titre$(), nbparag%(), parag$(),
m$(), t%)
DECLARE SUB modifier (nbtextes%, titre$(), m$(), parag$(),
nbparag%(), pp$())
DECLARE SUB ouinon (r$)
DECLARE SUB pleinecran (r$, l$, m$, v1%, v2%)
DECLARE SUB pleineligne (r$, m$, np%, v%, h%)
DECLARE SUB recupere (m$, v1%, v2%)
DECLARE SUB titr (w$)
DECLARE SUB titr2 (w$)
DECLARE SUB titrnb (tit$)
DECLARE SUB transforme (m$)
DECLARE SUB trouvemot (m$, m$(), nm%)
'Gestion textes LECTURE souris
'Clerc Daniel 18/12/2001
'version 1.4.3
DEFINT A-Z
COMMON SHARED es$, lecture$, tit$, gg$, fle$, fe$, rt$, noir, bleu,
vert, rouge, marron, blanc, vertclair, cyanclair, rougeclair, jaune,
blancbrill, couleur
' Inclut les fichiers contenant les déclarations relatives aux
procédures appelées.
'$INCLUDE: 'MOUSE.BI'
'$INCLUDE: 'VBDOS.BI'
SCREEN 9
SCREEN 0
CONST FALSE = 0
CONST TRUE = NOT FALSE
' Vérifie que le gestionnaire de souris est installé.
MouseInit
' Affiche le pointeur de la souris.
MouseShow
ON ERROR GOTO corrigeerreur '===
OPEN "pointeur.dat" FOR INPUT AS #1
INPUT #1, eleve, sens, couleur, texte, lecture$
CLOSE
couleur = 1
IF couleur = 1 THEN
noir = 0: bleu = 1: vert = 2: rouge = 4: marron = 6: blanc = 7:
vertclair = 10: cyanclair = 11: rougeclair = 12: jaune = 14:
blancbrill = 15
ELSE
noir = 0: bleu = 0: vert = 15: rouge = 0: marron = 7: blanc = 7:
vertclair = 15: cyanclair = 15: rougeclair = 15: jaune = 15:
blancbrill = 15
END IF
LOCATE , , 0: COLOR , noir: CLS
texte$ = "EXPORT.TXT"
DIM m$(250), nbparag(10), parag$(10, 5), p$(11), pp$(11),
titre$(11), s$(3000), s%(3000), te$(3000), r%(3000)
DATA
Visualiser,Ajouter,Modifier,Insérer,Effacer,Imprimer,Exporter,Fin
FOR i = 1 TO 8: READ p$(i): NEXT
Fh$ = CHR$(24): Fb$ = CHR$(25)
FG$ = CHR$(27): FD$ = CHR$(26)
rt$ = CHR$(17) + CHR$(196) + CHR$(217)
fle$ = Fh$ + " " + Fb$ + " " + FG$ + " " + FD$
gg$ = Fh$ + " " + Fb$ + " puis " + rt$
es$ = "[Echap]=Fin"
fe$ = gg$ + SPACE$(13) + es$
'lecture
OPEN lecture$ FOR INPUT AS #1
'nbtextes
INPUT #1, nbtextes
IF nbtextes = 0 THEN
CLOSE
tit$ = "Ajouter"
DO
CALL ajoutertexte(nbtextes, titre$(), m$(), parag$(), nbparag(),
pp$())
LOOP WHILE nbtextes = 0
CALL enregistrer(nbtextes, titre$(), nbparag(), parag$())
RUN
END IF
'titres
FOR i = 1 TO nbtextes
LINE INPUT #1, titre$(i)
NEXT
'nbparag
FOR i = 1 TO nbtextes
INPUT #1, nbparag(i)
NEXT
'paragraphe$
FOR i = 1 TO nbtextes
FOR j = 1 TO nbparag(i)
LINE INPUT #1, parag$(i, j)
parag$(i, j) = parag$(i, j) + " "
NEXT j
NEXT i
CLOSE
'+++++++++++++++++
'menu principal
DO
COLOR , bleu: CLS
DEF SEG = 0
POKE &H417, (PEEK(&H417) AND &H9F)'non numérique
POKE &H417, (PEEK(&H417) AND &HBF) 'minuscules
DEF SEG
SELECT CASE nbtextes
CASE 10, 9
v = 8
CASE 8, 7, 6
v = 9
CASE ELSE
v = 10
END SELECT
CALL cadre(v, 10, 60, nbtextes + 2, vert)
COLOR blancbrill, vert
LOCATE v + 1
FOR j = 1 TO nbtextes
LOCATE , 15: PRINT titre$(j);
LOCATE , 38 - LEN(STR$(nbparag(j)))
PRINT "("; MID$(STR$(nbparag(j)), 2); " parag.)"
NEXT
COLOR blanc, bleu
LOCATE v - 1, 15
IF LCASE$(lecture$) = "fichier1.txt" THEN PRINT "Niveau I" ELSE
PRINT "Niveau II"
'===
LOCATE 7, 49: COLOR jaune: PRINT "GESTION DES TEXTES"
CALL cadre(8, 50, 14, 12, rouge)
COLOR blanc, bleu
LOCATE 20, 53: PRINT gg$
FOR i = 1 TO 8: pp$(i) = p$(i): NEXT
DO
CALL fleches(10, 53, pp$(), 8, r, rouge, 0, 20, 53)
LOOP WHILE r = 27
tit$ = p$(r)
SELECT CASE r
CASE 1
CALL lire(nbtextes, titre$(), parag$(), nbparag(), s$(), s%(), m$(),
te$(), r%(), pp$())
CASE 2
CALL ajoutertexte(nbtextes, titre$(), m$(), parag$(), nbparag(),
pp$())
CASE 3
CALL modifier(nbtextes, titre$(), m$(), parag$(), nbparag(), pp$())
CASE 4
CALL inserer(nbtextes, titre$(), m$(), parag$(), nbparag(), pp$())
CASE 5
CALL effacer(nbtextes, titre$(), m$(), parag$(), nbparag(), pp$())
CASE 6
CALL imprimer(nbtextes, titre$(), parag$(), nbparag(), pp$())
CASE 7
CALL exporter(texte$, nbtextes, titre$(), parag$(), nbparag())
CASE 8
CALL enregistrer(nbtextes, titre$(), nbparag(), parag$())
COLOR , noir: CLS
RUN "menu"
END
END SELECT
LOOP
'++++++++++++++++
corrigeerreur:
programme$ = "gestion"
SCREEN 0
COLOR , bleu: CLS
BEEP
CALL cadre(8, 5, 70, 9, rouge)
COLOR , rouge
CALL centre(10, blanc, "ATTENTION")
SELECT CASE ERR
CASE 71
CALL centre(12, blancbrill, "Disque non prêt")
CASE 70
CALL centre(12, blancbrill, "Disquette protégée")
CASE 53, 57, 72
CALL centre(12, blancbrill, "Problème sur le disque")
CASE 61
CALL centre(12, blancbrill, "Disque plein")
CASE 25, 26, 68
CALL centre(12, blancbrill, "Imprimante non prête")
CASE 27
CALL centre(12, blancbrill, "Imprimante sans papier")
CASE ELSE
CALL centre(12, blancbrill, "Erreur système n°" + LTRIM$(STR$(ERR)))
CALL centre(14, blancbrill, "Essayez de relancez le programme.")
CLOSE
w$ = INPUT$(1)
COLOR , noir: CLS
END
END SELECT
CALL centre(14, blancbrill, "Corrigez puis tapez " + rt$ + " [Echap]
= Fin")
CALL getinvi(r, r$)
IF r = 27 THEN COLOR , noir: CLS : END
COLOR , bleu: CLS : RUN programme$
RESUME
DEFINT A-Z
SUB affiche (s$, w$)
w$ = (".(" + w$ + ")")
l1 = LEN(w$)
l2 = LEN(s$) + l1
IF l2 > 14 THEN
ss$ = MID$(s$, 1, 14 - l1)
ELSEIF l2 < 14 THEN
ss$ = s$ + MID$(STRING$(15, "."), 1, 14 - (LEN(s$) + l1))
ELSE
ss$ = s$
END IF
PRINT ss$; : COLOR jaune: PRINT w$: COLOR blancbrill
END SUB
DEFINT A-Z
SUB afformate (nm, m$(), erreur)
erreur = 0
i = 1: l2 = 0: co = 80
DO
l = LEN(m$(i))
IF l > 39 THEN
BEEP
COLOR , noir
CALL centre(23, rougeclair, "Un mot du texte dépasse les 39
caractères. Corrigez.")
CALL getinvi(w, w$)
erreur = 1
EXIT SUB
END IF
l2 = l2 + l
IF l2 > co THEN
PRINT : i = i - 1: l2 = 0
ELSEIF l2 = co THEN
PRINT m$(i); : l2 = 0
ELSEIF l2 = co - 1 THEN
PRINT m$(i): l2 = 0
ELSE
PRINT m$(i); " "; : l2 = l2 + 1
END IF
i = i + 1
LOOP WHILE i <= nm
PRINT
END SUB
DEFINT A-Z
SUB ajoutertexte (nbtextes, titre$(), m$(), parag$(), nbparag(),
pp$())
CALL titr(tit$)
COLOR , noir
IF nbtextes = 10 THEN
BEEP
CALL centre(23, rougeclair, "Maximum de textes : 10")
CALL getinvi(r, r$)
EXIT SUB
END IF
IF nbtextes = 0 THEN
BEEP
CALL centre(22, rougeclair, "La bibliothèque est vide.")
CALL centre(23, rougeclair, "Vous devez taper un nouveau texte.")
CALL getinvi(w, w$)
CALL efface(22, 2)
END IF
CALL centre(23, blanc, "Tapez le titre du texte.")
CALL cadre(10, 20, 40, 5, rouge)
DO
COLOR blancbrill, rouge
LOCATE 12, 30: PRINT STRING$(20, 46)
LOCATE 12, 30: CALL inputline(r$, 20)
LOOP WHILE r$ = CHR$(13)
IF r$ = CHR$(27) THEN EXIT SUB
titre$(nbtextes + 1) = r$
p = 0: f = 0
CALL titr2(tit$)
COLOR cyanclair, noir
LOCATE 1, 73: PRINT "Texte"; RTRIM$(STR$(nbtextes + 1))
LOCATE 1, 1: COLOR vertclair: PRINT titre$(nbtextes + 1)
COLOR , rouge: LOCATE 11, 1: PRINT SPACE$(80): COLOR , bleu
v1 = 5: v2 = v1 + 5
aj1:
p = p + 1
m$ = ""
aj4:
COLOR jaune, bleu
LOCATE v1 - 2, 1: PRINT "Paragraphe "; LTRIM$(RTRIM$(STR$(p)))
CALL pleinecran(r$, STRING$(80, 196), m$, v1, v2)
CALL efface(21, 3)
CALL recupere(m$, v1, v2)
IF r$ = CHR$(27) THEN
COLOR , noir
'paragraphe vide
IF m$ = CHR$(255) AND p = 1 THEN EXIT SUB
pp$(1) = "Enregistrer le texte et finir"
pp$(2) = "Modifier encore ce paragraphe"
pp$(3) = "Finir sans enregistrer"
DO
CALL fleches(21, 2, pp$(), 3, r, noir, 0, 23, 35)
LOOP WHILE r = 27
COLOR , noir: CALL efface(21, 3): COLOR , bleu
SELECT CASE r
CASE 1
'paragraphe vide
IF m$ = CHR$(255) THEN
nbtextes = nbtextes + 1
COLOR , noir
CALL efface(21, 3)
COLOR jaune: LOCATE 22, 1: PRINT "Enregistrement du texte"
SLEEP 3
EXIT SUB
END IF
CALL transforme(m$)
CALL efface(v1, 5)
CALL trouvemot(m$, m$(), nm)
LOCATE v1: CALL afformate(nm, m$(), z)
IF z = 1 THEN GOTO aj4
COLOR , noir
CALL efface(21, 3)
COLOR jaune: LOCATE 22, 1: PRINT "Enregistrement du texte"
SLEEP 3
parag$(nbtextes + 1, p) = m$
nbparag(nbtextes + 1) = p
nbtextes = nbtextes + 1
EXIT SUB
CASE 2
GOTO aj4
CASE 3
EXIT SUB
END SELECT
END IF
IF m$ = CHR$(255) THEN BEEP: m$ = "": GOTO aj4
CALL efface(v1, 5)
COLOR blancbrill, bleu
CALL transforme(m$)
CALL trouvemot(m$, m$(), nm)
LOCATE v1: CALL afformate(nm, m$(), z)
IF z = 1 THEN GOTO aj4
COLOR , noir
CALL efface(21, 3)
'paragraphe suivant ?
IF p < 5 THEN
pp$(1) = "Introduire un autre paragraphe"
pp$(2) = "Modifier encore ce paragraphe"
pp$(3) = "Enregistrer le texte et finir"
DO
CALL fleches(21, 2, pp$(), 3, r, noir, 0, 23, 35)
LOOP WHILE r = 27
SELECT CASE r
CASE 2
GOTO aj4
CASE 1
'monter les paragraphes
COLOR blanc, bleu
LOCATE 3, 1: PRINT "Paragraphe "; LTRIM$(RTRIM$(STR$(p)))
CALL efface(5, 5)
LOCATE 5: CALL afformate(nm, m$(), z)
IF p <> 1 THEN
CALL efface(13, 5)
END IF
v1 = 14: v2 = v1 + 5
parag$(nbtextes + 1, p) = m$
nbparag(nbtextes + 1) = p
f = 1
GOTO aj1
CASE 3
CALL efface(21, 3)
COLOR jaune: LOCATE 22, 1: PRINT "Enregistrement du texte"
SLEEP 2
parag$(nbtextes + 1, p) = m$
nbparag(nbtextes + 1) = p
nbtextes = nbtextes + 1
EXIT SUB
END SELECT
ELSE
pp$(1) = "Modifier encore ce paragraphe"
pp$(2) = "Enregistrer le texte et finir"
DO
CALL fleches(22, 2, pp$(), 2, r, noir, 0, 23, 35)
LOOP WHILE r = 27
SELECT CASE r
CASE 1
GOTO aj4
CASE 2
CALL efface(21, 3)
COLOR jaune: LOCATE 22, 1: PRINT "Enregistrement du texte"
SLEEP 3
parag$(nbtextes + 1, p) = m$
nbparag(nbtextes + 1) = p
nbtextes = nbtextes + 1
EXIT SUB
END SELECT
END IF
END SUB
DEFINT A-Z
SUB attendre (tx!)
tx! = tx! * 2
debut! = TIMER
DO
fin! = TIMER
LOOP WHILE fin! - debut! < tx!
END SUB
DEFINT A-Z
SUB cadre (v%, h%, l%, nli%, c)
'c est l'intérieur
'le fond est bleu
v2 = v
'ombré
COLOR , 0 'noir
LOCATE v + 1
FOR i = 1 TO nli - 1
LOCATE , h + l + 2
PRINT " "
NEXT
LOCATE v + nli - 1, h + 1
PRINT STRING$(l + 1, 223)
'cadre
COLOR c, bleu
LOCATE v2, h
PRINT STRING$(l + 2, 220)
FOR i = 1 TO nli - 2
v2 = v2 + 1: LOCATE v2, h
PRINT STRING$(l + 2, 219)
NEXT
COLOR , bleu '=== fond de l'écran
LOCATE v2 + 1, h: PRINT CHR$(223)
COLOR , 0
LOCATE v2 + 1, h + 1: PRINT STRING$(l + 1, 223)
COLOR blancbrill
END SUB
DEFINT A-Z
SUB centre (v, coul, ph$)
COLOR coul
LOCATE v, INT(41 - LEN(ph$) / 2): PRINT ph$
COLOR 15
END SUB
DEFINT A-Z
SUB choixtexte (nbtextes, titre$(), nbparag(), pp$(), parag$())
IF nbtextes = 0 THEN
CALL enregistrer(nbtextes, titre$(), nbparag(), parag$())
RUN "gestion"
END IF
CALL titr(tit$)
v2 = 8
w$ = LTRIM$(STR$(nbtextes)) + " texte": IF nbtextes > 1 THEN w$ = w$
+ "s"
w$ = w$ + " dans la bibliothèque"
CALL cadre(v2 - 4, 16, 45, 3, blanc)
COLOR , blanc
CALL centre(v2 - 3, noir, w$)
COLOR , bleu
FOR i = 1 TO nbtextes: pp$(i) = "Texte" + STR$(i): NEXT
COLOR cyanclair
FOR j = 1 TO nbtextes
LOCATE v2 - 1 + j, 16
PRINT pp$(j)
LOCATE v2 - 1 + j, 55 - LEN(STR$(nbparag(j)))
PRINT "("; MID$(STR$(nbparag(j)), 2); " parag.)"
NEXT j
END SUB
DEFINT A-Z
SUB efface (v, hk)
IF v > 20 THEN COLOR , noir
LOCATE v, 1: FOR i = 1 TO hk: PRINT SPACE$(80): NEXT: LOCATE v, 1
END SUB
DEFINT A-Z
SUB effacer (nbtextes, titre$(), m$(), parag$(), nbparag(), pp$())
DIM p2$(2)
DO '+++++++
IF nbtextes = 0 THEN
CALL enregistrer(nbtextes, titre$(), nbparag(), parag$())
RUN "gestion"
END IF
CALL titr(tit$)
CALL choixtexte(nbtextes, titre$(), nbparag(), pp$(), parag$())
v = 8
CALL cadre(v - 1, 26, 22, nbtextes + 2, marron)
COLOR blanc, marron
FOR j = 1 TO nbtextes
LOCATE v - 1 + j, 28
PRINT titre$(j)
NEXT j
COLOR , vert: LOCATE 20: PRINT SPACE$(80)
COLOR blanc, noir
PRINT SPACE$(80)
pp$(3) = "La bibliothèque"
pp$(1) = "Un texte"
pp$(2) = "Un paragraphe"
CALL fleches(21, 2, pp$(), 3, rx, noir, 0, 23, 23)
IF rx = 27 THEN EXIT SUB
CALL efface(21, 3)
IF rx = 3 THEN
GOSUB creer
EXIT SUB
END IF
DO
DEF SEG = 0
POKE &H417, (PEEK(&H417) OR &h30)'numérique
POKE &H417, (PEEK(&H417) OR &H40) 'MAJ
DEF SEG
COLOR blanc
LOCATE 22, 1: PRINT "Numéro du texte : ";
CALL inputline(r$, 2)
IF r$ = CHR$(27) THEN EXIT SUB
t = VAL(r$)
LOOP WHILE t < 1 OR t > nbtextes
IF nbparag(t) = 1 THEN rx = 1
ff = -1: IF rx = 1 THEN ff = 0
CALL listeecran(nbtextes, titre$(), nbparag(), parag$(), m$(), t)
ff = 0
COLOR , noir
IF rx = 2 THEN
DO
DEF SEG = 0
POKE &H417, (PEEK(&H417) OR &h30)'numérique
POKE &H417, (PEEK(&H417) OR &H40) 'MAJ
DEF SEG
LOCATE 23, 1: COLOR blanc: PRINT "Numéro du paragraphe : ";
CALL inputline(r$, 2)
IF r$ = CHR$(27) THEN EXIT SUB
p = VAL(r$)
LOOP WHILE p < 1 OR p > nbparag(t)
END IF
DEF SEG = 0
POKE &H417, (PEEK(&H417) AND &H9F)'non numérique
POKE &H417, (PEEK(&H417) AND &HBF) 'minuscules
DEF SEG
DO
LOCATE 23: PRINT SPACE$(80)
LOCATE 23, 1: COLOR blanc: PRINT "Effacement "; : CALL ouinon(r$)
IF ASC(r$) = 27 OR UCASE$(r$) = "N" THEN GOTO effac3
LOOP WHILE UCASE$(r$) <> "O"
SELECT CASE rx
CASE 1
'_efface texte & titre_
nbtextes = nbtextes - 1
IF t < nbtextes + 1 THEN
FOR i = t TO nbtextes
FOR p = 1 TO 5
parag$(i, p) = parag$(i + 1, p)
NEXT p
NEXT i
FOR i = t TO nbtextes
titre$(i) = titre$(i + 1)
nbparag(i) = nbparag(i + 1)
NEXT
END IF
CASE 2
'_effacer paragraphe_
IF p < nbparag(t) THEN
FOR i = p TO nbparag(t) - 1
parag$(t, i) = parag$(t, i + 1)
NEXT
END IF
nbparag(t) = nbparag(t) - 1
END SELECT
effac3:
CALL entree_echap(r)
IF r = 27 THEN EXIT SUB
LOOP '+++++
creer:
CALL titr(tit$)
BEEP
CALL cadre(5, 19, 41, 5, blanc)
COLOR , blanc
CALL centre(7, noir, "Effacer tous les textes.")
COLOR , bleu
CALL centre(12, rougeclair, "Vous confirmez ?")
p2$(1) = "oui"
p2$(2) = "non"
CALL fleches(15, 38, p2$(), 2, r, rouge, 1, 23, 35)
SELECT CASE r
CASE 0
COLOR , bleu: CLS : RUN "gestion"
CASE 1
CLOSE : KILL lecture$
nbtextes = 0
OPEN lecture$ FOR OUTPUT AS #1
PRINT #1, 0
CLOSE
RUN "gestion"
END SELECT
RETURN
END SUB
DEFINT A-Z
SUB enregistrer (nbtextes, titre$(), nbparag(), parag$())
OPEN lecture$ FOR OUTPUT AS #1
'nbtextes
PRINT #1, nbtextes
'titres
FOR i = 1 TO nbtextes
PRINT #1, titre$(i)
NEXT
'nbparag
FOR i = 1 TO nbtextes
PRINT #1, nbparag(i)
NEXT
'paragraphe$
FOR i = 1 TO nbtextes
FOR j = 1 TO nbparag(i)
m$ = RTRIM$(LTRIM$(parag$(i, j)))
PRINT #1, m$
NEXT j
NEXT i
CLOSE
END SUB
DEFINT A-Z
SUB entree (rr, y, z)
COLOR , y
CALL efface(23, 1)
COLOR , noir
CALL centre(23, blanc, rt$)
DEF SEG = 0
POKE 1050, PEEK(1052)
DEF SEG
r$ = ""
DO
r$ = INKEY$
' Obtient l'emplacement de la souris et l'état des boutons.
MousePoll row, col, lButton, rButton
IF lButton THEN
r$ = CHR$(13)
CALL attendre(.3)
END IF
LOOP WHILE r$ = ""
IF LEN(r$) < 2 THEN rr = ASC(r$) ELSE rr = ASC(RIGHT$(r$, 1))
COLOR blancbrill
COLOR , z
END SUB
DEFINT A-Z
SUB entree_echap (rr)
COLOR , noir
LOCATE 23, 1: PRINT SPACE$(80)
CALL centre(23, blanc, rt$ + " = Continuer" + SPACE$(20) + es$)
DEF SEG = 0
POKE 1050, PEEK(1052)
DEF SEG
r$ = ""
DO
r$ = INKEY$
' Obtient l'emplacement de la souris et l'état des boutons.
MousePoll v_mouse, h_mouse, lButton, rButton
'LOCATE 22, 1: PRINT "Position de la souris : "; v_mouse; ", ";
h_mouse '===
IF lButton THEN
IF v_mouse = 23 AND (h_mouse >= 53 AND h_mouse <= 63) THEN
r$ = CHR$(27)
CALL attendre(.3)
ELSE
r$ = CHR$(13)
CALL attendre(.3)
END IF
END IF
LOOP WHILE r$ = ""
IF LEN(r$) < 2 THEN rr = ASC(r$) ELSE rr = ASC(RIGHT$(r$, 1))
COLOR blancbrill
END SUB
DEFINT A-Z
SUB epuration (mo$)
F1 = 0
IF LEN(mo$) = 1 THEN EXIT SUB
IF RIGHT$(mo$, 3) = "..." THEN mo$ = MID$(mo$, 1, LEN(mo$) - 3)
az = ASC(RIGHT$(mo$, 1))
IF az = 33 OR az = 34 OR az = 39 OR az = 41 OR az = 44 OR az = 45 OR
az = 46 OR az = 58 OR az = 59 OR az = 63 THEN mo$ = MID$(mo$, 1,
LEN(mo$) - 1): F1 = 1
az = ASC(LEFT$(mo$, 1))
IF F1 = 0 AND (az = 34 OR az = 39 OR az = 40 OR az = 44 OR az = 45
OR az = 46 OR az = 58 OR az = 59) THEN mo$ = MID$(mo$, 2, LEN(mo$) -
1): GOTO epur2
IF az = 34 OR az = 39 OR az = 40 OR az = 44 OR az = 45 OR az = 46 OR
az = 58 OR az = 59 THEN mo$ = MID$(mo$, 2, LEN(mo$) - 1)
epur2:
IF MID$(mo$, 2, 1) = "'" THEN mo$ = MID$(mo$, 3)
IF mo$ = "" THEN mo$ = " "
END SUB
DEFINT A-Z
SUB exporter (texte$, nbtextes, titre$(), parag$(), nbparag())
CALL titr(tit$)
'Obtient le lecteur en cours
curdrive$ = LEFT$(CURDIR$, 2)
CALL cadre(7, 5, 70, 9, blanc)
COLOR , blanc
CALL centre(9, noir, "Les textes vont être exportés en ASCII sous le
nom : " + texte$)
CALL centre(11, noir, "au niveau supérieur du disque (racine).")
CALL centre(13, noir, "Vous pourrez les récupérer avec un traitement
de textes.")
CALL entree_echap(r)
IF r = 27 THEN EXIT SUB
CALL efface(23, 1)
CALL centre(23, blanc, "Exportation des textes")
OPEN curdrive$ + "\" + texte$ FOR OUTPUT AS #2
FOR t = 1 TO nbtextes
PRINT #2, titre$(t)
FOR j = 1 TO nbparag(t)
PRINT #2, parag$(t, j)
NEXT j
PRINT #2, CHR$(13)
NEXT t
CLOSE #2
SLEEP 2
END SUB
DEFINT A-Z
SUB fleches (v%, h%, w$(), np%, r%, coul, drap, v2, h3)
'LOCATE 19, 1: PRINT v2, h3
'v2 et h3 sont la ligne colonne des fleches
DIM p$(np)
souris = 0
LOCATE , , 0
FOR i = 1 TO np: p$(i) = w$(i): NEXT
l2 = 0
FOR i = 1 TO np
l1 = LEN(p$(i)): IF l2 < l1 THEN l2 = l1
NEXT
FOR i = 1 TO np
p$(i) = p$(i) + SPACE$(l2 - LEN(p$(i)))
NEXT
'souris
v_mini = v: v_maxi = v_mini + np - 1
h_mini = h - 1: h_maxi = LEN(p$(1)) + h_mini + 1
'LOCATE 22, 1: PRINT v_mini, v_maxi, h_mini, h_maxi '===
'cadre
IF drap = 1 THEN
CALL cadre(v - 1, h - 3, l2 + 4, np + 2, coul)
END IF
flag = 0
IF v2 = 23 AND h3 = 35 THEN
COLOR , noir
CALL centre(23, blanc, gg$)
ELSEIF v2 = 23 AND h3 = 23 THEN
COLOR , noir
CALL centre(23, blanc, gg$ + SPACE$(13) + es$)
flag = 2
END IF
COLOR blancbrill, coul
LOCATE v
FOR i = 1 TO np
LOCATE , h - 1: PRINT " "; p$(i); " "
NEXT
vt = v - 1
LOCATE v, h - 1
IF couleur = 1 THEN COLOR coul, blanc ELSE COLOR noir, blanc
PRINT " "; p$(1); " "
COLOR blancbrill, coul
DO
DEF SEG = 0
POKE &H417, (PEEK(&H417) AND &H9F)'non numérique
POKE 1050, PEEK(1052)
DEF SEG
DO
r$ = INKEY$
' Obtient l'emplacement de la souris et l'état des boutons.
MousePoll v_mouse, h_mouse, lButton, rButton
IF lButton THEN
'pointé l'article
IF v_mouse >= v_mini AND v_mouse <= v_maxi THEN
IF h_mouse >= h_mini AND h_mouse <= h_maxi THEN
LOCATE v_mini
FOR i = 1 TO np
LOCATE , h_mini: PRINT " "; p$(i); " "
NEXT
calcul = v_mouse - v_mini + 1
LOCATE v_mouse, h_mini
COLOR coul, blancbrill
PRINT " "; p$(calcul); " "
CALL attendre(.3)
r = calcul
v = v_mouse
EXIT SUB
ELSE
BEEP
END IF
ELSEIF v_mouse = v2 AND h_mouse = h3 THEN
rr = 72 'fleche haut
souris = 1
CALL attendre(.2)
EXIT DO
ELSEIF v_mouse = v2 AND h_mouse = h3 + 2 THEN
rr = 80 'fleche bas
souris = 1
CALL attendre(.2)
EXIT DO
ELSEIF v_mouse = v2 AND (h_mouse >= h3 + 9 AND h_mouse <= h3 + 11)
THEN
rr = 13 'entree
souris = 1
CALL attendre(.3)
EXIT DO
ELSEIF v_mouse = v2 AND (h_mouse >= h3 + 25 AND h_mouse <= h3 + 35)
AND flag = 2 THEN
r = 27 'echap
CALL attendre(.3)
EXIT SUB
ELSE
BEEP
END IF
END IF
LOOP WHILE r$ = ""
IF souris = 0 AND LEN(r$) < 2 THEN
rr = ASC(r$)
ELSEIF souris = 0 THEN
rr = ASC(RIGHT$(r$, 1))
END IF
IF rr = 27 THEN r = 27: EXIT SUB
LOCATE v, h - 1: PRINT " "; p$(v - vt); " "
IF rr = 72 THEN v = v - 1: IF v = vt THEN v = vt + np
IF rr = 80 THEN v = v + 1: IF v = vt + np + 1 THEN v = vt + 1
LOCATE v, h - 1
IF couleur = 1 THEN COLOR coul, blanc ELSE COLOR noir, blanc
PRINT " "; p$(v - vt); " "
COLOR blancbrill, coul
LOOP WHILE rr <> 13
r = v - vt
COLOR blancbrill
END SUB
DEFINT A-Z
SUB getinvi (r, r$)
DEF SEG = 0
POKE 1050, PEEK(1052)
DEF SEG
DO
r$ = INKEY$
LOOP WHILE r$ = ""
IF LEN(r$) < 2 THEN r = ASC(r$) ELSE r = ASC(RIGHT$(r$, 1))
END SUB
DEFINT A-Z
SUB impression (parag$(), nbparag(), t)
FOR o = 1 TO nbparag(t)
r$ = parag$(t, o)
l = 1: colonne = 79
DO
imp3:
IF LEN(r$) <= colonne THEN PRINT #3, r$: EXIT DO
z = INSTR(l, r$, " ")
IF z > colonne OR z = 0 THEN
PRINT #3, MID$(r$, 1, r)
r$ = MID$(r$, r + 1)
l = 1
GOTO imp3
END IF
r = z
l = z + 1
LOOP
NEXT o
END SUB
DEFINT A-Z
SUB imprime2 (s$, w$)
w$ = (".(" + w$ + ")")
l1 = LEN(w$)
l2 = LEN(s$) + l1
IF l2 > 14 THEN
ss$ = MID$(s$, 1, 14 - l1)
ELSEIF l2 < 14 THEN
ss$ = s$ + MID$(STRING$(15, "."), 1, 14 - (LEN(s$) + l1))
ELSE
ss$ = s$
END IF
PRINT #3, ss$; w$; " ";
END SUB
DEFINT A-Z
SUB imprimer (nbtextes, titre$(), parag$(), nbparag(), pp$())
DO
IM = 0
CALL choixtexte(nbtextes, titre$(), nbparag(), pp$(), parag$())
IF nbtextes > 1 THEN
i = nbtextes + 1: titre$(i) = "Tous"
CALL fleches(8, 28, titre$(), i, r, marron, 1, 23, 23)
IF r = 27 THEN EXIT SUB
t = r: IF r = nbtextes + 1 THEN IM = -1
ELSE
LOCATE 8, 28: PRINT titre$(1)
t = 1
END IF
CALL efface(23, 1)
CALL centre(23, blanc, "Tapez " + rt$ + " quand l'imprimante sera
prête.")
DO
r$ = INKEY$
' Obtient l'emplacement de la souris et l'état des boutons.
MousePoll row, col, lButton, rButton
IF lButton THEN
r$ = CHR$(13)
CALL attendre(.3)
END IF
LOOP WHILE r$ = ""
IF r$ = CHR$(27) THEN EXIT SUB
CALL efface(23, 1)
OPEN "lpt1:" FOR OUTPUT AS #3
'PRINT #3, CHR$(27); "@" ===
WIDTH #3, 80
IF NOT IM THEN
CALL impression(parag$(), nbparag(), t)
ELSE
FOR t = 1 TO nbtextes
COLOR blanc: LOCATE 23, 30: PRINT "Impression texte n°"; t
PRINT #3, STRING$(79, "-")
PRINT #3, titre$(t); " - Texte"; t; "-"
CALL impression(parag$(), nbparag(), t)
NEXT t
PRINT #3, STRING$(79, "-")
END IF
PRINT #3, CHR$(12)
CLOSE #3
CLS
IF IM THEN EXIT SUB
CALL titr(tit$)
CALL entree_echap(r)
IF r = 27 THEN EXIT SUB
LOOP
END SUB
DEFINT A-Z
SUB inputline (r$, nl)
DIM re$(30)
LOCATE , , 1
DEF SEG = 0
POKE 1050, PEEK(1052)
DEF SEG
FOR ii = 1 TO nl + 1
inpdebut:
COLOR blancbrill
IF ii <= 0 THEN ii = 1
DO
re$(ii) = INKEY$
LOOP WHILE re$(ii) = ""
IF re$(ii) = CHR$(27) THEN r$ = CHR$(27): GOTO inpfin
IF LEN(re$(ii)) = 2 THEN z2 = ASC(RIGHT$(re$(ii), 1)): IF ii > 1 AND
(z2 = 75 OR z2 = 83 OR z2 = 15) THEN PRINT CHR$(29); " "; CHR$(29);
: ii = ii - 1: z2 = 0: GOTO inpdebut
IF ASC(re$(ii)) = 13 THEN EXIT FOR
IF ii > 1 AND ASC(re$(ii)) = 8 THEN PRINT CHR$(29); " "; CHR$(29); :
ii = ii - 1: GOTO inpdebut
IF re$(ii) = "*" THEN GOTO inpdebut
IF ASC(re$(ii)) < 32 OR ASC(re$(ii)) > 165 THEN GOTO inpdebut
IF ii = nl + 1 THEN BEEP: GOTO inpdebut
PRINT re$(ii);
NEXT ii
PRINT
r$ = "": FOR JJ = 1 TO ii - 1: r$ = r$ + re$(JJ): NEXT
r$ = LTRIM$(r$): r$ = RTRIM$(r$)
IF r$ = "" THEN r$ = CHR$(13)
inpfin:
LOCATE , , 0
END SUB
DEFINT A-Z
SUB inserer (nbtextes, titre$(), m$(), parag$(), nbparag(), pp$())
IF nbtextes > 1 THEN
CALL choixtexte(nbtextes, titre$(), nbparag(), pp$(), parag$())
CALL fleches(8, 28, titre$(), nbtextes, r, marron, 1, 23, 23)
IF r = 27 THEN EXIT SUB
t = r
ELSE
t = 1
END IF
IF nbparag(t) = 5 THEN
COLOR , noir
BEEP
LOCATE 23, 1: PRINT SPACE$(80)
CALL centre(23, rougeclair, "5 paragraphes maximum par texte !")
CALL getinvi(r, r$)
EXIT SUB
END IF
ff = -1: CALL listeecran(nbtextes, titre$(), nbparag(), parag$(),
m$(), t)
ff = 0
DO '+++++++++++++++
insere0:
COLOR , vert: LOCATE 20: PRINT SPACE$(80): COLOR , noir
i = 3: IF nbparag(t) = 1 THEN i = 2
flag = 0
pp$(1) = "Au début du texte": pp$(2) = "A la fin du texte": pp$(3) =
"Entre deux parag."
CALL efface(21, 3)
CALL fleches(21, 2, pp$(), i, r, noir, 0, 23, 35)
CALL efface(21, 3)
SELECT CASE r
CASE 27
EXIT SUB
CASE 3
DEF SEG = 0
POKE &H417, (PEEK(&H417) OR &h30)'numérique
POKE &H417, (PEEK(&H417) OR &H40) 'MAJ
DEF SEG
DO
LOCATE 22, 1: COLOR blanc: PRINT "Avant quel paragraphe : ";
CALL inputline(r$, 2)
IF r$ = CHR$(27) THEN EXIT SUB
LOOP WHILE VAL(r$) < 1 OR VAL(r$) > nbparag(t)
DEF SEG = 0
POKE &H417, (PEEK(&H417) AND &H9F)'non numérique
POKE &H417, (PEEK(&H417) AND &HBF) 'minuscules
DEF SEG
IF r$ = CHR$(27) THEN GOTO insere0
p = VAL(r$): flag = 1
CASE 1
p = 1: flag = 1
CASE 2
p = nbparag(t) + 1
END SELECT
CALL titr2(tit$)
m$ = ""
ins2:
COLOR cyanclair, noir
LOCATE 1, 73: PRINT "Texte"; RTRIM$(STR$(t))
LOCATE 1, 1: COLOR vertclair: PRINT titre$(t)
COLOR jaune, bleu: LOCATE 3, 1: PRINT "Paragraphe"; p
CALL pleinecran(r$, STRING$(80, 196), m$, 9, 14)
CALL efface(21, 3)
CALL recupere(m$, 9, 14)
IF r$ = CHR$(27) THEN
COLOR , noir
'paragraphe vide
IF m$ = CHR$(255) THEN EXIT SUB
pp$(1) = "Enregistrer et finir"
pp$(2) = "Modifier encore ce paragraphe"
pp$(3) = "Finir sans enregistrer"
DO
CALL fleches(21, 2, pp$(), 3, r, noir, 0, 23, 35)
LOOP WHILE r = 27
COLOR , noir: CALL efface(21, 3): COLOR , bleu
SELECT CASE r
CASE 1
CALL transforme(m$)
CALL efface(9, 5)
CALL trouvemot(m$, m$(), nm)
LOCATE 9: CALL afformate(nm, m$(), z)
IF z = 1 THEN GOTO ins2
COLOR , noir
CALL efface(21, 3)
COLOR jaune: LOCATE 22, 1: PRINT "Enregistrement du texte"
SLEEP 3
nbparag(t) = nbparag(t) + 1
IF flag = 0 THEN
parag$(t, p) = m$
ELSE
FOR i = nbparag(t) - 1 TO p STEP -1
parag$(t, i + 1) = parag$(t, i)
NEXT
parag$(t, p) = m$
END IF
EXIT SUB
CASE 2
GOTO ins2
CASE 3
EXIT SUB
END SELECT
END IF
IF m$ = CHR$(255) THEN BEEP: m$ = "": GOTO ins2
CALL efface(9, 5)
CALL transforme(m$)
CALL trouvemot(m$, m$(), nm)
LOCATE 9: CALL afformate(nm, m$(), z)
IF z = 1 THEN GOTO ins2
COLOR , noir
pp$(1) = "Enregistrer le paragraphe"
pp$(2) = "Modifier encore ce paragraphe"
pp$(3) = "Finir sans enregistrer"
DO
CALL fleches(21, 2, pp$(), 3, r, noir, 0, 23, 35)
LOOP WHILE r = 27
COLOR , noir: CALL efface(21, 3): COLOR , bleu
SELECT CASE r
CASE 1
nbparag(t) = nbparag(t) + 1
IF flag = 0 THEN
parag$(t, p) = m$
ELSE
FOR i = nbparag(t) - 1 TO p STEP -1
parag$(t, i + 1) = parag$(t, i)
NEXT
parag$(t, p) = m$
END IF
CASE 2
GOTO ins2
CASE 3
EXIT SUB
END SELECT
CALL listeecran(nbtextes, titre$(), nbparag(), parag$(), m$(), t)
IF nbparag(t) = 5 THEN CALL entree(r, noir, noir): EXIT SUB
CALL entree_echap(r)
IF r = 27 THEN EXIT SUB
LOOP '+++++++++++
END SUB
DEFINT A-Z
SUB lire (nbtextes, titre$(), parag$(), nbparag(), s$(), s%(), m$(),
te$(), r%(), pp$())
CALL titr(tit$)
pp$(1) = "Textes": pp$(2) = "Liste des mots"
CALL fleches(11, 33, pp$(), 2, r, rouge, 1, 23, 23)
CALL efface(11, 3)
SELECT CASE r
CASE 27
EXIT SUB
CASE 1 '+++++++++++++
IF nbtextes = 1 THEN
CALL listeecran(1, titre$(), nbparag(), parag$(), m$(), 1)
CALL entree(w, noir, noir)
EXIT SUB
END IF
DO
CALL choixtexte(nbtextes, titre$(), nbparag(), pp$(), parag$())
i = nbtextes + 1
IF nbtextes = 1 THEN i = nbtextes ELSE titre$(i) = "Tous"
CALL fleches(8, 28, titre$(), i, r, marron, 1, 23, 23)
IF r = 27 THEN EXIT DO
f = 0: t = r: IF r = nbtextes + 1 THEN f = -1
IF NOT f THEN
CALL listeecran(nbtextes, titre$(), nbparag(), parag$(), m$(), t)
ELSE
FOR t = 1 TO nbtextes
CALL listeecran(nbtextes, titre$(), nbparag(), parag$(), m$(), t)
CALL entree_echap(r)
IF r = 27 THEN EXIT DO
NEXT t
EXIT DO
END IF
CALL entree_echap(r)
IF r = 27 THEN EXIT DO
COLOR , noir: CLS
LOOP
CASE 2 '+++++++
GOSUB listemots
FOR i = 1 TO nm: s%(i) = 0: NEXT
END SELECT
EXIT SUB
listemots:
tit$ = "Liste des mots": CALL titr(tit$)
te = 1
COLOR blanc, noir: LOCATE 23, 25: PRINT "Textes restant à lire :"
FOR t = 1 TO nbtextes
FOR p = 1 TO nbparag(t)
m$ = parag$(t, p)
LOCATE 23, 49: COLOR jaune: PRINT nbtextes + 1 - t; : COLOR
blancbrill: PRINT " "
CALL trouvemot(m$, m$(), nm)
IF nm > 3000 THEN nm = 3000
FOR i = 1 TO nm
mo$ = m$(i)
CALL epuration(mo$)
IF LEN(mo$) = 1 AND ASC(mo$) < 64 THEN 5080
CALL epuration(mo$)
te$(te) = mo$: r%(te) = te: te = te + 1
5080 NEXT i
NEXT p
NEXT t
COLOR , bleu
CALL centre(12, vertclair, LTRIM$(STR$(te)) + " mots dans la
bibliothèque.")
COLOR , noir
LOCATE 23, 1: PRINT SPACE$(80)
CALL centre(23, blanc, "Tri des mots...")
'tri shell-metzner
n = te: m = n
5130 m = INT(m / 2): K = n - m: j = 1
IF m = 0 THEN 5220
5150 i = j
5160 l1 = i + m: I2 = r%(i): l2 = r%(l1)
IF te$(I2) <= te$(l2) THEN 5200
SWAP r%(i), r%(l1)
i = i - m: IF i >= 1 THEN 5160
5200 j = j + 1: IF j > K THEN 5130
GOTO 5150
5220 nm = 1: s$(nm) = te$(r%(1))
FOR i = 2 TO te
IF te$(r%(i)) = s$(nm) THEN s%(nm) = s%(nm) + 1: GOTO 5240
nm = nm + 1: s$(nm) = te$(r%(i))
5240 NEXT
nm = nm - 1
affiche:
CALL titr(tit$)
pp$(1) = "Ecran": pp$(2) = "Imprimante"
'CALL a
CALL fleches(11, 35, pp$(), 2, r, rouge, 1, 23, 23)
IF r = 27 THEN RETURN
IF r = 1 THEN
CALL titr(tit$)
GOSUB affcol
GOTO affiche
END IF
COLOR , noir: LOCATE 23, 1: PRINT SPACE$(80)
CALL centre(23, blanc, "Tapez " + rt$ + " quand l'imprimante est
prête.")
DO
r$ = INKEY$
' Obtient l'emplacement de la souris et l'état des boutons.
MousePoll row, col, lButton, rButton
IF lButton THEN
r$ = CHR$(13)
CALL attendre(.3)
END IF
LOOP WHILE r$ = ""
IF r$ = CHR$(27) THEN GOTO affiche
LOCATE 23, 1: PRINT SPACE$(80)
OPEN "lpt1:" FOR OUTPUT AS #3
'PRINT #3, CHR$(27); "@" ===
WIDTH #3, 80
PRINT #3, STRING$(79, "-")
PRINT #3, "Liste des mots :"
PRINT #3, STRING$(79, "-")
FOR i = 2 TO nm STEP 5
IF i = nm THEN GOTO impfin
w$ = LTRIM$(STR$(s%(i) + 1))
s$ = s$(i)
CALL imprime2(s$, w$)
IF i = nm THEN GOTO impfin
w$ = LTRIM$(STR$(s%(i + 1) + 1))
s$ = s$(i + 1)
CALL imprime2(s$, w$)
IF i = nm THEN GOTO impfin
w$ = LTRIM$(STR$(s%(i + 2) + 1))
s$ = s$(i + 2)
CALL imprime2(s$, w$)
IF i = nm THEN GOTO impfin
w$ = LTRIM$(STR$(s%(i + 3) + 1))
s$ = s$(i + 3)
CALL imprime2(s$, w$)
IF i = nm THEN GOTO impfin
w$ = LTRIM$(STR$(s%(i + 4) + 1))
s$ = s$(i + 4)
CALL imprime2(s$, w$)
CALL centre(23, vertclair, LTRIM$(STR$(i)) + " mots sur" + STR$(nm))
w$ = INKEY$: IF w$ = CHR$(27) THEN PRINT #3, CHR$(10); "Impression
interrompue": CLOSE #3: GOTO affiche
NEXT
impfin:
PRINT #3, CHR$(12)
CLOSE #3
RETURN
affcol:
'affichage en colonne
h = 1: mot = 2: e = 1
FOR i = 1 TO nm
FOR y = 1 TO 16
LOCATE 3 + y, h
CALL affiche(s$(mot), LTRIM$(STR$(s%(mot) + 1)))
IF mot > nm THEN CALL entree(r, noir, noir): RETURN
mot = mot + 1
NEXT y
h = h + 16
IF i = 5 * e THEN
CALL entree(r, noir, noir)
IF r = 27 THEN RETURN ELSE CALL titr(tit$): h = 1: e = e + 1
END IF
NEXT i
CALL entree(r, noir, noir)
RETURN
END SUB
DEFINT A-Z
SUB listeecran (nbtextes, titre$(), nbparag(), parag$(), m$(), t)
CALL titr(tit$)
COLOR cyanclair, noir
w$ = "texte " + LTRIM$(STR$(t))
LOCATE 1, 81 - LEN(w$): PRINT w$
COLOR vertclair
LOCATE 1, 1: PRINT titre$(t)
COLOR blancbrill, bleu
nl = 16: LOCATE 2, 1
FOR ir = 1 TO nbparag(t)
m$ = parag$(t, ir)
IF nl < 6 THEN
nl = 16
CALL entree(r, noir, noir)
LOCATE 23, 1: PRINT SPACE$(80)
VIEW PRINT 3 TO 18: COLOR , bleu: CLS 2: VIEW PRINT
LOCATE 2, 1
END IF
PRINT : PRINT
CALL trouvemot(m$, m$(), nm)
CALL afformate(nm, m$(), z)
nl = nl - (INT(LEN(m$) / 80) + 2)
NEXT ir
END SUB
DEFINT A-Z
SUB modifier (nbtextes, titre$(), m$(), parag$(), nbparag(), pp$())
DO '++++++++++++
CALL choixtexte(nbtextes, titre$(), nbparag(), pp$(), parag$())
IF nbtextes > 1 THEN
CALL fleches(8, 28, titre$(), nbtextes, r, marron, 1, 23, 23)
IF r = 27 THEN EXIT SUB
ELSE
r = 1
END IF
t = r
v = r + 7
COLOR , noir
LOCATE 23, 1: PRINT SPACE$(80)
CALL centre(23, blanc, "Modifiez le titre puis " + rt$)
DO
m$ = titre$(t)
COLOR jaune: CALL pleineligne(r$, m$, 19, v, 28): COLOR blancbrill
m$ = RTRIM$(m$): m$ = LTRIM$(m$)
LOOP WHILE m$ = ""
IF r$ = CHR$(27) THEN EXIT SUB
titre$(t) = m$
' IF nbparag(t) = 1 THEN p = 1: GOTO 4090
FOR p = 1 TO nbparag(t)
GOSUB modif
NEXT p
CALL titr(tit$)
CALL entree_echap(r)
IF r = 27 THEN EXIT SUB
LOOP '++++++++++++
modif:
m$ = parag$(t, p)
modi:
CALL titr2(tit$)
COLOR cyanclair, noir
LOCATE 1, 73: PRINT "Texte"; RTRIM$(STR$(t))
LOCATE 1, 1: COLOR vertclair: PRINT titre$(t)
COLOR jaune, bleu: LOCATE 3, 1: PRINT "Paragraphe"; p
CALL pleinecran(r$, STRING$(80, 196), m$, 9, 14)
CALL efface(21, 3)
CALL recupere(m$, 9, 14)
IF r$ = CHR$(27) THEN
COLOR , noir
'paragraphe vide
IF m$ = CHR$(255) THEN EXIT SUB
pp$(1) = "Enregistrer et finir"
pp$(2) = "Modifier encore ce paragraphe"
pp$(3) = "Finir sans enregistrer"
DO
CALL fleches(21, 2, pp$(), 3, r, noir, 0, 23, 35)
LOOP WHILE r = 27
COLOR , noir: CALL efface(21, 3): COLOR , bleu
SELECT CASE r
CASE 1
CALL transforme(m$)
CALL efface(9, 5)
CALL trouvemot(m$, m$(), nm)
COLOR blancbrill
LOCATE 9: CALL afformate(nm, m$(), z)
IF z = 1 THEN GOTO modi
COLOR , noir
CALL efface(21, 3)
COLOR jaune: LOCATE 22, 1: PRINT "Enregistrement du texte"
SLEEP 3
parag$(t, p) = m$
EXIT SUB
CASE 2
GOTO modi
CASE 3
EXIT SUB
END SELECT
END IF
IF m$ = CHR$(255) THEN BEEP: GOTO modif
CALL efface(9, 5)
CALL transforme(m$)
CALL trouvemot(m$, m$(), nm)
LOCATE 9: CALL afformate(nm, m$(), z)
IF z = 1 THEN GOTO modi
COLOR , noir
pp$(1) = "Enregistrer le paragraphe"
pp$(2) = "Modifier encore ce paragraphe"
pp$(3) = "Finir sans enregistrer"
DO
CALL fleches(21, 2, pp$(), 3, r, noir, 0, 23, 35)
LOOP WHILE r = 27
COLOR , noir: CALL efface(21, 3): COLOR , bleu
SELECT CASE r
CASE 1
COLOR , noir
CALL efface(21, 3)
COLOR jaune: LOCATE 22, 1: PRINT "Enregistrement du texte"
SLEEP 3
parag$(t, p) = m$
CASE 2
GOTO modi
CASE 3
EXIT SUB
END SELECT
RETURN
END SUB
DEFINT A-Z
SUB ouinon (r$)
h = POS(0)
v = CSRLIN
LOCATE v, h
COLOR blanc: PRINT "["; : COLOR jaune: PRINT "O"; : COLOR blanc:
PRINT "]ui ou ["; : COLOR jaune: PRINT "N"; : COLOR blanc: PRINT
"]on"
DO
r$ = ""
DO
r$ = INKEY$
' Obtient l'emplacement de la souris et l'état des boutons.
MousePoll v_mouse, h_mouse, lButton, rButton
IF lButton THEN
IF v_mouse = v AND (h_mouse >= h AND h_mouse <= h + 5) THEN
r$ = "o"
CALL attendre(.3)
ELSEIF v_mouse = v AND (h_mouse >= h + 10 AND h_mouse <= h + 14)
THEN
r$ = "n"
CALL attendre(.3)
ELSE
BEEP
END IF
END IF
LOOP WHILE r$ = ""
r$ = UCASE$(r$)
LOOP UNTIL r$ = "O" OR r$ = "N" OR r$ = CHR$(27)
END SUB
DEFINT A-Z
SUB pleinecran (r$, l$, m$, v1, v2)
m$ = RTRIM$(m$)
co = 80
'_saisie plein ecran_
f = -1: 'insertion
COLOR , noir
CALL efface(21, 3)
CALL centre(22, vertclair, "Ret.Arr Suppr Inser Origine Fin " + fle$
+ " Ctrl-x")
CALL centre(23, blanc, rt$ + " = terminer" + SPACE$(13) + "[Echap] =
abandon")
COLOR blancbrill, bleu
VIEW PRINT v1 - 1 TO v2
v = v1: h = 1
pl0:
CLS 2
pl1:
LOCATE v1, 1, 0: PRINT m$
pl2:
IF h < 1 THEN h = 1: BEEP
IF v < v1 THEN v = v1: BEEP
IF h > co THEN h = 1: v = v + 1
lc = h + (co * (v - v1))
IF lc > LEN(m$) THEN 'fin texte
lc = LEN(m$) + 1
v = INT(LEN(m$) / co)
h = (LEN(m$) - (co * v)) + 1
v = v + v1
END IF
IF v = v2 AND h > 38 THEN h = 38
IF NOT f THEN LOCATE v, h, 1, 0, 7 ELSE LOCATE v, h, 1, 7
souris = 0
DO
r$ = INKEY$
' Obtient l'emplacement de la souris et l'état des boutons.
MousePoll v_mouse, h_mouse, lButton, rButton
IF lButton THEN
IF v_mouse >= v1 AND v_mouse <= v2 THEN
v = v_mouse: h = h_mouse
CALL attendre(.2)
souris = 1
EXIT DO
ELSEIF v_mouse = 23 AND (h_mouse >= 46 AND h_mouse <= 62) THEN
r$ = CHR$(27)
CALL attendre(.3)
ELSEIF v_mouse = 23 AND (h_mouse >= 19 AND h_mouse <= 32) THEN
r$ = CHR$(13)
CALL attendre(.3)
ELSE
BEEP
END IF
END IF
LOOP WHILE r$ = ""
IF souris = 1 THEN GOTO pl2
IF r$ = CHR$(27) OR r$ = CHR$(13) THEN VIEW PRINT: LOCATE , , 0:
EXIT SUB
IF LEN(r$) = 2 THEN GOTO pl3
r2 = ASC(r$)
IF r2 > 31 AND r2 < 166 THEN
IF LEN(m$) > 357 THEN
BEEP
VIEW PRINT
COLOR , noir
LOCATE , , 0
CALL centre(23, rougeclair, "Le paragraphe ne doit pas dépasser 355
caractères.")
CALL getinvi(w, w$)
CALL efface(23, 1)
CALL centre(23, blanc, rt$ + " = terminer" + SPACE$(13) + "[Echap] =
abandon")
LOCATE , , 1
COLOR , bleu
VIEW PRINT v1 - 1 TO v2
m$ = LEFT$(m$, 357)
END IF
IF f THEN
m$ = MID$(m$, 1, lc - 1) + r$ + MID$(m$, lc)
ELSE
m$ = MID$(m$, 1, lc - 1) + r$ + MID$(m$, lc + 1)
END IF
h = h + 1
GOTO pl1
END IF
IF r2 = 8 THEN 'delete
IF h = 1 AND v = v1 THEN GOTO pl0
m$ = MID$(m$, 1, lc - 2) + MID$(m$, lc): h = h - 1
IF h < 1 AND v > v1 THEN h = co: v = v - 1
GOTO pl0
END IF
IF r2 = 24 THEN m$ = LEFT$(m$, lc - 1): GOTO pl0'^X
pl3:
'carac étendu
r2 = ASC(RIGHT$(r$, 1))
IF r2 = 72 THEN v = v - 1 'haut
IF r2 = 80 THEN v = v + 1 'bas
IF r2 = 77 THEN h = h + 1 'droite
IF r2 = 71 THEN h = 1: GOTO pl2 'home
IF r2 = 79 THEN h = co: GOTO pl2 'end
IF r2 = 73 THEN v = v1: h = 1: GOTO pl2'pgup
IF r2 = 81 THEN v = v2: h = co: GOTO pl2'pgdown
IF r2 = 75 THEN h = h - 1: IF h < 1 AND v > v1 THEN h = co: v = v -
1: GOTO pl2 'gauche
IF r2 = 82 THEN f = NOT f: GOTO pl0 'ins
IF r2 = 83 THEN 'suppr
m$ = MID$(m$, 1, lc - 1) + MID$(m$, lc + 1)
GOTO pl0
END IF
GOTO pl2
END SUB
DEFINT A-Z
SUB pleineligne (r$, m$, np, v, h)
DEF SEG = 0
POKE 1050, PEEK(1052)
DEF SEG
h3 = h
f = 0 'recouvrement
ple1:
IF NOT f THEN LOCATE v, h, 1, 0, 7 ELSE LOCATE v, h, 1, 7
IF h < h3 THEN h = h3
IF h > np + h3 THEN h = np + h3
IF h - h3 > LEN(m$) THEN h = LEN(m$) + h3
LOCATE v, h3 - 1, 0: PRINT SPACE$(np + 1)
LOCATE v, h3: PRINT m$
lc = h - (h3 - 1)
LOCATE v, h, 1
DO
r$ = INKEY$
LOOP WHILE r$ = ""
IF r$ = CHR$(27) OR r$ = CHR$(13) THEN
LOCATE , , 0, 7
EXIT SUB
END IF
IF LEN(r$) = 2 THEN GOTO plecaet
r2 = ASC(r$)
IF r2 > 31 AND r2 < 255 THEN
IF LEN(m$) >= np THEN BEEP: IF f THEN m$ = MID$(m$, 1, LEN(m$) - 1)
IF f THEN
m$ = MID$(m$, 1, lc - 1) + r$ + MID$(m$, lc)
ELSE
m$ = MID$(m$, 1, lc - 1) + r$ + MID$(m$, lc + 1)
END IF
h = h + 1
IF h > np + h3 THEN h = np + h3
GOTO ple1
END IF
IF r2 = 8 THEN 'delete
IF h <> h3 THEN m$ = MID$(m$, 1, lc - 2) + MID$(m$, lc): h = h - 1
GOTO ple1
END IF
plecaet:
'carac étendu
r2 = ASC(RIGHT$(r$, 1))
SELECT CASE r2
CASE 77
h = h + 1 'droite
CASE 71
h = h3 'home
CASE 79
h = np + h3 'end
CASE 75
h = h - 1 'gauche
CASE 82
f = NOT f 'ins
CASE 83
m$ = MID$(m$, 1, lc - 1) + MID$(m$, lc + 1) 'suppr
END SELECT
GOTO ple1
END SUB
DEFINT A-Z
SUB recupere (m$, v1, v2)
LOCATE 23, 1: COLOR , noir: PRINT SPACE$(80): COLOR , bleu
'_recuperation texte_
m$ = ""
FOR y = v1 TO v2
FOR x = 1 TO 80
s = SCREEN(y, x)
m$ = m$ + CHR$(s)
NEXT x
NEXT y
'FOR x = 1 TO 38
's = SCREEN(17, x)
'm$ = m$ + CHR$(s)
'NEXT
IF LEFT$(m$, 355) = SPACE$(355) THEN m$ = CHR$(255): EXIT SUB
m$ = RTRIM$(m$): m$ = LTRIM$(m$)
ASS = ASC(RIGHT$(m$, 1))
IF ASS = 33 OR ASS = 46 OR ASS = 58 OR ASS = 59 OR ASS = 63 THEN
m$ = m$ + " "
ELSE
m$ = m$ + ". "
END IF
END SUB
DEFINT A-Z
SUB titr (w$)
IF couleur = 0 THEN CALL titrnb(w$): EXIT SUB
COLOR , noir: CLS
FOR i = 1 TO LEN(w$)
IF MID$(w$, i, 1) = "é" OR MID$(w$, i, 1) = "è" THEN
w$ = MID$(w$, 1, i - 1) + "E" + MID$(w$, i + 1)
END IF
NEXT
COLOR , vert
LOCATE 2, 1: PRINT SPACE$(80)
CALL centre(2, noir, UCASE$(w$))
LOCATE 21, 1: PRINT SPACE$(80)
VIEW PRINT 3 TO 20: COLOR blancbrill, bleu: CLS 2: VIEW PRINT
END SUB
DEFINT A-Z
SUB titr2 (w$)
IF couleur = 0 THEN CALL titrnb(w$): EXIT SUB
COLOR , noir: CLS
FOR i = 1 TO LEN(w$)
IF MID$(w$, i, 1) = "é" OR MID$(w$, i, 1) = "è" THEN
w$ = MID$(w$, 1, i - 1) + "E" + MID$(w$, i + 1)
END IF
NEXT
COLOR , vert
LOCATE 2, 1: PRINT SPACE$(80)
CALL centre(2, noir, UCASE$(w$))
LOCATE 20, 1: PRINT SPACE$(80)
VIEW PRINT 3 TO 19: COLOR blancbrill, bleu: CLS 2: VIEW PRINT
END SUB
DEFINT A-Z
SUB titrnb (tit$)
COLOR jaune, noir: CLS
w$ = tit$
FOR i = 1 TO LEN(w$)
IF MID$(w$, i, 1) = "é" OR MID$(w$, i, 1) = "è" THEN
w$ = MID$(w$, 1, i - 1) + "E" + MID$(w$, i + 1)
END IF
NEXT
COLOR blancbrill, noir: LOCATE 2: PRINT STRING$(80, 196)
CALL centre(2, blancbrill, UCASE$(w$))
LOCATE 21, 1: PRINT STRING$(80, 196)
VIEW PRINT 3 TO 20: COLOR blancbrill, bleu: CLS 2: VIEW PRINT
END SUB
DEFINT A-Z
SUB transforme (m$)
e$ = " ": GOSUB sup
e$ = "(": GOSUB avant
e$ = CHR$(34): GOSUB avant
e$ = CHR$(34): GOSUB apres
e$ = ")": GOSUB apres
e$ = ",": GOSUB apres
e$ = ".": GOSUB apres
e$ = ":": GOSUB avap
e$ = "!": GOSUB avap
e$ = "?": GOSUB avap
e$ = ";": GOSUB avap
e$ = "'": GOSUB avap '1° étape
GOSUB ctrl
GOSUB ctrl2
GOSUB ctrl3 '2° étape
GOSUB ctrl4
e$ = "! ! !": e2$ = "!!!": GOSUB ctrl5
e$ = "? ? ?": e2$ = "???": GOSUB ctrl5
e$ = ". . .": e2$ = "...": GOSUB ctrl5
IF LEN(m$) > 360 THEN
IF MID$(m$, 358, 1) = " " THEN
m$ = LEFT$(m$, 357) + ". "
ELSE
m$ = LEFT$(m$, 358) + ". "
END IF
BEEP
COLOR , noir
CALL centre(23, rougeclair, "Paragraphe trop long (355 caractères
max.) -> il sera tronqué.")
CALL getinvi(w, w$)
CALL efface(23, 1)
COLOR blancbrill, bleu
END IF
EXIT SUB
apres:
l = 1: f = 0
DO
GOSUB espace
LOOP WHILE z <> 0
RETURN
espace:
z = INSTR(l, m$, e$): IF z = 0 THEN RETURN
IF e$ = CHR$(34) THEN f = f + 1
IF f / 2 <> INT(f / 2) AND e$ = CHR$(34) THEN l = z + 1: RETURN
IF ASC(MID$(m$, z + 1, 1)) <> 32 THEN m$ = MID$(m$, 1, z) + " " +
MID$(m$, z + 1) 'pas espace après
IF z = 1 THEN l = z + 1: GOTO espace
IF ASC(MID$(m$, z - 1, 1)) = 32 THEN m$ = MID$(m$, 1, z - 2) +
MID$(m$, z): 'espace avant
l = z + 1
RETURN
avant:
l = 1: f = 0
DO
GOSUB espace2
LOOP WHILE z <> 0
RETURN
espace2:
z = INSTR(l, m$, e$): IF z = 0 THEN RETURN
IF e$ = CHR$(34) THEN f = f + 1
IF f / 2 = INT(f / 2) AND e$ = CHR$(34) THEN l = z + 1: RETURN 'pair
IF ASC(MID$(m$, z + 1, 1)) = 32 THEN m$ = MID$(m$, 1, z) + MID$(m$,
z + 2)'un espace après
IF z = 1 THEN GOTO esp2
IF ASC(MID$(m$, z - 1, 1)) <> 32 THEN m$ = MID$(m$, 1, z - 1) + " "
+ MID$(m$, z): z = z + 1 'pas d'espace
esp2:
l = z + 1
RETURN
avap:
l = 1
DO
GOSUB espace3
LOOP WHILE z <> 0
RETURN
espace3:
z = INSTR(l, m$, e$): IF z = 0 THEN RETURN
IF ASC(MID$(m$, z + 1, 1)) <> 32 THEN m$ = MID$(m$, 1, z) + " " +
MID$(m$, z + 1)
IF z = 1 THEN l = z + 1: GOTO espace3
IF ASC(MID$(m$, z - 1, 1)) <> 32 THEN m$ = MID$(m$, 1, z - 1) + " "
+ MID$(m$, z) 'pas d'espace
l = z + 1
RETURN
sup:
l = 1
DO
GOSUB espace4
LOOP WHILE z <> LEN(m$)
RETURN
espace4:
z = INSTR(l, m$, e$): IF z = LEN(m$) THEN RETURN
IF ASC(MID$(m$, z + 1, 1)) = 32 THEN m$ = MID$(m$, 1, z) + MID$(m$,
z + 2): RETURN
l = z + 1
RETURN
ctrl:
l = 1: f = 0
DO
GOSUB espace5
LOOP WHILE z <> 0
RETURN
espace5:
z = INSTR(l, m$, CHR$(34)): IF z = 0 THEN RETURN
f = f + 1
IF f / 2 <> INT(f / 2) THEN l = z + 1: RETURN
t$ = MID$(m$, z - 2, 2)
IF t$ = ". " OR t$ = "? " OR t$ = "! " OR t$ = ") " THEN
m$ = MID$(m$, 1, z - 2) + MID$(m$, z)
END IF
l = z + 1
RETURN
ctrl2:
l = 1
DO
GOSUB espace6
LOOP WHILE z <> 0
RETURN
espace6:
z = INSTR(l, m$, CHR$(34)): IF z = 0 THEN RETURN
IF z = 1 THEN l = z + 1: RETURN
t$ = MID$(m$, z - 2, 2)
IF t$ = "( " THEN
m$ = MID$(m$, 1, z - 2) + MID$(m$, z)
END IF
l = z + 1
RETURN
ctrl3:
l = 1
DO
GOSUB espace7
LOOP WHILE z <> 0
RETURN
espace7:
z = INSTR(l, m$, " ' "): IF z = 0 THEN RETURN
m$ = MID$(m$, 1, z - 1) + "'" + MID$(m$, z + 3)
l = z + 1
RETURN
ctrl4:
l = 1
DO
GOSUB espace8
LOOP WHILE z <> 0
RETURN
espace8:
z = INSTR(l, m$, ")"): IF z = 0 THEN RETURN
t$ = MID$(m$, z - 2, 2)
IF t$ = ". " OR t$ = "? " OR t$ = "! " THEN
m$ = MID$(m$, 1, z - 2) + MID$(m$, z)
END IF
l = z + 1
RETURN
ctrl5:
l = 1
DO
GOSUB espace9
LOOP WHILE z <> 0
RETURN
espace9:
z = INSTR(l, m$, e$): IF z = 0 THEN RETURN
m$ = MID$(m$, 1, z - 1) + e2$ + MID$(m$, z + 5)
l = z + 1
RETURN
END SUB
DEFINT A-Z
SUB trouvemot (m$, m$(), nm)
j = 1: mm$ = ""
FOR i = 1 TO LEN(m$)
mm$ = mm$ + MID$(m$, i, 1)
IF ASC(MID$(m$, i, 1)) = 32 THEN m$(j) = MID$(mm$, 1, LEN(mm$) - 1):
mm$ = "": j = j + 1: IF LEN(m$(j - 1)) = 0 THEN j = j - 1
NEXT
nm = j - 1
END SUB
|
