Create your own text control codes: Difference between revisions

Content added Content deleted
(→‎{{header|PL/M}}: Bug fix and tweaks)
Line 105: Line 105:


=={{header|PL/M}}==
=={{header|PL/M}}==
PL/M doesn't have a standard printf function, or indeed a standard library.
PL/M doesn't have a standard printf function or indeed, a standard library.
This sample implements a PRINTF procedure somewhat like the standard C library routine.<br><br>
This sample implements a PRINTF procedure somewhat like the standard C library routine.<br><br>
Although CP/M uses ASCII, Kildall's original 8080 PL/M compiler only supports a limited character set for the program's source. In particular the compiler doesn't like lowercase letters, % or \. PL/M also requires procedures to be called with the same number of parameters they were defined with. The PRINTF defined here has the format string plus seven parameters, if fewer parameters are required, additional dummy parameters must be supplied<br>
Although CP/M uses ASCII, Kildall's original 8080 PL/M compiler only supports a limited character set for the program's source. In particular the compiler doesn't like lowercase letters, % or \. PL/M also requires procedures to be called with the same number of parameters they were defined with. The PRINTF defined here has the format string plus seven parameters, if fewer parameters are required, additional dummy parameters must be supplied<br>
Line 162: Line 162:
DECLARE B BYTE;
DECLARE B BYTE;
DECLARE D BYTE;
DECLARE D BYTE;
D = SHR( B, 4 );
IF ( D := SHR( B, 4 ) ) > 9 THEN CALL PR$CHAR( ( D - 10 ) + 'A' );
⚫
ELSE CALL PR$CHAR( D + '0' );
⚫
IF D > 9
THEN CALL PR$CHAR( ( D - 10 ) + 'A' );
IF ( D := B AND 0FH ) > 9 THEN CALL PR$CHAR( ( D - 10 ) + 'A' );
ELSE CALL PR$CHAR( D + '0' );
ELSE CALL PR$CHAR( D + '0' );
D = B AND 0FH;
IF D > 9
THEN CALL PR$CHAR( ( D - 10 ) + 'A' );
⚫
ELSE CALL PR$CHAR( D + '0' );
END PR$HEX ;
END PR$HEX ;
/* RETURNS A CONVERTED TO LOWERCASE, IF NECESSARY */
TO$LOWER: PROCEDURE( A )BYTE;
⚫
DECLARE A BYTE;
⚫
IF A >= 'A' AND A <= 'Z' THEN RETURN ( A + 32 ); ELSE RETURN A;
END TO$LOWER;


DECLARE FRAME LITERALLY '''/''';
DECLARE FRAME LITERALLY '''/''';
DECLARE P ( 7 )ADDRESS;
DECLARE P ( 7 )ADDRESS;
DECLARE FPTR ADDRESS;
DECLARE FPTR ADDRESS;
DECLARE ( PPOS, FCH BASED FPTR ) BYTE;
DECLARE ( PPOS, FCH BASED FPTR, IN$LOWERCASE ) BYTE;
P( 0 ) = A; P( 1 ) = B; P( 2 ) = C; P( 3 ) = D;
P( 0 ) = A; P( 1 ) = B; P( 2 ) = C; P( 3 ) = D;
P( 4 ) = E; P( 5 ) = F; P( 6 ) = G;
P( 4 ) = E; P( 5 ) = F; P( 6 ) = G;
Line 181: Line 182:
FPTR = FMT;
FPTR = FMT;
DO WHILE( FCH <> '$' );
DO WHILE( FCH <> '$' );
IF FCH <> FRAME THEN DO;
IF FCH <> FRAME THEN DO; /* NOT A FORMAT FRAME */
/* NOT A FORMAT FRAME */
CALL PR$CHAR( FCH );
CALL PR$CHAR( FCH );
END;
END;
ELSE DO;
ELSE DO; /* IS A FORMAT FRAME */
/* FORMAT FRAME */
FPTR = FPTR + 1;
FPTR = FPTR + 1;
IF FCH = 'S' THEN DO;
IF ( IN$LOWERCASE := FCH = 'L' ) THEN FPTR = FPTR + 1;
/* STRING */
IF FCH = 'C' OR FCH = 'S' THEN DO;
CALL PR$STRING( P( PPOS ) );
/* CHARACTER OR STRING OPTIONALLY CONVERTED TO LOWER CASE */
PPOS = PPOS + 1;
IF FCH = 'C' THEN DO; /* CHARACTER */
END;
IF IN$LOWERCASE THEN CALL PR$CHAR( TO$LOWER( P( PPOS ) ) );
ELSE IF FCH = 'C' THEN DO;
ELSE CALL PR$CHAR( P( PPOS ) );
/* CHARACTER */
END;
CALL PR$CHAR( LOW( P( PPOS ) ) );
ELSE IF NOT IN$LOWERCASE THEN DO; /* STRING AS-IS */
PPOS = PPOS + 1;
CALL PR$STRING( P( PPOS ) );
END;
END;
ELSE IF FCH = 'L' THEN DO;
ELSE DO; /* LOWERCASE STRING */
/* CHARACTER OR STRING CONVERTED TO LOWER CASE */
DECLARE V BYTE;
FPTR = FPTR + 1;
IF FCH = 'S' THEN DO;
/* LOWERCASE STRING */
DECLARE SPTR ADDRESS;
DECLARE SPTR ADDRESS;
DECLARE SCH BASED SPTR BYTE;
DECLARE SCH BASED SPTR BYTE;
SPTR = P( PPOS );
SPTR = P( PPOS );
DO WHILE( ( V := SCH ) <> '$' );
DO WHILE( SCH <> '$' );
IF V >= 'A' AND V <= 'Z' THEN V = V + 32;
CALL PR$CHAR( TO$LOWER( SCH ) );
CALL PR$CHAR( V );
SPTR = SPTR + 1;
SPTR = SPTR + 1;
END;
END;
END;
ELSE DO;
/* LOWERCASE CHARACTER */
V = LOW( P( PPOS ) );
⚫
IF V >= 'A' AND V <= 'Z' THEN V = V + 32;
CALL PR$CHAR( V );
END;
END;
PPOS = PPOS + 1;
PPOS = PPOS + 1;
Line 242: Line 229:
PPOS = PPOS + 1;
PPOS = PPOS + 1;
END;
END;
ELSE IF FCH = 'O' THEN DO;
ELSE IF FCH = 'O' THEN DO; /* UNSIGNED OCTAL INTEGER */
/* UNSIGNED OCTAL INTEGER */
CALL PR$OCTAL( P( PPOS ) );
CALL PR$OCTAL( P( PPOS ) );
PPOS = PPOS + 1;
PPOS = PPOS + 1;
END;
END;
ELSE IF FCH = 'N' THEN DO;
ELSE IF FCH = 'N' THEN DO; /* NEWLINE */
/* PRINT NEWLINE */
CALL PR$NL;
CALL PR$NL;
END;
END;
ELSE DO;
ELSE DO; /* ANYTHING ELSE - JUST PRINT IT */
/* ANYTHING ELSE - JUST PRINT IT */
CALL PR$CHAR( FCH );
CALL PR$CHAR( FCH );
END /* IF VARIOUS FRAMES;; */ ;
END /* IF VARIOUS FRAMES;; */ ;
Line 260: Line 244:
END PRINTF ;
END PRINTF ;


/* TEST PRINTF */
DECLARE ( P3, P4, P5, P6, P7 ) ADDRESS;
DECLARE ( P3, P4, P5, P6, P7 ) ADDRESS;
P3 = 301; P4, P5, P6 = 0;
P3 = 301; P4, P5, P6 = 0;
P3 = - P3;
P3 = - P3; P4 = P4 - 1; P5 = P5 - 2; P6 = P6 - 3; P7 = 65535;
P4 = P4 - 1; P5 = P5 - 2; P6 = P6 - 3;
P7 = 65535;
CALL PRINTF( .'HELLO, /S/C /I/$ /D /U /X./N(END)/O/N$'
CALL PRINTF( .'HELLO, /S/C /I/$ /D /U /X./N(END)/O/N$'
, .'WORLD$', 33, P3, P4, P5, P6, P7
, .'WORLD$', 33, P3, P4, P5, P6, P7
Line 271: Line 254:
, 'E', 'L', 'L', 'O', .'ORLD$', 33, 0
, 'E', 'L', 'L', 'O', .'ORLD$', 33, 0
);
);

EOF</lang>
EOF</lang>
{{out}}
{{out}}
Retrieved from "https://rosettacode.org/wiki/Create_your_own_text_control_codes"