99 lines
2.5 KiB
Text
99 lines
2.5 KiB
Text
/* MAYAN NUMERALS IN PL/M
|
|
|
|
THIS PROGRAM RUNS UNDER CP/M AND TAKES THE NUMBER ON THE COMMAND LINE */
|
|
100H:
|
|
/* CP/M CALLS */
|
|
BDOS: PROCEDURE (FN, ARG); DECLARE FN BYTE, ARG ADDRESS; GO TO 5; END BDOS;
|
|
EXIT: PROCEDURE; CALL BDOS(0,0); END EXIT;
|
|
PRINT: PROCEDURE (S); DECLARE S ADDRESS; CALL BDOS(9,S); END PRINT;
|
|
|
|
/* CP/M COMMAND LINE */
|
|
DECLARE CL$PTR ADDRESS INITIAL (80H), CMD$LEN BASED CL$PTR BYTE;
|
|
DECLARE CMD$PTR ADDRESS INITIAL (81H), CMD$LINE BASED CMD$PTR BYTE;
|
|
|
|
/* THE PIPE AND AT SYMBOLS ARE NOT INCLUDED IN THE PL/M CHARSET */
|
|
DECLARE PIPE LITERALLY '7CH', AT LITERALLY '40H';
|
|
|
|
/* PRINT BORDER FOR N DIGITS */
|
|
BORDER: PROCEDURE (N);
|
|
DECLARE (I, N) BYTE;
|
|
DO I=1 TO N;
|
|
CALL PRINT(.'+----$');
|
|
END;
|
|
CALL PRINT(.('+',13,10,'$'));
|
|
END BORDER;
|
|
|
|
/* PRINT LINE FOR GIVEN DIGIT */
|
|
DIGIT$LINE: PROCEDURE (LINE, DIGIT);
|
|
DECLARE (I, LINE, DIGIT, UPB) BYTE;
|
|
DECLARE PARTS (6) ADDRESS;
|
|
PARTS(0) = .(PIPE,' $'); PARTS(1) = .(PIPE,' . $');
|
|
PARTS(2) = .(PIPE,' .. $'); PARTS(3) = .(PIPE,'... $');
|
|
PARTS(4) = .(PIPE,'....$'); PARTS(5) = .(PIPE,'----$');
|
|
|
|
IF DIGIT = 0 THEN DO;
|
|
IF LINE = 3 THEN CALL PRINT(.(PIPE,' ',AT,' $'));
|
|
ELSE CALL PRINT(PARTS(0));
|
|
END;
|
|
ELSE DO;
|
|
UPB = 15-LINE*5;
|
|
IF DIGIT < UPB THEN CALL PRINT(PARTS(0));
|
|
ELSE IF DIGIT >= UPB+5 THEN CALL PRINT(PARTS(5));
|
|
ELSE CALL PRINT(PARTS(DIGIT-UPB));
|
|
END;
|
|
END DIGIT$LINE;
|
|
|
|
/* PRINT LINE GIVEN DIGITS */
|
|
LINE: PROCEDURE (L, DIGITS, NDIGITS);
|
|
DECLARE DIGITS ADDRESS;
|
|
DECLARE (L, I, D BASED DIGITS, NDIGITS) BYTE;
|
|
DO I=0 TO NDIGITS-1;
|
|
CALL DIGIT$LINE(L, D(I));
|
|
END;
|
|
CALL PRINT(.(PIPE,13,10,'$'));
|
|
END LINE;
|
|
|
|
/* CHECK FOR ARGUMENT */
|
|
IF CMD$LEN < 2 THEN DO;
|
|
CALL PRINT(.'NO INPUT$');
|
|
CALL EXIT;
|
|
END;
|
|
|
|
/* PREPROCESS COMMAND LINE - TURN EACH ASCII DIGIT INTO 0-9 */
|
|
DECLARE (I, J) BYTE;
|
|
DO I = 1 TO CMD$LEN-1;
|
|
CMD$LINE(I) = CMD$LINE(I) - '0';
|
|
IF CMD$LINE(I) > 9 THEN DO;
|
|
/* ERROR MESSAGE FOR INVALID INPUT */
|
|
CALL PRINT(.'INVALID DIGIT IN INPUT$');
|
|
CALL EXIT;
|
|
END;
|
|
END;
|
|
|
|
/* CONVERT TO BASE 20 DIGIT BY DIGIT */
|
|
J = CMD$LEN-2;
|
|
DO WHILE J > 0;
|
|
DO I = 1 TO J;
|
|
CMD$LINE(I+1) = CMD$LINE(I+1) + 10*(CMD$LINE(I) AND 1);
|
|
CMD$LINE(I) = CMD$LINE(I) / 2;
|
|
END;
|
|
J = J - 1;
|
|
END;
|
|
|
|
/* FIND FIRST NONZERO DIGIT */
|
|
J = 1;
|
|
DO WHILE CMD$LINE(J) = 0 AND J < CMD$LEN-1;
|
|
J = J + 1;
|
|
END;
|
|
|
|
/* PRINT CARTOUCHES */
|
|
DECLARE SIZE BYTE;
|
|
SIZE = CMD$LEN-J;
|
|
CALL BORDER(SIZE);
|
|
DO I=0 TO 3;
|
|
CALL LINE(I, .CMD$LINE(J), SIZE);
|
|
END;
|
|
CALL BORDER(SIZE);
|
|
|
|
CALL EXIT;
|
|
EOF
|