aparler/RosettaCodeData
1
0
Fork 0
Code Issues 12 Pull requests 3 Projects Releases Packages Wiki Activity Actions

Data update

Browse source
This commit is contained in:
Ingy döt Net 2024-07-13 15:19:22 -07:00
parent 29a5eea0d4
commit 5c1bb7bfa9
2011 changed files with 35081 additions and 3229 deletions
Download patch file Download diff file Expand all files Collapse all files

81
Task/Draw-a-cuboid/PL-M/draw-a-cuboid.plm Normal file
View file

@ -0,0 +1,81 @@
100H: /* DRAW SOME CUBOIDS USING ASCII ART */
/* CP/M BDOS SYSTEM CALL AND I/O ROUTINES */
BDOS: PROCEDURE( FN, ARG ); DECLARE FN BYTE, ARG ADDRESS; GOTO 5; END;
PR$CHAR: PROCEDURE( C ); DECLARE C BYTE; CALL BDOS( 2, C ); END;
PR$NL: PROCEDURE; CALL PR$CHAR( 0DH ); CALL PR$CHAR( 0AH ); END;
/* TASK */
/* DRAWS A CUBOID STANDING ON ONE EDGE USING ASCII ART */
DRAW$CUBOID: PROCEDURE( H, W, L );
DECLARE ( H, W, L ) BYTE;
DECLARE ( I, J, FACE$WIDTH, EDGE$POS ) BYTE;
BACKSLASH: PROCEDURE; CALL PR$CHAR( 92 ); END; /* PRINTS A BACKSLASH */
REPEAT$CHAR: PROCEDURE( CH, COUNT ); /* PRINTS CH COUNT TIMES */
DECLARE ( CH, COUNT ) BYTE;
DECLARE I BYTE;
IF COUNT > 0 THEN DO;
DO I = 1 TO COUNT; CALL PR$CHAR( CH ); END;
END;
END REPEAT$CHAR;
UNDERSCORES: PROCEDURE( COUNT ); /* PRINTS COUNT UNDERSCORES */
DECLARE COUNT BYTE;
CALL REPEAT$CHAR( 95, COUNT );
END UNDERSCORES;
/* TOP LINE */
CALL REPEAT$CHAR( ' ', L ); CALL UNDERSCORES( W + 1 ); CALL PR$NL;
/* REST OF THE TOP FACE AND PART OF THE VISIBLE SIDE */
FACE$WIDTH = 0;
EDGE$POS = 0;
DO I = 1 TO L;
CALL REPEAT$CHAR( ' ', L - I );
CALL PR$CHAR( '/' );
IF I = L THEN CALL UNDERSCORES( W );
ELSE CALL REPEAT$CHAR( ' ', W );
CALL PR$CHAR( '/' );
EDGE$POS = EDGE$POS + 1;
IF EDGE$POS <= H THEN DO;
/* DRAW THE BACK EDGE */
FACE$WIDTH = 2 * ( EDGE$POS - 1 );
CALL REPEAT$CHAR( ' ', FACE$WIDTH );
CALL BACKSLASH;
END;
ELSE DO;
/* DRAW THE BOTTOM EDGE AND THE MORE OF THE VISIBLE SIDE */
CALL REPEAT$CHAR( ' ', FACE$WIDTH + 1 );
CALL PR$CHAR( '/' );
END;
CALL PR$NL;
END;
/* OTHER VISIBLE FACE */
DO I = 1 TO H;
CALL REPEAT$CHAR( ' ', I - 1 );
CALL BACKSLASH;
IF I = H THEN CALL UNDERSCORES( W );
ELSE CALL REPEAT$CHAR( ' ', W );
CALL BACKSLASH;
EDGE$POS = EDGE$POS + 1;
IF EDGE$POS <= H THEN DO;
/* DRAW THE BACK EDGE */
CALL REPEAT$CHAR( ' ', FACE$WIDTH + 1 );
CALL BACKSLASH;
END;
ELSE DO;
/* DRAW THE BOTTOM EDGE */
CALL REPEAT$CHAR( ' ', FACE$WIDTH );
FACE$WIDTH = FACE$WIDTH - 2;
CALL PR$CHAR( '/' );
END;
CALL PR$NL;
END;
END DRAW$CUBOID;
CALL DRAW$CUBOID( 3, 2, 4 );
CALL DRAW$CUBOID( 4, 3, 2 );
CALL DRAW$CUBOID( 2, 4, 3 );
CALL DRAW$CUBOID( 2, 3, 4 );
EOF