1
2
3
|
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;PACKETvgaplotDEFINESdrawingarea,beginplot,endplot,plotend,stdhoehe,stdbreite,terminalkorrekt,clear,pen,move,draw,cursor,getcursor,out,zeichensatz:LEThorfaktor=29.09091,vertfaktor=35.0365,anzahlx=640,anzahly=480,delete=0,nothing=0,durchgehend=1,gepunktet=2,kurzgestrichelt=3,langgestrichelt=4,strichpunkt=5,colourcode=256,xpixel=640,ypixel=480,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 VGA-Karte (oder eine kompatible");putline("Karte) unterstützt werden.");line;yes("Ist Ihr Bildschirm von diesem Typ")END PROCterminalkorrekt;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 VARxpixel,ypixel):xcm:=22.0;ycm:=13.7;xpixel:=anzahlx-1;ypixel:=anzahly-1;END 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,17,0,dummy);control(-4,0,colourcode,dummy);actthick:=0;END PROCclear;PROCpen(INT CONSTbackground,foreground,thickness,linetype):actthick:=thickness;control(-8,linetypecode,foregroundcode,dummy).linetypecode:SELECTlinetypeOF CASEnothing:0CASEdurchgehend:-1CASEgepunktet:21845CASEkurzgestrichelt:3855CASElanggestrichelt:255CASEstrichpunkt:4351OTHERWISElinetypeEND SELECT.foregroundcode:IFforeground=deleteTHEN0ELIFforeground<0THEN128ELSEforegroundFI.END PROCpen;PROCmove(INT CONSTx,y):xMOVEy;pos:=POS:(x,y)END PROCmove;PROCdraw(INT CONSTx,y):INT VARxx:=x,yy:=y;pos.xDRAWpos.y;grenzkontrolle(xx,yy);control(-6,xx,ypixel-1-yy,dummy);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;BOOL VARmoveorder;setcharacterheightandwidth;FORiFROM1UPTOlength(record)REPdrawcharacteriPER;pos.xMOVEpos.y.setcharacterheightandwidth:IFwidth=0.0ANDheight=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)];INT VARxold:=xpos,yold:=ypos;FORnFROM1UPTOlength(char)DIV4REPvalue(char,n,x,y,moveorder);IFmoveorderTHENxpos+xMOVEypos+y;ELSExoldDRAWyold;xpos+xDRAWypos+yFI;xold:=xpos+x;yold:=ypos+y;PER;xposINCRxstep;yposINCRystep.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,ypixel-1-ywert,dummy)END OP MOVE;OP DRAW(INT CONSTx,y):INT VARxwert:=x,ywert:=y;
grenzkontrolle(xwert,ywert);control(-6,xwert,ypixel-1-ywert,dummy)END OP DRAW;PROCgrenzkontrolle(INT VARx,y):INT VARxwert,ywert;IFx>xpixel-1THENxwert:=xpixel-1ELIFx<0THENxwert:=0ELSExwert:=xFI;IFy>ypixel-1THENywert:=ypixel-1ELIFy<0THENywert:=0ELSEywert:=yFI;x:=xwert;y:=ywert;END PROCgrenzkontrolle;PROCout(TEXT CONSTtext):TEXT VARtextcopy:=text;IF NOTgraphiconTHENoldout(text)ELSEneuesoutFI.neuesout:INT CONSTxpos:=(spalte-1)*zeichen.width,ypos:=anzahly-(zeile*zeichen.height);pruefetext;loeschealtentext;gibneuentextaus.pruefetext:IFspalte+(LENGTHtext)-1>anzahlxDIVzeichen.widthTHENtextcopy:=subtext(text,1,anzahlxDIVzeichen.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>anzahlxDIVzeichen.widthTHENspalte:=anzahlxDIVzeichen.widthELIFa<=0THENspalte:=1ELSEspalte:=aFI;IFb>anzahlyDIVzeichen.heightTHENzeile:=anzahlyDIVzeichen.heightELIFb<=0THENzeile:=1ELSEzeile:=bFI ELSEoldcursor(a,b)FI END PROCcursor;END PACKETvgaplot;zeichensatz("ZEICHEN 8*19")
|
