You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
124 lines
3.0 KiB
124 lines
3.0 KiB
\ Pretty printing in the terminal with ANSI escape codes
|
|
: .BOLD ( -- ) s\" \033[1m" TYPE ;
|
|
: .NORMAL ( -- ) s\" \033[0m" TYPE ;
|
|
|
|
\ Print number and left align with spaces
|
|
: L.R ( n pad -- )
|
|
2 - SWAP 10 \ decrement pad by 1 and set widthCheck to 10
|
|
BEGIN 2DUP >= 2OVER DROP 0 >= AND WHILE \ while number >= widthCheck and pad >= 0
|
|
ROT 1- -ROT 10 * \ decrement pad and multiply widthCheck by 10
|
|
REPEAT
|
|
DROP . \ print the number
|
|
DUP 0 <= IF DROP EXIT THEN \ quit early if pad is less than or equal to 0
|
|
SPACES ; \ emit `pad` number of spaces
|
|
|
|
: DMY ( -- day month year ) TIME&DATE 2ROT 2DROP 2SWAP NIP -ROT ;
|
|
|
|
: NUM-TO-MONTH ( monthNum -- monthStr )
|
|
CASE
|
|
1 OF S" January" ENDOF
|
|
2 OF S" February" ENDOF
|
|
3 OF S" March" ENDOF
|
|
4 OF S" April" ENDOF
|
|
5 OF S" May" ENDOF
|
|
6 OF S" June" ENDOF
|
|
7 OF S" July" ENDOF
|
|
8 OF S" August" ENDOF
|
|
9 OF S" September" ENDOF
|
|
10 OF S" October" ENDOF
|
|
11 OF S" November" ENDOF
|
|
12 OF S" December" ENDOF
|
|
ENDCASE ;
|
|
|
|
: NUM-TO-WEEKDAY ( dayOfWeekNum -- dayOfWeekStr )
|
|
CASE
|
|
0 OF S" Sunday" ENDOF
|
|
1 OF S" Monday" ENDOF
|
|
2 OF S" Tuesday" ENDOF
|
|
3 OF S" Wednesday" ENDOF
|
|
4 OF S" Thursday" ENDOF
|
|
5 OF S" Friday" ENDOF
|
|
6 OF S" Saturday" ENDOF
|
|
ENDCASE ;
|
|
|
|
: GET-MONTH-DAYS ( month -- days )
|
|
CASE
|
|
1 OF 31 ENDOF
|
|
2 OF 28 ENDOF
|
|
3 OF 31 ENDOF
|
|
4 OF 30 ENDOF
|
|
5 OF 31 ENDOF
|
|
6 OF 30 ENDOF
|
|
7 OF 31 ENDOF
|
|
8 OF 31 ENDOF
|
|
9 OF 30 ENDOF
|
|
10 OF 31 ENDOF
|
|
11 OF 30 ENDOF
|
|
12 OF 31 ENDOF
|
|
ENDCASE ;
|
|
|
|
: CALCULATE-START-WEEKDAY ( month year -- dayOfWeekNum )
|
|
\ https://stackoverflow.com/a/28520469/14857724
|
|
\ (
|
|
\ (d += (m < 3 ? y-- : (y-2))),
|
|
\ (
|
|
\ ((23 * m) / 9)
|
|
\ + d + 4
|
|
\ + (y / 4)
|
|
\ + (y / 400)
|
|
\ - (y / 100)
|
|
\ )
|
|
\ ) % 7
|
|
SWAP DUP 3 < IF \ if (m < 3)
|
|
SWAP DUP 1 + SWAP 1 - \ then { d += y; y--; }
|
|
ELSE
|
|
SWAP DUP 1 + 2 - SWAP \ else { d += (y - 2); }
|
|
THEN
|
|
SWAP ROT 23 * 9 / \ ((23 * m) / 9)
|
|
+ 4 + \ + d + 4
|
|
SWAP DUP 4 / ROT + \ + (y / 4)
|
|
OVER 400 / + \ + (y / 400)
|
|
SWAP 100 / - \ - (y / 100)
|
|
7 MOD ; \ % 7
|
|
|
|
: PRINT-MONTH ( day startWeekday daysInMonth -- )
|
|
SWAP DUP ( d dim s s )
|
|
0 = INVERT IF ( d dim s )
|
|
DUP 0 DO
|
|
3 SPACES
|
|
LOOP
|
|
THEN ( d dim s )
|
|
SWAP ( d s dim )
|
|
1 DO ( d s )
|
|
DUP I + 7 MOD 1 = IF CR THEN \ if a full week is formed, make a newline
|
|
\ if current index is day, print it bolded
|
|
OVER I = IF
|
|
.BOLD I 3 L.R .NORMAL
|
|
ELSE
|
|
I 3 L.R \ print number left padded with space
|
|
THEN
|
|
LOOP ;
|
|
|
|
: PRINT-HEADER ( m y -- )
|
|
CR
|
|
.BOLD
|
|
SWAP NUM-TO-MONTH TYPE SPACE .
|
|
.NORMAL
|
|
CR
|
|
S" SMTWRFS"
|
|
0 DO \ left pad each of the weekday abbreviations
|
|
DUP I + c@ EMIT 2 SPACES
|
|
LOOP CR CR DROP ;
|
|
|
|
: PRINT-CAL ( d m y -- )
|
|
2DUP PRINT-HEADER
|
|
2DUP CALCULATE-START-WEEKDAY
|
|
-ROT OVER 2 = SWAP 4 MOD 0 = AND IF \ if leap year, 29 days in the month
|
|
DROP 29
|
|
ELSE \ else set days of month to standard case list
|
|
GET-MONTH-DAYS
|
|
THEN PRINT-MONTH CR ;
|
|
|
|
DMY PRINT-CAL BYE
|
|
|