MCVSMOrgel_1 MiscellaneousCvOrgel_1gClick to insert.7m(10 %> f    >  @@@@CCC@@@@   *X_IN9Y_IN4.5Z_IN27NR_STEPS3 NR_OCTAVES3 PROCEDURE orgel; CONST PAGE_WIDTH = 210; PAGE_HEIGHT = 297; VAR nrOkt, nrEbe, i, n : INTEGER; x, y, z, ax, ay : REAL; sizex : REAL; PROCEDURE flInit; BEGIN PenSize(1); PenPat(-1); PenFore(0,0,65535); END; PROCEDURE slInit; BEGIN PenSize(1); PenPat(1); PenFore(65535,65535,65535); PenBack(0,65535,0); END; {* ---------------------------------------------- *} {* drawC *} {* ---------------------------------------------- *} PROCEDURE drawC(VAR px, py, x, y, z : REAL); BEGIN {* init pen fr faltlinien*} flInit; MoveTo(px, py); Line(x,0); MoveTo(px, py+y); Line(x,0); MoveTo(px, py+y+z); Line(5/6*x,0); {* init pen fr schnittlinien*} slInit; MoveTo(px, py); Line(0, y + z ); MoveTo(px + x, py); Line(0, y + 1/3*z); END; {* ---------------------------------------------- *} {* procedure drawD *} {* ---------------------------------------------- *} PROCEDURE drawD(VAR px, py, x, y, z : REAL); BEGIN {* init pen fr faltlinien*} flInit; MoveTo(px, py); Line(x, 0); MoveTo(px, py+y); Line(x,0); MoveTo(px-1/6*x, py + y + 1/3*z); Line(1/3*x, 0); MoveTo(px-1/6*x, py + y + 1/3*z + y/2); Line(1/3*x, 0); MoveTo(px-1/6*x, py + y + z + y/2); Line(1/3*x, 0); MoveTo(px+1/6*x, py + y + z); Line(2/3*x, 0); {* init pen fr schnittlinien *} slInit; MoveTo(px-1/6*x, py + y + 1/3*z); Line(0, y/2 + 2/3*z); MoveTo(px+1/6*x, py + y + 1/3*z); Line(0, y/2 + 2/3*z); MoveTo(px+x, py); Line(0, y + 1/3*z); END; {* ---------------------------------------------- *} {* procedure drawE *} {* ---------------------------------------------- *} PROCEDURE drawE(VAR px, py, x, y, z : REAL); BEGIN {* init pen fr faltlinien*} flInit; MoveTo(px, py); Line(x, 0); MoveTo(px, py+y); Line(x,0); MoveTo(px-1/6*x, py + y + 1/3*z); Line(1/3*x, 0); MoveTo(px-1/6*x, py + y + 1/3*z + y/2); Line(1/3*x, 0); MoveTo(px-1/6*x, py + y + z + y/2); Line(1/3*x, 0); MoveTo(px+1/6*x, py + y + z); Line(5/6*x, 0); {* init pen fr schnittlinien *} slInit; MoveTo(px-1/6*x, py + y + 1/3*z); Line(0, y/2 + 2/3*z); MoveTo(px+1/6*x, py + y + 1/3*z); Line(0, y/2 + 2/3*z); MoveTo(px+x, py); Line(0, y + z); END; {* ---------------------------------------------- *} {* procedure drawOktave *} {* ---------------------------------------------- *} PROCEDURE drawOktave(VAR px, py, x, y, z : REAL); VAR ax, ay : REAL; BEGIN ax := px; ay := py; drawC(ax, ay, x, y, z); ax := ax + x; drawD(ax, ay, x, y, z); ax := ax + x; drawE(ax, ay, x, y, z); ax := ax + x; drawC(ax, ay, x, y, z); ax := ax + x; drawD(ax, ay, x, y, z); ax := ax + x; drawD(ax, ay, x, y, z); ax := ax + x; drawE(ax, ay, x, y, z); END; {* ---------------------------------------------- *} {* main block of procedure doofiUfgab *} {* ---------------------------------------------- *} BEGIN x := PX_IN; y := PY_IN; z := PZ_IN; nrOkt := PNR_OCTAVES; nrEbe := PNR_STEPS; ax := 0 - 7*x*nrOkt/2; ay := 0 - z - (y+y/2+z+y+y/2)/2*(nrEbe - 1); FOR i := 1 TO nrEbe DO BEGIN FOR n := 1 TO nrOkt DO BEGIN drawOktave(ax, ay, x, y, z); ax := ax + 7*x; END; ax := 0 - 7*x*nrOkt/2; IF (i < nrEbe) THEN BEGIN {* init pen fr faltlinien*} flInit; MoveTo(ax, ay + y + z + y); Line( 7*x*nrOkt , 0); {* init pen fr schnittlinien *} slInit; MoveTo(ax, ay + y + z); Line(0 , y + y/2); MoveTo(ax + 7*x*nrOkt, ay + y + z); Line(0 , y + y/2); END; ay := ay+ (y+y/2+z+y); END; END; RUN(orgel); xyz# Stufen # Oktaven