RetroBasicCode/ADREPLUS.BAS at master · yoann-darche/RetroBasicCode · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
10 DEFINT A-B,D-Z:X=1:Y=1:MY=1:MX=9:CLS:KEY OFF:NFICH$="essai.adr":GOSUB 1330
20 DIM N$(1000),P$(1000),D$(1000),C(1000),V$(1000),T$(1000),R(100):COLOR 7,0
30 B$="º       ENREGISTRER   MODIFIER    EFFACER   RECHERCHER    QUITTER   "
40 GOSUB 1110
50 CLS:GOSUB 180:GOSUB 1220:LOCATE 2,1:PRINT B$:J=0:GOSUB 1240
60 LOCATE 2,70:PRINT NF:DX=9+12*(X-1):COLOR 7,0:LOCATE 2,MX:IF Y>NF THEN Y=1
70 PRINT MID$(B$,MX,11);:COLOR 0,7:LOCATE 2,DX:PRINT MID$(B$,DX,11);:MX=DX
80 COLOR 7,0:NE=NF:J=0:T$=INPUT$(1):IF T$=CHR$(27) THEN 1090
90 IF T$="6" AND X<5 THEN X=X+1:GOTO 60
100 IF T$="4" AND X>1 THEN X=X-1:GOTO 60
110 IF T$=CHR$(13) THEN ON X GOTO 220,360,540,630,1090
120 IF T$="2" AND (Y<NF AND Y<20) THEN Y=Y+1:GOSUB 1240
130 IF T$="8" AND Y>1  THEN Y=Y-1:GOSUB 1240
140 IF T$="9" AND P>0 THEN P=P-1:Y=1:MY=1:GOSUB 1320:GOSUB 1220:GOSUB 1240
150 IF T$="3" AND P<NP THEN P=P+1:Y=1:MY=1:GOSUB 1320:GOSUB 1220:GOSUB 1240
160 IF T$=" " THEN I=Y+20*PA:GOSUB 1020:A$=INPUT$(1):GOTO 50
170 GOTO 80
180 DEF SEG=&HB800:POKE 0,201:FOR K=2 TO 156 STEP 2:POKE K,205:POKE K+320,205
190 POKE K+3680,205:NEXT K:POKE 158,187:POKE 160,186:POKE 318,186:POKE 320,204
200 POKE 478,185:POKE 3680,200:POKE 3838,188:FOR K=480 TO 3520 STEP 160
210 POKE K,186:POKE K+158,186:NEXT:RETURN
220 CLS:GOSUB 180:LOCATE 2,34:PRINT "ENREGISTREMENT"
230 LOCATE  5,10:INPUT "Nom       :",M$:GOSUB 1160:N$(NF+1)=M$
240 IF M$="" THEN LOCATE 21,10:PRINT "D‚sirez-vous r‚enregistrer ?":GOTO 340
250 LOCATE  7,10:INPUT "Pr‚non    :",M$:GOSUB 1160:P$(NF+1)=M$
260 LOCATE  9,10:INPUT "Adresse   :",D$(NF+1)
270 LOCATE 11,10:INPUT "Code Post :",C(NF+1)
280 LOCATE 13,10:INPUT "Ville     :",M$:GOSUB 1160:V$(NF+1)=M$
290 LOCATE 15,10:INPUT "T‚l‚phonne:",T$(NF+1)
300 LOCATE 19,10:PRINT "<ESC> pour abandon <O> confirmer <N> recommencer"
310 A$=INPUT$(1):IF A$="n" OR A$="N" THEN 220
320 IF A$=CHR$(27) THEN IF NE<>NF THEN GOTO 350 ELSE 50
330 LOCATE 21,10:PRINT " D‚sirez-vous encore enregistrer une fiche ? ":NF=NF+1
340 A$=INPUT$(1):IF A$="n" OR A$="N" OR A$=CHR$(27) THEN 350 ELSE 220
350 LOCATE 2,23:PRINT "Patientez !  ":GOSUB 1280:GOSUB 1140:GOTO 50
360 CLS:GOSUB 180:LOCATE 2,34:PRINT "MODIFICATIONS":IK=Y+P*20
370 LOCATE 5,10:PRINT "Pour ne pas changer appuyez sur ENTRE "
380 LOCATE  7,3:PRINT "Nom        [";N$(IK);:INPUT "] :",M$
390 IF M$="" THEN NE$=N$(IK) ELSE GOSUB 1160:NE$=M$
400 LOCATE  9,3:PRINT "Pr‚nom     [";P$(IK);:INPUT "] :",M$
410 IF M$="" THEN PE$=P$(IK) ELSE GOSUB 1160:PE$=M$
420 LOCATE 11,3:PRINT "Adresse    [";D$(IK);:INPUT "] :",M$
430 IF M$="" THEN DE$=D$(IK) ELSE DE$=M$
440 LOCATE 13,3:PRINT "Code Post  [";C(IK);:INPUT "] :",M$
450 IF M$="" THEN C=C(IK) ELSE C=VAL(M$)
460 LOCATE 15,3:PRINT "Ville      [";V$(IK);:INPUT "] :",M$
470 IF M$="" THEN VE$=V$(IK) ELSE GOSUB 1160:VE$=M$
480 LOCATE 17,3:PRINT "T‚l‚phonne [";T$(IK);:INPUT "] :",M$
490 IF M$="" THEN TE$=T$(IK) ELSE TE$=M$
500 LOCATE 19,20:PRINT "Confirmer :O/N":A$=INPUT$(1):IF A$=CHR$(27) THEN 50
510 IF A$="n" OR A$="N" THEN 360 ELSE IF A$<>"o" AND A$<>"O" THEN GOTO 500
520 N$(IK)=NE$:P$(IK)=PE$:D$(IK)=DE$:C(IK)=C:V$(IK)=VE$:T$(IK)=TE$:GOSUB 1280
530 GOSUB 1140:GOTO 50
540 CLS:GOSUB 180:LOCATE 2,36:PRINT "EFFACER"
550 LOCATE 5,5:COLOR 14:PRINT "Etes vous certain de vouloir ";:COLOR 30
560 PRINT "EFFACER";:COLOR 14:PRINT " ce qui suit ?":COLOR 7
570 LOCATE 8,20:I=Y+PA*20:PRINT N$(I);" ";P$(I)
580 LOCATE 9,15:PRINT D$(I):LOCATE 10,20:PRINT C(I);V$(I):LOCATE 11,20
590 PRINT T$(I):A$=INPUT$(1):IF A$="n" OR A$="N" OR A$=CHR$(27) THEN 50
600 IF A$<>"o" AND A$<>"O" THEN BEEP:LOCATE 14,25:PRINT "Oui/Non":GOTO 580
610 FOR I=Y+20*P TO NF:N$(I)=N$(I+1):P$(I)=P$(I+1):D$(I)=D$(I+1):C(I)=C(I+1)
620 V$(I)=V$(I+1):T$(I)=T$(I+1):NEXT I:NF=NF-1:GOSUB 1140:GOTO 50
630 CLS:GOSUB 180:LOCATE 2,36:PRINT "RECHERCHE":I=0
640 LOCATE 5,20:COLOR 3:PRINT "Vous repondez uniquement ce que vous savez !"
650 LOCATE 6,10:COLOR 4:PRINT "La recherche s'effectue par filtre d‚finie ";
660 PRINT "par vos r‚ponses .":TD=0
670 COLOR 30:LOCATE 25,1:PRINT "N.B si le code postal comporte que";
680 PRINT " 2 chiffres la recherche portera sur le dep";:COLOR 7
690 LOCATE 8,10:INPUT "Nom         :",M$:GOSUB 1160:NE$=M$
700 LOCATE 9,10:INPUT "Pr‚nom      :",M$:GOSUB 1160:PE$=M$
710 LOCATE 10,10:INPUT "Code Postal :",C$:C=VAL(C$)
720 LOCATE 11,10:INPUT "Ville       :",M$:GOSUB 1160:VE$=M$
730 LOCATE 12,10:INPUT "T‚l‚phonne  :",TE$
740 IF C=0 AND C$<>"" THEN LOCATE 13,1:PRINT "Code postal annul‚":C$=""
750 IF C<100 THEN LOCATE 14,2:PRINT "Recherche sur tout le d‚partement":TD=1
760 R=0:FOR I=1 TO NF
770 IF NE$<>"" THEN IF NE$<>N$(I) THEN 840
780 IF PE$<>"" THEN IF PE$<>P$(I) THEN 840
790 IF VE$<>"" THEN IF VE$<>V$(I) THEN 840
800 IF C$<>"" AND TD=0 THEN IF C<>C(I) THEN 840
810 IF C$<>"" AND TD=1 THEN IF C<>INT(C(I)/1000) THEN 840
820 IF TE$<>"" THEN IF TE$<>T$(I) THEN 840
830 R=R+1:R(R)=I
840 NEXT I
850 CLS:GOSUB 180:LOCATE 2,36:PRINT "RESULTATS"
860 IF R<>0 THEN 890
870 LOCATE 12,5:PRINT " Aucune fiche ne correspond … vos critŠres ..."
880 A$=INPUT$(1):GOTO 50
890 LOCATE 25,1:PRINT " Il y a ";R;" r‚ponses ";
900 LOCATE 4,1:PA=0:Y=1:MY=1
910 NPA=INT(R/20)+1*SGN(R MOD 20)-1:IF PA>NPA THEN PA=0
920 FOR F=1+20*PA TO 20+20*PA:I=R(F):J=F-20*PA:GOSUB 1250:IF F<=R THEN NEXT
930 GOTO 1000
940 T$=INPUT$(1):COLOR 7,0:IF T$=CHR$(27) THEN 50
950 IF T$="2" AND (Y<R AND Y<20) THEN Y=Y+1
960 IF T$="8" AND Y>1 THEN Y=Y-1
970 IF T$="9" AND PA>0 THEN PA=PA-1:Y=1:GOSUB 1320:GOTO 920
980 IF T$="3" AND PA<NP THEN PA=PA+1:Y=1:GOSUB 1320:GOTO 920
990 IF T$=CHR$(13) OR T$=" " THEN I=R(Y+PA*20):GOSUB 1020:GOTO 1070
1000 I=R(MY+PA*20):J=MY:COLOR 7,0:GOSUB 1250:COLOR 0,7:I=R(Y+PA*20):J=Y
1010 GOSUB 1250:MY=Y:GOTO 940
1020 COLOR 7,0:CLS:GOSUB 180:LOCATE 2,35:PRINT "Adresse : "
1030 L=LEN(N$(I)+P$(I))+1:LOCATE 7,INT((80-L)/2):PRINT N$(I)+" "+P$(I)
1040 L=LEN(D$(I))     :LOCATE 9,INT((80-L)/2):PRINT D$(I)
1050 L=LEN(STR$(C(I))+V$(I))+1:LOCATE 11,INT((80-L)/2):PRINT C(I);" ";V$(I)
1060 L=LEN(T$(I))+5:LOCATE 13,INT((80-L)/2):PRINT "Tel :";T$(I):RETURN
1070 LOCATE 16,20:PRINT " <ESC> pour menu principal ou autre pour retour"
1080 A$=INPUT$(1):IF A$=CHR$(27) THEN 50 ELSE 850
1090 COLOR 7,0:CLS:PRINT "Vous avez l'agr‚able bonjour de ";NCO$;" et il vous ":PRINT "f‚licite d'avoir choisi son logigiel ADRESSE + Ver 1.2 Programme nø U1 ."
1095 PRINT " Ce logiciel est entiŠrement gratuit et appartient au DOMAINE PUBLIQUE":PRINT" Si il vous a plus ne vous gˆner pas pour en donner une copie … vos ami(e)(s)" :PRINT
1096 PRINT:PRINT "Programme ‚crit en GWBASIC par :"
1097 PRINT NCO$;" : 71 avenue d' Orl‚ans 91800 BRUNOY tel:69-39-51-26 ":PRINT
1098 PRINT "                                   Salut .... Y.D."
1100 END
1110 OPEN "I",#1,NFICH$:NF=0
1120 IF EOF(1) THEN CLOSE:RETURN ELSE NF=NF+1
1130 INPUT #1,N$(NF),P$(NF),D$(NF),C$,V$(NF),T$(NF):C(NF)=VAL(C$):GOTO 1120
1140 OPEN "O",#1,NFICH$:FOR I=1 TO NF
1150 WRITE #1,N$(I),P$(I),D$(I),STR$(C(I)),V$(I),T$(I):NEXT I:CLOSE:RETURN
1160 IF M$="" THEN RETURN ELSE FOR I=1 TO LEN(M$):L$=MID$(M$,I,1):L=ASC(L$)
1170 IF L<65 OR (L>90 AND L<97) OR L>122 THEN 1200 ELSE IF L>90 THEN L=L-32
1180 N$=N$+CHR$(L)
1190 NEXT:M$=N$:N$="":RETURN
1200 L$=MID$("Û' UUUUUEEEEEAAAAOOOY-/C",INSTR("' –—š£‚Šˆ‰ƒ„…Ž“”™˜-/‡",L$)+1,1)
1210 IF L$="Û" THEN 1190 ELSE L=ASC(L$):GOTO 1180
1220 NP=INT(NF/20)+1*SGN(NF MOD 20)-1:J=0:IF P>NP THEN P=0
1230 FOR I=1+20*P TO 20+20*P:GOSUB 1250:IF I=>NF THEN RETURN ELSE NEXT:RETURN
1240 J=MY:I=MY+P*20:GOSUB 1250:COLOR 0,7:I=Y+P*20:J=Y:GOSUB 1250:MY=Y:RETURN
1250 IF J=0 THEN J=I-20*P
1260 LOCATE J+3,2:PRINT N$(I):LOCATE J+3,15:PRINT P$(I);
1270 LOCATE J+3,28:PRINT T$(I);:LOCATE J+3,44:PRINT V$(I):J=0:RETURN
1280 FOR I=1 TO NF:FOR J=I TO NF:IF N$(I)>N$(J) THEN 1300
1290 NEXT J:LOCATE 2,42:PRINT I+1;"/";NF:NEXT I:RETURN
1300 SWAP N$(I),N$(J):SWAP P$(I),P$(J):SWAP D$(I),D$(J):SWAP C(I),C(J)
1310 SWAP V$(I),V$(J):SWAP T$(I),T$(J):GOTO 1290
1320 FOR KL=4 TO 23:LOCATE KL,2:PRINT SPACE$(78);:NEXT KL:LOCATE 1,1:RETURN
1330 CLS:NCO$=CHR$(68)+CHR$(65)+CHR$(82)+CHR$(67)+CHR$(72)+CHR$(69)+CHR$(32)+CHR$(89)+CHR$(111)+CHR$(97)+CHR$(110)+CHR$(110)
1340 LOCATE 1,28:COLOR 14:PRINT NCO$;" pr‚sente :":LOCATE 7
1350 PRINT "    ±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±"
1360 PRINT "    ±±ÛÛÛ±±±ÛÛÛ±±±±ÛÛÛÛ±±±ÛÛÛÛÛ±±±ÛÛÛ±±±±ÛÛÛ±±±ÛÛÛÛÛ±±±±±±±±±±±±±²²"
1370 PRINT "    ±Û±°°Û±±Û°°Û±±±Û°°°Û±±Û°°°°°±Û±°°Û±±Û±°°Û±±Û°°°°°±±±±±±±±Û±±±²²"
1380 PRINT "    ±Û°±±Û°±Û°±±Û±±Û°±±Û°±Û°±±±±±Û°±±±°±Û°±±±°±Û°±±±±±±±±±±±±Û°±±²²"
1390 PRINT "    ±ÛÛÛÛÛ°±Û°±±Û°±ÛÛÛÛ±°±ÛÛÛÛ±±±±ÛÛÛ±±±±ÛÛÛ±±±ÛÛÛÛ±±±±±±±±ÛÛÛÛÛ±²²"
1400 PRINT "    ±Û°°°Û°±Û°±±Û°±Û°Û°°±±Û°°°°±±±±°°Û±±±±°°Û±±Û°°°°±±±±±±±±°Û°°°²²"
1410 PRINT "    ±Û°±±Û°±Û°±Û±°±Û°±Û±±±Û°±±±±±Û±±±Û°±Û±±±Û°±Û°±±±±±±±±±±±±Û°±±²²"
1420 PRINT "    ±Û°±±Û°±ÛÛÛ±°±±Û°±±Û±±ÛÛÛÛÛ±±±ÛÛÛ±°±±ÛÛÛ±°±ÛÛÛÛÛ±±±±±±±±±±°±±²²"
1430 PRINT "    ±±°±±±°±±°°°±±±±°±±±°±±°°°°°±±±°°°±±±±°°°±±±°°°°°±±±±±±±±±±±±²²"
1440 PRINT "      ²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²"
1450 PRINT:PRINT "                             Version 1.2 "
1460 LOCATE 20,4:PRINT " Mr ";NCO$;" 71 av. d'Orl‚ans 91800 BRUNOY   tel: 69-39-51-26 aprŠs 19H"
1470 A$=INPUT$(1):RETURN