Data update
This commit is contained in:
Ingy döt Net
parent
5150844a7d
commit
4bb20c9b71
7735 changed files with 38060 additions and 199180 deletions
|
|
@ -1,48 +0,0 @@
|
|||
with Ada.Calendar.Formatting;
|
||||
|
||||
package Printable_Calendar is
|
||||
|
||||
subtype String20 is String(1 .. 20);
|
||||
type Month_Rep_Type is array (Ada.Calendar.Month_Number) of String20;
|
||||
|
||||
type Description is record
|
||||
Weekday_Rep: String20;
|
||||
Month_Rep: Month_Rep_Type;
|
||||
end record;
|
||||
-- for internationalization, you only need to define a new description
|
||||
|
||||
Default_Description: constant Description :=
|
||||
(Weekday_Rep =>
|
||||
"Mo Tu We Th Fr Sa So",
|
||||
Month_Rep =>
|
||||
(" January ", " February ", " March ",
|
||||
" April ", " May ", " June ",
|
||||
" July ", " August ", " September ",
|
||||
" October ", " November ", " December "));
|
||||
|
||||
type Calendar (<>) is tagged private;
|
||||
|
||||
-- Initialize a calendar for devices with 80- or 132-characters per row
|
||||
function Init_80(Des: Description := Default_Description) return Calendar;
|
||||
function Init_132(Des: Description := Default_Description) return Calendar;
|
||||
|
||||
-- the following procedures output to standard IO; override if neccessary
|
||||
procedure New_Line(Cal: Calendar);
|
||||
procedure Put_String(Cal: Calendar; S: String);
|
||||
|
||||
-- the following procedures do the real stuff
|
||||
procedure Print_Line_Centered(Cal: Calendar'Class; Line: String);
|
||||
procedure Print(Cal: Calendar'Class;
|
||||
Year: Ada.Calendar.Year_Number;
|
||||
Year_String: String); -- this is the main Thing
|
||||
|
||||
private
|
||||
type Calendar is tagged record
|
||||
Columns, Rows, Space_Between_Columns: Positive;
|
||||
Left_Space: Natural;
|
||||
|
||||
Weekday_Rep: String20;
|
||||
Month_Rep: Month_Rep_Type;
|
||||
end record;
|
||||
|
||||
end Printable_Calendar;
|
||||
|
|
@ -1,176 +0,0 @@
|
|||
with Ada.Text_IO;
|
||||
|
||||
package body Printable_Calendar is
|
||||
|
||||
use Ada.Calendar;
|
||||
package F renames Ada.Calendar.Formatting;
|
||||
|
||||
function Days_Per_Month(Year: Year_Number; Month: Month_Number)
|
||||
return Day_Number is
|
||||
begin
|
||||
case Month is
|
||||
when 1 | 3 | 5 | 7 | 8 | 10 | 12 => return 31;
|
||||
when 4 | 6 | 9 | 11 => return 30;
|
||||
when 2 =>
|
||||
if Year mod 4 /= 0 then
|
||||
return 28;
|
||||
elsif Year mod 100 /= 0 then
|
||||
return 29;
|
||||
elsif Year mod 400 /= 0 then
|
||||
return 28;
|
||||
else
|
||||
return 29;
|
||||
end if;
|
||||
end case;
|
||||
end Days_Per_Month;
|
||||
|
||||
type Full_Month_Rep is array (1 .. 6) of String20;
|
||||
function Generate_Printable_Month (Y: Ada.Calendar.Year_Number;
|
||||
M: Ada.Calendar.Month_Number)
|
||||
return Full_Month_Rep is
|
||||
|
||||
X: Full_Month_Rep := (others => " ");
|
||||
-- If X=Generate_Printable_Month(2011, 01), the result could be
|
||||
-- " January ", -- Month_Rep(01)
|
||||
-- "Mo Tu We Th Fr Sa Su" -- Weekday_Rep
|
||||
-- " 1 2" -- X(1)
|
||||
-- " 3 4 5 6 7 8 9" -- X(2)
|
||||
-- "10 11 12 13 14 15 16" -- X(3)
|
||||
-- "17 18 19 20 21 22 23" -- X(4)
|
||||
-- "24 25 26 27 28 29 30" -- X(5)
|
||||
-- "31 " -- X(6)
|
||||
|
||||
Row: Integer range 1 .. 6 := 1;
|
||||
Day_Index: constant array(F.Day_Name) of Positive
|
||||
:= (1, 4, 7, 10, 13, 16, 19);
|
||||
begin
|
||||
for I in 1 .. Days_Per_Month(Y, M) loop
|
||||
declare
|
||||
Weekday: constant F.Day_Name := F.Day_Of_Week(F.Time_Of(Y, M, I));
|
||||
Pos: constant Positive := Day_Index(Weekday);
|
||||
Cleartext_Name: constant String := Day_Number'Image(I);
|
||||
L: constant Positive := Cleartext_Name'Last;
|
||||
begin
|
||||
X(Row)(Pos .. Pos+1) := Cleartext_Name(L-1 .. L);
|
||||
if F."="(Weekday, F.Sunday) then
|
||||
Row := Row + 1;
|
||||
end if;
|
||||
end;
|
||||
end loop;
|
||||
return X;
|
||||
end Generate_Printable_Month;
|
||||
|
||||
|
||||
procedure Print(Cal: Calendar'class;
|
||||
Year: Ada.Calendar.Year_Number;
|
||||
Year_String: String) is
|
||||
|
||||
The_Month: Month_Number := Month_Number'First;
|
||||
|
||||
procedure Write_Space(Length: Natural) is
|
||||
begin
|
||||
for I in 1 .. Length loop
|
||||
Cal.Put_String(" ");
|
||||
end loop;
|
||||
end Write_Space;
|
||||
|
||||
Year_Rep: array(Month_Number) of Full_Month_Rep;
|
||||
|
||||
begin
|
||||
-- print the year
|
||||
Cal.Print_Line_Centered(Year_String);
|
||||
|
||||
-- generate a printable form for all the months
|
||||
for Month in Month_Number loop
|
||||
Year_Rep(Month) := Generate_Printable_Month(Year, Month);
|
||||
end loop;
|
||||
|
||||
begin
|
||||
while True loop
|
||||
|
||||
-- new line
|
||||
Cal.New_Line;
|
||||
|
||||
-- write month names
|
||||
Write_Space(Cal.Left_Space);
|
||||
for Month in The_Month .. The_Month+Cal.Columns-2 loop
|
||||
Cal.Put_String(Cal.Month_Rep(Month));
|
||||
Write_Space(Cal.Space_Between_Columns);
|
||||
end loop;
|
||||
Cal.Put_String(Cal.Month_Rep(The_Month+Cal.Columns-1));
|
||||
Cal.New_Line;
|
||||
|
||||
-- write "Mo Tu .. So" - or whatever is defined by Weekday_Rep
|
||||
Write_Space(Cal.Left_Space);
|
||||
for Month in The_Month .. The_Month+Cal.Columns-2 loop
|
||||
Cal.Put_String(Cal.Weekday_Rep);
|
||||
Write_Space(Cal.Space_Between_Columns);
|
||||
end loop;
|
||||
Cal.Put_String(Cal.Weekday_Rep);
|
||||
Cal.New_Line;
|
||||
|
||||
-- write the dates
|
||||
for I in 1 .. 6 loop
|
||||
Write_Space(Cal.Left_Space);
|
||||
for Month in The_Month .. The_Month+Cal.Columns-2 loop
|
||||
Cal.Put_String(Year_Rep(Month)(I));
|
||||
Write_Space(Cal.Space_Between_Columns);
|
||||
end loop;
|
||||
Cal.Put_String(Year_Rep(The_Month+Cal.Columns-1)(I));
|
||||
Cal.New_Line;
|
||||
end loop;
|
||||
|
||||
The_Month := The_Month + Cal.Columns;
|
||||
-- this will eventually raise Constraint_Error to terminate the loop
|
||||
end loop;
|
||||
exception
|
||||
when Constraint_Error => null;
|
||||
end;
|
||||
end Print;
|
||||
|
||||
procedure New_Line(Cal: Calendar) is
|
||||
begin
|
||||
Ada.Text_IO.New_Line;
|
||||
end New_Line;
|
||||
|
||||
procedure Put_String(Cal: Calendar; S: String) is
|
||||
begin
|
||||
Ada.Text_IO.Put(S);
|
||||
end Put_String;
|
||||
|
||||
procedure Print_Line_Centered(Cal: Calendar'Class; Line: String) is
|
||||
Width : constant Positive := Cal.Columns*20
|
||||
+ (Cal.Columns-1)*Cal.Space_Between_Columns
|
||||
+ Cal.Left_Space;
|
||||
begin
|
||||
if Line'Length >= Width-1 then
|
||||
Cal.Put_String(Line);
|
||||
Cal.New_Line;
|
||||
else
|
||||
Print_Line_Centered(Cal, " " & Line & " ");
|
||||
end if;
|
||||
end Print_Line_Centered;
|
||||
|
||||
function Init_80(Des: Description := Default_Description) return Calendar is
|
||||
X: Calendar:=
|
||||
(Columns => 3, Rows => 4, Space_Between_Columns => 4,
|
||||
Left_Space => 1,
|
||||
Weekday_Rep => Des.Weekday_Rep,
|
||||
Month_Rep => Des.Month_Rep
|
||||
);
|
||||
begin
|
||||
return X;
|
||||
end Init_80;
|
||||
|
||||
function Init_132(Des: Description := Default_Description) return Calendar is
|
||||
X: Calendar:=
|
||||
(Columns => 6, Rows => 2, Space_Between_Columns => 2,
|
||||
Left_Space => 1,
|
||||
Weekday_Rep => Des.Weekday_Rep,
|
||||
Month_Rep => Des.Month_Rep
|
||||
);
|
||||
begin
|
||||
return X;
|
||||
end Init_132;
|
||||
|
||||
end Printable_Calendar;
|
||||
|
|
@ -1,11 +0,0 @@
|
|||
with Printable_Calendar;
|
||||
|
||||
procedure Cal is
|
||||
|
||||
C: Printable_Calendar.Calendar := Printable_Calendar.Init_80;
|
||||
|
||||
begin
|
||||
C.Print_Line_Centered("[reserved for Snoopy]");
|
||||
C.New_Line;
|
||||
C.Print(1969, "Nineteen-Sixty-Nine");
|
||||
end Cal;
|
||||
|
|
@ -1,102 +0,0 @@
|
|||
#include <Date.au3>
|
||||
|
||||
; Set the count of characters in each line, minimum is 20 - one month.
|
||||
Global $iPrintSize = 132
|
||||
|
||||
; Set the count of months, you want to print side by side. With "0" it calculates automatically.
|
||||
; The number will corrected, if it not allowed to print in an rectangle.
|
||||
; If your print size is to small for given count, it will set back to automatically calculation.
|
||||
Global $iSideBySide = 3
|
||||
|
||||
; Set the count of spaces between months.
|
||||
Global $iSpace = 4
|
||||
|
||||
_CreateCalendar( 1969 )
|
||||
|
||||
|
||||
Func _CreateCalendar($_iYear)
|
||||
Local $aMon[12] = [' January ', ' February ', ' March ', _
|
||||
' April ', ' May ', ' June ', _
|
||||
' July ', ' August ', ' September ', _
|
||||
' October ', ' November ', ' December ']
|
||||
Local $sHead = 'Mo Tu We Th Fr Sa Su'
|
||||
Local $aDaysInMonth[12] = [31,28,31,30,31,30,31,31,30,31,30,31]
|
||||
If _DateIsLeapYear($_iYear) Then $aDaysInMonth[1] = 29
|
||||
|
||||
; == assign date in weekday table for the whole year
|
||||
Local $aAllDaysInMonth[6][7][12] ; [ lines ][ weekdays ][ months ]
|
||||
Local $iDay = 1, $iShift
|
||||
For $i = 1 To 12
|
||||
$iShift = _DateToDayOfWeekISO($_iYear, $i, 1) -1
|
||||
For $j = 0 To 5
|
||||
For $k = $iShift To 6
|
||||
$aAllDaysInMonth[$j][$k][$i-1] = $iDay
|
||||
$iDay += 1
|
||||
If $iDay > $aDaysInMonth[$i-1] Then ExitLoop(2)
|
||||
Next
|
||||
$iShift = 0
|
||||
Next
|
||||
$iDay = 1
|
||||
Next
|
||||
|
||||
; == check given side by side count, calculate if needed
|
||||
If $iSideBySide > 0 Then
|
||||
If $iPrintSize < ($iSideBySide *(20 +$iSpace) -$iSpace) Then $iSideBySide = 0
|
||||
EndIf
|
||||
Switch $iSideBySide
|
||||
Case 0
|
||||
$iSideBySide = Int($iPrintSize /(20 +$iSpace))
|
||||
If $iPrintSize < 20 Then Return _PrintLine('Escape: Size Error')
|
||||
If $iPrintSize < (20 +$iSpace) Then $iSideBySide = 1
|
||||
Case 5
|
||||
$iSideBySide = 4
|
||||
Case 7 To 11
|
||||
$iSideBySide = 6
|
||||
EndSwitch
|
||||
|
||||
; == create space string
|
||||
Local $sSpace = ''
|
||||
For $i = 1 To $iSpace
|
||||
$sSpace &= ' '
|
||||
Next
|
||||
|
||||
; == print header
|
||||
_PrintLine(@LF)
|
||||
_PrintLine('[ here is Snoopy ]', @LF)
|
||||
_PrintLine(StringRegExpReplace($_iYear, '(\d)(\d)(\d)(\d)', '$1 $2 $3 $4'), @LF)
|
||||
|
||||
; == create data for each line, in dependence to count of months in one line
|
||||
Local $sLine, $iRight, $sTmp1, $sTmp2
|
||||
For $n = 0 To 12 /$iSideBySide -1
|
||||
$sTmp1 = ''
|
||||
$sTmp2 = ''
|
||||
For $z = 0 To $iSideBySide -1
|
||||
$sTmp1 &= $aMon[$iSideBySide *$n+$z] & $sSpace
|
||||
$sTmp2 &= $sHead & $sSpace
|
||||
Next
|
||||
_PrintLine(StringTrimRight($sTmp1, $iSpace))
|
||||
_PrintLine(StringTrimRight($sTmp2, $iSpace))
|
||||
For $j = 0 To 5
|
||||
$sLine = ''
|
||||
For $i = 1 To $iSideBySide
|
||||
For $k = 0 To 6
|
||||
$iRight = 3
|
||||
If $k = 0 Then $iRight = 2
|
||||
$sLine &= StringRight(' ' & $aAllDaysInMonth[$j][$k][$iSideBySide*$n+$i-1], $iRight)
|
||||
Next
|
||||
If $i < $iSideBySide Then $sLine &= $sSpace
|
||||
Next
|
||||
_PrintLine($sLine)
|
||||
Next
|
||||
Next
|
||||
EndFunc ;==>_CreateCalendar
|
||||
|
||||
Func _PrintLine($_sLine, $_sLF='')
|
||||
Local $iLen = StringLen($_sLine)
|
||||
Local $sSpace = '', $sLeft = ''
|
||||
For $i = 1 To $iPrintSize-1
|
||||
$sSpace &= ' '
|
||||
Next
|
||||
If $iLen < $iPrintSize Then $sLeft = StringLeft($sSpace, Int(($iPrintSize-$iLen)/2))
|
||||
ConsoleWrite($sLeft & $_sLine & $_sLF & @LF)
|
||||
EndFunc ;==>_PrintLine
|
||||
|
|
@ -1,226 +0,0 @@
|
|||
IDENTIFICATION DIVISION.
|
||||
PROGRAM-ID. CALEND.
|
||||
ENVIRONMENT DIVISION.
|
||||
INPUT-OUTPUT SECTION.
|
||||
DATA DIVISION.
|
||||
|
||||
WORKING-STORAGE SECTION.
|
||||
01 WS-DAY-NAMES-DEF.
|
||||
03 FILLER PIC X(09) VALUE 'SUNDAY '.
|
||||
03 FILLER PIC X(09) VALUE 'MONDAY '.
|
||||
03 FILLER PIC X(09) VALUE 'TUESDAY '.
|
||||
03 FILLER PIC X(09) VALUE 'WEDNESDAY'.
|
||||
03 FILLER PIC X(09) VALUE 'THURSDAY '.
|
||||
03 FILLER PIC X(09) VALUE 'FRIDAY '.
|
||||
03 FILLER PIC X(09) VALUE 'SATURDAY '.
|
||||
01 FILLER REDEFINES WS-DAY-NAMES-DEF.
|
||||
03 WS-DAY-NAME PIC X(09) OCCURS 07 TIMES.
|
||||
|
||||
01 WS-MTH-INFO-DEF.
|
||||
03 FILLER PIC X(11) VALUE 'JANUARY 31'.
|
||||
03 FILLER PIC X(11) VALUE 'FEBRUARY 28'.
|
||||
03 FILLER PIC X(11) VALUE 'MARCH 31'.
|
||||
03 FILLER PIC X(11) VALUE 'APRIL 30'.
|
||||
03 FILLER PIC X(11) VALUE 'MAY 31'.
|
||||
03 FILLER PIC X(11) VALUE 'JUNE 30'.
|
||||
03 FILLER PIC X(11) VALUE 'JULY 31'.
|
||||
03 FILLER PIC X(11) VALUE 'AUGUST 31'.
|
||||
03 FILLER PIC X(11) VALUE 'SEPTEMBER30'.
|
||||
03 FILLER PIC X(11) VALUE 'OCTOBER 31'.
|
||||
03 FILLER PIC X(11) VALUE 'NOVEMBER 30'.
|
||||
03 FILLER PIC X(11) VALUE 'DECEMBER 31'.
|
||||
01 FILLER REDEFINES WS-MTH-INFO-DEF.
|
||||
03 WS-MTH-INFO-TABLE OCCURS 12 TIMES.
|
||||
05 WS-MTH-INFO-NAME PIC X(09).
|
||||
05 WS-MTH-INFO-DAYS PIC 9(02).
|
||||
|
||||
01 WS-MTH-AREA.
|
||||
03 WS-MTH-DD PIC S99.
|
||||
03 WS-DAY1 PIC 9.
|
||||
03 WS-DAYS PIC 99.
|
||||
03 WS-DD PIC 9.
|
||||
03 WS-WK PIC 9.
|
||||
03 WS-MM PIC 99.
|
||||
03 WS-QQ PIC 99.
|
||||
|
||||
03 WS-MTH-MONTH OCCURS 12 TIMES.
|
||||
05 WS-MTH-WEEK OCCURS 6 TIMES.
|
||||
07 WS-DAY-FLD OCCURS 7 TIMES.
|
||||
09 WS-DAY PIC ZZ.
|
||||
01 INPDATE-RECORD.
|
||||
05 INPD-YEAR PIC 9(04).
|
||||
05 FILLER PIC X(01).
|
||||
05 INPD-MONTH PIC 9(02).
|
||||
05 FILLER PIC X(01).
|
||||
05 INPD-DAY PIC 9(02).
|
||||
01 WMS-DOW PIC 9(01).
|
||||
01 WS-PRT PIC X(132).
|
||||
01 WS-COL PIC 9(03) VALUE 0.
|
||||
01 WS-PP PIC 9(03) VALUE 0.
|
||||
01 WS-CFGN.
|
||||
03 FILLER PIC 9(03) VALUE 80.
|
||||
03 FILLER PIC 9(02) VALUE 5.
|
||||
03 FILLER PIC 9(01) VALUE 1.
|
||||
03 FILLER PIC 9(02) VALUE 5.
|
||||
03 FILLER PIC 9(01) VALUE 2.
|
||||
01 WS-CFGW.
|
||||
03 FILLER PIC 9(03) VALUE 120.
|
||||
03 FILLER PIC 9(02) VALUE 10.
|
||||
03 FILLER PIC 9(01) VALUE 2.
|
||||
03 FILLER PIC 9(02) VALUE 10.
|
||||
03 FILLER PIC 9(01) VALUE 3.
|
||||
01 WS-CFG.
|
||||
03 WS-LS PIC 9(03) VALUE 120.
|
||||
03 WS-LMAR PIC 9(02) VALUE 10.
|
||||
03 WS-SPBD PIC 9(01) VALUE 2.
|
||||
03 WS-SPBC PIC 9(02) VALUE 10.
|
||||
03 WS-DNMW PIC 9(01) VALUE 3.
|
||||
PROCEDURE DIVISION.
|
||||
MOVE '1969-01-01' TO INPDATE-RECORD
|
||||
MOVE WS-CFGN TO WS-CFG
|
||||
IF (FUNCTION MOD ( INPD-YEAR , 400 ) = 0
|
||||
OR (FUNCTION MOD ( INPD-YEAR , 4 ) = 0
|
||||
AND
|
||||
FUNCTION MOD ( INPD-YEAR , 100 ) NOT = 0))
|
||||
MOVE 29 TO WS-MTH-INFO-DAYS (02)
|
||||
ELSE
|
||||
MOVE 28 TO WS-MTH-INFO-DAYS (02)
|
||||
END-IF
|
||||
|
||||
PERFORM VARYING WS-MM FROM 1 BY +1
|
||||
UNTIL WS-MM > 12
|
||||
MOVE WS-MM TO INPD-MONTH
|
||||
CALL 'DATE2DOW' USING INPDATE-RECORD, WMS-DOW
|
||||
COMPUTE WS-MTH-DD = 1 - WMS-DOW
|
||||
COMPUTE WS-DAYS = WS-MTH-INFO-DAYS (INPD-MONTH)
|
||||
PERFORM VARYING WS-WK FROM 1 BY +1
|
||||
UNTIL WS-WK > 6
|
||||
PERFORM VARYING WS-DD FROM 1 BY +1
|
||||
UNTIL WS-DD > 7
|
||||
COMPUTE WS-MTH-DD = WS-MTH-DD + 1
|
||||
IF (WS-MTH-DD < 1)
|
||||
OR (WS-MTH-DD > WS-DAYS)
|
||||
MOVE 0 TO WS-DAY (WS-MM, WS-WK, WS-DD)
|
||||
ELSE
|
||||
MOVE WS-MTH-DD TO WS-DAY (WS-MM, WS-WK, WS-DD)
|
||||
END-IF
|
||||
END-PERFORM
|
||||
END-PERFORM
|
||||
END-PERFORM
|
||||
|
||||
COMPUTE WS-MM = 0
|
||||
PERFORM VARYING WS-QQ FROM 1 BY +1
|
||||
UNTIL WS-QQ > 4
|
||||
|
||||
INITIALIZE WS-PRT
|
||||
COMPUTE WS-PP = 1
|
||||
PERFORM VARYING WS-COL FROM 1 BY +1
|
||||
UNTIL WS-COL > 3
|
||||
COMPUTE WS-MM = 3 * (WS-QQ - 1) + WS-COL
|
||||
|
||||
IF WS-COL = 1
|
||||
COMPUTE WS-PP = WS-PP + WS-LMAR + 2 - WS-DNMW
|
||||
ELSE
|
||||
COMPUTE WS-PP = WS-PP + WS-SPBC + 2 - WS-DNMW
|
||||
END-IF
|
||||
MOVE WS-MTH-INFO-NAME (WS-MM)
|
||||
TO WS-PRT(WS-PP:9)
|
||||
COMPUTE WS-PP
|
||||
= WS-PP + ( 2 * 7 + WS-SPBD * 6 + WS-SPBD - 1)
|
||||
- 4
|
||||
MOVE INPD-YEAR TO WS-PRT (WS-PP:4)
|
||||
COMPUTE WS-PP = WS-PP + 4
|
||||
END-PERFORM
|
||||
DISPLAY WS-PRT (1:WS-LS)
|
||||
|
||||
INITIALIZE WS-PRT
|
||||
COMPUTE WS-PP = 1
|
||||
PERFORM VARYING WS-COL FROM 1 BY +1
|
||||
UNTIL WS-COL > 3
|
||||
COMPUTE WS-MM = 3 * (WS-QQ - 1) + WS-COL
|
||||
|
||||
IF WS-COL = 1
|
||||
COMPUTE WS-PP = WS-PP + WS-LMAR + 2 - WS-DNMW
|
||||
ELSE
|
||||
COMPUTE WS-PP = WS-PP + WS-SPBC + 2 - WS-DNMW
|
||||
END-IF
|
||||
PERFORM VARYING WS-DD FROM 1 BY +1
|
||||
UNTIL WS-DD > 7
|
||||
IF WS-DD > 1
|
||||
COMPUTE WS-PP = WS-PP + WS-SPBD + 2 - WS-DNMW
|
||||
END-IF
|
||||
MOVE WS-DAY-NAME (WS-DD) (1:WS-DNMW)
|
||||
TO WS-PRT (WS-PP:WS-DNMW)
|
||||
COMPUTE WS-PP = WS-PP + WS-DNMW
|
||||
END-PERFORM
|
||||
END-PERFORM
|
||||
DISPLAY WS-PRT (1:WS-LS)
|
||||
|
||||
PERFORM VARYING WS-WK FROM 1 BY +1
|
||||
UNTIL WS-WK > 6
|
||||
INITIALIZE WS-PRT
|
||||
COMPUTE WS-PP = 1
|
||||
PERFORM VARYING WS-COL FROM 1 BY +1
|
||||
UNTIL WS-COL > 3
|
||||
COMPUTE WS-MM = 3 * (WS-QQ - 1) + WS-COL
|
||||
|
||||
IF WS-COL = 1
|
||||
COMPUTE WS-PP = WS-PP + WS-LMAR
|
||||
ELSE
|
||||
COMPUTE WS-PP = WS-PP + WS-SPBC
|
||||
END-IF
|
||||
PERFORM VARYING WS-DD FROM 1 BY +1
|
||||
UNTIL WS-DD > 7
|
||||
IF WS-DD > 1
|
||||
COMPUTE WS-PP = WS-PP + WS-SPBD
|
||||
END-IF
|
||||
MOVE WS-DAY (WS-MM, WS-WK, WS-DD)
|
||||
TO WS-PRT (WS-PP:2)
|
||||
COMPUTE WS-PP = WS-PP + 2
|
||||
END-PERFORM
|
||||
END-PERFORM
|
||||
DISPLAY WS-PRT (1:WS-LS)
|
||||
END-PERFORM
|
||||
DISPLAY ' '
|
||||
END-PERFORM
|
||||
GOBACK
|
||||
.
|
||||
END PROGRAM CALEND.
|
||||
IDENTIFICATION DIVISION.
|
||||
PROGRAM-ID. DATE2DOW.
|
||||
ENVIRONMENT DIVISION.
|
||||
DATA DIVISION.
|
||||
WORKING-STORAGE SECTION.
|
||||
01 WMS-WORK-AREA.
|
||||
03 WMS-YEAR PIC 9(04).
|
||||
03 WMS-MONTH PIC 9(02).
|
||||
03 WMS-CSYS PIC 9(01) VALUE 1.
|
||||
03 WMS-SUM pic 9(04).
|
||||
LINKAGE SECTION.
|
||||
01 INPDATE-RECORD.
|
||||
05 INPD-YEAR PIC 9(04).
|
||||
05 FILLER PIC X(01).
|
||||
05 INPD-MONTH PIC 9(02).
|
||||
05 FILLER PIC X(01).
|
||||
05 INPD-DAY PIC 9(02).
|
||||
01 WMS-DOW PIC 9(01).
|
||||
PROCEDURE DIVISION USING INPDATE-RECORD, WMS-DOW.
|
||||
1010-CONVERT-DATE-TO-DOW.
|
||||
IF INPD-MONTH < 3
|
||||
COMPUTE WMS-MONTH = INPD-MONTH + 12
|
||||
COMPUTE WMS-YEAR = INPD-YEAR - 1
|
||||
ELSE
|
||||
COMPUTE WMS-MONTH = INPD-MONTH
|
||||
COMPUTE WMS-YEAR = INPD-YEAR
|
||||
END-IF
|
||||
COMPUTE WMS-SUM =
|
||||
( INPD-DAY + 2 * WMS-MONTH + WMS-YEAR
|
||||
+ FUNCTION INTEGER (6 * (WMS-MONTH + 1) / 10)
|
||||
+ FUNCTION INTEGER ( WMS-YEAR / 4 )
|
||||
- FUNCTION INTEGER ( WMS-YEAR / 100 )
|
||||
+ FUNCTION INTEGER ( WMS-YEAR / 400 )
|
||||
+ WMS-CSYS )
|
||||
COMPUTE WMS-DOW = FUNCTION MOD (WMS-SUM, 7) + 1
|
||||
GOBACK
|
||||
.
|
||||
END PROGRAM DATE2DOW.
|
||||
|
|
@ -1,36 +0,0 @@
|
|||
Param([int]$Year = 1969)
|
||||
Begin {
|
||||
$COL_WIDTH = 21
|
||||
$COLS = 3
|
||||
$MONTH_COUNT = 12
|
||||
$MONTH_LINES = 9
|
||||
|
||||
Function CenterStr([string]$s, [int]$lineSize) {
|
||||
$padSize = [int](($lineSize - $s.Length) / 2)
|
||||
($(if ($padSize -gt 0) { ' ' * $padSize } else { '' }) + $s).PadRight($lineSize,' ')
|
||||
}
|
||||
|
||||
Function MonthLines([int]$month) {
|
||||
$dt = [System.DateTime]::new($Year, $month, 1)
|
||||
$line = CenterStr $dt.ToString("MMMM") $COL_WIDTH
|
||||
$line += 'Su Mo Tu We Th Fr Sa'
|
||||
$line += $(' ' * $dt.DayOfWeek.value__)
|
||||
$line += (-join ($(1..$($dt.AddMonths(1).AddDays(-1).Day)) | %{ $("" + $_).PadLeft(3) }))
|
||||
$line = $line.PadRight($MONTH_LINES * $COL_WIDTH)
|
||||
New-Object –TypeName PSObject –Prop(@{
|
||||
'Lines'=(0..($MONTH_LINES - 1)) | %{ $_ * $COL_WIDTH } | %{ -join $line[$_..($_ + $COL_WIDTH - 1)] }
|
||||
'Dt'=$dt})
|
||||
}
|
||||
}
|
||||
Process {
|
||||
Write-Output (CenterStr $Year ($COL_WIDTH * $COLS + 4))
|
||||
$(0..($MONTH_COUNT / $COLS - 1)) | %{
|
||||
$fm = $_ * $COLS
|
||||
$monthNums = $fm..($fm + $COLS - 1) | %{ $_ + 1 }
|
||||
$months = $monthNums | %{ MonthLines $_ }
|
||||
$(0..($MONTH_LINES - 1)) | %{
|
||||
$ml = $_
|
||||
Write-Output $(-join ($(0..($COLS - 1)) | %{ $(if ($_ -eq 0) { '' } else {' '}) + $months[$_].Lines[$ml] }))
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
@ -1,13 +0,0 @@
|
|||
Rebol []
|
||||
do [if "" = y: ask "Year (ENTER for current):^/^/" [prin y: now/year]
|
||||
foreach m system/locale/months [
|
||||
prin rejoin ["^/^/ " m "^/^/ "]
|
||||
foreach day system/locale/days [prin join copy/part day 2 " "]
|
||||
print "" f: to-date rejoin ["1-"m"-"y] loop f/weekday - 1 [prin " "]
|
||||
repeat i 31 [
|
||||
if attempt [c: to-date rejoin [i"-"m"-"y]][
|
||||
prin join either 1 = length? form i [" "][" "] i
|
||||
if c/weekday = 7 [print ""]
|
||||
]
|
||||
]
|
||||
] ask "^/^/Press [ENTER] to Continue..."]
|
||||
|
|
@ -1,74 +0,0 @@
|
|||
'call it with year, number of months per row (1,2,3,4,6) and locale ("" for default)
|
||||
docal 1969,6,""
|
||||
|
||||
function center (s,n) x=n-len(s):center=space(x\2+(x and 1))& s & space(x\2):end function
|
||||
sub print(x) wscript.stdout.writeline x : end sub
|
||||
function iif(a,b,c) :if a then iif=b else iif =c end if : end function
|
||||
|
||||
sub docal (yr,nmonth,sloc)
|
||||
'yr year to print
|
||||
'nmonth number of monts side to side, allowed values :1,2,3,4,6
|
||||
'sloc locale to use . "" uses the default
|
||||
|
||||
dim ld(6)
|
||||
dim d(6)
|
||||
if nmonth=5 or nmonth>6 or nmonth<1 then wscript.stderr.writeline "Can't use width " & nmonth :exit sub
|
||||
|
||||
'set the locale (names of months and weekdays plus first day of week)
|
||||
if sloc<>"" then Setlocale sloc
|
||||
|
||||
'make a row of short weekday names to put on top of the month days
|
||||
'trim the names to 2 char and align them right
|
||||
wday=""
|
||||
for i=1 to 7
|
||||
wday=wday &" "&right(" "& left(weekdayname(i,true,vbUseSystemDayOfWeek),2),2)
|
||||
next
|
||||
|
||||
'print header of the calendar
|
||||
ncols=nmonth*21+(nmonth-1)*1
|
||||
print center("[Snoopy]",ncols)
|
||||
print center(yr,ncols)
|
||||
print string(ncols,"=")
|
||||
|
||||
'row of months
|
||||
for i=1 to 12\nmonth
|
||||
s="": s1="":esp=""
|
||||
|
||||
for j=1 to nmonth
|
||||
'build header of the month row
|
||||
s=s & esp & center(monthname(m+j),21)
|
||||
s1=s1 & esp & wday
|
||||
|
||||
'get negative offset of first day of week to the weekday of day 1 of each month
|
||||
d(j)= -weekday(dateserial(yr,m+j,1),vbUseSystemDayOfWeek)+2
|
||||
'get last day of each month from Windows
|
||||
ld(j)=day(dateserial(yr,m+j+1,0))
|
||||
esp=" "
|
||||
next
|
||||
|
||||
'print the row of months header (name of month and weekday names)
|
||||
print s: print s1
|
||||
|
||||
'weekday rows. makes 5 or 6 rows according to the month requiring most
|
||||
while(d(1)<ld(1)) or (d(2)<ld(2)) or (d(3)<ld(3)) or (d(4)<ld(4))or (d(5)<ld(5)) or (d(6)<ld(6))
|
||||
s=""
|
||||
for j=1 to nmonth
|
||||
'fill present week row
|
||||
for k=1 to 7
|
||||
'add a day number only if inside the range of days of this montg
|
||||
s=s& right(space(3)&iif(d(j)<1 or d(j)>ld(j),"",d(j)),3)
|
||||
d(j)=d(j)+1
|
||||
next
|
||||
s=s&" "
|
||||
next
|
||||
'print a complete row of days
|
||||
print s
|
||||
wend
|
||||
'go for the next row of monts
|
||||
m=m+nmonth
|
||||
if i<>12\nmonth then print ""
|
||||
next
|
||||
|
||||
'print footer
|
||||
print string(ncols,"=")
|
||||
end sub
|
||||
Loading…
Add table
Add a link
Reference in a new issue