1
2
3
4
|
PACKEToldproceduresDEFINESoldcursor,oldgetcursor,oldout:PROColdcursor(INT CONSTa,b):cursor(a,b)END PROColdcursor;PROColdgetcursor(INT VARa,b):getcursor(a,b)END PROColdgetcursor;PROColdout(TEXT CONSTtext):out(text)END PROColdoutEND PACKEToldprocedures;PACKETegaplotDEFINESdrawingarea,beginplot,endplot,plotend,stdhoehe,stdbreite,terminalkorrekt,anpassungstyp,clear,pen,move,draw,cursor,getcursor,out,zeichensatz,where,zeichenbreite,zeichenhoehe,systemimgraphicmodus,initstift,aktuellerstift,neuerstift,sekantenstift,normalenstift,tangentenstift,lotstift,punktstift:LEThorfaktor=29.09091,vertfaktor=25.54745,delete=0,nothing=0,durchgehend=1,gepunktet=2,kurzgestrichelt=3,langgestrichelt=4,strichpunkt=5,colourcode=256,xpixel=640,ypixel=350,ykonst=349,xkonst=639,bit14=16384;LET POS=STRUCT(INTx,y);LET ZEICHENSATZ=STRUCT(ROW255TEXTchar,INTwidth,height);ZEICHENSATZ VARzeichen;INT VARactthick:=0,dummy;POS VARpos:=POS:(0,0);REAL VARbuchstabenhoehe:=0.5422916,buchstabenbreite:=0.275;BOOL PROCterminalkorrekt:page;putline("Mit Ihrer Task können Sie nur an Graphik-Bildschirmen");putline("arbeiten, die durch die EGA-Karte (oder eine kompatible");putline("Karte) unterstützt werden.");line;yes("Ist Ihr Bildschirm von diesem Typ")END PROCterminalkorrekt;TEXT PROCanpassungstyp:"ega"END PROCanpassungstyp;PROCzeichensatz(TEXT CONSTname):IFexists(name)THEN BOUND ZEICHENSATZ VARnewzeichen:=old(name);zeichen:=newzeichen;ELSEerrorstop("Der Zeichensatz "+name+" existiert nicht")FI END PROCzeichensatz;PROCdrawingarea(REAL VARxcm,ycm,INT VARx,y):xcm:=22.0;ycm:=13.7;x:=xkonst;y:=ykonstEND PROCdrawingarea;REAL PROCstdhoehe:buchstabenhoeheEND PROCstdhoehe;REAL PROCstdbreite:buchstabenbreiteEND PROCstdbreite;PROCbeginplot:graphicon:=TRUE ENDPROCbeginplot;PROCendplot:ENDPROCendplot;PROCplotend:control(-5,3,0,dummy);graphicon:=FALSE ENDPROCplotend;PROCclear:control(-5,16,0,dummy);actthick:=0;END PROCclear;PROCpen(INT CONSTbackground,foreground,thickness,linetype):actthick:=thickness;control(-8,-1,foregroundcode,dummy).foregroundcode:IFforeground=deleteTHEN0ELSElinetypecodeFI.linetypecode:SELECTlinetypeOF CASEnothing:0CASEdurchgehend:15CASEgepunktet:13CASEkurzgestrichelt:12CASElanggestrichelt:11CASEstrichpunkt:10OTHERWISElinetypeEND SELECT.END PROCpen;PROCmove(INT CONSTx,y):xMOVEy;pos:=POS:(x,y)END PROCmove;PROCdraw(INT CONSTx,y):xDRAWy;pos:=POS:(x,y)END PROCdraw;INT VARxfak:=zeichen.width,yfak:=zeichen.height;PROCdraw(TEXT CONSTrecord,REAL CONSTangle,height,width):INT CONSTxstep:=characterxstep,ystep:=characterystep;INT VARxpos:=pos.x,ypos:=pos.y,i,n,x,y,xold:=xpos,yold:=ypos;BOOL VARmoveorder;setcharacterheightandwidth;FORiFROM1UPTOlength(record)REPdrawcharacteriPER;xoldMOVEyold;pos.x:=xold;pos.y:=yold.setcharacterheightandwidth:IFwidth=0.0CANDheight=0.0THENxfak:=zeichen.width;yfak:=zeichen.heightELSExfak:=int(horfaktor*width+0.5);yfak:=int(vertfaktor*height+0.5)FI.characterxstep:IFwidth<>0.0THENint(cosd(angle)*horfaktor*width+0.5)ELSEint(cosd(angle)*real(zeichen.width)+0.5)FI.characterystep:IFheight<>0.0THENint(sind(angle)*vertfaktor*height+0.5)ELSEint(sind(angle)*real(zeichen.height)+0.5)FI.drawcharacteri:IFcode(recordSUBi)<32THENsteuerzeichenELSEnormalezeichenFI.steuerzeichen:IFcode(recordSUBi)=7THENoldout("�")FI.normalezeichen:TEXT CONSTchar:=zeichen.char[code(recordSUBi)];pos.xMOVEpos.y;FORnFROM1UPTOlength(char)DIV4REPvalue(char,n,x,y,moveorder);IFmoveorderTHENxpos+xMOVEypos+y;ELSExpos+xDRAWypos+yFI;pos.x:=xpos+x;pos.y:=ypos+yPER;xposINCRxstep;yposINCRystep;pos.x:=xpos;pos.y:=ypos;.END PROCdraw;PROCdraw(TEXT CONSTrecord):draw(record,0.0,0.0,0.0)END PROCdraw;PROCvalue(TEXT CONSTchar,INT CONSTn,INT VARx,y,BOOL VARmove):x:=charISUBn+n-1;y:=charISUBn+n;IFx<0THEN IF(xANDbit14)<>0THENmove:=FALSE ELSEmove:=TRUE;x:=xXORbit14FI ELSE IF(xANDbit14)<>0THENmove:=TRUE;x:=xXORbit14ELSEmove:=FALSE FI FI;x:=(x*xfak)DIVzeichen.width;y:=(y*yfak)DIVzeichen.heightEND PROCvalue;OP MOVE(INT CONSTx,y):INT VARxwert:=x,ywert:=y;grenzkontrolle(xwert,ywert);control(-7,xwert,ykonst-ywert,
dummy)END OP MOVE;OP DRAW(INT CONSTx,y):INT VARxwert:=x,ywert:=y,anfang:=ykonst-pos.y,ziel;grenzkontrolle(xwert,ywert);ziel:=ykonst-ywert;IFgeradelinienTHENcontrol(-6,pos.x,anfang,dummy);control(-6,xwert,ziel,dummy)ELSEcontrol(-6,xwert,ziel,dummy);control(-6,pos.x,anfang,dummy);control(-7,xwert,ziel,dummy)END IF.geradelinien:xwert=pos.xCORywert=pos.yEND OP DRAW;PROCgrenzkontrolle(INT VARx,y):IFx>xkonstTHENx:=xkonstELIFx<0THENx:=0END IF;IFy>ykonstTHENy:=ykonstELIFy<0THENy:=0FI END PROCgrenzkontrolle;PROCout(TEXT CONSTtext):TEXT VARtextcopy:=text;IF NOTgraphiconTHENoldout(text)ELSEneuesoutFI.neuesout:INT CONSTxpos:=(spalte-1)*zeichen.width,ypos:=ypixel-(zeile*zeichen.height);pruefetext;loeschealtentext;gibneuentextaus.pruefetext:IFspalte+(LENGTHtext)-1>xpixelDIVzeichen.widthTHENtextcopy:=subtext(text,1,xpixelDIVzeichen.width-spalte+1)FI.loeschealtentext:IFcode(textcopySUB1)>31THENclearFI.clear:INT CONSTxbis:=xpos+(LENGTHtextcopy)*zeichen.width-1;INT VARi;pen(0,0,0,1);FORiFROM0UPTOzeichen.height-1REPmove(xpos,ypos+i);draw(xbis,ypos+i)PER;move(xpos,ypos);pen(0,1,0,1).gibneuentextaus:draw(textcopy);cursor(spalte+(LENGTHtextcopy),zeile)END PROCout;INT VARzeile:=1,spalte:=1;BOOL VARgraphicon:=FALSE;PROCgetcursor(INT VARa,b):IFgraphiconTHENa:=spalte;b:=zeileELSEoldgetcursor(a,b)FI END PROCgetcursor;PROCcursor(INT CONSTa,b):IFgraphiconTHEN IFa>xpixelDIVzeichen.widthTHENspalte:=xpixelDIVzeichen.widthELIFa<=0THENspalte:=1ELSEspalte:=aFI;IFb>ypixelDIVzeichen.heightTHENzeile:=ypixelDIVzeichen.heightELIFb<=0THENzeile:=1ELSEzeile:=bFI ELSEoldcursor(a,b)FI END PROCcursor;PROCwhere(INT VARx,y):x:=pos.x;y:=pos.yEND PROCwhere;INT PROCzeichenbreite:8END PROCzeichenbreite;INT PROCzeichenhoehe:14END PROCzeichenhoehe;BOOL PROCsystemimgraphicmodus:graphiconEND PROCsystemimgraphicmodus;LETanzahlfktstifte=14;ROWanzahlfktstifteINT CONSTstiftpalette:=ROWanzahlfktstifteINT:(14,2,3,4,9,8,7,6,5,13,12,11,10,1);INT VARstiftzeiger:=0;PROCinitstift:stiftzeiger:=0END PROCinitstift;INT PROCneuerstift:stiftzeiger:=stiftzeigerMODanzahlfktstifte+1;aktuellerstiftEND PROCneuerstift;INT PROCaktuellerstift:stiftpalette(stiftzeiger)END PROCaktuellerstift;INT PROCsekantenstift:12END PROCsekantenstift;INT PROCnormalenstift:12END PROCnormalenstift;INT PROCtangentenstift:12END PROCtangentenstift;INT PROClotstift:10END PROClotstift;INT PROCpunktstift:12END PROCpunktstift;END PACKETegaplot;zeichensatz("ZEICHEN 8*14")
|
