PACKET felderDEFINES statfelder:LET statistikdatei="STATISTIK.", statistikserver="statistik server",maskefelderdefinieren= "mst statistik felder definieren",maskefelderbearbeiten= "mst statistik felder bearbeiten",maskefelderstandarddruck= "mst statistik felder standarddruck",statistikvorzeilen=3,maxstatistiken=200, maxspalten=50,minbreite=4,maxbreite=30,niltext="",space=" ",meldungzusatz="+" ,pruefeimintervall=3,fwarten=1,fstatnr=2,fuebertragen=3,ffeldnr=3,fzeile=4, fspalte=5,fart=6,fdef=7,fkopieren=8,fnaechstes=9,mnichterlaubt=34, mgibtesnicht=477,martangeben=478,mmussleerbleiben=491,mnureineauswahl=492, mspeichern=486,mnichtspeichern=487,muebernehmenfrage=493,mnichtgleichgross= 494,muebernehmen=495,msyntaxfehler=496,mdefzulang=497;FILE VAR stat;TEXT VAR statistikname;BOOL VAR statgeaendert;INT VAR zeilen,spalten,felder, letztemeldung,verlassentiefe;ROW maxspaltenINT VAR breiten;LET normalesende= FALSE ,klammeramende=TRUE ,fvergleicherwartet=1,fmerkmalerwartet=2, fvergleichsoperwartet=3,fkommaerwartet=4,ftexterwartet=5,fklammerzuerwartet=6 ,fbooloperwartet=7,ftextfeldsummiert=8,fdatumfalsch=9,fhierkeinjoker=10, frechenoperwartet=11,ffeldnrerwartet=12,ffeldnrzuhoch=13,fzubreit=14, fpatternzulang=15,fzahlfalsch=16,tendedestextes=7,tname=1,ttext=4,atext=1, adate=2,azahl=3,akurs=4,squote="""",snull="0",skomma=",",sgleich="=",sspace= " ",sgroesser=">",sklammerauf="(",skleiner="<",sklammerzu=")",sgroessergleich =">=",sfeld="f",skleinergleich="<=",skurs="kurs",sungleich="<>",smerkmal="m", sand="AND",sjoker="*",sor="OR",splus="+",sund="UND",sminus="-",soder="ODER"; TEXT VAR symbol;INT VAR type,fehlernr;BOOL VAR ok;PROC statfelder(INT CONST was):TEXT VAR bezeichnung,liste;INT VAR breite,hoehe,zaehler,status;SELECT wasOF CASE 1:felderbearbeitenstartprocCASE 2:felderbearbeitenspeichernCASE 3: felderbearbeitennaechstesfeldCASE 4:felderbearbeitenzumbeginnCASE 5: felderbearbeitenmerkmalslisteCASE 6:felderbearbeitendefinitionkopierenCASE 7: felderlistezeigenCASE 8:felderlistebearbeitenstartprocCASE 9: felderstandarddruckstartprocCASE 10:felderstandarddruckspeichernCASE 11: felderstandarddrucknichtspeichernCASE 12:felderlistestandarddruckstartproc CASE 13:felderlistestandarddruckspeichernCASE 14: felderlistestandarddrucknichtspeichernCASE 15: felderlistestandarddruckzumbeginnCASE 16:felderuebernehmenstartprocCASE 17: felderuebernehmenexecCASE 18:allefelderspeichernEND SELECT . felderbearbeitenstartproc:IF NOT statnummerokTHEN leave(1);ELIF standardmaskenfeld(fuebertragen)>niltextTHEN standardmeldung(mmussleerbleiben ,niltext);infeld(fuebertragen);leave(1);ELSE statistikladen(statnummer); standardstartproc(maskefelderbearbeiten);verlassentiefe:=0;feldbearbeiten(1); standardnproc;FI .felderbearbeitenspeichern:IF NOT feldeingabenokTHEN leave(1 );ELSE speicherefeldab;felderbearbeitennaechstesfeld;FI . felderbearbeitennaechstesfeld:IF NOT naechstefeldnummerokTHEN leave(1);ELIF compress(standardmaskenfeld(fnaechstes))=niltextTHEN felderbearbeitenzumbeginnELSE feldbearbeiten(int(standardmaskenfeld( fnaechstes)));leave(1);FI .felderbearbeitenzumbeginn:statistiksichern; standardstartproc(maskefelderdefinieren);standardmaskenfeld(statistikname, fstatnr);leave(2+verlassentiefe).allefelderspeichern:WHILE feldeingabenok CAND naechstefeldnummerokREP speicherefeldab;IF standardmaskenfeld(fnaechstes )=niltextTHEN felderbearbeitenzumbeginn;LEAVE allefelderspeichernELSE feldbearbeiten(int(standardmaskenfeld(fnaechstes)));FI ;PER ;leave(1). felderbearbeitenmerkmalsliste:WINDOW VAR w:=startwindow(40,23,77,1);open(w); bereitelisteauf;listeCAT "*";listeCAT auskunftstextende;auskunfterteilung( liste,w,FALSE );reorganizescreen;setlasteditvalues;leave(1).bereitelisteauf: liste:="Bez. Feld Länge";listeCAT auskunftstextende;FOR zaehlerFROM 1UPTO 50REP IF zaehler=39THEN listeCAT " davon Art 2";listeCAT auskunftstextende;listeCAT " Fach 2";listeCAT auskunftstextende;listeCAT " Kennung 4";listeCAT auskunftstextende;listeCAT " Klausur 1";listeCAT auskunftstextende;FI ;IF zaehler< 10THEN listeCAT "m0"ELSE listeCAT "m"FI ;listeCAT text(zaehler);listeCAT " = ";listeCAT text(statfeldname(zaehler),24);listeCAT text(statfeldlaenge( zaehler));listeCAT auskunftstextende;PER .felderbearbeitendefinitionkopieren: standardpruefe(pruefeimintervall,fkopieren,1,felder,niltext,status);IF status >0THEN infeld(status)ELSE felddefinitionzeigen(int(standardmaskenfeld( fkopieren)))FI ;leave(1).felderlistezeigen:letztemeldung:=0;statlistezeigen( int(standardmaskenfeld(fstatnr))).felderlistebearbeitenstartproc:IF highestentry(thesaurusauswahl)=1THEN statlistebearbeiten( maskefelderbearbeiten);statistikladen(statlisteeintrag);verlassentiefe:=1; feldbearbeiten(1);standardnproc;ELSE standardstartproc(maskefelderdefinieren) ;IF highestentry(thesaurusauswahl)>1THEN standardmeldung(mnureineauswahl, niltext);FI ;leave(2);FI .felderstandarddruckstartproc:IF NOT statnummerok THEN leave(1);ELIF standardmaskenfeld(fuebertragen)>niltextTHEN standardmeldung(mmussleerbleiben,niltext);infeld(fuebertragen);leave(1);ELSE statistikladen(statnummer);standardstartproc(maskefelderstandarddruck); spaltenbreiteneintragen;standardnproc;FI .felderstandarddruckspeichern:IF NOT spaltenbreitenokTHEN leave(1);ELSE spaltenbreitenspeichern; standardstartproc(maskefelderdefinieren);standardmeldung(mspeichern, statistikname+meldungzusatz);statistiksichern;standardmaskenfeld( statistikname,fstatnr);leave(2);FI .felderstandarddrucknichtspeichern: standardstartproc(maskefelderdefinieren);standardmeldung(mnichtspeichern, statistikname+meldungzusatz);statistikvergessen;standardmaskenfeld( statistikname,fstatnr);leave(2).felderlistestandarddruckstartproc: statlistebearbeiten(maskefelderstandarddruck);IF statlisteeintrag>niltext THEN statistikladen(statlisteeintrag);spaltenbreiteneintragen;standardnproc; ELSE standardstartproc(maskefelderdefinieren);IF letztemeldung=mspeichernOR letztemeldung=mnichtspeichernTHEN standardmeldung(letztemeldung,statistikname +meldungzusatz);FI ;leave(2);FI .felderlistestandarddruckspeichern:IF NOT spaltenbreitenokTHEN leave(1);ELSE standardmeldung(mspeichern,statistikname+ meldungzusatz);letztemeldung:=mspeichern;spaltenbreitenspeichern; statistiksichern;standardmaskenfeld(statistikname,fstatnr);enter(1);FI . felderlistestandarddrucknichtspeichern:standardmeldung(mnichtspeichern, statistikname+meldungzusatz);letztemeldung:=mnichtspeichern; statistikvergessen;enter(1).felderlistestandarddruckzumbeginn: statistikvergessen;enter(3).felderuebernehmenstartproc:standardpruefe( pruefeimintervall,fuebertragen,1,maxstatistiken,niltext,status);IF status>0 THEN infeld(status);leave(1);ELIF NOT statistikexistiert(uebernehmennummer) THEN standardmeldung(mgibtesnicht,uebernehmennummer+meldungzusatz);infeld( fuebertragen);leave(1);ELIF NOT statnummerokTHEN leave(1);ELIF diedefinitionensindnichtgleichgrossTHEN standardmeldung(mnichtgleichgross, niltext);leave(1);ELSE standardmeldung(muebernehmenfrage,niltext);feldschutz( fwarten);feldschutz(fstatnr);feldschutz(fuebertragen);infeld(fwarten); standardnproc;FI .diedefinitionensindnichtgleichgross:statistikladen( statnummer);hoehe:=zeilen;breite:=spalten;statistikvergessen;statistikladen( uebernehmennummer);statistikvergessen;hoehe<>zeilenOR breite<>spalten. felderuebernehmenexec:statistikladen(statnummer);tofirstrecord(stat); readrecord(stat,bezeichnung);statistikvergessen;statistikladen( uebernehmennummer);tofirstrecord(stat);writerecord(stat,bezeichnung);toline( stat,statistikvorzeilen);writerecord(stat,niltext);rename(statistikdatei+ uebernehmennummer,statistikdatei+statnummer);statistikname:=statnummer; statistiksichern;standardmeldung(muebernehmen,uebernehmennummer+meldungzusatz );feldfrei(fstatnr);feldfrei(fuebertragen);standardmaskenfeld(niltext, fuebertragen);infeld(fstatnr);leave(2).naechstefeldnummerok:IF compress( standardmaskenfeld(fnaechstes))=niltextTHEN standardmaskenfeld(niltext, fnaechstes);status:=0;ELSE standardpruefe(pruefeimintervall,fnaechstes,1, felder,niltext,status);FI ;IF status>0THEN infeld(status)FI ;status=0. feldeingabenok:status:=0;IF art=0THEN standardmeldung(mnichterlaubt,niltext); status:=fart;ELIF NOT definitionokTHEN status:=fdef;ELIF standardmaskenfeld( fkopieren)>niltextTHEN standardmeldung(mmussleerbleiben,niltext);status:= fkopieren;ELIF NOT naechstefeldnummerokTHEN status:=fnaechstes;FI ;IF status> 0THEN infeld(status);FI ;status=0.definitionok:SELECT artOF CASE 1: bedingungok(fdef)CASE 2:summeok(fdef)CASE 3:textok(fdef,breiten[int( standardmaskenfeld(fspalte))])OTHERWISE leerokEND SELECT .leerok:IF standardmaskenfeld(fdef)>niltextTHEN standardmeldung(martangeben,niltext); FALSE ELSE TRUE FI .art:IF standardmaskenfeld(fart)=niltextTHEN 4ELSE pos( "bst ",standardmaskenfeld(fart))FI .spaltenbreiteneintragen:input(stat); getline(stat,bezeichnung);get(stat,hoehe);get(stat,breite);standardmaskenfeld (text(statistikname,3),fstatnr);FOR zaehlerFROM 1UPTO spaltenREP tragespaltenwertein;feldfrei(breitenfeld+1);PER ;FOR zaehlerFROM spalten+1 UPTO maxspaltenREP standardmaskenfeld(space+space,breitenfeld); standardmaskenfeld(space+space,breitenfeld+1);feldschutz(breitenfeld+1);PER ; modify(stat);infeld(2);standardfelderausgeben;infeld(4).tragespaltenwertein: get(stat,breite);standardmaskenfeld(text(zaehler,2),breitenfeld); standardmaskenfeld(text(breite),breitenfeld+1).breitenfeld:(zaehler-1)MOD 10* 10+(zaehler-1)DIV 10*2+3.spaltenbreitenok:FOR zaehlerFROM 1UPTO spaltenREP standardpruefe(pruefeimintervall,breitenfeld+1,minbreite,maxbreite,niltext, status);UNTIL status>0PER ;IF status>0THEN infeld(status)FI ;status=0. spaltenbreitenspeichern:bezeichnung:=text(zeilen)+space+text(spalten)+space; FOR zaehlerFROM 1UPTO spaltenREP bezeichnungCAT text(int(standardmaskenfeld( breitenfeld+1)));bezeichnungCAT space;PER ;toline(stat,2);writerecord(stat, bezeichnung).statnummerok:standardpruefe(pruefeimintervall,fstatnr,1, maxstatistiken,niltext,status);IF status>0THEN infeld(status)ELIF NOT statistikexistiert(statnummer)THEN standardmeldung(mgibtesnicht,statnummer+ meldungzusatz);infeld(fstatnr);status:=fstatnrFI ;status=0.statnummer:text( int(standardmaskenfeld(fstatnr))).uebernehmennummer:text(int( standardmaskenfeld(fuebertragen))).END PROC statfelder;PROC statistikladen( TEXT CONST statnummer):INT VAR spaltenzaehler;forget(statistikdatei+ statnummer,quiet);fetch(statistikdatei+statnummer,task(statistikserver));stat :=sequentialfile(input,statistikdatei+statnummer);getline(stat,statistikname) ;get(stat,zeilen);get(stat,spalten);FOR spaltenzaehlerFROM 1UPTO spaltenREP get(stat,breiten[spaltenzaehler]);PER ;modify(stat);felder:=zeilen*spalten; statistikname:=statnummer;statgeaendert:=FALSE ;END PROC statistikladen;PROC statistiksichern:IF statgeaendertTHEN toline(stat,statistikvorzeilen); writerecord(stat,niltext);FI ;commanddialogue(FALSE );save(statistikdatei+ statistikname,task(statistikserver));commanddialogue(TRUE ); statistikvergessen;END PROC statistiksichern;PROC statistikvergessen:forget( statistikdatei+statistikname,quiet);END PROC statistikvergessen;BOOL PROC statistikexistiert(TEXT CONST statnummer):exists(statistikdatei+statnummer, task(statistikserver))END PROC statistikexistiert;PROC feldbearbeiten(INT CONST feldnummer):standardmaskenfeld(text(statistikname,3),fstatnr); standardmaskenfeld(text(feldnummer,4),ffeldnr);standardmaskenfeld(text(( feldnummer-1)DIV spalten+1,2),fzeile);standardmaskenfeld(text((feldnummer-1) MOD spalten+1,2),fspalte);IF feldnummer250THEN standardmaskenfeld(bedingung, maskenfeld);standardmeldung(mdefzulang,niltext);ELSE standardmaskenfeld( bedingung,maskenfeld);bedingungIN maskenfeld;FI ;okEND PROC bedingungok;TEXT PROC normbedingung(BOOL CONST endeklammerzu):TEXT VAR bedingung:=niltext, operator;INT VAR merkmal;IF type=tendedestextesTHEN fehler(fvergleicherwartet );ELIF symbol=sklammeraufTHEN behandleklammerELIF symbol=skursTHEN behandlekursELSE behandlemerkmalFI ;IF NOT okTHEN ELIF type<>tendedestextes THEN liesverknuepfungoderklammerzuELIF endeklammerzuTHEN fehler( fklammerzuerwartet);FI ;bedingung.behandleklammer:naechstessymbol;bedingung:= sklammerauf+normbedingung(klammeramende)+sklammerzu.behandlemerkmal: liesmerkmal;liesoperator;IF okTHEN bedingungCAT textderlaenge(statfeldlaenge( merkmal),statfeldart(merkmal),operator);FI .liesmerkmal:merkmal:=int(subtext( symbol,2,3));IF type=tnameAND length(symbol)=3AND (symbolSUB 1)=smerkmalAND merkmal>=1AND merkmal<=50AND lastconversionokTHEN bedingungCAT symbol; naechstessymbol;ELSE fehler(fmerkmalerwartet);FI .liesoperator:IF symbol= sgleichOR symbol=sgroesserOR symbol=sgroessergleichOR symbol=sungleichOR symbol=skleinerOR symbol=skleinergleichTHEN bedingungCAT sspace;bedingungCAT symbol;bedingungCAT sspace;operator:=symbol;ELIF okTHEN fehler( fvergleichsoperwartet);FI .behandlekurs:naechstessymbol;IF symbol=sgleich THEN bedingungCAT skurs+sspace+sgleich+sspace;bedingungCAT textderlaenge(2, akurs,sgleich);lieskomma;bedingungCAT textderlaenge(2,akurs,sgleich); lieskomma;bedingungCAT textderlaenge(4,akurs,sgleich);lieskomma;bedingungCAT textderlaenge(1,akurs,sgleich);ELSE fehler(fvergleichsoperwartet)FI . lieskomma:IF symbol=skommaTHEN bedingungCAT symbol;ELIF okTHEN fehler( fkommaerwartet);FI .liesverknuepfungoderklammerzu:IF endeklammerzuAND symbol= sklammerzuTHEN naechstessymbol;ELIF symbol=sandOR symbol=sundOR symbol=sorOR symbol=soderTHEN bedingungCAT sspace;bedingungCAT symbol;bedingungCAT sspace; naechstessymbol;bedingungCAT normbedingung(endeklammerzu);ELSE fehler( fbooloperwartet);FI .END PROC normbedingung;TEXT PROC textderlaenge(INT CONST laenge,art,TEXT CONST operator):TEXT VAR textsammler:=niltext;IF ok THEN sammletextteile;normieretext;textanhaengen;FI ;textsammler. sammletextteile:REP naechstessymbol;IF type=ttextTHEN textsammlerCAT symbol ELIF symbol=sjokerTHEN textsammlerCAT symbolELSE fehler(ftexterwartet);FI ; naechstessymbol;UNTIL NOT okOR symbol<>splusPER .normieretext:SELECT artOF CASE atext:textbehandelnCASE adate:datumbehandelnCASE azahl:zahlbehandeln CASE akurs:kursbehandelnEND SELECT .textbehandeln:WHILE pos(textsammler, sjoker+sjoker)>0REP change(textsammler,sjoker+sjoker,sjoker);PER ;IF pos( textsammler,sjoker)=0THEN textsammler:=text(textsammler,laenge);ELIF operator <>sgleichTHEN fehler(fhierkeinjoker);ELIF length(textsammler)>laengeTHEN fehler(fpatternzulang);FI .datumbehandeln:textsammler:=datum(datum( textsammler));IF textsammler=niltextTHEN fehler(fdatumfalsch);FI . zahlbehandeln:textsammler:=text(int(subtext(textsammler,1,4)));IF length( textsammler)>laengeOR textsammler=niltextOR NOT lastconversionokTHEN fehler( fzahlfalsch)ELSE textsammler:=(laenge-length(textsammler))*snull+textsammler; FI .kursbehandeln:IF pos(textsammler,sjoker)=0THEN textsammler:=text( textsammler,laenge);ELIF length(textsammler)<>1THEN fehler(fhierkeinjoker); FI .textanhaengen:IF textsammler<>sjokerTHEN changeall(textsammler,squote, squote+squote);textsammler:=squote+textsammler+squote;FI .END PROC textderlaenge;BOOL PROC summeok(INT CONST maskenfeld):TEXT VAR summe:=niltext ;ok:=TRUE ;fehlernr:=0;scan(standardmaskenfeld(maskenfeld));summenormieren; IF NOT okTHEN standardmeldung(msyntaxfehler,fehlermeldung+meldungzusatz); ELIF length(summe)>250THEN standardmaskenfeld(summe,maskenfeld); standardmeldung(mdefzulang,niltext);ELSE standardmaskenfeld(summe,maskenfeld) ;summeIN maskenfeld;FI ;ok.summenormieren:naechstessymbol;REP IF symbol=splus OR symbol=sminusTHEN summeCAT sspace;summeCAT symbol;naechstessymbol;ELIF summe>niltextTHEN fehler(frechenoperwartet);FI ;INT CONST feldnr:=int(subtext (symbol,2,5));IF okTHEN IF type=tnameCAND lastconversionokCAND (symbolSUB 1)= sfeldCAND (symbolSUB 2)<>snullCAND feldnr>=1CAND feldnr<=felderCAND NOT isttextfeldTHEN summeCAT sspace;summeCAT symbol;naechstessymbol;ELIF feldnr> felderTHEN fehler(ffeldnrzuhoch);ELIF isttextfeldTHEN fehler( ftextfeldsummiert);ELIF okTHEN fehler(ffeldnrerwartet);FI ;FI ;UNTIL type= tendedestextesOR NOT okPER ;summe:=subtext(summe,2).isttextfeld:toline(stat, statistikvorzeilen+feldnr);subtext(stat,minbreite+1,minbreite+1)="t".END PROC summeok;BOOL PROC textok(INT CONST maskenfeld,feldbreite):TEXT VAR tex:= compress(standardmaskenfeld(maskenfeld));fehlernr:=0;ok:=TRUE ;scan(tex); naechstessymbol;IF type=tendedestextesTHEN tex:=squote+squoteELIF pos(symbol, sjoker)>0THEN fehler(fhierkeinjoker)ELIF type<>ttextTHEN fehler(ftexterwartet );ELIF length(symbol)>feldbreiteTHEN fehler(fzubreit);ELSE naechstessymbol; IF type<>tendedestextesTHEN fehler(ftexterwartet);FI ;FI ;IF NOT okTHEN standardmeldung(msyntaxfehler,fehlermeldung+meldungzusatz);ELSE standardmaskenfeld(tex,maskenfeld);texIN maskenfeld;FI ;ok.END PROC textok; PROC naechstessymbol:nextsymbol(symbol,type);END PROC naechstessymbol;PROC fehler(INT CONST nummer):ok:=FALSE ;fehlernr:=nummer;END PROC fehler;TEXT PROC fehlermeldung:SELECT fehlernrOF CASE fvergleicherwartet: "Vergleich erwartet"CASE fmerkmalerwartet:"Merkmal m01 bis m50 erwartet"CASE fvergleichsoperwartet:"=, >, <, >=, <= oder <> erwartet"CASE fkommaerwartet: "Komma erwartet"CASE ftexterwartet:"""Text"" erwartet"CASE fklammerzuerwartet :"')' erwartet"CASE fbooloperwartet:"'UND' oder 'ODER' erwartet"CASE ftextfeldsummiert:"Text-Feld in der Summenformel"CASE fdatumfalsch: "Datum nicht zulässig"CASE fhierkeinjoker:"'*' nicht zulässig"CASE frechenoperwartet:"'+' oder '-' erwartet"CASE ffeldnrerwartet: "Feldnummer (z.B. f17) erwartet"CASE ffeldnrzuhoch:"Feldnummer zu hoch"CASE fzubreit:"Text länger als Spaltenbreite"CASE fpatternzulang: "Pattern für das Merkmal zu lang"CASE fzahlfalsch:"Zahl falsch angegeben" OTHERWISE niltextEND SELECT END PROC fehlermeldung;END PACKET felder;