1
2
3
4
5
|
PACKETdialoghilfenDEFINESscratchfunctionname,scroll,belegeparameter,schreibestatuszeile,schreibearbeitsfunktion,gibmeldung,gibinfofensteraus,warte,strich,definieredruckseitenformat,druckseitenformat,druckspalten,aufbereitetdrucken,druckversuch:LETniltext="",bell="�",carrreturn="
",beginmark="",endmark="",left="�",right="�",runter="
",hoch="�",hop="�",esc="�",blank=" ",unterstrichzeichen="_",systemname=" s c h u l i s - Mathematiksystem",niveau="Ebene ",seitenvorschub="#page#",stddruckbreite=45,stddrucklaenge=60;TEXT CONSTkurzerstrich:=25*unterstrichzeichen,basiszeile:=beginmark+systemname+44*blank+endmark;TEXT PROCscratchfunctionname:TEXT VARfunctionname:="hilfsfunktion";INT VARi:=1;WHILElistenposition(eigenefunktionen,functionname+text(i))<>nilREPiINCR1END REP;functionname+text(i)END PROCscratchfunctionname;PROCscroll(WINDOW VARw,TEXT CONSTdatname,INT CONSTxscroll,yscroll,horizontalscroll,INT VARerstersatz,erstespalte,TEXT CONSTsonderzeichen,TEXT VARausstiegzeichen):BOOL VARveraenderungderkopfzeilen:=TRUE,veraenderungdervariablenspalte:=TRUE;bestimmemaximalwertederdatei;bereiteausgabevor;REPzeigedateiausschnitt;IFsonderzeichen=niltextTHEN LEAVEscrollEND IF;werteeingabezeichenaus;veraenderungdervariablenspalte:=NOTveraenderungderkopfzeilenEND REP.bestimmemaximalwertederdatei:TEXT VARzeile;FILE VARf:=sequentialfile(input,datname);INT VARmaxspalten:=0,maxzeilen:=lines(f);WHILE NOTeof(f)REPgetline(f,zeile);IFlength(zeile)>maxspaltenTHENmaxspalten:=length(zeile)END IF END REP.bereiteausgabevor:INT CONSTbreite:=areaxsize(w),laenge:=areaysize(w),xbeginn:=areax(w),ybeginn:=areay(w),letzterzeilenanfang:=maxzeilen-laenge+yscroll,ausgabebreite:=breite-xscroll-1,ausgabelaenge:=laenge-yscroll+1,letzterspaltenanfang:=jenachdem;modify(f).jenachdem:INT VARsucher:=xscroll;WHILEsucher<maxspaltenREPsucherINCRhorizontalscrollEND REP;sucher-horizontalscroll.zeigedateiausschnitt:TEXT VARsatz,ausgabezeile;INT VARi,ypos;IFveraenderungderkopfzeilenTHENypos:=ybeginn;FORiFROM1UPTOyscroll-1REPtoline(f,i);readrecord(f,satz);ausgabezeile:=subtext(satz,1,xscroll-1);ausgabezeileCATsubtext(satz,erstespalte,erstespalte+ausgabebreite+1);cursor(xbeginn,ypos);out(text(ausgabezeile,breite));yposINCR1END REP ELSEypos:=ybeginn+yscroll-1END IF;i:=erstersatz;REPtoline(f,i);readrecord(f,satz);IFveraenderungdervariablenspalteTHENcursor(xbeginn,ypos);out(text(satz,xscroll-1,1))END IF;cursor(xbeginn+xscroll-1,ypos);out(text(satz,breite-xscroll+1,erstespalte));yposINCR1;iINCR1UNTILypos-ybeginn>laenge-1END REP.werteeingabezeichenaus:TEXT VARch;REPinchar(ch);IFch=leftTHEN IFerstespalte>xscrollTHENscrollelinksEND IF ELIFch=rightTHEN IFerstespalte<letzterspaltenanfangTHENscrollerechtsEND IF ELIFch=hochTHEN IFerstersatz>yscrollTHENscrollezurueckEND IF ELIFch=runterTHEN IFerstersatz<letzterzeilenanfangTHENscrollevorEND IF ELIFch=hopTHENinchar(ch);IFch=leftTHEN IFerstespalte>xscrollTHENblaetterelinksEND IF ELIFch=rightTHEN IFerstespalte<letzterspaltenanfangTHENblaettererechtsEND IF ELIFch=hochTHEN IFerstersatz>yscrollTHENblaetterezurueckEND IF ELIFch=runterTHEN IFerstersatz<letzterzeilenanfangTHENblaetterevorEND IF ELSEout(bell)END IF ELIFch=escTHENinchar(ausstiegzeichen);IFausstiegzeichen="1"CANDerstersatz>yscrollTHENspringeandenanfangELIFausstiegzeichen="9"CANDerstersatz<letzterzeilenanfangTHENspringeandasendeELIFpos(sonderzeichen,ausstiegzeichen)<>0THEN LEAVEscrollEND IF END IF END REP.scrollelinks:erstespalteDECRhorizontalscroll;erstespalte:=max(erstespalte,xscroll);veraenderungderkopfzeilen:=TRUE;LEAVEwerteeingabezeichenaus.scrollerechts:erstespalteINCRhorizontalscroll;erstespalte:=min(erstespalte,letzterspaltenanfang);veraenderungderkopfzeilen:=TRUE;LEAVEwerteeingabezeichenaus.scrollezurueck:erstersatzDECR1;veraenderungderkopfzeilen:=FALSE;LEAVEwerteeingabezeichenaus.scrollevor:erstersatzINCR1;veraenderungderkopfzeilen:=FALSE;LEAVEwerteeingabezeichenaus.blaetterelinks:erstespalteDECRausgabebreite;erstespalte:=max(erstespalte,xscroll);veraenderungderkopfzeilen:=TRUE;LEAVE
werteeingabezeichenaus.blaettererechts:erstespalteINCRausgabebreite;erstespalte:=min(erstespalte,letzterspaltenanfang);veraenderungderkopfzeilen:=TRUE;LEAVEwerteeingabezeichenaus.blaetterezurueck:erstersatzDECRausgabelaenge;erstersatz:=max(erstersatz,yscroll);veraenderungderkopfzeilen:=FALSE;LEAVEwerteeingabezeichenaus.blaetterevor:erstersatzINCRausgabelaenge;erstersatz:=min(erstersatz,letzterzeilenanfang);veraenderungderkopfzeilen:=FALSE;LEAVEwerteeingabezeichenaus.springeandenanfang:erstersatz:=yscroll;veraenderungderkopfzeilen:=FALSE;LEAVEwerteeingabezeichenaus.springeandasende:erstersatz:=max(yscroll,letzterzeilenanfang);veraenderungderkopfzeilen:=FALSE;LEAVEwerteeingabezeichenausEND PROCscroll;PROCbelegeparameter(VECTOR VARv,INT CONSTvarindex,LISTE CONSTvariablenliste,TEXT CONSTescapeausstieg,TEXT VARausstieg):TEXT VAReingabetext,ausstiegszeichen;INT CONSTende:=laenge(variablenliste),eingabelaenge:=40,scrollbeginn:=12;TEXT CONSTseparatoren:=hoch+runter;INT VARxpos,ypos,aktuellerparameterindex:=naechsterparameter(ende,varindex,0);getcursor(xpos,ypos);REPzeigeaktuellenparameter;editieredenaktuellenparameter;werteausstiegscodeausEND REP.zeigeaktuellenparameter:TEXT VARvariablenname:=text(NAMEauswahl(variablenliste,aktuellerparameterindex),8);variablennameCAT" = ";cursor(xpos,ypos);out(variablenname).editieredenaktuellenparameter:eingabetext:=compress(wandle(vSUBaktuellerparameterindex));eingabetextCATkurzerstrich;IFsystemimgraphicmodusTHENgrapheditget(eingabetext,scrollbeginn,escapeausstieg,ausstiegszeichen)ELSEout(beginmark);out(left);editget(eingabetext,eingabelaenge,scrollbeginn,separatoren,escapeausstieg,ausstiegszeichen);out(endmark)END IF.werteausstiegscodeaus:IFausstiegszeichen=niltextCORpos(hoch+runter+carrreturn,ausstiegszeichen)<>0THENchangeall(eingabetext,unterstrichzeichen,niltext);REAL VAReingegebenerwert:=realzahl(eingabetext);IF NOTiserrorTHENreplace(v,aktuellerparameterindex,eingegebenerwert);IFausstiegszeichen<>hochTHENaktuellerparameterindex:=naechsterparameter(ende,varindex,aktuellerparameterindex)ELSEaktuellerparameterindex:=letzterparameter(ende,varindex,aktuellerparameterindex)END IF ELSEclearerrorEND IF ELSE IFsystemimgraphicmodusTHENausstieg:=ausstiegszeichenELSEausstieg:=ausstiegszeichenSUB2END IF;IFpos(escapeausstieg,ausstieg)<>0THENchangeall(eingabetext,unterstrichzeichen,niltext);eingegebenerwert:=realzahl(eingabetext);IF NOTiserrorTHENreplace(v,aktuellerparameterindex,eingegebenerwert)ELSEclearerrorEND IF;LEAVEbelegeparameterEND IF END IF END PROCbelegeparameter;INT PROCnaechsterparameter(INT CONSTende,verboten,aktuellerwert):INT CONSTnaechsterwert:=aktuellerwertMODende+1;IFnaechsterwert=verbotenTHENnaechsterparameter(ende,verboten,aktuellerwert+1)ELSEnaechsterwertEND IF END PROCnaechsterparameter;INT PROCletzterparameter(INT CONSTende,verboten,aktuellerwert):INT CONSTnaechsterwert:=(aktuellerwert-2)MODende+1;IFnaechsterwert=verbotenTHENletzterparameter(ende,verboten,aktuellerwert-1)ELSEnaechsterwertEND IF END PROCletzterparameter;PROCschreibestatuszeile(TEXT CONSTverfahrensname):TEXT VARzeile:=basiszeile,teilbereich:=niveau+text(ebene)+" "+verfahrensname;replace(zeile,78-length(teilbereich),teilbereich);cursor(1,1);out(zeile)END PROCschreibestatuszeile;PROCschreibearbeitsfunktion(ABBILDUNG CONSTfkt):cursor(1,2);out(text(funktionsstring(fkt),80))END PROCschreibearbeitsfunktion;PROCstrich(INT CONSTzeile):cursor(1,zeile);out(79*waagerecht)END PROCstrich;PROCwarte:clearbuffer;footnote(anwendungstext(77));pauseEND PROCwarte;PROCgibmeldung(TEXT CONSTmeldung):WINDOW VARstdmeldungsfenster:=window(2,22,77,1);outframe(stdmeldungsfenster);out(stdmeldungsfenster,text(meldung,77));warte;page(stdmeldungsfenster,TRUE)END PROCgibmeldung;PROCgibinfofensteraus(WINDOW VARw,INT CONSTn):outframe(w);show(formular(n));warte;page(w,TRUE)END PROCgibinfofensteraus;ROW2INT VARdruckbreite:=ROW2INT:(stddruckbreite,stddruckbreite),drucklaenge:=ROW2INT:(stddrucklaenge,stddrucklaenge);PROCdefinieredruckseitenformat(INT CONST
breite,laenge):druckbreite(ebene):=breite;drucklaenge(ebene):=laengeEND PROCdefinieredruckseitenformat;INT PROCdruckspalten:druckbreite(ebene)END PROCdruckspalten;PROCdruckseitenformat(INT VARspalten,zeilen):spalten:=druckbreite(ebene);zeilen:=drucklaenge(ebene)END PROCdruckseitenformat;PROCaufbereitetdrucken(TEXT CONSTfname,ueberschrift,INT CONSTspaltenbeginn,zeilenbeginn,spaltenbreite):FILE VARf,fdruck;INT VARdateibreite,dateilaenge,i,j,verfuegbarerplatz,zulaessigebreite;TEXT CONSTneuername:=scratchdateiname;TEXT VARzeile,druckzeile;testeumfangderzudruckendendatei;bereitedateiauf;druckversuch(neuername);forget(neuername,quiet).testeumfangderzudruckendendatei:f:=sequentialfile(input,fname);dateilaenge:=lines(f);dateibreite:=0;WHILE NOTeof(f)REPgetline(f,zeile);IFlength(zeile)>dateibreiteTHENdateibreite:=length(zeile)END IF END REP;verfuegbarerplatz:=drucklaenge(ebene)-zeilenbeginn+1;IFueberschrift<>niltextTHENverfuegbarerplatzDECR2END IF;zulaessigebreite:=0;REPzulaessigebreiteINCRspaltenbreiteUNTILzulaessigebreite>druckbreite(ebene)-spaltenbeginn+1END REP;zulaessigebreiteDECRspaltenbreite.bereitedateiauf:INT VARspaltenpointer,zeilenpointer;modify(f);fdruck:=sequentialfile(output,neuername);spaltenpointer:=spaltenbeginn;WHILEspaltenpointer<dateibreiteREPschreibeseiten;spaltenpointerINCRzulaessigebreiteEND REP.schreibeseiten:zeilenpointer:=zeilenbeginn;REPschreibekopfzeilen;schreiberumpfzeilenEND REP.schreibekopfzeilen:putline(fdruck,seitenvorschub);IFueberschrift<>niltextTHENputline(fdruck,ueberschrift);line(fdruck)END IF;FORjFROM1UPTOzeilenbeginn-1REPdruckzeile:=niltext;toline(f,j);readrecord(f,zeile);druckzeileCATsubtext(zeile,1,spaltenbeginn-1);druckzeileCATsubtext(zeile,spaltenpointer,spaltenpointer+zulaessigebreite-1);putline(fdruck,druckzeile)END REP.schreiberumpfzeilen:FORiFROM1UPTOverfuegbarerplatzREPdruckzeile:=niltext;toline(f,zeilenpointer);readrecord(f,zeile);druckzeileCATsubtext(zeile,1,spaltenbeginn-1);druckzeileCATsubtext(zeile,spaltenpointer,spaltenpointer+zulaessigebreite-1);putline(fdruck,druckzeile);zeilenpointerINCR1;IFzeilenpointer>dateilaengeTHEN LEAVEschreibeseitenEND IF END REP END PROCaufbereitetdrucken;PROCdruckversuch(TEXT CONSTdatname):disablestop;print(datname);IFiserrorTHENgibmeldung(errormessage);clearerror;ELSEgibmeldung(anwendungstext(219))END IF END PROCdruckversuch;END PACKETdialoghilfen;
|
