1 PROGRAM LISTE(INPUT/,OUTPUT,DATA);
  2 (*
  3    LITERATURVERZEICHNIS FUER ZEITSCHRIFTENARTIKEL.
  4
  5    DIE DATEI ' DATA' ENTHAELT DIE LITERATURREFERENZEN,
  6    DIE AUSGABE ERFOLGT NACH OUTPUT.
  7    WEITERE BESCHREIBUNG SIEHE NUNKSCHAU ARTIKEL
  8
  9    ANMERKUNG: DER '/' HINTER INPUT IST NICHT STD-PASCAL
 10
 11 *)
 12
 13 CONST N = 499; (*LAENGE DER HASH-TABLE *)
 14       LENGTH = 1000; (* LAENGE DER DATENLISTE *)
 15       BLANK30 = '                              '; (* 30 BLANKS *)
 16       KEYL = 30 (* KEYLAENGE *);
 17
 18 TYPE  KEYWORD = PACKED ARRAY [1..KEYL] OF CHAR ;  (* STRING *)
 19       LISTARRAY = ARRAY [1..LENGTH,1..3] OF INTEGER;
 20                  (* LITERATURLISTE : HEFT,SEITE,NAECHSTER *)
 21       TABLE = ARRAY [0..N] OF RECORD
 22                                   KEY : KEYWORD;
 23                                   START : 0..LENGTH
 24                                END;
 25
 26 VAR   LIST : LISTARRAY;
 27       TAB  : TABLE;
 28       DATAPOINTER : 0..LENGTH (* ZEIGT AUF DAS NAECHSTE FREIE
 29                                  LISTENELEMENT *);
 30       KOMMANDO : CHAR;
 31       DATA : TEXT; (* TYPE TEXT = FILE OF CHAR *)
 32
 33
 34 PROCEDURE GENERATENEWLIST;
 35   VAR I : 1..LENGTH;
 36       J : 0..N;
 37   BEGIN
 38   FOR I := 1 TO LENGTH DO
 39     FOR J := 1 TO 3 DO LIST[I,J] := 0;
 40   FOR J := 0 TO N DO
 41     BEGIN
 42     TAB[J].KEY := BLANK30;
 43     TAB[J].START := 1;
 44     END;
 45   END;
 46
 47
 48
 49 PROCEDURE PUTDATA;
 50   VAR I : 1.. LENGTH;
 51       J : 0..N;
 52   BEGIN
 53   REWRITE(DATA);
 54   FOR J := 0 TO N DO
 55     WRITELN(DATA,TAB[J].KEY,' ',TAB[J].START :1);
 56   FOR I := 1 TO DATAPOINTER-1 DO
 57     WRITELN(DATA,LIST[I,1]:1,' ',LIST[I,2]:1,' ',
 58                  LIST[I,3]:1);
 59   END;
 60
 61
 62
 63 PROCEDURE GETDATA;
 64   VAR I : 1..LENGTH;
 65       J : 0..N;
 66       K : 1..KEYL;
 67   BEGIN
 68   RESET(DATA);
 69   FOR J := 0 TO N DO
 70     BEGIN
 71     (* STRINGS MUESSEN ZEICHENWEISE GELESEN WERDEN *)
 72     FOR K := 1 TO KEYL DO READ(DATA,TAB[J].KEY[K]);
 73     READ(DATA,TAB[J].START);
 74     READLN(DATA);
 75     END;
 76   DATAPOINTER := 1;
 77   WHILE NOT EOF(DATA) DO
 78     BEGIN
 79     READ(DATA,LIST[DATAPOINTER,1],LIST[DATAPOINTER,2],
 80               LIST[DATAPOINTER,3]);
 81     READLN(DATA);
 82     DATAPOINTER := DATAPOINTER + 1;
 83     END;
 84   END;
 85
 86
 87
 88 PROCEDURE GETLINE(VAR K : KEYWORD; VAR H,S : INTEGER);
 89   VAR I : 0..KEYL;
 90       CH :CHAR;
 91   BEGIN
 92   READLN (* MASCHINENABHAENGIG *);
 93   K := BLANK30;
 94   H := 0; S := 0;
 95   READ(INPUT,K[1]);
 96   IF K[1]<>'$' THEN
 97     BEGIN
 98     I := 1; READ(CH);
 99     WHILE (CH<>',') AND NOT EOLN DO
100       BEGIN
101       IF I< KEYL THEN BEGIN I := I+1; K[I] := CH END;
102       READ(CH);
103       END;
104     IF NOT EOLN THEN READ(H,CH);
105     IF NOT EOLN THEN READ (S);
106     END;
107   END;
108
109
110 FUNCTION HASH(X :KEYWORD) : INTEGER ;
111   VAR I : 1..5;
112       H : INTEGER;
113   BEGIN
114   H:=0;
115   FOR I := 1 TO 5 DO H:= H*10 + ORD(X[I]) ;
116   HASH := H MOD N;
117   END;
118
119
120
121 PROCEDURE INSERT(KEY : KEYWORD; HEFT,SEITE : INTEGER);
122   VAR GEFUNDEN : BOOLEAN;
123       MARKE,INDEX : 0..N;
124       ZEIGER : 0..LENGTH;
125   BEGIN
126   GEFUNDEN := FALSE;
127   INDEX := HASH(KEY); MARKE := INDEX;
128   REPEAT
129     (* SUCHE KEY IN TABELLE *)
130     IF TAB[INDEX].KEY = BLANK30 THEN
131       BEGIN (* NEUEINTRAG *)
132       GEFUNDEN := TRUE;
133       TAB[INDEX].KEY := KEY;
134       TAB[INDEX].START := DATAPOINTER;
135       LIST[DATAPOINTER,1] := HEFT;
136       LIST[DATAPOINTER,2] := SEITE;
137       DATAPOINTER := DATAPOINTER + 1;
138       END
139     ELSE
140       IF TAB[INDEX].KEY = KEY THEN
141         BEGIN(* GETROFFEN *)
142         GEFUNDEN := TRUE;
143         ZEIGER := TAB[INDEX].START;
144         WHILE LIST[ZEIGER,3]<>0 DO
145           ZEIGER := LIST[ZEIGER,3];
146         LIST[ZEIGER,3] := DATAPOINTER;
147         LIST[DATAPOINTER,1] := HEFT;
148         LIST[DATAPOINTER,2] := SEITE;
149         DATAPOINTER := DATAPOINTER + 1;
150         END
151       ELSE
152         BEGIN (* WEITERSUCHEN *)
153         IF INDEX = N THEN INDEX := 0 ELSE INDEX :=INDEX + 1;
154         IF INDEX = MARKE THEN
155            BEGIN WRITELN(' --- TABLE OVERFLOW ---');
156            GEFUNDEN := TRUE END;
157         END;
158   UNTIL GEFUNDEN;
159   IF DATAPOINTER = LENGTH THEN WRITELN(' --- LIST OVERFLOW ---');
160   END;
161
162
163
164 PROCEDURE ENTER;
165   VAR KEY : KEYWORD;
166       HEFT,SEITE : INTEGER;
167   BEGIN
168   WRITELN(' PLEASE ENTER: KEY,ISSUE,PAGE');
169   WRITELN(' FINISH WITH $ ');
170   REPEAT
171     GETLINE(KEY,HEFT,SEITE);
172     IF( KEY[1]<>'$') AND (KEY<>BLANK30) THEN INSERT(KEY,HEFT,SEITE);
173     WRITELN(' O.K.');
174   UNTIL KEY[1]='$';
175   END;
176
177
178
179 PROCEDURE SEARCH(KEY : KEYWORD);
180   VAR INDEX,MARKE : 0..N;
181       ZEIGER,K : 0..LENGTH;
182       GEFUNDEN : BOOLEAN;
183
184   BEGIN
185   GEFUNDEN := FALSE; K := 0;
186   INDEX := HASH(KEY); MARKE := INDEX;
187   REPEAT
188     IF TAB[INDEX].KEY = KEY THEN
189       BEGIN (* GEFUNPEN *)
190       GEFUNDEN := TRUE;
191       WRITELN(' ':3,KEY);
192       WRITE(' ':5);
193       ZEIGER := TAB[INDEX].START;
194       REPEAT
195         WRITE(' ':3,LIST[ZEIGER,1]:3,'/',LIST[ZEIGER,2]:1);
196         K := K + 1; IF K MOD 5 = 0 THEN
197           BEGIN
198           WRITELN; WRITE(' ':5);
199           END;
200         ZEIGER := LIST[ZEIGER,3];
201       UNTIL ZEIGER = 0;
202       IF K MOD 5<>5 THEN WRITELN;
203       WRITELN;
204       WRITELN;
205       END
206     ELSE
207       BEGIN
208       IF INDEX = N THEN INDEX := 0 ELSE INDEX := INDEX + 1;
209       IF INDEX = MARKE THEN
210         BEGIN GEFUNDEN := TRUE;
211         WRITELN(' --- ',KEY, ' NOT FOUND ---');
212         END;
213       END;
214   UNTIL GEFUNDEN;
215   END;
216
217
218
219 PROCEDURE QUESTION;
220   VAR KEY : KEYWORD;
221       I : 0..KEYL;
222   BEGIN
223   WRITELN(' PLEASE ENTER KEYWORD');
224   READLN;
225   I := 0;
226   KEY := BLANK30;
227   WHILE NOT EOLN AND (I<KEYL) DO
228     BEGIN I:=I+1; READ(KEY[I]) END;
229   SEARCH(KEY);
230   END;
231
232
233
234 PROCEDURE LISTTABLE;
235   VAR KEYS : ARRAY[0..N] OF KEYWORD;
236       KEY : KEYWORD;
237       I,J,K : INTEGER;
238       ENDE : BOOLEAN;
239   BEGIN
240   K := 0;
241   FOR I := 0 TO N DO
242     IF TAB[I].KEY <> BLANK30 THEN
243       BEGIN KEYS[K] := TAB[I].KEY; K := K + 1 END;
244   K := K - 1;
245   FOR I := 1 TO K DO
246     BEGIN
247     ENDE := FALSE;
248     KEY := KEYS[I];
249     J := I-1;
250     WHILE NOT ENDE AND (J>=0) DO
251       IF KEY<KEYS[J] THEN
252         BEGIN KEYS[J+1] := KEYS[J]; J := J-1 END
253       ELSE ENDE := TRUE;
254     KEYS[J+1] := KEY;
255     END;
256   WRITELN(' HOW MANY COPIES DO YOU WANT');
257   READLN; READ(I);
258   REPEAT
259     WRITELN(' ':25,'LITERATURSTELLEN');
260     WRITELN(' ':25,'================');
261     WRITELN; WRITELN; WRITELN;
262     FOR J := 0 TO K DO
263       SEARCH(KEYS[J]);
264     WRITELN; WRITELN; WRITELN;
265     I := I - 1
266   UNTIL I = 0;
267   END;
268
269
270
271
272 (* MAIN *)
273 BEGIN
274 DATAPOINTER :=1;
275 WRITELN(' ENTER COMMAND');
276 READLN; READ(KOMMANDO);
277 GENERATENEWLIST;
278 IF KOMMANDO <> 'N' THEN GETDATA;
279 REPEAT
280   IF KOMMANDO IN ['E', 'Q','P','N'] THEN
281      CASE KOMMANDO OF
282      'E' : ENTER;
283      'Q' : QUESTION;
284      'P' : LISTTABLE;
285      'N' : GENERATENEWLIST;
286      END
287 ELSE
288   WRITELN(' --- ILLEGAL COMMAND,REENTER ---');
289 WRITELN(' ENTER COMMAND');
290 READLN; READ(KOMMANDO);
291 UNTIL KOMMANDO = 'S';
292 WRITELN(' GOOD BYE');
293 PUTDATA;
294 END.

00005 REM * *************************
00010 REM * LITERATURSTELLEN-PROGRAMM
00020 REM * *************************
00030 REM * VARIABLEN:
00040 REM *   L(L1,3) LITERATURSTELLEN (HEFT,SEITE,NACHFOLGER)
00050 REM *   HASH-TABELLE: K$ FUER DIE SCHLUESSEL
00060 REM *                 S FUER DIE STARTINDICES IN L
00070 REM *                 K$(N),S(N)
00080 REM *   F$ NAME DES DATENFILES
00090 REM *   D ZEIGT AUF DAS ERSTE FREIE ELEMENT VON L
00100 REM * KONSTANTE FUER DIE FELDLAENGEN BESETZEN
00110 N = 499
00120 L1 = 1000
00125 DIM L(1000,3),K$(499),S(499),K9$(499)
00130 REM * * * BEGINN HAUPTPROGRAMM * * *
00140 D=1
00150 PRINT " PLEASE ENTER NAME OF DATAFILE";
00160 INPUT F$
00170 GOSUB 1000
00180 REM * GENERIEREN LEERER LISTE
00190 PRINT " ENTER COMMAND"
00200 INPUT A$
00210 IF A$="N" THEN 240
00220 GOSUB 2000
00230 REM * EINLESEN DES DATENFILES
00240 REM * KOMMANDO BEARBEITEN
00250 IF A$ = "E" THEN 340
00260 IF A$ = "Q" THEN 360
00270 IF A$ = "P" THEN 380
00280 IF A$ = "N" THEN 400
00290 IF A$ = "S" THEN 420
00300 PRINT " --- ILLEGAL COMMAND ---"
00310 PRINT " --- ALLOWED ARE E,Q,N,P OR S ---"
00320 GOTO 440
00330 REM * AUFRUFE DER FUNKTIONEN
00340 GOSUB 3000
00350 GOTO 440
00360 GOSUB 4000
00370 GOTO 440
00380 GOSUB 5000
00390 GOTO 440
00400 GOSUB 1000
00410 GOTO 440
00420 PRINT " GOOD BYE"
00425 GOSUB 6000
00430 STOP
00440 REM * EINLESEN NAECHSTES KOMMANDO
00450 PRINT " ENTER COMMAND"
00460 INPUT A$
00470 GOTO 240
00480 REM * ENDE HAUPTPROGRAMM
00490 REM *************************************************
00500 REM *************************************************
00510 REM *
00515 REM * DEFINIEREN DER HASH- FUNKTION
00520 REM *
00530 DEF FNH (X$)
00540   REM SUBSTR IST IDENTISCH MIT MIDSTR
00550 I = 0
00560 FOR J = 1 TO 5
00570    L9 = 0
00580   FOR K = 1 TO 63
00590     IF SUBSTR(X$,J,1)<>CHR$(K) THEN L9 = K
00600     NEXT K
00610   I = I*10 + L9
00620 NEXT J
00630 FNH = I - INT(I/N)*N
00640 FNEND
00650 REM *
00660 REM *
00670 REM *
00680 REM *
01000 REM *************************************************
01001 REM * GENERIEREN EINER LEEREN LISTE
01002 REM *************************************************
01010 FOR I = 1 TO L1
01020   FOR J = 1 TO 3
01030     L(I,J) = 0
01040   NEXT J
01050 NEXT I
01060 FOR I = 1 TO N
01070   K$(I) = " "
01080   S(I) = 1
01090 NEXT I
01110 RETURN
02000 REM *************************************************
02001 REM * LESEN DES DATENFILES
02002 REM *************************************************
02010 FILE#1 = F$
02025 REM * FILE IST GLEICHBEDEUTEND MIT OPEN
02030 RESTORE #1
02035 REM * DATEI AUF ANFANG STELLEN
02040 FOR J = 1 TO N
02050   INPUT#1,K$(J),S(J)
02060 NEXT J
02070 D = 1
02080 IF END#1 THEN 2120
02090 INPUT#1,L(D,1),L(D,2),L(D,3)
02100 D = D + 1
02110 GOTO 2080
02120 CLOSE#1
02130 RETURN
03000 REM *************************************************
03001 REM * EINGABE NEUER DATEN VON DER TASTATUR
03002 REM *************************************************
03010 PRINT " PLEASE ENTER KEY,ISSUE,PAGE"
03020 PRINT " FINISH WITH $,0,0"
03030 INPUT K1$,Hl,S1
03040 IF K1$ = "$" THEN 3080
03050 GOSUB 7000
03060 PRINT "0. K."
03070 GOTO 3030
03080 RETURN
04000 REM  ************************************************
04001 REM * FRAGE NACH EINTRAEGEN ZU EINEM KEYWORD
04002 REM *************************************************
04010 PRINT "PLEASE ENTER KEYWORD"
04020 INPUT K1$
04030 GOSUB 8000
04040 RETURN
05000 REM *************************************************
05001 REM * AUFLISTEN DER GANZEN DATEN
05002 REM *************************************************
05020 K=1
05030 FOR I = 1 TO N
05040   IF K$(I) = " " THEN 5070
05050   K9$(K) = K$(I)
05060   K = K + 1
05070   NEXT I
05080 K = K - 1
05090 FOR I = 2 TO K
05100   H$ = K9$(I)
05110   J = I - 1
05120   IF H$>=K9$(J) THEN 5160
05130   K9$(J+1) = K9$(J)
05140   J = J - 1
05150   IF J<>0 THEN 5120
05160   K9$(J+1) = H$
05170 NEXT I
05175 K8 = K
05180 PRINT"HOW MANY COPIES DO YOU WANT"
05190 INPUT I9
05200 PRINT TAB(25),"LITERATURSTELLEN"
05210 PRINT TAB(25),"================"
05220 PRINT
05230 PRINT
05240 PRINT
05250 FOR J9 = 1 TO K8
05260   K1$ = K9$(J9)
05270   GOSUB 8000
05280 NEXT J9
05290 I9 = I9 - 1
05300 IF I9>0 THEN 5200
05310 RETURN
06000 REM *************************************************
06001 REM * ZURUECKSCHREIBEN DER DATEN AUF DAS DATENFILE
06002 REM *************************************************
06010 FILE#1 = F$
06020 RESTORE#1
06030 FOR J = 1 TO N
06040   PRINT#1,K$(J);",";S(J);","
06050 NEXT J
06060 FOR J = 1 TO D-1
06070   PRINT#1,L(J,1);",";L(J,2);",";L(J,3);","
06080 NEXT J
06090 CLOSE#1
06100 RETURN
07000 REM *************************************************
07001 REM * EINFUEGEN EINES EINTRAGS IN DIE LISTE/TABELLE
07002 REM *************************************************
07003 REM *
07004 REM * PARAMETER:
07005 REM *   K1$ EINZUFUEGENDER SCHLUESSEL
07006 REM *   H1    HEFTNUMMER
07007 REM *   S1    SEITENNUMMER
07008 REM *
07010 G = 0
07020 I = FNH(K1$)
07030 M = I
07040 REM SUCHE NACH DEM SCHLUESSEL
07050 IF K$(I)<>" " THEN 7130
07060 G = 1
07070 K$(I) = K1$
07080 S(I) = D
07090 L(D,1) = H1
07100 L(D,2) = S1
07110 D = D + 1
07120 GOTO 7310
07130 IF K$(I)<>K1$ THEN 7240
07140 G = 1
07150 Z = S(I)
07160 IF L(Z,3) = 0 THEN 7190
07170 Z = L(Z,3)
07180 GOTO 7160
07190 L(Z,3) = D
07200 L(D,1) = H1
07210 L(D,2) = S1
07220 D = D + 1
07230 GOTO 7310
07240 IF I = N THEN 7270
07250 I = I + 1
07260 GOTO 7280
07270 I = 1
07280 IF I <> M THEN 7310
07290 PRINT " --- TABLE OVERFLOW ---"
07300 G = 1
07310 IF G = 0 THEN 7040
07320 IF D<L1 THEN 7340
07330 PRINT " --- LIST OVERFLOW ---"
07340 RETURN
08000 REM *************************************************
08001 REM * SUCHEN IN DER TABELLE NACH EINEM SCHLUESSEL
08002 REM *************************************************
08003 REM *
08004 REM * PARAMETER:
08005 REM *   K1$ ZU SUCHENDER SCHLUESSEL
08006 REM *
08010 G = 0
08020 I = FNH(K1$)
08030 K = 0
08040 M = I
08050 REM BEGINN DER SUCHE
08060 IF K$(I)<>K1$ THEN 8220
08070 G = 1
08080 PRINT"   ";Kl$
08090 Z = S(I)
08100 PRINT "   ";L(Z,1);"/";L(Z,2);
08110 K = K + 1
08120 IF K<5 THEN 8150
08130 PRINT
08140 K = 0
08150 Z = L(Z,3)
08160 IF Z<>0 THEN 8100
08170 IF K = 0 THEN 8190
08180 PRINT
08190 PRINT
08200 PRINT
08210 GOTO 8290
08220 IF I = N THEN 8250
08230 I = I + 1
08240 GOTO 8260
08250 I = 1
08260 IF I<>M THEN 8290
08270 PRINT " --- ";K1$;" NOT FOUND"
08280 G = 1
08290 IF G = 0 THEN 8050
08300 RETURN
09000 END