program CALENDAR; (* written in TURBO PASCAL Jan '85
                    by Doug Cox for the Osborne 1 *)

{ Updated for the Osborne EXECUTIVE by Mike Pillers  Mar '85 }
{    by merely changing the value of ScreenTop to $C000.     }

const ScreenTop: integer= $C000;
type
  Days= 1..7; Rows= 1..24;
  TotalRows= 1..32; TotalCols= 1..128;
  PointerType= ^ScreenPointer;
  ScreenPointer= array[TotalRows, TotalCols] of byte;
var
  pointerVar: PointerType ABSOLUTE Screentop;
  entry: array [Days, Rows] of string[10];
  note: string[10];
  mon, mo: string[3];
  ch, nextCh: char;
  p, x, y: byte;
  fileName: string[7];
  fv: Text;

procedure HorizLines;
  begin
  for y:= 1 to 4 do
    for x:= 1 to 76 do
      pointerVar^[5*y, x]:= 95;
  end;

procedure VertLines;
  begin
  for y:= 1 to 24 do
    for x:= 1 to 6 do
      pointerVar^[y, 11*x]:= 124;
  end;

procedure DiskInfo;
    label B, E;
    var spaces, len: integer; ok: boolean;
procedure Dates;
  begin
  for x:= 1 to 7 do
    begin
    GotoXY(((x+spaces)*11)-2, 1); if (spaces+x) <= 7 then write (x);
    GotoXY((x*11)-2, 6); write (7+(x-spaces));
    GotoXY((x*11)-2, 11); write (14+(x-spaces));
    GotoXY((x*11)-2, 16); write (21+(x-spaces));
    end;
  y:= 28-spaces;
  for x:= 1 to (len-y) do
    begin
    y:= y+1;
    GotoXY((x*11)-2, 21);  if x < 8 then write (y);
    end;
  y:= 35-spaces;
  if y < len then
    for x:= 1 to (len-y) do
      begin
      y:= y+1;
      GotoXY((x*11)-5, 21); write (y,'/');
      end;
  end;

  begin (* procedure DiskInfo *)
B:GotoXY(1,3); writeln ('(RETURN to quit)');
  GotoXY(1,2); write ('MONTH: '); read (mo);
  for x:= 1 to 3 do mo[x]:= UpCase(mo[x]);
  GotoXY(1,2); write ('          |     ');
  GotoXY(1,3); write ('          |     ');
  if mo= '' then goto E
  else mon:= Copy(mo,1,3);
  if mon= 'JAN' then begin spaces:= 2; len:= 31; end
  else if mon= 'FEB' then begin spaces:= 5; len:= 28; end
  else if mon= 'MAR' then begin spaces:= 5; len:= 31; end
  else if mon= 'APR' then begin spaces:= 1; len:= 30; end
  else if mon= 'MAY' then begin spaces:= 3; len:= 31; end
  else if mon= 'JUN' then begin spaces:= 6; len:= 30; end
  else if mon= 'JUL' then begin spaces:= 1; len:= 31; end
  else if mon= 'AUG' then begin spaces:= 4; len:= 31; end
  else if mon= 'SEP' then begin spaces:= 0; len:= 30; end
  else if mon= 'OCT' then begin spaces:= 2; len:= 31; end
  else if mon= 'NOV' then begin spaces:= 5; len:= 30; end
  else if mon= 'DEC' then begin spaces:= 0; len:= 31; end
  else goto B;
  fileName:= mon+'.DTA';
  Dates;
  Assign (fv,fileName);
  {$I-} Reset (fv) {$I+};
  ok:= (IOresult= 0);
  if ok then
    while not Eof (fv) do
      begin
      readln (fv, x, y, note); entry[x,y]:= note;
      GotoXY((x*11)-10, y); write (entry[x,y]);
      end;
E:end;

procedure Save;
  begin
  Assign (fv,fileName); Rewrite (fv);
  for x:= 1 to 7 do
    for y:= 1 to 24 do
      if entry[x,y] <> '' then
        writeln (fv, x,' ',y,' ',entry[x,y]);
  Close (fv);
  end;

procedure Entries;
    label B, E;
    const Len= 10; Blanks= '          ';
  begin
B:GotoXY(1,1); write (mon);
  p:= 0; x:= 1; y:= 2;
  repeat
    GotoXY(((x*11)-10)+p, y); read (Kbd, ch);
    case ch of
      #31..#127: if p < Len then
                begin
                if p > Length(entry[x,y]) then
                  Insert (Copy(Blanks, 1, p-Length(entry[x,y])), entry[x,y],1);
                p:= p+1;
                Delete (entry[x,y], p, 1);
                Insert (ch, entry[x,y],p);
                write (Copy(entry[x,y], p, Len));
                end;
      ^D   : if p < Len then p:= p+1
                else if x < 7 then begin x:= x+1; p:= 0; end;
      ^S   : if p > 0 then p:= p-1
                else if x > 1 then begin x:= x-1; p:= 9; end;
      ^E   : if y > 1 then begin y:= y-1; p:= 0; end;
      ^X,^M: begin if y < 24 then y:= y+1; p:= 0; end;
      ^F   : if x < 7 then begin x:= x+1; p:= 0; end;
      ^A   : begin if (p= 0) and (x > 1) then x:= x-1 else p:= 0; end;
      ^C   : begin if y < 20 then y:= y+5 else y:= 24; p:= 0; end;
      ^R   : begin if y > 5 then y:= y-5 else y:= 1; p:= 0; end;
      ^Y   : begin
             Delete (entry[x,y], 1,Len);
             GotoXY((x*11)-10, y); write (Blanks);
             p:= 0;
             end;
      ^G   : if p < Length(entry[x,y]) then
               begin
               Delete(entry[x,y], p+1, 1);
               write (Copy(entry[x,y], p+1, Len), ' ');
               end;
      ^H   : if p > 0 then
               begin
                 Delete(entry[x,y], p, 1);
                 write (^H, Copy(entry[x,y], p, Length(entry[x,y])-p),' ');
                  p:= p-1;
               end;
      ^[   : Goto E;
      ^Q   : begin
               read (Kbd, nextCh); nextCh:= UpCase(nextCh);
               case nextCh of
                'S',^S: begin x:= 1; p:= 0; end;
                'D',^D: begin x:= 7; p:= 0; end;
                'E',^E: begin y:= 1; p:= 0; end;
                'X',^X: begin y:= 24; p:= 0; end;
                 end;
             end;
      end;
  until ch= ^K;
  GotoXY(1,1); write ('^K '); GotoXY(3,1);
  read (Kbd, ch); ch:= UpCase(ch);
  case ch of
   'S',^S : begin write ('S'); Save; Goto B; end;
   'D',^D : begin write ('D'); Save; end;
   'X',^X : begin write ('X'); Save; mo:= ''; end;
   'Q',^Q : begin end;
    else Goto B;
    end;
E:end;

begin (* MAIN PART *)
repeat
  ClrScr;
  for x:= 1 to 7 do
    for y:= 1 to 24 do
      entry[x,y]:= '';
  write ('    SUN        MON        TUE        WED        THU        FRI        SAT');
  HorizLines;
  VertLines;
  DiskInfo;
  if mo <> '' then Entries;
until mo= '';
ClrScr;
end.