LECTURE
Visual Basic for MS-DOS
|
|
DECLARE SUB recopier (re%, co%, parag%, n$(), rt$, gg$, pre$, titr$,
noir%, bleu%, vert%, rouge%, marron%, blanc%, vertclair%, cyanclair%,
rougeclair%, jaune%, blancbrill%)
DECLARE SUB attendre (tx!)
DECLARE SUB attendre2 (tx!)
DECLARE SUB Bilan (ma$(), VarEnreg AS ANY)
DECLARE SUB centre (v%, coul%, ph$)
DECLARE SUB chiffres ()
DECLARE SUB convertir (z$)
DECLARE SUB entree (x%, flag%)
DECLARE SUB fleches (v%, h%, w$(), np%, r%, coul%, drap%, v2%, h3%)
DECLARE SUB flechesmenu (w$(), r%, coul%)
DECLARE SUB getinvi (rr%)
DECLARE SUB lettres ()
DECLARE SUB ligne23 ()
DECLARE SUB quitter (fond%)
DECLARE SUB titre ()
DECLARE SUB cadre (v%, h%, l%, nli%, c%)
DECLARE SUB tableauexo (p$())
DECLARE SUB getinvimouse (rr%)
DECLARE SUB ouinon (r$)
DECLARE SUB Chercher (co%, re%, parag%, couleur%, rt$, gg$, gg2$,
pre$, titr$, n$(), prog%, noir%, bleu%, vert%, rouge%, marron%,
blanc%, vertclair%, cyanclair%, rougeclair%, jaune%, blancbrill%)
DECLARE SUB compter (re%, couleur%, co%, parag%, rt$, pre$, titr$,
n$(), prog%, noir%, bleu%, vert%, rouge%, marron%, blanc%, vertclair%,
cyanclair%, rougeclair%, jaune%, blancbrill%)
DECLARE SUB deviner (co%, re%, parag%, n$(), rt$, gg$, pre$, titr$,
prog%, nom$, noir%, bleu%, vert%, rouge%, marron%, blanc%, vertclair%,
cyanclair%, rougeclair%, jaune%, blancbrill%)
DECLARE SUB ecrire (couleur%, re%, co%, parag%, rt$, pre$, titr$,
n$(), prog%, noir%, bleu%, vert%, rouge%, marron%, blanc%, vertclair%,
cyanclair%, rougeclair%, jaune%, blancbrill%)
DECLARE SUB lire (co%, texte%, parag%, eleve%, lecture%, couleur%,
pre$, nom$, classe$, titex$, rt$, gg$, titr$, n$(), noir%, bleu%,
vert%, rouge%, marron%, blanc%, vertclair%, cyanclair%, rougeclair%,
jaune%, blancbrill%)
DECLARE SUB recoller (co%, re%, parag%, rt$, pre$, titr$, n$(), prog%,
noir%, bleu%, vert%, rouge%, marron%, blanc%, vertclair%, cyanclair%,
rougeclair%, jaune%, blancbrill%)
DECLARE SUB reconstituer (re%, co%, parag%, rt$, pre$, titr$, n$(),
prog%, noir%, bleu%, vert%, rouge%, marron%, blanc%, vertclair%,
cyanclair%, rougeclair%, jaune%, blancbrill%)
DECLARE SUB reperer (co%, re%, parag%, n$(), rt$, gg$, pre$, titr$,
prog%, nom$, noir%, bleu%, vert%, rouge%, marron%, blanc%, vertclair%,
cyanclair%, rougeclair%, jaune%, blancbrill%)
DECLARE SUB separer (re%, co%, parag%, n$(), rt$, gg$, pre$, titr$,
prog%, nom$, noir%, bleu%, vert%, rouge%, marron%, blanc%, vertclair%,
cyanclair%, rougeclair%, jaune%, blancbrill%)
DECLARE SUB trouver (re%, co%, parag%, n$(), rt$, gg$, gg2$, pre$,
titr$, prog%, nom$, noir%, bleu%, vert%, rouge%, marron%, blanc%,
vertclair%, cyanclair%, rougeclair%, jaune%, blancbrill%, couleur%)
DECLARE SUB ponctuer (re%, co%, parag%, n$(), rt$, gg$, pre$, titr$,
prog%, nom$, noir%, bleu%, vert%, rouge%, marron%, blanc%, vertclair%,
cyanclair%, rougeclair%, jaune%, blancbrill%)
'EXERCICES AAS LECTURE
'module bibliothèque
'Daniel CLERC
'18/12/2001
'version 1.4.3
'lecture$ contient le niveau : fichier1.txt ou fichier2.txt
DEFINT A-Z
'variables globales
COMMON SHARED pre$, lecture$, co, rt$, gg$, gg2$, titr$, texte%,
parag%, eleve%, lecture%, n$(), prog, 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'
CONST FALSE = 0
CONST TRUE = NOT FALSE
SCREEN 9
SCREEN 0
rt$ = CHR$(17) + CHR$(196) + CHR$(217)
gg$ = CHR$(24) + " " + CHR$(25) + " puis " + rt$
gg2$ = CHR$(24) + " " + CHR$(25) + " " + CHR$(27) + " " + CHR$(26) +
" puis " + rt$
COLOR , 0, 0: CLS : KEY OFF: LOCATE , , 0
'dimension
DIM p$(12), note$(13), n$(13), parag$(10, 5), nbparag(10), titr$(10),
ma$(11)
DIM t$(10) 'pour enregistre
TYPE TypeEnreg
nom AS STRING * 20
prenom AS STRING * 20
nbexo AS STRING * 21
Divers AS STRING * 50
notes AS STRING * 3000
END TYPE
DIM VarEnreg AS TypeEnreg
ON ERROR GOTO erreur ' ===
RANDOMIZE TIMER
OPEN "pointeur.dat" FOR INPUT AS #1
INPUT #1, eleve, sens, couleur, texte, lecture$
CLOSE
OPEN "pointeur.dat" FOR OUTPUT AS #1
WRITE #1, eleve, 2, 1, texte, lecture$
CLOSE
couleur = 1
noir = 0: bleu = 1: vert = 2: rouge = 4: marron = 6: blanc = 7:
vertclair = 10: cyanclair = 11: rougeclair = 12: jaune = 14:
blancbrill = 15
np = 12: ma = 11
DATA Lire,Recopier,Ecrire,Séparer,Recoller
DATA Deviner,Compter,Chercher,Repérer,Trouver,Reconstituer,Ponctuer
FOR i = 1 TO np: READ p$(i): NEXT
FOR i = 2 TO np: ma$(i - 1) = p$(i): NEXT
co = 80
OPEN lecture$ FOR INPUT AS #1
'nbtextes
INPUT #1, nbtextes
IF nbtextes = 0 THEN
CLOSE
BEEP
CALL titre
CALL centre(10, rougeclair, "Il n'y a pas de texte")
CALL centre(14, jaune, "Vous allez devoir en introduire un ou
plusieurs.")
CALL centre(16, jaune, "-> Gestion des textes : option 'Ajouter'")
COLOR , noir
CALL centre(23, blanc, "Tapez " + rt$)
w$ = INPUT$(1)
RUN "gestion" '===
END IF
'titres$
FOR i = 1 TO nbtextes
LINE INPUT #1, titr$(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) = LTRIM$(parag$(i, j))
parag$(i, j) = RTRIM$(parag$(i, j)) + " "
NEXT j
NEXT i
CLOSE
parag = nbparag(texte)
FOR i = 1 TO parag
n$(i) = parag$(texte, i)
NEXT
titex$ = titr$(texte)
principal:
' Vérifie que le gestionnaire de souris est installé.
MouseInit
MouseShow
COLOR , bleu, noir: CLS
IF eleve <> 0 THEN
'lecture des notes
OPEN "fichier.dat" FOR RANDOM AS #1 LEN = LEN(VarEnreg)
GET #1, eleve, VarEnreg
nom$ = RTRIM$(VarEnreg.nom)
pre$ = RTRIM$(VarEnreg.prenom)
IF lecture$ = "fichier1.txt" THEN
'lecture niv 1 est en 6° position
nbexo$ = LTRIM$(STR$(VAL(MID$(VarEnreg.nbexo, 16, 3))))
resultat$ = MID$(VarEnreg.notes, 2001, 400)
ELSE
'lecture niv 2 est en 7° position
nbexo$ = LTRIM$(STR$(VAL(MID$(VarEnreg.nbexo, 19, 3))))
resultat$ = MID$(VarEnreg.notes, 2401, 400)
END IF
CLOSE
'possibilité de 20 exercices enregistré sur 10 (2 caractères)
j = 1
FOR i = 1 TO 400 STEP 40 '(10 textes)
t$(j) = MID$(resultat$, i, 40)
j = j + 1
NEXT
pointeur = 1
FOR matiere = 1 TO ma
note$(matiere) = MID$(t$(texte), pointeur, 2)
pointeur = pointeur + 2
NEXT matiere
w$ = RIGHT$(t$(texte), 1): IF w$ = "O" THEN lecture = 1
END IF
IF lecture = 0 AND sens = 1 THEN
titr$ = "LECTURE"
CALL titre
CALL cadre(7, 16, 48, 10, marron)
COLOR , marron
IF pre$ = "" THEN
CALL centre(9, blanc, "Un conseil :")
ELSE
CALL centre(9, blanc, pre$ + ", un conseil :")
END IF
CALL centre(12, blancbrill, "commence par l'activité « LIRE »")
CALL centre(15, blancbrill, "pour t'entraîner et t'imprégner du
texte.")
CALL entree(noir, noir)
COLOR , bleu, noir: CLS
END IF
'affichage texte, classe, élève
CALL cadre(2, 22, 36, 2, vert)
COLOR , vert
IF lecture$ = "fichier1.txt" THEN
CALL centre(3, blancbrill, "ACTIVITES de LECTURE - niveau I")
ELSE
CALL centre(3, blancbrill, "ACTIVITES de LECTURE - niveau II")
END IF
COLOR , bleu
CALL centre(6, jaune, titex$ + " - texte" + STR$(texte))
IF eleve <> 0 THEN
CALL centre(5, vertclair, pre$ + " " + nom$)
END IF
CALL tableauexo(p$())
'affiche liste exo
h1 = 26: h3 = 44
COLOR blancbrill
LOCATE 9
FOR i = 1 TO 6
LOCATE , h1: PRINT p$(i): PRINT
NEXT
LOCATE 9
FOR i = 7 TO 12
LOCATE , h3: PRINT p$(i): PRINT
NEXT
COLOR blancbrill, rouge
LOCATE 9, 24: IF lecture = 1 THEN PRINT CHR$(4)
IF eleve <> 0 THEN
'affiche eval
COLOR , noir
LOCATE 11
FOR i = 1 TO 5
LOCATE , 24
IF note$(i) = " " THEN
PRINT " "
ELSEIF (VAL(note$(i)) = 9 OR VAL(note$(i)) = 10) THEN
COLOR vertclair: PRINT "A"
ELSEIF (VAL(note$(i)) = 7 OR VAL(note$(i)) = 8) THEN
COLOR vert: PRINT "B"
ELSEIF (VAL(note$(i)) = 6 OR VAL(note$(i)) = 5) THEN
COLOR jaune: PRINT "C"
ELSE
COLOR rouge: PRINT "D"
END IF
PRINT
NEXT
LOCATE 9
FOR i = 6 TO ma
LOCATE , 42
IF note$(i) = " " THEN
PRINT " "
ELSEIF (VAL(note$(i)) = 9 OR VAL(note$(i)) = 10) THEN
COLOR vertclair: PRINT "A"
ELSEIF (VAL(note$(i)) = 7 OR VAL(note$(i)) = 8) THEN
COLOR vert: PRINT "B"
ELSEIF (VAL(note$(i)) = 5 OR VAL(note$(i)) = 6) THEN
COLOR jaune: PRINT "C"
ELSE
COLOR rouge: PRINT "D"
END IF
PRINT
NEXT
COLOR , rouge
END IF
CALL flechesmenu(p$(), prog, rouge)
COLOR , noir
IF prog = 0 THEN
COLOR , bleu
LOCATE 23, 1: PRINT SPACE$(80)
LOCATE 23, 30
COLOR blanc: BEEP: PRINT "Quitter ";
CALL ouinon(s$)
IF s$ = "O" THEN GOTO quit
GOTO principal
END IF
IF prog = 42 AND eleve <> 0 THEN
CALL Bilan(ma$(), VarEnreg)
'
GOTO principal
END IF
COLOR , noir: CLS
titr$ = p$(prog)
COLOR , noir
re = 0
SELECT CASE prog
CASE 1
CALL lire(co, texte, parag, eleve, lecture, couleur, pre$, nom$,
classe$, titex$, rt$, gg$, titr$, n$(), noir, bleu, vert, rouge,
marron, blanc, vertclair, cyanclair, rougeclair, jaune, blancbrill)
CASE 2
CALL recopier(re, co, parag, n$(), rt$, gg$, pre$, titr$, noir,
bleu, vert, rouge, marron, blanc, vertclair, cyanclair, rougeclair,
jaune, blancbrill)
CASE 3
CALL ecrire(couleur, re, co, parag, rt$, pre$, titr$, n$(), prog%,
noir, bleu, vert, rouge, marron, blanc, vertclair, cyanclair,
rougeclair, jaune, blancbrill)
CASE 4
CALL separer(re, co, parag, n$(), rt$, gg$, pre$, titr$, prog%,
nom$, noir%, bleu%, vert%, rouge%, marron%, blanc%, vertclair%,
cyanclair%, rougeclair%, jaune%, blancbrill%)
CASE 5
CALL recoller(co, re, parag, rt$, pre$, titr$, n$(), prog, noir,
bleu, vert, rouge, marron, blanc, vertclair, cyanclair, rougeclair,
jaune, blancbrill)
CASE 6
CALL deviner(co, re, parag, n$(), rt$, gg$, pre$, titr$, prog%,
nom$, noir%, bleu%, vert%, rouge%, marron%, blanc%, vertclair%,
cyanclair%, rougeclair%, jaune%, blancbrill%)
CASE 7
CALL compter(re, couleur, co, parag, rt$, pre$, titr$, n$(), prog,
noir, bleu, vert, rouge, marron, blanc, vertclair, cyanclair,
rougeclair, jaune, blancbrill)
CASE 8
CALL Chercher(co, re, parag, couleur, rt$, gg$, gg2$, pre$, titr$,
n$(), prog, noir, bleu, vert, rouge, marron, blanc, vertclair,
cyanclair, rougeclair, jaune, blancbrill)
CASE 9
CALL reperer(co, re, parag, n$(), rt$, gg$, pre$, titr$, prog%,
nom$, noir%, bleu%, vert%, rouge%, marron%, blanc%, vertclair%,
cyanclair%, rougeclair%, jaune%, blancbrill%)
CASE 10
CALL trouver(re, co, parag, n$(), rt$, gg$, gg2$, pre$, titr$, prog%,
nom$, noir%, bleu%, vert%, rouge%, marron%, blanc%, vertclair%,
cyanclair%, rougeclair%, jaune%, blancbrill%, couleur%)
CASE 11
CALL reconstituer(re, co, parag, rt$, pre$, titr$, n$(), prog, noir,
bleu, vert, rouge, marron, blanc, vertclair, cyanclair, rougeclair,
jaune, blancbrill)
CASE 12
CALL ponctuer(re, co, parag, n$(), rt$, gg$, pre$, titr$, prog%,
nom$, noir%, bleu%, vert%, rouge%, marron%, blanc%, vertclair%,
cyanclair%, rougeclair%, jaune%, blancbrill%)
END SELECT
mat = prog - 1
GOSUB enregistre
GOTO principal
enregistre:
'mat , re
IF eleve = 0 THEN RETURN
COLOR , noir
IF mat <> 0 THEN
CALL centre(23, blanc, "Enregistrement de la note")
mat = (mat * 2) - 1
re$ = LTRIM$(STR$(re)): IF LEN(re$) = 1 THEN re$ = " " + re$
END IF
OPEN "fichier.dat" FOR RANDOM AS #1 LEN = LEN(VarEnreg)
GET #1, eleve, VarEnreg
nbexo$ = VarEnreg.nbexo
IF lecture$ = "fichier1.txt" THEN
' lecture est en 6° -> 15
nombre$ = LTRIM$(STR$(VAL(MID$(nbexo$, 16, 3)) + 1))
IF LEN(nombre$) = 1 THEN
nombre$ = "00" + nombre$
ELSEIF LEN(nombre$) = 2 THEN
nombre$ = "0" + nombre$
END IF
IF VAL(nombre$) < 1000 THEN
VarEnreg.nbexo = MID$(nbexo$, 1, 15) + nombre$ + MID$(nbexo$, 19)
END IF
notes$ = MID$(VarEnreg.notes, 2001, 400)
ELSE
' lecture est en 7° -> 18
nombre$ = LTRIM$(STR$(VAL(MID$(nbexo$, 19, 3)) + 1))
IF LEN(nombre$) = 1 THEN
nombre$ = "00" + nombre$
ELSEIF LEN(nombre$) = 2 THEN
nombre$ = "0" + nombre$
END IF
IF VAL(nombre$) < 1000 THEN
VarEnreg.nbexo = MID$(nbexo$, 1, 18) + nombre$
END IF
notes$ = MID$(VarEnreg.notes, 2401, 400)
END IF
'lecture anciennes notes
'possibilité de 20 exercices enregistré sur 10 (2 caractères)
'la 40° place est pour lire (O/N)
j = 1
FOR i = 1 TO 400 STEP 40 '(10 textes)
t$(j) = MID$(notes$, i, 40)
j = j + 1
NEXT
'on change notes$
notes$ = t$(texte)
SELECT CASE mat
CASE 0 'lire
notes$ = MID$(notes$, 1, 39) + "O"
CASE 1
notes$ = re$ + MID$(notes$, mat + 2)
CASE ELSE
notes$ = LEFT$(notes$, mat - 1) + re$ + MID$(notes$, mat + 2)
END SELECT
w$ = ""
FOR i = 1 TO 10
IF i <> texte THEN
w$ = w$ + t$(i)
ELSE
w$ = w$ + notes$
END IF
NEXT
'w$ doit avoir une longueur de 400
IF lecture$ = "fichier1.txt" THEN
VarEnreg.notes = MID$(VarEnreg.notes, 1, 2000) + w$ + MID$(VarEnreg.notes,
2401)
ELSE
VarEnreg.notes = MID$(VarEnreg.notes, 1, 2400) + w$ + MID$(VarEnreg.notes,
2801)
END IF
PUT #1, eleve, VarEnreg
CLOSE #1
CALL attendre2(.5)
LOCATE 23, 1: PRINT SPACE$(80)
CALL entree(noir, 0)
RETURN
quit:
IF eleve <> 0 THEN CALL Bilan(ma$(), VarEnreg)
CLS
LOCATE , , 0
RUN "menuexo"
END
erreur:
programme$ = "exo_le"
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 getinvimouse(r)
IF r = 27 THEN COLOR , noir: CLS : END
COLOR , bleu: CLS : RUN programme$
RESUME
DEFINT A-Z
SUB affectmots (m$, m$(), nm)
i = 0: l = 1
DO
z = INSTR(l, m$, " "): IF z = 0 THEN EXIT DO
i = i + 1
m$(i) = MID$(m$, l, z - l)
l = z + 1
LOOP
nm = i
END SUB
DEFINT A-Z
SUB afformate (m$(), nm, v, h)
'il faut tester avant si les mots ne sont pas
'plus grand que col ===
h3 = h
col = co - (h3 * 2)
IF h3 = 0 THEN h3 = 1
GOSUB nombreligne
IF h3 > 1 THEN
CALL cadre(v - 1, h3 - 2, col + 2, nl, blanc)
COLOR noir, blanc
ELSE
LOCATE v - 2
COLOR noir, blanc
FOR i = 1 TO nl + 1: PRINT SPACE$(co): NEXT
END IF
LOCATE v, h3, 0
i = 1: l2 = 0
DO
l = LEN(m$(i))
l2 = l2 + l
IF l2 > col THEN
PRINT : i = i - 1: l2 = 0
LOCATE , h3
ELSEIF l2 = col THEN
PRINT m$(i); : l2 = 0
IF h3 > 1 THEN PRINT : LOCATE , h3
ELSEIF l2 = col - 1 THEN
PRINT m$(i): l2 = 0
LOCATE , h3
ELSE
PRINT m$(i); " "; : l2 = l2 + 1
END IF
i = i + 1
LOOP WHILE i <= nm
PRINT
EXIT SUB
nombreligne:
COLOR bleu, bleu
LOCATE v, h3, 0
i = 1: l2 = 0
DO
l = LEN(m$(i))
l2 = l2 + l
IF l2 > col THEN
PRINT : i = i - 1: l2 = 0
LOCATE , h3
ELSEIF l2 = col THEN
PRINT m$(i); : l2 = 0
IF h3 > 1 THEN PRINT : LOCATE , h3
ELSEIF l2 = col - 1 THEN
PRINT m$(i): l2 = 0
LOCATE , h3
ELSE
PRINT m$(i); " "; : l2 = l2 + 1
END IF
i = i + 1
LOOP WHILE i <= nm
ligne = CSRLIN
nl = ligne - v + 2
RETURN
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 attendre2 (tx!)
DEF SEG = 0
POKE 1050, PEEK(1052)
DEF SEG
tx! = tx! * 2
debut! = TIMER
DO
IF INKEY$ <> "" THEN EXIT DO
MousePoll v_mouse, h_mouse, lButton, rButton
IF lButton THEN
CALL attendre(.2)
EXIT DO
END IF
fin! = TIMER
LOOP WHILE fin! - debut! < tx!
END SUB
DEFINT A-Z
SUB Bilan (ma$(), VarEnreg AS TypeEnreg)
ma = 11
DIM no$(ma, 10), t$(10), moy(10), total(10)
titr$ = "bilan"
CALL titre
rt$ = CHR$(17) + CHR$(196) + CHR$(217)
ll$ = STRING$(30, ".")
'lecture des notes
OPEN "fichier.dat" FOR RANDOM AS #1 LEN = LEN(VarEnreg)
GET #1, eleve, VarEnreg
nom$ = RTRIM$(VarEnreg.nom)
pre$ = RTRIM$(VarEnreg.prenom)
IF lecture$ = "fichier1.txt" THEN
'lecture niv 1 est en 6° position
nbexo$ = LTRIM$(MID$(VarEnreg.nbexo, 16, 3))
resultat$ = MID$(VarEnreg.notes, 2001, 400)
ELSE
'lecture niv 2 est en 7° position
nbexo$ = LTRIM$(MID$(VarEnreg.nbexo, 19, 3))
resultat$ = MID$(VarEnreg.notes, 2401, 400)
END IF
CLOSE
IF VAL(nbexo$) = 0 THEN EXIT SUB
'possibilité de 20 exercices enregistré sur 10 (2 caractères)
j = 1
FOR i = 1 TO 400 STEP 40 '(10 textes)
t$(j) = MID$(resultat$, i, 40)
j = j + 1
NEXT
FOR text = 1 TO 10
pointeur = 1
FOR matiere = 1 TO ma
no$(matiere, text) = MID$(t$(text), pointeur, 2)
pointeur = pointeur + 2
NEXT matiere
NEXT text
'moyenne générale
tt = 0: nt = 0
FOR i = 1 TO 10
FOR j = 1 TO ma
IF no$(j, i) <> " " THEN tt = tt + VAL(no$(j, i)): nt = nt + 1
NEXT j
NEXT i
IF tt <> 0 THEN moy! = INT((tt / nt) * 10) / 10
GOSUB moytexte
z$ = pre$ + " " + nom$ + " a fait" + STR$(VAL(nbexo$)) + " exercice"
IF VAL(nbexo$) > 1 THEN z$ = z$ + "s"
IF lecture$ = "fichier1.txt" THEN
zz$ = " (niveau I)"
ELSE
zz$ = " (niveau II)"
END IF
z$ = z$ + " de lecture" + zz$
COLOR , marron
CALL centre(4, blancbrill, " " + z$ + " ")
COLOR , bleu
LOCATE 6, 26: COLOR vertclair: PRINT "texte n° "; : FOR i = 1 TO 9:
PRINT i; " "; : NEXT
LOCATE 6, 71: PRINT "10": COLOR blancbrill
'liste des matières
COLOR , rouge
LOCATE 7, 7: PRINT "┌"; STRING$(66, "─"); "┐"
FOR i = 1 TO ma
LOCATE , 7: PRINT "│ "; ma$(i); " "; LEFT$(ll$, 20 - LEN(ma$(i)));
PRINT " │ │ │ │ │ │ │ │ │ │ │"
NEXT
LOCATE , 7: PRINT "└"; STRING$(66, "─"); "┘"
'notes
COLOR blanc, rouge
v = 8
FOR i = 1 TO ma
h = 36
FOR j = 1 TO 10
LOCATE v, h: IF VAL(no$(i, j)) = 10 THEN LOCATE v, h - 1
IF no$(i, j) <> " " THEN
PRINT LTRIM$(STR$(VAL(no$(i, j))))
END IF
h = h + 4
NEXT j
v = v + 1
NEXT i
COLOR cyanclair, bleu: LOCATE 20, 9: PRINT "Moyenne par texte ";
LEFT$(ll$, 6)
v = 20: h = 36
FOR text = 1 TO 10
LOCATE v, h: IF moy(text) = 10 THEN LOCATE v, h - 1
IF moy(text) <> 0 THEN
PRINT LTRIM$(STR$((moy(text))))
ELSE
PRINT "-"
END IF
h = h + 4
NEXT
COLOR jaune, noir: LOCATE 23, 1
IF tt <> 0 THEN
z$ = STR$(moy!): CALL convertir(z$)
CALL centre(23, jaune, "Moyenne générale :" + z$ + " sur 10")
END IF
COLOR blancbrill
CLOSE
CALL getinvimouse(w)
EXIT SUB
moytexte:
FOR text = 1 TO 10
total(text) = 0: nt = 0
FOR i = 1 TO ma
IF no$(i, text) <> " " THEN total(text) = total(text) + VAL(no$(i,
text)): nt = nt + 1
NEXT
IF total(text) = 0 THEN
moy(text) = 0
ELSE
moy(text) = INT(((total(text) / nt) * 10) / 10)
END IF
NEXT
RETURN
END SUB
DEFINT A-Z
SUB cadre (v%, h%, l%, nli%, c)
'c est l'intérieur
'le fond écran est bleu
v2 = v
'cadre
COLOR c, bleu
LOCATE v2, h
PRINT STRING$(l + 2, 220)
FOR i = 1 TO nli - 1
v2 = v2 + 1: LOCATE v2, h
PRINT STRING$(l + 2, 219)
NEXT
COLOR , bleu
LOCATE v2 + 1, h: PRINT CHR$(223)
COLOR , 0
LOCATE v + 1
FOR i = 1 TO nli
LOCATE , h + l + 2
PRINT " "
NEXT
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 chiffres ()
LOCATE 23, 1, 0
FOR i = 1 TO co
x$ = x$ + CHR$(SCREEN(23, i))
NEXT
CALL ligne23
CALL centre(23, rougeclair, "Des chiffres !")
CALL attendre2(1)
CALL ligne23
COLOR blanc: LOCATE 23, 1: PRINT x$
END SUB
DEFINT A-Z
SUB choixparag (np, r)
CALL titre
DIM p$(5)
CALL cadre(7, 25, 30, 2, vert)
COLOR , vert
CALL centre(8, blancbrill, "Choix du paragraphe")
COLOR 15, bleu
p$(1) = "1": p$(2) = "2": p$(3) = "3": p$(4) = "4": p$(5) = "5"
CALL fleches(13, 40, p$(), np, r, rouge, 1, 23, 35)
END SUB
DEFINT A-Z
SUB chrono (v, h, duree, temps!)
DEF SEG = 0
POKE 1050, PEEK(1052)
DEF SEG
CALL cadre(v - 1, h - 3, 2, 2, rouge)
COLOR blancbrill, rouge
depart! = TIMER
DO
fin! = TIMER
'temps! = INT((Fin! - depart!) * 10) / 10 === affichage en 1/10°
temps! = INT(fin! - depart!)
temps$ = LTRIM$(STR$(temps!))
IF temps! < 1 THEN
temps$ = "0" '=== + temps$
'ELSEIF VAL(temps$) = INT(temps!) THEN ===
'temps$ = temps$ + ".0"
END IF
'COLOR vertclair
IF VAL(temps$) < 10 THEN LOCATE v, h - 1 ELSE LOCATE v, h - 2
PRINT temps$ ': COLOR blancbrill
w$ = INKEY$
MousePoll v_mouse, h_mouse, lButton, rButton
IF lButton THEN
CALL attendre(.2)
EXIT DO
END IF
IF w$ = CHR$(13) OR w$ = CHR$(32) THEN EXIT DO
IF w$ = CHR$(27) THEN CALL quitter(rouge)
LOOP WHILE duree <> INT(temps!)
END SUB
DEFINT A-Z
SUB consigne (nl, w$, z$, y$)
CALL titre
l = LEN(w$)
IF LEN(z$) > l THEN l = LEN(z$)
IF LEN(y$) > l THEN l = LEN(y$)
l = l + 6
h = INT(40 - l / 2)
IF eleve <> 0 THEN nl = nl + 1
IF nl = 1 OR nl = 2 THEN
v = 8
ELSEIF nl = 3 THEN
v = 7
ELSEIF nl = 4 THEN
v = 6
END IF
CALL cadre(v, h, l, 4 + (nl * 2), marron)
COLOR , marron
IF eleve <> 0 THEN
CALL centre(v + 3, blancbrill, pre$ + ","): w$ = LCASE$(w$)
CALL centre(v + 5, blancbrill, w$)
CALL centre(v + 7, blancbrill, z$)
CALL centre(v + 10, blancbrill, y$)
ELSE
CALL centre(v + 3, blancbrill, w$)
CALL centre(v + 5, blancbrill, z$)
CALL centre(v + 8, blancbrill, y$)
END IF
CALL entree(noir, 1)
w$ = "": z$ = "": y$ = ""
END SUB
DEFINT A-Z
SUB convertir (z$)
'convertir les . en ,
s = INSTR(1, z$, ".")
IF s <> 0 THEN z$ = MID$(z$, 1, s - 1) + "," + MID$(z$, s + 1)
END SUB
DEFINT A-Z
SUB encore2 (r)
CALL centre(23, blanc, "[Echap] = fin" + SPACE$(7) + CHR$(17) +
CHR$(196) + CHR$(217) + " = paragraphe suivant")
CALL getinvi(r)
END SUB
DEFINT A-Z
SUB entree (x, flag)
COLOR , x
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 v_mouse, h_mouse, lButton, rButton
IF lButton THEN
r$ = CHR$(13)
CALL attendre(.5)
END IF
LOOP WHILE r$ = ""
IF LEN(r$) < 2 THEN rr = ASC(r$) ELSE rr = ASC(RIGHT$(r$, 1))
COLOR blancbrill
IF rr = 27 AND flag = 1 THEN CALL quitter(noir)
END SUB
DEFINT A-Z
SUB epure (m$)
FOR n = 1 TO 3
IF LEN(m$) = 1 THEN EXIT SUB
f1 = 0
IF RIGHT$(m$, 3) = "..." THEN m$ = MID$(m$, 1, LEN(m$) - 3): f1 = 1
az = ASC(RIGHT$(m$, 1)) 'fin
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 m$ = MID$(m$, 1,
LEN(m$) - 1): f1 = 1
az = ASC(LEFT$(m$, 1)) 'début
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 m$ = MID$(m$, 2, LEN(m$) -
1): GOTO epure1
IF f1 = 1 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 m$ = MID$(m$, 2, LEN(m$) - 1)
epure1:
NEXT n
END SUB
DEFINT A-Z
SUB erreur ()
v = CSRLIN: h = POS(0)
COLOR rougeclair: PRINT "Erreur"; SPACE$(20)
CALL attendre2(1): COLOR 15
LOCATE v, h: PRINT SPACE$(7)
END SUB
DEFINT A-Z
SUB erreur2 ()
COLOR , noir
CALL centre(23, rougeclair, "Erreur")
CALL attendre2(1)
CALL centre(23, 15, SPACE$(7))
END SUB
DEFINT A-Z
SUB Exact ()
v = CSRLIN: h = POS(0)
COLOR jaune: PRINT "Exact"; SPACE$(20): COLOR 15: CALL attendre2(.5)
LOCATE v, h: PRINT SPACE$(6)
END SUB
DEFINT A-Z
SUB exact2 ()
COLOR , noir
CALL centre(23, jaune, "Exact")
CALL attendre2(1)
CALL centre(23, 15, SPACE$(5))
END SUB
DEFINT A-Z
SUB fleches (v, h, w$(), np, r, coul, drap, v2, h3)
'PRINT v2, h3
'v2 et h3 sont la ligne colonne des fleches
DIM p$(np)
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
COLOR blanc, noir
LOCATE v2, h3: PRINT gg$
'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 + 1, coul)
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
souris = 0
DO
r$ = INKEY$
' Obtient l'emplacement de la souris et l'état des boutons.
MousePoll v_mouse, h_mouse, lButton, rButton
'LOCATE 21, 1: PRINT "Position de la souris : "; v_mouse; ", ";
h_mouse '===
IF lButton THEN
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
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
souris = 1
CALL attendre(.3)
EXIT DO
ELSE
BEEP
END IF
END IF
LOOP WHILE r$ = ""
IF souris = 0 THEN
IF LEN(r$) < 2 THEN
rr = ASC(r$)
ELSE
rr = ASC(RIGHT$(r$, 1))
END IF
END IF
IF rr = 27 THEN
CALL quitter(coul)
END IF
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 flechesmenu (w$(), r, coul)
nm = 12
DIM p$(nm)
CONST gauche = 75, droite = 77, bas = 80, haut = 72
h1 = 26: h3 = 44
'on met des espaces à la fin
FOR i = 1 TO nm
p$(i) = w$(i)
NEXT
l2 = 0
FOR i = 1 TO nm
l1 = LEN(p$(i)): IF l2 < l1 THEN l2 = l1
NEXT
FOR i = 1 TO 6
p$(i) = p$(i) + SPACE$(l2 - (LEN(p$(i)) + 1))
NEXT
FOR i = 7 TO nm
p$(i) = p$(i) + SPACE$(l2 - LEN(p$(i)))
NEXT
'+++
h = h1: v = 9
r = 1
DO
IF couleur = 1 THEN COLOR coul, blanc ELSE COLOR noir, blanc
LOCATE v, h - 1
PRINT " "; p$(r); " "
COLOR blancbrill, coul
hh = h: vv = v
'fleches
DEF SEG = 0
POKE &H417, (PEEK(&H417) AND &H9F)'non numérique
POKE &H417, (PEEK(&H417) AND &HBF) 'minus
DEF SEG
souris = 0
DO
r$ = INKEY$
' Obtient l'emplacement de la souris et l'état des boutons.
MousePoll v_mouse, h_mouse, lButton, rButton
'LOCATE 21, 1: PRINT "Position de la souris : "; v_mouse; ", ";
h_mouse '===
IF lButton THEN
'ligne fleches et entree
IF v_mouse = 22 THEN
IF h_mouse = 33 THEN
'fleche haut
rr = haut
CALL attendre(.3)
souris = 1
EXIT DO
ELSEIF h_mouse = 35 THEN
'fleche bas
rr = bas
CALL attendre(.3)
souris = 1
EXIT DO
ELSEIF h_mouse = 37 THEN
'fleche gauche
rr = gauche
CALL attendre(.3)
souris = 1
EXIT DO
ELSEIF h_mouse = 39 THEN
'fleche droite
rr = droite
CALL attendre(.3)
souris = 1
EXIT DO
ELSEIF h_mouse >= 46 AND h_mouse <= 48 THEN
'entree
rr = 13
CALL attendre(.3)
souris = 1
EXIT DO
ELSE
BEEP
END IF
'ligne echap et *
ELSEIF v_mouse = 23 THEN
IF h_mouse >= 23 AND h_mouse <= 35 THEN
rr = 27
CALL attendre(.3)
souris = 1
EXIT DO
ELSEIF h_mouse >= 48 AND h_mouse <= 58 THEN
rr = 42
CALL attendre(.3)
souris = 1
EXIT DO
END IF
'lignes noms des activités
ELSEIF v_mouse = 9 THEN
IF h_mouse >= 25 AND h_mouse <= 37 THEN
'lire
GOSUB afficheliste
r = 1
LOCATE v_mouse, 25
IF couleur = 1 THEN COLOR coul, blanc ELSE COLOR noir, blanc
PRINT " "; p$(r); " "
CALL attendre(.5)
EXIT SUB
ELSEIF h_mouse >= 43 AND h_mouse <= 56 THEN
'compter
GOSUB afficheliste
r = 7
LOCATE v_mouse, 43
IF couleur = 1 THEN COLOR coul, blanc ELSE COLOR noir, blanc
PRINT " "; p$(r); " "
CALL attendre(.5)
EXIT SUB
ELSE
BEEP
END IF
ELSEIF v_mouse = 11 THEN
IF h_mouse >= 25 AND h_mouse <= 37 THEN
'recopier
GOSUB afficheliste
r = 2
LOCATE v_mouse, 25
IF couleur = 1 THEN COLOR coul, blanc ELSE COLOR noir, blanc
PRINT " "; p$(r); " "
CALL attendre(.5)
EXIT SUB
ELSEIF h_mouse >= 43 AND h_mouse <= 56 THEN
'chercher
GOSUB afficheliste
r = 8
LOCATE v_mouse, 43
IF couleur = 1 THEN COLOR coul, blanc ELSE COLOR noir, blanc
PRINT " "; p$(r); " "
CALL attendre(.5)
EXIT SUB
ELSE
BEEP
END IF
ELSEIF v_mouse = 13 THEN
IF h_mouse >= 25 AND h_mouse <= 37 THEN
'ecrire
GOSUB afficheliste
r = 3
LOCATE v_mouse, 25
IF couleur = 1 THEN COLOR coul, blanc ELSE COLOR noir, blanc
PRINT " "; p$(r); " "
CALL attendre(.5)
EXIT SUB
ELSEIF h_mouse >= 43 AND h_mouse <= 56 THEN
'reperer
GOSUB afficheliste
r = 9
LOCATE v_mouse, 43
IF couleur = 1 THEN COLOR coul, blanc ELSE COLOR noir, blanc
PRINT " "; p$(r); " "
CALL attendre(.5)
EXIT SUB
ELSE
BEEP
END IF
ELSEIF v_mouse = 15 THEN
IF h_mouse >= 25 AND h_mouse <= 37 THEN
'separer
GOSUB afficheliste
r = 4
LOCATE v_mouse, 25
IF couleur = 1 THEN COLOR coul, blanc ELSE COLOR noir, blanc
PRINT " "; p$(r); " "
CALL attendre(.5)
EXIT SUB
ELSEIF h_mouse >= 43 AND h_mouse <= 56 THEN
'trouver
GOSUB afficheliste
r = 10
LOCATE v_mouse, 43
IF couleur = 1 THEN COLOR coul, blanc ELSE COLOR noir, blanc
PRINT " "; p$(r); " "
CALL attendre(.5)
EXIT SUB
ELSE
BEEP
END IF
ELSEIF v_mouse = 17 THEN
IF h_mouse >= 25 AND h_mouse <= 37 THEN
'recoller
GOSUB afficheliste
r = 5
LOCATE v_mouse, 25
IF couleur = 1 THEN COLOR coul, blanc ELSE COLOR noir, blanc
PRINT " "; p$(r); " "
CALL attendre(.5)
EXIT SUB
ELSEIF h_mouse >= 43 AND h_mouse <= 56 THEN
'reconstituer
GOSUB afficheliste
r = 11
LOCATE v_mouse, 43
IF couleur = 1 THEN COLOR coul, blanc ELSE COLOR noir, blanc
PRINT " "; p$(r); " "
CALL attendre(.5)
EXIT SUB
ELSE
BEEP
END IF
ELSEIF v_mouse = 19 THEN
IF h_mouse >= 25 AND h_mouse <= 37 THEN
'deviner
GOSUB afficheliste
r = 6
LOCATE v_mouse, 25
IF couleur = 1 THEN COLOR coul, blanc ELSE COLOR noir, blanc
PRINT " "; p$(r); " "
CALL attendre(.5)
EXIT SUB
ELSEIF h_mouse >= 43 AND h_mouse <= 56 THEN
'ponctuer
GOSUB afficheliste
r = 12
LOCATE v_mouse, 43
IF couleur = 1 THEN COLOR coul, blanc ELSE COLOR noir, blanc
PRINT " "; p$(r); " "
CALL attendre(.5)
EXIT SUB
ELSE
BEEP
END IF
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
SELECT CASE rr
CASE gauche
h = h - (h3 - h1)
IF h < h1 THEN
v = v - 2: h = h3
END IF
IF v < 9 THEN
v = 19
END IF
CASE droite
h = h + (h3 - h1)
IF h > h3 THEN
v = v + 2: h = h1
END IF
IF v > 19 THEN
v = 9
END IF
CASE bas
v = v + 2
IF v > 19 THEN
IF h = h1 THEN
h = h3: v = 9
ELSEIF h = h3 THEN
h = h1: v = 9
END IF
END IF
CASE haut
v = v - 2
IF v < 9 THEN
IF h = h3 THEN
h = h1: v = 19
ELSEIF h = h1 THEN
h = h3: v = 19
END IF
END IF
CASE 13
GOSUB calculr
EXIT SUB
CASE 27
r = 0
EXIT SUB
CASE 42, 36, 56, 230, 43
IF eleve <> 0 THEN
'l'étoile
r = 42
EXIT SUB
END IF
END SELECT
COLOR blancbrill, coul
LOCATE vv, hh - 1
PRINT " "; p$(r); " "
GOSUB calculr
LOOP
EXIT SUB
calculr:
SELECT CASE v
CASE 9
IF h = h1 THEN r = 1 ELSE r = 7
CASE 11
IF h = h1 THEN r = 2 ELSE r = 8
CASE 13
IF h = h1 THEN r = 3 ELSE r = 9
CASE 15
IF h = h1 THEN r = 4 ELSE r = 10
CASE 17
IF h = h1 THEN r = 5 ELSE r = 11
CASE 19
IF h = h1 THEN r = 6 ELSE r = 12
END SELECT
RETURN
afficheliste:
COLOR blancbrill, coul
LOCATE 9
FOR i = 1 TO 6
LOCATE , h1 - 1: PRINT " "; p$(i); " ": PRINT
NEXT
LOCATE 9
FOR i = 7 TO nm
LOCATE , h3 - 1: PRINT " "; p$(i); " ": PRINT
NEXT
RETURN
END SUB
DEFINT A-Z
SUB getinvi (rr%)
DEF SEG = 0
POKE 1050, PEEK(1052)
DEF SEG
DO
r$ = INKEY$
LOOP WHILE r$ = ""
IF LEN(r$) < 2 THEN rr = ASC(r$) ELSE rr = ASC(RIGHT$(r$, 1))
END SUB
DEFINT A-Z
SUB getinvimouse (rr)
DEF SEG = 0
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
r$ = CHR$(13)
CALL attendre(.5)
END IF
LOOP WHILE r$ = ""
IF LEN(r$) < 2 THEN rr = ASC(r$) ELSE rr = ASC(RIGHT$(r$, 1))
END SUB
DEFINT A-Z
SUB inputgen (coul, fond, nl%, r$, deb%, fin%)
'14/9/94
DIM re$(nl + 1)
'MouseShow'===
inpdebut:
COLOR coul, fond
r$ = "."
DEF SEG = 0
POKE 1050, PEEK(1052)
DEF SEG
ligne = CSRLIN
col = POS(0)
LOCATE ligne, col, 1
IF deb% = 65 OR prog = 11 THEN '===reconstitution
PRINT SPACE$(nl)
END IF
LOCATE ligne, col, 1
FOR ii = 1 TO nl + 1
input0:
IF ii <= 0 THEN ii = 1
DO
re$(ii) = INKEY$
' Obtient l'emplacement de la souris et l'état des boutons.
MousePoll v_mouse, h_mouse, lButton, rButton
'LOCATE 21, 1: PRINT "Position de la souris : "; v_mouse; ", ";
h_mouse '===
IF lButton THEN
IF prog = 5 AND v_mouse = 23 AND (h_mouse >= 39 AND h_mouse <= 57)
THEN
re$(ii) = "*"
CALL attendre(.5)
ELSEIF (prog = 3 OR prog = 11) AND v_mouse = 23 AND (h_mouse >= 51
AND h_mouse <= 60) THEN
'orth & reconst ===
re$(ii) = "*"
CALL attendre(.5)
ELSE
BEEP
END IF
END IF
LOOP WHILE re$(ii) = ""
IF ASC(re$(ii)) = 27 THEN CALL quitter(fond): ii = 1: EXIT FOR
IF prog = 3 OR prog = 5 OR prog = 11 THEN '=== ecrire et recolle,
reconstitution
IF re$(ii) = "*" THEN r$ = "*": LOCATE , , 0: EXIT SUB
END IF
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 input0 ELSE GOTO input0
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 input0 ELSE IF ASC(re$(ii)) = 8 THEN GOTO input0
IF deb = 33 AND ASC(re$(ii)) = 32 THEN EXIT FOR
IF ASC(re$(ii)) < deb OR ASC(re$(ii)) > fin THEN
IF deb = 48 THEN
CALL chiffres: r$ = "": EXIT FOR
COLOR , fond
ELSE
CALL lettres: r$ = "": EXIT FOR
COLOR , fond
END IF
END IF
IF ii = nl + 1 THEN BEEP: GOTO input0
PRINT re$(ii);
NEXT ii
PRINT
r$ = "": FOR JJ = 1 TO ii - 1: r$ = r$ + re$(JJ): NEXT
r$ = LTRIM$(r$): r$ = RTRIM$(r$)
r$ = UCASE$(r$)
IF fin% = 115 AND r$ = "" THEN LOCATE , , 0: EXIT SUB
IF r$ = "" THEN BEEP: LOCATE ligne, col: GOTO inpdebut
LOCATE , , 0
END SUB
DEFINT A-Z
SUB lettres ()
LOCATE 23, 1, 0
FOR i = 1 TO 40
x$ = x$ + CHR$(SCREEN(23, i))
NEXT
CALL ligne23
CALL centre(23, rougeclair, "Des lettres !")
CALL attendre2(1)
CALL ligne23
LOCATE 23, 1: PRINT x$
END SUB
DEFINT A-Z
SUB ligne23 ()
IF prog <> 5 AND prog <> 9 THEN COLOR , noir '=== recolle et repère
LOCATE 23, 1
PRINT SPACE$(co)
LOCATE 23, 1
END SUB
DEFINT A-Z
SUB niv (limit, xx)
COLOR noir, vert
LOCATE 21, 76: PRINT " "
IF limit + 1 - xx > 9 THEN LOCATE 21, 76 ELSE LOCATE 21, 77
PRINT limit + 1 - xx
COLOR blancbrill, bleu
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) OR r$ = CHR$(13)
END SUB
DEFINT A-Z
SUB pleinecran (r$, m$, co, v1, v2)
'pour sub espace
'20/11/96
m$ = RTRIM$(m$)
'_saisie plein ecran_
COLOR , noir
'CALL centre(22, vertclair, "Avec les flèches, déplace le curseur là
où tu veux insérer un espace.")
CALL centre(22, vertclair, "Place le curseur au début du mot suivant
puis tape la touche [espace].")
CALL centre(23, blanc, CHR$(24) + " " + CHR$(25) + " " + CHR$(27) +
" " + CHR$(26) + " Espace Ret.Arr Suppr " + rt$ + " = valider")
COLOR noir, blanc
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 > co - 2 THEN h = co - 2
LOCATE v, h, 1, 7 'curseur
souris = 0
DO
r$ = INKEY$
MousePoll v_mouse, h_mouse, lButton, rButton
'LOCATE 8: PRINT v_mouse, h_mouse, v1, v2'===
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 THEN
IF h_mouse >= 54 AND h_mouse <= 66 THEN
r$ = CHR$(13)
CALL attendre(.3)
ELSEIF h_mouse >= 25 AND h_mouse <= 30 THEN
'espace
r$ = CHR$(32)
CALL attendre(.2)
ELSEIF h_mouse >= 35 AND h_mouse <= 41 THEN
'del
r$ = CHR$(8)
CALL attendre(.2)
souris = 0
ELSEIF h_mouse = 14 THEN
'haut
r2 = 72
CALL attendre(.2)
souris = 2
EXIT DO
ELSEIF h_mouse = 16 THEN
'bas
r2 = 80
CALL attendre(.2)
souris = 2
EXIT DO
ELSEIF h_mouse = 18 THEN
'gauche
r2 = 75
CALL attendre(.2)
souris = 2
EXIT DO
ELSEIF h_mouse = 20 THEN
'droite
r2 = 77
CALL attendre(.2)
souris = 2
EXIT DO
ELSEIF h_mouse >= 45 AND h_mouse <= 49 THEN
'suppr
r2 = 83
CALL attendre(.2)
souris = 2
EXIT DO
ELSE
BEEP
END IF
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 OR souris = 2 THEN GOTO pl3
r2 = ASC(r$)
max = 356
IF r2 = 32 THEN
IF LEN(m$) > max THEN
BEEP
ELSE
m$ = MID$(m$, 1, lc - 1) + r$ + MID$(m$, lc)
h = h + 1
END IF
GOTO pl1
END IF
IF r2 = 8 THEN 'delete doit concerner seulement les espaces
IF h = 1 AND v = v1 THEN GOTO pl0
esp$ = MID$(m$, lc - 1, 1)
IF esp$ <> CHR$(32) THEN
BEEP
ELSE
m$ = MID$(m$, 1, lc - 2) + MID$(m$, lc): h = h - 1
IF h < 1 AND v > v1 THEN h = co: v = v - 1
END IF
GOTO pl0
END IF
pl3:
'carac étendu
IF souris = 0 THEN 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 = 83 THEN 'suppr doit concerner seulement les espaces
esp$ = MID$(m$, lc, 1)
IF esp$ <> CHR$(32) THEN
BEEP
ELSE
m$ = MID$(m$, 1, lc - 1) + MID$(m$, lc + 1)
GOTO pl0
END IF
END IF
GOTO pl2
END SUB
DEFINT A-Z
SUB quitter (fond)
'25/2/96
DIM c(co), x$(co)
MouseShow
F = 0
'on mémorise la zone quitter
LOCATE 23, 1, 0
COLOR blanc, noir
FOR i = 1 TO co
x$(i) = CHR$(SCREEN(23, i))
c(i) = SCREEN(23, i, 1): IF c(i) > 15 THEN F = 1 'erreur à cause du
fond
NEXT
LOCATE 23, 1: PRINT SPACE$(co)
LOCATE 23, (co / 2) + 1 - 11
BEEP: PRINT "Quitter ";
CALL ouinon(r$)
IF UCASE$(r$) = "O" THEN COLOR , 0: CLS : RUN "exo_le"
'on restitue la zone quitter
LOCATE 23, 1
FOR i = 1 TO co
IF F = 0 THEN
COLOR c(i)
END IF
PRINT x$(i);
NEXT
PRINT
COLOR 15, fond
END SUB
DEFINT A-Z
SUB recoepure (m$)
f1 = 0
IF LEN(m$) = 1 THEN EXIT SUB
IF RIGHT$(m$, 3) = "..." THEN m$ = MID$(m$, 1, LEN(m$) - 3)
az = ASC(RIGHT$(m$, 1)) 'fin mot
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 m$ = MID$(m$, 1,
LEN(m$) - 1): f1 = 1
az = ASC(LEFT$(m$, 1)) 'début mot
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
m$ = MID$(m$, 2, LEN(m$) - 1)
ELSEIF az = 34 OR az = 39 OR az = 40 OR az = 44 OR az = 45 OR az =
46 OR az = 58 OR az = 59 THEN m$ = MID$(m$, 2, LEN(m$) - 1)
END IF
IF MID$(m$, 2, 1) = "'" THEN m$ = MID$(m$, 3)
END SUB
DEFINT A-Z
SUB resultats (re)
'pour lecture
tit$ = titr$
titr$ = "resultats"
CALL titre
w! = LEN(tit$) / 2
IF w! = INT(LEN(tit$) / 2) THEN n = 4 ELSE n = 2
CALL cadre(5, 38 - INT(LEN(tit$) / 2), INT(LEN(tit$)) + n, 2, blanc)
COLOR , blanc
CALL centre(6, noir, tit$)
COLOR , bleu
IF re > 8 THEN
cc = vertclair: z$ = "Acquis"
ELSEIF re > 4 AND re < 9 THEN
cc = jaune: z$ = "En cours d'acquisition"
ELSE
cc = rougeclair: z$ = "Non acquis"
END IF
CALL centre(10, cc, z$)
CALL cadre(12, 20, 40, 2, rouge)
LOCATE 13
i2 = 0
FOR i = 1 TO re
LOCATE , 21 + i2: PRINT "████"; '219
i2 = i2 + 4
NEXT
COLOR noir, noir
FOR i = re + 1 TO 10
LOCATE , 21 + i2: PRINT " ";
i2 = i2 + 4
NEXT
PRINT
COLOR , bleu
CALL centre(16, 15, "Pourcentage de réussite :" + STR$(re * 10) + "
%")
CALL centre(18, 15, "(" + LTRIM$(STR$(re)) + " sur 10)")
END SUB
DEFINT A-Z
SUB tableauexo (p$())
'tableau des exercices
CALL cadre(7, 22, 36, 14, rouge)
COLOR blancbrill, bleu
LOCATE 23, 23: PRINT "["; : COLOR jaune: PRINT "Echap"; : COLOR
blancbrill: PRINT "] = Fin"
CALL centre(22, blanc, " " + gg2$ + " ")
IF eleve <> 0 THEN
COLOR blancbrill
LOCATE 23, 48: PRINT "["; : COLOR jaune: PRINT "*"; : COLOR
blancbrill: PRINT "] = Bilan"
END IF
l3$ = SPACE$(17) + "│"
l4$ = STRING$(17, "─") + "┼" + STRING$(18, "─")
l5$ = STRING$(17, "─") + "┬" + STRING$(18, "─")
l6$ = STRING$(17, "─") + "┴" + STRING$(18, "─")
COLOR blanc, rouge
LOCATE 8
LOCATE , 23: PRINT l5$
FOR i = 1 TO 5
LOCATE , 23: PRINT l3$
LOCATE , 23: PRINT l4$
NEXT
LOCATE , 23: PRINT l3$
LOCATE , 23: PRINT l6$
END SUB
DEFINT A-Z
SUB titre ()
COLOR , noir, noir: CLS
w$ = titr$
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
FOR i = 1 TO LEN(w$)
IF MID$(w$, i, 1) = "à" THEN
w$ = MID$(w$, 1, i - 1) + "A" + MID$(w$, i + 1)
END IF
NEXT
COLOR , vert
LOCATE 2, 1: PRINT SPACE$(co)
CALL centre(2, noir, UCASE$(w$))
LOCATE 21, 1: PRINT SPACE$(co)
VIEW PRINT 3 TO 20: COLOR blancbrill, bleu: CLS 2: VIEW PRINT
END SUB
DEFINT A-Z
SUB transmaj (m$)
'transforme le texte en majuscules
'21/9/94
FOR x = 1 TO LEN(m$)
IF MID$(m$, x, 1) = "é" THEN m$ = MID$(m$, 1, x - 1) + "E" +
MID$(m$, x + 1)
IF MID$(m$, x, 1) = "è" THEN m$ = MID$(m$, 1, x - 1) + "E" +
MID$(m$, x + 1)
IF MID$(m$, x, 1) = "ç" THEN m$ = MID$(m$, 1, x - 1) + "C" +
MID$(m$, x + 1)
IF MID$(m$, x, 1) = "ù" THEN m$ = MID$(m$, 1, x - 1) + "U" +
MID$(m$, x + 1)
IF MID$(m$, x, 1) = "à" THEN m$ = MID$(m$, 1, x - 1) + "A" +
MID$(m$, x + 1)
IF MID$(m$, x, 1) = "ô" THEN m$ = MID$(m$, 1, x - 1) + "O" +
MID$(m$, x + 1)
IF MID$(m$, x, 1) = "û" THEN m$ = MID$(m$, 1, x - 1) + "U" +
MID$(m$, x + 1)
IF MID$(m$, x, 1) = "î" THEN m$ = MID$(m$, 1, x - 1) + "I" +
MID$(m$, x + 1)
IF MID$(m$, x, 1) = "â" THEN m$ = MID$(m$, 1, x - 1) + "A" +
MID$(m$, x + 1)
IF MID$(m$, x, 1) = "ê" THEN m$ = MID$(m$, 1, x - 1) + "E" +
MID$(m$, x + 1)
IF MID$(m$, x, 1) = "ï" THEN m$ = MID$(m$, 1, x - 1) + "I" +
MID$(m$, x + 1)
IF MID$(m$, x, 1) = "ë" THEN m$ = MID$(m$, 1, x - 1) + "E" +
MID$(m$, x + 1)
NEXT
m$ = UCASE$(m$)
END SUB
DEFINT A-Z
SUB tri (n$(), no)
FOR i = 1 TO no - 1
m = 0
FOR j = 1 TO no - i
IF n$(j + 1) < n$(j) THEN SWAP n$(j), n$(j + 1)
m = 1
NEXT j
IF m = 0 THEN EXIT FOR
NEXT i
END SUB
DEFINT A-Z
SUB tropcourt (x)
CALL titre
BEEP
IF x = 1 THEN
CALL centre(12, rougeclair, "Le texte est trop court !")
ELSE
CALL centre(12, rougeclair, "Le paragraphe est trop court !")
END IF
CALL entree(noir, 0)
COLOR , bleu: CLS : RUN "exo_le"
END SUB
|
 
|
DECLARE SUB niv (limit%, xx%)
DECLARE SUB quitter (fond%)
DECLARE SUB afformate (m$(), nm%, v%, h%)
DECLARE SUB erreur ()
DECLARE SUB Exact ()
DECLARE SUB erreur2 ()
DECLARE SUB MouseHide ()
DECLARE SUB MousePoll (row%, col%, lButton%, rButton%)
DECLARE SUB getinvimouse (rr%)
DECLARE SUB fleches (v%, h%, w$(), np%, r%, coul%, drap%, v2%, h3%)
DECLARE SUB consigne (nl%, w$, z$, y$)
DECLARE SUB cadre (v%, h%, l%, nli%, C%)
DECLARE SUB cadre2 (v%, h%, l%, nli%, C%, c2%, rouge%)
DECLARE SUB titre ()
DECLARE SUB resultats (re%)
DECLARE SUB inputgen (x%, y%, nl%, r$, deb%, fin%)
DECLARE SUB enregistrement (re%, mat%, VarEnreg AS ANY)
DECLARE SUB affectmots (m$, m$(), nm%)
DECLARE SUB chrono (v%, h%, duree%, temps!)
DECLARE SUB recoepure (m$)
DECLARE SUB epure (m$)
DECLARE SUB ligne23 ()
DECLARE SUB tropcourt (x%)
DECLARE SUB entree (x%, flag%)
DECLARE SUB convertir (z$)
DECLARE SUB centre (v%, coul%, ph$)
DECLARE SUB getinvi (rr%)
DECLARE SUB attendre (tx!)
DECLARE SUB lettres ()
DECLARE SUB tri (n$(), no%)
DECLARE SUB attendre2 (tx!)
DECLARE SUB transmaj (m$)
DECLARE SUB exact2 ()
DECLARE SUB choixparag (np%, r%)
'EXO 2
'LECTURE Primaire
'18/05/96
'Daniel CLERC
DEFINT A-Z
SUB Chercher (co, re, parag, couleur, rt$, gg$, gg2$, pre$, titr$,
n$(), prog, noir, bleu, vert, rouge, marron, blanc, vertclair,
cyanclair, rougeclair, jaune, blancbrill)
'21/12/96
DIM m$(400), p$(45), z(10)
nu = 1
ct = 0
w$ = "Un mot va être affiché"
z$ = "très rapidement."
y$ = "Tu devras le retrouver dans une liste."
CALL consigne(3, w$, z$, y$)
CALL titre
np = 0: re = 0
'affect mots
ch1:
m$ = n$(nu)
CALL affectmots(m$, m$(), nm)
FOR i = 1 TO nm
CALL epure(m$(i))
IF m$(i) <> ":" AND m$(i) <> ";" AND m$(i) <> "?" AND m$(i) <> "!"
AND LEN(m$(i)) < 21 THEN
np = np + 1
p$(np) = m$(i)
END IF
IF np = 36 THEN EXIT FOR
NEXT
IF np < 36 AND nu < parag THEN nu = nu + 1: GOTO ch1
IF np < 5 THEN
CALL tropcourt(1)
EXIT SUB
END IF
longueur = 0
FOR i = 1 TO np
l1 = LEN(p$(i)): IF longueur < l1 THEN longueur = l1
NEXT
nb = 0
FOR i = 1 TO np
IF LEN(p$(i)) < 3 THEN nb = nb + 1
NEXT
FOR ii = 1 TO 5 '+++++++++++++
DO
IF np < 10 THEN
DO
nt = INT(RND * np) + 1
LOOP WHILE nt = zz
zz = nt
ELSE
DO
f = 0
z(ii) = INT(RND * np) + 1
FOR j = 1 TO ii - 1
IF z(ii) = z(j) THEN f = 1: EXIT FOR
NEXT
LOOP WHILE f = 1
nt = z(ii)
END IF
re$ = p$(nt)
LOOP WHILE LEN(re$) < 3 AND np - nb > 10
che3:
COLOR , noir: LOCATE 23, 1: PRINT SPACE$(co)
VIEW PRINT 3 TO 20: COLOR , bleu: CLS 2: VIEW PRINT
r1$ = re$: r1$ = UCASE$(r1$)
CALL niv(5, ii)
CALL cadre(10, INT(41 - LEN(re$) / 2) - 3, LEN(re$) + 4, 4, rouge)
COLOR blancbrill, rouge
LOCATE 12, INT(41 - LEN(re$) / 2): PRINT re$
COLOR , noir
IF ct = 0 THEN
CALL centre(23, blanc, "Lis le mot")
ELSE
CALL centre(23, blanc, "Relis le mot")
END IF
CALL attendre2(1 + ct)
LOCATE 23, 78: PRINT " "
COLOR blancbrill, bleu
VIEW PRINT 3 TO 20: CLS 2: VIEW PRINT
IF ct <> 0 THEN
IF couleur = 1 THEN
COLOR , vert
CALL centre(4, blancbrill, " " + re$ + " ")
ELSE
COLOR , blanc
CALL centre(4, noir, " " + re$ + " ")
END IF
COLOR , bleu
END IF
TT = 0
GOSUB cheaf
COLOR rouge, noir: LOCATE 23, 1: PRINT SPACE$(co): LOCATE 23, 37
r2$ = p$(r): r2$ = UCASE$(r2$)
IF temps > 20 THEN
re = re - 1: BEEP: CALL centre(23, rougeclair, "Trop lent !")
CALL attendre2(2)
GOTO che3
ELSEIF r2$ <> r1$ THEN
ct = ct + 1: IF ct > 2 THEN ct = 2
CALL erreur
GOTO che3
ELSE
CALL Exact
IF ct = 0 THEN re = re + 2
ct = 0
END IF
NEXT ii '++++++++
IF re < 0 THEN re = 0
CALL resultats(re)
EXIT SUB
cheat:
DEF SEG = 0
POKE 1050, PEEK(1052)
DEF SEG
duree = 30
depart = VAL(RIGHT$(TIME$, 2))
IF depart < 60 - duree THEN
fin = duree + depart
ELSE
fin = duree + depart - 60
END IF
RETURN
cheat1:
souris = 0
DO
seconde = VAL(RIGHT$(TIME$, 2))
IF seconde >= depart THEN
temps = -(depart - seconde)
ELSE
temps = 60 - depart + seconde
END IF
IF temps < 10 THEN LOCATE 4, 77 ELSE LOCATE 4, 76
COLOR blancbrill, rouge
PRINT LTRIM$(STR$(temps))
COLOR noir, blanc
r$ = INKEY$
MousePoll v_mouse, h_mouse, lButton, rButton
' LOCATE 20, 1: PRINT v_mouse, h_mouse, v, v + ll - 1'===
IF lButton THEN
IF v_mouse >= v_mini AND v_mouse <= v_mini + ll - 1 THEN
SELECT CASE colonnes
CASE 1
IF h_mouse >= h1 AND h_mouse <= h1 + longueur THEN
LOCATE v_mini
FOR i = 1 TO np
LOCATE , h1: PRINT p$(i)
NEXT
calcul = v_mouse - v_mini + 1
LOCATE v_mouse, h1
COLOR noir, vert
PRINT p$(calcul)
CALL attendre(.5)
r = calcul
souris = 1
EXIT DO
END IF
CASE 2
IF (h_mouse >= h1 AND h_mouse <= h1 + longueur) OR (h_mouse >= h3
AND h_mouse <= h3 + longueur) THEN
IF v_mouse = v_mini + ll - 1 AND (h_mouse >= h3 AND h_mouse <= h3 +
longueur) AND paire = 0 THEN
BEEP
ELSE
LOCATE v_mini
FOR i = 1 TO ll
LOCATE , h1: PRINT p$(i)
NEXT
LOCATE v_mini
FOR i = ll + 1 TO np
LOCATE , h3: PRINT p$(i)
NEXT
IF h_mouse < h3 THEN
calcul = v_mouse - v_mini + 1
LOCATE v_mouse, h1
ELSE
calcul = (v_mouse + ll) - v_mini + 1
LOCATE v_mouse, h3
END IF
COLOR noir, vert
PRINT p$(calcul)
CALL attendre(.5)
r = calcul
souris = 1
EXIT DO
END IF
END IF
CASE 3
IF (h_mouse >= h1 AND h_mouse <= h1 + longueur) OR (h_mouse >= h3
AND h_mouse <= h3 + longueur) OR (h_mouse >= h3 AND h_mouse <= h3 +
longueur) THEN
IF v_mouse = v_mini + ll - 1 AND (h_mouse >= h3 AND h_mouse <= h3 +
longueur) AND paire = 0 THEN
BEEP
ELSE
LOCATE v_mini
FOR i = 1 TO ll
LOCATE , h1: PRINT p$(i)
NEXT
LOCATE v_mini
FOR i = ll + 1 TO ll * 2
LOCATE , h3: PRINT p$(i)
NEXT
LOCATE v_mini
FOR i = (ll * 2) + 1 TO np
LOCATE , h3: PRINT p$(i)
NEXT
IF h_mouse < h3 THEN
calcul = v_mouse - v_mini + 1
LOCATE v_mouse, h1
ELSEIF h_mouse < h3 THEN
calcul = (v_mouse + ll) - v_mini + 1
LOCATE v_mouse, h3
ELSE
calcul = (v_mouse + (2 * ll)) - v_mini + 1
LOCATE v_mouse, h3
END IF
COLOR noir, vert
PRINT p$(calcul)
CALL attendre(.5)
r = calcul
souris = 1
EXIT DO
END IF
END IF
END SELECT
ELSEIF v_mouse = 23 THEN
SELECT CASE colonnes
CASE 2, 3
IF h_mouse >= 46 AND h_mouse <= 48 THEN
r$ = CHR$(13)
CALL attendre(.3)
ELSEIF h_mouse = 33 THEN
'haut
rr = 72
CALL attendre(.2)
souris = 2
ELSEIF h_mouse = 35 THEN
'bas
rr = 80
CALL attendre(.2)
souris = 2
ELSEIF h_mouse = 37 THEN
'gauche
rr = 75
CALL attendre(.2)
souris = 2
ELSEIF h_mouse = 39 THEN
'droite
rr = 77
CALL attendre(.2)
souris = 2
END IF
CASE 1
IF h_mouse >= 44 AND h_mouse <= 46 THEN
r$ = CHR$(13)
CALL attendre(.3)
ELSEIF h_mouse = 35 THEN
'haut
rr = 72
CALL attendre(.2)
souris = 2
ELSEIF h_mouse = 37 THEN
'bas
rr = 80
CALL attendre(.2)
souris = 2
END IF
END SELECT
END IF
END IF
IF r$ = CHR$(13) THEN EXIT DO
IF r$ = CHR$(27) THEN
CALL quitter(bleu)
GOTO cheat1
END IF
IF LEN(r$) = 2 OR souris = 2 THEN EXIT DO
LOOP WHILE seconde <> fin
IF souris = 1 THEN rr = 13: RETURN
IF temps = 30 THEN rr = 13: RETURN
IF LEN(r$) < 2 AND souris = 0 THEN
IF ASC(r$) = 13 THEN
rr = 13: RETURN
ELSE
GOTO cheat1
END IF
END IF
IF souris = 0 THEN rr = ASC(RIGHT$(r$, 1))
RETURN
cheaf:
'données
souris = 0
ll = 12: v = 7: v_mini = v
r = 1: rr = 0
paire = 1
IF np <= ll THEN
h = 33: h1 = h: h3 = 0: h3 = 0
colonnes = 1
ll_dernier = np
ELSEIF np <= 2 * ll THEN
h = 20: h1 = h: h3 = 50: h3 = 0
ll = INT(np / 2)
IF np / 2 <> INT(np / 2) THEN paire = 0: ll = ll + 1
colonnes = 2
ll_dernier = np - ll
ELSE
h = 5: h1 = h: h3 = 33: h3 = 61
ll = INT(np / 3)
IF np / 3 <> INT(np / 3) THEN paire = 0: ll = ll + 1
colonnes = 3
ll_dernier = np - (2 * ll)
END IF
CALL cadre(v - 1, 3, 74, ll + 1, blanc)
COLOR noir, blanc
SELECT CASE colonnes
CASE 1
LOCATE v
FOR i = 1 TO np: LOCATE , h1: PRINT p$(i): NEXT
CASE 2
LOCATE v
FOR i = 1 TO ll: LOCATE , h1: PRINT p$(i): NEXT
LOCATE v
FOR i = ll + 1 TO np: LOCATE , h3: PRINT p$(i): NEXT
CASE 3
LOCATE v
FOR i = 1 TO ll: LOCATE , h1: PRINT p$(i): NEXT
LOCATE v
FOR i = ll + 1 TO 2 * ll: LOCATE , h3: PRINT p$(i): NEXT
LOCATE v
FOR i = (2 * ll) + 1 TO np: LOCATE , h3: PRINT p$(i): NEXT
END SELECT
'fleches
COLOR , noir
IF colonnes = 1 THEN CALL centre(23, blanc, gg$) ELSE CALL
centre(23, blanc, gg2$)
COLOR noir, vert
LOCATE v, h1
PRINT p$(1)
COLOR noir, blanc
CALL cadre(3, 75, 2, 2, rouge)
COLOR blancbrill, rouge
GOSUB cheat
DO
GOSUB cheat1
IF souris = 0 OR souris = 2 THEN
LOCATE v, h
PRINT p$(r)
GOSUB chedi
LOCATE v, h
COLOR noir, vert
PRINT p$(r)
END IF
COLOR , blanc
LOOP WHILE rr <> 13
RETURN
chedi:
IF colonnes = 1 THEN
GOTO chedi1
ELSEIF colonnes = 2 THEN
IF rr = 75 THEN r = r - ll: h = h1: GOTO chedi2 'gauche
IF rr = 77 THEN r = r + ll: h = h3: GOTO chedi2 'droite
ELSEIF colonnes = 3 THEN
IF rr = 75 THEN r = r - ll: h = h - 28: GOTO chedi2 'gauche
IF rr = 77 THEN r = r + ll: h = h + 28: GOTO chedi2 'droite
END IF
chedi1:
IF rr = 72 THEN v = v - 1: r = r - 1 'haut
IF rr = 80 THEN v = v + 1: r = r + 1 'bas
chedi2:
IF r = ll + 1 THEN v = v_mini: h = h3
IF r = ll THEN v = ll + (v_mini - 1): h = h1
IF r = 2 * ll + 1 THEN v = v_mini: h = h3
IF r = 2 * ll THEN v = ll + (v_mini - 1): h = h3
IF r > np THEN r = 1: v = v_mini: h = h1
IF r >= 1 THEN RETURN
r = np
IF np <= ll THEN v = (v_mini - 1) + np: RETURN
IF np <= 2 * ll THEN v = (v_mini - 1) + np - ll: h = h3: RETURN
v = (v_mini - 1 + np) - 2 * ll: h = h3
RETURN
END SUB
DEFINT A-Z
SUB compter (re, couleur, co, parag, rt$, pre$, titr$, n$(), prog,
noir, bleu, vert, rouge, marron, blanc, vertclair, cyanclair,
rougeclair, jaune, blancbrill)
DIM m$(400), m2$(55), re$(5), z(10)
'22/12/96
nu = 1
w$ = "Un mot va être affiché."
z$ = "Dans une liste, tu devras compter"
y$ = "le nombre de fois qu'il sera apparu."
CALL consigne(3, w$, z$, y$)
n2 = 0
compte3:
m$ = n$(nu)
CALL affectmots(m$, m$(), nm)
FOR i = 1 TO nm
CALL epure(m$(i))
IF LEN(m$(i)) > 2 AND LEN(m$(i)) < 12 THEN
n2 = n2 + 1
m2$(n2) = m$(i)
END IF
IF n2 = 52 THEN EXIT FOR
NEXT
IF n2 < 52 AND nu < parag THEN nu = nu + 1: GOTO compte3
IF n2 < 8 THEN
CALL tropcourt(1)
EXIT SUB
END IF
'debut
CALL titre
re = 10
FOR boucle = 1 TO 5 '+++++++++++++++++++++
FOR i = 1 TO n2
m$(i) = m2$(i)
NEXT
IF n2 < 10 THEN
DO
nt = INT(RND * n2) + 1
LOOP WHILE nt = zz
zz = nt
ELSE
DO
f = 0
z(boucle) = INT(RND * n2) + 1
FOR j = 1 TO boucle - 1
IF z(boucle) = z(j) THEN f = 1: EXIT FOR
NEXT
LOOP WHILE f = 1
nt = z(boucle)
END IF
qu$ = m$(nt)
l2 = INT(RND * 9) + 3
FOR i = 1 TO n2
IF LEN(m$(i)) = l2 THEN m$(i) = qu$
NEXT
qu = 0
FOR i = 1 TO n2
IF m$(i) = qu$ THEN qu = qu + 1
NEXT
MouseHide
VIEW PRINT 3 TO 20: COLOR , bleu: CLS 2: VIEW PRINT: CALL ligne23
CALL niv(5, boucle)
CALL cadre(10, INT((co / 2 + 1) - LEN(qu$) / 2) - 2, LEN(qu$) + 2,
4, rouge)
COLOR , rouge
CALL centre(12, blancbrill, qu$)
COLOR , noir
CALL centre(23, blanc, "Mémorise le mot")
CALL attendre2(1.5)
VIEW PRINT 3 TO 20: COLOR , bleu: CLS 2: VIEW PRINT
COLOR , vert
CALL centre(4, blancbrill, " " + qu$ + " ")
ff = 0: GOSUB compteaf: GOSUB compteat
COLOR , bleu
LOCATE 5, 1: PRINT SPACE$(72)
VIEW PRINT 6 TO 20: COLOR , bleu: CLS 2: VIEW PRINT
CALL ligne23
CALL centre(23, blanc, "Tape ta réponse")
CALL cadre(10, co / 2 - 2, 4, 4, rouge)
COLOR , rouge
COLOR blancbrill: LOCATE 12, co / 2: PRINT " "; : LOCATE 12, co / 2
DEF SEG = 0
POKE &H417, (PEEK(&H417) OR &h30)'numérique
POKE &H417, (PEEK(&H417) OR &H40) 'MAJ
DEF SEG
CALL inputgen(blancbrill, rouge, 2, r$, 48, 57)
r = VAL(r$)
VIEW PRINT 6 TO 20: COLOR , bleu: CLS 2: VIEW PRINT
CALL ligne23
ff = 1: GOSUB compteaf
COLOR , noir
IF nm < 39 THEN limit = 15 ELSE limit = 20
IF r = qu THEN
IF t! > limit THEN
re = re - 1
CALL centre(23, jaune, "Exact mais trop lent !")
ELSE
CALL exact2
COLOR noir, 0
CALL centre(23, blanc, rt$)
END IF
CALL getinvimouse(w)
ELSE
re = re - 2
w$ = "Il y avait" + STR$(qu) + " fois « " + qu$ + " »."
CALL centre(23, rougeclair, w$)
CALL getinvimouse(w)
END IF
NEXT boucle '+++++++++++++++++
IF re < 0 THEN re = 0
CALL resultats(re)
'CALL enregistrement(re, 6, VarEnreg)'===
EXIT SUB
compteat:
CALL ligne23
CALL centre(23, blanc, "Compte puis tape " + rt$)
COLOR , bleu: CALL chrono(4, co - 2, 30, t!)
COLOR , bleu
RETURN
compteaf:
'affichage en colonne
IF n2 < 14 THEN
h = 35: longueur = 15
ELSEIF n2 < 27 THEN
h = 30: longueur = 2 * 15 - 2
ELSEIF n2 < 40 THEN
h = 20: longueur = 3 * 15 - 2
ELSE
h = 15: longueur = 4 * 15 - 2
END IF
CALL cadre(5, h - 3, longueur, 14, blanc)
f = 0: nn = 13: nbis = 1
DO
IF n2 < nn THEN nn = n2: f = 1
LOCATE 6, , 0
FOR i = nbis TO nn
IF ff = 1 AND m$(i) = qu$ THEN
COLOR jaune, rouge
ELSE
COLOR noir, blanc
END IF
LOCATE , h: PRINT m$(i)
NEXT
nbis = nn + 1
nn = nn + 13
h = h + 15
LOOP WHILE f = 0
RETURN
END SUB
DEFINT A-Z
SUB deviner (co, re, parag, n$(), rt$, gg$, pre$, titr$, prog%,
nom$, noir%, bleu%, vert%, rouge%, marron%, blanc%, vertclair%,
cyanclair%, rougeclair%, jaune%, blancbrill%)
'15/4/96
DIM z(20), lettre$(26), m$(400), mot$(400), m2$(400)
l$ = STRING$(40, 196)
lp$ = STRING$(20, ".")
w$ = "Tu vas deviner un mot du texte."
z$ = "Conseil : cherche d'abord les voyelles."
CALL consigne(2, w$, z$, y$)
nu = 1
m$ = n$(nu)
l = LEN(m$)
CALL affectmots(m$, m$(), nm)
'pour l'aide
CALL affectmots(m$, m2$(), nm2)
FOR i = 1 TO nm
CALL recoepure(m$(i))
CALL recoepure(m$(i))
CALL recoepure(m$(i))
NEXT
nf = 0
FOR i = 1 TO nm
IF LEN(m$(i)) >= 4 AND LEN(m$(i)) < 9 THEN
nf = nf + 1: mot$(nf) = m$(i)
END IF
NEXT
IF nf < 7 THEN
CALL tropcourt(2)
EXIT SUB
END IF
'IF nu = 1 THEN CALL entree(noir, 1)
'prg principal +++++++++++++++++
ct! = 0
FOR ii = 1 TO 5 '+++++++++++++++++++++++++++++++
compteur = 0: boucle = 1: boucle2 = 1
DO
DO
f = 0
z(ii) = INT(RND * nf) + 1
FOR j = 1 TO ii - 1
IF z(ii) = z(j) THEN f = 1: EXIT FOR
NEXT
LOOP WHILE f = 1
nn = z(ii)
mot$ = mot$(nn)
'espace, tirets et guillemets -> non tiré
z = 0
FOR x = 1 TO LEN(mot$)
z$ = MID$(mot$, x, 1)
IF z$ = "'" OR z$ = " " OR z$ = "-" THEN z = 1: EXIT FOR
NEXT
LOOP WHILE z = 1
limite = LEN(mot$) + 5
mot2$ = MID$(lp$, 1, LEN(mot$))
'transformation en majuscules
CALL transmaj(mot$)
CALL titre
CALL niv(5, ii)
CALL cadre(16, 28, 24, 2, vert)
'saisie
DO
CALL cadre(5, 28, 24, 2, rouge)
CALL cadre(10, 28, 24, 4, blanc)
devine1:
COLOR , rouge
IF limite - boucle2 > 1 THEN
CALL centre(6, blancbrill, LTRIM$(STR$(limite - boucle2)) + "
essais")
ELSE
CALL centre(6, blancbrill, "Dernier essai")
END IF
COLOR , rouge
COLOR , blanc: CALL centre(12, noir, mot2$): COLOR blancbrill
CALL ligne23
DO
COLOR , noir
CALL centre(23, blanc, "Tape une lettre [*] = aide")
COLOR noir, blanc
DEF SEG = 0
POKE 1050, PEEK(1052)
DEF SEG
DO
r$ = INKEY$
MousePoll v_mouse, h_mouse, lButton, rButton
'LOCATE 21, 1: PRINT "Position de la souris : "; v_mouse; ", ";
h_mouse '===
IF lButton THEN
IF v_mouse = 23 AND (h_mouse >= 47 AND h_mouse <= 56) THEN
r$ = "*"
CALL attendre(.3)
ELSE
BEEP
END IF
END IF
LOOP WHILE r$ = ""
IF LEN(r$) < 2 THEN r = ASC(r$) ELSE BEEP: r = 0
IF r = 27 THEN CALL quitter(blanc): r = 0
LOOP WHILE r = 0
IF CHR$(r) = "*" THEN
GOSUB aidedevine
GOTO devine1
END IF
IF CHR$(r) = "é" THEN r = ASC("e")
IF CHR$(r) = "è" THEN r = ASC("e")
IF CHR$(r) = "ç" THEN r = ASC("c")
IF CHR$(r) = "ù" THEN r = ASC("u")
IF CHR$(r) = "à" THEN r = ASC("a")
IF CHR$(r) = "â" THEN r = ASC("a")
IF CHR$(r) = "ê" THEN r = ASC("e")
IF CHR$(r) = "î" THEN r = ASC("i")
IF CHR$(r) = "ô" THEN r = ASC("o")
IF CHR$(r) = "û" THEN r = ASC("u")
IF CHR$(r) = "ë" THEN r = ASC("e")
IF (r > 64 AND r < 91) OR (r > 96 AND r < 123) THEN
IF r > 96 THEN r = r - 32
'tester si lettre pas encore proposée
f = 0
FOR j = 1 TO boucle - 1
IF lettre$(j) = CHR$(r) THEN f = 1: EXIT FOR
NEXT
IF f = 1 THEN
BEEP: COLOR , noir
LOCATE 23, 1: PRINT SPACE$(co)
CALL centre(23, rougeclair, "Lettre déjà proposée"): CALL
attendre2(.7)
LOCATE 23: PRINT SPACE$(co)
GOTO devine1
END IF
COLOR , noir
s2 = 1
DO
s = INSTR(s2, mot$, CHR$(r))
IF s <> 0 THEN
mot2$ = MID$(mot2$, 1, s - 1) + CHR$(r) + MID$(mot2$, s + 1)
COLOR , blanc: CALL centre(12, noir, mot2$): COLOR blancbrill
s2 = s + 1
compteur = compteur + 1
IF boucle + 1 >= limite THEN
boucle2 = boucle2 - 1 'dernier essai juste
END IF
END IF
LOOP WHILE s <> 0
ELSE
CALL lettres
GOTO devine1
END IF
lettre$(boucle) = CHR$(r)
GOSUB devine15
boucle = boucle + 1
boucle2 = boucle2 + 1
IF boucle2 = limite THEN
BEEP
ct! = ct! + 2
COLOR , bleu
LOCATE 5, 1: FOR i = 1 TO 4: PRINT SPACE$(co): NEXT
CALL cadre(10, 28, 24, 4, rouge)
COLOR , rouge: CALL centre(12, blanc, mot$)
COLOR , noir
LOCATE 23, 1: PRINT SPACE$(co)
CALL centre(23, rougeclair, "Solution")
CALL getinvimouse(w)
COLOR , bleu
EXIT DO
END IF
IF compteur = LEN(mot$) THEN
CALL titre
CALL cadre(10, 28, 24, 4, blanc)
COLOR , blanc
CALL centre(12, noir, mot$)
CALL exact2
CALL entree(noir, 1)
EXIT DO
END IF
LOOP
FOR i = 1 TO 12: lettre$(i) = "": NEXT
NEXT ii '+++++++++++++++++++++++++++++++++
re = INT(10 - ct!)
IF re < 0 THEN re = 0
CALL resultats(re)
'CALL enregistrement(re, 5, VarEnreg)
EXIT SUB
devine15:
'afficher les lettres utilisées
m$ = ""
FOR i = 1 TO boucle
m$ = m$ + " " + lettre$(i)
NEXT
m$ = RTRIM$(LTRIM$(m$))
IF LEN(m$) > 24 THEN
CALL cadre(16, INT(41 - LEN(m$) / 2) - 2, LEN(m$) + 2, 2, vert)
ELSE
CALL cadre(16, 28, 24, 2, vert)
END IF
COLOR , vert
CALL centre(17, blancbrill, m$)
RETURN
aidedevine:
ct! = ct! + .25
CALL titre
COLOR , bleu
CALL centre(6, jaune, "Aide")
CALL afformate(m2$(), nm2, 10, 10)
CALL entree(noir, 0)
CALL titre
CALL cadre(5, 28, 24, 2, rouge)
CALL cadre(10, 28, 24, 4, blanc)
GOSUB devine15
RETURN
END SUB
DEFINT A-Z
SUB ecrire (couleur, re, co, parag, rt$, pre$, titr$, n$(), prog,
noir, bleu, vert, rouge, marron, blanc, vertclair, cyanclair,
rougeclair, jaune, blancbrill)
'21/2/96
DIM m$(400), m2$(400), z(21)
l$ = STRING$(39, 196)
lp$ = STRING$(39, ".")
w$ = "L'ordinateur va effacer des mots"
z$ = "dans le texte."
y$ = "Tu devras les retaper."
CALL consigne(3, w$, z$, y$)
nu = 1
IF parag > 1 THEN
CALL choixparag(parag, nu)
END IF
a = 0: C = 0: ct = 0
'affect mots
m$ = n$(nu)
numero = LEN(m$) / 60
SELECT CASE numero
CASE 1
ligne = 12
CASE 2
ligne = 11
CASE 3
ligne = 10
CASE 4
ligne = 9
CASE ELSE
ligne = 8
END SELECT
CALL affectmots(m$, m$(), nm)
'affect 2
FOR i = 1 TO nm
m2$(i) = m$(i)
NEXT i
nb = 0
FOR i = 1 TO nm
IF LEN(m$(i)) > 2 THEN nb = nb + 1
NEXT
CALL titre
IF nb < 4 THEN
CALL tropcourt(2)
EXIT SUB
END IF
IF nb < 10 THEN lm = 2 ELSE lm = 3
CALL afformate(m$(), nm, ligne, 10)
COLOR , noir
CALL centre(23, blanc, "Mémorise le texte puis tape " + rt$)
CALL getinvimouse(r)
IF nb > 10 THEN nb = 10
FOR ll = 1 TO nb
CALL niv(nb, ll)
orth3:
DO
f = 0
z(ll) = INT(RND * nm) + 1
FOR j = 1 TO ll - 1
IF z(ll) = z(j) THEN f = 1: EXIT FOR
NEXT
LOOP WHILE f = 1
nn = z(ll)
IF LEN(m2$(nn)) < lm THEN GOTO orth3
r2$ = m2$(nn): m$(nn) = LEFT$(l$, LEN(m2$(nn)))
'test fin mot
IF RIGHT$(r2$, 3) = "..." THEN m$(nn) = MID$(l$, 1, LEN(r2$) - 3) +
"...": r2$ = MID$(r2$, 1, LEN(r2$) - 3): GOTO orth10
f = 0
az = ASC(RIGHT$(r2$, 1))
'point & virgule
IF az = 44 OR az = 46 THEN m$(nn) = MID$(l$, 1, LEN(m$(nn)) - 1) +
CHR$(az): r2$ = MID$(r2$, 1, LEN(r2$) - 1): f = 1
az = ASC(RIGHT$(r2$, 1))
IF az = 33 OR az = 34 OR az = 39 OR az = 41 OR az = 45 OR az = 58 OR
az = 59 OR az = 63 THEN
IF f = 0 THEN
m$(nn) = MID$(l$, 1, LEN(m$(nn)) - 1) + CHR$(az): r2$ = MID$(r2$, 1,
LEN(r2$) - 1)
ELSE
m$(nn) = MID$(m$(nn), 1, LEN(m$(nn)) - 2) + CHR$(az) +
RIGHT$(m$(nn), 1): r2$ = MID$(r2$, 1, LEN(r2$) - 1): f = 2
END IF
END IF
az = ASC(RIGHT$(r2$, 1))
IF az = 34 OR az = 41 THEN
IF f = 2 THEN
m$(nn) = MID$(m$(nn), 1, LEN(m$(nn)) - 3) + CHR$(az) +
RIGHT$(m$(nn), 2): r2$ = MID$(r2$, 1, LEN(r2$) - 1)
ELSE
m$(nn) = MID$(m$(nn), 1, LEN(m$(nn)) - 2) + CHR$(az) +
RIGHT$(m$(nn), 1): r2$ = MID$(r2$, 1, LEN(r2$) - 1)
END IF
END IF
orth10:
'test debut mot
az = ASC(LEFT$(r2$, 1))
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 m$(nn) = CHR$(az) + MID$(m$(nn), 2): r2$ =
MID$(r2$, 2): f = 3'début mot
az = ASC(LEFT$(r2$, 1))
IF az = 34 OR az = 40 THEN m$(nn) = LEFT$(m$(nn), 1) + CHR$(az) +
MID$(m$(nn), 3): r2$ = MID$(r2$, 2): f = 4
'test guillemet
z = INSTR(1, r2$, "'")
IF z <> 0 THEN
IF f = 3 THEN
m$(nn) = MID$(m2$(nn), 1, z + 1) + MID$(m$(nn), z + 2)
ELSEIF f = 4 THEN
m$(nn) = MID$(m2$(nn), 1, z + 2) + MID$(m$(nn), z + 3)
ELSE
m$(nn) = MID$(m2$(nn), 1, z) + MID$(m$(nn), z + 1)
END IF
r2$ = MID$(r2$, z + 1)
END IF
IF z <> 0 THEN GOTO orth11
'test tiret
IF r2$ = "-" THEN GOTO orth11
z = INSTR(1, r2$, "-")
IF z <> 0 THEN
IF f = 3 THEN
m$(nn) = MID$(m$(nn), 1, z) + MID$(m2$(nn), z + 1)
ELSEIF f = 4 THEN
m$(nn) = MID$(m$(nn), 1, z + 1) + MID$(m2$(nn), z + 2)
ELSE
m$(nn) = MID$(m$(nn), 1, z - 1) + MID$(m2$(nn), z)
END IF
r2$ = MID$(r2$, 1, z - 1)
END IF
orth11:
r3$ = UCASE$(r2$)
CALL afformate(m$(), nm, ligne, 10)
orth1:
COLOR , noir
LOCATE 23, 1: PRINT SPACE$(80)
CALL centre(23, blanc, "Tape le mot" + SPACE$(20) + "[*] = Aide")
CALL cadre(17, 30, 20, 2, rouge)
COLOR , rouge
CALL centre(18, blanc, MID$(lp$, 1, LEN(r2$)))
LOCATE 18, INT(41 - (LEN(r2$) / 2))
CALL inputgen(blancbrill, rouge, LEN(r2$), r$, 31, 155)
IF r$ = "*" THEN
GOSUB orthaide: GOTO orth1
END IF
COLOR , noir: LOCATE 23, 1: PRINT SPACE$(80)
IF r$ = r3$ THEN
CALL exact2
ELSE
C = C + 1: IF C = 1 THEN ct = ct + 1
IF C > 1 THEN
BEEP
CALL centre(23, rougeclair, "Solution : " + r2$)
CALL attendre(1.5)
ELSE
CALL erreur2
END IF
COLOR blancbrill
GOTO orth1
END IF
C = 0
m$(nn) = m2$(nn)
NEXT ll
pt! = 10 / nb
re = INT(10 - (ct * pt!)) - (a / 2): IF re < 0 THEN re = 0
CALL resultats(re)
'CALL enregistrement(re, 2, VarEnreg)
EXIT SUB
'--------------------------
orthaide:
a = a + 1
CALL cadre(17, 30, 20, 2, vert)
COLOR , vert
BEEP
CALL centre(18, noir, MID$(lp$, 1, LEN(r2$)))
CALL attendre(.7)
CALL centre(18, jaune, r2$)
CALL attendre(.7 + (ct / 2))
COLOR blancbrill, bleu
RETURN
END SUB
DEFINT A-Z
SUB lire (co, texte, parag, eleve, lecture, couleur, pre$, nom$,
classe$, titex$, rt$, gg$, titr$, n$(), noir, bleu, vert, rouge,
marron, blanc, vertclair, cyanclair, rougeclair, jaune, blancbrill)
'15/4/96
DIM m$(400), m2$(400), t!(7), p$(5)
lp$ = STRING$(22, ".")
p$(5) = "très rapide": p$(4) = "rapide": p$(3) = "moyenne"
p$(2) = "lente": p$(1) = "très lente"
GOTO lecprincipal
lectitre:
CALL cadre(9, 20, 40, 4, marron)
COLOR , marron
CALL centre(11, blancbrill, a$): tx! = 2
CALL attendre2(tx! * vitesse!)
CALL titre
CALL attendre(.4)
RETURN
lecattendre:
COLOR , noir
CALL centre(23, blanc, "Lis le texte puis tape " + rt$)
COLOR , bleu
CALL chrono(4, co - 2, 40, temps!)
IF temps! < 3 AND LEN(m$) > 120 THEN
CALL titre
BEEP
COLOR , noir
CALL centre(23, rougeclair, "Tu n'as pas lu le texte !")
COLOR blancbrill, bleu: CALL attendre2(1)
CALL attendre2(tx! * vitesse!): CALL afformate(m$(), nm, 9, 10)
GOTO lecattendre
END IF
COLOR blancbrill
RETURN
lecbande:
CALL cadre(10, 25, 28, 4, blanc)
COLOR noir, blanc
CALL attendre(.5)
h = 25
IF LEN(m$) < h THEN h = LEN(m$)
FOR i = 1 TO h
LOCATE 12, h + 27
PRINT MID$(m$, 1, i): tx! = .12: IF h > 1 THEN CALL attendre2(tx! *
vitesse!)
h = h - 1
NEXT
FOR i = 1 TO LEN(m$)
LOCATE 12, 27
PRINT MID$(m$, i, 26): tx! = .12: CALL attendre2(tx! * vitesse!)
NEXT
COLOR , bleu
RETURN
lecafformatbis:
CALL cadre(5, 10, 60, 14, blanc)
COLOR noir, blanc
CALL attendre(.5)
h3 = 20: h3 = 41
r$ = ""
LOCATE 8, 1: v = 8: i = 0: f = 0
lecaf1:
i = i + 1
r$ = r$ + m$(i) + " "
COLOR noir
IF LEN(r$) + LEN(m$(i + 1)) > 19 THEN
IF f = 0 THEN
LOCATE v, h3: PRINT r$
r$ = "": f = 1: tx! = .8: CALL attendre2(tx! * vitesse!)
LOCATE v, h3: PRINT STRING$(20, ".")
GOTO lecaf1
ELSE
LOCATE v, h3: PRINT r$: r$ = ""
f = 0: tx! = .8: CALL attendre2(tx! * vitesse!)
LOCATE v, h3: PRINT STRING$(19, "."): v = v + 1
GOTO lecaf1
END IF
END IF
IF i <= nm THEN
GOTO lecaf1
END IF
IF LTRIM$(RTRIM$(r$)) <> "" THEN
LOCATE v, h3
IF f = 0 THEN
LOCATE v, h3: PRINT r$: tx! = .8
CALL attendre2(tx! * vitesse!)
LOCATE v, h3: PRINT STRING$(20, ".")
RETURN
ELSE
LOCATE v, h3: PRINT r$: tx! = .8
CALL attendre2(tx! * vitesse!)
LOCATE v, h3: PRINT STRING$(19, ".")
END IF
END IF
RETURN
lecafcol2:
'on cherche le mot le plus long
l2 = 0
FOR i = 1 TO nm2
l1 = LEN(m2$(i)): IF l2 < l1 THEN l2 = l1
NEXT
'affichage en colonne
f = 0: h = 41 - INT(l2 / 2): tx! = .4
x = 1: nn = 14
DO
CALL cadre(4, 41 - INT(l2 / 2) - 2, l2 + 2, 15, blanc)
CALL attendre(.5)
COLOR noir, blanc
IF nm2 < nn THEN nn = nm2: f = 1
LOCATE 5
FOR i = x TO nn
LOCATE , h: PRINT m2$(i): CALL attendre2(tx! * vitesse!)
NEXT
CALL attendre(.5)
IF f = 1 THEN EXIT DO
nn = nn + 14
x = x + 14
LOOP
RETURN
lecafcol: 'inutilisé ===
'affichage en colonne
f = 0: h = 1: tx! = .25
nn = 16
IF nm2 < 16 THEN nn = nm2: f = 1
LOCATE 4, 1
FOR i = 1 TO nn
PRINT m2$(i): CALL attendre2(tx! * vitesse!)
NEXT
IF f = 1 THEN RETURN
xx = 0
DO
n = 16 * xx + 1
'on cherche la longueur max des mots de la colonne précédente : ll
l = 0: ll = 0
FOR i = n TO nn
l = LEN(m2$(i)): IF l > ll THEN ll = l
NEXT
h = h + ll + 2
nn = 16 * (xx + 2): IF nm2 < nn THEN nn = nm2: f = 1
n = 16 * (xx + 1) + 1
'on cherche la longueur max de la colonne en cours = si on peut
l'afficher
l = 0: ll = 0
FOR i = n TO nn
l = LEN(m2$(i)): IF l > ll THEN ll = l
NEXT
IF h + ll > co THEN
tx! = .6: CALL attendre2(tx! * vitesse!): tx! = .25: CALL titre: h =
1
END IF
vt = 4
FOR i = 16 * (xx + 1) + 1 TO nn
LOCATE vt, h: PRINT m2$(i): CALL attendre2(tx! * vitesse!): vt = vt
+ 1
NEXT
IF f = 1 THEN EXIT DO
xx = xx + 1
LOOP
RETURN
lecafalea:
CALL cadre(4, 10, 60, 15, blanc)
COLOR noir, blanc
FOR i = 1 TO nm2
v = INT(RND * 12) + 6
hh = (co - 25) - LEN(m2$(i)): h = INT(RND * hh) + 15
LOCATE v, h: PRINT LEFT$(lp$, LEN(m2$(i))): tx! = .3: CALL
attendre2(tx! * vitesse!)
LOCATE v, h: PRINT m2$(i)
tx! = .5: CALL attendre2(tx! * vitesse!)
LOCATE v, h: PRINT LEFT$(SPACE$(30), LEN(m2$(i)))
NEXT
RETURN
lecaf:
CALL cadre(10, 25, 28, 4, blanc)
COLOR , blanc
CALL attendre(.5)
FOR i = 1 TO nm2
CALL centre(12, noir, LEFT$(lp$, LEN(m2$(i))))
tx! = .25: CALL attendre2(tx! * vitesse!)
CALL centre(12, noir, m2$(i))
tx! = .25: CALL attendre2(tx! * vitesse!)
CALL centre(12, blanc, SPACE$(LEN(m2$(i))))
NEXT
RETURN
leceftexte:
'223 si cadre sinon 32 '===
tx! = 1: CALL attendre2(tx! * vitesse!)
tx! = ((t!(1) + t!(2) + t!(3) + t!(4) + t!(5)) / 5) / 200 '100 ===
IF tx! > .08 THEN tx! = .08
FOR nl = 0 TO 9
IF SCREEN(nl + 9, 10) = 223 OR SCREEN(nl + 9, 10) = 32 THEN EXIT FOR
NEXT
COLOR noir, blanc
FOR v = 9 TO nl + 8
FOR C = 10 TO 70
LOCATE v, C
IF SCREEN(v, C) = 32 OR SCREEN(v, C) > 176 THEN
PRINT " "
ELSE
PRINT "."
END IF
CALL attendre2(tx! * vitesse!)
NEXT C
NEXT v
COLOR blancbrill
RETURN
lecprincipal:
CALL titre
CALL cadre(7, 25, 30, 2, vert)
COLOR , vert
CALL centre(8, blancbrill, "Choix de la vitesse")
CALL fleches(12, 35, p$(), 5, r, rouge, 1, 23, 35)
SELECT CASE r
CASE 5
vitesse! = .35
CASE 4
vitesse! = .5
CASE 3
vitesse! = .9
CASE 2
vitesse! = 1.2
CASE 1
vitesse! = 1.7
END SELECT
nu = 1
IF parag > 1 THEN
CALL choixparag(parag, nu)
END IF
m$ = n$(nu)
CALL titre
CALL affectmots(m$, m$(), nm)
nm2 = 0: colo1 = 0: colo2 = 0
FOR i = 1 TO nm
IF LEN(m$(i)) > 13 THEN colo1 = 1 'alors affichage seulement en 2
colonnes
IF LEN(m$(i)) > 20 THEN colo2 = 1
IF m$(i) <> ":" AND m$(i) <> "!" AND m$(i) <> "?" AND m$(i) <> ";"
THEN
nm2 = nm2 + 1
m2$(nm2) = m$(i)
CALL epure(m2$(nm2))
END IF
NEXT i
'GOTO temp '===
CALL afformate(m$(), nm, 9, 10)
CALL niv(7, 1)
GOSUB lecattendre: t!(1) = temps!
CALL titre
a$ = "Mots en colonne": GOSUB lectitre
GOSUB lecafcol2: CALL entree(noir, 1)
CALL titre: CALL afformate(m$(), nm, 9, 10)
CALL niv(6, 1)
GOSUB lecattendre: t!(2) = temps!
CALL titre
a$ = "Mots au milieu": GOSUB lectitre
GOSUB lecaf: CALL entree(noir, 1)
CALL titre: CALL afformate(m$(), nm, 9, 10)
CALL niv(5, 1)
GOSUB lecattendre: t!(3) = temps!
CALL titre
a$ = "Mots n'importe où": GOSUB lectitre
GOSUB lecafalea: CALL entree(noir, 1)
CALL titre: CALL afformate(m$(), nm, 9, 10)
CALL niv(4, 1)
GOSUB lecattendre: t!(4) = temps!
CALL titre
a$ = "Texte défilant": GOSUB lectitre
GOSUB lecbande: CALL entree(noir, 1)
CALL titre: CALL afformate(m$(), nm, 9, 10)
CALL niv(3, 1)
GOSUB lecattendre: t!(5) = temps!
CALL titre
a$ = "Texte s'effaçant": GOSUB lectitre
CALL afformate(m$(), nm, 9, 10)
GOSUB leceftexte: CALL entree(noir, 1)
CALL titre: CALL afformate(m$(), nm, 9, 10)
CALL niv(2, 1)
GOSUB lecattendre: t!(6) = temps!
'temp: '===
CALL titre
IF colo2 = 1 THEN
a$ = "Dernière lecture": GOSUB lectitre
ELSE
a$ = "Texte en deux colonnes": GOSUB lectitre
GOSUB lecafformatbis: CALL entree(noir, 1)
CALL titre
END IF
CALL afformate(m$(), nm, 9, 10)
CALL niv(1, 1)
GOSUB lecattendre: t!(7) = temps!
'affichage résultats
COLOR , noir: CLS
COLOR , vert: LOCATE 2: PRINT SPACE$(co)
CALL centre(2, noir, "Résultats Lecture Rapide")
LOCATE 21, 1: PRINT SPACE$(co)
VIEW PRINT 3 TO 20: COLOR blancbrill, bleu: CLS 2: VIEW PRINT
hh = 51
IF pre$ <> "" THEN LOCATE 5, hh - 3: PRINT pre$ + " " + nom$
LOCATE 4, 12: COLOR vertclair: PRINT "Temps en secondes"
COLOR cyanclair
LOCATE 6, hh - 3: PRINT "Texte : "; titex$
LOCATE 7, hh - 3: PRINT "Paragraphe n°"; LTRIM$(STR$(nu)); " (";
LTRIM$(STR$(nm)); " mots)"
CALL cadre(5, 9, 22, 14, rouge)
LOCATE 6
FOR i = 1 TO 7
COLOR jaune, rouge
LOCATE , 12: PRINT "lecture n°"; RTRIM$(STR$(i)); " :";
COLOR vertclair
IF t!(i) < 1 THEN t!(i) = 1
LOCATE , 26: s$ = STR$(t!(i)): CALL convertir(s$): PRINT s$: PRINT
NEXT
CALL cadre(9, hh - 3, 20, 10, rouge)
COLOR , rouge
LOCATE 10, hh: PRINT "Vitesse moyenne"
LOCATE 11, hh: PRINT "lecture n°1 :"
IF t!(1) <> 0 THEN
LOCATE 13, hh - 1: COLOR vertclair: PRINT INT((nm / t!(1)) * 3600);
"mots/heure": COLOR blancbrill
END IF
LOCATE 15, hh: PRINT "Vitesse moyenne"
LOCATE 16, hh: PRINT "lecture n°7 :"
IF t!(7) <> 0 THEN
LOCATE 18, hh - 1: COLOR vertclair: PRINT INT((nm / t!(7)) * 3600);
"mots/heure"
END IF
lecture = 1
END SUB
DEFINT A-Z
SUB recoller (co, re, parag, rt$, pre$, titr$, n$(), prog, noir,
bleu, vert, rouge, marron, blanc, vertclair, cyanclair, rougeclair,
jaune, blancbrill)
'21/2/96
DIM m$(400), h(10), r$(28), ru$(28), m1$(20), m2$(20), x(15, 56),
z(10)
re = 0: aide = 0
l$ = STRING$(40, 196)
lp$ = STRING$(20, ".")
w$ = "L'ordinateur va mélanger les lettres"
z$ = "d'un mot du texte."
CALL consigne(2, w$, z$, y$)
nu = 1: n2 = 0
m$ = n$(nu)
reco11:
CALL affectmots(m$, m$(), nm)
FOR i = 1 TO nm
CALL recoepure(m$(i))
CALL recoepure(m$(i))
CALL recoepure(m$(i))
NEXT
FOR i = 1 TO nm
'limité de 5 à 9 caractères
IF LEN(m$(i)) > 4 AND LEN(m$(i)) < 10 THEN
n2 = n2 + 1: r$(n2) = m$(i): ru$(n2) = UCASE$(r$(n2))
END IF
IF n2 = 25 THEN EXIT FOR
NEXT
IF n2 < 25 AND nu < parag THEN nu = nu + 1: m$ = n$(nu): GOTO reco11
IF n2 < 3 THEN
CALL tropcourt(1)
EXIT SUB
END IF
'debut
CALL titre
CALL cadre(6, 22, 36, 9, rouge)
IF n2 < 20 THEN nbboucle = 5 ELSE nbboucle = 10
FOR ll = 1 TO nbboucle '+++++++++++
IF n2 < 5 THEN
DO
nt = INT(RND * n2) + 1
LOOP WHILE nt = zz
zz = nt
ELSE
DO
f = 0
z(ll) = INT(RND * n2) + 1
FOR j = 1 TO ll - 1
IF z(ll) = z(j) THEN f = 1: EXIT FOR
NEXT
LOOP WHILE f = 1
nt = z(ll)
END IF
C = 0
'efface cadre2
COLOR , noir
FOR ku = 7 TO 14
LOCATE ku, 23: PRINT SPACE$(36)
NEXT
FOR v = 6 TO 15
FOR h = 23 TO 56
x(v, h) = 0
NEXT h, v
cc = 0
FOR k = 1 TO LEN(r$(nt))
DO
h = INT(RND * 30) + 25
v = INT(RND * 6) + 8
IF cc = 0 THEN cc = 1: EXIT DO
LOOP WHILE x(v, h) = 1
x(v, h) = 1: x(v, h + 1) = 1: x(v, h + 2) = 1: x(v, h - 1) = 1: x(v,
h - 2) = 1
x(v - 1, h) = 1: x(v + 1, h) = 1: x(v - 2, h) = 1: x(v + 2, h) = 1
x(v - 1, h - 1) = 1: x(v + 1, h - 1) = 1: x(v - 1, h + 1) = 1: x(v +
1, h + 1) = 1
LOCATE v, h: PRINT MID$(r$(nt), k, 1)
NEXT k
reco2:
CALL niv(nbboucle, ll)
COLOR , noir
CALL ligne23
CALL centre(23, blanc, "Tape le mot [*] = liste entière")
COLOR , bleu
nl = LEN(r$(nt))
h = INT((80 / 2) + 1 - (nl / 2))
CALL cadre(17, 22, 36, 2, blanc)
COLOR , blanc
CALL centre(18, noir, STRING$(nl, "."))
LOCATE 18, h
COLOR noir
CALL inputgen(noir, blanc, nl, r$, 32, 155)
COLOR , bleu
IF r$ = "*" THEN GOSUB recoliste: GOTO reco2
COLOR , noir
CALL ligne23
IF r$ <> ru$(nt) THEN
IF C >= 2 THEN
BEEP
CALL centre(23, rougeclair, "Solution : " + r$(nt))
CALL attendre2(2)
GOTO reco2
END IF
C = C + 1
IF LEN(r$) <> LEN(ru$(nt)) THEN
CALL centre(23, rougeclair, "Tu n'as pas tapé toutes les lettres.")
ELSE
FOR j = 1 TO LEN(r$)
m1$(j) = MID$(ru$(nt), j, 1)
m2$(j) = MID$(r$, j, 1)
NEXT
CALL tri(m1$(), LEN(r$))
CALL tri(m2$(), LEN(r$))
m1$ = "": m2$ = ""
FOR j = 1 TO LEN(r$)
m1$ = m1$ + m1$(j)
m2$ = m2$ + m2$(j)
NEXT
IF m1$ <> m2$ THEN
CALL centre(23, rougeclair, "Tu as tapé des lettres non proposées.")
ELSE
CALL centre(23, rougeclair, "Ce mot ne fait pas partie du texte.")
END IF
END IF
CALL attendre2(2): GOTO reco2
END IF
CALL exact2
IF C = 0 THEN re = re + 2
'clear
FOR n = 1 TO LEN(r$(nt))
h(n) = 0
NEXT
cc = 0: f = 0
NEXT ll '++++++++++++++++
IF aide > 5 THEN aide = 5
re = re - aide
IF re < 0 THEN re = 0
IF nbboucle = 10 THEN re = INT(re / 2)
CALL resultats(re)
'CALL enregistrement(re, 4, VarEnreg) '===
EXIT SUB
recoliste:
aide = aide + 1
COLOR , noir
CALL ligne23
COLOR blancbrill, bleu
VIEW PRINT 16 TO 20: CLS 2: VIEW PRINT
f = 0
nn = 5: nbis = 1
IF n2 < 6 THEN
h = 35
ELSEIF n2 < 11 THEN
h = 30
ELSEIF n2 < 16 THEN
h = 20
ELSEIF n2 < 21 THEN
h = 15
ELSE
h = 5
END IF
DO
IF n2 < nn THEN nn = n2: f = 1
LOCATE 16, , 0
FOR i = nbis TO nn
LOCATE , h: PRINT r$(i)
NEXT
nbis = nn + 1
nn = nn + 5
h = h + 15
LOOP WHILE f = 0
CALL entree(noir, 0)
COLOR , bleu
VIEW PRINT 16 TO 20: CLS 2: VIEW PRINT: LOCATE , , 1
RETURN
END SUB
DEFINT A-Z
SUB reconstituer (re, co, parag, rt$, pre$, titr$, n$(), prog, noir,
bleu, vert, rouge, marron, blanc, vertclair, cyanclair, rougeclair,
jaune, blancbrill)
'19/12/96
DIM m$(400), m2$(400), m3$(400), m4$(400), re$(30), r$(400)
l$ = STRING$(40, 196)
ll$ = STRING$(39, "_")
'présentation
w$ = "Dans le texte, la plupart des mots vont être effacés."
z$ = "Tu devras les retaper."
CALL consigne(2, w$, z$, y$)
nu = 1
IF parag > 1 THEN
CALL choixparag(parag, nu)
END IF
nf = 1: nt = 0: ct = 0: a = 0
'affect mots
m$ = n$(nu)
numero = INT(LEN(m$) / 60)
SELECT CASE numero
CASE 1
ligne = 11
CASE 2
ligne = 10
CASE 3
ligne = 9
CASE 4
ligne = 8
CASE ELSE
ligne = 7
END SELECT
CALL titre
CALL affectmots(m$, m$(), nm)
'affect 2
nn = 0: rr = 0
FOR i = 1 TO nm
s$ = m$(i): g$ = CHR$(34)
IF s$ = "???" OR s$ = "!!!" OR s$ = "?" + g$ OR s$ = "?)" OR s$ =
"?" + g$ + "," OR s$ = "?" + g$ + "." OR s$ = "?)," OR s$ = "?)." OR
s$ = "?" + g$ + ")." OR s$ = "?)" + g$ + "." OR s$ = "?" + g$ + "),"
OR s$ = "?)" + g$ + "," THEN
m2$(i) = s$: m3$(i) = s$: nn = nn + 1: m4$(nn) = s$: rr = rr + 1:
GOTO recon10
END IF
IF s$ = "!" + g$ OR s$ = "!)" OR s$ = "!" + g$ + "," OR s$ = "!" +
g$ + "." OR s$ = "!)," OR s$ = "!)." OR s$ = "!" + g$ + ")." OR s$ =
"!)" + g$ + "." OR s$ = "!" + g$ + ")," OR s$ = "!)" + g$ + "," THEN
m2$(i) = s$: m3$(i) = s$: nn = nn + 1: m4$(nn) = s$: rr = rr + 1:
GOTO recon10
END IF
az = ASC(s$)
IF LEN(s$) = 1 AND (az = 33 OR az = 34 OR az = 39 OR az = 40 OR az =
41 OR az = 44 OR az = 45 OR az = 46 OR az = 58 OR az = 63 OR az = 59
OR az = 58) THEN m2$(i) = s$: m3$(i) = s$: nn = nn + 1: m4$(nn) =
CHR$(az): rr = rr + 1: GOTO recon10
m2$(i) = MID$(ll$, 1, LEN(s$)): m3$(i) = s$
'test fin mot
IF RIGHT$(m3$(i), 3) = "..." THEN m2$(i) = MID$(m2$(i), 1,
LEN(m3$(i)) - 3) + "...": m3$(i) = MID$(m3$(i), 1, LEN(m3$(i)) - 3):
GOTO recon11
f = 0
az = ASC(RIGHT$(m3$(i), 1))
'point & virgule
IF az = 44 OR az = 46 THEN m2$(i) = MID$(m2$(i), 1, LEN(m2$(i)) - 1)
+ CHR$(az): m3$(i) = MID$(m3$(i), 1, LEN(m3$(i)) - 1): nn = nn + 1:
m4$(nn) = CHR$(az): f = 1
az = ASC(RIGHT$(m3$(i), 1))
IF az = 33 OR az = 34 OR az = 39 OR az = 41 OR az = 45 OR az = 58 OR
az = 59 OR az = 63 THEN
IF f = 0 THEN
m2$(i) = MID$(m2$(i), 1, LEN(m2$(i)) - 1) + CHR$(az): m3$(i) =
MID$(m3$(i), 1, LEN(m3$(i)) - 1): nn = nn + 1: m4$(nn) = CHR$(az)
ELSE
m2$(i) = MID$(m2$(i), 1, LEN(m2$(i)) - 2) + CHR$(az) +
RIGHT$(m2$(i), 1): m3$(i) = MID$(m3$(i), 1, LEN(m3$(i)) - 1): nn =
nn + 1: m4$(nn) = CHR$(az): f = 2
END IF
az = ASC(RIGHT$(m3$(i), 1))
IF az = 34 OR az = 41 THEN
IF f = 2 THEN
m2$(i) = MID$(m2$(i), 1, LEN(m2$(i)) - 3) + CHR$(az) +
RIGHT$(m2$(i), 2): m3$(i) = MID$(m3$(i), 1, LEN(m3$(i)) - 1): nn =
nn + 1: m4$(nn) = CHR$(az)
ELSE
m2$(i) = MID$(m2$(i), 1, LEN(m2$(i)) - 2) + CHR$(az) +
RIGHT$(m2$(i), 1): m3$(i) = MID$(m3$(i), 1, LEN(m3$(i)) - 1): nn =
nn + 1: m4$(nn) = CHR$(az)
END IF
END IF
END IF
recon11:
'test debut mot
az = ASC(LEFT$(m3$(i), 1))
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 m2$(i) = CHR$(az) + MID$(m2$(i), 2): m3$(i)
= MID$(m3$(i), 2): nn = nn + 1: m4$(nn) = CHR$(az)
az = ASC(LEFT$(m3$(i), 1))
IF az = 34 OR az = 40 THEN m2$(i) = LEFT$(m2$(i), 1) + CHR$(az) +
MID$(m2$(i), 3): m3$(i) = MID$(m3$(i), 2): nn = nn + 1: m4$(nn) =
CHR$(az)
'test guillemet
'ag$ = MID$(m$(i), 2, 1)
'IF ag$ = "'" THEN m2$(i) = CHR$(az) + "'" + MID$(m2$(i), 3): m3$(i)
= MID$(m3$(i), 3): nn = nn + 1: m4$(nn) = UCASE$(CHR$(az))
m3$(i) = UCASE$(m3$(i))
IF nm < 10 THEN
mini = 1
ELSEIF nm < 25 THEN
mini = 3
ELSE
mini = 4
END IF
IF LEN(m3$(i)) < mini THEN
m2$(i) = s$: nn = nn + 1: m4$(nn) = m3$(i): rr = rr + 1
END IF
recon10:
NEXT i
IF rr >= nm - 3 THEN
CALL tropcourt(2)
EXIT SUB
END IF
'test longueur maxi
l2 = 0
FOR i = 1 TO nm
l1 = LEN(m$(i)): IF l2 < l1 THEN l2 = l1
NEXT
CALL afformate(m$(), nm, ligne, 10)
COLOR , noir
CALL centre(23, blanc, "Mémorise le texte puis tape " + rt$)
CALL getinvimouse(r)
CALL ligne23
recon3:
CALL niv(nm - rr, nt + 1)
COLOR blancbrill, bleu: CALL afformate(m2$(), nm, ligne, 10)
recon2:
COLOR , noir
LOCATE 23, 1: PRINT SPACE$(80)
CALL centre(23, blanc, "Tape un mot" + SPACE$(20) + "[*] = Aide")
CALL cadre(17, 41 - ((l2 + 4) / 2), l2 + 4, 2, rouge)
COLOR , rouge
LOCATE 18, INT(41 - (l2 + 4) / 2) + 2
CALL inputgen(blancbrill, rouge, l2 + 2, r$, 33, 155)
COLOR , noir
LOCATE 23, 1: PRINT SPACE$(80)
IF r$ = "*" THEN GOSUB reconsaide: GOTO recon2
r$(nf) = r$
COLOR rouge
IF r$ = "!!!" OR r$ = "???" OR r$ = "'" THEN BEEP: CALL centre(23,
rougeclair, "Inutile"): ff = 1: GOTO recons5
IF r$ = "?" + g$ OR r$ = "?)" OR r$ = "?" + g$ + "," OR r$ = "?" +
g$ + "." OR r$ = "?)," OR r$ = "?)." OR r$ = "?" + g$ + ")." OR r$ =
"?)" + g$ + "." OR r$ = "?" + g$ + ")," OR r$ = "?)" + g$ + "," THEN
BEEP: CALL centre(23, rougeclair, "Inutile"): ff = 1: GOTO recons5
IF r$ = "!" + g$ OR r$ = "!)" OR r$ = "!" + g$ + "," OR r$ = "!" +
g$ + "." OR r$ = "!)," OR r$ = "!)." OR r$ = "!" + g$ + ")." OR r$ =
"!)" + g$ + "." OR r$ = "!" + g$ + ")," OR r$ = "!)" + g$ + "," THEN
BEEP: CALL centre(23, rougeclair, "Inutile"): ff = 1: GOTO recons5
'test si déjà dit
f = 0: ff = 0
IF nf = 1 THEN GOTO recons3
FOR i = 1 TO nf - 1
IF r$ = r$(i) THEN BEEP: CALL centre(23, rougeclair, "Déjà tapé"):
ff = 1: EXIT FOR
NEXT
IF ff = 1 THEN GOTO recons5
recons3:
FOR i = 1 TO nn
IF r$ = m4$(i) THEN LOCATE 23, 21: BEEP: CALL centre(23, rougeclair,
"Inutile"): ff = 1: EXIT FOR
NEXT
IF ff = 1 THEN GOTO recons5
recons4:
'test si bon
FOR i = 1 TO nm
IF r$ = m3$(i) THEN m2$(i) = m$(i): f = 1: nt = nt + 1
NEXT
recons5:
COLOR blancbrill
IF ff = 1 THEN CALL attendre2(1): GOTO recon2
IF f = 0 THEN ct = ct + 1: GOSUB reconstaide2: GOTO recon2
IF nt < nm - rr THEN nf = nf + 1: GOTO recon3
COLOR , bleu: CALL afformate(m2$(), nm, ligne, 10)
CALL attendre(.8)
pt! = 10 / (nm - rr)
re = INT(10 - (ct * pt!) - (a / 2)): IF re < 0 THEN re = 0
CALL resultats(re)
EXIT SUB
reconsaide:
COLOR , bleu
FOR i = 17 TO 20
LOCATE i: PRINT SPACE$(80)
NEXT
CALL afformate(m$(), nm, ligne, 10)
CALL attendre2(2 + (ct / 5))
a = a + 1
CALL afformate(m2$(), nm, ligne, 10)
LOCATE 23, 1, 1
RETURN
reconstaide2:
BEEP
CALL erreur2
COLOR blancbrill, bleu
CALL afformate(m$(), nm, ligne, 10)
CALL attendre2(1 + (ct / 5))
CALL afformate(m2$(), nm, ligne, 10)
RETURN
END SUB
DEFINT A-Z
SUB reperer (co, re, parag, n$(), rt$, gg$, pre$, titr$, prog%,
nom$, noir%, bleu%, vert%, rouge%, marron%, blanc%, vertclair%,
cyanclair%, rougeclair%, jaune%, blancbrill%)
'20/11/96
DIM m$(400), m2$(90), p$(3), z(5)
lp$ = STRING$(26, ".")
p$(3) = "Rapide": p$(2) = "Moyenne": p$(1) = "Lente"
'choix vitesse
CALL titre
CALL cadre(7, 25, 30, 2, vert)
COLOR , vert
CALL centre(8, blancbrill, "Choix de la vitesse")
CALL fleches(13, 37, p$(), 3, r, rouge, 1, 23, 35)
SELECT CASE r
CASE 3
vi! = 1.4
CASE 2
vi! = 2.2
CASE 1
vi! = 3.5
END SELECT
'présentation
w$ = "L'ordinateur va t'indiquer un mot."
CALL titre
CALL cadre(7, 17, 46, 10, marron)
COLOR , marron
IF pre$ <> "" THEN
CALL centre(9, blancbrill, pre$ + ","): w$ = LCASE$(w$)
END IF
CALL centre(11, blancbrill, w$)
CALL centre(13, blancbrill, "Lorsque tu verras ce mot s'afficher,")
CALL centre(15, blancbrill, "tu appuieras sur la barre " + CHR$(39)
+ "espace" + CHR$(39) + ".")
COLOR , noir: CALL centre(23, blanc, "Appuie sur la barre [espace]")
COLOR blancbrill
DO
DEF SEG = 0
POKE 1050, PEEK(1052)
DEF SEG
DO
r$ = INKEY$
MousePoll v_mouse, h_mouse, lButton, rButton
IF lButton THEN
r$ = CHR$(32)
CALL attendre(.3)
END IF
LOOP WHILE r$ = ""
IF LEN(r$) < 2 THEN r = ASC(r$) ELSE r = ASC(RIGHT$(r$, 1))
IF r = 27 THEN EXIT SUB
IF r <> 32 THEN BEEP
LOOP WHILE r <> 32
CLS
n2 = 0: nu = 1
rep1:
m$ = n$(nu)
CALL affectmots(m$, m$(), nm)
FOR i = 1 TO nm
CALL epure(m$(i))
IF m$(i) <> ":" AND m$(i) <> ";" AND m$(i) <> "?" AND m$(i) <> "!"
AND LEN(m$(i)) < 13 THEN
n2 = n2 + 1
m2$(n2) = m$(i)
END IF
IF n2 = 83 THEN EXIT FOR
NEXT
IF n2 < 83 AND nu < parag THEN nu = nu + 1: GOTO rep1
IF n2 < 8 THEN
CALL tropcourt(1)
EXIT SUB
END IF
'debut
re = 10
FOR ne = 1 TO 2 '++++++++++++++
rr = 0: er2 = 0: nbmot = 0
FOR i = 1 TO n2
m$(i) = m2$(i)
NEXT
'tirage du mot
IF n2 < 5 THEN
DO
i = INT(RND * n2) + 1
LOOP WHILE i = zz
zz = i
ELSE
DO
f = 0
z(ne) = INT(RND * n2) + 1
FOR j = 1 TO ne - 1
IF z(ne) = z(j) THEN f = 1: EXIT FOR
NEXT
LOOP WHILE f = 1
i = z(ne)
END IF
l2 = INT(RND * 9) + 2
qu$ = m$(i)
CALL titre
'affichage du mot
CALL cadre(10, INT(41 - LEN(qu$) / 2) - 3, LEN(qu$) + 4, 4, rouge)
COLOR , rouge
CALL centre(12, blancbrill, qu$)
COLOR , noir
CALL centre(23, blanc, "Mémorise le mot")
CALL attendre2(2)
'debut
CALL titre
CALL niv(2, ne)
CALL cadre(5, 30, 20, 14, blanc)
COLOR , noir
CALL centre(23, blanc, "Tape [espace] quand tu vois " + CHR$(174) +
" " + qu$ + " " + CHR$(175))
CALL cadre(11, 5, 20, 2, vert)
CALL cadre(11, 55, 20, 2, vert)
COLOR blancbrill, vert
LOCATE 12, 7: PRINT "Mot présenté :";
LOCATE 12, 57: PRINT "Mot Trouvé :";
FOR i = 1 TO n2
IF LEN(m$(i)) = l2 THEN m$(i) = qu$
NEXT
qu = 0
FOR i = 1 TO n2
IF m$(i) = qu$ THEN qu = qu + 1
NEXT
'_affichage_
COLOR , blanc
FOR i = 3 TO 0 STEP -1
CALL centre(6, noir, LTRIM$(STR$(i)))
CALL attendre(.5)
NEXT
CALL centre(6, noir, " ")
f = 0
jj = 1
nn = 13
DO
IF n2 < nn THEN nn = n2: f = 1
v = 6
FOR i = jj TO nn
GOSUB repcent
v = v + 1
NEXT
IF f = 1 THEN EXIT DO
tx! = .6: CALL attendre(tx! * vi!)
nn = nn + 13
jj = jj + 13
LOOP
'résultats
CALL titre
CALL cadre(5, 30, 20, 14, rouge)
COLOR vertclair, rouge
LOCATE 8, 35: PRINT "RESULTATS"
COLOR blancbrill
LOCATE 11, 35: PRINT "Mots :"; qu
LOCATE 13, 35: PRINT "Trouvés :"; rr
LOCATE 15, 35
IF rr = qu + er2 THEN
COLOR jaune: PRINT "Exact"
ELSEIF (qu + er2) - rr = 1 THEN
re = re - 1
COLOR noir
PRINT "Erreur : 1"
ELSE
COLOR noir
PRINT "Erreurs :"; (qu + er2) - rr
IF (qu + er2) - rr = 2 THEN
re = re - 2
ELSE
re = re - 3
END IF
END IF
CALL entree(noir, 1)
NEXT ne '++++++++
IF re < 0 THEN re = 0
CALL resultats(re)
'CALL enregistrement(re, 8, VarEnreg) '===
EXIT SUB
'++++++++++++
repcent:
DEF SEG = 0
POKE 1050, PEEK(1052)
DEF SEG
flag = 0
CALL centre(v, noir, RIGHT$(lp$, LEN(m$(i))))
tx! = .1: CALL attendre(tx! * vi!)
COLOR blancbrill
CALL centre(v, noir, m$(i))
tx! = .1: CALL attendre(tx! * vi!)
'saisie au vol
debut! = TIMER
DO
x$ = INKEY$
fin! = TIMER
MousePoll v_mouse, h_mouse, lButton, rButton
IF lButton THEN
x$ = CHR$(32)
CALL attendre(.1)
END IF
LOOP WHILE x$ = "" AND fin! - debut! < tx! * vi! * 2
IF x$ = "" THEN x$ = "."
IF ASC(x$) = 27 THEN CALL quitter(blanc)
IF ASC(x$) = 32 THEN
IF m$(i) = qu$ THEN
rr = rr + 1: flag = 1
CALL cadre(11, 55, 20, 2, vert)
COLOR blancbrill, vert
IF rr = 1 THEN
LOCATE 12, 57: PRINT "Mot Trouvé :";
ELSE
LOCATE 12, 57: PRINT "Mots Trouvés :";
END IF
PRINT rr
COLOR , blanc
ELSE
BEEP: er2 = er2 + 1
END IF
END IF
CALL centre(v, blanc, RIGHT$(SPACE$(20), LEN(m$(i))))
DEF SEG = 0
POKE 1050, PEEK(1052)
DEF SEG
IF m$(i) = qu$ THEN
nbmot = nbmot + 1
CALL cadre(11, 5, 20, 2, vert)
COLOR blancbrill, vert
IF nbmot = 1 THEN
LOCATE 12, 7: PRINT "Mot présenté :";
ELSE
LOCATE 12, 7: PRINT "Mots présentés :";
END IF
PRINT nbmot
COLOR , blanc
IF flag = 0 THEN BEEP
END IF
RETURN
END SUB
|
|
DECLARE SUB niv (limit%, xx%)
DECLARE SUB quitter (fond%)
DECLARE SUB afformate (m$(), nm%, v%, h%)
DECLARE SUB ouinon (r$)
DECLARE SUB epuration (re$, re2$)
DECLARE SUB MousePoll (row%, col%, lButton%, rButton%)
DECLARE SUB MouseHide ()
DECLARE SUB getinvimouse (rr%)
DECLARE SUB fleches (v%, h%, w$(), np%, r%, coul%, drap%, v2%, h3%)
DECLARE SUB consigne (nl%, w$, z$, y$)
DECLARE SUB cadre (v%, h%, l%, nli%, c%)
DECLARE SUB cadre2 (v%, h%, l%, nli%, c%, c2%, rouge%)
DECLARE SUB pleinecran (r$, m$, co%, v1%, v2%)
DECLARE SUB titre ()
DECLARE SUB resultats (re%)
DECLARE SUB enregistrement (re%, mat%, VarEnreg AS ANY)
DECLARE SUB ligne23 ()
DECLARE SUB entree (x%, flag%)
DECLARE SUB centre (v%, coul%, ph$)
DECLARE SUB getinvi (rr%)
DECLARE SUB attendre (tx!)
DECLARE SUB attendre2 (tx!)
DECLARE SUB transmaj (m$)
DECLARE SUB erreur2 ()
DECLARE SUB exact2 ()
DECLARE SUB choixparag (np%, r%)
DECLARE SUB transforme (m$)
DECLARE SUB trouvemot (m$, m$(), nm%)
DECLARE SUB afficheformate (co%, m$(), nm%)
DECLARE SUB deplacemot1 (rr%, nm%, flag%, li%, place%, limax%, m$(),
ligne%())
DECLARE SUB recupere2 (m$, v1%, v2%)
'EXO 3
'Lecture Primaire 3.0
'Daniel CLERC
'18/05/96
DEFINT A-Z
SUB afficheformate (co, m$(), nm)
i = 1: l2 = 0
DO
l = LEN(m$(i))
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 deplacemot1 (rr, nm, flag, li, place, limax, m$(), ligne())
'25/2/96
'saisie déplacement mot dans texte en restant dans même colonne
'flag indique la position du mot dans le texte
'place indique la position du mot dans la ligne
'li indique la ligne
'ligne(li) indique le nombre du 1° mot de la ligne li
'ligne(li+1) - ligne(li) donne le nombre de mot pour la ligne li
'sauf pour la dernière : nm -ligne(li) +1
SELECT CASE rr
CASE 27
CALL quitter(noir)
CASE 77 'droite
flag = flag + 1
IF flag > nm THEN
flag = nm: BEEP
ELSEIF flag = ligne(li + 1) THEN
li = li + 1: IF li > limax THEN li = limax
END IF
place = flag - ligne(li) + 1
CASE 75 'gauche
flag = flag - 1
IF flag = 0 THEN
flag = 1: BEEP
ELSEIF flag < ligne(li) THEN
li = li - 1: IF li < 1 THEN li = 1
END IF
place = flag - ligne(li) + 1
CASE 72 'haut
IF li = 1 THEN
BEEP
ELSE
li = li - 1
'si place est sup aux nombres de mots de la ligne de dessus
IF place > ligne(li + 1) - ligne(li) THEN
place = ligne(li + 1) - ligne(li)
END IF
flag = ligne(li) + place - 1
IF flag < 1 THEN flag = 1
END IF
CASE 80 'bas
IF li = limax THEN
BEEP
ELSE
li = li + 1
'si place est sup aux nombres de mots de la ligne de dessous
IF ligne(li + 1) <> 0 THEN
IF place > ligne(li + 1) - ligne(li) THEN
place = ligne(li + 1) - ligne(li)
END IF
ELSE
'calcul sur la dernière ligne
IF place > nm - ligne(li) + 1 THEN
place = (nm - ligne(li)) + 1
END IF
END IF
flag = ligne(li) + place - 1
IF flag > nm THEN flag = nm
END IF
CASE 13
EXIT SUB
CASE ELSE
BEEP
END SELECT
END SUB
DEFINT A-Z
SUB efface (v, hk)
IF v = 23 THEN COLOR , noir
LOCATE v, 1: FOR i = 1 TO hk: PRINT SPACE$(co): NEXT: LOCATE v, 1
END SUB
DEFINT A-Z
SUB epuration (re$, re2$)
' re$ à l'entrée, re2$ à la sortie
'épuration à droite
IF RIGHT$(re$, 3) = "..." THEN
re2$ = MID$(re$, 1, LEN(re$) - 3)
ELSEIF RIGHT$(re$, 2) = ")," OR RIGHT$(re$, 2) = ")." THEN
re2$ = MID$(re$, 1, LEN(re$) - 2)
ELSEIF RIGHT$(re$, 1) = "," OR RIGHT$(re$, 1) = "." OR RIGHT$(re$,
1) = ")" OR RIGHT$(re$, 1) = "'" OR RIGHT$(re$, 1) = CHR$(34) THEN
re2$ = MID$(re$, 1, LEN(re$) - 1)
ELSE
re2$ = re$
END IF
'épuration à gauche de re2$
IF LEFT$(re2$, 1) = "(" OR LEFT$(re2$, 1) = "'" OR LEFT$(re2$, 1) =
CHR$(34) THEN
re2$ = MID$(re2$, 2)
END IF
END SUB
DEFINT A-Z
SUB recopier (re, co, parag, n$(), rt$, gg$, pre$, titr$, noir,
bleu, vert, rouge, marron, blanc, vertclair, cyanclair, rougeclair,
jaune, blancbrill)
'22/2/96
DIM m$(400), p$(3)
er = 0
nu = 1
IF parag > 1 THEN
CALL choixparag(parag, nu)
END IF
ancienre$ = "": re$ = ""
p$(1) = "TEXTE EN MAJUSCULES"
p$(2) = "Majuscules non obligatoires"
p$(3) = "Majuscules obligatoires"
CALL titre
CALL fleches(12, (co / 2) - 12, p$(), 3, ni, rouge, 1, 23, 35)
'niveau 2 ne tient pas compte des maj
m$ = n$(nu)
nbcar = LEN(m$)
MouseHide
CALL titre
IF ni = 1 THEN
CALL transmaj(m$)
ELSEIF ni = 3 THEN
COLOR , noir
CALL centre(23, blanc, "Tu dois utiliser les majuscules.")
CALL attendre(1)
END IF
CALL trouvemot(m$, m$(), nm)
LOCATE 5, , 0: COLOR jaune, bleu
CALL afficheformate(co, m$(), nm)
LOCATE 11
COLOR blancbrill
PRINT STRING$(co, "_")
copie0:
FOR nl = 1 TO 5
IF SCREEN(nl + 5, 1) = 32 THEN EXIT FOR
NEXT
COLOR noir, blanc
LOCATE 13: FOR i = 1 TO nl + 2: PRINT SPACE$(co): NEXT
LOCATE 14, 1
FOR jx = 1 TO nl * co
c = jx MOD co: IF c = 0 THEN c = co: GOTO copie14
v = INT(jx / co) + 5
copie14:
IF SCREEN(v, c) = 32 THEN
PRINT " ";
ELSE
PRINT ".";
END IF
NEXT jx
CALL ligne23
COLOR noir, blanc
'saisie
DEF SEG = 0
POKE 1050, PEEK(1052)
DEF SEG
LOCATE 14, 1, 1
FOR ii = 1 TO nbcar
ligne = CSRLIN
col = POS(0)
IF col < co THEN
IF SCREEN(ligne - 9, col) = 32 AND SCREEN(ligne - 9, col + 1) = 32
THEN
col = 1: ligne = ligne + 1
nbcar = nbcar - 1
END IF
END IF
IF col = co THEN
IF SCREEN(ligne - 9, co) = 32 THEN
col = 1: ligne = ligne + 1
nbcar = nbcar - 1
ELSE
nbcar = nbcar - 1
END IF
END IF
IF ii > nbcar THEN EXIT FOR
copie1:
DEF SEG = 0
IF ni = 2 OR ni = 3 THEN
POKE &H417, (PEEK(&H417) AND &HBF) 'minus
ELSE
POKE &H417, (PEEK(&H417) OR &H40) 'MAJ
END IF
'======POKE &H417, (PEEK(&H417) OR &h30)'numérique
DEF SEG
COLOR noir, blanc
LOCATE ligne, col, 1
DO
re$ = INKEY$
LOOP WHILE re$ = ""
IF ASC(re$) = 27 THEN CALL quitter(blanc): GOTO copie1
IF LEN(re$) = 2 THEN BEEP: GOTO copie1
IF ASC(re$) = 8 THEN BEEP: GOTO copie1
IF ni = 1 THEN 'majuscules
IF re$ = "?" AND SCREEN(ligne - 9, col) = ASC(",") THEN re$ = ","
IF re$ = "." AND SCREEN(ligne - 9, col) = ASC(";") THEN re$ = ";"
IF re$ = "/" AND SCREEN(ligne - 9, col) = ASC(":") THEN re$ = ":"
IF re$ = "4" AND SCREEN(ligne - 9, col) = ASC("'") THEN re$ = "'"
IF re$ = "5" AND SCREEN(ligne - 9, col) = ASC("(") THEN re$ = "("
IF re$ = "6" AND SCREEN(ligne - 9, col) = ASC("-") THEN re$ = "-"
IF re$ = "°" AND SCREEN(ligne - 9, col) = ASC(")") THEN re$ = ")"
IF re$ = "+" AND SCREEN(ligne - 9, col) = ASC("=") THEN re$ = "="
IF re$ = "3" AND SCREEN(ligne - 9, col) = 34 THEN re$ = CHR$(34)
'IF re$ = "⌡" AND SCREEN(ligne - 9, col) = ASC("!") THEN re$ = "!"
IF re$ = CHR$(21) AND SCREEN(ligne - 9, col) = ASC("!") THEN re$ =
"!"
END IF
PRINT re$;
'analyse
IF ii > 1 THEN
IF ASC(ancienre$) = 32 AND ASC(re$) = 32 THEN LOCATE , col: PRINT
"."; : GOTO copie1
END IF
IF col = 1 AND ASC(re$) = 32 THEN
LOCATE , 1: PRINT "."; : GOTO copie1
END IF
'test
SELECT CASE ni
CASE 1, 2
IF re$ = LCASE$(CHR$(SCREEN(ligne - 9, col))) OR re$ =
CHR$(SCREEN(ligne - 9, col)) OR re$ = UCASE$(CHR$(SCREEN(ligne - 9,
col))) THEN
erreurs = 0
ELSE
erreurs = erreurs + 1
END IF
CASE 3
IF ASC(re$) = SCREEN(ligne - 9, col) THEN
erreurs = 0
ELSE
erreurs = erreurs + 1
END IF
END SELECT
IF erreurs <> 0 THEN
COLOR rouge: LOCATE ligne, col: PRINT re$
LOCATE , , 0: COLOR , noir: BEEP: CALL erreur2
IF SCREEN(ligne - 9, col) > 64 AND erreurs = 1 THEN
er = er + 1
END IF
IF ni = 3 THEN
'majuscules
IF ASC(re$) - 32 = SCREEN(ligne - 9, col) THEN
CALL centre(23, rougeclair, "Utilise les majuscules !"): CALL
attendre2(2)
LOCATE 23, 1: PRINT SPACE$(co)
END IF
END IF
COLOR noir, blanc
GOTO copie1
END IF
erreurs = 0
ancienre$ = re$
NEXT ii
PRINT
COLOR blancbrill, noir: LOCATE 23, 1, 0
PRINT SPACE$(co)
CALL entree(noir, 0)
IF nbcar < 200 THEN
re = 10 - INT(er): IF re < 0 THEN re = 0
ELSE
re = 10 - INT(er / 2): IF re < 0 THEN re = 0
END IF
CALL resultats(re)
'CALL enregistrement(re, 1, VarEnreg) '===
END SUB
DEFINT A-Z
SUB separer (re, co, parag, n$(), rt$, gg$, pre$, titr$, prog%,
nom$, noir%, bleu%, vert%, rouge%, marron%, blanc%, vertclair%,
cyanclair%, rougeclair%, jaune%, blancbrill%)
'22/4/97
DIM m$(320), m2$(320), p2$(2)
'présentation
w$ = "Dans le texte, les espaces entre les"
z$ = "mots vont être supprimés."
y$ = "Tu devras les remettre."
CALL consigne(3, w$, z$, y$)
nu = 1
IF parag > 1 THEN
CALL choixparag(parag, nu)
END IF
m$ = n$(nu)
er = 0
m2$ = m$
CALL titre
CALL trouvemot(m$, m$(), nm)
CALL afformate(m$(), nm, 9, 10)
COLOR , noir
CALL centre(23, blanc, "Mémorise le texte puis tape " + rt$)
m$ = ""
FOR i = 1 TO nm
m$ = m$ + m$(i)
NEXT
CALL getinvimouse(w)
debespace:
CALL titre
DO
CALL pleinecran(r$, m$, co, 9, 14)
IF r$ = CHR$(27) THEN CALL quitter(bleu)
LOOP WHILE r$ = CHR$(27)
COLOR , noir
LOCATE 22, 1: PRINT SPACE$(co): PRINT SPACE$(co)
CALL recupere2(m$, 9, 14)
CALL titre
COLOR , bleu
CALL transforme(m$)
CALL trouvemot(m$, m$(), nm)
FOR i = 1 TO nm
l = LEN(m$(i))
IF l > 39 THEN
BEEP: LOCATE , , 0: COLOR , noir
CALL centre(23, rougeclair, "Tu n'as pas fait assez d'espaces !")
COLOR blancbrill
CALL getinvimouse(r)
GOTO debespace
END IF
NEXT i
CALL afformate(m$(), nm, 9, 10)
CALL cadre(4, 30, 20, 2, marron)
COLOR , marron
CALL centre(5, blancbrill, "Est-ce correct ?")
p2$(1) = "oui"
p2$(2) = "non"
COLOR , noir
CALL centre(23, blanc, gg$)
CALL fleches(17, 39, p2$(), 2, r, rouge, 1, 23, 35)
SELECT CASE r
CASE 1
flag = 1
CASE 2
flag = 0
END SELECT
CALL ligne23
IF flag = 0 THEN GOTO debespace
IF m$ = m2$ THEN
CALL exact2
IF er = 0 THEN
re = 10
ELSEIF er = 1 THEN
re = 8
END IF
ELSE
CALL erreur2
er = er + 1
IF er > 1 THEN
'afficher le texte et poursuivre la saisie
CALL titre
CALL trouvemot(m2$, m2$(), nm)
LOCATE 5, , 0: COLOR blancbrill, bleu
CALL afficheformate(co, m2$(), nm)
COLOR rouge: LOCATE 11: PRINT STRING$(co, CHR$(196))
CALL trouvemot(m$, m$(), nm)
debespace2:
COLOR blancbrill, bleu
DO
CALL pleinecran(r$, m$, co, 13, 18)
IF r$ = CHR$(27) THEN CALL quitter(bleu)
LOOP WHILE r$ = CHR$(27)
COLOR , noir
LOCATE 22, 1: PRINT SPACE$(co): PRINT SPACE$(co)
COLOR , bleu
CALL recupere2(m$, 13, 18)
CALL transforme(m$)
CALL trouvemot(m$, m$(), nm)
FOR i = 1 TO nm
l = LEN(m$(i))
IF l > 39 THEN
BEEP: LOCATE , , 0: COLOR , noir
CALL centre(23, rougeclair, "Tu n'as pas fait assez d'espaces !")
COLOR blancbrill
CALL getinvimouse(r)
GOTO debespace2
END IF
NEXT i
COLOR rougeclair, bleu
VIEW PRINT 12 TO 20: CLS 2: VIEW PRINT
LOCATE 13
CALL afficheformate(co, m$(), nm)
COLOR , noir
LOCATE 23, 1: PRINT SPACE$(co)
IF m$ = m2$ THEN
CALL exact2
re = 5
ELSE
CALL centre(23, rougeclair, "Compare les textes")
CALL getinvimouse(w)
re = 3
END IF
ELSE
CALL titre
CALL trouvemot(m2$, m$(), nm)
CALL afformate(m$(), nm, 9, 10)
COLOR , noir
CALL centre(23, blanc, "Relis le texte puis tape " + rt$)
CALL getinvimouse(w)
GOTO debespace
END IF
END IF
CALL resultats(re)
END SUB
DEFINT A-Z
SUB transforme (m$)
'pour sub espace
'13/5/94
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
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)
jl = 1: mm$ = ""
FOR il = 1 TO LEN(m$)
mm$ = mm$ + MID$(m$, il, 1)
IF ASC(MID$(m$, il, 1)) = 32 THEN m$(jl) = MID$(mm$, 1, LEN(mm$) -
1): mm$ = "": jl = jl + 1: IF LEN(m$(jl - 1)) = 0 THEN jl = jl - 1
NEXT
nm = jl - 1
END SUB
DEFINT A-Z
SUB trouver (re, co, parag, n$(), rt$, gg$, gg2$, pre$, titr$,
prog%, nom$, noir%, bleu%, vert%, rouge%, marron%, blanc%,
vertclair%, cyanclair%, rougeclair%, jaune%, blancbrill%, couleur%)
'20/3/96
DIM m$(400), ligne(20), z(10)
'présentation
w$ = "Un mot va être affiché."
z$ = "Tu devras le retrouver dans le texte"
y$ = "le plus rapidement possible."
CALL consigne(3, w$, z$, y$)
FOR i = 1 TO parag
ll = LEN(m$ + " " + n$(i))
IF ll > 720 THEN EXIT FOR
m$ = m$ + n$(i)
NEXT
CLS
re = 0: ct = 0
CALL trouvemot(m$, m$(), nm)
'on teste le nombre de mots dont la long est sup à 4
ll = 0
FOR i = 1 TO nm
IF LEN(m$(i)) > 4 THEN ll = ll + 1
NEXT
'on mémorise les mots à gauche
i = 1: l2 = 0: li = 0
DO
l = LEN(m$(i))
l2 = l2 + l
IF l2 > co THEN
i = i - 1: l2 = 0
ELSEIF l2 = co THEN
l2 = 0
ELSEIF l2 = co - 1 THEN
l2 = 0
ELSE
IF l2 = LEN(m$(i)) THEN li = li + 1: ligne(li) = i
l2 = l2 + 1
END IF
COLOR blancbrill
i = i + 1
LOOP WHILE i <= nm
limax = li
FOR ii = 1 TO 5 '++++++++++++++++++++++++++++++
'tirage
IF ll < 10 THEN
re$ = m$(INT(RND * nm) + 1)
ELSE
DO
DO
f = 0
z(ii) = INT(RND * nm) + 1
FOR j = 1 TO ii - 1
IF z(ii) = z(j) THEN f = 1: EXIT FOR
NEXT
LOOP WHILE f = 1
re$ = m$(z(ii))
LOOP WHILE LEN(re$) < 5
END IF
CALL epuration(re$, re2$)
chemot3:
'affichage du mot signal
CALL titre
CALL cadre(10, INT((co / 2 + 1) - LEN(re2$) / 2) - 3, LEN(re2$) + 4,
4, rouge)
CALL niv(5, ii)
CALL attendre(.3)
COLOR , rouge
CALL centre(12, blancbrill, re2$)
COLOR , noir
IF ct = 0 THEN
CALL centre(23, blanc, "Mémorise le mot")
ELSE
CALL centre(23, blanc, "Relis le mot")
END IF
CALL attendre2(2)
'affichage du texte
CALL titre
CALL niv(5, ii)
CALL afformate(m$(), nm, 10, 0)
IF ct <> 0 THEN
IF couleur = 1 THEN
COLOR , vert: CALL centre(5, blancbrill, " " + re2$ + " ")
ELSE
COLOR , blanc: CALL centre(5, noir, " " + re2$ + " ")
END IF
END IF
COLOR , noir: CALL centre(23, blanc, gg2$)
CALL cadre(3, co - 5, 2, 2, rouge)
COLOR blancbrill, rouge
li = 1
place = 1
rr = 0
flag = 1
GOSUB chemotat
DO
ki = 1: l2 = 0: h = 1: v = 10
IF couleur = 1 THEN COLOR noir, vertclair ELSE COLOR noir, blanc
DO
l = LEN(m$(ki))
l2 = l2 + l
IF l2 > co THEN
ki = ki - 1: l2 = 0
h = 1: v = v + 1
IF ki = flag THEN
LOCATE v, h
IF RIGHT$(m$(ki), 1) = "," OR RIGHT$(m$(ki), 1) = "." THEN
PRINT MID$(m$(ki), 1, LEN(m$(ki)) - 1)
ELSE
PRINT m$(ki)
END IF
v2 = v: h3 = h: m2$ = m$(ki)
EXIT DO
END IF
ELSEIF l2 = co THEN
l2 = 0
h = co - LEN(m$(ki)) + 1
IF ki = flag THEN
LOCATE v, h
IF RIGHT$(m$(ki), 1) = "," OR RIGHT$(m$(ki), 1) = "." THEN
PRINT MID$(m$(ki), 1, LEN(m$(ki)) - 1)
ELSE
PRINT m$(ki)
END IF
v2 = v: h3 = h: m2$ = m$(ki)
EXIT DO
END IF
v = v + 1
ELSEIF l2 = co - 1 THEN
h = co - LEN(m$(ki))
IF ki = flag THEN
LOCATE v, h
IF RIGHT$(m$(ki), 1) = "," OR RIGHT$(m$(ki), 1) = "." THEN
PRINT MID$(m$(ki), 1, LEN(m$(ki)) - 1)
ELSE
PRINT m$(ki)
END IF
v2 = v: h3 = h: m2$ = m$(ki)
EXIT DO
END IF
ELSE
l2 = l2 + 1
h = l2 - LEN(m$(ki))
IF ki = flag THEN
LOCATE v, h
IF RIGHT$(m$(ki), 1) = "," OR RIGHT$(m$(ki), 1) = "." THEN
PRINT MID$(m$(ki), 1, LEN(m$(ki)) - 1)
ELSE
PRINT m$(ki)
END IF
v2 = v: h3 = h: m2$ = m$(ki)
EXIT DO
END IF
END IF
ki = ki + 1
LOOP WHILE ki <= nm
COLOR noir, blanc
GOSUB chemotat1
IF souris = 1 THEN EXIT DO
CALL deplacemot1(rr, nm, flag, li, place, limax, m$(), ligne())
IF rr = 13 THEN res$ = m$(flag): EXIT DO
COLOR noir, blanc
LOCATE v2, h3: PRINT m2$
LOOP
CALL ligne23
IF temps >= 30 THEN
ct = ct + 1
BEEP
CALL centre(23, rougeclair, " Trop lent ! "): CALL attendre2(1.5)
IF ct < 2 THEN GOTO chemot3
GOSUB cherchesol
GOTO chemot4
END IF
IF re$ <> res$ AND re2$ <> res$ THEN
ct = ct + 1
CALL ligne23
CALL erreur2
IF ct < 2 THEN GOTO chemot3
GOSUB cherchesol
ELSE
IF temps >= 20 THEN
CALL centre(23, jaune, "Exact mais trop lent !"): CALL
attendre2(1.8)
IF ct = 0 THEN re = re + 1
ELSE
CALL exact2
IF ct = 0 THEN re = re + 2
IF ct = 1 THEN re = re + 1
END IF
END IF
chemot4:
ct = 0
NEXT ii '+++++++++++++++++++++++++++++
CALL resultats(re)
'CALL enregistrement(re, 9, VarEnreg) '===
EXIT SUB
chemotat:
DEF SEG = 0
POKE 1050, PEEK(1052)
DEF SEG
duree = 30
depart = VAL(RIGHT$(TIME$, 2))
IF depart < 60 - duree THEN
fin = duree + depart
ELSE
fin = duree + depart - 60
END IF
RETURN
chemotat1:
DEF SEG = 0
POKE 1050, PEEK(1052)
DEF SEG
souris = 0
DO
seconde = VAL(RIGHT$(TIME$, 2))
IF seconde >= depart THEN
temps = -(depart - seconde)
ELSE
temps = 60 - depart + seconde
END IF
IF temps < 10 THEN LOCATE 4, co - 3 ELSE LOCATE 4, co - 4
COLOR blancbrill, rouge
PRINT LTRIM$(STR$(temps))
COLOR noir, blanc
r$ = INKEY$
' Obtient l'emplacement de la souris et l'état des boutons.
MousePoll v_mouse, h_mouse, lButton, rButton
'LOCATE 22, 1: PRINT v_mouse, h_mouse '===
IF lButton THEN
IF v_mouse >= 10 AND v_mouse <= 19 THEN
sc = SCREEN(v_mouse, h_mouse)
IF sc = 32 THEN
BEEP
ELSE
'on cherche les lettres à gauche jusqu'à espace ou h1=1
h1 = h_mouse
DO
sc = SCREEN(v_mouse, h1)
IF sc = 32 THEN EXIT DO
h1 = h1 - 1
LOOP WHILE h1 <> 0
h1 = h1 + 1
h3 = h1: mot$ = ""
DO
sc = SCREEN(v_mouse, h3)
IF sc = 32 THEN EXIT DO
mot$ = mot$ + CHR$(sc)
h3 = h3 + 1
LOOP WHILE h3 <> 81
souris = 1
CALL epuration(mot$, res$)
CALL afformate(m$(), nm, 10, 0)
LOCATE v_mouse, h1
COLOR noir, vert
PRINT mot$
CALL attendre(.3)
EXIT DO
END IF
ELSEIF v_mouse = 23 THEN
IF h_mouse >= 46 AND h_mouse <= 48 THEN
r$ = CHR$(13)
CALL attendre(.3)
ELSEIF h_mouse = 33 THEN
'haut
rr = 72
CALL attendre(.2)
souris = 2
ELSEIF h_mouse = 35 THEN
'bas
rr = 80
CALL attendre(.2)
souris = 2
ELSEIF h_mouse = 37 THEN
'gauche
rr = 75
CALL attendre(.2)
souris = 2
ELSEIF h_mouse = 39 THEN
'droite
rr = 77
CALL attendre(.2)
souris = 2
ELSE
BEEP
END IF
ELSE
BEEP
END IF
END IF
IF r$ = CHR$(13) OR r$ = CHR$(27) THEN EXIT DO
IF LEN(r$) = 2 OR souris = 2 THEN EXIT DO
LOOP WHILE seconde <> fin
IF souris = 1 OR souris = 2 THEN RETURN
IF temps >= 30 THEN rr = 13: RETURN
IF LEN(r$) < 2 THEN
IF ASC(r$) = 13 THEN
rr = 13: RETURN
ELSEIF ASC(r$) = 27 THEN
rr = 27: RETURN
ELSE
GOTO chemotat1
END IF
END IF
rr = ASC(RIGHT$(r$, 1))
RETURN
cherchesol:
LOCATE 23, 1: PRINT SPACE$(co)
BEEP
CALL centre(23, rougeclair, "Solution")
CALL afformate(m$(), nm, 10, 0)
IF souris = 0 THEN
COLOR noir, blanc: LOCATE v2, h3: PRINT m2$
END IF
ki = 1: l2 = 0: h = 1: v = 10
IF couleur = 1 THEN COLOR blancbrill, rouge ELSE COLOR noir, blanc
DO
l = LEN(m$(ki))
l2 = l2 + l
IF l2 > co THEN
ki = ki - 1: l2 = 0
h = 1: v = v + 1
IF m$(ki) = m$(z(ii)) THEN
LOCATE v, h
IF RIGHT$(m$(ki), 1) = "," OR RIGHT$(m$(ki), 1) = "." THEN
PRINT MID$(m$(ki), 1, LEN(m$(ki)) - 1)
ELSE
PRINT m$(ki)
END IF
EXIT DO
END IF
ELSEIF l2 = co THEN
l2 = 0
h = co - LEN(m$(ki)) + 1
IF m$(ki) = m$(z(ii)) THEN
LOCATE v, h
IF RIGHT$(m$(ki), 1) = "," OR RIGHT$(m$(ki), 1) = "." THEN
PRINT MID$(m$(ki), 1, LEN(m$(ki)) - 1)
ELSE
PRINT m$(ki)
END IF
EXIT DO
END IF
v = v + 1
ELSEIF l2 = co - 1 THEN
h = co - LEN(m$(ki))
IF m$(ki) = m$(z(ii)) THEN
LOCATE v, h
IF RIGHT$(m$(ki), 1) = "," OR RIGHT$(m$(ki), 1) = "." THEN
PRINT MID$(m$(ki), 1, LEN(m$(ki)) - 1)
ELSE
PRINT m$(ki)
END IF
EXIT DO
END IF
ELSE
l2 = l2 + 1
h = l2 - LEN(m$(ki))
IF m$(ki) = m$(z(ii)) THEN
LOCATE v, h
IF RIGHT$(m$(ki), 1) = "," OR RIGHT$(m$(ki), 1) = "." THEN
PRINT MID$(m$(ki), 1, LEN(m$(ki)) - 1)
ELSE
PRINT m$(ki)
END IF
EXIT DO
END IF
END IF
ki = ki + 1
LOOP WHILE ki <= nm
CALL getinvimouse(w)
RETURN
END SUB
|
|
DECLARE SUB cadre (v%, h%, l%, nli%, c%)
DECLARE SUB quitter (fond%)
DECLARE SUB afformate (m$(), nm%, v%, h%)
DECLARE SUB pleinecran2 (r$, m$, v1%, v2%, rt$, gg$, pre$, titr$,
prog%, nom$, noir%, bleu%, vert%, rouge%, marron%, blanc%, vertclair%,
cyanclair%, rougeclair%, jaune%, blancbrill%)
DECLARE SUB ouinon (r$)
DECLARE SUB attendre (tx!)
DECLARE SUB MousePoll (row%, col%, lButton%, rButton%)
DECLARE SUB getinvimouse (rr%)
DECLARE SUB fleches (v%, h%, w$(), np%, r%, coul%, drap%, v2%, h3%)
DECLARE SUB consigne (nl%, w$, z$, y$)
DECLARE SUB titre ()
DECLARE SUB resultats (re%)
DECLARE SUB enregistrement (re%, mat%, VarEnreg AS ANY)
DECLARE SUB ligne23 ()
DECLARE SUB entree (x%, flag%)
DECLARE SUB centre (v%, coul%, ph$)
DECLARE SUB getinvi (rr%)
DECLARE SUB erreur2 ()
DECLARE SUB exact2 ()
DECLARE SUB choixparag (np%, r%)
DECLARE SUB transforme (m$)
DECLARE SUB trouvemot (m$, m$(), nm%)
DECLARE SUB afficheformate (co%, m$(), nm%)
DECLARE SUB efface (v%, hk%)
DECLARE SUB recupere2 (m$, v1%, v2%)
'Exo 4
'Daniel CLERC
'Lecture Primaire
'15/5/96
DEFINT A-Z
SUB pleinecran2 (r$, m$, v1, v2, rt$, gg$, pre$, titr$, prog%, nom$,
noir%, bleu%, vert%, rouge%, marron%, blanc%, vertclair%,
cyanclair%, rougeclair%, jaune%, blancbrill%)
'pour ponctuer 12/5/96
m$ = RTRIM$(m$)
co = 80
'_saisie plein ecran_
f = -1: 'insertion
COLOR , noir
LOCATE 22: PRINT SPACE$(80): PRINT SPACE$(80)
CALL centre(22, vertclair, "Avec les flèches, déplace le curseur là
où tu veux faire tes modifications.")
CALL centre(23, blanc, "Ret.Arr Suppr Inser Origine Fin " + CHR$(24)
+ " " + CHR$(25) + " " + CHR$(27) + " " + CHR$(26) + " " + rt$ + " =
valider")
COLOR noir, blanc
'COLOR blancbrill, bleu
VIEW PRINT v1 - 1 TO v2
v = v1: h = 1
plecran0:
CLS 2
plecran1:
LOCATE v1, 1, 0: PRINT m$
plecran2:
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$
MousePoll v_mouse, h_mouse, lButton, rButton
'LOCATE 8: PRINT v_mouse, h_mouse, v1, v2'===
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 THEN
IF h_mouse >= 61 AND h_mouse <= 73 THEN
r$ = CHR$(13)
CALL attendre(.3)
ELSEIF h_mouse >= 33 AND h_mouse <= 39 THEN
'origine
r2 = 71
CALL attendre(.2)
souris = 2
EXIT DO
ELSEIF h_mouse >= 43 AND h_mouse <= 45 THEN
'fin
r2 = 79
CALL attendre(.2)
souris = 2
EXIT DO
ELSEIF h_mouse = 49 THEN
'haut
r2 = 72
CALL attendre(.2)
souris = 2
EXIT DO
ELSEIF h_mouse = 51 THEN
'bas
r2 = 80
CALL attendre(.2)
souris = 2
EXIT DO
ELSEIF h_mouse = 53 THEN
'gauche
r2 = 75
CALL attendre(.2)
souris = 2
EXIT DO
ELSEIF h_mouse = 55 THEN
'droite
r2 = 77
CALL attendre(.2)
souris = 2
EXIT DO
ELSEIF h_mouse >= 25 AND h_mouse <= 28 THEN
'ins
r2 = 82
CALL attendre(.2)
souris = 2
EXIT DO
ELSEIF h_mouse >= 17 AND h_mouse <= 21 THEN
'suppr
r2 = 83
CALL attendre(.2)
souris = 2
EXIT DO
ELSEIF h_mouse >= 7 AND h_mouse <= 13 THEN
'del
r$ = CHR$(8)
CALL attendre(.2)
souris = 0
ELSE
BEEP
END IF
ELSE
BEEP
END IF
END IF
LOOP WHILE r$ = ""
IF souris = 1 THEN GOTO plecran2
IF souris = 2 THEN GOTO plecran4
IF r$ = CHR$(27) OR r$ = CHR$(13) THEN VIEW PRINT: LOCATE , , 0:
EXIT SUB
IF LEN(r$) = 2 THEN GOTO plecran3
r2 = ASC(r$)
IF r2 > 31 AND r2 < 166 THEN
IF LEN(m$) > 356 THEN
BEEP
VIEW PRINT
COLOR , noir
LOCATE 23, 1, 0: PRINT SPACE$(80)
CALL centre(23, rougeclair, "Tu as tapé trop de caractères !")
CALL getinvimouse(w)
CALL efface(23, 1)
CALL centre(23, blanc, "Ret.Arr Suppr Inser Origine Fin " + CHR$(24)
+ " " + CHR$(25) + " " + CHR$(27) + " " + CHR$(26) + " " + rt$ + " =
valider")
LOCATE , , 1
COLOR noir, blanc
VIEW PRINT v1 - 1 TO v2
GOTO plecran1
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 plecran1
END IF
IF r2 = 8 THEN 'delete
IF h = 1 AND v = v1 THEN GOTO plecran0
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 plecran0
END IF
plecran3:
'carac étendu
r2 = ASC(RIGHT$(r$, 1))
plecran4:
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 plecran2 'home
IF r2 = 79 THEN h = co: GOTO plecran2 'end
IF r2 = 73 THEN v = v1: h = 1: GOTO plecran2'pgup
IF r2 = 81 THEN v = v2: h = co: GOTO plecran2'pgdown
IF r2 = 75 THEN h = h - 1: IF h < 1 AND v > v1 THEN h = co: v = v -
1: GOTO plecran2 'gauche
IF r2 = 82 THEN f = NOT f: GOTO plecran0 'ins
IF r2 = 83 THEN 'suppr
m$ = MID$(m$, 1, lc - 1) + MID$(m$, lc + 1)
GOTO plecran0
END IF
GOTO plecran2
END SUB
DEFINT A-Z
SUB ponctuer (re, co, parag, n$(), rt$, gg$, pre$, titr$, prog%,
nom$, noir%, bleu%, vert%, rouge%, marron%, blanc%, vertclair%,
cyanclair%, rougeclair%, jaune%, blancbrill%)
'22/2/96
DIM m$(320), m2$(320), p$(2)
'présentation
w$ = "Dans le texte, la ponctuation va être effacée."
z$ = "Tu devras la retaper comme dans un traitement de textes."
CALL consigne(2, w$, z$, y$)
nu = 1
IF parag > 1 THEN
CALL choixparag(parag, nu)
END IF
'on choisit sans les maj ou avec
p$(1) = "Texte avec les majuscules"
p$(2) = "Texte sans les majuscules"
CALL titre
CALL fleches(12, (co / 2) - 12, p$(), 2, ni, rouge, 1, 23, 35)
m$ = n$(nu)
er = 0
m2$ = m$
CALL titre
CALL trouvemot(m$, m$(), nm)
CALL afformate(m$(), nm, 9, 10)
COLOR , noir
CALL centre(23, blanc, "Mémorise le texte puis tape " + rt$)
'on transforme le texte m$ (m2$ est la référence)
IF ni = 2 THEN
m$ = LCASE$(m2$)
ELSE
m$ = m2$
END IF
l = LEN(m$)
FOR i = 1 TO l
x$ = MID$(m$, i, 1)
IF x$ = "." OR x$ = "," OR x$ = ";" OR x$ = "!" OR x$ = "?" OR x$ =
":" THEN
m$ = MID$(m$, 1, i - 1) + MID$(m$, i + 1)
i = i - 1
END IF
NEXT
IF m2$ = m$ THEN
BEEP
CALL centre(23, rougeclair, "Il n'y a pas de majuscules ni de
ponctuation dans ce texte.")
CALL getinvimouse(w)
EXIT SUB
END IF
CALL getinvimouse(w)
debponctuer:
CALL titre
DO
CALL pleinecran2(r$, m$, 9, 14, rt$, gg$, pre$, titr$, prog%, nom$,
noir%, bleu%, vert%, rouge%, marron%, blanc%, vertclair%,
cyanclair%, rougeclair%, jaune%, blancbrill%)
IF r$ = CHR$(27) THEN CALL quitter(bleu)
LOOP WHILE r$ = CHR$(27)
COLOR , noir
LOCATE 22, 1: PRINT SPACE$(co): PRINT SPACE$(co)
CALL recupere2(m$, 9, 14)
IF m$ = CHR$(255) THEN
BEEP: BEEP
CALL centre(23, rougeclair, "Tu as effacé tout le texte !")
CALL getinvimouse(w)
EXIT SUB
END IF
CALL titre
COLOR , bleu
CALL transforme(m$)
CALL trouvemot(m$, m$(), nm)
FOR i = 1 TO nm
l = LEN(m$(i))
IF l > co - 1 THEN
BEEP: LOCATE , , 0: COLOR , noir
CALL centre(23, rougeclair, "Tu as du supprimer trop d'espaces !")
COLOR blancbrill
CALL getinvimouse(r)
GOTO debponctuer
END IF
NEXT i
CALL afformate(m$(), nm, 9, 10)
CALL cadre(4, 30, 20, 2, marron)
COLOR , marron
CALL centre(5, blancbrill, "Est-ce correct ?")
p$(1) = "oui"
p$(2) = "non"
COLOR , noir
CALL centre(23, blanc, gg$)
CALL fleches(17, 39, p$(), 2, r, rouge, 1, 23, 35)
SELECT CASE r
CASE 1
flag = 1
CASE 2
flag = 0
END SELECT
CALL ligne23
IF flag = 0 THEN GOTO debponctuer
IF m$ = m2$ THEN
CALL exact2
IF er = 0 THEN
re = 10
ELSEIF er = 1 THEN
re = 8
END IF
ELSE
IF m$ = LCASE$(m2$) THEN
CALL centre(23, rougeclair, "Tu as oublié des majuscules.")
ELSEIF (LEFT$(m$, 1) <> LEFT$(m2$, 1)) AND (UCASE$(LEFT$(m$, 1)) =
LEFT$(m2$, 1)) THEN
CALL centre(23, rougeclair, "Tu as oublié la majuscule du début.")
ELSEIF RIGHT$(m$, 2) <> RIGHT$(m2$, 2) THEN
CALL centre(23, rougeclair, "Tu as oublié la ponctuation finale.")
ELSE
CALL centre(23, rougeclair, "Erreur")
END IF
CALL getinvimouse(w)
er = er + 1
IF er > 1 THEN
'affichage des deux textes et resaisie
CALL titre
CALL trouvemot(m2$, m2$(), nm)
LOCATE 5, , 0: COLOR vertclair, bleu
CALL afficheformate(co, m2$(), nm)
COLOR rouge: LOCATE 11: PRINT STRING$(co, CHR$(196))
CALL trouvemot(m$, m$(), nm)
debponctuer2:
COLOR blancbrill, bleu
DO
CALL pleinecran2(r$, m$, 13, 19, rt$, gg$, pre$, titr$, prog%, nom$,
noir%, bleu%, vert%, rouge%, marron%, blanc%, vertclair%,
cyanclair%, rougeclair%, jaune%, blancbrill%)
IF r$ = CHR$(27) THEN CALL quitter(bleu)
LOOP WHILE r$ = CHR$(27)
COLOR , noir
LOCATE 22, 1: PRINT SPACE$(co): PRINT SPACE$(co)
CALL recupere2(m$, 13, 19)
IF m$ = CHR$(255) THEN
BEEP: BEEP
CALL centre(23, rougeclair, "Tu as effacé tout le texte !")
CALL getinvimouse(w)
EXIT SUB
END IF
COLOR , bleu
CALL transforme(m$)
CALL trouvemot(m$, m$(), nm)
FOR i = 1 TO nm
l = LEN(m$(i))
IF l > co - 1 THEN
BEEP: LOCATE , , 0: COLOR , noir
CALL centre(23, rougeclair, "Tu as du supprimer trop d'espaces !")
COLOR blancbrill
CALL getinvimouse(r)
GOTO debponctuer2
END IF
NEXT i
COLOR , bleu
VIEW PRINT 12 TO 20: CLS 2: VIEW PRINT
'LOCATE 12, 1: FOR i = 1 TO 8: PRINT SPACE$(co): NEXT
COLOR rougeclair
LOCATE 13
CALL afficheformate(co, m$(), nm)
COLOR , noir
LOCATE 23, 1: PRINT SPACE$(co)
IF m$ = m2$ THEN
CALL exact2
re = 5
ELSE
IF m$ = LCASE$(m2$) THEN
CALL centre(23, rougeclair, "Tu as oublié des majuscules.")
ELSEIF (LEFT$(m$, 1) <> LEFT$(m2$, 1)) AND (UCASE$(LEFT$(m$, 1)) =
LEFT$(m2$, 1)) THEN
CALL centre(23, rougeclair, "Tu as oublié la majuscule du début.")
ELSEIF RIGHT$(m$, 2) <> RIGHT$(m2$, 2) THEN
CALL centre(23, rougeclair, "Tu as oublié la ponctuation finale.")
ELSE
CALL centre(23, rougeclair, "Compare les textes.")
END IF
re = 3
CALL getinvimouse(w)
END IF
ELSE
CALL titre
CALL trouvemot(m2$, m$(), nm)
CALL afformate(m$(), nm, 9, 10)
COLOR blanc, noir
CALL centre(23, blanc, "Relis le texte puis tape " + rt$)
CALL getinvimouse(w)
GOTO debponctuer
END IF
END IF
CALL resultats(re)
'CALL enregistrement(re, 11, VarEnreg)'===
END SUB
DEFINT A-Z
SUB recupere2 (m$, v1, v2)
LOCATE 22, 1: COLOR , noir: PRINT SPACE$(80): COLOR , bleu
'_recuperation texte pour ponctuer_
m$ = ""
FOR y = v1 TO v2
FOR x = 1 TO 80
s = SCREEN(y, x)
m$ = m$ + CHR$(s)
NEXT x
NEXT y
IF LEFT$(m$, 355) = SPACE$(355) THEN m$ = CHR$(255): EXIT SUB
m$ = RTRIM$(m$): m$ = LTRIM$(m$)
m$ = m$ + " "
END SUB
|
|
