112 lines
4.3 KiB
Text
112 lines
4.3 KiB
Text
100H: /* DISCORDIAN DATE CALCULATION - TRANSLATION OF MAD (VIA ALGOL W) */
|
|
|
|
/* CP/M 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$STRING: PROCEDURE( S ); DECLARE S ADDRESS; CALL BDOS( 9, S ); END;
|
|
PR$NL: PROCEDURE; CALL PR$CHAR( 0DH ); CALL PR$CHAR( 0AH ); END;
|
|
PR$NUMBER: PROCEDURE( N ); /* PRINTS A NUMBER IN THE MINIMUN FIELD WIDTH */
|
|
DECLARE N ADDRESS;
|
|
DECLARE V ADDRESS, N$STR ( 6 )BYTE, W BYTE;
|
|
V = N;
|
|
W = LAST( N$STR );
|
|
N$STR( W ) = '$';
|
|
N$STR( W := W - 1 ) = '0' + ( V MOD 10 );
|
|
DO WHILE( ( V := V / 10 ) > 0 );
|
|
N$STR( W := W - 1 ) = '0' + ( V MOD 10 );
|
|
END;
|
|
CALL PR$STRING( .N$STR( W ) );
|
|
END PR$NUMBER;
|
|
|
|
/* COMMAND LINE */
|
|
DECLARE CL$ADDR LITERALLY '80H'; /* ADDRESS OF THE COMMAND LINE */
|
|
DECLARE CL$PTR ADDRESS; /* POINTER TO THE CURRENT COMMAND LINE CHAR */
|
|
DECLARE CL$CHAR BASED CL$PTR BYTE; /* CURRENT COMMAND LINE CHARACTER */
|
|
DECLARE CL$LEN ADDRESS; /* LENGTH OF THE COMMAND LINE */
|
|
|
|
/* INITIALISES THE COMMAND LINE VARIABLES */
|
|
CL$INIT: PROCEDURE;
|
|
CL$PTR = CL$ADDR;
|
|
CL$LEN = CL$CHAR;
|
|
CL$PTR = CL$PTR + 1;
|
|
END CL$INIT;
|
|
|
|
/* READS A NUMBER FROM THE COMMAND LINE, THE TERMINATOR IS IGNORED */
|
|
CL$NUMBER: PROCEDURE ADDRESS;
|
|
DECLARE N ADDRESS;
|
|
N = 0;
|
|
DO WHILE CL$PTR <= ( CL$ADDR + CL$LEN ) AND CL$CHAR = ' ';
|
|
CL$PTR = CL$PTR + 1;
|
|
END;
|
|
DO WHILE CL$PTR <= ( CL$ADDR + CL$LEN ) AND CL$CHAR >= '0'
|
|
AND CL$CHAR <= '9';
|
|
N = ( N * 10 ) + ( CL$CHAR - '0' );
|
|
CL$PTR = CL$PTR + 1;
|
|
END;
|
|
CL$PTR = CL$PTR + 1; /* SKIP THE CHARACTER THAT TERMINATED THE NUMBER */
|
|
RETURN N;
|
|
END CL$NUMBER;
|
|
|
|
/* TASK */
|
|
|
|
DECLARE HOLY5 ( 5 )ADDRESS;
|
|
DECLARE HOLY50 ( 5 )ADDRESS;
|
|
DECLARE DISDAY ( 5 )ADDRESS;
|
|
DECLARE DISSSN ( 5 )ADDRESS;
|
|
DECLARE MLENGT ( 13 )ADDRESS
|
|
INITIAL( 0, 0, 31, 59, 90, 120
|
|
, 151, 181, 212, 243, 273, 304, 334
|
|
);
|
|
|
|
HOLY5 (0) = .'MUNG$'; HOLY5 (1) = .'MOJO$'; HOLY5 (2) = .'SYA$';
|
|
HOLY5 (3) = .'ZARA$'; HOLY5 (4) = .'MALA$';
|
|
HOLY50(0) = .'CHAO$'; HOLY50(1) = .'DISCO$'; HOLY50(2) = .'CONFU$';
|
|
HOLY50(3) = .'BURE$'; HOLY50(4) = .'AF$';
|
|
DISDAY(0) = .'SWEETMORN$'; DISDAY(1) = .'BOOMTIME$';
|
|
DISDAY(2) = .'PUNGENDAY$'; DISDAY(3) = .'PRICKLE-PRICKLE$';
|
|
DISDAY(4) = .'SETTING ORANGE$';
|
|
DISSSN(0) = .'CHAOS$'; DISSSN(1) = .'DISCORD$'; DISSSN(2) = .'CONFUSION$';
|
|
DISSSN(3) = .'BUREAUCRACY$'; DISSSN(4) = .'THE AFTERMATH$';
|
|
|
|
/* GET THE GREGORIAN DATE FROM THE COMMAND LINE, NB: NO VALIDATION */
|
|
DECLARE ( GMONTH, GDAY, GYEAR ) ADDRESS; /* MUST BE IN MM/DD/YYYY FORMAT */
|
|
CALL CL$INIT;
|
|
GMONTH = CL$NUMBER; GDAY = CL$NUMBER; GYEAR = CL$NUMBER;
|
|
CALL PR$NUMBER( GMONTH );CALL PR$CHAR( '/' );CALL PR$NUMBER( GDAY );
|
|
CALL PR$CHAR( '/');CALL PR$NUMBER( GYEAR );CALL PR$NL;
|
|
|
|
/* CONVERT AND PRINT THE DATE */
|
|
IF GMONTH = 2 AND GDAY = 29
|
|
THEN DO;
|
|
CALL PR$STRING( .'SAINT TIB''S DAY IN THE Y.O.L.D. $' );
|
|
CALL PR$NUMBER( GYEAR + 1166 );
|
|
END;
|
|
ELSE DO;
|
|
DECLARE ( YRDAY, SEASON, DAY, WKDAY ) ADDRESS;
|
|
YRDAY = MLENGT(GMONTH)+GDAY;
|
|
SEASON = YRDAY / 73;
|
|
DAY = YRDAY-SEASON*73;
|
|
WKDAY = (YRDAY-1) MOD 5;
|
|
CALL PR$STRING( DISDAY(WKDAY) );
|
|
CALL PR$STRING( .', DAY $' );
|
|
CALL PR$NUMBER( DAY );
|
|
CALL PR$STRING( .' OF $' );
|
|
CALL PR$STRING( DISSSN(SEASON) );
|
|
CALL PR$STRING( .' IN THE Y.O.L.D $' );
|
|
CALL PR$NUMBER( GYEAR + 1166 );
|
|
IF DAY = 5 THEN DO;
|
|
CALL PR$NL;
|
|
CALL PR$STRING( .'CELEBRATE $' );
|
|
CALL PR$STRING( HOLY5(SEASON) );
|
|
CALL PR$STRING( .'DAY$' );
|
|
END;
|
|
ELSE IF DAY = 50 THEN DO;
|
|
CALL PR$NL;
|
|
CALL PR$STRING( .'CELEBRATE $' );
|
|
CALL PR$STRING( HOLY50(SEASON) );
|
|
CALL PR$STRING( .'FLUX$' );
|
|
END;
|
|
END;
|
|
CALL PR$NL;
|
|
|
|
EOF
|