Note: L'EXL100 ne pouvant charger la totalité de ce programme en mémoire, Exeldessin est scindé en deux programmes «DESSIN0.BAS» et «DESSIN1.BAS». Le programme a été adapté pour une utilisation sur disquette, le seconde partie du programme se lançant automatiquement.
1ER LISTING:
1 ! EXELDESSIN PAR HENRY MEZZASALMA
2 CALL REGLE
3 SUB CLIGNE(LI,COL,TEXT$,CLR$)
4 CALL COLOR(CLR$)
5 LOCATE (LI,COL):PRINT TEXT$
6 LOCATE (LI+1,COL):PRINT TEXT$
7 CALL COLOR("1bY")
8 SUBEND
9 SUB REGLE
10 DATA 1bB,1YB,1GB,1RB,1MB,1CB,1WB,1BB
11 RESTORE 10
12 FOR I=1 TO 8:READ C$(I):C1$(I)=SEG$(C$(I),2,1):NEXT
13 RANDOMIZE
14 CLS "Wbb":CALL CLIGNE(1,8,"DESSINER AVEC EXL 100","0YbH")
15 CALL CHAR(15,"00002040FC40200000"):CALL CHAR(16,"0F0305091020408")
16 CALL CHAR(17,"F0C0A09008040201"):CALL CHAR(18,"00000102040890A0C0F0")
17 CALL CHAR(13,"1038541010101010"):CALL CHAR(20,"0000804020100905030F")
18 CALL COLOR("1Wb")
19 LOCATE (4,1):PRINT "CE PROGRAMME SERT A DESSINER SUR L'ECRAN"
20 PRINT "A L'AIDE DU CLAVIER."
21 PRINT:PRINT "VOUS POUVEZ DESSINER TOUTES SORTES DE "
22 PRINT "FIGURES,AVEC LES CARACTERES DEJA "
23 PRINT "PROGRAMMES DE L'ORDINATEUR."
24 PRINT:PRINT "AU DEPART DU JEU VOUS POUVEZ DEFINIR VOS"
25 PRINT "PROPRES CARACTERES (AU NOMBRE DE 32)."
26 PRINT "LORS DE L'ELABORATION D'UN DESSIN"
27 PRINT "VOUS POUVEZ REVENIR A CES CARACTERES."
28 PRINT "GRACE A LA TOUCHE "" R ""....."
29 CALL COLOR("1YR"):PRINT:PRINT " POUR LES TOUCHES SPECIALES "
30 PRINT:PRINT " APPUYEZ SUR UNE TOUCHE "
31 A$=KEY$
32 CLS "bWW":CALL CLIGNE(1,10,"TOUCHES SPECIALES ","0RBH")
33 CALL COLOR("1WR"):LOCATE (3,1):
34 PRINT ""
35 CALL COLOR("1bW"):PRINT:PRINT " LES TOUCHES DE 1 A 8 SERVENT A AMENER"
36 PRINT " UN CARACTERE A L'ECRAN."
37 PRINT
38 PRINT CHR$(11)&""
39 PRINT CHR$(14)&" SONT LES TOUCHES FLECHEES."
40 PRINT CHR$(13)&" DU CLAVIER."
41 PRINT CHR$(15)&""
42 PRINT CHR$(16)&" OU ""O"" POUR LA MANETTE NO1"
43 PRINT CHR$(17)&" OU ""T"" """" """" """" """""
44 PRINT CHR$(18)&" OU ""("" """" """" """" """""
45 PRINT CHR$(20)&" OU ""H"" """" """" """" """""
46 CALL COLOR("1WR")
47 PRINT:PRINT "POUR LA SUITE,APPUYEZ SUR UNE TOUCHE. "
48 A$=KEY$
49 CLS "bWW":CALL CLIGNE(1,10,"TOUCHES SPECIALES ","0BH")
50 CALL COLOR("1WR"):LOCATE (3,1):
51 PRINT " LES TOUCHES DU CLAVIER SONT: "
52 CALL CLI("99")
53 LOCATE (7,2):PRINT "EN APPUYANT SUR LA TOUCHE ""9"" LA COUL-"
54 PRINT "-EUR DU CARACTERE CHANGE SANS ARRET."
55 PRINT "EN APPUYANT SUR N'IMPORTE QUELLE TOUCHE,"
56 PRINT "VOUS PASSEZ A LA COULEUR DU FOND."
57 PRINT "TOUJOURS EN APPUYANT SUR LA TOUCHE ""9"""
58 PRINT "VOUS CHANGER LA COULEUR DU FOND."
59 PRINT "EN APPUYANT SUR N'IMPORTE QUELLE TOUCHE,"
60 PRINT "VOUS POUVEZ REVENIR A VOTRE DESSIN."
61 CALL TOUCHE:CALL CLI("00")
62 LOCATE (12,1):PRINT "LA TOUCHE ""0"" SERT A EFFACER UN CARA-"
63 PRINT "-TERE.ET SE DEPLACER SANS DESSINER."
64 CALL TOUCHE:CALL CLI("AA")
65 LOCATE (10,1):PRINT "LA TOUCHE ""A"" SERT A EFFICHER UN TEXTE,"
66 PRINT "SUR VOTRE DESSIN."
67 PRINT:PRINT "ATTENTION !! LES LIGNES ET LES COLONNES."
68 PRINT "DEBUTENT LIGNE ""2"" ET COLONNE ""2"""
69 PRINT "ET TERMINENT AUX COLONNES ""39"""
70 PRINT:PRINT "LES LIGNES SONT AUX NOMBRES DE ""17"""
71 CALL TOUCHE:CALL CLI("CC")
72 LOCATE (10,1):PRINT "LA TOUCHE ""C"" CHANGE LA COULEUR,"
73 PRINT "DE L'ECRAN."
74 CALL TOUCHE:CALL CLI("EE")
75 LOCATE (8,1):PRINT "LORS DE L'ELABORATION D'UN DESSIN."
76 PRINT "ET QUE CELUI-CI NE VOUS PLAIT PAS GRACE"
77 PRINT "A LA TOUCHE ""E"" VOUS POUVEZ L'EFFACER,"
78 PRINT "A LA MEMOIRE ET EN RECOMMENCER UN AUTRE"
79 CALL TOUCHE:CALL CLI("MM")
80 LOCATE (8,1):PRINT "LORS D'UN EFFACEMENT DE L'ECRAN,GRACE"
81 PRINT "A LA TOUCHE ""M"" LE DESSIN SE REPRODUIT"
82 PRINT "TANT QU'IL EST MEMORISE."
83 PRINT "EXEMPLE:SI VOUS AVEZ FINI VOTRE DESSIN,"
84 PRINT "ET QUE VOUS VOUS RENDEZ COMPTE QUE VOUS"
85 PRINT "VOULEZ REDEFINIR UN CARACTERE VOUS POUV-"
86 PRINT "-EZ LE FAIRE,REVENIR AU CADRE DU DESSIN"
87 PRINT "ET LE DESSIN PRECEDENT SE REPRODUIT"
88 CALL TOUCHE:CALL CLI("RR")
89 LOCATE (8,1):PRINT "EN APPUYANT SUR LA TOUCHE ""R"" VOUS"
90 PRINT "RETOURNEZ A LA REDEFINITION DES "
91 PRINT "CARACTERES."
92 CALL TOUCHE:CALL CLI("PP")
93 LOCATE (8,1):PRINT "LA TOUCHE ""P"" CHANGE LA POSITION DU"
94 PRINT "DU CARACTERE,ET VOUS PERMET DE LE PLACER"
95 PRINT "N'IMPORTE OU DANS LE CADRE.EN PRECISANT,"
96 PRINT "LE NUMERO DE LA LIGNE ET LE NUMERO DE "
97 PRINT "COLONNE.":CALL TOUCHE:CALL CLI("VV")
98 LOCATE (8,1):PRINT "LA TOUCHE ""V"" EST TRES IMPORTANTE.."
99 PRINT "LORSQUE VOUS VOULEZ ENREGISTRER UN"
100 PRINT "DESSIN,ET SI VOUS VOULEZ UN FOND D'UNE"
101 PRINT "COULEUR QUELCONQUE.VOUS DEVEZ TOUT"
102 PRINT "D'ABORD APPUYER SUR LA TOUCHE ""M"""
103 PRINT "SINON UN TABLEAU SERA SUR FOND NOIR."
104 PRINT "VOUS POUVEZ DEFINIR LA COULEUR DU TABL-"
105 PRINT "-EAU DES LE DEPART ET DESSINER ENSUITE"
106 CALL COLOR("1WR"):PRINT "ATTENTION!!!"
107 CALL COLOR("1bW"):PRINT "POUR POUVOIR ENREGISTRER UN DESSIN:"
108 PRINT "IL EST OBLIGATOIRE D'APPUYER SUR LA"
109 PRINT "TOUCHE ""V""":CALL TOUCHE:CALL CLI("**")
110 LOCATE (8,1):PRINT "LA TOUCHE ""*"" PERMET DE FAIRE DEFILER"
111 PRINT "LES CARACTERES PREDEFINIS SOUS LES"
112 PRINT "CHIFFRES 1 A 8,ET DE FAIRE SON CHOIX:"
113 PRINT "DANS L'OPTION ""*"" VOUS POUVEZ FAIRE "
114 PRINT "DEFILER LES CARACTERES DU BAS DE L'ECRAN"
115 PRINT "DANS LES DEUX SENS AVEC LES TOUCHES "&CHR$(11)&" "&CHR$(15)
116 PRINT "POUR RETOURNER AU DESSIN APPUYER SUR"
117 PRINT "N'IMPORTE QUELLE TOUCHE.":CALL TOUCHE:CALL CLI("##")
118 LOCATE (8,1):PRINT "LA TOUCHE ""#"" PERMET L'ENREGISTREMENT"
119 PRINT "OU LA LECTURE D'UN DESSIN CREE PAR VOS SOINS."
120 CALL TOUCHE:CALL CLI("BBAARRRREE EESSPPAACCEE")
121 LOCATE (8,1):PRINT "LA "" BARRE ESPACE"" VOUS PERMET DE "
122 PRINT "TIRER UN TRAIT,D'UN BORD DE L'ECRAN (ET"
123 PRINT "CELA DANS TOUTES LES DIRECTIONS POSSI-"
124 PRINT "BLES)A LA POSITION DE VOTRE CARACTERE."
125 PRINT "BIEN ENTENDU LE TRAIT SERA COMPOSE DU"
126 PRINT "CARACTERE QUE VOUS AVEZ DEFINI."
127 CALL TOUCHE:CALL CLI(" ")
128 LOCATE (8,1):PRINT "LES REGLES NE SONT PAS INDISPENSABLES"
129 LOCATE (9,1):PRINT "POUR LE PROGRAMME EXELDESSIN....."
130 CALL TOUCHE
131 CLS "WBB"
132 CALL CLIGNE(1,4,"EXEMPLE DE COULEURS MELANGEES","0RYH")
133 CALL COLOR("1YR")
134 FOR I=3 TO 19:LOCATE (I,1):PRINT RPT$(CHR$(12),40)
135 S=INTRND(8):O=INTRND(8):CALL COLOR(SEG$(C$(S),1,2)&C1$(O))
136 NEXT I
137 CALL COLOR("1WB")
138 LOCATE (20,1):PRINT "VOULEZ VOUS REVOIR LES REGLES (O/N) N"
139 LOCATE (20,38):ACCEPT SIZE(-1)VALIDATE("ON"),OUI$
140 IF OUI$="O" THEN 14 ELSE CLS "RGG"
141 PRINT "UNE MINUTE DE PATIENCE, JE CHARGE LA SUITE DU PROGRAMME"
142 CALL DOS("LOADRUN DESSIN1.BAS")
143 SUBEND
144 SUB CLI(A$)
145 LOCATE (5,1):PRINT "TOUCHE -->:":CALL CLIGNE(4,13,A$,"0RbHLF")
146 CALL COLOR("1bW"):FOR I=6 TO 20:LOCATE (I,1):PRINT RPT$(" ",40):NEXT
147 SUBEND
148 SUB TOUCHE
149 CALL COLOR("1WR")
150 LOCATE (20,1):PRINT:PRINT "POUR LA SUITE,APPUYER SUR UNE TOUCHE"
151 A$=KEY$:SUBEND
2EME LISTING:
19 DIM F$(32),T$(17,39),T1$(17,39),VA$(17),COL$(17)
20 CALL CHAR(5,RPT$("01",10)):CALL CHAR(3,RPT$("80",10))
21 CALL CHAR(4,RPT$("0",18)&"FF"):CALL CHAR(6,"FF"&RPT$("0",18))
22 CALL CHAR(7,"FF"&RPT$("80",9)):CALL CHAR(8,"FF"&RPT$("01",9))
23 CALL CHAR(9,RPT$("80",9)&"FF"):CALL CHAR(19,RPT$("01",9)&"FF")
24 BO=8:DO=8
25 CLS "WBB"
26 CALL CLIGNE(12,12," UUNN IINNSSTTAANNTT SSVVPP......","1RHLF")
27 LT(1)=17:LT(2)=19:LT(3)=21:LT(4)=23:LT(5)=25:LT(6)=27:LT(7)=29:LT(8)=31
28 LET$="1122334455667788"
29 DATA 1bB,1YB,1GB,1RB,1MB,1CB,1WB,1BB
30 RESTORE 29
31 FOR I=1 TO 8:READ C$(I):NEXT
32 DATA BBLLEEUU,JJAAUUNNEE,VVEERRTT,RROOUUGGEE,MMAAGGEENNTTAA,CCYYAANN
33 DATA BBLLAANNCC,NNOOIIRR
34 RESTORE 32
35 FOR I=1 TO 8:READ D$(I):NEXT I
36 DATA b,Y,G,R,M,C,W,B
37 RESTORE 36
38 FOR I=1 TO 8:READ C1$(I):NEXT I
39 CALL CHAR(2,"00000000000000000000")
40 FOR I=2 TO 17:FOR II=2 TO 39
41 T1$(I,II)=CHR$(2)
42 T$(I,II)=("1"&SEG$(C$(BO),2,1)&C1$(DO))
43 NEXT II:NEXT I
44 GOSUB 279
45 CALL REGLE:BO=0:CO=0:TOUR=0
46 CLS "bWW"
47 CALL CLIGNE(1,7,"CHOIX DES CARACTERES","0RYH")
48 CALL CLIGNE(3,7,"--------------------","0BYH")
49 LOCATE (5,4):PRINT "VOICI CEUX DE L'ORDINATEUR"
50 PRINT:CALL COLOR("1bW")
51 CALL COLOR("1RW")
52 PRINT "CARACTERES ---> ";:FOR I=96 TO 103:PRINT CHR$(I);" ";:NEXT
53 CALL COLOR("1BW"):PRINT " 1 2 3 4 5 6 7 8"
54 CALL COLOR("1BY")
55 LOCATE (11,1):PRINT " 9="
56 LOCATE (13,1):PRINT "17="
57 LOCATE (15,1):PRINT "25="
58 LOCATE (11,4):PRINT CHR$(104);:FOR I=105 TO 111:PRINT " "&STR$(I-95)&"=";
59 PRINT CHR$(I);:NEXT
60 LOCATE (13,4):PRINT CHR$(112);:FOR I=113 TO 119:PRINT " "&STR$(I-95)&"=";
61 PRINT CHR$(I);:NEXT I
62 LOCATE (15,4):PRINT CHR$(120);:FOR I=121 TO 127:PRINT " "&STR$(I-95)&"=";
63 PRINT CHR$(I);:NEXT I
64 CALL COLOR("1RW")
65 LOCATE (17,1):PRINT "VOULEZ-VOUS CREER VOS CARACTERES (O/N) N"
66 LOCATE (17,40):ACCEPT SIZE(-1)VALIDATE("ON"),OUI$
67 IF OUI$="N" THEN 86 ELSE 68
68 LOCATE (17,1):PRINT " :"
69 LOCATE (17,1):PRINT "COMBIEN DE CARACTERES (1 A 32) "
70 LOCATE (17,32):ACCEPT SIZE(2)VALIDATE(DIGIT),CARAC
71 IF CARAC>32 THEN 69
72 IF CARAC=0 THEN 65
73 LOCATE (17,1):PRINT "COMBIEN DE CARACTERES "
74 FOR I=0 TO CARAC-1
75 LOCATE (17,1):PRINT "NUMERO DE CODE --> "
76 LOCATE (17,20):ACCEPT SIZE(2)VALIDATE(DIGIT),CA
77 IF CA>32 THEN 75
78 IF CA=0 THEN 83
79 LOCATE (17,1):PRINT "TAPEZ VOTRE CODE -> "&F$(CA)
80 LOCATE (17,21):ACCEPT SIZE(-20)VALIDATE("1234567890ABCDEF"),CA$
81 CALL CHAR(95+CA,CA$)
82 NEXT I
83 LOCATE (17,1):PRINT "UN AUTRE CHANGEMENT (O/N) N "
84 LOCATE (17,27):ACCEPT SIZE(-1)VALIDATE("ON"),OUI$
85 IF OUI$="0" THEN 68
86 CLS "BWW"
87 CALL COLOR("1BB"):FOR I=2 TO 17
88 LOCATE (I,2):PRINT RPT$(" ",38):NEXT I
89 CALL COLOR("1GB")
90 LOCATE (1,1):PRINT RPT$(CHR$(12),40)
91 LOCATE (18,1):PRINT RPT$(CHR$(12),40)
92 FOR I=2 TO 17:LOCATE (I,1):PRINT CHR$(12):NEXT I
93 FOR I=2 TO 17:LOCATE (I,40):PRINT CHR$(12):NEXT I
94 CALL COLOR("0WBL"):LOCATE (1,5):PRINT "BBLLAANNCC"
95 CALL COLOR("0WBL"):LOCATE (1,25):PRINT "NNOOIIRR"
96 CALL REGL
97 TOUR=TOUR+1:IF TOUR>1 THEN 102
98 CL=19:LI=9:R=88
99 LOCATE (LI,CL):PRINT CHR$(88)
100 CALL COLOR("1WB")
101 C$(B0)="1WB":C1$(CO)="B"
102 TR2,TRAIT,TR3,TR4=0:BB=1
103 A1=96:A2=97:A3=98:A4=99:A5=100:A6=101:A7=102:A8=103
104 LOCATE (LI,CL):PRINT CHR$(R)
105 CALL LIG(SEG$(C$(BO),1,2)&C1$(CO))
106 CALL KEY1(A,B):GOSUB 140
107 LOCATE (18,10):PRINT USING"LIGNE=##",LI
108 LOCATE (18,18):PRINT USING" COLONNE=## ",LI
109 IF B=0 THEN 106
110 IF A=32 THEN TRAIT=39:TR2,TR3=2:TR4=17
111 IF A=129 THEN GOSUB 142
112 IF A=131 THEN GOSUB 151
113 IF A=128 THEN GOSUB 161
114 IF A=130 THEN GOSUB 170
115 IF A=79 THEN GOSUB 179
116 IF A=84 THEN GOSUB 194
117 IF A=60 THEN GOSUB 209
118 IF A=72 THEN GOSUB 224
119 IF A=77 THEN GOSUB 316
120 IF A=80 THEN GOSUB 337
121 IF A=48 THEN R=2:CALL COLOR(SEG$(C$(BO),1,2)&C1$(DO)):GOSUB 140
122 IF A=49 THEN R=A1:GOSUB 299:LOCATE (LI,CL):PRINT CHR$(A1)
123 IF A=50 THEN R=A2:GOSUB 299:LOCATE (LI,CL):PRINT CHR$(A2)
124 IF A=51 THEN R=A3:GOSUB 299:LOCATE (LI,CL):PRINT CHR$(A3)
125 IF A=52 THEN R=A4:GOSUB 299:LOCATE (LI,CL):PRINT CHR$(A4)
126 IF A=53 THEN R=A5:GOSUB 299:LOCATE (LI,CL):PRINT CHR$(A5)
127 IF A=54 THEN R=A6:GOSUB 299:LOCATE (LI,CL):PRINT CHR$(A6)
128 IF A=55 THEN R=A7:GOSUB 299:LOCATE (LI,CL):PRINT CHR$(A7)
129 IF A=56 THEN R=A8:GOSUB 299:LOCATE (LI,CL):PRINT CHR$(A8)
130 IF A=82 THEN 46
131 IF A=67 THEN GOSUB 303
132 IF A=69 THEN GOSUB 328
133 IF A=86 THEN GOSUB 377
134 IF A=37 THEN GOSUB 429
135 IF A=57 THEN GOSUB 239
136 IF A=42 THEN GOSUB 285
137 IF A=35 THEN GOSUB 402
138 IF A=65 THEN GOSUB 351
139 GOSUB 312:GOTO 106
140 LL=LI:CC=CL
141 LOCATE (LI,CL):PRINT CHR$(42):LOCATE (LI,CL):PRINT CHR$(R):RETURN
142 ! FONCTION 129-->
143 IF TRAIT=0 THEN 148
144 FOR X=TRAIT TO CL STEP -1
145 LOCATE (LI,X):PRINT CHR$(R);:LL=LI:CC=X:GOSUB 312:NEXT X
146 TR2,TRAIT,TR3,TR4=0
147 CL=39:GOTO 149
148 CL=CL+1:IF CL>38 THEN CL=39
149 LOCATE (LI,CL):PRINT CHR$(R);
150 LL=LI:CC=CL:GOSUB 312:RETURN
151 ! FONCTION 131<--
152 IF TR2=0 THEN 158
153 FOR X=TR2 TO CL
154 LOCATE (LI,X):LL=LI:CC=X:GOSUB 312:PRINT CHR$(R);
155 NEXT X
156 TR2,TRAIT,TR3,TR4=0
157 CL=2:GOTO 159:CL=CL+1
158 CL=CL-1:IF CL<3 THEN CL=2
159 LOCATE (LI,CL):PRINT CHR$(R);
160 LL=LI:CC=CL:GOSUB 312:RETURN
161 ! FONCTION 128 ^
162 IF TR3=0 THEN 167
163 FOR X=TR3 TO LI
164 LOCATE (X,CL):PRINT CHR$(R);:LL=X:CC=CL:GOSUB 312:NEXT X
165 TR2,TRAIT,TR3,TR4=0
166 LI=2:GOTO 168
167 LI=LI-1:IF LI<3 THEN LI=2
168 LOCATE (LI,CL):PRINT CHR$(R)
169 LL=LI:CC=CL:GOSUB 312:RETURN
170 ! FONCTION 130
171 IF TR4=0 THEN 176
172 FOR X=TR4 TO LI STEP -1
173 LOCATE (X,CL):PRINT CHR$(R);:CC=CL:LL=X:GOSUB 312:NEXT X
174 TR2,TRAIT,TR3,TR4=0
175 LI=17:GOTO 177
176 LI=LI+1:IF LI>16 THEN LI=17
177 LOCATE (LI,CL):PRINT CHR$(R)
178 LL=LI:CC=CL:GOSUB 312:RETURN
179 ! FONCTION 79 "O"
180 IF TR2=0 THEN 205
181 FOR X=LI TO TR2 STEP -1
182 X1=X1+1:IF CL+X1-1>39 THEN 185
183 LOCATE (X,CL+X1-1):PRINT CHR$(R)
184 LL=X:CC=CL+X1-1:GOSUB 312:LI=X
185 NEXT X
186 IF CL+X1-1>39 THEN CL=39:TR2,TRAIT,TR3,TR4,X1=0:GOTO 188
187 CL=CL+X1-1
188 TR2,TRAIT,TR3,TR4,X1=0
189 GOTO 192
190 LI=LI-1:IF LI<3 THEN LI=2
191 CL=CL+1:IF CL>38 THEN CL=39
192 LOCATE (LI,CL):PRINT CHR$(R)
193 LL=LI:CC=CL:GOSUB 312:RETURN
194 ! FONCTION 84 "T"
196 FOR X=LI TO TR2 STEP -1
197 X1=X1+1:IF CL-X1+1<2 THEN 200
198 LL=X:CC=CL-X1+1:GOSUB 312:LI=X
199 LOCATE (X,CL-X1+1):PRINT CHR$(R)
200 NEXT X
201 IF CL-X1+1<2 THEN CL=2:TR2,TRAIT,TR3,TR4,X1=0:GOTO 207
202 CL=CL-X1+1
203 TR2,TRAIT,TR3,TR4,X1=0
204 GOTO 207!LI=LI+1:CL=CL+1
205 LI=LI-1:IF LI<3 THEN LI=2
206 CL=CL-1:IF CL<3 THEN CL=2
207 LOCATE (LI,CL):PRINT CHR$(R)
208 LL=LI:CC=CL:GOSUB 312:RETURN
209 ! FONCTION 60 "<"
210 IF TR4=0 THEN 220
211 FOR X=LI TO TR4
212 X1=X1+1:IF CL-X1+1<2 THEN 215
213 LOCATE (X,CL-X1+1):PRINT CHR$(R)
214 LL=X:CC=CL-X1+1:GOSUB 312:LI=X
215 NEXT X
216 IF CL-X1+1<2 THEN CL=2:TR2,TRAIT,TR3,TR4,X1=0:GOTO 222
217 CL=CL-X1+1
218 TR2,TRAIT,TR3,TR4,X1=0
219 GOTO 222
220 LI=LI+1:IF LI>16 THEN LI=17
221 CL=CL-1:IF CL<3 THEN CL=2
222 LOCATE (LI,CL):PRINT CHR$(R)
223 LL=LI:CC=CL:GOSUB 312:RETURN
224 ! FONCTION 72 "H"
225 IF TR4=0 THEN 235
226 FOR X=LI TO TR4
227 X1=X1+1:IF CL+X1-1>39 THEN 230
228 LOCATE (X,CL+X1-1):PRINT CHR$(R)
229 LL=X:CC=CL+X1-1:GOSUB 312:LI=X
230 NEXT X
231 IF CL+X1-1<39 THEN CL=39:TR2,TRAIT,TR3,TR4,X1=0:GOTO 237
232 CL=CL+X1-1
233 TR2,TRAIT,TR3,TR4,X1=0
234 GOTO 237!LI=LI-1:CL=CL-1
235 LI=LI+1:IF LI>16 THEN LI=17
236 CL=CL+1:IF CL>38 THEN CL=39
237 LOCATE (LI,CL):PRINT CHR$(R)
238 LL=LI:CC=CL:GOSUB 312:RETURN
239 !CHANGEMENT DE COULEUR
240 CALL COLOR("0WBL"):LOCATE (1,5):PRINT D$(BO)
241 CALL LIG(SEG$(C$(BO),1,2)&C1$(CO))
242 LOCATE (18,2):PRINT "TOUCHE""9""POUR COULEUR DU CARACTERE: "&CHR$(R)
243 CALL KEY1(A,B)
244 IF A=57 THEN BO=BO+1:CALL EF1
245 IF B=1 AND A<>57 THEN PAUSE .1:GOTO 252
246 IF BO>8 THEN BO=0
247 IF BO=8 THEN CALL COLOR("0WBL"):LOCATE (1,5):PRINT D$(8)
248 CALL COLOR("0"&SEG$(C$(BO),2,1)&"BL"):LOCATE (1,5):PRINT D$(BO)
249 CALL COLOR(C$(BO)):PRINT CHR$(R):LOCATE (18,39)
250 PRINT CHR$(R)
251 GOTO 243
252 CALL COLOR("0WBL"):LOCATE (1,25):PRINT "FFOONNDD":CALL COLOR(C$(BO))
253 CALL LIG(SEG$(C$(BO),1,2)&C1$(CO))
254 LOCATE (18,2):PRINT "TOUCHE""9""POUR COULEUR DU FOND ---> "&CHR$(R)
255 CALL KEY1(A,B)
256 IF A=57 THEN CO=CO+1:PAUSE .1:CALL EF2
257 IF B=1 AND A<>57 THEN CALL LIG(SEG$(C$(BO),1,2)&C1$(CO)):RETURN
258 IF CO>8 THEN CO=0
259 IF CO=8 THEN CALL COLOR("0WBL"):LOCATE (1,25):PRINT D$(8):CO=0
260 CALL COLOR("0"&SEG$(C$(CO),2,1)&"BL"):LOCATE (1,25):PRINT D$(CO)
261 CALL COLOR("1"&SEG$(C$(BO),2,1)&C1$(CO))
262 LOCATE (LI,CL):PRINT CHR$(R):LOCATE (18,39):PRINT CHR$(R)
263 GOTO 255
264 !
265 ! DATAS DES DIFFERENTS CARACTERES
266 !
267 DATA FFFFFFFFFFFFFFFFFFFF
268 DATA FFFFC3C3C3C3C3C3FFFF,010303070F1F3F3F7FFF,80C0C0E0F0F8FCFCFEFF
269 DATA 01020404081020204080,80402020100804040201,003C66C38181C3663C00
270 DATA 003C7EFFFFFFFF7E3C00,FF9999FF9999FF9999FF,AA55AA55AA55AA55AA55
271 DATA 3C3C3C3C3C3C3C3C3C3C,818181818181818181FF,20202020FF04040404FF
272 DATA FFC3A5999999A5C3FFFF,0000070F3F7F7FFFFFFF,FFFFFF7F7F3F0F070000
273 DATA 0000E0F0FCFEFEFFFFFF,FFFFFFFEFEFCF0E00000,FFE7C3C3810000000000
274 DATA 000000000081C3C3E7FF,18181818FFFF18181818,1819027E98387C282828
275 DATA 99896618181808242466,3C7E5A7E423C18C33CC3,C3817EFF99FF663C24E7
276 DATA 183C3C99FF99182442C3,0C1C30180C060343877E,08081C1C1C1C1C3E3E14
277 DATA F090F0313F3F19112163,0F090F8CFCFC988884C6,040C1C3E7FFF08FF7F3C
278 DATA 0081C3E367360C120000
279 RESTORE 267
280 FOR I=1 TO 32:READ F$(I):CALL CHAR(95+I,F$(I)):NEXT I
281 RETURN
282 !
283 ! ECRITURE LIGNE "*"
284 !
285 ON ERROR 46
286 CALL LIG(SEG$(C$(BO),1,2)&C1$(CO))
287 LOCATE (18,8):PRINT "CHOIX DES AUTRES CARACTERES "
288 CALL KEY1(A,B):IF B=0 THEN 288
289 IF A=129 THEN Y=Y+8:IF Y>128 THEN Y=1
290 IF A=131 THEN Y=Y-8:IF Y<1 THEN Y=128
291 IF A<>131 AND A<>129 THEN CALL LIG(SEG$(C$(BO),1,2)&C1$(CO)):RETURN
292 LOCATE (20,18)
293 CALL COLOR("1RW")
294 PRINT:PRINT "CARACTERES---> ";
295 PRINT TAB(17);" ";:FOR I=0 TO 7:PRINT CHR$(Y+I)&" ";:NEXT
296 PRINT " "
297 A1=Y:A2=Y+1:A3=Y+2:A4=Y+3:A5=Y+4:A6=Y+5:A7=Y+6:A8=Y+7
298 CALL COLOR(SEG$(C$(BO),1,2)&C1$(CO)):GOTO 288
299 ! CHIFFRES CLIGNOTANTS
300 CALL COLOR("0bWL"):LOCATE (19,17):PRINT LET$
301 CALL COLOR("0bWLF"):LOCATE (19,LT(VAL(CHR$(A)))):PRINT CHR$(A)&CHR$(A)
302 CALL COLOR(SEG$(C$(BO),1,2)&C1$(CO)):RETURN
303 !
304 ! COULEUR ECRAN
305 !
306 DO=DO+1:IF DO>8 THEN DO=0
307 CALL COLOR("1"&SEG$(C$(BO),2,1)&C1$(DO))
308 FOR I=2 TO 17
309 LOCATE (I,2)
310 PRINT RPT$(CHR$(2),38):NEXT I
311 CALL COLOR(SEG$(C$(BO),1,2)&C1$(CO)):RETURN
312 ! MEMORISATION CARACTERES
313 T1$(LL,CC)=CHR$(R)
314 T$(LL,CC)=(SEG$(C$(BO),1,2)&C1$(CO))
315 RETURN
316 ! ECRAN CARACTERES
317 CALL LIG(SEG$(C$(BO),1,2)&C1$(CO))
318 LOCATE (18,12):PRINT "MEMORISATION CARA."
319 FOR AA=2 TO 17:FOR BB=2 TO 39
320 IF T1$(AA,BB)=CHR$(2)THEN T$(AA,BB)="1"&SEG$(C$(BO),2,1)&C1$(DO)
321 CALL COLOR(T$(AA,BB)):LOCATE (AA,BB):PRINT T1$(AA,BB)
322 CALL COLOR("1"&SEG$(C$(BO),2,1)&C1$(DO))
323 NEXT BB:NEXT AA
324 LOCATE (18,12):PRINT "FIN MEMORISATION "
325 PAUSE 1:CALL LIG(SEG$(C$(BO),1,2)&C1$(CO)):RETURN
326 !
327 ! EFFACEMENT MEMOIRE
328 !
329 CALL LIG(SEG$(C$(BO),1,2)&C1$(CO))
330 LOCATE (18,12):PRINT "EFFACEMENT MEMOIRE"
331 FOR AA=2 TO 17:FOR BB=2 TO 39
332 T1$(AA,BB)=CHR$(2)
333 NEXT BB:NEXT AA
334 LOCATE (18,12):PRINT "FIN EFFACEMENT"
335 PAUSE 1:CALL LIG(SEG$(C$(BO),1,2)&C1$(CO))
336 RETURN
337 ! POSITION LIGNE COLONNE
338 CALL COLOR("0BW"):CALL EFFACE2
339 LOCATE (20,2):PRINT "CHANGEMENT DE POSITION (O/N) N "
340 LOCATE (20,31):ACCEPT SIZE(-1)VALIDATE("ON"),OUI$
341 IF OUI$="N" THEN CALL REGL:GOSUB 292:RETURN
342 LOCATE (20,2):PRINT "TAPEZ LE NUMERO DE LA LIGNE "
343 LOCATE (20,31):ACCEPT SIZE(2)VALIDATE(DIGIT),LIG:LI,LL=LIG
344 IF LIG<2 OR LIG>17 THEN 343
345 LOCATE (20,2):PRINT "TAPEZ LE NUMERO DE LA COLONNE "
346 LOCATE (20,31):ACCEPT SIZE(2)VALIDATE(DIGIT),COLL:CL,CC=COLL
347 IF COLL<2 OR COLL>39 THEN 346
348 CALL LIG(SEG$(C$(BO),1,2)&C1$(CO))
349 CALL REGL:GOTO 285
350 LOCATE (LI,CL):PRINT CHR$(R):RETURN
351 ! AFFICHAGE D'UN TEXTE
352 CALL LIG(SEG$(C$(BO),1,2)&C1$(CO))
353 CALL COLOR("0BW"):CALL EFFACE2
354 LOCATE (20,2):PRINT "ECRITURE DU TEXTE (O/N) N "
355 LOCATE (20,26):ACCEPT SIZE(-1)VALIDATE("ON"),OUI$
356 IF OUI$="N" THEN CALL REGL:GOSUB 292:RETURN
357 LOCATE (20,2):PRINT "TAPEZ LE NUMERO DE LA LIGNE-->"
358 LOCATE (20,33):ACCEPT SIZE(2)VALIDATE(DIGIT),LIGG
359 IF LIGG<2 OR LIGG>17 THEN 357
360 LOCATE (20,2):PRINT "TAPEZ LE NUMERO DE LA COLONNE > "
361 LOCATE (20,33):ACCEPT SIZE(2)VALIDATE(DIGIT),COLL
362 IF COLL<2 OR COLL>39 THEN 360
363 LOCATE (19,2):PRINT "TAPEZ VOTRE TEXTE (1 A 38 CAR.) ";
364 PRINT CHR$(12)&RPT$(" ",38)&CHR$(12)
365 LOCATE (20,2):ACCEPT SIZE(38),TEX$
366 IF LEN(TEX$)+COLL>40 THEN GOSUB 374:GOTO 353
367 FOR I=1 TO LEN(TEX$)
368 T1$(LIGG,COLL+I-1)=SEG$(TEX$,I,1)
369 IF SEG$(TEX$,I,1)=" " THEN T1$(LIGG,COLL+I-1)=CHR$(2)
370 T$(LIGG,COLL+I-1)=(SEG$(C$(BO),1,2)&C1$(CO)):NEXT I
371 CALL LIG(SEG$(C$(BO),1,2)&C1$(CO)):LOCATE (LIGG,COLL):PRINT TEX$
372 CALL REGL:GOTO 286
373 LOCATE (LI,CL):CHR$(R):RETURN
374 CALL COLOR("0RLF"):LOCATE (18,5)
375 PRINT "TTRROOPP DDEE LLEETTRREESS"
376 PAUSE 4:CALL COLOR("0BW"):CALL LIG("0BW"):RETURN
377 ! MEMORISATION VA$(V)
378 CALL LIG(SEG$(C$(BO),1,2)&C1$(CO))
379 LOCATE (18,5):PRINT "MEMORISATION POUR ENREGISTREMENT"
380 FOR I=2 TO 17:V=I:GOSUB 382:NEXT I
381 FOR I=2 TO 17:V=I:GOSUB 391:NEXT I:GOSUB 400
382 !BOUCLE VA$(V)
383 VAL$(1)=T1$(V,2)&T1$(V,3)&T1$(V,4)&T1$(V,5)&T1$(V,6)&T1$(V,7)&T1$(V,8)
384 VAL$(2)=T1$(V,9)&T1$(V,10)&T1$(V,11)&T1$(V,12)&T1$(V,13)&T1$(V,14)
385 VAL$(3)=T1$(V,15)&T1$(V,16)&T1$(V,17)&T1$(V,18)&T1$(V,19)&T1$(V,20)
386 VAL$(4)=T1$(V,21)&T1$(V,22)&T1$(V,23)&T1$(V,24)&T1$(V,25)&T1$(V,26)
387 VAL$(5)=T1$(V,27)&T1$(V,28)&T1$(V,29)&T1$(V,30)&T1$(V,31)&T1$(V,32)
388 VAL$(6)=T1$(V,33)&T1$(V,34)&T1$(V,35)&T1$(V,36)&T1$(V,37)&T1$(V,38)
389 VAL$(7)=T1$(V,39)&T1$(V,39)
390 VA$(V)=VAL$(1)&VAL$(2)&VAL$(3)&VAL$(4)&VAL$(5)&VAL$(6)&VAL$(7):RETURN
391 !BOUCLE COL$(V)
392 CL$(1)=T$(V,2)&T$(V,3)&T$(V,4)&T$(V,5)&T$(V,6)&T$(V,7)&T$(V,8)
393 CL$(2)=T$(V,9)&T$(V,10)&T$(V,11)&T$(V,12)&T$(V,13)&T$(V,14)
394 CL$(3)=T$(V,15)&T$(V,16)&T$(V,17)&T$(V,18)&T$(V,19)&T$(V,20)
395 CL$(4)=T$(V,21)&T$(V,22)&T$(V,23)&T$(V,24)&T$(V,25)&T$(V,26)
396 CL$(5)=T$(V,27)&T$(V,28)&T$(V,29)&T$(V,30)&T$(V,31)&T$(V,32)
397 CL$(6)=T$(V,33)&T$(V,34)&T$(V,35)&T$(V,36)&T$(V,37)&T$(V,38)&T$(V,39)
398 CL$(7)=T$(V,39)
399 COL$(V)=CL$(1)&CL$(2)&CL$(3)&CL$(4)&CL$(5)&CL$(6)&CL$(7):RETURN
400 LOCATE (18,5):PRINT " FIN MEMORISATION "
401 PAUSE 1:CALL LIG(SEG$(C$(BO),1,2)&C1$(CO)):RETURN
402 ! ENREGISTREMENT
403 CALL LIG(SEG$(C$(BO),1,2)&C1$(CO))
404 LOCATE (18,2):PRINT "1 POUR ENREG. 2 POUR LECT. 3 RETOUR"
405 CALL KEY1(A,B):IF B=0 THEN 405
406 IF A=49 THEN CALL LIG(SEG$(C$(BO),1,2)&C1$(CO)):GOTO 410
407 IF A=50 THEN CALL LIG(SEG$(C$(BO),1,2)&C1$(CO)):GOTO 419
408 IF A=51 THEN CALL LIG(SEG$(C$(BO),1,2)&C1$(CO)):RETURN
409 GOTO 404
410 OPEN #1,"1.CARA",OUTPUT,VARIABLE 220
411 LOCATE (18,5):PRINT " ENREGISTREMENT "
412 FOR Y=2 TO 17
413 PRINT #1,COL$(Y):NEXT Y
414 FOR Y=2 TO 17
415 PRINT #1,VA$(Y)
416 NEXT Y
417 CLOSE #1
418 PAUSE 1:CALL LIG(SEG$(C$(BO),1,2)&C1$(CO)):RETURN
419 ! LECTURE
420 OPEN #1,"1.CARA",OUTPUT,VARIABLE 220
421 LOCATE (18,5):PRINT " LECTURE "
422 FOR Y=2 TO 17
423 INPUT #1,COL$(Y):NEXT Y
424 FOR Y=2 TO 17
425 INPUT #1,VA$(Y)
426 NEXT Y
427 CLOSE #1
428 LOCATE (18,5):PRINT " EXECUTION DU DESSIN "
429 ! TRANSFORMATION DESSIN
430 FOR AA=2 TO 17:FOR BB=2 TO 117 STEP 3
431 VALE=INT((BB/3)+1.33)
432 IF VALE=1 THEN 437
433 T$(AA,VALE)=SEG$(COL$(AA),BB-4,3)
434 CALL COLOR(T$(AA,VALE))
435 T1$(AA,VALE)=SEG$(VA$(AA),VALE-1,1)
436 LOCATE (AA,VALE):PRINT T1$(AA,VALE)
437 NEXT BB:NEXT AA
438 PAUSE 1:CALL LIG(SEG$(C$(BO),1,2)&C1$(CO)):RETURN
439 ! SOUS PROGRAMME
440 SUB CLIGNE(LIG,COL,TEXT$,CLR$)
441 CALL COLOR(CLR$)
442 LOCATE (LIG,COL):PRINT TEXT$
443 LOCATE (LIG+1,COL):PRINT TEXT$
444 CALL COLOR("1bY")
445 SUBEND
446 SUB EF1
447 CALL COLOR("1GB"):LOCATE (1,5):PRINT RPT$(CHR$(12),18)
448 SUBEND
449 SUB EF2
450 CALL COLOR("1GB"):LOCATE (1,25):PRINT RPT$(CHR$(12),14)
451 SUBEND
452 SUB REGLE
453 SUBEND
454 SUB LIG(A$)
455 CALL COLOR("1GB")
456 LOCATE (18,1):PRINT RPT$(CHR$(12),40)
457 CALL COLOR(A$)
458 SUBEND
459 SUB REGL
460 TR=TR+1:CALL COLOR("1bW"):LOCATE (19,1)
461 PRINT "CHOISISSEZ ---> ";:CALL COLOR("0bWL"):PRINT "1122334455667788";
462 CALL COLOR("1bW"):PRINT " <--"
463 PRINT RPT$(" ",38)
464 CALL COLOR("1RW")
465 IF TR>1 THEN SUBEXIT
466 PRINT "CARACTERES ---> ";:FOR Y=96 TO 103:PRINT CHR$(Y)&" ";:NEXT Y
467 PRINT " "
468 SUBEND
469 SUB EFFACE2
470 FOR I=19 TO 20:LOCATE (I,1):PRINT RPT$(" ",40):NEXT I
471 PRINT RPT$(" ",40)
472 SUBEND
Ce listing est uniquement proposé pour un usage privé.
Sans accord écrit préalable, vous n'êtes pas autorisé à le distribuer, le transmettre ou le rediffuser.