(* 
        
          ********************************************************* 
          ********************************************************* 
          **                                                     ** 
          **                 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 <ESC> 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;{}