From 04e68443040c7abad84d66477e98f93bed701760 Mon Sep 17 00:00:00 2001 From: Lars-Dominik Braun Date: Mon, 4 Feb 2019 13:09:03 +0100 Subject: Initial import --- app/schulis/2.2.1/src/5.felder | 263 +++++++++++++++++++++++++++++++++++++++++ 1 file changed, 263 insertions(+) create mode 100644 app/schulis/2.2.1/src/5.felder (limited to 'app/schulis/2.2.1/src/5.felder') diff --git a/app/schulis/2.2.1/src/5.felder b/app/schulis/2.2.1/src/5.felder new file mode 100644 index 0000000..3fd6225 --- /dev/null +++ b/app/schulis/2.2.1/src/5.felder @@ -0,0 +1,263 @@ +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; + -- cgit v1.2.3