1
2
3
4
|
PACKETlsdialog1DEFINESwaagerecht,senkrecht,eckeobenlinks,eckeobenrechts,eckeuntenlinks,eckeuntenrechts,balkenunten,balkenoben,balkenlinks,balkenrechts,kreuz,cursoron,cursoroff,clearbuffer,clearbufferandcount,center,invers,page,pageup,outframe,outmenuframe,eraseframe,stdgraphicchar,ft20graphicchar,ibmgraphicchar,AREA,:=,fill,areax,areay,areaxsize,areaysize,cursor,getcursor,out,outinvers,outwithbeam,outinverswithbeam,erase,eraseinvers,erasewithbeam,writepermanentfootnote,oldfootnote,footnote:TYPE AREA=STRUCT(INTx,y,xsize,ysize);LETblank=" ",markein="",markaus="",cleol="�";TEXT CONSTfehlermeldung:="Unzulässige Größen!";TEXT VAReol:="+",eor:="+",eul:="+",eur:="+",bo:="+",br:="+",bl:="+",bu:="+",waa:="-",sen:="|",kr:="+",cursorsichtbar:="",cursorunsichtbar:="";TEXT VARpermanentefusszeile:="";PROCwritepermanentfootnote(TEXT CONSTt):permanentefusszeile:=t;footnote(t)END PROCwritepermanentfootnote;PROColdfootnote:footnote(permanentefusszeile)END PROColdfootnote;PROCfootnote(TEXT CONSTt):INT VARx,y;getcursor(x,y);cursor(1,24);out(invers(text(t,76)));cursor(x,y)END PROCfootnote;TEXT PROCeckeobenlinks:eolEND PROCeckeobenlinks;TEXT PROCeckeobenrechts:eorEND PROCeckeobenrechts;TEXT PROCeckeuntenlinks:eulEND PROCeckeuntenlinks;TEXT PROCeckeuntenrechts:eurEND PROCeckeuntenrechts;TEXT PROCbalkenoben:boEND PROCbalkenoben;TEXT PROCbalkenlinks:blEND PROCbalkenlinks;TEXT PROCbalkenrechts:brEND PROCbalkenrechts;TEXT PROCbalkenunten:buEND PROCbalkenunten;TEXT PROCwaagerecht:waaEND PROCwaagerecht;TEXT PROCsenkrecht:senEND PROCsenkrecht;TEXT PROCkreuz:krEND PROCkreuz;PROCeckeobenlinks(TEXT CONSTt):eol:=tEND PROCeckeobenlinks;PROCeckeobenrechts(TEXT CONSTt):eor:=tEND PROCeckeobenrechts;PROCeckeuntenlinks(TEXT CONSTt):eul:=tEND PROCeckeuntenlinks;PROCeckeuntenrechts(TEXT CONSTt):eur:=tEND PROCeckeuntenrechts;PROCbalkenoben(TEXT CONSTt):bo:=tEND PROCbalkenoben;PROCbalkenlinks(TEXT CONSTt):bl:=tEND PROCbalkenlinks;PROCbalkenrechts(TEXT CONSTt):br:=tEND PROCbalkenrechts;PROCbalkenunten(TEXT CONSTt):bu:=tEND PROCbalkenunten;PROCwaagerecht(TEXT CONSTt):waa:=tEND PROCwaagerecht;PROCsenkrecht(TEXT CONSTt):sen:=tEND PROCsenkrecht;PROCkreuz(TEXT CONSTt):kr:=tEND PROCkreuz;PROCstdgraphicchar:eckeobenlinks("+");eckeobenrechts("+");eckeuntenlinks("+");eckeuntenrechts("+");balkenoben("+");balkenrechts("+");balkenlinks("+");balkenunten("+");waagerecht("-");senkrecht("|");kreuz("+");cursorsichtbar:="";cursorunsichtbar:=""END PROCstdgraphicchar;PROCft20graphicchar:eckeobenlinks("�R��S");eckeobenrechts("�RD�S");eckeuntenlinks("�RH�S");eckeuntenrechts("�RL�S");balkenoben("�RP�S");balkenrechts("�RT�S");balkenlinks("�RX�S");balkenunten("�R\�S");waagerecht("�R`�S");senkrecht("�Rd�S");kreuz("�Rh�S");cursorsichtbar:="�-1";cursorunsichtbar:="�-0";ft20statuszeilenausEND PROCft20graphicchar;PROCft20statuszeilenaus:out("�.A")END PROCft20statuszeilenaus;PROCft20statuszeilenan:out("�.�")END PROCft20statuszeilenan;PROCibmgraphicchar:eckeobenlinks("�");eckeobenrechts("�");eckeuntenlinks("̈");eckeuntenrechts("�");balkenoben("̗");balkenrechts("ω");balkenlinks("�");balkenunten("̊");waagerecht("̊");senkrecht("�");kreuz("�");cursorsichtbar:="";cursorunsichtbar:=""END PROCibmgraphicchar;PROCcursoron:out(cursorsichtbar)END PROCcursoron;PROCcursoroff:out(cursorunsichtbar)END PROCcursoroff;PROCcursoron(TEXT CONSTt):cursorsichtbar:=tEND PROCcursoron;PROCcursoroff(TEXT CONSTt):cursorunsichtbar:=tEND PROCcursoroff;PROCclearbuffer:REP UNTILincharety=""PER END PROCclearbuffer;INT PROCclearbufferandcount(TEXT CONSTzeichen):INT VARzaehler:=0;TEXT VARzeichenkette:="",ch;IFzeichen=""THENclearbuffer;LEAVEclearbufferandcountWITH0FI;ermittlediezeichenkette;untersucheaufvorhandenezeichen;zaehler.ermittlediezeichenkette:REPch:=incharety(1);zeichenketteCATchUNTILch=""PER.untersucheaufvorhandenezeichen:INT VARi;FORiFROM1UPTOlength(zeichenkette)REP IFpos(subtext(zeichenkette,i),zeichen)=1THENzaehlerINCR1FI PER.END PROCclearbufferandcount;TEXT PROCcenter(INT CONSTxsize,TEXT CONSTt):TEXT VARzeile:=compress(t
);zeile:=((xsize-length(zeile))DIV2)*blank+zeile;zeileCAT(xsize-length(zeile))*blank;zeileEND PROCcenter;TEXT PROCcenter(TEXT CONSTt):center(79,t)END PROCcenter;TEXT PROCinvers(TEXT CONSTt):TEXT VARneu:=markein;neuCATt;neuCAT" ";neuCATmarkaus;neuEND PROCinvers;PROCpage(INT CONSTx,y,xsize,ysize):INT VARzeiger;IFx+xsize=80THENineinemstreichELSEputzevorsichtigFI;cursor(x,y).ineinemstreich:FORzeigerFROMyUPTOy+ysize-1REPcursor(x,zeiger);out(cleol)PER.putzevorsichtig:TEXT VARleerzeile:=xsize*blank;FORzeigerFROMyUPTOy+ysize-1REPcursor(x,zeiger);out(leerzeile)PER.END PROCpage;PROCpage(AREA CONSTa):page(a.x,a.y,a.xsize,a.ysize)END PROCpage;PROCpageup(INT CONSTx,y,xsize,ysize):INT VARzeiger;IFx+xsize=80THENineinemstreichELSEputzevorsichtigFI.ineinemstreich:FORzeigerFROMy+ysize-1DOWNTOyREPcursor(x,zeiger);out(cleol)PER.putzevorsichtig:TEXT VARleerzeile:=xsize*blank;FORzeigerFROMy+ysize-1DOWNTOyREPcursor(x,zeiger);out(leerzeile)PER.END PROCpageup;PROCpageup(AREA CONSTa):pageup(a.x,a.y,a.xsize,a.ysize)END PROCpageup;PROCoutframe(INT CONSTx,y,xsize,ysize):TEXT VARlinie:=(xsize-2)*waagerecht;INT VARzeiger;IFx<1CORy<1CORxsize<8CORysize<3CORx+xsize>80CORy+ysize>25THEN LEAVEoutframeFI;maleoben;maleseiten;maleunten.maleoben:cursor(x,y);out(eckeobenlinks);out(linie);out(eckeobenrechts).maleseiten:FORzeigerFROM1UPTOysize-2REPcursor(x,y+zeiger);out(senkrecht);cursor(x+xsize-1,y+zeiger);out(senkrecht)PER.maleunten:cursor(x,y+ysize-1);out(eckeuntenlinks);out(linie);out(eckeuntenrechts)END PROCoutframe;PROCoutframe(AREA CONSTa):IFa.x-1<1ORa.y-1<1ORa.xsize+2>79ORa.ysize+2>24ORa.x+a.xsize+1>80ORa.y+a.ysize+1>25THEN LEAVEoutframeFI;outframe(a.x-1,a.y-1,a.xsize+2,a.ysize+2)END PROCoutframe;PROCoutmenuframe(INT CONSTx,y,xsize,ysize):INT VARi;TEXT VARlinie;untersucheangaben;schreiberahmen.untersucheangaben:IFx<0CORy<0CORx+xsize>81CORy+ysize>26THEN LEAVEoutmenuframeFI.schreiberahmen:IFx=0CORy=0CORxsize=81CORysize=26THENlinie:=xsize*waagerecht;zeichnereduziertenrahmenELSElinie:=(xsize-2)*waagerecht;zeichnevollenrahmenFI.zeichnereduziertenrahmen:zeichneoberlinie;zeichneunterlinie.zeichneoberlinie:cursor(1,2);out(linie).zeichneunterlinie:cursor(1,23);out(linie).zeichnevollenrahmen:schreibekopf;schreiberumpf;schreibefuss;schreibekopfleiste;schreibefussleiste.schreibekopf:cursor(x,y);out(eckeobenlinks);out(linie);out(eckeobenrechts).schreiberumpf:FORiFROMy+1UPTOy+ysize-2REPcursor(x,i);out(senkrecht);cursor(x+xsize-1,i);out(senkrecht)PER.schreibefuss:cursor(x,y+ysize-1);out(eckeuntenlinks);out(linie);out(eckeuntenrechts).schreibekopfleiste:cursor(x,y+2);schreibebalkenlinie.schreibefussleiste:cursor(x,y+ysize-3);schreibebalkenlinie.schreibebalkenlinie:out(balkenlinks);out(linie);out(balkenrechts).END PROCoutmenuframe;PROCoutmenuframe(AREA CONSTa):outmenuframe(a.x-1,a.y-1,a.xsize+2,a.ysize+2)END PROCoutmenuframe;PROCeraseframe(INT CONSTx,y,xsize,ysize):INT VARzeiger;TEXT VARleerzeile:=xsize*blank;loescheoben;loescheseiten;loescheunten.loescheoben:cursor(x,y);out(leerzeile).loescheseiten:FORzeigerFROM1UPTOysize-2REPcursor(x,y+zeiger);out(blank);cursor(x+xsize-1,y+zeiger);out(blank)PER.loescheunten:cursor(x,y+ysize-1);out(leerzeile)END PROCeraseframe;OP:=(AREA VARziel,AREA CONSTquelle):CONCR(ziel):=CONCR(quelle)END OP:=;PROCfill(AREA VARziel,INT CONSTa,b,c,d):IFa<1CORb<1CORa>79CORb>24CORc<8CORd<1CORc>79CORd>24CORa+c>80CORb+d>25THENerrorstop(fehlermeldung)FI;ziel.x:=a;ziel.y:=b;ziel.xsize:=c;ziel.ysize:=dEND PROCfill;INT PROCareax(AREA CONSTa):a.xEND PROCareax;INT PROCareay(AREA CONSTa):a.yEND PROCareay;INT PROCareaxsize(AREA CONSTa):a.xsizeEND PROCareaxsize;INT PROCareaysize(AREA CONSTa):a.ysizeEND PROCareaysize;PROCout(TEXT CONSTt,INT CONSTbreite):outtext(t,1,breite)END PROCout;PROCerase(INT CONSTbreite):out(breite*blank)END PROCerase;PROCcursor(AREA CONSTa,INT CONSTspa,zei):cursor(a.x+spa-1,a.y+zei-1)END PROCcursor;PROCgetcursor(AREA CONSTa,INT VARspalte,zeile):INT VARx,y;getcursor(x,y);spalte:=x-a.x+1;zeile:=y-a.y+1END PROCgetcursor;PROCout(AREA CONSTa,INT CONSTspa
,zei,TEXT CONSTt):out(a,spa,zei,t,LENGTHt)END PROCout;PROCout(AREA CONSTa,INT CONSTspa,zei,TEXT CONSTt,INT CONSTlaenge):ueberpruefecursorangaben;positionierecursor;IFlaengeistzugrossTHENverkuerzteausgabeELSEouttext(t,1,laenge)FI.ueberpruefecursorangaben:IFspa>a.xsizeCORzei>a.ysizeCORspa<1CORzei<1THEN LEAVEoutFI.positionierecursor:cursor(a.x+spa-1,a.y+zei-1).laengeistzugross:laenge>a.xsize-spa+1.verkuerzteausgabe:outtext(t,1,a.xsize-spa+1)END PROCout;PROCerase(AREA CONSTa,INT CONSTspa,zei,INT CONSTlaenge):out(a,spa,zei,laenge*blank,laenge)END PROCerase;PROCoutinvers(AREA CONSTa,INT CONSTspa,zei,TEXT CONSTt):outinvers(a,spa,zei,t,LENGTHt)END PROCoutinvers;PROCoutinvers(AREA CONSTa,INT CONSTspa,zei,TEXT CONSTt,INT CONSTlaenge):ueberpruefecursorangaben;positionierecursor;TEXT VARhilf:=markein;IFlaengeistzugrossTHENhilfCATsubtext(t,1,a.xsize-spa-1);ELSEhilfCATtext(t,laenge)FI;hilfCATblank;hilfCATmarkaus;out(hilf).ueberpruefecursorangaben:IFspa>(a.xsize-4)CORzei>a.ysizeCORspa<2CORzei<1THEN LEAVEoutinversFI.positionierecursor:cursor(a.x+spa-2,a.y+zei-1).laengeistzugross:laenge>a.xsize-spa-1END PROCoutinvers;PROCeraseinvers(AREA CONSTa,INT CONSTspa,zei,INT CONSTlaenge):ueberpruefecursorangaben;positionierecursor;IFlaengeistzugrossTHENverkuerzteausgabeELSEerase(laenge+3)FI.ueberpruefecursorangaben:IFspa>(a.xsize-4)CORzei>a.ysizeCORspa<2CORzei<1THEN LEAVEeraseinversFI.positionierecursor:cursor(a.x+spa-2,a.y+zei-1).laengeistzugross:laenge>a.xsize-spa-1.verkuerzteausgabe:erase(a.xsize-spa+2).END PROCeraseinvers;PROCoutwithbeam(AREA CONSTa,INT CONSTspa,zei,TEXT CONSTt):outwithbeam(a,spa,zei,t,LENGTHt)END PROCoutwithbeam;PROCoutwithbeam(AREA CONSTa,INT CONSTspa,zei,TEXT CONSTt,INT CONSTlaenge):ueberpruefecursorangaben;positionierecursor;TEXT VARhilf:=senkrecht;hilfCAT" ";IFlaengeistzugrossTHENhilfCATsubtext(t,1,a.xsize-spa-2)ELSEhilfCATtext(t,laenge)FI;hilfCAT" ";hilfCATsenkrecht;out(hilf).ueberpruefecursorangaben:IFspa>a.xsize-7CORzei>a.ysizeCORspa<4CORzei<1THEN LEAVEoutwithbeamFI.positionierecursor:cursor(a.x+spa-4,a.y+zei-1).laengeistzugross:laenge>a.xsize-spa-2.END PROCoutwithbeam;PROCerasewithbeam(AREA CONSTa,INT CONSTspa,zei,INT CONSTlaenge):ueberpruefecursorangaben;positionierecursor;IFlaengeistzugrossTHENverkuerzteausgabeELSEerase(laenge+6)FI.ueberpruefecursorangaben:IFspa>a.xsize-7CORzei>a.ysizeCORspa<4CORzei<1THEN LEAVEerasewithbeamFI.positionierecursor:cursor(a.x+spa-4,a.y+zei-1).laengeistzugross:laenge>a.xsize-spa-2.verkuerzteausgabe:erase(a.xsize-spa+4).END PROCerasewithbeam;PROCoutinverswithbeam(AREA CONSTa,INT CONSTspa,zei,TEXT CONSTt):outinverswithbeam(a,spa,zei,t,LENGTHt)END PROCoutinverswithbeam;PROCoutinverswithbeam(AREA CONSTa,INT CONSTspa,zei,TEXT CONSTt,INT CONSTlaenge):ueberpruefecursorangaben;positionierecursor;TEXT VARhilf:=senkrecht;hilfCATblank;hilfCATmarkein;IFlaengeistzugrossTHENhilfCATsubtext(t,1,a.xsize-spa-2)ELSEhilfCATtext(t,laenge)FI;hilfCATblank;hilfCATmarkaus;hilfCATsenkrecht;out(hilf).ueberpruefecursorangaben:IFspa>a.xsize-7CORzei>a.ysizeCORspa<4CORzei<1THEN LEAVEoutinverswithbeamFI.positionierecursor:cursor(a.x+spa-4,a.y+zei-1).laengeistzugross:laenge>a.xsize-spa-2END PROCoutinverswithbeam;END PACKETlsdialog1;
|
