(*************************************) (* (c) Copyright 1987 by Jens Kalski *) (*************************************) (* Programm : WS-INDEX *) (* Version : 2.0 *) (* vom : 11.03.1988 *) (* Sprache : TURBO-PASCAL 3.0 *) (*************************************) (* Indexe aus WORDSTAR 3.0 Texten *) (*************************************) (*$U-*) (* Benutzerunterbrechungen unterbinden *) (*$C-*) (* Control S und C deaktivieren *) (*$V-*) (* Var-Parametertyp-Pruefung abschalten *) PROGRAM WS_INDEX; TYPE Str2 = STRING(.2.); Str14 = STRING(.14.); Str20 = STRING(.20.); Str255 = STRING(.255.); Seiten_LT = ^Seiten_ST; (* Seitenlistendefinition *) Seiten_ST = RECORD Seite : INTEGER; NextSeite : Seiten_LT; END; Wort_LT = ^Wort_ST; (* Wortlistendefinition *) Wort_ST = RECORD Wort,V_Wort : ^Str255; Seiten_L : Seiten_LT; NextWort : Wort_LT; END; CONST Getrennt : BOOLEAN = FALSE; (* Trennzeichen - Flag *) Markiert : BOOLEAN = FALSE; (* ^K - Flag *) Speichern : BOOLEAN = TRUE; (* .PN/.OP - Flag *) ZeilenAnf : BOOLEAN = TRUE; (* Zeilenanfangs - Flag *) MB : INTEGER = 8; (* Unterer Seitenrand *) MT : INTEGER = 3; (* Oberer Seitenrand *) PL : INTEGER = 72; (* Gesamte Zeilenanzahl der Druckseiten *) MaxLen : INTEGER = 65; (* maximale Ausdruckbreite *) SeiteNr : INTEGER = 1; (* Momentane Seite *) ZeileNr : INTEGER = 60; (* Zeilenzaehler am Anfang = PL-MT-MB *) Sucher : ARRAY (.0..3.) OF CHAR = (* Deutsche Sonderzeichen *) ('[','\',']','~'); Ersatz : ARRAY (.0..3.) OF Str2 = (* Ersatz fuer ^^^ *) ('AE','OE','UE','SZ'); VAR CP : INTEGER; (* .CP - Blocklaenge *) Seite : INTEGER; (* Seitenspeicher fuer STRING-ZAHL-Umwandlung *) p : INTEGER; (* Dummy-Variable *) c,Lc : CHAR; (* Momentan/Letztes bearbeitetes Zeichen *) PBefehl : Str2; (* Punktbefehlsspeicher *) PZeile : Str20; (* Punktbefehlszeilenspeicher *) Wort : Str255; (* Wortspeicher *) Laenge : BYTE ABSOLUTE Wort; (* Wortlaenge *) Wort_L : Wort_LT; (* Zeiger Wortlistenanfang *) InDat, (* Eingabedatei *) OutDat : Str14; (* Ausgabedatei *) DatOut : TEXT; (* Output-Device *) (* TURBO-3.0-Laufzeitfehler im Klartext *) PROCEDURE SYSError(Nummer,Adresse:INTEGER); (* Integerwert Hexadezimal ausgeben *) PROCEDURE HexOut(Dezimal:INTEGER); BEGIN INLINE($CD/$04AF); END; BEGIN WriteLn; WriteLn('TURBO-SYSTEMABBRUCH bei Adresse &'); HexOut(Adresse); CASE Nummer OF (* Auswahl entsprechend TURBO-Fehlernummer *) $0102 : WriteLn('Lesefehler'); $0103 : WriteLn('Schreibfehler'); $01F0 : WriteLn('Diskette voll'); $01FF : WriteLn('Datei verschwunden ???'); $02FF : WriteLn('Speicher}berlauf'); END; HALT; END; (* Wandelt einen String in Grossbuchstaben um *) PROCEDURE SUpcase(VAR S:Str255); BEGIN INLINE($2A/S/$46/$04/$05/$CA/*+20/$23/$7E/$FE/$61/$DA/*-9/ $FE/$7E/$D2/*-14/$D6/$20/$77/$C3/*-20); END; (* Wandelt einen String in *) (* einen Integerwert um *) (* Bei Fehler ist der Wert 0 *) FUNCTION Str_Int(HStr:Str14):INTEGER; VAR HWert,Fehler : INTEGER; BEGIN HWert:=0; IF Length(HStr) > 0 THEN REPEAT Val(HStr,HWert,Fehler); IF Fehler > 0 THEN Delete(HStr,Fehler,1); UNTIL (Fehler = 0) OR (Length(HStr) = 0); Str_Int:=HWert; END; (* Fuegt ein Wort in die Liste ein *) PROCEDURE Speichere_Wort; VAR Flag : BOOLEAN; (* Hilfsvariablen *) i,p : INTEGER; HZeile : Str255; ps,qs : Seiten_LT; pw,qw : Wort_LT; BEGIN IF Wort(.Laenge.)=' ' THEN Laenge:=Pred(Laenge); (* Endleerz. loeschen *) IF Laenge > 0 THEN BEGIN IF Laenge > MaxLen-5 (* Wort auf MaxLen + Platz f. eine Seite kuerzen *) THEN Laenge:=Laenge-5; HZeile:=Wort; SUpcase(HZeile); (* Hilfszeile gross *) FOR i:=0 TO 3 DO REPEAT (* Deutsche Sonderzeichen umwandeln *) p:=Pos(Sucher(.i.),HZeile); IF p>0 THEN BEGIN Delete(HZeile,p,1); Insert(Ersatz(.i.),HZeile,p); END; UNTIL p=0; Flag:=TRUE; qw:=NIL; pw:=Wort_L; (* Wort (-sequenz) suchen *) WHILE Flag AND (pw<>NIL) DO IF pw^.V_Wort^ < HZeile THEN BEGIN qw:=pw; pw:=pw^.NextWort; END ELSE Flag:=FALSE; Flag:=TRUE; IF pw<>NIL THEN Flag:=(pw^.V_Wort^<>HZeile); (* Wort gefunden ? *) IF Flag THEN BEGIN (* Wort nicht gefunden -> Wort speichern *) pw:=NIL; New(pw); GetMem(pw^.Wort,Succ(Length(Wort))); (* Speicher reservieren *) GetMem(pw^.V_Wort,Succ(Length(HZeile))); pw^.Wort^:=Wort; (* Originalwort in Speicher schreiben *) pw^.V_Wort^:=HZeile; (* Vergleichswort abspeichern *) pw^.Seiten_L:=NIL; (* Seitenliste initialisieren *) IF qw=NIL THEN BEGIN pw^.NextWort:=Wort_L; Wort_L:=pw; END ELSE BEGIN pw^.NextWort:=qw^.NextWort; qw^.NextWort:=pw; END; New(pw^.Seiten_L); pw^.Seiten_L^.Seite:=SeiteNr; END ELSE BEGIN (* Wort gefunden -> Seite speichern *) Flag:=TRUE; qs:=NIL; ps:=pw^.Seiten_L; (* Seite suchen *) WHILE Flag AND (ps<>NIL) DO IF ps^.Seite < SeiteNr THEN BEGIN qs:=ps; ps:=ps^.NextSeite; END ELSE Flag:=FALSE; Flag:=TRUE; IF ps<>NIL THEN Flag:=(ps^.Seite<>SeiteNr); (* Seite gefunden ? *) IF Flag THEN BEGIN (* Seite nicht gefunden -> Seite speichern *) ps:=NIL; New(ps); ps^.Seite:=SeiteNr; IF qs=NIL (* Seite einfuegen *) THEN BEGIN ps^.NextSeite:=pw^.Seiten_L; pw^.Seiten_L:=ps; END ELSE BEGIN ps^.NextSeite:=qs^.NextSeite; qs^.NextSeite:=ps; END; END; END; Laenge:=0; END ELSE BEGIN WriteLn; WriteLn('Markierter Leerzeichenbereich gefunden !'); END; END; (* Addiert Buchstaben zum Wort und setzt die Flags *) PROCEDURE AddC(c:CHAR); BEGIN ZeilenAnf:=FALSE; (* Kein Zeilenanfang mehr *) Getrennt:=FALSE; (* Trennung ist hier beendet *) IF Markiert THEN (* Innerhalb einer Markierung ? *) IF Laenge < 255 THEN (* Stringlaenge < Maximalstringlaenge ? *) Wort:=Wort+c; (* Zeichen addieren *) END; (* Inkrementiert den Seitenzaehler und setzt den Zeilenzaehler zuruck *) PROCEDURE NeueSeite; BEGIN ZeileNr:=PL-MT-MB; SeiteNr:=Succ(SeiteNr); Write(':'); END; (* Analysiert den WORDSTAR-Text *) (*$A-*) PROCEDURE Textanalyse(VAR Wort_L:Wort_LT;DateiEin:Str14); VAR Datei : TEXT; (* Einlese-Datei-Leitung *) BEGIN Assign(Datei,DateiEin); (*$I-*) Reset(Datei); (*$I+*) (* Eingabedatei oeffnen *) IF IOResult = 0 THEN BEGIN (* Fehler beim Dateioeffnen *) WHILE NOT EoF(Datei) DO BEGIN (* Solange Zeichen in der Datei sind *) Read(Datei,c); (* Zeichen lesen *) INLINE($21/c/$CB/$BE); (* 7.Bit loeschen *) CASE c OF #33..#45,#47..#126 : begin AddC(c); (* "Normale" Wortzeichen *) Lc:=c; end; #15,#32 : BEGIN (* (festes) Leerzeichen *) ZeilenAnf:=FALSE; IF Markiert THEN IF NOT Getrennt THEN (* Innerhalb Trennbereich ? *) IF Laenge < 255 THEN IF Laenge > 0 THEN IF Wort(.Laenge.) <> ' ' THEN Wort:=Wort+' '; END; #10 : BEGIN ZeileNr:=Pred(ZeileNr); ZeilenAnf:=TRUE; if Lc = '-' then Getrennt:=TRUE; IF ZeileNr <= 0 THEN NeueSeite; END; #46 : IF ZeilenAnf THEN BEGIN ReadLn(Datei,PZeile); ZeilenAnf:=TRUE; Getrennt:=FALSE; SUpcase(PZeile); IF Pos('.WS-INDEX',PZeile)>0 THEN BEGIN Close(Datei); EXIT; END; PBefehl:=Copy(PZeile,1,2); Delete(PZeile,1,2); p:=Pos(PBefehl,'CPPAFIOPPNPLMTMB'); CASE p OF 1 : BEGIN CP:=Str_Int(PZeile); IF CP > ZeileNr THEN NeueSeite; END; 3 : NeueSeite; 5 : BEGIN WHILE (PZeile(.1.)=' ') AND (Length(PZeile) > 0) DO Delete(PZeile,1,1); p:=Pos(' ',PZeile); IF p > 0 THEN PZeile:=Copy(PZeile,1,p); Textanalyse(Wort_L,PZeile); END; 7 : Speichern:=FALSE; 9 : BEGIN Speichern:=TRUE; Seite:=Str_Int(PZeile); IF Seite > 0 THEN SeiteNr:=Seite; END; 11 : BEGIN Seite:=Str_Int(PZeile); IF Seite > 0 THEN PL:=Seite; END; 13 : MT:=Str_Int(PZeile); 15 : MB:=Str_Int(PZeile); END; END ELSE AddC(#46); (* "Normaler" Punkt / Zeichen addieren *) #31 : Getrennt:=TRUE; (* Trennzeichen *) ^K : BEGIN (* Wort- bzw. Satzmarkierung *) IF Markiert AND Speichern THEN Speichere_Wort; Markiert:=NOT Markiert; Getrennt:=FALSE; ZeilenAnf:=FALSE; END; END; END; (* While Not Eof *) Close(Datei); (* Eingabedatei schliessen *) WriteLn('< ',DateiEin); IF Markiert THEN BEGIN (* TRUE -> Markierung nicht paarig *) WriteLn; WriteLn('WARNUNG : ^K - Markierungen nicht paarig im Text'); END; END ELSE BEGIN (* Fehler beim Dateioeffnen *) WriteLn; LowVideo; Write('WARNUNG : ',DateiEin,' konnte nicht geoeffnet werden!'); NormVideo; WriteLn; END; END; (*$A+*) (* Erzeugt die Sachwortdatei *) PROCEDURE SchreibIndex(Wort_L:Wort_LT); CONST AnfBst : CHAR = #0; (* Momentaner Anfangsbuchstabe *) Anfang : BOOLEAN = TRUE; (* TRUE = Indexanfang *) VAR hs1 : Str255; (* Hilfsvariablen *) hs2 : STRING(.5.); L1 : BYTE ABSOLUTE hs1; L2 : BYTE ABSOLUTE hs2; HWort_L : Wort_LT; HSeiten_L : Seiten_LT; BEGIN IF Wort_L <> NIL THEN BEGIN (* Wortliste leer *) WriteLn; WriteLn('MELDUNG : Erstellung der Ausgabedatei '+OutDat); Assign(DatOut,OutDat); (* Ausgabedatei oeffnen *) (*$I-*) ReWrite(DatOut); (*$I+*) IF IOResult = 0 THEN BEGIN (* Fehler beim Oeffnen *) WriteLn(DatOut,'..WS-INDEX'); WriteLn(DatOut,'.HE','':(MaxLen-15) SHR 1,^B,'Sachverzeichnis',^B); WriteLn(DatOut,'.PA'); (* Neue Seite fuer den Index *) HWort_L:=Wort_L; WHILE HWort_L<>NIL DO WITH HWort_L^ DO BEGIN (* Bis Listenende *) IF V_Wort^(.1.) <> AnfBst THEN BEGIN (* Neuer Anfangsbuchstabe ? *) AnfBst:=V_Wort^(.1.); IF Anfang (* Indexanfang ? *) THEN Anfang:=FALSE (* JA - Keine Leerzeile *) ELSE WriteLn(DatOut); (* NEIN - Leerzeile ausgeben *) WriteLn(DatOut,^B,AnfBst,^B); (* Anfangsbuchstabe fettdrucken *) END; hs1:=Wort^+' '; (* --- Ausgabezeile zusammenbauen --- *) IF hs1(.1.)='.' THEN hs1:=^K+hs1; (* Punkt am Anfang beruecks. *) HSeiten_L:=Seiten_L; WHILE HSeiten_L<>NIL DO WITH HSeiten_L^ DO BEGIN (* Bis Listenende *) Str(Seite,hs2); (* Zahl in String umwandeln *) IF Succ(Succ(L2)) <= MaxLen - L1 (* Zeilenende ? *) THEN BEGIN IF hs1(.L1.) <> ' ' THEN hs1:=hs1+', '; hs1:=hs1+hs2; END ELSE BEGIN (* Maximale Ausdruckbreite erreicht *) WriteLn(DatOut,hs1); (* Zeile ausgeben *) IF NextSeite<>NIL (* Sind noch Seiten in der Liste ? *) THEN hs1:=' ' (* JA - Naechste Zeile vorbereiten *) ELSE L1:=0; END; HSeiten_L:=NextSeite; (* Naechste Seite *) END; IF L1 <> 0 THEN WriteLn(DatOut,hs1); (* Zeilenrest ausgeben *) HWort_L:=NextWort; (* Naechstes Wort *) END; Close(DatOut); (* Ausgabedatei schliessen *) END ELSE WriteLn('FEHLER : ',OutDat,' kann nicht ge|ffnet werden!'); END ELSE BEGIN WriteLn; WriteLn('WARNUNG : Keine markierten Textbereiche gefunden.'); END; END; BEGIN (* Hauptprogramm *) ErrorPtr:=Addr(SYSError); (* Fehlerausgabe umleiten *) Wort_L:=NIL; (* Wortliste initialisieren *) Laenge:=0; CrtInit; ClrScr; WriteLn('WS-INDEX / Version 2.0 vom 10. Maerz 1988'); WriteLn('(C) Copyright by Jens Kalski'); IF ParamCount = 1 THEN BEGIN InDat:=ParamStr(1); OutDat:=InDat; (* Ausgabedateiname zusammenbasteln *) IF Pos('.',OutDat) > 0 THEN OutDat:=Copy(OutDat,1,Pred(Pos('.',OutDat))); OutDat:=OutDat+'.IND'; WriteLn; WriteLn('MELDUNG : Bearbeitung von ',InDat); WriteLn('':10,': - Seitenumbruch'); WriteLn('':10,'< - Dateiende'); WriteLn; Textanalyse(Wort_L,InDat); (* Textanalyse *) SchreibIndex(Wort_L); (* Ergebnisdatei erzeugen *) WriteLn('MELDUNG : Programmende'); END ELSE BEGIN WriteLn; WriteLn('MELDUNG : Programmaufruf !'); WriteLn; WriteLn('Starten Sie das Programm bitte mit :'); WriteLn; WriteLn('WS-INDEX EINGABE.TXT'); WriteLn; WriteLn('Die Wortsequenzen m}ssen durch'); WriteLn('^K (^p^K) eingeschlossen sein'); END; END. (* ----- Programmende ----- *)