DataBase Archivio – Amstrad CPC – Locomotive Basic

Anno: 2020 – Linguaggio: Amstrad CPC – Locomotive Basic – Recupero di: Cristian Puddu

Ci scrive un nostro lettore, Cristian Puddu:
Nel 1986 insieme al cpc 464, versione Schneider acquistato dai miei genitori, ricevetti in una scatola un corso del CNR su cassette dedicato al BASIC , il gioco Punchy ed una cassetta dal nome “Database Archivio” all’interno del quale vi è sostanzialmente un programma “Database Archivio Listato” in Basic, di cui è disponibile il listato, che consente di creare un database ed effettuare ricerche su esso, salvando e leggendo i dati memorizzati degli array su cassette...

Cristian e’ riuscito a recuperare ed a farci pervenire il listato del programma Database Archivio scritto da Petruzzi Francesco negli anni ’80 e noi ovviamente non abbiamo perso tempo per pubblicarlo nella rubrica RetroLiPS.

Il listato è molto lineare ed interessante da studiare per imparare a gestire un semplice database in Basic con l’Amstrad CPC, poiché permette di comprendere in modo pratico la struttura dei dati, le operazioni di inserimento e ricerca delle informazioni e l’organizzazione logica del programma.

Ringraziamo Cristian per aver recuperato questo listato italiano inedito e invitiamo chiunque possieda materiali simili a condividerli con noi, così da renderli accessibili a tutti.

Titolo: DataBase Archivio
Piattaforma: Amstrad CPC
Linguaggio: Locomotive Basic
Versione originale: Petruzzi Francesco
Pubblicazione: N/A
Anno: TBD
Recupero: Cristian Puddu
Anno: 2026
Note: N/A

Istruzioni
Seguite le indicazioni del menu’ autoesplicativo.
Ah, il tasto (freccia su’) e’ mappato sul secondo tasto dopo lo zero (nella mia tastiera e’ il tasto =).

Qui di seguito trovate il codice del gioco e del loader da copiare sul vostro Amstrad CPC.
Attenzione – Ci siamo resi conto che nel listato i caratteri ‘>’ e ‘<‘ potrebbero venir sostituiti dai rispettivi encoding html ‘&gt’ e ‘&lt’. Nel caso, sostituite questi valori direttamente su CBM prg Studio.

Listato: DataBase Archivio – Amstrad CPC – Locomotive Basic


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
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
10 MODE 2:PRINT"OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO "            
15 LOCATE 1,2:PRINT"DATA BASE-DATA BASE-DATA BASE-DATA BASE-DATA BASE-DATA BASE-DATA BASE -DATA BASEOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO"          
20 PLOT 1,1:DRAWR 638,0:DRAWR 0,398:DRAWR -638,0:DRAWR 0,-398    
30 PLOT 1,50:DRAWR 638,0:PLOT 1,100:DRAWR 638,0:PLOT 1,150:DRAWR 638,0:PLOT 1,200:DRAWR 638,0:PLOT 1,250:DRAWR 638,0:PLOT 1,300:DRAWR 638,0:PLOT 1,350:DRAWR 638,0
40 PLOT 50,1:DRAWR 0,398:PLOT 100,1:DRAWR 0,398:PLOT 150,1:DRAWR 0,398:PLOT 200,1:DRAWR 0,398:PLOT 250,1:DRAWR 0,398:PLOT 300,1:DRAWR 0,398:PLOT 350,1:DRAWR 0,398 :PLOT 400,1:DRAWR 0,398:PLOT 450,1:DRAWR 0,398:PLOT 500,1:DRAWR 0,398
50 PLOT 550,1:DRAWR 0,398:PLOT 600,1:DRAWR 0,398
55 PRINT" "
60 PRINT"      _____________           ______      __________________     ______"
70 PRINT"     L            LM         L     LM    L                 LS   L     LM "  
80 PRINT"                  W M       V      WLS                     L   V      WLS "            
90 PRINT "        O         UWLS       O       S              S           O       S"  
100 PRINT"        O            S       OOOOOO  S              S           OOOOOO  S"
110 PRINT    "        O            S               S              S                   S"    
120 PRINT    "    ___ O            S       O       S              S           O       S"
130 PRINT    "   L    OOOOOOOOOOO L        O       S              S           O       S"  
140 PRINT    "   U               T         O      L              L            O      L "  
180 PRINT TAB (12)"       ___________  "        
190 PRINT TAB (12)"      L          LM       "
200 PRINT TAB (12)"                 W M       __     _______    _______   "
210 PRINT TAB (12)"       O         UWLS     L LM   L      LS  L      LS  "
220 PRINT TAB (12)"       OOOOOOOOOOO L     V  WLS         L          L "
230 PRINT TAB (12)"                  TM      O   S   O    LS    O   LS  "
240 PRINT TAB (12)"   ___ O         UWLS         S _       S        L__ "
250 PRINT TAB (12)"  L    OOOOOOOOOOO L      O   SL       L     O     LS  "
260 PRINT TAB (12)"                  T       O  L        T            L  "
270 LOCATE 60,25:PRINT"by Petruzzi Francesco";
500 FOR k=1 TO 3000 :NEXT : PRINT" "
510 BORDER 0:DIM a$(300), ca$(10), dd(10), AB$ (10),a(10)  
520 GOTO 1060
530 REM **lettura file ***
540 BORDER 0: PRINT" ": CLS: PRINT "......................................."
550 PRINT
560 PRINT "            LETTURA FILE               "
570 PRINT
580 PRINT "......................................."
590 PRINT:PRINT:PRINT: PRINT "        - C - Per continuare"
600 PRINT: PRINT "        - T - Richiamo Menu'"        
610 a$ = INKEY$: IF a$ =""THEN GOTO 610
620 IF a$="c" OR a$="C" THEN GOTO 650
630 IF a$="t" OR a$="T" THEN GOTO 1060  
640 GOTO 610
650 CLS : PRINT "......................................."
660 PRINT
670 PRINT "             LETTURA FILE          "
680 PRINT
690 PRINT "......................................."
700 PRINT TAB(10) "................."
710 PRINT TAB(10) "                 "
720 PRINT TAB(10) "Inserire il nome "
730 PRINT TAB(10) "                 "
740 PRINT TAB(10) "    del file     "
750 PRINT TAB(10) "                 "
760 PRINT TAB(10) "................."
770 LOCATE 4,20 : INPUT " ";f$ : PRINT
780 f$ = LEFT$(f$,15)
790 OPENIN f$
800 INPUT  #9,ca: FOR m = 1 TO ca : INPUT #9,ca$(m): INPUT #9,dd(m): NEXT m  
810 INPUT #9, y: FOR i = 1 TO y: INPUT #9,a$(i): NEXT i: CLOSEIN: GOTO 1060
820 BORDER 0: PRINT" ": CLS: REM ** registra file****  
830 LOCATE 11,4: PRINT "REGISTRAZIONE FILE"
840 LOCATE 2,12: PRINT "- C - PER CONTINUARE "  
850 LOCATE 2,14: PRINT "- T - RICHIAMO MENU' "  
860 A$ = INKEY$: IF A$ = "" THEN 860
870 IF A$ = "c" OR a$ = "C" THEN 900
880 IF a$ = "t" OR a$ = "T" THEN 1060
890 GOTO 860
900 CLS
910 LOCATE 3,6: PRINT "Scegli :"
920 LOCATE 12,4: PRINT "REGISTRAZIONE FILE"  
930 LOCATE 3,13: PRINT " - 1 - Registrazione a 2000 baud"
940 LOCATE 3,15: PRINT " - 0 - Registrazione a 1000 baud"
950 LOCATE 27,19: INPUT "N."; pl  
960 IF pl > 1 GOTO 950
970 GOSUB 4230
980 PRINT "          Inserire il nome  "
990 PRINT
1000 PRINT "              del file      "
1010 PRINT TAB(13);: INPUT f$  
1020 f$ = LEFT$(f$,15)
1030 OPENOUT f$
1040 PRINT #9, ca: FOR m = 1 TO ca: PRINT #9,ca$(m): PRINT  #9,dd(m): NEXT m
1050 PRINT  #9,y: FOR i = 1 TO y: PRINT  #9,a$(i): NEXT i : CLOSEOUT: GOTO 1060
1060 BORDER 6: CLS: MODE 1:  ORIGIN 0,0
1070  PLOT 0,0: DRAW 0,399: DRAW  639,399: DRAW 639,0: DRAW 0,0
1080 PLOT 0,360: DRAW 639,360
1090 PLOT 0,45  : DRAW 639,45: PLOT 0,40: DRAW 639,40
1100 LOCATE 15,2 : PRINT  "*  M E N U ' *"
1110 PRINT
1120 LOCATE 6,4: PRINT "- 1 -   Leggo            File"  
1130 PRINT
1140 LOCATE 6,6 : PRINT "- 2 -   Registro         File"
1150 PRINT
1160 LOCATE 6,8: PRINT "- 3 -   Creo         Archivio"
1170 PRINT
1180 LOCATE 6,10: PRINT "- 4 -   Continuo     Archivio"
1190 PRINT
1200 LOCATE 6,12: PRINT "- 5 -   Video          Record"
1210 PRINT
1220 LOCATE 6,14:PRINT "- 6 -   Sort           Record "
1230 PRINT
1240 LOCATE 6,16:PRINT "- 7 -   Ricerca        Record"
1250 PRINT
1260 LOCATE 6,18:PRINT "- 8 -   Stampa         Record"
1270 PRINT
1280 LOCATE 6,20:PRINT "- 9 -   Memoria        Libera"
1290 PRINT
1300 LOCATE 6,22:PRINT "- E -   END ":PRINT
1310 LOCATE 6,24:PRINT "CAMPI = "ca;: LOCATE 21,24:PRINT "RECORD ="y
1320 PLOT 0,0: DRAW 0,399
1330 e$ = INKEY$: IF e$ = "" THEN 1330
1340 IF e$ = "1" THEN 530
1350 IF e$ = "2"  THEN 820
1360 IF e$ = "3" THEN 1540
1370 IF e$ = "4" THEN 1960
1380 IF e$ = "5" THEN 3910
1390 IF e$ = "6" THEN 3470
1400 IF e$ = "7" THEN 2900
1410 IF e$ = "8" THEN 2590
1420 IF e$ = "9" THEN 2420
1430 IF e$ = "e" OR e$ = "E" THEN 1450
1440 GOTO 1330
1450 CLS: LOCATE 11,12
1460 PRINT "* FINE DEL PROGRAMMA * "
1470 PRINT" "
1520 END
1530 GOTO 1330
1540 REM ====== Creo Archivio =====
1550 BORDER 0: ca = 0: y = 0: CLS
1560 PLOT 192,360: DRAW 192,392: DRAW 432,392: DRAW 432,360: DRAW 192,360
1570 LOCATE 14,2: PRINT "CREO ARCHIVIO"
1580 PRINT :PRINT :PRINT :PRINT: PRINT "Definisci il numero ed il nome dei campi": PRINT "   [massimo 9 campi da 10 caratteri]": PRINT : PRINT " Poi definisci la lunghezza del campo."      
1590 PRINT : PRINT " La lunghezza di un RECORD puo' essere": PRINT "  di 88 caratteri in totale, esclusi": PRINT "  i nomi dei campi."
1600 LOCATE 22,21: PRINT "Premi un tasto"
1610 LOCATE 22,22
1620 FOR h = 1 TO 14 : PRINT CHR$(140);: NEXT h
1630 u$ = INKEY$: IF u$ = "" THEN 1630
1640 CLS
1650 PLOT 192,360: DRAW 192,392: DRAW 432,392: DRAW 432,360: DRAW 192,360
1660 LOCATE 14,2: PRINT "CREO ARCHIVIO"
1670 LOCATE 3,8: PRINT " Definisci il numero dei campi [   ]"
1680 r$ = INKEY$: IF r$ = "" THEN 1680
1690 IF r$ = "0" THEN 1060
1700 ca = VAL(r$)
1710 LOCATE 35,8: PRINT ca: LOCATE 2,12:PRINT "Nome del campo           Lunghezza"  
1720 ah = 0: FOR k = 1 TO ca  
1730 LOCATE 5,15: PRINT "..........": LOCATE 30,15: PRINT "..."  
1740 LOCATE 2,2: PRINT k;: LOCATE 2,14: INPUT " "; ca$(k): IF LEN (ca$(k)) > 10 THEN PRINT : GOTO 1740    
1750 LOCATE 28,14: INPUT dd(k): IF dd (k) > 25 THEN 1750  
1760 LOCATE 2,14: PRINT "                                   "
1770 ah = ah + (dd(k)): IF ah > 88 THEN 1750
1780 NEXT
1790 bh = (88 - ah): LOCATE 10,18: PRINT bh; " caratteri liberi"  
1800 LOCATE 11,20: PRINT "~~~~~~~~~~~~~~~~~~~~"  
1810 LOCATE 25,22 : PRINT "Vuoi correggere ? "
1820 ap$ = INKEY$: IF ap$ = "" THEN 1820
1830 IF ap$ = "s" OR ap$ = "S" THEN 1860
1840 IF ap$ = "n" OR ap$ = "N" THEN 1960
1850 GOTO 1820
1860 LOCATE 1,23: INPUT "N. campo da correggere : ";nc: IF nc > (ca+1) THEN 1860
1870 PRINT
1880 INPUT "Nome del campo corretto "; ca$(nc): PRINT : INPUT "Lunghezza "; dd(nc)                
1890 CLS: PRINT : PRINT " N.    NOMI DEI CAMPI";: PRINT "     LUNGHEZZA": PRINT : IF nc > ca THEN ca = nc
1900 PLOT 0,360: DRAW 639,360
1910 ah =0: FOR k = 1 TO ca: PRINT " "k;: PRINT "......."ca$(k);
1920 LOCATE 25,3+k: PRINT dd(k): ah= ah+dd(k): NEXT
1930 bh = (88-ah): LOCATE 11,19: PRINT bh " Caratteri liberi"    
1940 LOCATE 1,25: PRINT "Vuoi correggere ?"
1950 GOTO 1820
1960 IF ca < 1 GOTO 1330
1970 CLS
1980 LOCATE 13,2 : PRINT "CONTINUO ARCHIVIO "
1990 PLOT 176,352: DRAW 176,399: DRAW 480,399: DRAW 480,352: DRAW 176,352
2000 y = y + 1: i = y
2010 PRINT: PRINT:  PRINT "    Per tornare al Menu' digita {^}"
2020 PRINT: PRINT TAB(17)"~~~~~~~~"
2030 LOCATE 10,9: PRINT "Record numero [ "I;" ]"  
2040 a$(i) = "": FOR k = 1 TO ca
2050 LOCATE 2,17
2060 PRINT ca$(k);: PRINT "            ";:REM FOR  = 1 TO dd(k): PRINT "-";: NEXT e
2070 FOR u = 1 TO dd(k)+6:PRINT " ";: NEXT u
2080 LOCATE 13,17
2090 INPUT ab$(k)
2100 IF LEN (ab$(k)) > dd(k) THEN 2050
2110 ab$(k) = LEFT$(ab$(k)+SPACE$( 15),dd(k))
2120 a$(i) = a$(i)+ab$(k)
2130 IF LEFT$ (ab$(k),1) = "^" THEN y = y-1: GOTO 1060
2140 NEXT k: IF cc = 99 THEN 3850    
2150 GOTO 1970
2160 PRINT "I=Inser. D=Del.  C=Corr.  M=Menu V=Vedi"
2170  a$ = INKEY$: IF a$ = "" THEN 2170
2180 IF a$ = "i" OR a$ = "I" THEN 3740
2190 IF a$ = "d" OR a$ = "D" THEN 3860
2200 IF a$ = "c" OR a$ = "C" THEN 2510
2210 IF a$ = "m" OR a$ = "M" THEN  1060
2220 IF a$ = "v" OR a$ = "V" THEN 2240
2230 GOTO 2170
2240 g = 0: CLS: GOTO 2340
2250 REM
2260 CLS: PRINT"                ELENCO"
2270 PRINT : PRINT "QUANTI DATI VIDEO ?"
2280 gg$ = INKEY$: IF gg$ = "" THEN 2280
2290 gg = VAL (gg$)
2300 g = 0: FOR i = 1 TO y: s =1: PRINT "RECORD N."i": ?"
2310 FOR m = 1 TO ca : ab$(m) = MID$(a$(i),s,dd(m)): s = s + dd(m)
2320 PRINT ca$(m): PRINT "             " ab$(m)
2330 NEXT m: g = g+1: IF g = gg THEN 2160
2340 PRINT : NEXT i
2350 PRINT: PRINT "I=Inser.  C=Correggi  D=Delete  M=Menu                  "
2360 a$ = INKEY$: IF a$ = "" THEN 2360
2370 IF a$ = "i" OR a$ = "I" THEN 3740
2380 IF a$ = "c" OR a$ = "C" THEN 2510
2390 IF a$ = "d" OR a$ = "D" THEN 3860
2400 IF a$ = "m" OR a$ = "M" THEN  1060
2410 GOTO 2360
2420 REM  ========   MEMORIA  ======
2430 CLS: LOCATE 8,5
2440 PRINT "** MEMORIA DISPONIBILE **"
2450 LOCATE 11,14  
2460 PRINT  FRE ("");: PRINT " :Byte free "
2470 LOCATE 11,15 : PRINT "=================="    
2480 LOCATE 21,23: PRINT "PREMI UN TASTO"
2490 a$ = INKEY$: IF a$ = "" THEN 2490
2500 GOTO 1060
2510 i = 0 : INPUT " Numero da correggere (0 per uscire):";i
2520 IF i > y THEN 2510
2530 IF i = 0 THEN 1060
2540 CLS: PRINT: PRINT: PRINT i: a$(i) = "": FOR m = 1 TO ca
2550 PRINT:PRINT ca$(m);: PRINT "   ";: FOR e = 1 TO dd(m): PRINT "-";: NEXT e
2560 FOR u = 1 TO dd(m)+2: PRINT "";: NEXT u : INPUT ab$(m)
2563 sss=LEN(ab$(m))
2565 ab$(m)=ab$(m)+SPACE$(dd(m)-sss)
2570 a$(i) = a$(i) + ab$(m)
2580 NEXT m: GOTO 2500
2590 REM ====== STAMPA  DATI =======
2600 ll =0
2610 GOSUB 3330
2620 CLS
2630 PRINT
2640 PRINT
2650 PRINT "         Vuoi la stampa automatica ? "
2660 PRINT
2670 PRINT "              Digita < S/N >"
2680 kk$ = INKEY$: IF kk$ = "" THEN 2680
2690 IF kk$ = "s" OR kk$ = "S" THEN 2720
2700 IF kk$ = "n" OR kk$ = "N" THEN da = 100: GOTO 2720  
2710 GOTO 2680
2720 PRINT "      Sto stampando i dati "
2730 IF da > 78 THEN ll =1
2740 IF db > 78 THEN ll =1
2750 IF ll = 0 THEN GOSUB 3370: GOTO 2760
2760 FOR i = 1 TO y: s = 1
2770 IF ll = 1 THEN PRINT #8: GOSUB 2810: GOTO 2790
2780 GOSUB 3280
2790 NEXT i : GOTO 1060
2800 REM
2810 s = 1
2820 PRINT #8, "  DATO N."i
2830 FOR m = 1 TO ca: ab$(m) = MID$(a$(i),s,dd(m)): s = s+dd(m)
2840 PRINT #8, ca$(m);
2850 hh = 10 - LEN (ca$(m))
2860 FOR p = 1 TO hh: PRINT #8, " ";: NEXT p
2870 PRINT #8, " :";
2880 PRINT #8, ab$(m)
2890 NEXT m: PRINT #8,"": PRINT #8,"": RETURN
2900 REM ======RICERCA DATI =======
2910 BORDER 0:  GOSUB 4170
2920 PRINT "  La ricerca dei dati puo' essere fatta": PRINT "su ogni campo."
2930 PRINT "Basta un carattere per elencare tutti": PRINT "i dati che iniziano con quel carattere."
2940 PRINT " Piu' caratteri rendono la ricerca piu'": PRINT "selettiva."
2950 PRINT : PRINT : PRINT "             Premi un tasto"
2960 a$ = INKEY$: IF a$ = "" THEN 2960
2970 GOSUB 4170
2980 jj = 0 : PRINT "Per stampare i dati trovati premi [S]";: PRINT " altrimenti premi un tasto qualsiasi."
2990 j$ = INKEY$: IF j$ = "" THEN 2990
3000 IF j$ = "s" OR i$ = "S" THEN 3260
3010 PRINT : INPUT " Dati per la ricerca :";aw$: aw = LEN (aw$)
3020 GOSUB 4170
3030 sr = 0: FOR i = 1 TO y: s = 1: FOR m = 1 TO ca
3040 IF aw$ = MID$ (a$(i),s,dd(m)) THEN 3120
3050 IF aw$ = LEFT$(MID$(a$(i),s,dd(m)),aw) THEN 3120  
3060 s = s+dd(m)
3070 NEXT m
3080 NEXT i
3090 BORDER 0,6:  MODE 0: LOCATE 4,12: PRINT"Fine dei dati"
3100 FOR aa = 1 TO 1500 : NEXT aa: PRINT" " : MODE 1: BORDER 0
3110 GOTO 1060
3120 s = 1
3130  PRINT "NUM.[";i;"]"
3140  PRINT "__________________________":PRINT
3150 FOR n = 1 TO ca : ab$ = MID$(a$(i),s,dd(n)): s = s+dd(n)
3160 PRINT ca$(n);: PRINT TAB(15)ab$: NEXT n: IF jj = 999 THEN i = i :  GOSUB 2810    
3170       PRINT"__________________________"
3180 i = i: sr =sr+1: IF sr = 1 THEN 3210
3190 IF jj = 999 THEN 3080
3200 GOTO 3080
3210 LOCATE 1,23:  PRINT "Premi un tasto per continuare              ( 0 per uscire )"  
3220 a$ = INKEY$: IF a$ = "" THEN 3220
3230 IF a$ = "0" THEN 1060
3240 GOSUB 4170
3250 sr = 0: GOTO 3200
3260 jj = 999: GOSUB 3330
3270 GOTO 3010
3280 IF da > 78 AND db > 78 THEN GOSUB 2800: RETURN
3290 PRINT #8,i;
3300 b = 1: FOR m = 1 TO ca: PRINT #8,LEFT$(dc$,dd);: PRINT #8, MID$(a$(i),b,dd(m));: PRINT #8, LEFT$(dc$,dd);: b = b+dd(m)
3310 NEXT m : PRINT #8, ""
3320 RETURN
3330 da = 0: db = 0: FOR m = 1 TO ca: ca$(m) = ca$(m): da = da + LEN(ca$(m)): db = db+dd(m)
3340 NEXT m : RETURN
3350 IF da > 78 THEN 2800
3360 IF db > 78 THEN 2800
3370 dc = 78 - da : dc = dc/ca/2: dc = INT(dc)
3380 dd = 78 - db: dd = dd/ca/2: dd = INT(dd): dc$ = "                             "
3390 PRINT #8,CHR$(13);"                     ELENCO DATI"
3400 FOR m = 1 TO ca
3410 PRINT #8, LEFT$(dc$,dc);
3420 PRINT #8, ca$(m);
3430 PRINT #8, LEFT$(dc$,dc);
3440 NEXT m: PRINT #8,""
3450 FOR f = 1 TO 79 : PRINT #8,"-";: NEXT f: PRINT #8, ""
3460 RETURN
3470 CLS
3480 PRINT
3490 PRINT "            SORT RECORD"
3500 PRINT
3510 PRINT
3520 PRINT"    Nome del campo";: PRINT"     Lunghezza ": PRINT : IF nc > ca THEN ca = nc
3530 FOR k = 1 TO ca : PRINT "  "k"       "ca$(k)  
3540 PRINT "                             "dd(k): NEXT k
3550 PRINT: PRINT "    Su quale campo vuoi il SORT ?"
3560 r$ = INKEY$: IF r$ = "" THEN 3560
3570 IF r$ = "0" THEN 1060
3580 R = VAL (r$): s = 1: FOR m = 1 TO ca: s = s+dd(m): a(m) = s-dd(m): NEXT m: a(1) = 1: a1 = a(r)
3590 PRINT: PRINT : INPUT "    Quante lettere di precisione "; b1
3600 CLS
3610 PRINT
3620 PRINT "             SHELL   SORT"
3630 PRINT
3640 PRINT
3650 FOR j = 1 TO y: m =1 : NEXT j
3660 m = 2 * m : IF m <= y THEN 3660
3670 m = INT(m/2): IF m = 0 THEN 3720
3680 FOR j = 1 TO y-m: c = j
3690 d = c+m: IF MID$(a$(c),a1,b1) <= MID$(a$(d),a1,b1) THEN 3710
3700 aa$ = a$(c) : a$(c) = a$(d): a$(d) = aa$: c = c-m: IF c > 0 THEN 3690
3710 NEXT j: GOTO 3670
3720 REM
3730 GOTO 1060
3740 cc = 0: c =0 : INPUT " Numero da inserire (0 per uscire): ";c
3750 IF c > y THEN 3740
3760 IF c = 0 THEN 1060
3770 y = y+1: FOR i = y TO c STEP -1: a$(i) = a$(i-1): NEXT
3780 i = c: cc = 99
3790 CLS
3800 PRINT
3810 PRINT "             INSERIMENTO "
3820 PRINT
3830 PRINT
3840 GOTO 2030
3850 cc =0: GOTO 2350
3860 INPUT " Numero da cancellare (0 per uscire): ";c
3870 IF c > y THEN 3860
3880 IF c = 0 THEN 1060
3890 y = y-1
3900 FOR i = c TO y: a$(i) = a$(i+1): NEXT i: GOTO 1060
3910 BORDER 0: CLS: MODE 2
3920 PRINT
3930 WINDOW 1,80,1,25
3940 PRINT
3950 PRINT TAB(25)"** V I D E O    R E C O R D ** "            
3960 PRINT
3970 zz = 4: g = 0: FOR i = 1 TO y: s = 1: PRINT i;    
3980 FOR m = 1 TO ca
3990 PRINT " ";: PRINT MID$(a$(i),s,dd(m));: s = s + dd(m)
4000 NEXT m: g = g+1: IF g = zz THEN zz = zz+4: PRINT : PRINT"____________________________________": GOTO 4030
4010 PRINT : NEXT i
4020 LOCATE 1,11:  GOTO 2350
4030 LOCATE 1,18
4040 PRINT "I=Inser. D=Del. C=Corr. M=Menu V=Vedi"
4050 a$ = INKEY$: IF a$ = "" THEN 4050
4060 IF a$ = "i" OR a$ = "I" THEN 3740
4070 IF a$ = "d" OR a$ = "D" THEN 3860
4080 IF a$ = "c" OR a$ = "C" THEN 2510
4090 IF a$ = "m" OR a$ = "M" THEN  1060
4100 IF a$ = "v" OR a$ = "V" THEN CLS:  GOTO 3980
4110 GOTO 2170
4120 CLS
4130 PRINT "VIDEO RECORD"  
4140 PRINT
4150    NEXT i    
4160 LOCATE 1,21: GOTO 2350
4170 CLS
4180 LOCATE 13,1
4190 PRINT "* RICERCA DATI *"
4200 PRINT
4210 PRINT
4220 RETURN
4230 SPEED WRITE pl
4240 RETURN

Share

Lascia un commento

Il tuo indirizzo email non sarà pubblicato. I campi obbligatori sono contrassegnati *

Questo sito utilizza Akismet per ridurre lo spam. Scopri come vengono elaborati i dati derivati dai commenti.