1 ! GENERATEUR DE CARACTERES
3 ! PAR KARL MONTAGNE
5 !
8 DIM A$(120),B$(100),C$(8,10)
9 CLS "WBB"
10 CALL COLOR("0YLH")
11 LOCATE (2,10)
12 PRINT "GGEENNEERRAATTEEUURR"
13 LOCATE (3,10)
14 PRINT "GGEENNEERRAATTEEUURR"
15 CALL COLOR("0YLH")
16 LOCATE (11,3)
17 PRINT "--DDEE CCAARRAACCTTEERREESS "
18 LOCATE (12,3)
19 PRINT "--DDEE CCAARRAACCTTEERREESS "
20 LOCATE (19,3)
21 PRINT "--PPOOUURR QQUUIITTTTEERR "
22 LOCATE (20,3)
23 PRINT "--PPOOUURR QQUUIITTTTEERR "
24 CALL COLOR("0R")
25 LOCATE (11,39):PRINT 1
26 LOCATE (20,39):PRINT 2
27 LOCATE (22,30):PRINT "VOTRE CHOIX"
28 F$=KEY$
29 S=VAL(F$):ON S GOTO 35,233
32 !
35 CLS
36 CALL COLOR("0WB")
37 PRINT "1:LE DESSINER "
38 PRINT "2:LE CODER"
39 PRINT "3:QUITTER "
40 PRINT "QUE CHOISISSEZ VOUS (1/2/3)":F$=KEY$
41 IF F$="3" THEN 10
42 IF F$="2" THEN 211
43 GOSUB 176
44 I=1:J=1
47 !
50 GOSUB 189:CALL COLOR("0WB")
51 CALL KEY1(D,E):IF E=0 THEN 51
52 GOSUB 186
53 IF D=48 THEN CALL HROFF:GOTO 10
54 IF D=32 THEN C(I,J)=1-C(I,J):GOSUB 197
55 IF D=129 THEN I=I+1:GOSUB 78:GOTO 50
56 IF D=72 THEN I=I+1:J=J+1:GOSUB 78:GOSUB 81:GOTO 50
57 IF D=131 THEN I=I-1:GOSUB 78:GOTO 50
58 IF D=79 THEN I=I+1:J=J+1:GOSUB 78:GOSUB 81:GOTO 50
59 IF D=130 THEN J=J+1:GOSUB 81:GOTO 50
60 IF D=84 THEN I=I-1:J=J-1:GOSUB 78:GOSUB 81:GOTO 50
61 IF D=128 THEN J=J-1:GOSUB 81:GOTO 50
62 IF D=60 THEN I=I-1:J=J+1:GOSUB 78:GOSUB 81:GOTO 50
63 IF D=49 THEN 89
64 IF D=50 THEN 93
65 IF D=51 THEN 100
66 IF D=52 THEN 106
67 IF D=53 THEN 128
68 IF D=54 THEN 121
69 IF D=55 THEN 135
70 IF D=56 THEN 147
71 IF D=57 THEN 163
72 GOTO 50
75 !
78 IF I>8 THEN I=1
79 IF I<1 THEN I=8
80 RETURN
81 IF J>10 THEN J=1
82 IF J<1 THEN J=10
83 RETURN
84 !
86 !
89 FOR M=1 TO 8:FOR N=1 TO 10:C(M,N)=0:NEXT N:NEXT M:GOTO 43
91 !
93 FOR J=1 TO 10:C(I,J)=0:GOSUB 197
94 GOSUB 186:NEXT J:J=1:GOTO 50
97 !
100 FOR I=1 TO 8:C(I,J)=0:GOSUB 197:GOSUB 186:NEXT I:I=1:GOTO 50
103 !
106 Y$="":X$="":FOR N=1 TO 10:W=0:FOR M=1 TO 8:Y$=STR$(C(M,N))&Y$:NEXT M
107 FOR M=1 TO 8:IF SEG$(Y$,M,1)="1" THEN W=W+2^(M-1)
108 NEXT M:Y$=""
109 V=W:W=INT(V/16):IF W=0 THEN 111
110 Y$=SEG$("0123456789ABCDEF",1+16*(V/16-W),1)&Y$:GOTO 109
111 Y$=SEG$("0123456789ABCDEF",1+16*(V/16-W),1)&Y$:IF LEN(Y$)<2 THEN Y$="0"&Y$
112 X$=X$&Y$:Y$="":NEXT N
113 LOCATE (1,1):PRINT X$:CALL CHAR(122,X$)
114 CALL COLOR("1RB"):LOCATE (15,5):PRINT "z":IF Q=1 THEN RETURN
115 CALL COLOR("0WB"):GOTO 50
118 !
121 CLS:PRINT "QUELLE COLONNE:";:F$=KEY$:W=VAL(F$)
122 FOR M=1 TO 10:C(I,M)=C(W,M):J=M:GOSUB 197:GOSUB 186:NEXT M:GOTO 50
125 !
128 CLS:PRINT "QUELLE LIGNE :";:F$=KEY$:W=VAL(F$)
129 FOR M=1 TO 8:C(M,J)=C(M,W):I=M:GOSUB 197:GOSUB 186:NEXT M:GOTO 50
132 !
135 CLS:FOR M=0 TO 121
136 CALL COLOR("1R"):PRINT CHR$(M);
137 CALL COLOR("0R"):PRINT CHR$(M);M
138 PRINT A$(M)
139 P$=KEY$:IF P$="#" THEN 50
140 IF P$="*" THEN M=M-2
141 NEXT M:GOTO 50
144 !
147 CLS:INPUT "DANS QUEL CODE VOULEZ VOUS LE LOGER ";H
148 Q=1:GOSUB 106
149 IF A$(H)<>"" THEN 155
150 A$(H)=X$:Q=0:CALL CHAR(H,X$)
151 CALL COLOR("1RB"):PRINT CHR$(H);
152 CALL COLOR("0YB"):PRINT CHR$(H);
153 CALL COLOR("0WB"):PRINT A$(H)
154 GOTO 50
155 PRINT "CE CODE EST DEJA OCCUPE ":INPUT "VOULEZ VOUS LE CHANGER (O/N)";FD$
156 IF FD$="0" THEN 150
157 GOTO 147
160 !
163 PRINT "COULEUR DU FOND :";:K$=KEY$
164 PRINT "COULEUR DU CARACTERERE:";:L$=KEY$
165 CLS
166 Q=1:GOSUB 106:Q=0
167 CALL COLOR("1"&L$&K$)
168 PRINT CHR$(122)
169 CALL COLOR("0WB")
170 GOTO 50
173 !
176 CLS:CALL HRON("B",1,13)
177 CALL COLOR("0WB")
178 FOR M=1 TO 9:CALL LINE("R",10*M+10,10,10+M*10,239):NEXT M
179 FOR N=1 TO 11:CALL LINE("R",20,N*10,100,N*10):NEXT N
180 RETURN
183 !
186 CALL LINE("B",13+I*10,5+J*10,17+I*10,5+J*10)
187 CALL LINE("B",15+I*10,3+J*10,15+I*10,7+J*10)
188 RETURN
189 CALL LINE("R",13+I*10,5+J*10,17+I*10,5+J*10)
190 CALL LINE("R",15+I*10,3+J*10,15+I*10,7+J*10)
191 RETURN
194 !
197 IF C(I,J)=0 THEN 202
198 FOR N=1 TO 9
199 CALL LINE("W",11+I*10,J*10+N,19+I*10,J*10+N)
200 NEXT N
201 GOTO 189
202 FOR N=1 TO 9
203 CALL LINE("B",11+I*10,J*10+N,19+I*10,J*10+N)
204 NEXT N
205 GOTO 189
208 !
211 CLS:INPUT "CHAINE DE CARACTERES (en hexa)";X$
212 FD$="0123456789ABCDEF"
213 IF LEN(X$)>20 THEN X$=SEG$(X$,1,20)
214 IF LEN(X$)<20 THEN X$=X$&"0":GOTO 214
215 FOR N=1 TO 19 STEP 2:Y$=SEG$(X$,N,2):Q=1
216 FOR M=1 TO 16:IF SEG$(Y$,Q,1)=SEG$(FD$,M,1)THEN W=W*16+M-1
217 NEXT M:F$=""
218 IF Q=2 THEN 220
219 Q=Q+1:GOTO 216
220 V=W:W=INT(V/2):IF W=0 THEN 223
221 IF W=V/2 THEN F$="0"&F$ ELSE F$="1"&F$
222 GOTO 220
223 IF W<>V/2 THEN F$="1"&F$
224 IF LEN(F$)<8 THEN F$="0"&F$:GOTO 224
225 FOR M=1 TO 8:C(M,(N+1)/2)=VAL(SEG$(F$,M,1)):NEXT M:NEXT N
226 GOSUB 176
227 FOR W=1 TO 10:FOR M=1 TO 8:J=W:I=M:GOSUB 197:GOSUB 186:NEXT M:NEXT W
229 PRINT "VOICI LE DESSIN,VOUS POUVEZ UTILISER LES COMMANDES"
230 GOTO 50
232 !
233 END
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.