(* ********************************************************* ********************************************************* ** ** ** ls-Menu-Generator 1 ** ** ** ** Version 1.0 ** ** ** ** (Stand: 30.03.88) ** ** ** ** ** ** Autor: Wolfgang Weber, Bielefeld ** ** ** ** ** ** Copyright (C) 1987, 1988 Eva Latta-Weber, Bielefeld ** ** ** ** Copyright (C) 1988 ERGOS GmbH, Siegburg ** ** ** ********************************************************* ********************************************************* *) PACKET ls menu generator 1 DEFINES textprozedur, textzeile: LET maxzeilenzahl = 14, maxzeichenzahl = 65, zentrierkennung = "%", beginmarkkennung = "$", endmarkkennung = "&", unblockkennung = "�", blank = " ", dateikennung = ".a"; LET dateieintrag = "#type (""10"")##limit (16.5)#", stdfonttabelle = "fonttab.ls-Menu-Generator"; ROW 3 TEXT CONST fehlermeldung :: ROW 3 TEXT : ( "existiert nicht!", ""15"Text ist zu lang - bitte kürzen! "14"", ""15"Zeilenformatierung mit abgebrochen! "14"" ); ROW 6 TEXT CONST hinweis :: ROW 6 TEXT : ( "Bitte warten ...", "Zulässige Zeilenzahl: ", "Tatsächliche Zeilenzahl: ", "Textlänge ist in Ordnung!", "Textprozedur ist erstellt!", "Textzeile ist erstellt!" ); PROC textprozedur (TEXT CONST dateiname, prozedurname): BOOL VAR mit fehler; formatiere (dateiname, mit fehler); IF mit fehler THEN errorstop (fehlermeldung [3]) FI; bereite den text auf (dateiname); erzeuge textprozedur (dateiname, prozedurname); out (""7""); out (hinweis [5]); last param (dateiname + dateikennung) END PROC textprozedur; PROC textzeile (TEXT CONST dateiname): BOOL VAR mit fehler; formatiere (dateiname, mit fehler); IF mit fehler THEN errorstop (fehlermeldung [3]) FI; bereite den text auf (dateiname); erzeuge textzeile (dateiname); out (""7""); out (hinweis [6]); last param (dateiname + dateikennung) END PROC textzeile; PROC gib wartehinweis: page; out (hinweis [1]) END PROC gib wartehinweis; PROC formatiere (TEXT CONST dateiname, BOOL VAR mit fehler): TEXT VAR fonttabelle, zeileninhalt; kontrolliere existenz; stelle fonttabelle ein; schreibe font in die datei; zeilenformatierung; entferne ggf font aus der datei; stelle fonttabelle zurueck; streiche restleerzeilen weg; untersuche ggf datei auf korrektheit. kontrolliere existenz: IF NOT exists (dateiname) THEN page; errorstop ("'" + dateiname + "' " + fehlermeldung [1]) FI. stelle fonttabelle ein: gib wartehinweis; fonttabelle := fonttable; fonttable (stdfonttabelle). schreibe font in die datei: FILE VAR datei :: sequential file (modify, dateiname); to line (datei, 1); insert record (datei); write record (datei, dateieintrag + blank). zeilenformatierung: disable stop; lineform (dateiname); IF is error THEN clear error; mit fehler := TRUE ELSE mit fehler := FALSE FI; enable stop. entferne ggf font aus der datei: to line (datei, 1); read record (datei, zeileninhalt); IF pos (zeileninhalt, dateieintrag) > 0 THEN delete record (datei) FI. stelle fonttabelle zurueck: fonttable (fonttabelle). streiche restleerzeilen weg: REP streiche ggf letzte zeile UNTIL zeile ist nicht leer PER. streiche ggf letzte zeile: to line (datei, lines (datei)); read record (datei, zeileninhalt); IF compress (zeileninhalt) = "" THEN delete record (datei) FI. zeile ist nicht leer: compress (zeileninhalt) <> "". untersuche ggf datei auf korrektheit: IF NOT mit fehler THEN untersuche zeilenzahl FI. untersuche zeilenzahl: IF lines (datei) > maxzeilenzahl THEN page; out (hinweis [2] + text (maxzeilenzahl)); line; out (hinweis [3] + text (lines (datei))); line (2); errorstop (fehlermeldung [2]) ELSE page; out (hinweis [4]) FI. END PROC formatiere; PROC bereite den text auf (TEXT CONST dateiname): INT VAR zaehler; TEXT VAR zeileninhalt; FILE VAR f :: sequential file (modify, dateiname); gib wartehinweis; vernichte ggf aufbereitete datei; richte datei neu ein; uebertrage die zeilen. vernichte ggf aufbereitete datei: IF exists (dateiname + dateikennung) THEN forget (dateiname + dateikennung, quiet) FI. richte datei neu ein: FILE VAR aus :: sequential file (output, dateiname + dateikennung). uebertrage die zeilen: FOR zaehler FROM 1 UPTO lines (f) REP bereite eine zeile auf PER. bereite eine zeile auf: to line (f, zaehler); read record (f, zeileninhalt); ersetze alle gaensefuesschen; haenge ggf absatzmarke an; behandle zeile; putline (aus, zeileninhalt). ersetze alle gaensefuesschen: change all (zeileninhalt, """", "'"). haenge ggf absatzmarke an: IF (zeileninhalt SUB (length (zeileninhalt))) = blank THEN IF (zeileninhalt SUB 1) <> zentrierkennung THEN zeileninhalt CAT unblockkennung FI FI. behandle zeile: IF zeile soll zentriert werden THEN zentriere zeile ELIF zeile ist leerzeile THEN kennzeichne leerzeile ELSE blocke zeile auf stdlaenge FI. zeile soll zentriert werden: (zeileninhalt SUB 1) = zentrierkennung. zeile ist leerzeile: compress (zeileninhalt) = "". zentriere zeile: zeileninhalt := subtext (zeileninhalt, 2); zeileninhalt := anfangsblanks + zeileninhalt; zeilenabschluss. anfangsblanks: ((maxzeichenzahl - length (zeileninhalt)) DIV 2) * blank. zeilenabschluss: ersetze markierungszeichen; setze 13. ersetze markierungszeichen: change all (zeileninhalt, beginmarkkennung, """15"""); change all (zeileninhalt, endmarkkennung, """14"""). setze 13: zeileninhalt CAT " ""13""". kennzeichne leerzeile: zeileninhalt := """13""". blocke zeile auf stdlaenge: IF zeile darf nicht geblockt werden THEN ersetze endezeichen ELSE fuehre blockung aus FI. zeile darf nicht geblockt werden: (zeileninhalt SUB length (zeileninhalt)) = unblockkennung. ersetze endezeichen: zeileninhalt := subtext (zeileninhalt, 1, length (zeileninhalt) - 1); ersetze markierungszeichen; setze 13. fuehre blockung aus: ROW maxzeichenzahl INT VAR leerzeichen; INT VAR gezaehlte blanks, zu verteilende blanks; ordne anfangswerte zu; verteile blanks gleichmaessig; verteile blanks zufaellig; baue zeile zusammen; ersetze markierungszeichen; setze 13. ordne anfangswerte zu: bestimme blankanzahl in der zeile; bestimme zu verteilende blanks; initialisiere die reihung. bestimme blankanzahl in der zeile: gezaehlte blanks := 0; INT VAR zeiger; FOR zeiger FROM 1 UPTO length (zeileninhalt) REP IF (zeileninhalt SUB zeiger) = blank THEN gezaehlte blanks INCR 1 FI PER. bestimme zu verteilende blanks: zu verteilende blanks := maxzeichenzahl - length (zeileninhalt). initialisiere die reihung: FOR zeiger FROM 1 UPTO gezaehlte blanks REP leerzeichen [zeiger] := 1 PER. verteile blanks gleichmaessig: WHILE (zu verteilende blanks DIV gezaehlte blanks) > 0 REP schlag je ein blank auf; zu verteilende blanks DECR gezaehlte blanks PER. schlag je ein blank auf: FOR zeiger FROM 1 UPTO gezaehlte blanks REP leerzeichen [zeiger] INCR 1 PER. verteile blanks zufaellig: FOR zeiger FROM 1 UPTO zu verteilende blanks REP leerzeichen [random (1, gezaehlte blanks)] INCR 1 PER. baue zeile zusammen: TEXT VAR zwischen := zeileninhalt; INT VAR aktuelles blank := 0; zeileninhalt := ""; FOR zeiger FROM 1 UPTO length (zwischen) REP TEXT VAR aktuelles zeichen :: (zwischen SUB zeiger); IF aktuelles zeichen = blank THEN aktuelles blank INCR 1; zeileninhalt CAT (leerzeichen [aktuelles blank] * blank) ELSE zeileninhalt CAT aktuelles zeichen FI PER END PROC bereite den text auf; PROC erzeuge textprozedur (TEXT CONST dateiname, prozedurname): mache aus den zeilen einzeltexte; entferne ueberfluessige restzeilen; erstelle eine textprozedur. mache aus den zeilen einzeltexte: INT VAR zeiger; FILE VAR ausdatei :: sequential file (modify, dateiname + dateikennung); FOR zeiger FROM 1 UPTO lines (ausdatei) REP bearbeite eine zeile PER. bearbeite eine zeile: TEXT VAR zeileninhalt; to line (ausdatei, zeiger); read record (ausdatei, zeileninhalt); zeileninhalt := """ " + zeileninhalt + """ +"; change all (zeileninhalt, "­", "-"); write record (ausdatei, zeileninhalt). entferne ueberfluessige restzeilen: REP entferne ggf eine zeile UNTIL zeileninhalt <> """ ""13"""" +" PER; entferne return aus letzter zeile. entferne ggf eine zeile: IF compress (zeileninhalt) = """ ""13"""" +" THEN delete record (ausdatei) FI. entferne return aus letzter zeile: to line (ausdatei, lines (ausdatei)); read record (ausdatei, zeileninhalt); zeileninhalt := subtext (zeileninhalt, 1, length (zeileninhalt) - 6); write record (ausdatei, zeileninhalt). erstelle eine textprozedur: schreibe procanfang; schreibe procende. schreibe procanfang: to line (ausdatei, 1); insert record (ausdatei); write record (ausdatei, "TEXT PROC " + prozedurname + ":"). schreibe procende: to line (ausdatei, lines (ausdatei) + 1); insert record (ausdatei); write record (ausdatei, "END PROC " + prozedurname + ";"). END PROC erzeuge textprozedur; PROC erzeuge textzeile (TEXT CONST dateiname): entferne ueberfluessige restzeilen; entferne return aus letzter zeile; erstelle eine textzeile. entferne ueberfluessige restzeilen: TEXT VAR zeileninhalt; INT VAR zeiger; FILE VAR ausdatei :: sequential file (modify, dateiname + dateikennung); REP entferne ggf eine zeile UNTIL compress (zeileninhalt) <> """13""" PER. entferne ggf eine zeile: to line (ausdatei, lines (ausdatei)); read record (ausdatei, zeileninhalt); IF compress (zeileninhalt) = """13""" THEN delete record (ausdatei) FI. entferne return aus letzter zeile: to line (ausdatei, lines (ausdatei)); read record (ausdatei, zeileninhalt); change all (zeileninhalt, """13""", ""); write record (ausdatei, zeileninhalt). erstelle eine textzeile: haenge die zeilen aneinander; fasse zeile in gaensefuesschen; schreibe einzelzeile in ausgabedatei. haenge die zeilen aneinander: TEXT VAR zeile :: ""; FOR zeiger FROM 1 UPTO lines (ausdatei) REP to line (ausdatei, zeiger); read record (ausdatei, zeileninhalt); zeile CAT (" " + zeileninhalt) PER. fasse zeile in gaensefuesschen: zeile := """" + zeile + """"; change all (zeile, "­","-"). schreibe einzelzeile in ausgabedatei: forget (dateiname + dateikennung, quiet); FILE VAR fertig :: sequential file (modify, dateiname + dateikennung); to line (fertig, 1); insert record (fertig); write record (fertig, zeile) END PROC erzeuge textzeile; END PACKET ls menu generator 1;