home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / CPM / DATABASE / SCHEDULE.ARK / SCHEDULE.PAS < prev    next >
Pascal/Delphi Source File  |  1987-01-20  |  8KB  |  377 lines
  1. PROGRAM Schedule;
  2.  
  3. {   Personal Daily Schedule Handler by Noriaki Hosoya      }
  4.  
  5. {$C-}
  6.  
  7. CONST
  8.    HrBgn = 7;                { = 7 am }
  9.    HrEnd = 17;               { = 5 pm }
  10.    IM : Integer = 1;         { Window Boundary for Munu }
  11.    JM : Integer = 10;
  12.    IC : Integer = 1;         { Window Boundary for Calendar }
  13.    JC : Integer = 2;
  14.    IS : Integer = 30;        { Window Boundary for Notepad }
  15.    JS : Integer = 1;
  16.  
  17. TYPE
  18.    Str2 = String[2];
  19.    Str5 = String[5];
  20.    Str8 = String[8];
  21.    Str9 = String[9];
  22.    Str40 = String[40];
  23.    FileName = String[14];
  24.    Apt = Record
  25.             Date : Str8;
  26.             Note : Array[HrBgn..HrEnd] of Str40;
  27.          END;
  28.  
  29. CONST
  30.    Programmer = 'Noriaki Hosoya';
  31.    LastUpdate : Str8 = '07/11/86';
  32.    Version = 1.0;
  33.    DaysOfMonth : Array[1..12] of Integer = (31,28,31,30,31,30,
  34.                  31,31,30,31,30,31);
  35.    MonthOfYear : Array[1..12] of Str9 = ('January','February','March',
  36.                  'April','May','June','July','August','September',
  37.                  'October','November','December');
  38.    Hr : Array[HrBgn..HrEnd] of Str5 = ('7 am','8 am','9 am','10 am',
  39.         '11 am','12 n ','1 pm','2 pm','3 pm','4 pm','5 pm');
  40.    Blank : Str40 = '                                        ';
  41.    TempFile : FileName = 'SCHTEMP.$$$';
  42.    Show : Boolean = True;
  43.  
  44. VAR
  45.    Year, Month, Day, Hour, HourLast : Integer;
  46.    DayOfWeek, DOW, DOM : Integer;
  47.    AptFile, TFile : FILE of Apt;
  48.    AptRec : Apt;
  49.    DataFile : FileName;
  50.    Rec : Integer;
  51.    DY, DM, DD : Str2;
  52.    Date1, Date2, Date3 : Str8;
  53.    NoError, CreateMode, More : Boolean;
  54.  
  55. {$I SCH1.INC}
  56.  
  57. PROCEDURE DispNote(K : Integer);
  58.  
  59. VAR
  60.    I, J, L : Integer;
  61.  
  62. BEGIN
  63.    CursorOff;
  64.    L := 2*(K - HrBgn) + JS;
  65.    GotoXY(IS,L);
  66.    ClrEol;
  67.    If K = Hour Then NormVideo Else LowVideo;
  68.    I := Length(AptRec.Note[K]);
  69.    Write(Hr[K]:5, ' : ');
  70.    UnderOn;
  71.    If K = Hour Then
  72.    BEGIN
  73.       LowVideo;
  74.       ReverseOn;
  75.    END;
  76.    Write(AptRec.Note[K]:1);
  77.    If I < 40 Then For J := 1 To 40 - I Do Write(' ');
  78.    UnderOff;
  79.    ReverseOff;
  80.    GotoXY(IS + 48,L);
  81.    If K = Hour Then NormVideo Else LowVideo;
  82.    Write(' : ');
  83.    NormVideo;
  84.    CursorOn;
  85. END; {of DispNote}
  86.  
  87. PROCEDURE DispAll;
  88.  
  89. VAR
  90.    K : Integer;
  91.  
  92. BEGIN
  93.    For K := HrBgn To HrEnd Do DispNote(K);
  94. END; {of DispAll}
  95.  
  96. PROCEDURE GotoNote;
  97.  
  98. VAR
  99.    K, L : Integer;
  100.  
  101. BEGIN
  102.    CursorOff;
  103.    K := IS + 8;
  104.    L := 2*(Hour - HrBgn) + JS;
  105.    GotoXY(K,L);
  106.    ClrEol;
  107.    GotoXY(K + 40,L);
  108.    Write(' : ');
  109.    GotoXY(K,L);
  110.    CursorOn;
  111. END; {of GotoNote}
  112.  
  113. PROCEDURE UpDate;
  114.  
  115. BEGIN
  116.    EnterDate;
  117.    MakeDate;
  118.    SearchDate;
  119.    SetCal;
  120.    Calendar;
  121.    Hour := HrBgn;
  122.    DispAll;
  123. END; {of UpDate}
  124.  
  125. PROCEDURE Save;
  126.  
  127. BEGIN
  128.    Seek(AptFile,Rec);
  129.    Write(AptFile,AptRec);
  130.    Flush(AptFile);
  131.    Close(AptFile);
  132.    CreateMode := False;
  133. END; {of Save}
  134.  
  135. PROCEDURE UpHour;
  136.  
  137. BEGIN
  138.    HourLast := Hour;
  139.    Hour := Pred(Hour);
  140.    If Hour < HrBgn Then Hour := HrEnd;
  141. END; {of UpHour}
  142.  
  143. PROCEDURE DownHour;
  144.  
  145. BEGIN
  146.    HourLast := Hour;
  147.    Hour := Succ(Hour);
  148.    If Hour > HrEnd Then Hour := HrBgn;
  149. END; {of DownHour}
  150.  
  151. PROCEDURE EnterNote;
  152.  
  153. BEGIN
  154.    StatusLine;
  155.    GotoNote;
  156.    Readln(AptRec.Note[Hour]);
  157. END; {of EnterNote}
  158.  
  159. PROCEDURE CancelNote;
  160.  
  161. BEGIN
  162.    GotoNote;
  163.    AptRec.Note[Hour] := Blank;
  164. END; {of CancelNote}
  165.  
  166. PROCEDURE SaveResume;
  167.  
  168. BEGIN
  169.    Save;
  170.    UpDate;
  171. END; {of SaveResume}
  172.  
  173. PROCEDURE SaveQuit;
  174. BEGIN
  175.    Save;
  176.    More := False
  177. END; {of SaveQuit}
  178.  
  179. PROCEDURE DispDates;
  180.  
  181. VAR
  182.    D, M, Y, Code, R, RecSize : Integer;
  183.    DD1, DM1, DY1 : Str2;
  184.    Ch : Char;
  185.  
  186. BEGIN
  187.    ClrScr;
  188.    R := 0;
  189.    OpenToUpdate;
  190.    RecSize := FileSize(AptFile);
  191.    If RecSize = 0 Then
  192.    BEGIN
  193.       GotoXY(12,7);
  194.       Write(^G, 'No Record in File ', DataFile:1,'!!');
  195.    END
  196.    Else
  197.    BEGIN
  198.       GotoXY(12,1);
  199.       UnderOn;
  200.       Write('File ', DataFile:1, ' contains Records for:');
  201.       UnderOff;
  202.       Writeln;
  203.       Writeln;
  204.       While R < RecSize Do
  205.       BEGIN
  206.          Seek(AptFile,R);
  207.          Flush(AptFile);
  208.          Read(AptFile,AptRec);
  209.          DY1 := Copy(AptRec.Date,1,2);
  210.          DM1 := Copy(AptRec.Date,4,2);
  211.          DD1 := Copy(AptRec.Date,7,2);
  212.          Val(DY1,Y,Code);
  213.          Val(DM1,M,Code);
  214.          Val(DD1,D,Code);
  215.          Y := Y + 1900;
  216.          Write('              ', (R + 1):3, ' ');
  217.          Writeln(MonthOfYear[M]:9, ' ', D:2, ', ', Y:1);
  218.          If Succ(R) Mod 18 = 0 Then
  219.          BEGIN
  220.             StatusLine;
  221.             Write('Enter any key to continue : ');
  222.             Read(Kbd,Ch);
  223.             ClrScr;
  224.          END;
  225.          R := Succ(R);
  226.       END;
  227.       Close(AptFile);
  228.    END;
  229.    StatusLine;
  230.    Write('Enter any key to resume : ');
  231.    Read(Kbd,Ch);
  232.    ClrScr;
  233. END; {of DispDates}
  234.  
  235. PROCEDURE PrintSchedule;
  236.  
  237. VAR
  238.    I, Y : Integer;
  239.  
  240. BEGIN
  241.    Save;
  242.    StatusLine;
  243.    Write('Printer ready (y/n) ? ');
  244.    If NoYes(1) Then
  245.    BEGIN
  246.       Y := 1900 + Year;
  247.       StatusLine;
  248.       Write('Printing Schedule On ', MonthOfYear[Month]:1);
  249.       Write(' ', Day:1, ', ', Y:1);
  250.       Write(Lst, '          Schedule on ');
  251.       Writeln(Lst, MonthOfYear[Month]:1, ' ', Day:1, ', ', Y:1);
  252.       Writeln(Lst);
  253.       For I := HrBgn To HrEnd Do
  254.       BEGIN
  255.          Write(Lst, '     ', Hr[I]:5);
  256.          Writeln(Lst, ' : ', AptRec.Note[I]:1);
  257.          Writeln(Lst);
  258.       END;
  259.       Write(Lst,^L);
  260.    END;
  261.    OpenToUpdate;
  262. END; {of PrintSchedule}
  263.  
  264. PROCEDURE  OpenFile;
  265.  
  266. BEGIN
  267.    Save;
  268.    More := True;
  269. END; {of OpenFile}
  270.  
  271. PROCEDURE DeleteRecord;
  272.  
  273. VAR
  274.    R, RSize : Integer;
  275.  
  276. BEGIN
  277.    Close(AptFile);
  278.    More := True;
  279.    StatusLine;
  280.    Write('Are you sure (y/n) ? ');
  281.    If NoYes(1) Then
  282.    BEGIN
  283.       ClrScr;
  284.       StatusLine;
  285.       Write('Packing File ', DataFile:1, '.   Please WAIT...');
  286.       Date3 := Date1;
  287.       OpenToUpdate;
  288.       Assign(TFile, TempFile);
  289.       Rewrite(TFile);
  290.       RSize := FileSize(AptFile);
  291.       R := 0;
  292.       While R < RSize Do
  293.       BEGIN
  294.          Flush(AptFile);
  295.          Seek(AptFile,R);
  296.          Read(AptFile,AptRec);
  297.          R := Succ(R);
  298.          If AptRec.Date <> Date3 Then
  299.          BEGIN
  300.             Write(TFile,AptRec);
  301.             Flush(TFile);
  302.          END;
  303.       END;
  304.       Close(AptFile);
  305.       Close(TFile);
  306.       Erase(AptFile);
  307.       Rename(TFile,DataFile);
  308.    END;
  309. END; {of DeleteRecord}
  310.  
  311. PROCEDURE EnterCommand;
  312.  
  313. VAR
  314.    Com : Char;
  315.    Valid : Boolean;
  316.  
  317. BEGIN
  318.    Com := ^E;
  319.    Hour := HrBgn;
  320.    HourLast := Succ(HrBgn);
  321.    While Com In [^E, ^X, ^[, ^C, ^S, ^D, ^P, ^T] Do
  322.    BEGIN
  323.       DispNote(Hour);
  324.       DispNote(HourLast);
  325.       StatusLine;
  326.       Write('Your Command ? ');
  327.       Repeat
  328.          Read(Kbd,Com);
  329.          If Com In [^E, ^X, ^[, ^C, ^S, ^T, ^D, ^P, ^F, ^Q] Then Valid := True Else Valid := False;
  330.          If Not Valid Then Write(^G);
  331.       Until Valid;
  332.       Case Com of
  333.          ^E : UpHour;
  334.          ^X : DownHour;
  335.          ^[ : EnterNote;
  336.          ^C : CancelNote;
  337.          ^S : SaveResume;
  338.          ^T : BEGIN
  339.                  Save;
  340.                  DeleteRecord;
  341.                  DispDates;
  342.                  UpDate;
  343.                  Menu;
  344.               END;
  345.          ^D : BEGIN
  346.                  Save;
  347.                  DispDates;
  348.                  UpDate;
  349.                  Menu;
  350.               END;
  351.          ^P : PrintSchedule;
  352.          ^F : OpenFile;
  353.          ^Q : SaveQuit;
  354.       END;
  355.    END;
  356. END; {of EnterCommand}
  357.  
  358. BEGIN {of Main Program}
  359.    ClrScr;
  360.    If Show Then SignOn;
  361.    Repeat
  362.       EnterFile;
  363.       ClrScr;
  364.       If Not CreateMode Then
  365.       BEGIN
  366.          StatusLine;
  367.          Write('Do you want to see the contents of File ');
  368.          Write(DataFile:1, ' (y/n) ? ');
  369.          If NoYes(1) Then DispDates;
  370.       END;
  371.       UpDate;
  372.       Menu;
  373.       EnterCommand;
  374.    Until Not More;
  375.    SignOff;
  376. END. {of SCHEDULE}
  377.