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;PACKETsimselherculesplotDEFINESbeginplot,endplot,clear,move,draw,stdhoehe,stdbreite,pen,plotend,zeichensatz,cursor,getcursor,out,terminalkorrekt,anpassungstyp,drawingarea,where,zeichenhoehe,zeichenbreite,systemimgraphicmodus,initstift,aktuellerstift,neuerstift,sekantenstift,normalenstift,tangentenstift,lotstift,punktstift:LEThorfaktor=30.6383,vertfaktor=19.33333,bit14=16384,anzahlx=720,anzahly=348;INT VARxalt,yalt;ROW5INT VARzaehler:=ROW5INT:(0,0,0,0,0),i:=zaehler;INT VARlinientyp:=0,foreground:=0,background:=0;INT VARdummy;LET ZEICHENSATZ=STRUCT(ROW255TEXTchar,INTwidth,height);PROCdrawingarea(REAL VARxcm,ycm,INT VARxpixel,ypixel):xcm:=23.5;ycm:=18.0;xpixel:=anzahlx-1;ypixel:=anzahly-1;END PROCdrawingarea;REAL PROCstdhoehe:0.72END PROCstdhoehe;REAL PROCstdbreite:0.29375END PROCstdbreite;PROCbeginplot:xalt:=0;yalt:=0;graphicon:=TRUE END PROCbeginplot;PROCendplot:END PROCendplot;PROCclear:control(-5,512,0,dummy);pen(0,1,0,1);move(0,0)END PROCclear;PROCplotend:control(-5,2,0,dummy);graphicon:=FALSE END PROCplotend;PROCpen(INT CONSTb,f,t,l):IF NOT(f=0)THENforeground:=1ELSEforeground:=0;FI;linientyp:=l;SELECTfOF CASE0:loeschstift;CASE1:sichtbarelinien;ENDSELECT.loeschstift:control(-9,0,0,dummy);control(-10,0,0,dummy).sichtbarelinien:SELECTlOF CASE0:CASE1:control(-9,4369,4369,dummy);control(-10,4369,4369,dummy)CASE2:control(-9,257,257,dummy);control(-10,257,257,dummy)CASE3:control(-9,17,17,dummy);control(-10,17,17,dummy)CASE4:control(-9,0,4369,dummy);control(-10,0,4369,dummy)CASE5:control(-9,256,4369,dummy);control(-10,256,4369,dummy)OTHERWISE:control(-9,4369,4369,dummy);control(-10,4369,4369,dummy)ENDSELECT.END PROCpen;PROCmove(INT CONSTx,y):xMOVEyEND PROCmove;PROCdraw(INT CONSTx,y):xDRAWyEND PROCdraw;ZEICHENSATZ VARzeichen;INT VARxfak,yfak;PROCzeichensatz(TEXT CONSTname):IFexists(name)THEN BOUND ZEICHENSATZ VARnewzeichen:=old(name);zeichen:=newzeichenELSEerrorstop("Der Zeichensatz "+name+" existiert nicht")FI END PROCzeichensatz;PROCdraw(TEXT CONSTrecord,REAL CONSTangle,height,width):INT CONSTxstep:=characterxstep,ystep:=characterystep;INT VARxpos:=xalt,ypos:=yalt,x0:=xalt,y0:=yalt,i,n,x,y;BOOL VARmoveorder;setcharacterheightandwidth;FORiFROM1UPTOlength(record)REPdrawcharacteriPER;x0MOVEy0.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)];FORnFROM1UPTOlength(char)DIV4REPvalue(char,n,x,y,moveorder);IFmoveorderTHENxpos+xMOVEypos+yELSExpos+xDRAWypos+yFI PER;xposINCRxstep;yposINCRystepEND 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):control(-7,x,347-y,dummy);xalt:=x;yalt:=yEND OP MOVE;OP DRAW(INT CONSTx,y):IFlinientyp>0THENcontrol(-11,foreground,zaehler(linientyp),i(linientyp));control(-6,xalt,347-yalt,dummy);control(-6,x,347-y,dummy);control(-11,foreground,zaehler(linientyp),i(linientyp));zaehler(linientyp):=((i(linientyp)-2)MOD16);FI;xalt:=x;yalt:=y;END OP DRAW;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;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;BOOL PROCterminalkorrekt:page;putline("Mit Ihrer Task können Sie nur an ");putline("Bildschirmen mit HERCULES-Karte arbeiten.");line;yes("Ist Ihr Bildschirm von diesem Typ")END PROCterminalkorrekt;TEXT PROCanpassungstyp:"hercules"END PROCanpassungstyp;PROCwhere(INT VARx,y):x:=xalt;y:=yaltEND PROCwhere;INT PROCzeichenbreite:9END PROCzeichenbreite;INT PROCzeichenhoehe:14END PROCzeichenhoehe;BOOL PROCsystemimgraphicmodus:graphiconEND PROCsystemimgraphicmodus;LETanzahlfktstifte=5;ROWanzahlfktstifteINT CONSTstiftpalette:=ROWanzahlfktstifteINT:(1,2,3,4,5);INT VARstiftzeiger:=0;PROCinitstift:stiftzeiger:=0END PROCinitstift;INT PROCneuerstift:stiftzeiger:=stiftzeigerMODanzahlfktstifte+1;aktuellerstiftEND PROCneuerstift;INT PROCaktuellerstift:stiftpalette(stiftzeiger)END PROCaktuellerstift;INT PROCsekantenstift:2END PROCsekantenstift;INT PROCnormalenstift:2END PROCnormalenstift;INT PROCtangentenstift:2END PROCtangentenstift;INT PROClotstift:2END PROClotstift;INT PROCpunktstift:1END PROCpunktstift;END PACKETsimselherculesplot;zeichensatz("ZEICHEN 9*14")
|
