DATE4 PAS2F;4u DATE4 CMD3_vF^ ^^PROGRAM DATE; CONST Esc = #27; TYPE MONTHTYPE = (JAN,FEB,MAR,APR,MAY,JUN,JUL,AUG,SEP,OCT,NOV,DEC); DOWTYPE = (SUN,MON,TUE,WED,THU,FRI,SAT); YEARTYPE = 1583..9999; StringType = STRING[80]; VAR CH : CHAR; YEAR : YEARTYPE; MONTH : MONTHTYPE; DAY_OF_WEEK : DOWTYPE; PROCEDURE GetTime; TYPE RegsType = RECORD AX,BX,CX,DX,BP, SI,DI,DS,ES,Flags : INTEGER; END; TimeType = RECORD Year : BYTE; Mon_DOW : BYTE; Day : BYTE; Hour : BYTE; Mins : BYTE; Secs : BYTE; END; VAR Regs : RegsType; TimeBuf : TimeType; FUNCTION Get_Nibble(N : BYTE) : BYTE; BEGIN Get_Nibble := N AND $F; END; FUNCTION Get_BCD(N : BYTE) : BYTE; VAR Temp : BYTE; BEGIN Temp := (N SHR 4 ) * 10; Get_BCD := Temp + (N AND $F); END; BEGIN Regs.DX := Ofs(TimeBuf); Regs.DS := Seg(TimeBuf); Regs.CX := 0; INTR(220,Regs); Year := Get_BCD(TimeBuf.Year) + 1900; Month := MonthType(Get_Nibble(TimeBuf.Mon_DOW SHR 4)-1); Day_Of_Week := DOWType(Get_Nibble(TimeBuf.Mon_DOW) - 1); { WITH TimeBuf DO BEGIN WRITELN('Year ',Get_BCD(Year)); WRITELN('Month ',Get_Nibble(Mon_DOW SHR 4)); WRITELN('DOW ',Get_Nibble(Mon_DOW)); WRITELN('Day ',Get_BCD(Day)); WRITELN('Hours ',Get_BCD(Hour)); WRITELN('Mins ',Get_BCD(Mins)); WRITELN('Secs ',Get_BCD(Secs)); END; HALT; } END; PROCEDURE PRINT_MONTH(MONTH : MONTHTYPE; YEAR : YEARTYPE; VAR DAY_OF_WEEK : DOWTYPE); CONST SPACE = ' '; SPACE6 = ' '; VAR X : DOWTYPE; J : INTEGER; ROW : INTEGER; DAY_OF_MONTH, DAYS_IN_MONTH : INTEGER; NEW_MONTH : BOOLEAN; PROCEDURE INIT_MONTH; BEGIN CASE MONTH OF JAN,MAR,MAY,JUL,AUG,OCT,DEC : DAYS_IN_MONTH := 31; APR,JUN,SEP,NOV : DAYS_IN_MONTH := 30; FEB : BEGIN DAYS_IN_MONTH := 28; IF YEAR MOD 4 = 0 THEN IF YEAR MOD 100 <> 0 THEN DAYS_IN_MONTH := 29 ELSE IF YEAR MOD 400 = 0 THEN DAYS_IN_MONTH := 29; END; { BEGIN } END; { CASE } END; { INIT_MONTH } PROCEDURE DO_START; BEGIN GOTOXY(16,6); DAY_OF_MONTH := 1; FOR X := SUN TO SAT DO IF X < DAY_OF_WEEK THEN WRITE(SPACE6) ELSE BEGIN WRITE(DAY_OF_MONTH:5,SPACE); DAY_OF_MONTH := DAY_OF_MONTH + 1; END; { ELSE BEGIN } WRITELN; END; { DO_START } PROCEDURE DO_MIDDLE; BEGIN GOTOXY(16,ROW); FOR X := SUN TO SAT DO IF DAY_OF_MONTH <= DAYS_IN_MONTH THEN BEGIN WRITE(DAY_OF_MONTH:5,SPACE); DAY_OF_MONTH := DAY_OF_MONTH + 1; END; { THEN BEGIN } ROW := ROW + 3; (* SKIP 3 SCREEN LINES *) END; { DO_MIDDLE } PROCEDURE DO_HEADER; BEGIN GOTOXY(34,2); NormVideo; CASE MONTH OF JAN : WRITE('JANUARY'); FEB : WRITE('FEBRUARY'); MAR : WRITE('MARCH'); APR : WRITE('APRIL'); MAY : WRITE('MAY'); JUN : WRITE('JUNE'); JUL : WRITE('JULY'); AUG : WRITE('AUGUST'); SEP : WRITE('SEPTEMBER'); OCT : WRITE('OCTOBER'); NOV : WRITE('NOVEMBER'); DEC : WRITE('DECEMBER'); END; { CASE } WRITE(YEAR:5); LowVideo; GOTOXY(15,4); (* CURSOR 1 PLACE BEFORE Reverse *) WRITELN(ESC,'[7m','SUN':6,'MON':6,'TUE':6,'WED':6,'THU':6,'FRI':6,'SAT':6, ' ',ESC,'[1m'); END; { DO_HEADER } BEGIN { PRINT_MONTH } ROW := 8; (* FOR SCREEN LINE *) NEW_MONTH := TRUE; INIT_MONTH; ClrScr; DO_HEADER; NormVideo; FOR J := 1 TO 6 DO BEGIN IF NEW_MONTH THEN DO_START ELSE DO_MIDDLE; NEW_MONTH := FALSE; END; { DO BEGIN } LowVideo; END; { PRINT_MONTH } PROCEDURE ToUpper(VAR S : StringType); VAR X : INTEGER; BEGIN FOR X := 1 TO LENGTH(S) DO S[X] := UPCASE(S[X]); END; { ToUpper } PROCEDURE GET_MONTH; TYPE MonListType = STRING[36]; CONST MonList : MonListType = 'JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC'; VAR M : StringType; X : BYTE; BEGIN { GET_MONTH } REPEAT GOTOXY(0,21); ClrEol; WRITE('Month: '); READLN(M); M := COPY(M,1,3); ToUpper(M); X := POS(M,MonList); UNTIL X <> 0; Month := MonthType((X - 1) DIV 3); REPEAT GOTOXY(0,22); ClrEol; WRITE('Year: '); READLN(YEAR); IF (YEAR >= 0) AND (YEAR < 100) THEN YEAR := YEAR + 1900; UNTIL (YEAR >= 1583) AND (YEAR <= 9999); END; { GET_MONTH } PROCEDURE GET_DOW(Y : YEARTYPE; M : MONTHTYPE); VAR X,CENTURY,YEAR,MONTH,DAY : INTEGER; BEGIN YEAR := Y; MONTH := ORD(M) + 1; DAY := 1; MONTH := MONTH - 2; IF MONTH < 1 THEN BEGIN MONTH := MONTH + 12; YEAR := YEAR - 1; END; { THEN BEGIN } CENTURY := YEAR DIV 100; YEAR := YEAR MOD 100; X := ((26*MONTH-2) DIV 10 + DAY + YEAR + YEAR DIV 4 + CENTURY DIV 4 - (CENTURY * 2)) MOD 7; Day_Of_Week := DOWType(X); END; { GET_DOW } BEGIN { MAIN } LowVideo; WRITELN('Calendar version 3.0'); WRITELN; GetTime; REPEAT REPEAT Get_DOW(YEAR,MONTH); PRINT_MONTH(MONTH,YEAR,DAY_OF_WEEK); GOTOXY(0,23); WRITE('<--[ , ]--> , Q(uit, N(ew '); REPEAT READ(KBD,CH); CH := UPCASE(CH); UNTIL CH IN ['Q','N',#29,#8,#19,#12,#4]; CASE CH OF 'Q' : HALT; #29,#8,#19 : IF MONTH = JAN THEN BEGIN MONTH := DEC; YEAR := YEAR - 1; END ELSE MONTH := PRED(MONTH); #12,#4 : IF MONTH = DEC THEN BEGIN MONTH := JAN; YEAR := YEAR + 1; END ELSE MONTH := SUCC(MONTH); END; { CASE } UNTIL CH = 'N'; Get_Month; Get_DOW(Year,Month); UNTIL FALSE; END. { MAIN } ((@$ͫCopyright (C) 1984 BORLAND IncKNEC APCinal selectedP=;00H 2J=8 ;00H.' t C. u* SQRWVP2PX^_ZY[t .X[SP.>t.SPX[ûm}SQRWVP..FFGG..$...!X^_ZY[ÿ2.t.OOK2.n t0.G u d[YSЊpc2$U tt<u\!2XZPs0tL t L<uLXZP XZP2a[_)PQYX%;u;&E&]P X[S>Y[r3$ȋaUc>Ut%s >ac&=st +%6&=T`njQRȋӋČӃ_3hZYw- 33SP&u&5njT&&E&E&E6a&<&D6Y&<&DÑ[_[S& &Ur3$]_>UnjsW&&]s6_6]&&\&D&D& &U&E&]<t&=&E&]& &U&UW&&]ȋӡ]_&E&]egnjgKVuQJt1&&\&L&T&&]eg)&E&]3É>W3_3333>Ut&=ČӃ3+r;sȋ[&&U[&&Eik[,.;W!tW.!uTtFʱ3H,i.G!$R2,!& u,.G!Z€kuփ$6, U]%SQRWVLW  _2Ҋ{}U336R6P&&u2ұ63P yP[Ë*(SQNJ݊2XXظbȸ6؉*( y-C2'd 2+sut0C3?$ uCPCX0r% ru rsRZr2s tÊ-uCQYr-u[& 2A+^. 2A+Z62C6?CC6CC:v6A[2+L6 G[262+ t'y6 A6 AG!9BKT ]f6 2G62Fڊ;v t u:ZYQ62F6 r&62+AV^NOAG&XnH62+v;v3҇6&[62D62G6 2F3+r@ tBQWV^_Yt@GJu3&56[:<&>@S>:WP6HB>>>:66%5W8[6:<S>:WP6H>:68P[Xu6\26@6@[6:t22AG u tò[Z Q t2uY **t2u[ 36Ñ[XS*r26sCËFF6| 6D"22$[22 ;tNOG3t5 @3}Hu u3 @_  Q# A# 6G" t3 6"t@ "2܊ȀË$;øu;u@ ;øu;uH ZR[YEEQ[Yuu5Q3EE3!EEIE3E5EEr1ËDEDE..GE.GE%UUU]]]Ë EDEEDEEDEÊE*DEEDEEDEUUUEUUËE;DuE;DuE:Dó2ۀ<uÀ=u@0]V׿3}2\2߀MLϊ*ts؋?uÀuBs2+u+.OscE E Et Eu u0}^À=tS<tKȻ[ CsuuEu T0u=u'À=t*PruKt `sUr!ޟEu>urv [s[ÊuT2MLրÊE2DEyèttÊ:u tQ utyxy x EEÊ,wH<(s233u!M!] eV^^[&u&u&5[.w.w.7[XYZ_&&M&UròC<tز6t6wË6gmtH ^uH OsH @vH 1wH "rH rh =|=%~PXi ǀu u2ҀXSQR3Y[XXQ*r"ẁs t@x ǀt3òy#ÿz[XS{c=tAEu?,P+> 3X8vP~܇*ò6 =lra]e\]r qEt @r 5r M=lrr =tuX9?`C00g?(2n*8t z~e=tEtG,P b>; e X =gs}؉}颋.:}8c~I$I~L*Ee=sNËEP==t (Xs PXrt[qXLm.`1pF,t6|!wS<.z}[|%FXc~ur1'=t3Et@eP4rXX@@P~JDDasZPBGXr u%SF|[XtP {XtMvT0 j oD,:j !I}袋.}8c~I$I~LMgSQY[QLXQJS[Si[YuSr!gEt*s2< r ЊRZ uy  < r [ ŀt-j t yYKy t.It@ux, uðE++ yٰ-/ s:  tF0CÀ=u 00CCuÊme,Mhìx-Sx9?+{Η@=uÀMVQ}^s uuÀeð2[D _S>uAu;u À>2t$r &&E[&&E ù2QS.:t [YFCYY<:u.CONTRMKBDLSTAUXUSR23[S>uI&}u#@>u8&>3t&&Eu"&&}u&&}u&&E >3tlQeYu.W 3_[S&}u.&t>u&u&tu&Ï6W _Ï6>,.&t&}u &E8Ï6W _Ï6>,.&uÊ.r< t4<t<t<t< r:tC4xKP tW>,&}_t<uW>,_SQRW&E<u<toi<uP< r< uXN<uLC<uL8<uL-u&]2&A0<t&Ey&E& _&EZY[W>,_&E>t:< t < t< t< u1 < t< t< t<tC't u ?r?t [Su |&&ñ2[SQ|YtQYr u&&[S\tW_r[S{!< u~3< t<tC&tdDuZ&>,&}uB< t <t :u 0< u)&}t&EW>,_À>ucSQRW2P&E<t<uD<u:<u0<u&X& &]2&A0&Ey&Et_ZY[[ZS<v I xq[XSQX+v T˻HCÒ[XSP[YS u[ TRUEFALSEgZ6*v 2 62C t 6C[.2C t .C [S&tx:t<u 32k230[Sa>uCI>u9&&E&E&E-‹>3u20&9Et&E0&E[S&t("4&E&E-‹`"Ë[ZS>,&E&;Es2&M;&E Ë[ZS>,&E&;Er&Et&M &E À>tڋ&t&&% t&}u us QRV!^ZYuW t& &]2+;s&M3&E+ȑWy071_&}uQRV";^ZYu&E- t  u[S"t & &t&&% &t&%Q±3U0Y U W_[_S&;Ew3&E&UȀ&MҊĊ&;E-t P"X&E-[&E&;Eu@ [&E[&E23[S8>u->u#&#]&E-&E-&E&E&E[S&u!"4[XZ_S&t=PQ3"YZQR4ZY u$&E-€I&E-&E&;Ev&E >4!t [_S&;Ev &E&E-[Suu[j_SuW_ztԃ øK3[SuFIuPLXt3&E-ʱ3G%R>!.Z u &E-€o&}tLÈB>C[EYXSQ/B>C[EZXS&PcY>CWB2-+v G& :tCG&:t_&52G>L[NHJ@S>Gu;r#>H&mr>H38t-@>L&X62BvF[ڋ_[ڋ+[Y_㑌[_^;sNO[WUS &5GG_^]ZY[XÜWVURQSP~F &GG[]_;sò;|;ò +r=r;rò [XS6L tLޏ<tÏ^C User break2À>u !"».$.׊ I/O2[XS Z»h$.׊ Run-time. error zTv, PC=_g Program aborted %R&ZCUUfUvUF2%FF2]UvULF2 FF2PF2%YFF2]~䗉FЉFF~ LF2Pln LF2PN-p LF2P8-q]UUKUvU^6G 2=t!=t=t=t=t = t= t ^6G=t=t =t= t ^6Gk=tc^6G^6G=tC^6Gd=u ^6G ^6G=t ^6G]UvUP۸^6GPY+}xA^6GQ^6G2P^6&2Y;|/ /^6GP& P^6G^6GYIt ^6G]UvUP^6GڸPY+}YA^6GQ^6G^6;G~/^6GP Pq;^6G^6GYIt ^6G^6G^6G]UvU"P9ً^6G 2=t JANUARY'=tFEBRUARY =tqMARCH=tWAPRILx=t=MAY`=t%JUNEG=tl JULY.=tSAUGUSTq=t8 SEPTEMBERS= tOCTOBER7= tNOVEMBER= tDECEMBER^6GP ظPPD[7muSUNhMON[TUENWEDATHU4FRI'SAT P1[1m]à FFl'׹`_׸PY+}6AFQF2 u 3B 'FYItF]UUPP~SY+}6AFQ~WF_W~WF_&2_&YItF]UU%$JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDECRP%Month: ~P9~W~ݸPޱPݹ *~W~yݿ+r߈FF2=uF2-pP|Year: <+n;,n=}HPn=d|HY# u nlnn=/}HPn='~HY# u]UU FFF2FFF-FF=|F FF-FFdFFdFn- FFPFYPFYPFY+FFq]NCalendar version 3.0- |nPp2Pip2PnPqWP<--[ , ]--> , Q(uit, N(ew mqm2Hբmm2Pp޸Q|޸Nv޸p޸j޸d޸ ^޸X)um2=Qtr=t =t=t+p2=t pn-n p2Hp5= t=t(p2= tpnn p2@pm2=NtX:1nPp2P uQ.