Mayan numerals: Difference between revisions

Content added Content deleted

Inline

@@ Line 2,632: / Line 2,632: @@
 | style="border: solid black 2px;background-color: #fffff0;border-bottom: double 6px;border-radius: 1em;-moz-border-radius: 1em;-webkit-border-radius: 1em;vertical-align: bottom;width: 3.25em;" | ●
 |}
+=={{header|PL/M}}==
+<lang plm>/* MAYAN NUMERALS IN PL/M
+   THIS PROGRAM RUNS UNDER CP/M AND TAKES THE NUMBER ON THE COMMAND LINE */
+H:
+/* 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</lang>
+{{out}}
+<pre style='height:50ex;'>A>MAYAN 4005
++----+----+----+
+|    |    |    |
+|    |    |    |
+|----|    |    |
+|----| @  |----|
++----+----+----+
+A>MAYAN 8017
++----+----+----+----+
+|    |    |    | .. |
+|    |    |    |----|
+|    |    |    |----|
+| .  | @  | @  |----|
++----+----+----+----+
+A>MAYAN 326205
++----+----+----+----+----+
+|    |    |    |    |    |
+|    |    |----|    |    |
+|    |    |----|----|    |
+| .. | @  |----|----|----|
++----+----+----+----+----+
+A>MAYAN 886205
++----+----+----+----+----+
+|    |    |    |    |    |
+|    |    |----|    |    |
+|    |----|----|----|    |
+|----|----|----|----|----|
++----+----+----+----+----+
+A>MAYAN 18380658207197784
++----+----+----+----+----+----+----+----+----+----+----+----+----+
+|    |    |    |....|    |    |    |    |    |....|    |    |    |
+|    |    |....|----|....|    |    |    |....|----|....|    |    |
+|    |....|----|----|----|....|    |....|----|----|----|....|    |
+|....|----|----|----|----|----|....|----|----|----|----|----|....|
++----+----+----+----+----+----+----+----+----+----+----+----+----+</pre>
 =={{header|Phix}}==