(QL:QUICKLOAD '(DATE-CALC))

(DEFPARAMETER *DAY-ROW* "SU MO TU WE TH FR SA")
(DEFPARAMETER *CALENDAR-MARGIN* 3)

(DEFUN MONTH-TO-WORD (MONTH)
  "TRANSLATE A MONTH FROM 1 TO 12 INTO ITS WORD REPRESENTATION."
  (SVREF #("JANUARY" "FEBRUARY" "MARCH" "APRIL"
           "MAY" "JUNE" "JULY" "AUGUST"
           "SEPTEMBER" "OCTOBER" "NOVEMBER" "DECEMBER")
         (1- MONTH)))

(DEFUN MONTH-STRINGS (YEAR MONTH)
  "COLLECT ALL OF THE STRINGS THAT MAKE UP A CALENDAR FOR A GIVEN
MONTH AND YEAR."
  `(,(DATE-CALC:CENTER (MONTH-TO-WORD MONTH) (LENGTH *DAY-ROW*))
     ,*DAY-ROW*
     ;; WE CAN ASSUME THAT A MONTH CALENDAR WILL ALWAYS FIT INTO A 7 BY 6 BLOCK
     ;; OF VALUES. THIS MAKES IT EASY TO FORMAT THE RESULTING STRINGS.
     ,@ (LET ((DAYS (MAKE-ARRAY (* 7 6) :INITIAL-ELEMENT NIL)))
          (LOOP :FOR I :FROM (DATE-CALC:DAY-OF-WEEK YEAR MONTH 1)
             :FOR DAY :FROM 1 :TO (DATE-CALC:DAYS-IN-MONTH YEAR MONTH)
             :DO (SETF (AREF DAYS I) DAY))
          (LOOP :FOR I :FROM 0 :TO 5
             :COLLECT
             (FORMAT NIL "~{~:[  ~;~2,D~]~^ ~}"
                     (LOOP :FOR DAY :ACROSS (SUBSEQ DAYS (* I 7) (+ 7 (* I 7)))
                        :APPEND (IF DAY (LIST DAY DAY) (LIST DAY))))))))

(DEFUN CALC-COLUMNS (CHARACTERS MARGIN-SIZE)
  "CALCULATE THE NUMBER OF COLUMNS GIVEN THE NUMBER OF CHARACTERS PER
COLUMN AND THE MARGIN-SIZE BETWEEN THEM."
  (MULTIPLE-VALUE-BIND (COLS EXCESS)
      (TRUNCATE CHARACTERS (+ MARGIN-SIZE (LENGTH *DAY-ROW*)))
    (INCF EXCESS MARGIN-SIZE)
    (IF (>= EXCESS (LENGTH *DAY-ROW*))
        (1+ COLS)
        COLS)))

(DEFUN TAKE (N LIST)
  "TAKE THE FIRST N ELEMENTS OF A LIST."
  (LOOP :REPEAT N :FOR X :IN LIST :COLLECT X))

(DEFUN DROP (N LIST)
  "DROP THE FIRST N ELEMENTS OF A LIST."
  (COND ((OR (<= N 0) (NULL LIST)) LIST)
        (T (DROP (1- N) (CDR LIST)))))

(DEFUN CHUNKS-OF (N LIST)
  "SPLIT THE LIST INTO CHUNKS OF SIZE N."
  (ASSERT (> N 0))
  (LOOP :FOR X := LIST :THEN (DROP N X)
     :WHILE X
     :COLLECT (TAKE N X)))

(DEFUN PRINT-CALENDAR (YEAR &KEY (CHARACTERS 80) (MARGIN-SIZE 3))
  "PRINT OUT THE CALENDAR FOR A GIVEN YEAR, OPTIONALLY SPECIFYING
A WIDTH LIMIT IN CHARACTERS AND MARGIN-SIZE BETWEEN MONTHS."
  (ASSERT (>= CHARACTERS (LENGTH *DAY-ROW*)))
  (ASSERT (>= MARGIN-SIZE 0))
  (LET* ((CALENDARS (LOOP :FOR MONTH :FROM 1 :TO 12
                       :COLLECT (MONTH-STRINGS YEAR MONTH)))
         (COLUMN-COUNT (CALC-COLUMNS CHARACTERS MARGIN-SIZE))
         (TOTAL-SIZE (+ (* COLUMN-COUNT (LENGTH *DAY-ROW*))
                        (* (1- COLUMN-COUNT) MARGIN-SIZE)))
         (FORMAT-STRING (CONCATENATE 'STRING
                                     "~{~A~^~" (WRITE-TO-STRING MARGIN-SIZE) ",[email protected]~}~%")))
    (FORMAT T "~A~%~A~%~%"
            (DATE-CALC:CENTER "[SNOOPY]" TOTAL-SIZE)
            (DATE-CALC:CENTER (WRITE-TO-STRING YEAR) TOTAL-SIZE))
    (LOOP :FOR ROW :IN (CHUNKS-OF COLUMN-COUNT CALENDARS)
       :DO (APPLY 'MAPCAR
                  (LAMBDA (&REST HEADS)
                    (FORMAT T FORMAT-STRING HEADS))
                  ROW))))


IMPORT STD.STDIO, STD.DATETIME, STD.STRING, STD.CONV,
       STD.ALGORITHM, STD.ARRAY;

VOID PRINT_CALENDAR(IN UINT YEAR, IN UINT COLS)
IN {
    ASSERT(COLS > 0 && COLS <= 12);
} BODY {
    STATIC ENUM CAMEL_CASE = (STRING[] PARTS) PURE =>
        PARTS[0] ~ PARTS[1 .. $].MAP!CAPITALIZE.JOIN;

    IMMUTABLE ROWS = 12 / COLS + (12 % COLS != 0);
    MIXIN("AUTO DATE = " ~ "DATE(YEAR, 1, 1);".CAPITALIZE);
    ENUM STRING S1 = CAMEL_CASE("DAY OF WEEK".SPLIT);
    MIXIN(FORMAT("AUTO OFFS = CAST(INT)DATE.%S;", S1));
    CONST MONTHS = "JANUARY FEBRUARY MARCH APRIL MAY JUNE
        JULY AUGUST SEPTEMBER OCTOBER NOVEMBER DECEMBER"
        .SPLIT.MAP!CAPITALIZE.ARRAY;

    STRING[8][12] MONS;
    FOREACH (IMMUTABLE M; 0 .. 12) {
        MONS[M][0] = MONTHS[M].CENTER(21);
        MONS[M][1] = " " ~ "SU MO TU WE TH FR SA"
                           .SPLIT.MAP!CAPITALIZE.JOIN(" ");
        ENUM STRING S2 = CAMEL_CASE("DAYS IN MONTH".SPLIT);
        MIXIN(FORMAT("IMMUTABLE DIM = DATE.%S;", S2));
        FOREACH (IMMUTABLE D; 1 .. 43) {
            IMMUTABLE DAY = D > OFFS && D <= OFFS + DIM;
            IMMUTABLE STR = DAY ? FORMAT(" %2S", D-OFFS) : "   ";
            MONS[M][2 + (D - 1) / 7] ~= STR;
        }
        OFFS = (OFFS + DIM) % 7;
        DATE.ADD!"MONTHS"(1);
    }

    FORMAT("[%S %S]", "SNOOPY".CAPITALIZE, "PICTURE".CAPITALIZE)
    .CENTER(COLS * 24 + 4).WRITELN;
    WRITELN(YEAR.TEXT.CENTER(COLS * 24 + 4), "\N");
    FOREACH (IMMUTABLE R; 0 .. ROWS) {
        STRING[8] S;
        FOREACH (IMMUTABLE C; 0 .. COLS) {
            IF (R * COLS + C > 11)
                BREAK;
            FOREACH (IMMUTABLE I, LINE; MONS[R * COLS + C])
                S[I] ~= FORMAT("   %S", LINE);
        }
        WRITEFLN("%-(%S\N%)\N", S);
    }
}

STATIC THIS() {
    PRINT_CALENDAR(1969, 3);
}


import system'text;
import system'routines;
import system'calendar;
import extensions;
import extensions'routines;

const MonthNames = new string[]{"JANUARY","FEBRUARY","MARCH","APRIL","MAY","JUNE","JULY","AUGUST","SEPTEMBER","OCTOBER",
                                "NOVEMBER","DECEMBER"};
const DayNames = new string[]{"MO", "TU", "WE", "TH", "FR", "SA", "SU"};

class CalendarMonthPrinter
{
    Date        theDate;
    TextBuilder theLine;
    int         theMonth;
    int         theYear;
    ref<int>    theRow;

    constructor(year, month)
    {
        theMonth := month;
        theYear := year;
        theLine := new TextBuilder();
        theRow := 0;
    }

    writeTitle()
    {
        theRow.Value := 0;
        theDate := Date.new(theYear, theMonth, 1);
        DayNames.forEach:(name)
            { theLine.print(" ",name) }
    }

    writeLine()
    {
        theLine.clear();

        if (theDate.Month == theMonth)
        {
            var dw := theDate.DayOfWeek;

            theLine.writeCopies("   ",theDate.DayOfWeek == 0 ? 6 : (theDate.DayOfWeek - 1));

            do
            {
                theLine.writePaddingLeft(theDate.Day.toPrintable(), $32, 3);

                theDate := theDate.addDays:1
            }
            until(theDate.Month != theMonth || theDate.DayOfWeek == 1)
        };

        int length := theLine.Length;
        if (length < 21)
            { theLine.writeCopies(" ", 21 - length) };

        theRow.append(1)
    }

    indexer() = new Indexer
    {
        bool Available = theRow < 7;

        int Index
        {
            get() = theRow.Value;

            set(int index)
            {
                if (index <= theRow)
                    { self.writeTitle() };

                while (index > theRow)
                    { self.writeLine() }
            }
        }

        appendIndex(int index)
        {
            this self.Index := theRow.Value + index
        }

        get int Length() { ^ 7 }

        get() = self;

        set(o) { NotSupportedException.raise() }
    };

    printTitleTo(output)
    {
        output.writePadding(MonthNames[theMonth - 1], $32, 21)
    }

    printTo(output)
    {
        output.write(theLine.Value)
    }
}

class Calendar
{
    int theYear;
    int theRowLength;

    constructor new(int year)
    {
        theYear := year;
        theRowLength := 3
    }

    printTo(output)
    {
        output.writePadding("[SNOOPY]", $32, theRowLength * 25);
        output.writeLine();
        output.writePadding(theYear.toPrintable(), $32, theRowLength * 25);
        output.writeLine().writeLine();

        var rowCount := 12 / theRowLength;
        var months := Array.allocate(rowCount).populate:(i =>
            Array.allocate(theRowLength)
                  .populate:(j =>
                     new CalendarMonthPrinter(theYear, i * theRowLength + j + 1)));

        months.forEach:(row)
        {
            var r := row;

            row.forEach:(month)
            {
                month.printTitleTo:output;

                output.write:"   "
            };

            output.writeLine();

            ParallelEnumerator.new(row).forEach:(line)
            {
                line.forEach:(printer)
                {
                    printer.printTo:output;

                    output.write:"   "
                };

                output.writeLine()
            }
        }
    }
}

public program()
{
    var calender := Calendar.new(console.write:"ENTER THE YEAR:".readLine().toInt());

    calender.printTo:console;

    console.readChar()
}


       MODULE DATEGNASH

       TYPE DATEBAG
        INTEGER DAY,MONTH,YEAR
       END TYPE DATEBAG

       CHARACTER*9 MONTHNAME(12),DAYNAME(0:6)
       PARAMETER (MONTHNAME = (/"JANUARY","FEBRUARY","MARCH","APRIL",
     1  "MAY","JUNE","JULY","AUGUST","SEPTEMBER","OCTOBER","NOVEMBER",
     2  "DECEMBER"/))
       PARAMETER (DAYNAME = (/"SUNDAY","MONDAY","TUESDAY","WEDNESDAY",
     1  "THURSDAY","FRIDAY","SATURDAY"/))

       INTEGER*4 JDAYSHIFT
       PARAMETER (JDAYSHIFT = 2415020)
       CONTAINS
       INTEGER FUNCTION LSTNB(TEXT)
        CHARACTER*(*),INTENT(IN):: TEXT
        INTEGER L
         L = LEN(TEXT)
    1    IF (L.LE.0) GO TO 2
         IF (ICHAR(TEXT(L:L)).GT.ICHAR(" ")) GO TO 2
         L = L - 1
         GO TO 1
    2    LSTNB = L
        RETURN
       END FUNCTION LSTNB
      CHARACTER*2 FUNCTION I2FMT(N)
       INTEGER*4 N
        IF (N.LT.0) THEN
          IF (N.LT.-9) THEN
            I2FMT = "-!"
           ELSE
            I2FMT = "-"//CHAR(ICHAR("0") - N)
          END IF
        ELSE IF (N.LT.10) THEN
          I2FMT = " " //CHAR(ICHAR("0") + N)
        ELSE IF (N.LT.100) THEN
          I2FMT = CHAR(N/10      + ICHAR("0"))
     1           //CHAR(MOD(N,10) + ICHAR("0"))
        ELSE
          I2FMT = "+!"
        END IF
      END FUNCTION I2FMT
      CHARACTER*8 FUNCTION I8FMT(N)
       INTEGER*4 N
       CHARACTER*8 HIC
        WRITE (HIC,1) N
    1   FORMAT (I8)
        I8FMT = HIC
      END FUNCTION I8FMT

      SUBROUTINE SAY(OUT,TEXT)
       INTEGER OUT
       CHARACTER*(*) TEXT
        WRITE (6,1) TEXT(1:LSTNB(TEXT))
    1   FORMAT (A)
      END SUBROUTINE SAY

       INTEGER*4 FUNCTION DAYNUM(YY,M,D)
        INTEGER*4 JDAYN
        INTEGER YY,Y,M,MM,D
         Y = YY
         IF (Y.LT.1) Y = Y + 1
         MM = (M - 14)/12
         JDAYN = D - 32075
     A    + 1461*(Y + 4800  + MM)/4
     B    +  367*(M - 2     - MM*12)/12
     C    -    3*((Y + 4900 + MM)/100)/4
         DAYNUM = JDAYN - JDAYSHIFT
       END FUNCTION DAYNUM

       TYPE(DATEBAG) FUNCTION MUNYAD(DAYNUM)
        INTEGER*4 DAYNUM,JDAYN
        INTEGER Y,M,D,L,N
         JDAYN = DAYNUM + JDAYSHIFT
         L = JDAYN + 68569
         N = 4*L/146097
         L = L - (146097*N + 3)/4
         Y = 4000*(L + 1)/1461001
         L = L - 1461*Y/4 + 31
         M = 80*L/2447
         D = L - 2447*M/80
         L = M/11
         M = M + 2 - 12*L
         Y = 100*(N - 49) + Y + L
         IF (Y.LT.1) Y = Y - 1
         MUNYAD%YEAR  = Y
         MUNYAD%MONTH = M
         MUNYAD%DAY   = D
       END FUNCTION MUNYAD

       INTEGER FUNCTION PMOD(N,M)
        INTEGER N,M
         PMOD = MOD(MOD(N,M) + M,M)
       END FUNCTION PMOD

      SUBROUTINE CALENDAR(Y1,Y2,COLUMNS)

       INTEGER Y1,Y2,YEAR
       INTEGER M,M1,M2,MONTH
       INTEGER*4 DN1,DN2,DN,D
       INTEGER W,G
       INTEGER L,LINE
       INTEGER COL,COLUMNS,COLWIDTH
       CHARACTER*200 STRIPE(6),SPECIAL(6),MLINE,DLINE
        W = 3
        G = 1
        COLWIDTH = 7*W + G
      Y:DO YEAR = Y1,Y2
          CALL SAY(MSG,"")
          IF (YEAR.EQ.0) THEN
            CALL SAY(MSG,"THERE IS NO YEAR ZERO.")
            CYCLE Y
          END IF
          MLINE = ""
          L = (COLUMNS*COLWIDTH - G - 8)/2
          IF (YEAR.GT.0) THEN
            MLINE(L:) = I8FMT(YEAR)
           ELSE
            MLINE(L - 1:) = I8FMT(-YEAR)//"BC"
          END IF
          CALL SAY(MSG,MLINE)
          DO MONTH = 1,12,COLUMNS
            M1 = MONTH
            M2 = MIN(12,M1 + COLUMNS - 1)
            MLINE = ""
            DLINE = ""
            STRIPE = ""
            SPECIAL = ""
            L0 = 1
            DO M = M1,M2
              L = (COLWIDTH - G - LSTNB(MONTHNAME(M)))/2 - 1
              MLINE(L0 + L:) = MONTHNAME(M)
              DO D = 0,6
                L = L0 + (3 - W) + D*W
                DLINE(L:L + 2) = DAYNAME(D)(1:W - 1)
              END DO
              DN1 = DAYNUM(YEAR,M,1)
              DN2 = DAYNUM(YEAR,M + 1,0)
              COL = MOD(PMOD(DN1,7) + 7,7)
              LINE = 1
              D = 1
              DO DN = DN1,DN2
                L = L0 + COL*W
                STRIPE(LINE)(L:L + 1) = I2FMT(D)
                D = D + 1
                COL = COL + 1
                IF (COL.GT.6) THEN
                  LINE = LINE + 1
                  COL = 0
                END IF
              END DO
              L0 = L0 + 7*W + G
            END DO
            CALL SAY(MSG,MLINE)
            CALL SAY(MSG,DLINE)
            DO LINE = 1,6
              IF (STRIPE(LINE).NE."") THEN
                CALL SAY(MSG,STRIPE(LINE))
              END IF
            END DO
          END DO
        END DO Y
        CALL SAY(MSG,"")
      END SUBROUTINE CALENDAR
      END MODULE DATEGNASH

      PROGRAM SHOW1968
       USE DATEGNASH
       INTEGER NCOL
        DO NCOL = 1,6
          CALL CALENDAR(1969,1969,NCOL)
        END DO
      END


' VERSION 16-03-2016
' COMPILE WITH: FBC -S CONSOLE

' TRUE/FALSE ARE BUILT-IN CONSTANTS SINCE FREEBASIC 1.04
' BUT WE HAVE TO DEFINE THEM FOR OLDER VERSIONS.
#IFNDEF TRUE
    #DEFINE FALSE 0
    #DEFINE TRUE NOT FALSE
#ENDIF

FUNCTION WD(M AS INTEGER, D AS INTEGER, Y AS INTEGER) AS INTEGER
    ' ZELLERISH
    ' 0 = SUNDAY, 1 = MONDAY, 2 = TUESDAY, 3 = WEDNESDAY
    ' 4 = THURSDAY, 5 = FRIDAY, 6 = SATURDAY

    IF M < 3 THEN        ' IF M = 1 OR M = 2 THEN
        M += 12
        Y -= 1
    END IF
    RETURN (Y + (Y \ 4) - (Y \ 100) + (Y \ 400) + D + ((153 * M + 8) \ 5)) MOD 7
END FUNCTION

FUNCTION LEAPYEAR(Y AS INTEGER) AS INTEGER

    IF (Y MOD 4) <> 0 THEN RETURN FALSE
    IF (Y MOD 100) = 0 ANDALSO (Y MOD 400) <> 0 THEN RETURN FALSE
    RETURN TRUE
END FUNCTION

' ------=< MAIN >=------
' HARD CODED FOR 132 CHARACTERS PER LINE

DIM AS STRING WDN = "MO TU WE TH FR SA SU"  ' WEEKDAY NAMES
DIM AS STRING MO(1 TO 12) => {"JANUARY", "FEBRUARY", "MARCH", "APRIL", _
                         "MAY", "JUNE", "JULY", "AUGUST", "SEPTEMBER", _
                                    "OCTOBER", "NOVEMBER", "DECEMBER"}
DIM AS STRING TMP1, TMP2, D(1 TO 12)

DIM AS UINTEGER ML(1 TO 12) => {31,28,31,30,31,30,31,31,30,31,30,31}
DIM AS UINTEGER I, I1, J, K, Y = 1969

'SCREENRES 1080,600,8

IF LEAPYEAR(Y) = TRUE THEN ML(2) = 29

TMP1 = ""
FOR I = 1 TO 31
    TMP1 = TMP1 + RIGHT(("  " + STR(I)), 3)
NEXT I

FOR I = 1 TO 12
    TMP2 = ""
    J = WD(I,1, Y)
    IF J = 0 THEN J = 7
    J = J - 1
    TMP2 = SPACE(J * 3) + LEFT(TMP1, ML(I) * 3) + SPACE(21)
    D(I) = TMP2
NEXT I

PRINT
TMP1 = "INSERT YOUR SNOOPY PICTURE HERE"
PRINT SPACE((132 - LEN(TMP1)) \ 2); TMP1
PRINT
TMP1 = STR(Y)
PRINT SPACE((132 - LEN(TMP1)) \ 2); TMP1
PRINT

' 6 MONTH ON A ROW
TMP2 = " "
FOR I = 1 TO 6
    TMP2 = TMP2 + WDN
    IF I < 6 THEN TMP2 = TMP2 + "  "
NEXT I

FOR I = 1 TO 12 STEP 6
    TMP1 = ""
    FOR J = I TO I + 4
        TMP1 = TMP1 + LEFT(SPACE((22 - LEN(MO(J))) \ 2) + MO(J) + SPACE(11), 22)
    NEXT J
    TMP1 = TMP1 + SPACE((22 - LEN(MO(I + 5))) \ 2) + MO(I + 5)
    PRINT TMP1
    PRINT TMP2
    FOR J = 1 TO 85 STEP 21
        FOR K = I TO I + 4
            PRINT MID(D(K), J ,21); " ";
        NEXT K
        PRINT MID(D(I + 5), J ,21)
    NEXT J
    PRINT
NEXT I

' EMPTY KEYBOARD BUFFER
WHILE INKEY <> "" : WEND
PRINT : PRINT "HIT ANY KEY TO END PROGRAM"
SLEEP
END


PACKAGE MAIN

IMPORT (
    "FMT"
    "TIME"
)

CONST PAGEWIDTH = 80

FUNC MAIN() {
    PRINTCAL(1969)
}

FUNC PRINTCAL(YEAR INT) {
    THISDATE := TIME.DATE(YEAR, 1, 1, 1, 1, 1, 1, TIME.UTC)
    VAR (
        DAYARR                  [12][7][6]INT // MONTH, WEEKDAY, WEEK
        MONTH, LASTMONTH        TIME.MONTH
        WEEKINMONTH, DAYINMONTH INT
    )
    FOR THISDATE.YEAR() == YEAR {
        IF MONTH = THISDATE.MONTH(); MONTH != LASTMONTH {
            WEEKINMONTH = 0
            DAYINMONTH = 1
        }
        WEEKDAY := THISDATE.WEEKDAY()
        IF WEEKDAY == 0 && DAYINMONTH > 1 {
            WEEKINMONTH++
        }
        DAYARR[INT(MONTH)-1][WEEKDAY][WEEKINMONTH] = THISDATE.DAY()
        LASTMONTH = MONTH
        DAYINMONTH++
        THISDATE = THISDATE.ADD(TIME.HOUR * 24)
    }
    CENTRE := FMT.SPRINTF("%D", PAGEWIDTH/2)
    FMT.PRINTF("%"+CENTRE+"S\N\N", "[SNOOPY]")
    CENTRE = FMT.SPRINTF("%D", PAGEWIDTH/2-2)
    FMT.PRINTF("%"+CENTRE+"D\N\N", YEAR)
    MONTHS := [12]STRING{
        " JANUARY ", " FEBRUARY", "  MARCH  ", "  APRIL  ",
        "   MAY   ", "   JUNE  ", "   JULY  ", "  AUGUST ",
        "SEPTEMBER", " OCTOBER ", " NOVEMBER", " DECEMBER"}
    DAYS := [7]STRING{"SU", "MO", "TU", "WE", "TH", "FR", "SA"}
    FOR QTR := 0; QTR < 4; QTR++ {
        FOR MONTHINQTR := 0; MONTHINQTR < 3; MONTHINQTR++ { // MONTH NAMES
            FMT.PRINTF("      %S           ", MONTHS[QTR*3+MONTHINQTR])
        }
        FMT.PRINTLN()
        FOR MONTHINQTR := 0; MONTHINQTR < 3; MONTHINQTR++ { // DAY NAMES
            FOR DAY := 0; DAY < 7; DAY++ {
                FMT.PRINTF(" %S", DAYS[DAY])
            }
            FMT.PRINTF("     ")
        }
        FMT.PRINTLN()
        FOR WEEKINMONTH = 0; WEEKINMONTH < 6; WEEKINMONTH++ {
            FOR MONTHINQTR := 0; MONTHINQTR < 3; MONTHINQTR++ {
                FOR DAY := 0; DAY < 7; DAY++ {
                    IF DAYARR[QTR*3+MONTHINQTR][DAY][WEEKINMONTH] == 0 {
                        FMT.PRINTF("   ")
                    } ELSE {
                        FMT.PRINTF("%3D", DAYARR[QTR*3+MONTHINQTR][DAY][WEEKINMONTH])
                    }
                }
                FMT.PRINTF("     ")
            }
            FMT.PRINTLN()
        }
        FMT.PRINTLN()
    }
}


RIGHTCLICK:CLOCK,ADJUST DATE AND TIME,BUTTON:CANCEL


$include "REALIZE.ICN"

LINK DATETIME
$define ISLEAPYEAR IsLeapYear
$define JULIAN julian

PROCEDURE MAIN(A)
   PRINTCALENDAR(\A$<1$>|1969)
END

PROCEDURE PRINTCALENDAR(YEAR)
   COLS := 3
   MONS := $<$>
   "JANUARY FEBRUARY MARCH APRIL MAY JUNE " ||
   "JULY AUGUST SEPTEMBER OCTOBER NOVEMBER DECEMBER " ?
          WHILE PUT(MONS, TAB(FIND(" "))) DO MOVE(1)

   WRITE(CENTER("$<SNOOPY PICTURE$>",COLS * 24 + 4))
   WRITE(CENTER(YEAR,COLS * 24 + 4), CHAR(10))

   M := LIST(COLS)
   EVERY  MON := 0 TO 9 BY COLS DO $(
      WRITES("    ")
      EVERY I := 1 TO COLS DO {
         WRITES(CENTER(MONS$<MON+I$>,24))
         M$<I$> := CREATE CALENDARFORMATWEEK(YEAR,MON + I)
         $)
      WRITE()
      EVERY 1 TO 7 DO $(
         EVERY C := 1 TO COLS DO $(
            WRITES("    ")
            EVERY 1 TO 7 DO WRITES(RIGHT(@M$<C$>,3))
            $)
         WRITE()
         $)
      $)
   RETURN
END

PROCEDURE CALENDARFORMATWEEK(YEAR,M)
   STATIC D
   INITIAL D := $<31,28,31,30,31,30,31,31,30,31,30,31$>

   EVERY SUSPEND "SU"|"MO"|"TU"|"WE"|"TH"|"FR"|"SA"
   EVERY 1 TO (DAY := (JULIAN(M,1,YEAR)+1)%7) DO SUSPEND ""
   EVERY SUSPEND 1 TO D$<M$> DO DAY +:= 1
   IF M = 2 & ISLEAPYEAR(YEAR) THEN SUSPEND (DAY +:= 1, 29)
   EVERY DAY TO (6*7) DO SUSPEND ""
END


# IF THIS SMALL FUNCTION IS PLACED IN THE STARTUP.JL
# FILE, IT WILL BE LOADED ON STARTUP. THE REST OF
# THIS EXAMPLE IS IN ALL UPPERCASE.
function RUNUPPERCASECODE(CO)
    COD = replace(lowercase(CO), "date" => "Date")
    for E in Meta.parse(COD, 1) eval(E) end
end

CODE = """BEGIN

USING DATES;
CENTEROBJECT(X, N) = BEGIN S = UPPERCASE(STRING(X)); RPAD(LPAD(S, DIV(N + LENGTH(S), 2)), N) END;
FUNCTION FORMATMONTH(YR, MO)
    DT = DATE(\"\$YR-\$MO-01\");
    DAYOFWEEKFIRST = DAYOFWEEK(DT);
    NUMWEEKLINES = 1;
    STR = UPPERCASE(CENTEROBJECT(MONTHNAME(DT), 20) * \"\\NMO TU WE TH FR SA SU\\N\");
    STR *= \" \" ^ (3 * (DAYOFWEEKFIRST - 1)) * LPAD(STRING(1), 2);
    FOR I = 2:DAYSINMONTH(DT)
        IF (I + DAYOFWEEKFIRST + 5) % 7 == 0
            STR *= \"\\N\" * LPAD(I, 2);
            NUMWEEKLINES += 1;
        ELSE
            STR *= LPAD(STRING(I), 3);
        END;
    END;
    STR *= NUMWEEKLINES < 6 ? \"\\N\\N\\N\" : \"\\N\\N\";
    ARR = [];
    FOR S IN SPLIT(STR, \"\\N\")
        PUSH!(ARR, RPAD(S, 20)[1:20])
    END;
    JOIN(ARR, \"\\N\");
END;

FUNCTION FORMATYEAR(DISPLAYYEAR)
    CALMONTHS = [FORMATMONTH(DISPLAYYEAR, MO) FOR MO IN 1:12];
    MONTHSPERLINE = 6;
    JOINSPACES = 2;
    STR = \"\\N\" * CENTEROBJECT(DISPLAYYEAR, 132) * \"\\N\";
    MONTHCAL = [SPLIT(FORMATMONTH(DISPLAYYEAR, I), \"\\N\") FOR I IN 1:12];
    FOR I IN 1:MONTHSPERLINE:LENGTH(CALMONTHS) - 1
        FOR J IN 1:LENGTH(MONTHCAL[1])
            MONTHLINES = MAP(X->MONTHCAL[X][J], I:I + MONTHSPERLINE - 1);
            STR *= RPAD(JOIN(MONTHLINES, \" \" ^ JOINSPACES), 132) * \"\\N\";
        END;
        STR *= \"\\N\";
    END;
    STR;
END;

PRINTLN(FORMATYEAR(1969));

END;
"""

RUNUPPERCASECODE(CODE)


IMPORT JAVA.TEXT.*
IMPORT JAVA.UTIL.*
IMPORT JAVA.IO.PRINTSTREAM

INTERNAL FUN PRINTSTREAM.PRINTCALENDAR(YEAR: INT, NCOLS: BYTE, LOCALE: LOCALE?) {
    IF (NCOLS < 1 || NCOLS > 12)
        THROW ILLEGALARGUMENTEXCEPTION("ILLEGAL COLUMN WIDTH.")
    VAL W = NCOLS * 24
    VAL NROWS = MATH.CEIL(12.0 / NCOLS).TOINT()

    VAL DATE = GREGORIANCALENDAR(YEAR, 0, 1)
    VAR OFFS = DATE.GET(CALENDAR.DAY_OF_WEEK) - 1

    VAL DAYS = DATEFORMATSYMBOLS(LOCALE).SHORTWEEKDAYS.SLICE(1..7).MAP { IT.SLICE(0..1) }.JOINTOSTRING(" ", " ")
    VAL MONS = ARRAY(12) { ARRAY(8) { "" } }
    DATEFORMATSYMBOLS(LOCALE).MONTHS.SLICE(0..11).FOREACHINDEXED { M, NAME ->
        VAL LEN = 11 + NAME.LENGTH / 2
        VAL FORMAT = MESSAGEFORMAT.FORMAT("%{0}S%{1}S", LEN, 21 - LEN)
        MONS[M][0] = STRING.FORMAT(FORMAT, NAME, "")
        MONS[M][1] = DAYS
        VAL DIM = DATE.GETACTUALMAXIMUM(CALENDAR.DAY_OF_MONTH)
        FOR (D IN 1..42) {
            VAL ISDAY = D > OFFS && D <= OFFS + DIM
            VAL ENTRY = IF (ISDAY) STRING.FORMAT(" %2S", D - OFFS) ELSE "   "
            IF (D % 7 == 1)
                MONS[M][2 + (D - 1) / 7] = ENTRY
            ELSE
                MONS[M][2 + (D - 1) / 7] += ENTRY
        }
        OFFS = (OFFS + DIM) % 7
        DATE.ADD(CALENDAR.MONTH, 1)
    }

    PRINTF("%" + (W / 2 + 10) + "S%N", "[SNOOPY PICTURE]")
    PRINTF("%" + (W / 2 + 4) + "S%N%N", YEAR)

    FOR (R IN 0..NROWS - 1) {
        FOR (I IN 0..7) {
            VAR C = R * NCOLS
            WHILE (C < (R + 1) * NCOLS && C < 12) {
                PRINTF("   %S", MONS[C][I].TOUPPERCASE())  // ORIGINAL CHANGED TO PRINT IN UPPER CASE
                C++
            }
            PRINTLN()
        }
        PRINTLN()
    }
}

FUN MAIN(ARGS: ARRAY<STRING>) {
    SYSTEM.OUT.PRINTCALENDAR(1969, 3, LOCALE.US)
}


FUNCTION PRINT_CAL(YEAR)
  LOCAL MONTHS={"JANUARY","FEBRUARY","MARCH","APRIL","MAY","JUNE",
                "JULY","AUGUST","SEPTEMBER","OCTOBER","NOVEMBER","DECEMBER"}
  LOCAL DAYSTITLE="MO TU WE TH FR SA SU"
  LOCAL DAYSPERMONTH={31,28,31,30,31,30,31,31,30,31,30,31}
  LOCAL STARTDAY=((YEAR-1)*365+MATH.FLOOR((YEAR-1)/4)-MATH.FLOOR((YEAR-1)/100)+MATH.FLOOR((YEAR-1)/400))%7
  IF YEAR%4==0 AND YEAR%100~=0 OR YEAR%400==0 THEN
    DAYSPERMONTH[2]=29
  END
  LOCAL SEP=5
  LOCAL MONTHWIDTH=DAYSTITLE:LEN()
  LOCAL CALWIDTH=3*MONTHWIDTH+2*SEP

  FUNCTION CENTER(STR, WIDTH)
    LOCAL FILL1=MATH.FLOOR((WIDTH-STR:LEN())/2)
    LOCAL FILL2=WIDTH-STR:LEN()-FILL1
    RETURN STRING.REP(" ",FILL1)..STR..STRING.REP(" ",FILL2)
  END

  FUNCTION MAKEMONTH(NAME, SKIP,DAYS)
    LOCAL CAL={
      CENTER(NAME,MONTHWIDTH),
      DAYSTITLE
    }
    LOCAL CURDAY=1-SKIP
    WHILE #CAL<9 DO
      LINE={}
      FOR I=1,7 DO
        IF CURDAY<1 OR CURDAY>DAYS THEN
          LINE[I]="  "
        ELSE
          LINE[I]=STRING.FORMAT("%2D",CURDAY)
        END
        CURDAY=CURDAY+1
      END
      CAL[#CAL+1]=TABLE.CONCAT(LINE," ")
    END
    RETURN CAL
  END

  LOCAL CALENDAR={}
  FOR I,MONTH IN IPAIRS(MONTHS) DO
    LOCAL DPM=DAYSPERMONTH[I]
    CALENDAR[I]=MAKEMONTH(MONTH, STARTDAY, DPM)
    STARTDAY=(STARTDAY+DPM)%7
  END

  PRINT(CENTER("[SNOOPY]",CALWIDTH):UPPER(),"\N")
  PRINT(CENTER("--- "..YEAR.." ---",CALWIDTH):UPPER(),"\N")

  FOR Q=0,3 DO
    FOR L=1,9 DO
      LINE={}
      FOR M=1,3 DO
        LINE[M]=CALENDAR[Q*3+M][L]
      END
      PRINT(TABLE.CONCAT(LINE,STRING.REP(" ",SEP)):UPPER())
    END
  END
END

PRINT_CAL(1969)


\\ Calendar - for "REAL" programmers
\\ All statements in UPPERCASE
\\ Output to 132 characters console - as a line printer
\\ USE COURIER NEW  (FONT "COURIER NEW")

\\ CHANGE THE VALUE OF PRINT_IT TO TRUE FOR PRINTING
GLOBAL CONST PRINT_IT AS BOOLEAN=FALSE
MODULE GLOBAL SNOOPY  {
IF NOT PRINT_IT THEN CURSOR 0,ROW ELSE IF ROW>0 THEN PAGE 1
PRINT $(,8)
PRINT #-2, {
					   XXXX
					  X    XX
					 X  ***  X		  XXXXX
					X  *****  X	       XXX     XX
				     XXXX ******* XXX	   XXXX 	 XX
				   XX	X ******  XXXXXXXXX    [email protected]	   XX XXX
				 XX	 X ****  X			     X** X
				X	 XX    XX     X 		     X***X
			       X	 //XXXX       X 		     XXXX
			      X 	//   X				   XX
			     X	       //    X		XXXXXXXXXXXXXXXXXX/
			     X	   XXX//    X	       X
			     X	  X   X     X	      X
			     X	  X    X    X	     X
			      X   X    X    X	     X			  XX
			      X    X   X    X	     X		       XXX  XX
			       X    XXX      X	      X 	      X  X X  X
			       X	     X	       X	      XX X  XXXX
				X	      X 	XXXXXXXX\     XX   XX  X
				 XX	       XX	       X     X	 @X  XX
				   XX		 XXXX	XXXXXX/     X	  XXXX
				     XXX	     XX***	   X	 X
					XXXXXXXXXXXXX *   *	  X	X
						     *---* X	 X     X
						    *-* *   XXX X     X
						    *- *       XXX   X
						   *- *X	  XXX
						   *- *X  X	     XXX
						  *- *X    X		XX
						  *- *XX    X		  X
						 *  *X* X    X		   X
						 *  *X * X    X 	    X
						*  * X**  X   XXXX	    X
						*  * X**  XX	 X	    X
					       *  ** X** X     XX	   X
					       *  **  X*  XXX	X	  X
					      *  **    XX   XXXX       XXX
					     *	* *	 XXXX	   X	 X
					    *	* *	     X	   X	 X
			      =======*******   * *	     X	   X	  XXXXXXXX\
				     *	       * *	/XXXXX	    XXXXXXXX\	   )
				=====**********  *     X		     )	\  )
				  ====* 	*     X 	      \  \   )XXXXX
			     =========**********       XXXXXXXXXXXXXXXXXXXXXX

}
}
MODULE CALENDAR (YEAR, LOCALEID) {
      FUNCTION GETMAX(YEAR, MONTH) {
            A=DATE(STR$(YEAR)+"-"+STR$(MONTH)+"-1")
            MAX=32
            DO {
                  MAX--
                  M=VAL(STR$(CDATE(A,0,0,MAX), "M"))
            } UNTIL M=MONTH
             =MAX+1
      }
      FUNCTION SKIPMO(YEAR, MONTH) {
            A=DATE(STR$(YEAR)+"-"+STR$(MONTH)+"-1")
            =(VAL(STR$(A, "W"))-8) MOD 7 +7
      }
      FUNCTION TITLE$(A$) {
            =UCASE$(LEFT$(A$,1))+LCASE$(MID$(A$, 2))
      }
      LOCALE LOCALEID
      IF NOT PRINT_IT THEN CURSOR 0,HEIGHT-1  ' LAST LINE, SO EACH NEW LINE SCROLL ALL LINES UP
      SNOOPY

      PRINT UNDER  ' PRINT UNDERLINE
      PRINT OVER $(2), YEAR
      PRINT
      FOR J=0 TO 1 {
            PRINT
            FOR I=1 TO 6 {
                  MONTH=I+J*6
                  PRINT  PART @((I-1)*22+1), $(2,21), UCASE$(LOCALE$(55+MONTH))
            }
            PRINT
            DIM SKIP(1 TO 6), COUNT(1 TO 6), D(1 TO 6)=1
            FOR I=1 TO 6 {
                  MONTH=I+J*6
                  IF I>1 THEN PRINT " ";
                  FOR K=42 TO 48 :PRINT " ";UCASE$(LEFT$(LOCALE$(K),2));:NEXT K
                  SKIP(I)=SKIPMO(YEAR, MONTH)
                  COUNT(I)=GETMAX(YEAR, MONTH)
            }
            PRINT
            IF PRINT_IT ELSE REFRESH 1000
            FOR I=1 TO 6 {
                      IF I>1 THEN PRINT " ";
                      FOR K=1 TO 7 {
                        SKIP(I)--
                        IF  SKIP(I)>0 THEN PRINT "   "; :CONTINUE
                        COUNT(I)--
                        PRINT FORMAT$(" {0::-2}", D(I));
                        D(I)++
                  }
            }
            PRINT
            IF PRINT_IT ELSE REFRESH 1000
            PRINT @(0)
            FOR M=1 TO 5 {
                  FOR I=1 TO 6 {
                        IF I>1 THEN PRINT " ";
                        FOR K=1 TO 7 {
                              COUNT(I)--
                              IF COUNT(I)<0 THEN PRINT "   "; : CONTINUE
                              PRINT FORMAT$(" {0::-2}", D(I));
                              D(I)++
                        }
                  }
            PRINT
            IF PRINT_IT ELSE REFRESH 1000
            }
      }
}
WHILE INKEY$<>"" :  END WHILE
IF PRINT_IT THEN PRINTING ON ELSE REFRESH 1000
FONT "COURIER NEW"
PEN 0
CLS 15, 0
FORM 132,68
CALENDAR 1966, 1032 ' GREEK
GOSUB WAITKEY_OR_MOUSE
FOR I=2020 TO 2026
CALENDAR I, 1033  ' ENGLISH
GOSUB WAITKEY_OR_MOUSE
NEXT I
IF PRINT_IT THEN PRINTING OFF ELSE REFRESH 50
CLEAR  ' CLEAR VARIABLES FROM THIS MODULE
END
WAITKEY_OR_MOUSE:
IF PRINT_IT THEN RETURN
WHILE INKEY$="" AND MOUSE=0
END WHILE
RETURN


import strutils

const progUpper = staticRead("calendar_upper.txt")

proc transformed(s: string): string {.compileTime.} =
  ## Return a transformed version (which can compile) of a program in uppercase.

  let upper = s.toLower() # Convert all to lowercase.
  var inString = false    # Text in string should be in uppercase…
  var inBraces = false    # … except if this is in an expression to interpolate.
  for ch in upper:
    case ch
    of '"':
      inString = not inString
    of '{':
      if inString: inBraces = true
    of '}':
      if inString: inBraces = false
    of 'a'..'z':
      if inString and not inBraces:
        result.add(ch.toUpperAscii())   # Restore content of strings to uppercase.
        continue
    else:
      discard
    result.add(ch)

const prog = progUpper.transformed()

static: writeFile("calendar_transformed.nim", prog)

include "calendar_transformed.nim"


return repeat(' ',left)&s&repeat(' ',right)


(DE CAL (YEAR)
   (PRINL "====== " YEAR " ======")
   (FOR DAT (RANGE (DATE YEAR 1 1) (DATE YEAR 12 31))
      (LET D (DATE DAT)
         (TAB (3 3 4 8)
            (WHEN (= 1 (CADDR D))
               (GET `(INTERN (PACK (MAPCAR CHAR (42 77 111 110)))) (CADR D)) )
            (CADDR D)
            (DAY DAT `(INTERN (PACK (MAPCAR CHAR (42 68 97 121)))))
            (WHEN (=0 (% (INC DAT) 7))
               (PACK (CHAR 87) "EEk " (WEEK DAT)) ) ) ) ) )

(CAL 1969)
(BYE)


(SUBRG, SIZE, FOFL):
CALENDAR: PROCEDURE (YEAR) OPTIONS (MAIN);
   DECLARE YEAR CHARACTER (4) VARYING;
   DECLARE (A, B, C) (0:5,0:6) CHARACTER (3);
   DECLARE NAME_MONTH(12) STATIC CHARACTER (9) VARYING INITIAL (
      'JANUARY', 'FEBRUARY', 'MARCH',     'APRIL',   'MAY',      'JUNE',
      'JULY',    'AUGUST',   'SEPTEMBER', 'OCTOBER', 'NOVEMBER', 'DECEMBER');
   DECLARE I FIXED;
   DECLARE (MM, MMP1, MMP2) PIC '99';

   PUT EDIT (CENTER('CALENDAR FOR ' || YEAR, 67)) (A);
   PUT SKIP (2);

   DO MM = 1 TO 12 BY 3;
      MMP1 = MM + 1; MMP2 = MM + 2;
      CALL PREPARE_MONTH('01' || MM   || YEAR, A);
      CALL PREPARE_MONTH('01' || MMP1 || YEAR, B);
      CALL PREPARE_MONTH('01' || MMP2 || YEAR, C);

      PUT SKIP EDIT (CENTER(NAME_MONTH(MM),   23),
                     CENTER(NAME_MONTH(MMP1), 23),
                     CENTER(NAME_MONTH(MMP2), 23) ) (A);
      PUT SKIP EDIT ((3)'  M  T  W  T  F  S  S  ') (A);
      DO I = 0 TO 5;
         PUT SKIP EDIT (A(I,*), B(I,*), C(I,*)) (7 A, X(2));
      END;
   END;

PREPARE_MONTH: PROCEDURE (START, MONTH);
   DECLARE MONTH(0:5,0:6) CHARACTER (3);
   DECLARE START CHARACTER (8);
   DECLARE I PIC 'ZZ9';
   DECLARE OFFSET FIXED;
   DECLARE (J, DAY) FIXED BINARY (31);
   DECLARE (THIS_MONTH, NEXT_MONTH, K) FIXED BINARY;

   DAY = DAYS(START, 'DDMMYYYY');
   OFFSET = WEEKDAY(DAY) - 1;
   IF OFFSET  = 0 THEN OFFSET = 7;
   MONTH = '';
   DO J = DAY BY 1;
      THIS_MONTH = SUBSTR(DAYSTODATE(J,   'DDMMYYYY'), 3, 2);
      NEXT_MONTH = SUBSTR(DAYSTODATE(J+1, 'DDMMYYYY'), 3, 2);
      IF THIS_MONTH^= NEXT_MONTH THEN LEAVE;
   END;
   I = 1;
   DO K = OFFSET-1 TO OFFSET+J-DAY-1;
      MONTH(K/7, MOD(K,7)) = I; I = I + 1;
   END;
END PREPARE_MONTH;

END CALENDAR;


#CI(MODULE NAME-OF-THIS-FILE RACKET
(REQUIRE RACKET/DATE)
(DEFINE (CALENDAR YR)
  (DEFINE (NSPLIT N L) (IF (NULL? L) L (CONS (TAKE L N) (NSPLIT N (DROP L N)))))
  (DEFINE MONTHS
    (FOR/LIST ([MN (IN-NATURALS 1)]
               [MNAME '(JANUARY FEBRUARY MARCH APRIL MAY JUNE JULY
                        AUGUST SEPTEMBER OCTOBER NOVEMBER DECEMBER)])
      (DEFINE S (FIND-SECONDS 0 0 12 1 MN YR))
      (DEFINE PFX (DATE-WEEK-DAY (SECONDS->DATE S)))
      (DEFINE DAYS
        (LET ([? (IF (= MN 12) (Λ(X Y) Y) (Λ(X Y) X))])
          (ROUND (/ (- (FIND-SECONDS 0 0 12 1 (? (+ 1 MN) 1) (? YR (+ 1 YR))) S)
                    60 60 24))))
      (LIST* (~A MNAME #:WIDTH 20 #:ALIGN 'CENTER) "SU MO TU WE TH FR SA"
             (MAP STRING-JOIN
                  (NSPLIT 7 `(,@(MAKE-LIST PFX "  ")
                              ,@(FOR/LIST ([D DAYS])
                                  (~A (+ D 1) #:WIDTH 2 #:ALIGN 'RIGHT))
                              ,@(MAKE-LIST (- 42 PFX DAYS) "  ")))))))
  (LET* ([S '(" 11,-~4-._3. 41-4! 10/ ()=(2) 3\\ 40~A! 9( 3( 80 39-4! 10\\._\\"
              ", ,-4'! 5#[email protected]! 12/ 2-3'~2;! 11/ 4/~2|-! 9=( 3~4 2|! 3/~42\\! "
              "2/_23\\! /_25\\!/_27\\! 3|_20|! 3|_20|! 3|_20|! 3| 20|!!")]
         [S (REGEXP-REPLACE* "!" (STRING-APPEND* S) "~%")]
         [S (REGEXP-REPLACE* "@" S (STRING-FOLDCASE "X"))]
         [S (REGEXP-REPLACE* ".(?:[1-7][0-9]*|[1-9])" S
              (Λ(M) (MAKE-STRING (STRING->NUMBER (SUBSTRING M 1))
                                 (STRING-REF M 0))))])
    (PRINTF S YR))
  (FOR-EACH (COMPOSE1 DISPLAYLN STRING-TITLECASE)
    (DROPF-RIGHT (FOR*/LIST ([3MS (NSPLIT 3 MONTHS)] [S (APPLY MAP LIST 3MS)])
                   (REGEXP-REPLACE " +$" (STRING-JOIN S "   ") ""))
                 (Λ(S) (EQUAL? "" S)))))

(CALENDAR 1969))


/*REXX PROGRAM TO SHOW ANY YEAR'S (MONTHLY) CALENDAR (WITH/WITHOUT GRID)*/
@ABC=
PARSE VALUE SCRSIZE()  WITH  SD  SW .
DO J=0 TO 255;_=D2C(J);IF DATATYPE(_,'L') THEN @[email protected]||_;END
@[email protected]; UPPER @ABCU
DAYS_='SUNDAY MONDAY TUESDAY WEDNESDAY THURSDAY FRIDAY SATURDAY'
MONTHS_='JANUARY FEBRUARY MARCH APRIL MAY JUNE JULY AUGUST SEPTEMBER OCTOBER NOVEMBER DECEMBER'
DAYS=; MONTHS=
    DO J=1 FOR 7
    _=LOWER(WORD(DAYS_,J))
    DAYS=DAYS TRANSLATE(LEFT(_,1))SUBSTR(_,2)
    END
          DO J=1 FOR 12
          _=LOWER(WORD(MONTHS_,J))
          MONTHS=MONTHS TRANSLATE(LEFT(_,1))SUBSTR(_,2)
          END
CALFILL=' '; MC=12; _='1 3 1234567890' "FB"X
PARSE VAR _ GRID CALSPACES # CHK . CV_ DAYS.1 DAYS.2 DAYS.3 DAYSN
_=0; PARSE VAR _ COLS 1 JD 1 LOWERCASE 1 MAXKALPUTS 1 NARROW 1,
                 NARROWER 1 NARROWEST 1 SHORT 1 SHORTER 1 SHORTEST 1,
                 SMALL 1 SMALLER 1 SMALLEST 1 UPPERCASE
PARSE ARG MM '/' DD "/" YYYY _ '(' OPS;  UOPS=OPS
IF _\=='' | \IS#(MM) | \IS#(DD) | \IS#(YYYY) THEN CALL ERX 86

@CALMONTHS ='CALMON'   || LOWER('THS')
@CALSPACES ='CALSP'    || LOWER('ACES')
@DEPTH     ='DEP'      || LOWER('TH')
@GRIDS     ='GRID'     || LOWER('S')
@LOWERCASE ='LOW'      || LOWER('ERCASE')
@NARROW    ='NAR'      || LOWER('ROW')
@NARROWER  ='NARROWER'
@NARROWEST ='NARROWES' || LOWER('T')
@SHORT     ='SHOR'     || LOWER('T')
@SHORTER   ='SHORTER'
@SHORTEST  ='SHORTES'  || LOWER('T')
@UPPERCASE ='UPP'      || LOWER('ERCASE')
@WIDTH     ='WID'      || LOWER('TH')
  DO WHILE OPS\==''; OPS=STRIP(OPS,'L'); PARSE VAR OPS _1 2 1 _ . 1 _O OPS
  UPPER _
       SELECT
       WHEN  ABB(@CALMONTHS)  THEN        MC=NAI()
       WHEN  ABB(@CALSPACES)  THEN CALSPACES=NAI()
       WHEN  ABB(@DEPTH)      THEN        SD=NAI()
       WHEN ABBN(@GRIDS)      THEN      GRID=NO()
       WHEN ABBN(@LOWERCASE)  THEN LOWERCASE=NO()
       WHEN ABBN(@NARROW)     THEN    NARROW=NO()
       WHEN ABBN(@NARROWER)   THEN  NARROWER=NO()
       WHEN ABBN(@NARROWEST)  THEN NARROWEST=NO()
       WHEN ABBN(@SHORT)      THEN     SHORT=NO()
       WHEN ABBN(@SHORTER)    THEN   SHORTER=NO()
       WHEN ABBN(@SHORTEST)   THEN  SHORTEST=NO()
       WHEN ABBN(@SMALL)      THEN     SMALL=NO()
       WHEN ABBN(@SMALLER)    THEN   SMALLER=NO()
       WHEN ABBN(@SMALLEST)   THEN  SMALLEST=NO()
       WHEN ABBN(@UPPERCASE)  THEN UPPERCASE=NO()
       WHEN  ABB(@WIDTH)      THEN        SW=NAI()
       OTHERWISE NOP
       END    /*SELECT*/
  END         /*DO WHILE OPTS\== ...*/

IF SD==0  THEN SD= 43;  SD= SD-3
IF SW==0  THEN SW= 80;  SW= SW-1
MC=INT(MC,'MONTHSCALENDER'); IF MC>0 THEN CAL=1
DAYS=' 'DAYS;  MONTHS=' 'MONTHS
CYYYY=RIGHT(DATE(),4);  HYY=LEFT(CYYYY,2);  LYY=RIGHT(CYYYY,2)
DY.=31; _=30; PARSE VAR _ DY.4 1 DY.6 1 DY.9 1 DY.11; DY.2=28+LY(YYYY)
YY=RIGHT(YYYY,2);  CW=10;  CINDENT=1;  CALWIDTH=76
IF SMALL    THEN DO; NARROW=1   ; SHORT=1   ; END
IF SMALLER  THEN DO; NARROWER=1 ; SHORTER=1 ; END
IF SMALLEST THEN DO; NARROWEST=1; SHORTEST=1; END
IF SHORTEST THEN SHORTER=1
IF SHORTER  THEN SHORT  =1
IF NARROW    THEN DO; CW=9; CINDENT=3; CALWIDTH=69; END
IF NARROWER  THEN DO; CW=4; CINDENT=1; CALWIDTH=34; END
IF NARROWEST THEN DO; CW=2; CINDENT=1; CALWIDTH=20; END
CV_=CALWIDTH+CALSPACES+2
CALFILL=LEFT(COPIES(CALFILL,CW),CW)
      DO J=1 FOR 7;         _=WORD(DAYS,J)
            DO JW=1 FOR 3;  _D=STRIP(SUBSTR(_,CW*JW-CW+1,CW))
            IF JW=1 THEN _D=CENTRE(_D,CW+1)
                    ELSE _D=LEFT(_D,CW+1)
            DAYS.JW=DAYS.JW||_D
            END   /*JW*/
      __=DAYSN
      IF NARROWER  THEN DAYSN=__||CENTRE(LEFT(_,3),5)
      IF NARROWEST THEN DAYSN=__||CENTER(LEFT(_,2),3)
      END   /*J*/
_YYYY=YYYY; CALPUTS=0; CV=1; _MM=MM+0; MONTH=WORD(MONTHS,MM)
DY.2=28+LY(_YYYY); DIM=DY._MM; _DD=01; DOW=DOW(_MM,_DD,_YYYY); $DD=DD+0

/*─────────────────────────────NOW: THE BUSINESS OF THE BUILDING THE CAL*/
CALL CALGEN
               DO _J=2 TO MC
               IF CV_\=='' THEN DO
                                CV=CV+CV_
                                IF CV+CV_>=SW THEN DO; CV=1; CALL CALPUT
                                                   CALL FCALPUTS;CALL CALPB
                                                   END
                                              ELSE CALPUTS=0
                                END
                           ELSE DO;CALL CALPB;CALL CALPUT;CALL FCALPUTS;END
               _MM=_MM+1;  IF _MM==13 THEN DO;  _MM=1; _YYYY=_YYYY+1;  END
               MONTH=WORD(MONTHS,_MM); DY.2=28+LY(_YYYY); DIM=DY._MM
               DOW=DOW(_MM,_DD,_YYYY); $DD=0; CALL CALGEN
               END   /*_J*/
CALL FCALPUTS
RETURN _

/*─────────────────────────────CALGEN SUBROUTINE────────────────────────*/
CALGEN: CELLX=;CELLJ=;CELLM=;CALCELLS=0;CALLINE=0
CALL CALPUT
CALL CALPUTL COPIES('─',CALWIDTH),"┌┐"; CALL CALHD
CALL CALPUTL MONTH ' ' _YYYY          ; CALL CALHD
IF NARROWEST | NARROWER THEN CALL CALPUTL DAYSN
                        ELSE DO JW=1 FOR 3
                             IF SPACE(DAYS.JW)\=='' THEN CALL CALPUTL DAYS.JW
                             END
CALFT=1; CALFB=0
  DO JF=1 FOR DOW-1; CALL CELLDRAW CALFILL,CALFILL; END
  DO JY=1 FOR DIM; CALL CELLDRAW JY; END
CALFB=1
  DO 7; CALL CELLDRAW CALFILL,CALFILL; END
IF SD>32 & \SHORTER THEN CALL CALPUT
RETURN

/*─────────────────────────────CELLDRAW SUBROUTINE──────────────────────*/
CELLDRAW: PARSE ARG ZZ,CDDOY;ZZ=RIGHT(ZZ,2);CALCELLS=CALCELLS+1
IF CALCELLS>7 THEN DO
                   CALLINE=CALLINE+1
                   CELLX=SUBSTR(CELLX,2)
                   CELLJ=SUBSTR(CELLJ,2)
                   CELLM=SUBSTR(CELLM,2)
                   CELLB=TRANSLATE(CELLX,,")(─-"#)
                   IF CALLINE==1 THEN CALL CX
                   CALL CALCSM; CALL CALPUTL CELLX; CALL CALCSJ; CALL CX
                   CELLX=; CELLJ=; CELLM=; CALCELLS=1
                   END
CDDOY=RIGHT(CDDOY,CW); CELLM=CELLM'│'CENTER('',CW)
CELLX=CELLX'│'CENTRE(ZZ,CW); CELLJ=CELLJ'│'CENTER('',CW)
RETURN

/*═════════════════════════════GENERAL 1-LINE SUBS══════════════════════*/
ABB:ARG ABBU;PARSE ARG ABB;RETURN ABBREV(ABBU,_,ABBL(ABB))
ABBL:RETURN VERIFY(ARG(1)LEFT(@ABC,1),@ABC,'M')-1
ABBN:PARSE ARG ABBN;RETURN ABB(ABBN)|ABB('NO'ABBN)
CALCSJ:IF SD>49&\SHORTER THEN CALL CALPUTL CELLB;IF SD>24&\SHORT THEN CALL CALPUTL CELLJ; RETURN
CALCSM:IF SD>24&\SHORT THEN CALL CALPUTL CELLM;IF SD>49&\SHORTER THEN CALL CALPUTL CELLB;RETURN
CALHD:IF SD>24&\SHORTER THEN CALL CALPUTL;IF SD>32&\SHORTEST THEN CALL CALPUTL;RETURN
CALPB:IF \GRID&SHORTEST THEN CALL PUT CHK;RETURN
CALPUT:CALPUTS=CALPUTS+1;MAXKALPUTS=MAX(MAXKALPUTS,CALPUTS);IF SYMBOL('CT.'CALPUTS)\=='VAR' THEN CT.CALPUTS=;CT.CALPUTS=OVERLAY(ARG(1),CT.CALPUTS,CV);RETURN
CALPUTL:CALL CALPUT COPIES(' ',CINDENT)LEFT(ARG(2)"│",1)CENTER(ARG(1),CALWIDTH)||RIGHT('│'ARG(2),1);RETURN
CX:CX_='├┤';CX=COPIES(COPIES('─',CW)'┼',7);IF CALFT THEN DO;CX=TRANSLATE(CX,'┬',"┼");CALFT=0;END;IF CALFB THEN DO;CX=TRANSLATE(CX,'┴',"┼");CX_='└┘';CALFB=0;END;CALL CALPUTL CX,CX_;RETURN
DOW:PROCEDURE;ARG M,D,Y;IF M<3 THEN DO;M=M+12;Y=Y-1;END;YL=LEFT(Y,2);YR=RIGHT(Y,2);W=(D+(M+1)*26%10+YR+YR%4+YL%4+5*YL)//7;IF W==0 THEN W=7;RETURN W
ER:PARSE ARG _1,_2;CALL '$ERR' "14"P(_1) P(WORD(_1,2) !FID(1)) _2;IF _1<0 THEN RETURN _1;EXIT RESULT
ERR:CALL ER '-'ARG(1),ARG(2);RETURN ''
ERX:CALL ER '-'ARG(1),ARG(2);EXIT ''
FCALPUTS: DO J=1 FOR MAXKALPUTS;CALL PUT CT.J;END;CT.=;MAXKALPUTS=0;CALPUTS=0;RETURN
INT:INT=NUMX(ARG(1),ARG(2));IF \ISINT(INT) THEN CALL ERX 92,ARG(1) ARG(2);RETURN INT/1
IS#:RETURN VERIFY(ARG(1),#)==0
ISINT:RETURN DATATYPE(ARG(1),'W')
LOWER:RETURN TRANSLATE(ARG(1),@ABC,@ABCU)
LY:ARG _;IF LENGTH(_)==2 THEN _=HYY||_;LY=_//4==0;IF LY==0 THEN RETURN 0;LY=((_//100\==0)|_//400==0);RETURN LY
NA:IF ARG(1)\=='' THEN CALL ERX 01,ARG(2);PARSE VAR OPS NA OPS;IF NA=='' THEN CALL ERX 35,_O;RETURN NA
NAI:RETURN INT(NA(),_O)
NAN:RETURN NUMX(NA(),_O)
NO:IF ARG(1)\=='' THEN CALL ERX 01,ARG(2);RETURN LEFT(_,2)\=='NO'
NUM:PROCEDURE;PARSE ARG X .,F,Q;IF X=='' THEN RETURN X;IF DATATYPE(X,'N') THEN RETURN X/1;X=SPACE(TRANSLATE(X,,','),0);IF DATATYPE(X,'N') THEN RETURN X/1;RETURN NUMNOT()
NUMNOT:IF Q==1 THEN RETURN X;IF Q=='' THEN CALL ER 53,X F;CALL ERX 53,X F
NUMX:RETURN NUM(ARG(1),ARG(2),1)
P:RETURN WORD(ARG(1),1)
PUT:_=ARG(1);_=TRANSLATE(_,,'_'CHK);IF \GRID THEN _=UNGRID(_);IF LOWERCASE THEN _=LOWER(_);IF UPPERCASE THEN UPPER _;IF SHORTEST&_=' ' THEN RETURN;CALL TELL _;RETURN
TELL:SAY ARG(1);RETURN
UNGRID:RETURN TRANSLATE(ARG(1),,"│║─═┤┐└┴┬├┼┘┌╔╗╚╝╟╢╞╡╫╪╤╧╥╨╠╣")


# PROJECT : CALENDAR - FOR "REAL" PROGRAMMERS
# DATE      : 2018/06/28
# AUTHOR : GAL ZSOLT (~ CALMOSOFT ~)
# EMAIL    : <[email protected]>

LOAD "GUILIB.RING"
LOAD "STDLIB.RING"

NEW QAPP
       {
        WIN1 = NEW QWIDGET() {
                   DAY = LIST(12)
                   POS = NEWLIST(12,37)
                   MONTH = LIST(12)
                   WEEK = LIST(7)
                   WEEKDAY = LIST(7)
                   BUTTON = NEWLIST(7,6)
                   MONTHSNAMES = LIST(12)
                   WEEK = ["SU", "MO", "TU", "WE", "TH", "FR", "SA"]
                   MONTHS = ["JANUARY", "FEBRUARY", "MARCH", "APRIL", "MAY", "JUNE", "JULY",
                                   "AUGUST", "SEPTEMBER", "OCTOBER", "NOVEMBER", "DECEMBER"]
                   DAYSNEW = [[5,1], [6,2], [7,3], [1,4], [2,5], [3,6], [4,7]]
                   MO = [4,0,0,3,5,1,3,6,2,4,0,2]
                   MON = [31,28,31,30,31,30,31,31,30,31,30,31]
                   M2 = (((1969-1900)%7) + FLOOR((1969 - 1900)/4) % 7) % 7
                   FOR N = 1 TO 12
                        MONTH[N] = (MO[N] + M2) % 7
                        X = (MONTH[N] + 1) % 7 + 1
                       FOR M = 1 TO LEN(DAYSNEW)
                            IF DAYSNEW[M][1] = X
                              NR = M
                           OK
                       NEXT
                       DAY[N] = DAYSNEW[NR][2]
                  NEXT
                  FOR M = 1 TO 12
                       FOR N = 1 TO DAY[M] - 1
                            POS[M][N] = "  "
                       NEXT
                  NEXT
                  FOR M = 1 TO 12
                       FOR  N = DAY[M] TO 37
                             IF N < (MON[M] + DAY[M])
                                POS[M][N] = N - DAY[M] + 1
                             ELSE
                                POS[M][N] = "  "
                             OK
                       NEXT
                  NEXT
                  SETWINDOWTITLE("CALENDAR")
                  SETGEOMETRY(100,100,650,800)
                  LABEL1 = NEW QLABEL(WIN1) {
                              SETGEOMETRY(10,10,800,600)
                              SETTEXT("")
                  }
                 YEAR = NEW QPUSHBUTTON(WIN1)
                                                  {
                                                  SETGEOMETRY(280,20,63,20)
                                                  YEAR.SETTEXT("1969")
                                                  }
                 FOR N = 1 TO 4
                      NR = (N-1)*3+1
                     SHOWMONTHS(NR)
                 NEXT
                 FOR N = 1 TO 12
                     SHOWWEEKS(N)
                 NEXT
                 FOR N = 1 TO 12
                     SHOWDAYS(N)
                 NEXT
                 SHOW()
        }
        EXEC()
        }

FUNC SHOWMONTHS(M)
       FOR N = M TO M + 2
            MONTHSNAMES[N] = NEW QPUSHBUTTON(WIN1)
                                        {
                                        IF N%3 = 1
                                           COL = 120
                                           ROWNR = FLOOR(N/3)
                                           IF ROWNR = 0
                                              ROWNR = N/3
                                           OK
                                           IF N = 1
                                              ROW = 40
                                           ELSE
                                              ROW = 40+ROWNR*180
                                           OK
                                        ELSE
                                           COLNR = N%3
                                           IF COLNR = 0
                                              COLNR = 3
                                           OK
                                           ROWNR = FLOOR(N/3)
                                           IF N%3 = 0
                                              ROWNR = FLOOR(N/3)-1
                                           OK
                                           COL = 120 + (COLNR-1)*160
                                           ROW = 40 + ROWNR*180
                                        OK
                                        SETGEOMETRY(COL,ROW,63,20)
                                        MONTHSNAMES[N].SETTEXT(MONTHS[N])
                                        }
       NEXT

FUNC SHOWWEEKS(N)
        FOR M = 1 TO 7
             COL = M%7
             IF COL = 0 COL = 7 OK
             WEEKDAY[M] = NEW QPUSHBUTTON(WIN1)
                                  {
                                  COLNR = N % 3
                                  IF COLNR = 0
                                     COLNR = 3
                                  OK
                                  ROWNR = FLOOR(N/3)
                                  IF N%3 = 0
                                     ROWNR = FLOOR(N/3)-1
                                  OK
                                  COLBEGIN = 60 + (COLNR-1)*160
                                  ROWBEGIN = 60 + (ROWNR)*180
                                  SETGEOMETRY(COLBEGIN+COL*20,ROWBEGIN,25,20)
                                  WEEKDAY[M].SETTEXT(WEEK[M])
                                  }
        NEXT

FUNC SHOWDAYS(IND)
        ROWNR = FLOOR(IND/3)
        IF IND%3 = 0
           ROWNR = FLOOR(IND/3)-1
        OK
        ROWBEGIN = 60+ROWNR*180
        FOR M = 1 TO 6
             FOR N = 1 TO 7
                  COL = N%7
                  IF COL = 0 COL = 7 OK
                  ROW = M
                   BUTTON[N][M] = NEW QPUSHBUTTON(WIN1)
                                         {
                                          IF IND%3 = 1
                                             COLBEGIN = 60
                                          ELSEIF IND%3 = 2
                                             COLBEGIN = 220
                                          ELSE
                                             COLBEGIN = 380
                                          OK
                                          SETGEOMETRY(COLBEGIN+COL*20,ROWBEGIN+ROW*20,25,20)
                                          NR = (M-1)*7+N
                                          IF NR <= 37
                                             IF POS[IND][NR] != "  "
                                                BUTTON[N][M].SETTEXT(STRING(POS[IND][NR]))
                                             OK
                                          OK
                                          }
             NEXT
        NEXT


# loadup.rb - run UPPERCASE RUBY program

class Object
  alias lowercase_method_missing method_missing

  # Allow UPPERCASE method calls.
  def method_missing(sym, *args, &block)
    str = sym.to_s
    if str == (down = str.downcase)
      lowercase_method_missing sym, *args, &block
    else
      send down, *args, &block
    end
  end

  # RESCUE an exception without the 'rescue' keyword.
  def RESCUE(_BEGIN, _CLASS, _RESCUE)
    begin _BEGIN.CALL
    rescue _CLASS
      _RESCUE.CALL; end
  end
end

_PROGRAM = ARGV.SHIFT
_PROGRAM || ABORT("USAGE: #{$0} PROGRAM.RB ARGS...")
LOAD($0 = _PROGRAM)


$ INCLUDE "SEED7_05.S7I";
  INCLUDE "TIME.S7I";

CONST FUNC STRING: CENTER (IN STRING: STRI, IN INTEGER: LENGTH) IS
  RETURN ("" LPAD (LENGTH - LENGTH(STRI)) DIV 2 <& STRI) RPAD LENGTH;

CONST PROC: PRINTCALENDAR (IN INTEGER: YEAR, IN INTEGER: COLS) IS FUNC
  LOCAL
    VAR TIME: DATE IS TIME.VALUE;
    VAR INTEGER: DAYOFWEEK IS 0;
    CONST ARRAY STRING: MONTHNAMES IS [] ("JANUARY", "FEBRUARY", "MARCH", "APRIL", "MAY", "JUNE",
        "JULY", "AUGUST", "SEPTEMBER", "OCTOBER", "NOVEMBER", "DECEMBER");
    VAR ARRAY ARRAY STRING: MONTHTABLE IS 12 TIMES 9 TIMES "";
    VAR STRING: STR IS "";
    VAR INTEGER: MONTH IS 0;
    VAR INTEGER: POSITION IS 0;
    VAR INTEGER: ROW IS 0;
    VAR INTEGER: COLUMN IS 0;
    VAR INTEGER: LINE IS 0;
  BEGIN
    FOR MONTH RANGE 1 TO 12 DO
      MONTHTABLE[MONTH][1] := " " & CENTER(UPPER(MONTHNAMES[MONTH]), 20);
      MONTHTABLE[MONTH][2] := UPPER(" MO TU WE TH FR SA SU");
      DATE := DATE(YEAR, MONTH, 1);
      DAYOFWEEK := DAYOFWEEK(DATE);
      FOR POSITION RANGE 1 TO 43 DO
        IF POSITION >= DAYOFWEEK AND POSITION - DAYOFWEEK < DAYSINMONTH(DATE.YEAR, DATE.MONTH) THEN
          STR := SUCC(POSITION - DAYOFWEEK) LPAD 3;
        ELSE
          STR := "" LPAD 3;
        END IF;
        MONTHTABLE[MONTH][3 + PRED(POSITION) DIV 7] &:= STR;
      END FOR;
    END FOR;
    WRITELN(CENTER(UPPER("[SNOOPY PICTURE]"), COLS * 24 + 4));
    WRITELN(CENTER(STR(YEAR),COLS * 24 + 4));
    WRITELN;
    FOR ROW RANGE 1 TO SUCC(11 DIV COLS) DO
      FOR LINE RANGE 1 TO 9 DO
        FOR COLUMN RANGE 1 TO COLS DO
          IF PRED(ROW) * COLS + COLUMN <= 12 THEN
            WRITE("   " & MONTHTABLE[PRED(ROW) * COLS + COLUMN][LINE]);
          END IF;
        END FOR;
        WRITELN;
      END FOR;
    END FOR;
  END FUNC;

CONST PROC: MAIN IS FUNC
  BEGIN
    PRINTCALENDAR(1969, 3);
  END FUNC;


-> DT { ('DATE'.("\LWC") + 'TIME'.("\LWC")).("\LREQUIRE") }

-> MONTHS_PER_COL { 6 }
-> WEEK_DAY_NAMES { <MO TU WE TH FR SA SU> }
-> MONTH_NAMES    { <JAN FEB MAR APR MAY JUN JUL AUG SEP OCT NOV DEC> }

-> FMT_MONTH (YEAR, MONTH, STR="", WEEK_DAY=0) {
    STR  = "%11\LS\E%9\LS\E\12".("\LSPRINTF")(MONTH_NAMES()[MONTH-1],'')
    STR += (WEEK_DAY_NAMES().("\LJOIN")(' ') + "\12")

    -> DATE { DT().("\LNEW")("\LYEAR" => YEAR, "\LMONTH" => MONTH) }

    WEEK_DAY = DATE().("\LDAY_OF_WEEK")
    STR += (["  "] * WEEK_DAY-1 -> ("\LJOIN")(" "))

    -> LAST_DAY {
        DT().("\LLAST_DAY_OF_MONTH")(
            "\LYEAR" => YEAR, "\LMONTH" => MONTH
        ).("\LDAY")
    }

    (DATE().("\LDAY") .. LAST_DAY()).("\LEACH")({ |DAY|
        (WEEK_DAY ~~ (2..7)) && (STR += " ")

        (WEEK_DAY == 8) && (
            STR += "\12"
            WEEK_DAY = 1
        )
        STR += ("%2\LD" % DAY)
        ++WEEK_DAY
    })
    (WEEK_DAY < 8) && (STR += " ")
    STR += (["  "] * 8-WEEK_DAY -> ("\LJOIN")(" "))
    STR += "\12"
}

-> FMT_YEAR (YEAR, STR="", MONTH_STRS=[]) {
    MONTH_STRS = 12.("\LOF")({|I| FMT_MONTH(YEAR, I+1).("\LLINES") })

    STR += (' '*(MONTHS_PER_COL()*10 + 2) + YEAR + "\12")
    (0..11 -> ("\LBY")(MONTHS_PER_COL())).("\LEACH")({ |MONTH|
        MONTH_STRS[MONTH] && ->() {
            { |I|
                MONTH_STRS[MONTH + I] && (
                    STR += MONTH_STRS[MONTH + I].("\LSHIFT")
                    STR += ' '*2
                )
            } * MONTHS_PER_COL()

            STR += "\12"
            MONTH_STRS[MONTH] && __FUNC__()
        }()
        STR += "\12"
    })

    STR
}

FMT_YEAR(ARGV ? ARGV[0].("\LTO_I") : 1969).("\LPRINT")


V e0 = 0.0
V e = 2.0
V n = 0
V fact = 1
L (e - e0 > 1e-15)
   e0 = e
   n++
   fact *= 2 * n * (2 * n + 1)
   e += (2.0 * n + 2) / fact

print(‘Computed e = ’e)
print(‘Real e = ’math:e)
print(‘Error = ’(math:e - e))
print(‘Number of iterations = ’n)


*        Calculating the value of e - 21/07/2018
CALCE    PROLOG
         LE     F0,=E'0'
         STE    F0,EOLD            eold=0
         LE     F2,=E'1'           e=1
         LER    F4,F2              xi=1
         LER    F6,F2              facti=1
BWHILE   CE     F2,EOLD            while e<>eold
         BE     EWHILE             ~
         STE    F2,EOLD              eold=e
         LE     F0,=E'1'             1
         DER    F0,F6                1/facti
         AER    F2,F0                e=e+1/facti
         AE     F4,=E'1'             xi=xi+1
         MER    F6,F4                facti=facti*xi
         LER    F0,F4                xi
         B      BWHILE             end while
EWHILE   LER    F0,F2              e
         LA     R0,5               number of decimals
         BAL    R14,FORMATF        format a float number
         MVC    PG(13),0(R1)       output e
         XPRNT  PG,L'PG            print e
         EPILOG
         COPY   FORMATF            format a float number
EOLD     DS     E                  eold
PG       DC     CL80' '            buffer
         REGEQU
         END    CALCE


INCLUDE "H6:REALMATH.ACT"

PROC Euler(REAL POINTER e)
  REAL e0,fact,tmp,tmp2,one
  INT n

  IntToReal(1,one)
  IntToReal(2,e)
  IntToReal(1,fact)
  n=2

  DO
    RealAssign(e,e0)
    IntToReal(n,tmp)
    RealMult(fact,tmp,tmp2)
    RealAssign(tmp2,fact)
    n==+1
    RealDiv(one,fact,tmp)
    RealAdd(e,tmp,tmp2)
    RealAssign(tmp2,e)
  UNTIL RealGreaterOrEqual(e0,e)
  OD
RETURN

PROC Main()
  REAL e,calc,diff

  Put(125) PutE() ;clear screen
  ValR("2.71828183",e)
  Euler(calc)
  RealSub(calc,e,diff)
  Print("      real e=") PrintRE(e)
  Print("calculated e=") PrintRE(calc)
  Print("       error=") PrintRE(diff)
RETURN


with Ada.Text_IO;            use Ada.Text_IO;
with Ada.Long_Float_Text_IO; use Ada.Long_Float_Text_IO;

procedure Euler is
   Epsilon : constant     := 1.0E-15;
   Fact    : Long_Integer := 1;
   E       : Long_Float   := 2.0;
   E0      : Long_Float   := 0.0;
   N       : Long_Integer := 2;

begin

   loop
      E0   := E;
      Fact := Fact * N;
      N    := N + 1;
      E    := E + (1.0 / Long_Float (Fact));
      exit when abs (E - E0) < Epsilon;
   end loop;

   Put ("e = ");
   Put (E, 0, 15, 0);
   New_Line;

end Euler;


BEGIN
    # calculate an approximation to e #
    LONG REAL epsilon = 1.0e-15;
    LONG INT  fact   := 1;
    LONG REAL e      := 2;
    LONG INT  n      := 2;
    WHILE
        LONG REAL e0 = e;
        fact *:= n;
        n    +:= 1;
        e    +:= 1.0 / fact;
        ABS ( e - e0 ) >= epsilon
    DO SKIP OD;
    print( ( "e = ", fixed( e, -17, 15 ), newline ) )
END


--------------- CALCULATING THE VALUE OF E ----------------
on run

    sum(map(inverse, ¬
        scanl(product, 1, enumFromTo(1, 16))))

    --> 2.718281828459

end run

-- inverse :: Float -> Float
on inverse(x)
    1 / x
end inverse

-- product :: Float -> Float -> Float
on product(a, b)
    a * b
end product

--------------------- GENERIC FUNCTIONS ---------------------

-- enumFromTo :: Int -> Int -> [Int]
on enumFromTo(m, n)
    if m ≤ n then
        set lst to {}
        repeat with i from m to n
            set end of lst to i
        end repeat
        lst
    else
        {}
    end if
end enumFromTo

-- foldl :: (a -> b -> a) -> a -> [b] -> a
on foldl(f, startValue, xs)
    tell mReturn(f)
        set v to startValue
        set lng to length of xs
        repeat with i from 1 to lng
            set v to |λ|(v, item i of xs, i, xs)
        end repeat
        return v
    end tell
end foldl

-- Lift 2nd class handler function into 1st class script wrapper
-- mReturn :: First-class m => (a -> b) -> m (a -> b)
on mReturn(f)
    if class of f is script then
        f
    else
        script
            property |λ| : f
        end script
    end if
end mReturn

-- map :: (a -> b) -> [a] -> [b]
on map(f, xs)
    -- The list obtained by applying f
    -- to each element of xs.
    tell mReturn(f)
        set lng to length of xs
        set lst to {}
        repeat with i from 1 to lng
            set end of lst to |λ|(item i of xs, i, xs)
        end repeat
        return lst
    end tell
end map

-- scanl :: (b -> a -> b) -> b -> [a] -> [b]
on scanl(f, startValue, xs)
    tell mReturn(f)
        set v to startValue
        set lng to length of xs
        set lst to {startValue}
        repeat with i from 1 to lng
            set v to |λ|(v, item i of xs, i, xs)
            set end of lst to v
        end repeat
        return lst
    end tell
end scanl

-- sum :: [Num] -> Num
on sum(xs)
    script add
        on |λ|(a, b)
            a + b
        end |λ|
    end script

    foldl(add, 0, xs)
end sum


OPTION COMPARE BINARY
OPTION EXPLICIT ON
OPTION INFER ON
OPTION STRICT ON

IMPORTS SYSTEM.GLOBALIZATION
IMPORTS SYSTEM.TEXT
IMPORTS SYSTEM.RUNTIME.INTEROPSERVICES
IMPORTS SYSTEM.RUNTIME.COMPILERSERVICES

MODULE ARGHELPER
    READONLY _ARGDICT AS NEW DICTIONARY(OF STRING, STRING)()

    DELEGATE FUNCTION TRYPARSE(OF T, TRESULT)(VALUE AS T, <OUT> BYREF RESULT AS TRESULT) AS BOOLEAN

    SUB INITIALIZEARGUMENTS(ARGS AS STRING())
        FOR EACH ITEM IN ARGS
            ITEM = ITEM.TOUPPERINVARIANT()

            IF ITEM.LENGTH > 0 ANDALSO ITEM(0) <> """"C THEN
                DIM COLONPOS = ITEM.INDEXOF(":"C, STRINGCOMPARISON.ORDINAL)

                IF COLONPOS <> -1 THEN
                    ' SPLIT ARGUMENTS WITH COLUMNS INTO KEY(PART BEFORE COLON) / VALUE(PART AFTER COLON) PAIRS.
                    _ARGDICT.ADD(ITEM.SUBSTRING(0, COLONPOS), ITEM.SUBSTRING(COLONPOS + 1, ITEM.LENGTH - COLONPOS - 1))
                END IF
            END IF
        NEXT
    END SUB

    SUB FROMARGUMENT(OF T)(
            KEY AS STRING,
            <OUT> BYREF VAR AS T,
            GETDEFAULT AS FUNC(OF T),
            TRYPARSE AS TRYPARSE(OF STRING, T),
            OPTIONAL VALIDATE AS PREDICATE(OF T) = NOTHING)

        DIM VALUE AS STRING = NOTHING
        IF _ARGDICT.TRYGETVALUE(KEY.TOUPPERINVARIANT(), VALUE) THEN
            IF NOT (TRYPARSE(VALUE, VAR) ANDALSO (VALIDATE IS NOTHING ORELSE VALIDATE(VAR))) THEN
                CONSOLE.WRITELINE($"INVALID VALUE FOR {KEY}: {VALUE}")
                ENVIRONMENT.EXIT(-1)
            END IF
        ELSE
            VAR = GETDEFAULT()
        END IF
    END SUB
END MODULE

MODULE PROGRAM
    SUB MAIN(ARGS AS STRING())
        DIM DT AS DATE
        DIM COLUMNS, ROWS, MONTHSPERROW AS INTEGER
        DIM VERTSTRETCH, HORIZSTRETCH, RESIZEWINDOW AS BOOLEAN

        INITIALIZEARGUMENTS(ARGS)
        FROMARGUMENT("DATE", DT, FUNCTION() NEW DATE(1969, 1, 1), ADDRESSOF DATE.TRYPARSE)
        FROMARGUMENT("COLS", COLUMNS, FUNCTION() 80, ADDRESSOF INTEGER.TRYPARSE, FUNCTION(V) V >= 20)
        FROMARGUMENT("ROWS", ROWS, FUNCTION() 43, ADDRESSOF INTEGER.TRYPARSE, FUNCTION(V) V >= 0)
        FROMARGUMENT("MS/ROW", MONTHSPERROW, FUNCTION() 0, ADDRESSOF INTEGER.TRYPARSE, FUNCTION(V) V <= 12 ANDALSO V <= COLUMNS \ 20)
        FROMARGUMENT("VSTRETCH", VERTSTRETCH, FUNCTION() TRUE, ADDRESSOF BOOLEAN.TRYPARSE)
        FROMARGUMENT("HSTRETCH", HORIZSTRETCH, FUNCTION() TRUE, ADDRESSOF BOOLEAN.TRYPARSE)
        FROMARGUMENT("WSIZE", RESIZEWINDOW, FUNCTION() TRUE, ADDRESSOF BOOLEAN.TRYPARSE)

        ' THE SCROLL BAR IN COMMAND PROMPT SEEMS TO TAKE UP PART OF THE LAST COLUMN.
        IF RESIZEWINDOW THEN
            CONSOLE.WINDOWWIDTH = COLUMNS + 1
            CONSOLE.WINDOWHEIGHT = ROWS
        END IF

        IF MONTHSPERROW < 1 THEN MONTHSPERROW = MATH.MAX(COLUMNS \ 22, 1)

        FOR EACH ROW IN GETCALENDARROWS(DT:=DT, WIDTH:=COLUMNS, HEIGHT:=ROWS, MONTHSPERROW:=MONTHSPERROW, VERTSTRETCH:=VERTSTRETCH, HORIZSTRETCH:=HORIZSTRETCH)
            CONSOLE.WRITE(ROW)
        NEXT
    END SUB

    ITERATOR FUNCTION GETCALENDARROWS(
            DT AS DATE,
            WIDTH AS INTEGER,
            HEIGHT AS INTEGER,
            MONTHSPERROW AS INTEGER,
            VERTSTRETCH AS BOOLEAN,
            HORIZSTRETCH AS BOOLEAN) AS IENUMERABLE(OF STRING)

        DIM YEAR = DT.YEAR
        DIM CALENDARROWCOUNT AS INTEGER = CINT(MATH.CEILING(12 / MONTHSPERROW))
        ' MAKE ROOM FOR THE THREE EMPTY LINES ON TOP.
        DIM MONTHGRIDHEIGHT AS INTEGER = HEIGHT - 3

        YIELD "[SNOOPY]".PADCENTER(WIDTH) & ENVIRONMENT.NEWLINE
        YIELD YEAR.TOSTRING(CULTUREINFO.INVARIANTCULTURE).PADCENTER(WIDTH) & ENVIRONMENT.NEWLINE
        YIELD ENVIRONMENT.NEWLINE

        DIM MONTH = 0
        DO WHILE MONTH < 12
            DIM ROWHIGHESTMONTH = MATH.MIN(MONTH + MONTHSPERROW, 12)

            DIM CELLWIDTH = WIDTH \ MONTHSPERROW
            DIM CELLCONTENTWIDTH = IF(MONTHSPERROW = 1, CELLWIDTH, (CELLWIDTH * 19) \ 20)

            DIM CELLHEIGHT = MONTHGRIDHEIGHT \ CALENDARROWCOUNT
            DIM CELLCONTENTHEIGHT = (CELLHEIGHT * 19) \ 20

            ' CREATES A MONTH CELL FOR THE SPECIFIED MONTH (1-12).
            DIM GETMONTHFROM =
                FUNCTION(M AS INTEGER) BUILDMONTH(
                    DT:=NEW DATE(DT.YEAR, M, 1),
                    WIDTH:=CELLCONTENTWIDTH,
                    HEIGHT:=CELLCONTENTHEIGHT,
                    VERTSTRETCH:=VERTSTRETCH,
                    HORIZSTRETCH:=HORIZSTRETCH).SELECT(FUNCTION(X) X.PADCENTER(CELLWIDTH))

            ' THE MONTHS IN THIS ROW OF THE CALENDAR.
            DIM MONTHSTHISROW AS IENUMERABLE(OF IENUMERABLE(OF STRING)) =
                ENUMERABLE.SELECT(ENUMERABLE.RANGE(MONTH + 1, ROWHIGHESTMONTH - MONTH), GETMONTHFROM)

            DIM CALENDARROW AS IENUMERABLE(OF STRING) =
                INTERLEAVED(
                    MONTHSTHISROW,
                    USEINNERSEPARATOR:=FALSE,
                    USEOUTERSEPARATOR:=TRUE,
                    OUTERSEPARATOR:=ENVIRONMENT.NEWLINE)

            DIM EN = CALENDARROW.GETENUMERATOR()
            DIM HASNEXT = EN.MOVENEXT()
            DO WHILE HASNEXT

                DIM CURRENT AS STRING = EN.CURRENT

                ' TO MAINTAIN THE (NOT STRICTLY NEEDED) CONTRACT OF YIELDING COMPLETE ROWS, KEEP THE NEWLINE AFTER
                ' THE CALENDAR ROW WITH THE LAST TERMINAL ROW OF THE ROW.
                HASNEXT = EN.MOVENEXT()
                YIELD IF(HASNEXT, CURRENT, CURRENT & ENVIRONMENT.NEWLINE)
            LOOP

            MONTH += MONTHSPERROW
        LOOP
    END FUNCTION

    ''' <SUMMARY>
    ''' INTERLEAVES THE ELEMENTS OF THE SPECIFIED SUB-SOURCES BY MAKING SUCCESSIVE PASSES THROUGH THE SOURCE
    ''' ENUMERABLE, YIELDING A SINGLE ELEMENT FROM EACH SUB-SOURCE IN SEQUENCE IN EACH PASS, OPTIONALLY INSERTING A
    ''' SEPARATOR BETWEEN ELEMENTS OF ADJACENT SUB-SOURCES AND OPTIONALLY A DIFFERENT SEPARATOR AT THE END OF EACH
    ''' PASS THROUGH ALL THE SOURCES. (I.E., BETWEEN ELEMENTS OF THE LAST AND FIRST SOURCE)
    ''' </SUMMARY>
    ''' <TYPEPARAM NAME="T">THE TYPE OF THE ELEMENTS OF THE SUB-SOURCES.</TYPEPARAM>
    ''' <PARAM NAME="SOURCES">A SEQUENCE OF THE SEQUENCES WHOSE ELEMENTS ARE TO BE INTERLEAVED.</PARAM>
    ''' <PARAM NAME="USEINNERSEPARATOR">WHETHER TO INSERT <PARAMREF NAME="USEINNERSEPARATOR"/> BETWEEN THE ELEMENTS OFADJACENT SUB-SOURCES.</PARAM>
    ''' <PARAM NAME="INNERSEPARATOR">THE SEPARATOR BETWEEN ELEMENTS OF ADJACENT SUB-SOURCES.</PARAM>
    ''' <PARAM NAME="USEOUTERSEPARATOR">WHETHER TO INSERT <PARAMREF NAME="OUTERSEPARATOR"/> BETWEEN THE ELEMENTS OF THE LAST AND FIRST SUB-SOURCES.</PARAM>
    ''' <PARAM NAME="OUTERSEPARATOR">THE SEPARATOR BETWEEN ELEMENTS OF THE LAST AND FIRST SUB-SOURCE.</PARAM>
    ''' <PARAM NAME="WHILEANY">IF <SEE LANGWORD="TRUE"/>, THE ENUMERATION CONTINUES UNTIL EVERY GIVEN SUBSOURCE IS EMPTY;
    ''' IF <SEE LANGWORD="FALSE"/>, THE ENUMERATION STOPS AS SOON AS ANY ENUMERABLE NO LONGER HAS AN ELEMENT TO SUPPLY FOR THE NEXT PASS.</PARAM>
    ITERATOR FUNCTION INTERLEAVED(OF T)(
            SOURCES AS IENUMERABLE(OF IENUMERABLE(OF T)),
            OPTIONAL USEINNERSEPARATOR AS BOOLEAN = FALSE,
            OPTIONAL INNERSEPARATOR AS T = NOTHING,
            OPTIONAL USEOUTERSEPARATOR AS BOOLEAN = FALSE,
            OPTIONAL OUTERSEPARATOR AS T = NOTHING,
            OPTIONAL WHILEANY AS BOOLEAN = TRUE) AS IENUMERABLE(OF T)
        DIM SOURCEENUMERATORS AS IENUMERATOR(OF T)() = NOTHING

        TRY
            SOURCEENUMERATORS = SOURCES.SELECT(FUNCTION(X) X.GETENUMERATOR()).TOARRAY()
            DIM NUMSOURCES = SOURCEENUMERATORS.LENGTH
            DIM ENUMERATORSTATES(NUMSOURCES - 1) AS BOOLEAN

            DIM ANYPREVITERS AS BOOLEAN = FALSE
            DO
                ' INDICES OF FIRST AND LAST SUB-SOURCES THAT HAVE ELEMENTS.
                DIM FIRSTACTIVE = -1, LASTACTIVE = -1

                ' DETERMINE WHETHER EACH SUB-SOURCE THAT STILL HAVE ELEMENTS.
                FOR I = 0 TO NUMSOURCES - 1
                    ENUMERATORSTATES(I) = SOURCEENUMERATORS(I).MOVENEXT()
                    IF ENUMERATORSTATES(I) THEN
                        IF FIRSTACTIVE = -1 THEN FIRSTACTIVE = I
                        LASTACTIVE = I
                    END IF
                NEXT

                ' DETERMINE WHETHER TO YIELD ANYTHING IN THIS ITERATION BASED ON WHETHER WHILEANY IS TRUE.
                ' NOT YIELDING ANYTHING THIS ITERATION IMPLIES THAT THE ENUMERATION HAS ENDED.
                DIM THISITERHASRESULTS AS BOOLEAN = IF(WHILEANY, FIRSTACTIVE <> -1, FIRSTACTIVE = 0 ANDALSO LASTACTIVE = NUMSOURCES - 1)
                IF NOT THISITERHASRESULTS THEN EXIT DO

                ' DON'T INSERT A SEPARATOR ON THE FIRST PASS.
                IF ANYPREVITERS THEN
                    IF USEOUTERSEPARATOR THEN YIELD OUTERSEPARATOR
                ELSE
                    ANYPREVITERS = TRUE
                END IF

                ' GO THROUGH AND YIELD FROM THE SUB-SOURCES THAT STILL HAVE ELEMENTS.
                FOR I = 0 TO NUMSOURCES - 1
                    IF ENUMERATORSTATES(I) THEN
                        ' DON'T INSERT A SEPARATOR BEFORE THE FIRST ELEMENT.
                        IF I > FIRSTACTIVE ANDALSO USEINNERSEPARATOR THEN YIELD INNERSEPARATOR
                        YIELD SOURCEENUMERATORS(I).CURRENT
                    END IF
                NEXT
            LOOP

        FINALLY
            IF SOURCEENUMERATORS ISNOT NOTHING THEN
                FOR EACH EN IN SOURCEENUMERATORS
                    EN.DISPOSE()
                NEXT
            END IF
        END TRY
    END FUNCTION

    ''' <SUMMARY>
    ''' RETURNS THE ROWS REPRESENTING ONE MONTH CELL WITHOUT TRAILING NEWLINES. APPROPRIATE LEADING AND TRAILING
    ''' WHITESPACE IS ADDED SO THAT EVERY ROW HAS THE LENGTH OF WIDTH.
    ''' </SUMMARY>
    ''' <PARAM NAME="DT">A DATE WITHIN THE MONTH TO REPRESENT.</PARAM>
    ''' <PARAM NAME="WIDTH">THE WIDTH OF THE CELL.</PARAM>
    ''' <PARAM NAME="HEIGHT">THE HEIGHT.</PARAM>
    ''' <PARAM NAME="VERTSTRETCH">IF <SEE LANGWORD="TRUE" />, BLANK ROWS ARE INSERTED TO FIT THE AVAILABLE HEIGHT.
    ''' OTHERWISE, THE CELL HAS A CONSTANT HEIGHT OF </PARAM>
    ''' <PARAM NAME="HORIZSTRETCH">IF <SEE LANGWORD="TRUE" />, THE SPACING BETWEEN INDIVIDUAL DAYS IS INCREASED TO
    ''' FIT THE AVAILABLE WIDTH. OTHERWISE, THE CELL HAS A CONSTANT WIDTH OF 20 CHARACTERS AND IS PADDED TO BE IN
    ''' THE CENTER OF THE EXPECTED WIDTH.</PARAM>
    ITERATOR FUNCTION BUILDMONTH(DT AS DATE, WIDTH AS INTEGER, HEIGHT AS INTEGER, VERTSTRETCH AS BOOLEAN, HORIZSTRETCH AS BOOLEAN) AS IENUMERABLE(OF STRING)
        CONST DAY_WDT = 2 ' WIDTH OF A DAY.
        CONST ALLDAYS_WDT = DAY_WDT * 7 ' WIDTH OF AL LDAYS COMBINED.

        ' NORMALIZE THE DATE TO JANUARY 1.
        DT = NEW DATE(DT.YEAR, DT.MONTH, 1)

        ' HORIZONTAL WHITESPACE BETWEEN DAYS OF THE WEEK. CONSTANT OF 6 REPRESENTS 6 SEPARATORS PER LINE.
        DIM DAYSEP AS NEW STRING(" "C, MATH.MIN((WIDTH - ALLDAYS_WDT) \ 6, IF(HORIZSTRETCH, INTEGER.MAXVALUE, 1)))
        ' NUMBER OF BLANK LINES BETWEEN ROWS.
        DIM VERTBLANKCOUNT = IF(NOT VERTSTRETCH, 0, (HEIGHT - 8) \ 7)

        ' WIDTH OF EACH DAY * 7 DAYS IN ONE ROW + DAY SEPARATOR LENGTH * 6 SEPARATORS PER LINE.
        DIM BLOCKWIDTH = ALLDAYS_WDT + DAYSEP.LENGTH * 6

        ' THE WHITESPACE AT THE BEGINNING OF EACH LINE.
        DIM LEFTPAD AS NEW STRING(" "C, (WIDTH - BLOCKWIDTH) \ 2)
        ' THE WHITESPACE FOR BLANK LINES.
        DIM FULLPAD AS NEW STRING(" "C, WIDTH)

        ' LINES ARE "STAGED" IN THE STRINGBUILDER.
        DIM SB AS NEW STRINGBUILDER(LEFTPAD)
        DIM NUMLINES = 0

        ' GET THE CURRENT LINE SO FAR FORM THE STRINGBUILDER AND BEGIN A NEW LINE.
        ' RETURNS THE CURRENT LINE AND TRAILING BLANK LINES USED FOR VERTICAL PADDING (IF ANY).
        ' RETURNS EMPTY ENUMERABLE IF THE HEIGHT REQUIREMENT HAS BEEN REACHED.
        DIM ENDLINE =
         FUNCTION() AS IENUMERABLE(OF STRING)
             DIM FINISHEDLINE AS STRING = SB.TOSTRING().PADRIGHT(WIDTH)
             SB.CLEAR()
             SB.APPEND(LEFTPAD)

             ' USE AN INNER ITERATOR TO PREVENT LAZY EXECUTION OF SIDE EFFECTS OF OUTER FUNCTION.
             RETURN IF(NUMLINES >= HEIGHT,
                 ENUMERABLE.EMPTY(OF STRING)(),
                 ITERATOR FUNCTION() AS IENUMERABLE(OF STRING)
                     YIELD FINISHEDLINE
                     NUMLINES += 1

                     FOR I = 1 TO VERTBLANKCOUNT
                         IF NUMLINES >= HEIGHT THEN RETURN
                         YIELD FULLPAD
                         NUMLINES += 1
                     NEXT
                 END FUNCTION())
         END FUNCTION

        ' YIELD THE MONTH NAME.
        SB.APPEND(PADCENTER(DT.TOSTRING("MMMM", CULTUREINFO.INVARIANTCULTURE), BLOCKWIDTH).TOUPPER())
        FOR EACH L IN ENDLINE()
            YIELD L
        NEXT

        ' YIELD THE HEADER OF WEEKDAY NAMES.
        DIM WEEKNMABBREVS = [ENUM].GETNAMES(GETTYPE(DAYOFWEEK)).SELECT(FUNCTION(X) X.SUBSTRING(0, 2).TOUPPER())
        SB.APPEND(STRING.JOIN(DAYSEP, WEEKNMABBREVS))
        FOR EACH L IN ENDLINE()
            YIELD L
        NEXT

        ' DAY OF WEEK OF FIRST DAY OF MONTH.
        DIM STARTWKDY = CINT(DT.DAYOFWEEK)

        ' INITIALIZE WITH EMPTY SPACE FOR THE FIRST LINE.
        DIM FIRSTPAD AS NEW STRING(" "C, (DAY_WDT + DAYSEP.LENGTH) * STARTWKDY)
        SB.APPEND(FIRSTPAD)

        DIM D = DT
        DO WHILE D.MONTH = DT.MONTH
            SB.APPENDFORMAT(CULTUREINFO.INVARIANTCULTURE, $"{{0,{DAY_WDT}}}", D.DAY)

            ' EACH ROW ENDS ON SATURDAY.
            IF D.DAYOFWEEK = DAYOFWEEK.SATURDAY THEN
                FOR EACH L IN ENDLINE()
                    YIELD L
                NEXT
            ELSE
                SB.APPEND(DAYSEP)
            END IF

            D = D.ADDDAYS(1)
        LOOP

        ' KEEP ADDING EMPTY LINES UNTIL THE HEIGHT QUOTA IS MET.
        DIM NEXTLINES AS IENUMERABLE(OF STRING)
        DO
            NEXTLINES = ENDLINE()
            FOR EACH L IN NEXTLINES
                YIELD L
            NEXT
        LOOP WHILE NEXTLINES.ANY()
    END FUNCTION

    ''' <SUMMARY>
    ''' RETURNS A NEW STRING THAT CENTER-ALIGNS THE CHARACTERS IN THIS STRING BY PADDING TO THE LEFT AND RIGHT WITH
    ''' THE SPECIFIED CHARACTER TO A SPECIFIED TOTAL LENGTH.
    ''' </SUMMARY>
    ''' <PARAM NAME="S">THE STRING TO CENTER-ALIGN.</PARAM>
    ''' <PARAM NAME="TOTALWIDTH">THE NUMBER OF CHARACTERS IN THE RESULTING STRING.</PARAM>
    ''' <PARAM NAME="PADDINGCHAR">THE PADDING CHARACTER.</PARAM>
    <EXTENSION()>
    PRIVATE FUNCTION PADCENTER(S AS STRING, TOTALWIDTH AS INTEGER, OPTIONAL PADDINGCHAR AS CHAR = " "C) AS STRING
        RETURN S.PADLEFT(((TOTALWIDTH - S.LENGTH) \ 2) + S.LENGTH, PADDINGCHAR).PADRIGHT(TOTALWIDTH, PADDINGCHAR)
    END FUNCTION
END MODULE


IMPORT "/DATE" FOR DATE
IMPORT "/FMT" FOR FMT
IMPORT "/SEQ" FOR LST

VAR CALENDAR = FN.NEW { |YEAR|
    VAR SNOOPY = "🐶"
    VAR DAYS = "SU MO TU WE TH FR SA"
    VAR MONTHS = [
        "JANUARY", "FEBRUARY", "MARCH", "APRIL", "MAY", "JUNE",
        "JULY", "AUGUST", "SEPTEMBER", "OCTOBER", "NOVEMBER", "DECEMBER"
    ]
    FMT.PRINT("$70M", SNOOPY)
    VAR YEARSTR = "--- %(YEAR) ---"
    FMT.PRINT("$70M\N", YEARSTR)
    VAR FIRST = LIST.FILLED(3, 0)
    VAR MLEN = LIST.FILLED(3, 0)
    VAR C = 0
    FOR (CHUNK IN LST.CHUNKS(MONTHS, 3)) {
        FOR (I IN 0..2) FMT.WRITE("$20M     ", CHUNK[I])
        SYSTEM.PRINT()
        FOR (I IN 0..2) SYSTEM.WRITE("%(DAYS)     ")
        SYSTEM.PRINT()
        FIRST[0] = DATE.NEW(YEAR, C*3 + 1, 1).DAYOFWEEK % 7
        FIRST[1] = DATE.NEW(YEAR, C*3 + 2, 1).DAYOFWEEK % 7
        FIRST[2] = DATE.NEW(YEAR, C*3 + 3, 1).DAYOFWEEK % 7
        MLEN[0]  = DATE.MONTHLENGTH(YEAR, C*3 + 1)
        MLEN[1]  = DATE.MONTHLENGTH(YEAR, C*3 + 2)
        MLEN[2]  = DATE.MONTHLENGTH(YEAR, C*3 + 3)
        FOR (I IN 0..5) {
            FOR (J IN 0..2) {
                VAR START = 1 + 7 * I - FIRST[J]
                FOR (K IN START..START+6) {
                    IF (K >= 1 && K <= MLEN[J]) {
                        FMT.WRITE("$2D ", K)
                    } ELSE {
                        SYSTEM.WRITE("   ")
                    }
                }
                SYSTEM.WRITE("    ")
            }
            SYSTEM.PRINT()
        }
        SYSTEM.PRINT()
        C = C + 1
    }
}

CALENDAR.CALL(1969)


# syntax: GAWK -f CALCULATING_THE_VALUE_OF_E.AWK
BEGIN {
    epsilon = 1.0e-15
    fact = 1
    e = 2.0
    n = 2
    do {
      e0 = e
      fact *= n++
      e += 1.0 / fact
    } while (abs(e-e0) >= epsilon)
    printf("e=%.15f\n",e)
    exit(0)
}
function abs(x) { if (x >= 0) { return x } else { return -x } }


n = 1  : n1 = 1
e1 = 0 : e = 1 / 1

while e <> e1
	e1 = e
	e += 1 / n
	n1 += 1
	n *= n1
end while

print "The value of e = "; e
end


        .MODEL  TINY
        .CODE
        .486
        ORG     100H            ;.COM FILES START HERE
YEAR    EQU     1969            ;DISPLAY CALENDAR FOR SPECIFIED YEAR
START:  MOV     CX, 61          ;SPACE(61);  TEXT(0, "[SNOOPY]");  CRLF(0)
        CALL    SPACE
        MOV     DX, OFFSET SNOOPY
        CALL    TEXT
        MOV     CL, 63          ;SPACE(63);  INTOUT(0, YEAR);  CRLF(0);  CRLF(0)
        CALL    SPACE
        MOV     AX, YEAR
        CALL    INTOUT
        CALL    CRLF
        CALL    CRLF

        MOV     DI, 1           ;FOR MONTH:= 1 TO 12 DO         DI=MONTH
L22:    XOR     SI, SI          ; FOR COL:= 0 TO 6-1 DO         SI=COL
L23:    MOV     CL, 5           ;  SPACE(5)
        CALL    SPACE
        MOV     DX, DI          ;  TEXT(0, MONAME(MONTH+COL-1));  SPACE(7);
        DEC     DX              ;  DX:= (MONTH+COL-1)*10+MONAME
        ADD     DX, SI
        IMUL    DX, 10
        ADD     DX, OFFSET MONAME
        CALL    TEXT
        MOV     CL, 7
        CALL    SPACE
        CMP     SI, 5           ;  IF COL<5 THEN SPACE(1);
        JGE     L24
         MOV    CL, 1
         CALL   SPACE
         INC    SI
         JMP    L23
L24:    CALL    CRLF

        MOV     SI, 6           ; FOR COL:= 0 TO 6-1 DO
L25:    MOV     DX, OFFSET SUMO ;  TEXT(0, "SU MO TU WE TH FR SA");
        CALL    TEXT
        DEC     SI              ;   IF COL<5 THEN SPACE(2);
        JE      L27
         MOV    CL, 2
         CALL   SPACE
         JMP    L25
L27:    CALL    CRLF

        XOR     SI, SI          ;FOR COL:= 0 TO 6-1 DO
L28:    MOV     BX, DI          ;DAY OF FIRST SUNDAY OF MONTH (CAN BE NEGATIVE)
        ADD     BX, SI          ;DAY(COL):= 1 - WEEKDAY(YEAR, MONTH+COL, 1);
        MOV     BP, YEAR

;DAY OF WEEK FOR FIRST DAY OF THE MONTH (0=SUN 1=MON..6=SAT)
        CMP     BL, 2           ;IF MONTH<=2 THEN
        JG      L3
         ADD    BL, 12          ; MONTH:= MONTH+12;
         DEC    BP              ; YEAR:= YEAR-1;
L3:
;REM((1-1 + (MONTH+1)*26/10 + YEAR + YEAR/4 + YEAR/100*6 + YEAR/400)/7)
        INC     BX              ;MONTH
        IMUL    AX, BX, 26
        MOV     CL, 10
        CWD
        IDIV    CX
        MOV     BX, AX
        MOV     AX, BP          ;YEAR
        ADD     BX, AX
        SHR     AX, 2
        ADD     BX, AX
        MOV     CL, 25
        CWD
        IDIV    CX
        IMUL    DX, AX, 6       ;YEAR/100*6
        ADD     BX, DX
        SHR     AX, 2           ;YEAR/400
        ADD     AX, BX
        MOV     CL, 7
        CWD
        IDIV    CX
        NEG     DX
        INC     DX
        MOV     [SI+DAY], DL    ;COL+DAY
        INC     SI
        CMP     SI, 5
        JLE     L28

        MOV     BP, 6           ;FOR LINE:= 0 TO 6-1 DO         BP=LINE
L29:    XOR     SI, SI          ; FOR COL:= 0 TO 6-1 DO         SI=COL
L30:    MOV     BX, DI          ;  DAYMAX:= DAYS(MONTH+COL);
        MOV     BL, [BX+SI+DAYS]

;IF MONTH+COL=2 & (REM(YEAR/4)=0 & REM(YEAR/100)#0 ! REM(YEAR/400)=0) THEN
        MOV     AX, DI          ;MONTH
        ADD     AX, SI
        CMP     AL, 2
        JNE     L32
        MOV     AX, YEAR
        TEST    AL, 03H
        JNE     L32
        MOV     CL,100
        CWD
        IDIV    CX
        TEST    DX, DX
        JNE     L31
        TEST    AL, 03H
        JNE     L32
L31:     INC    BX              ;IF FEBRUARY AND LEAP YEAR THEN ADD A DAY
L32:
        MOV     DX, 7           ;FOR WEEKDAY:= 0 TO 7-1 DO
L33:    MOVZX   AX, [SI+DAY]    ; IF DAY(COL)>=1 & DAY(COL)<=DAYMAX THEN
        CMP     AL, 1
        JL      L34
        CMP     AL, BL
        JG      L34
        CALL    INTOUT          ; INTOUT(0, DAY(COL));
        CMP     AL, 10          ; IF DAY(COL)<10 THEN SPACE(1); LEFT JUSTIFY
        JGE     L36
         MOV    CL, 1
         CALL   SPACE
        JMP     L36
L34:    MOV     CL, 2           ; ELSE SPACE(2);
        CALL    SPACE           ; SUPPRESS OUT OF RANGE DAYS
L36:    MOV     CL, 1           ; SPACE(1);
        CALL    SPACE
        INC     BYTE PTR [SI+DAY] ; DAY(COL):= DAY(COL)+1;
        DEC     DX              ;NEXT WEEKDAY
        JNE     L33

        CMP     SI, 5           ;IF COL<5 THEN SPACE(1);
        JGE     L37
         MOV    CL, 1
         CALL   SPACE
         INC    SI
         JMP    L30
L37:    CALL    CRLF

        DEC     BP              ;NEXT LINE DOWN
        JNE     L29
        CALL    CRLF

        ADD     DI, 6           ;NEXT 6 MONTHS
        CMP     DI, 12
        JLE     L22
        RET

;DISPLAY POSITIVE INTEGER IN AX
INTOUT: PUSHA
        MOV     BX, 10
        XOR     CX, CX
NO10:   CWD
        IDIV    BX
        PUSH    DX
        INC     CX
        TEST    AX, AX
        JNE     NO10
NO20:   MOV     AH, 02H
        POP     DX
        ADD     DL, '0'
        INT     21H
        LOOP    NO20
        POPA
        RET

;DISPLAY CX SPACE CHARACTERS
SPACE:  PUSHA
SP10:   MOV     AH, 02H
        MOV     DL, 20H
        INT     21H
        LOOP    SP10
        POPA
        RET

;START A NEW LINE
CRLF:   MOV     DX, OFFSET LCRLF

;DISPLAY STRING AT DX
TEXT:   MOV     AH, 09H
        INT     21H
        RET

SNOOPY  DB      "[SNOOPY]"
LCRLF   DB      0DH, 0AH, '$'
MONAME  DB      " JANUARY $ FEBRUARY$  MARCH  $  APRIL  $   MAY   $   JUNE  $"
        DB      "   JULY  $  AUGUST $SEPTEMBER$  OCTOBER$ NOVEMBER$ DECEMBER$"
SUMO    DB      "SU MO TU WE TH FR SA$"
DAYS    DB      0, 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31
DAY     DB      ?, ?, ?, ?, ?, ?
        END     START


#include <stdio.h>
#include <math.h>

int main(int argc, char* argv[])
{
    double e;

    puts("The double precision in C give about 15 significant digits.\n"
         "Values below are presented with 16 digits after the decimal point.\n");

    // The most direct way to compute Euler constant.
    //
    e = exp(1);
    printf("Euler constant e = %.16lf\n", e);

    // The fast and independed method: e = lim (1 + 1/n)**n
    //
    int n = 8192;
    e = 1.0 + 1.0 / n;
    for (int i = 0; i < 13; i++)
        e *= e;
    printf("Euler constant e = %.16lf\n", e);

    // Taylor expansion e = 1 + 1/1 + 1/2 + 1/2/3 + 1/2/3/4 + 1/2/3/4/5 + ...
    // Actually Kahan summation may improve the accuracy, but is not necessary.
    //
    const int N = 1000;
    double a[1000];
    a[0] = 1.0;
    for (int i = 1; i < N; i++)
    {
        a[i] = a[i-1] / i;
    }
    e = 1.;
    for (int i = N - 1; i > 0; i--)
        e += a[i];
    printf("Euler constant e = %.16lf\n", e);

    return 0;
}


using System;

namespace CalculateE {
    class Program {
        public const double EPSILON = 1.0e-15;

        static void Main(string[] args) {
            ulong fact = 1;
            double e = 2.0;
            double e0;
            uint n = 2;
            do {
                e0 = e;
                fact *= n++;
                e += 1.0 / fact;
            } while (Math.Abs(e - e0) >= EPSILON);
            Console.WriteLine("e = {0:F15}", e);
        }
    }
}


#include <iostream>
#include <iomanip>
#include <cmath>

using namespace std;

int main() {
    const double EPSILON = 1.0e-15;
    unsigned long long fact = 1;
    double e = 2.0, e0;
    int n = 2;
    do {
        e0 = e;
        fact *= n++;
        e += 1.0 / fact;
    }
    while (fabs(e - e0) >= EPSILON);
    cout << "e = " << setprecision(16) << e << endl;
    return 0;
}


VAR [CONST] D=TIME.DATE, DAYS="SU MO TU WE TH FR SA";

FCN CENTER(TEXT,M) { STRING(" "*((M-TEXT.LEN())/2),TEXT) }

FCN ONEMONTH(YEAR,MONTH){
   DAY1:=D.ZELLER(YEAR,MONTH,1);    //1969-1-1 -->3 (WED, ISO 8601)
   DAYZ:=D.DAYSINMONTH(YEAR,MONTH); //1969-1   -->31
   LIST(CENTER(D.MONTHNAMES[MONTH],DAYS.LEN()),DAYS).EXTEND(
      (1).PUMP(DAYZ,(0).PUMP(DAY1,LIST,T(VOID,""))).APPLY("%2S ".FMT)
      .PUMP(LIST,T(VOID.READ,DAYS.LEN()/3,FALSE),STRING.CREATE));
}
...


;; Calculating the number e, euler-napier number.
;; We will use two methods
;; First method: the forumula (1 + 1/n)^n
;; Second method: the series partial sum 1/(p!)

;;first method

(defn inverse-plus-1 [n]
  (+ 1 (/ 1 n)))

(defn e-return [n]
  (Math/pow (inverse-plus-1 n) n))

(time (e-return 100000.))

;;"Elapsed time: 0.165629 msecs"
;;2.7182682371922975

;;SECOND METHOD

(defn method-e [n]
  (loop [e-aprx 0M
        value-add 1M
        p  1M]
    (if (> p n)
    e-aprx
    (recur (+ e-aprx value-add) (/ value-add p) (inc p)))))

(time (with-precision 110 (method-e 200M)))


       >>SOURCE FORMAT IS FIXED
       IDENTIFICATION DIVISION.
       PROGRAM-ID. EULER.
       DATA DIVISION.
       WORKING-STORAGE SECTION.
           01 EPSILON USAGE COMPUTATIONAL-2 VALUE 1.0E-15.
           01 FACT USAGE BINARY-DOUBLE UNSIGNED VALUE 1.
           01 N USAGE BINARY-INT UNSIGNED.
           01 E USAGE COMPUTATIONAL-2 VALUE 2.0.
           01 E0 USAGE COMPUTATIONAL-2 value 0.0.
           01 RESULT-MESSAGE.
              03 FILLER PIC X(4) VALUE 'e = '.
              03 RESULT-VALUE PIC 9.9(18) USAGE DISPLAY.
       PROCEDURE DIVISION.
       MAIN SECTION.
           PERFORM
              VARYING N FROM 2 BY 1
              UNTIL FUNCTION ABS(E - E0) < EPSILON
              MOVE E TO E0
              COMPUTE FACT = FACT * N
              COMPUTE E = E + 1.0 / FACT
           END-PERFORM.
           MOVE E TO RESULT-VALUE.
           DISPLAY RESULT-MESSAGE.
           STOP RUN.


100 REM COMPUTE E VIA INVERSE FACTORIAL SUM
110 N = 11:REM NUMBER OF ITERATIONS
120 E =  1:REM APPROXIMATE E HERE
130 F =  1:REM BUILD FACTORIAL HERE
140 FOR I = 1 TO N
150 : F = F*I
160 : E = E + 1/F
170 NEXT I
180 PRINT "AFTER" N "ITERATIONS, E =" E


(ql:quickload :computable-reals :silent t)
(use-package :computable-reals)

(defparameter *iterations* 1000)

(let ((e 1) (f 1))
  (loop for i from 1 to *iterations* doing
     (setq f (* f i))
     (setq e (+ e (/ 1 f))))
  (format t "After ~a iterations, e = " *iterations*)
  (print-r e 2570))


import std.math;
import std.stdio;

enum EPSILON = 1.0e-15;

void main() {
    ulong fact = 1;
    double e = 2.0;
    double e0;
    int n = 2;
    do {
        e0 = e;
        fact *= n++;
        e += 1.0 / fact;
    } while (abs(e - e0) >= EPSILON);
    writefln("e = %.15f", e);
}


1000 sn                 [ n = number of iterations ]sx
2574k                   [ precision to use during computation ]sx
1 d se sf               [ set e and f to 1 ]sx
0 si                    [ set i to 0 ]sx
[                       [ p = begin ]sx
  lf li 1 + d si * sf     [ f = f*(++i) ]sx
  le 1 lf / + se          [ e = e + 1/f ]sx
  ln li <p                [ if i<n recur ]sx
]sp                     [ end ]sx

lpx                     [ call p ]sx

[After ]n lnn           [ output header. uses n + 10P for newline ]sx
[ iterations, e =]n     [ instead of p, so nothing is left hanging ]sx
10P                     [ around on the stack.]sx

2570k                   [ now reset precision to match correct digits ]sx
le 1 /                  [ get result truncated to that precision ]sx
n 10P                   [ and print it out, again with n + 10P ]sx


program Calculating_the_value_of_e;

{$APPTYPE CONSOLE}

{$R *.res}

uses
  System.SysUtils;

const
  EPSILON = 1.0e-15;

function fAbs(value: Extended): Extended;
begin
  Result := value;
  if value < 0 then
    Result := -Result;
end;

function e: Extended;
var
  fact: UInt64;
  e, e0: Extended;
  n: Integer;
begin
  fact := 1;
  Result := 2.0;
  n := 2;
  repeat
    e0 := Result;
    fact := fact * n;
    inc(n);
    Result := Result + (1.0 / fact);
  until (fAbs(Result - e0) < EPSILON);
end;

begin
  writeln(format('e = %.15f', [e]));
  readln;
end.


func calculateE(epsilon = 1.0e-15) {
    func abs(n) {
        if n < 0 {
            -n
        } else {
            n
        }
    }

    var fact = 1
    var e = 2.0
    var e0 = 0.0
    var n = 2

    while true {
        e0 = e
        fact *= n
        n += 1
        e += 1.0 / Float(fact)

        if abs(e - e0) < epsilon {
            break
        }
    }

    return e
}

print(calculateE())


numfmt 0 5
fact = 1
n = 2
e = 2
while abs (e - e0) > 0.0001
  e0 = e
  fact = fact * n
  n += 1
  e += 1 / fact
.
print e


  [Calculate e]
  [EDSAC program, Initial Orders 2]

  [Library subroutine M3. Prints header and is then overwritten]
  [Here, last character sets teleprinter to figures]
   [email protected]@E8FEZPF
   @&*[email protected]&#
     ..PZ  [blank tape, needed to mark end of header text]

  [Library subroutine D6. Division, accurate, fast.
  Closed, 36 locations, working positions 6D and 8D.
  C(0D) := C(0D)/C(4D), where C(4D) <> 0, -1.]
     T56K  [define load address for subroutine]
     [email protected]@[email protected]@[email protected]
     [email protected]@SDVDTDEFW1526D

  [Library subroutine P1.
  Prints a single positive number (without layout or round-off).
  Prints number in 0D to n places of decimals, where
  n is specified by 'P n F' pseudo-order after subroutine call.
  Closed, 21 locations.]
    T92K  [define load address for subroutine]
   [email protected]@[email protected]@[email protected]@[email protected]@EFU3FJFM1F
    ..PZ

               [Main routine]
        T120K  [Define load address for main program.
                Must be even, because of double values at start.]
        GK     [set @ (theta) for relative addresses]
    [0] PF PF  [build sum 4*(1/3! + 1/4! + 1/5! + ...)]
    [2] PF PF  [term in sum]
    [4] PD PF  [2^-34, stop when term < this]
    [6] PF     [divisor]
    [7] IF     [1/2]
    [8] QF     [1/16]
    [9] @F     [carriage return]
   [10] &F     [line feed]
   [11] WF     [digit '2']
   [12] MF     [full stop / decimal point]
   [13] K4096F [teleprinter null]

   [14] [email protected]    [load 1/16]
        LD     [shift, makes 1/8]
        UD     [to 0D for subroutine D6]
        [email protected]    [divisor := 1/8]
        T#@    [sum := 0]

               [loop, acc assumed to be 0 here]
   [19] [email protected]    [load divisor]
        [email protected]    [add 1/16]
        [email protected]    [update divisor]
        T4D    [to 4D for subroutine D6]
   [23] [email protected]   [for subroutine return]
        G56F   [call D6]
        AD     [load quotient]
        U2#@   [store as term]
        A#@    [add term into sum]
        T#@    [update sum]
        A2#@   [load term]
        S4#@   [test for convergence]
        [email protected]   [jump out if so]
        A4#@   [restore term after test]
        R4F    [divide by 16]
        TD     [to 0D for subroutine D6]
        [email protected]   [loop back]

               [here when converged]
   [36] TF     [clear acc]
        A#@    [load sum]
        R1F    [shift to divide by 4]
        [email protected]    [add 1/2, now have (e - 2)]
        YF     [round]
        TD     [to 0D for subroutine P1]
        [email protected]   [print '2.']
        [email protected]
   [44] [email protected]   [for subroutine return]
        G92F   [call P1 to print (e - 2)]
        P10F   [10 decimals]
        [email protected]    [print CR]
        [email protected]   [print LF]
        [email protected]   [null to flush print buffer]
        ZF     [stop]
        E14Z   [relative address of entry]
        PF     [enter with accumulator = 0]


(defun factorial (i)
  "Compute factorial of i."
  (apply #'* (number-sequence 1 i)))

(defun compute-e (iter)
  "Compute e."
  (apply #'+ 1 (mapcar (lambda (x) (/ 1.0 x))
    (mapcar #'factorial (number-sequence 1 iter)))))

(compute-e 20)


fn CalculateE(P)
	var E:1,F:1
	loop I:1;I<=P;I+:1 do
		F*:I
		E+:1/F
	cls
	return E
cls

log(CalculateE(100))
log(math.e)


eApprox
=LAMBDA(n,
    INDEX(
        FOLDROW(
            LAMBDA(efl,
                LAMBDA(x,
                    LET(
                        flx, INDEX(efl, 2) * x,
                        e, INDEX(efl, 1),

                        CHOOSE(
                            {1;2},
                            e + (1 / flx),
                            flx
                        )
                    )
                )
            )
        )({1;1})(
            SEQUENCE(1, n)
        ),
        1
    )
)


// A function to generate the sequence 1/n!). Nigel Galloway: May 9th., 2018
let e = Seq.unfold(fun (n,g)->Some(n,(n/g,g+1N))) (1N,1N)


USING: math math.factorials prettyprint sequences ;
IN: rosetta-code.calculate-e

CONSTANT: terms 20

terms <iota> [ n! recip ] map-sum >float .


100 constant #digits
: int-array  create cells allot  does> swap cells + ;

#digits 1+ int-array e-digits[]

: init-e ( -- )
   [ #digits 1+ ] literal 0 DO
      1  i e-digits[]  !
   LOOP
   ." = 2." ;

: .e  ( -- )
   init-e
   [ #digits 1- ] literal 0 DO
      0  \ carry
      0 #digits DO
         i e-digits[] dup @  10 *  rot +  i 2 + /mod -rot  swap !
      -1 +LOOP
      0 .r
   LOOP ;


Program eee
implicit none
integer, parameter  :: QP = selected_real_kind(16)
real(QP), parameter :: one = 1.0
real(QP)            :: ee

write(*,*) '    exp(1.) ', exp(1._QP)

ee = 1. +(one +(one +(one +(one +(one+ (one +(one +(one +(one +(one +(one &
        +(one +(one +(one +(one +(one +(one +(one +(one +(one +(one)      &
        /21.)/20.)/19.)/18.)/17.)/16.)/15.)/14.)/13.)/12.)/11.)/10.)/9.)  &
        /8.)/7.)/6.)/5.)/4.)/3.)/2.)

write(*,*) ' polynomial ', ee

end Program eee


' version 02-07-2018
' compile with: fbc -s console

Dim As Double e , e1
Dim As ULongInt n = 1, n1 = 1

e = 1 / 1

While e <> e1
    e1 = e
    e += 1 / n
    n1 += 1
    n *= n1
Wend

Print "The value of e ="; e

' empty keyboard buffer
While InKey <> "" : Wend
Print : Print "hit any key to end program"
Sleep
End


###sysinclude math.uh
1.0e-15 sto EPSILON
one fact
2. sto e
2  sto n
((
@e sto e0
#g @n++ prd fact
1.0 @fact !(#d) / sum e
( @e @e0 - abs @EPSILON < )))
."e = " @e printnl
end
{ „EPSILON” }
{ „fact” }
{ „e” }
{ „e0” }
{ „n” }


package main

import (
    "fmt"
    "math"
)

const epsilon = 1.0e-15

func main() {
    fact := uint64(1)
    e := 2.0
    n := uint64(2)
    for {
        e0 := e
        fact *= n
        n++
        e += 1.0 / float64(fact)
        if math.Abs(e - e0) < epsilon {
            break
        }
    }
    fmt.Printf("e = %.15f\n", e)
}


def ε = 1.0e-15
def φ = 1/ε

def generateAddends = {
    def addends = []
    def n = 0.0
    def fact = 1.0
    while (true) {
        fact *= (n < 2 ? 1.0 : n) as double
        addends << 1.0/fact
        if (fact > φ) break // any further addends would not pass the tolerance test
        n++
    }
    addends.sort(false) // smallest addends first for better response to rounding error
}

def e = generateAddends().sum()


------ APPROXIMATION OF E OBTAINED AFTER N ITERATIONS ----

eApprox :: Int -> Double
eApprox n =
  (sum . take n) $ (1 /) <$> scanl (*) 1 [1 ..]

--------------------------- TEST -------------------------
main :: IO ()
main = print $ eApprox 20


$define EPSILON 1.0e-15

procedure main()
   local e0
   local e := 2.0
   local fact := 1
   local n := 2

   repeat {
      e0 := e
      fact *:= n
      n +:= 1
      e +:= (1.0 / fact)
      if abs(e - e0) < EPSILON then break
   }
   write("computed e ", e)
   write("keyword &e ", &e)
end


100 PROGRAM "e.bas"
110 LET E1=0:LET E,N,N1=1
120 DO WHILE E<>E1
130   LET E1=E:LET E=E+1/N
140   LET N1=N1+1:LET N=N*N1
150 LOOP
160 PRINT "The value of e =";E


   NB. rational one half times pi to the first power
            NB. pi to the power of negative two
                      NB. two oh in base 111
                                   NB. complex number length 1, angle in degrees 180
   1r2p1    1p_2      111b20       1ad270
1.5708 0.101321 222 0j_1


public class CalculateE {
    public static final double EPSILON = 1.0e-15;

    public static void main(String[] args) {
        long fact = 1;
        double e = 2.0;
        int n = 2;
        double e0;
        do {
            e0 = e;
            fact *= n++;
            e += 1.0 / fact;
        } while (Math.abs(e - e0) >= EPSILON);
        System.out.printf("e = %.15f\n", e);
    }
}


(() => {
    "use strict";

    // - APPROXIMATION OF E OBTAINED AFTER N ITERATIONS --

    // eApprox : Int -> Float
    const eApprox = n =>
        sum(
            scanl(mul)(1)(
                enumFromTo(1)(n)
            )
            .map(x => 1 / x)
        );

    // ---------------------- TEST -----------------------
    const main = () =>
        eApprox(20);

    // ---------------- GENERIC FUNCTIONS ----------------

    // enumFromTo :: Int -> Int -> [Int]
    const enumFromTo = m =>
        n => Array.from({
            length: 1 + n - m
        }, (_, i) => m + i);

    // mul (*) :: Num a => a -> a -> a
    const mul = a =>
        // The arithmetic product of a and b.
        b => a * b;

    // scanl :: (b -> a -> b) -> b -> [a] -> [b]
    const scanl = f => startValue => xs =>
        // The series of interim values arising
        // from a catamorphism. Parallel to foldl.
        xs.reduce((a, x) => {
            const v = f(a[0])(x);

            return [v, a[1].concat(v)];
        }, [startValue, [startValue]])[1];

    // sum :: [Num] -> Num
    const sum = xs =>
        // The numeric sum of all values in xs.
        xs.reduce((a, x) => a + x, 0);

    // MAIN ---
    return main();
})();


module NeperConstant

export NeperConst

struct NeperConst{T}
    val::T
end

Base.show(io::IO, nc::NeperConst{T}) where T = print(io, "ℯ (", T, ") = ", nc.val)

function NeperConst{T}() where T
    local e::T  = 2.0
    local e2::T = 1.0
    local den::(T ≡ BigFloat ? BigInt : Int128) = 1
    local n::typeof(den) = 2
    while e ≠ e2
        e2 = e
        den *= n
        n += one(n)
        e += 1.0 / den
    end
    return NeperConst{T}(e)
end

end  # module NeperConstant


/ Computing value of e
/ ecomp.k
\p 17
fact: {*/1+!:x}
evalue:{1 +/(1.0%)'fact' 1+!20}
evalue[]


%e0 %e %n %fact %v

0 !e0 2 !e 0 !n 1 !fact
1e-15 !v

:printOp swap print print nl ;
:test $e $e0 - abs $v >= ;

[$e !e0
$n 1 + !n
2 $n * 2 $n * 1 + * $fact * !fact
2 $n * 2 + $fact / $e + !e]
[test]
while

%rE
2.718281828459045 !rE

"Computed e = " $e tostr printOp
"Real e = " $rE tostr printOp
"Error = " $rE $e sub printOp
"Number of iterations = " $n printOp

" " input


// Version 1.2.40

import kotlin.math.abs

const val EPSILON = 1.0e-15

fun main(args: Array<String>) {
    var fact = 1L
    var e = 2.0
    var n = 2
    do {
        val e0 = e
        fact *= n++
        e += 1.0 / fact
    }
    while (abs(e - e0) >= EPSILON)
    println("e = %.15f".format(e))
}


1) straightforward

{+ 1 {S.map {lambda {:n} {/ 1 {* {S.serie 1 :n}}}} {S.serie 1 17}}}
-> 2.7182818284590455

which is the value given by javascript : 2.718281828459045.

2) using recursion

{def fac
 {lambda {:a :b}
  {if {< :b 1}
   then :a
   else {fac {* :a :b} {- :b 1}}}}}
-> fac

{def euler
 {lambda {:a :b}
  {if {< :b 1}
   then :a
   else {euler {+ :a {/ 1 {fac 1 :b}}} {- :b 1}}}}}
-> euler

{euler 1 17}
-> 2.7182818284590455


mode divMaxScale = 104

val .epsilon = 1.0e-104

var .e = 2

for .fact, .n = 1, 2 ; ; .n += 1 {
    val .e0 = .e
    .fact x= .n
    .e += 1 / .fact
    if abs(.e - .e0) < .epsilon: break
}

writeln ".e = ", .e

# compare to built-in constant e
writeln " e = ", e


EPSILON = 1.0e-15;

fact = 1
e = 2.0
e0 = 0.0
n = 2

repeat
    e0 = e
    fact = fact * n
    n = n + 1
    e = e + 1.0 / fact
until (math.abs(e - e0) < EPSILON)

io.write(string.format("e = %.15f\n", e))


Module FindE {
      Function comp_e (n){
           \\ max 28 for decimal (in one line with less spaces)
           n/=28:For i=27to 1:n=1+n/i:Next i:=n
      }
      Clipboard Str$(comp_e([email protected]),"")+" Decimal"+{
      }+Str$(comp_e(1),"")+" Double"+{
      }+Str$(comp_e(1~),"")+" Float"+{
      }+Str$(comp_e(1#),"")+" Currency"+{
      }
      Report Str$(comp_e([email protected]),"")+" Decimal"+{
      }+Str$(comp_e(1),"")+" Double"+{
      }+Str$(comp_e(1~),"")+" Float"+{
      }+Str$(comp_e(1#),"")+" Currency"+{
      }
}
FindE


(:n (n 0 ==) ((0)) (-1 () ((succ dup) dip append) n times) if) :iota
(iota 'succ '* map-reduce) :factorial

20 iota (factorial 1 swap /) '+ map-reduce print


MODULE CalculateE;
FROM RealStr IMPORT RealToStr;
FROM Terminal IMPORT WriteString,WriteLn,ReadChar;

CONST EPSILON = 1.0E-15;

PROCEDURE abs(n : REAL) : REAL;
BEGIN
    IF n < 0.0 THEN
        RETURN -n
    END;
    RETURN n
END abs;

VAR
    buf : ARRAY[0..31] OF CHAR;
    fact,n : LONGCARD;
    e,e0 : LONGREAL;
BEGIN
    fact := 1;
    e := 2.0;
    n := 2;

    REPEAT
        e0 := e;
        fact := fact * n;
        INC(n);
        e := e + 1.0 / LFLOAT(fact)
    UNTIL abs(e - e0) < EPSILON;

    WriteString("e = ");
    RealToStr(e, buf);
    WriteString(buf);
    WriteLn;

    ReadChar
END CalculateE.