{************************************************}
{                                                }
{   UNIT XVIEWS   A collection of new Views      }
{   Copyright (c) 1994-97 by Tom Wellige         }
{   Donated as FREEWARE                          }
{                                                }
{   Ortsmuehle 4, 44227 Dortmund, GERMANY        }
{   EMail: wellige@itk.de                        }
{                                                }
{************************************************}

(*
  Some few words on this unit:
  ----------------------------

   - This units works fine with Turbo Pascal 6 or higher. If you use
     TP/BP 7 you can use the "inherited" command as shown in the
     comment lines on each line where it is possible.

   - This unit defines first of all a basic object (TXView) for status views
     which are updateable via messages (send from the applications Idle
     methode). All inheritances only have to override the abstract methode
     UPDATE and place the information to display in a string. In this manner
     there are a ClockView, a DateView and an HeapView as examples
     implemented. The usage of these objects (TClock, TDate and THeap) will
     be demonstrated in the programs XTEST1 and XTEST2.

   - There is also a 7-segment view implemented in this unit (T7Segment)
     capable of displaying all numbers from 0 to 9 and the characters
     "A" "b" "c" "d" "E" "F" and "-". The usage of this object is also
     demonstrated in this unit by the object TBigClock which is a clock
     in "hh:mm:ss" format. How to use this clock is demonstrated in the
     XTEST3 program.
*)

unit xviews;

interface

uses dos, objects, drivers, views;

const
  cmGetData        = 5000;   { Request data string from TXView object }
  cmChange7Segment = 5001;   { Set new value to display in T7Segment  }
  cmChangeBack     = 5002;   { Change Background of T7Segment         }

type
  PXView = ^TXView;                  (* Basic status view object  *)
  TXView = object(TView)
      Data: string;
    procedure HandleEvent(var Event: TEvent); virtual;
    procedure Update; virtual;
    procedure Draw; virtual;
    function  GetString: PString; virtual;
  end;

  PClock = ^TClock;                   (* Displays current time           *)
  TClock = object(TXView)
    procedure Update; virtual;
  end;

  PDate = ^TDate;                     (* Displays current date           *)
  TDate = object(TXView)
    procedure Update; virtual;
  end;

  PHeap = ^THeap;                     (* Displays free bytes on the heap *)
  THeap = object(TXView)
    procedure Update; virtual;
  end;

  PInfoView = ^TInfoView;             (* Show all "actual" datas         *)
  TInfoView = object(TView)
    procedure Draw; virtual;
  end;

  PInfoWindow = ^TInfoWindow;         (* Window holding TInfoView        *)
  TInfoWindow = object(TWindow)
    constructor Init(var Bounds: TRect);
  end;

  TSegment = array[1..13] of byte;    (* Buffer for T7Sgement            *)

  P7Segment = ^T7Segment;             (* 7 Segment View (7x5)            *)
  T7Segment = object(TView)
      Segment: TSegment;
      Number: word;
        { 16 -> segm_ = "-",  >=17 -> segmBlank = " " }
      BackGround: boolean;
        { not active segment visible (gray) ? }
    constructor Init(Top: TPoint; ABackGround: boolean; ANumber: word);
      { Top: upper left corner of segment
        ABackGround: not active segments visible (gray) ?
        ANumber: default value to be displayed }
    procedure HandleEvent(var Event: TEvent); virtual;
    procedure Draw; virtual;
    procedure UpdateSegments;
  end;

  PBigClock = ^TBigClock;
  TBigClock = object(TGroup)
      Seg: Array[1..6] of P7Segment;
    constructor Init(Top: TPoint; BackGround: boolean);
      { Top: upper left corner of clock
        BackGround: will passed to each T7Segment: not active segments
                    visible (gray) ? }
    procedure HandleEvent(var Event: TEvent); virtual;
    procedure Update;
  end;

const
  Date : PDate  = nil;
  Clock: PClock = nil;
  Heap : PHeap  = nil;

implementation


{***********************************************************************}
{**                             TXView                                **}
{***********************************************************************}

procedure TXView.HandleEvent(var Event: TEvent);
begin
  { TP/BP7: inherited HandleEvent(Event); }
  TView.HandleEvent(Event);
  if Event.What = evBroadCast then
    if Event.Command = cmGetData then
    begin
      ClearEvent(Event);
      Event.InfoPtr:= GetString;
    end;
end;

procedure TXView.Update;
begin
  Abstract;
end;

procedure TXView.Draw;
var
  Buf: TDrawBuffer;
  C: word;
begin
  C:= GetColor(2);  (* Application -> "Menu normal"  *)
                    (* Window      -> "Frame active" *)
  MoveChar(Buf, ' ', C, Size.X);
  MoveStr(Buf, Data, C);
  WriteLine(0, 0, Size.X, 1, Buf);
end;

function TXView.GetString: PString;
begin
  GetString:= PString(@Data);
end;


{***********************************************************************}
{**                             TClock                                **}
{***********************************************************************}

procedure TClock.Update;
type
  Rec = record
    hh, mm, ss: longint; end;
var
  DataRec: Rec;
  hh, mm, ss, hs: word;
begin
  GetTime(hh, mm, ss, hs);
  DataRec.hh:= hh;
  DataRec.mm:= mm;
  DataRec.ss:= ss;
  FormatStr(Data, '%2d:%2d:%2d', DataRec);
  if hh < 10 then Data[1]:= '0';
  if mm < 10 then Data[4]:= '0';
  if ss < 10 then Data[7]:= '0';
  DrawView;
end;


{***********************************************************************}
{**                             TDate                                 **}
{***********************************************************************}

procedure TDate.Update;
type
  Rec = record
    dd, mm, yy: longint; end;
var
  DataRec: Rec;
  dd, mm, yy, dw: word;
begin
  GetDate(yy, mm, dd, dw);
  DataRec.dd:= dd;
  DataRec.mm:= mm;
  DataRec.yy:= yy;
  FormatStr(Data, '%2d.%2d.%4d', DataRec);
  if dd < 10 then Data[1]:= '0';
  if mm < 10 then Data[4]:= '0';
  DrawView;
end;


{***********************************************************************}
{**                             THeap                                 **}
{***********************************************************************}

procedure THeap.Update;
var
  Mem: longint;
begin
  Mem:= MemAvail;
  FormatStr(Data, '%d Bytes', Mem);
  DrawView;
end;


{***********************************************************************}
{**                            TInfoView                              **}
{***********************************************************************}

procedure TInfoView.Draw;
var
  Buf: TDrawBuffer;
  C: word;
  s: string;
begin
  C:= GetColor(2);  (* Application -> "Menu normal"  *)
                    (* Window      -> "Frame active" *)
  s:= 'Date   : ';
  if assigned(Date) then
    s:= s + PString(Message(Date, evBroadCast, cmGetData, nil))^ else
    s:= s + 'not accessable';
  MoveChar(Buf, ' ', C, Size.X);
  MoveStr(Buf, s, C);
  WriteLine(0, 0, Size.X, 1, Buf);

  s:= 'Time   : ';
  if assigned(Clock) then
    s:= s + PString(Message(Clock, evBroadCast, cmGetData, nil))^ else
    s:= s + 'not accessable';
  MoveChar(Buf, ' ', C, Size.X);
  MoveStr(Buf, s, C);
  WriteLine(0, 1, Size.X, 1, Buf);

  s:= 'Memory : ';
  if assigned(Heap) then
    s:= s + PString(Message(Heap, evBroadCast, cmGetData, nil))^ else
    s:= s + 'not accessable';
  MoveChar(Buf, ' ', C, Size.X);
  MoveStr(Buf, s, C);
  WriteLine(0, 2, Size.X, 1, Buf);
end;


{***********************************************************************}
{**                           TInfoWindow                             **}
{***********************************************************************}

constructor TInfoWindow.Init(var Bounds: TRect);
var R: TRect;
begin
  { TP/BP7: inherited Init(Bounds, 'Systeminfo', 0); }
  TWindow.Init(Bounds, 'Systeminfo', 0);
  Palette:= wpCyanWindow;
  Flags:= Flags and not (wfClose + wfZoom + wfGrow);
  GetExtent(R);
  R.Grow(-2, -2);
  Insert(New(PInfoView, Init(R)));
end;


{***********************************************************************}
{**                            T7Segment                              **}
{***********************************************************************}

const              { 1  2  3  4  5  6  7  8  9  A  B  C  D }
  segm0: TSegment = (1, 1, 1, 1, 1, 1, 0, 1, 1, 1, 1, 1, 1);
  segm1: TSegment = (0, 0, 1, 0, 1, 0, 0, 1, 0, 1, 0, 0, 1);
  segm2: TSegment = (1, 1, 1, 0, 1, 1, 1, 1, 1, 0, 1, 1, 1);
  segm3: TSegment = (1, 1, 1, 0, 1, 1, 1, 1, 0, 1, 1, 1, 1);
  segm4: TSegment = (1, 0, 1, 1, 1, 1, 1, 1, 0, 1, 0, 0, 1);
  segm5: TSegment = (1, 1, 1, 1, 0, 1, 1, 1, 0, 1, 1, 1, 1);
  segm6: TSegment = (1, 1, 1, 1, 0, 1, 1, 1, 1, 1, 1, 1, 1);
  segm7: TSegment = (1, 1, 1, 0, 1, 0, 0, 1, 0, 1, 0, 0, 1);
  segm8: TSegment = (1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1);
  segm9: TSegment = (1, 1, 1, 1, 1, 1, 1, 1, 0, 1, 0, 0, 1);
  segmA: TSegment = (1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 1);
  segmB: TSegment = (1, 0, 0, 1, 0, 1, 1, 1, 1, 1, 1, 1, 1);
  segmC: TSegment = (1, 1, 1, 1, 0, 0, 0, 0, 1, 0, 1, 1, 1);
  segmD: TSegment = (0, 0, 1, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1);
  segmE: TSegment = (1, 1, 1, 1, 0, 1, 1, 1, 1, 0, 1, 1, 1);
  segmF: TSegment = (1, 1, 1, 1, 0, 1, 1, 1, 1, 0, 1, 0, 0);
  segm_: TSegment = (0, 0, 0, 0, 0, 1, 1, 1, 0, 0, 0, 0, 0);
  segmBlank: TSegment =
                    (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);


constructor T7Segment.Init(Top: TPoint; ABackGround: boolean; ANumber: word);
var R: TRect;
begin
  R.Assign(Top.X, Top.Y, Top.X+7, Top.Y+5);
  { TP/BP7: inherited Init(R); }
  TView.Init(R);
  BackGround:= ABackGround;
  Number:= ANumber;
  UpdateSegments;
end;

procedure T7Segment.HandleEvent(var Event: TEvent);
begin
  { TP/BP7: inherited HandleEvent(Event); }
  TView.HandleEvent(Event);
  if Event.What = evBroadCast then
    case Event.Command of
      cmChange7Segment: begin
                          Number:= Word(Event.InfoPtr^);
                          UpdateSegments;
                          DrawView;
                          ClearEvent(Event);
                        end;
      cmChangeBack    : begin
                          if BackGround then BackGround:= false
                                        else BackGround:= true;
                          DrawView;
                        end;
    end;
end;

procedure T7Segment.Draw;
var
  Buf: TDrawBuffer;
  Front, Back: byte;

  function SetColor(w: word; c: byte): word;
  begin
    w:= w and $00FF;
    w:= swap(w);
    w:= w or c;
    w:= swap(w);
    SetColor:= w;
  end;

  procedure SetBufColor(var B: TDrawBuffer; C: word);
  var i: integer;
  begin
    for i:= 0 to Size.X do
      Buf[i]:= SetColor(Buf[i], C);
  end;

begin
  if BackGround then Back:= $8 else Back:= $0;
  Front:= $F;

  { Segment 1,2,3 }
  SetBufColor(Buf, $0);
  MoveStr (Buf, ' þþþþþ', Back);
  if Segment[1] = 1 then
    Buf[1]:= SetColor(Buf[1], Front);
  if Segment[2] = 1 then begin
    Buf[2]:= SetColor(Buf[2], Front);
    Buf[3]:= SetColor(Buf[3], Front);
    Buf[4]:= SetColor(Buf[4], Front); end;
  if Segment[3] = 1 then
    Buf[5]:= SetColor(Buf[5], Front);
  WriteLine(0, 0, Size.X, 1, Buf);

  { Segment 4,5 }
  SetBufColor(Buf, $0);
  MoveStr (Buf, ' Û   Û', Back);
  if Segment[4] = 1 then
    Buf[1]:= SetColor(Buf[1], Front);
  if Segment[5] = 1 then
    Buf[5]:= SetColor(Buf[5], Front);
  WriteLine(0, 1, Size.X, 1, Buf);

  { Segment 6,7,8 }
  SetBufColor(Buf, $0);
  MoveStr (Buf, ' þþþþþ', Back);
  if Segment[6] = 1 then
    Buf[1]:= SetColor(Buf[1], Front);
  if Segment[7] = 1 then begin
    Buf[2]:= SetColor(Buf[2], Front);
    Buf[3]:= SetColor(Buf[3], Front);
    Buf[4]:= SetColor(Buf[4], Front); end;
  if Segment[8] = 1 then
    Buf[5]:= SetColor(Buf[5], Front);
  WriteLine(0, 2, Size.X, 1, Buf);

  { Segment 9,10 }
  SetBufColor(Buf, $0);
  MoveStr (Buf, ' Û   Û', Back);
  if Segment[9] = 1 then
    Buf[1]:= SetColor(Buf[1], Front);
  if Segment[10] = 1 then
    Buf[5]:= SetColor(Buf[5], Front);
  WriteLine(0, 3, Size.X, 1, Buf);

  { Segment 11,12,13 }
  SetBufColor(Buf, $0);
  MoveStr (Buf, ' þþþþþ', Back);
  if Segment[11] = 1 then
    Buf[1]:= SetColor(Buf[1], Front);
  if Segment[12] = 1 then begin
    Buf[2]:= SetColor(Buf[2], Front);
    Buf[3]:= SetColor(Buf[3], Front);
    Buf[4]:= SetColor(Buf[4], Front); end;
  if Segment[13] = 1 then
    Buf[5]:= SetColor(Buf[5], Front);
  WriteLine(0, 4, Size.X, 1, Buf);
end;

procedure T7Segment.UpdateSegments;
begin
  case Number of
    0:  Segment:= segm0;
    1:  Segment:= segm1;
    2:  Segment:= segm2;
    3:  Segment:= segm3;
    4:  Segment:= segm4;
    5:  Segment:= segm5;
    6:  Segment:= segm6;
    7:  Segment:= segm7;
    8:  Segment:= segm8;
    9:  Segment:= segm9;
    10: Segment:= segmA;
    11: Segment:= segmB;
    12: Segment:= segmC;
    13: Segment:= segmD;
    14: Segment:= segmE;
    15: Segment:= segmF;
    16: Segment:= segm_;
  else
    Segment:= segmBlank;
  end;
end;


{***********************************************************************}
{**                            TBigClock                              **}
{***********************************************************************}

type
  PBlackView = ^TBlackView;    (* black background for TBigClock *)
  TBlackView = object(TView)
    procedure Draw; virtual;
  end;

procedure TBlackView.Draw;
var
  Buf  : TDrawBuffer;
  Color: word;
  i    : integer;
begin
  Color:= $0F;
  for i:= 0 to Size.Y do
  begin
    MoveChar(Buf, ' ', Color, Size.X);
    if (i = 2) or (i = 4) then
    begin
      Buf[16]:= $0FFE;
      Buf[33]:= $0FFE;
    end;
    WriteLine(0, i, Size.X, 1, Buf);
  end;
end;


constructor TBigClock.Init(Top: TPoint; BackGround: boolean);
const
  XPos : Array [1..6] of word = (1, 8, 18, 25, 35, 42);
var
  R: TRect;
  P: TPoint;
  i: integer;
begin
  R.Assign(Top.X, Top.Y, Top.X+50, Top.Y+7);
  { TP/BP7: inherited Init(R); }
  TGroup.Init(R);

  R.Assign(0, 0, Size.X, Size.Y);
  Insert(new(PBlackView, Init(R)));

  for i:= 1 to 6 do
  begin
    P.X:= XPos[i]; P.Y:= 1;
    Seg[i]:= new(P7Segment, Init(P, BackGround, 0));
    insert(Seg[i]);
  end;
end;

procedure TBigClock.HandleEvent(var Event: TEvent);
var i: integer;
begin
  { TP/BP7: inherited HandleEvent(Event); }
  TGroup.HandleEvent(Event);
  if Event.What = evBroadCast then
    if Event.Command = cmChangeBack then
    begin
      for i:= 1 to 6 do
        Message(Seg[i], evBroadCast, cmChangeBack, nil);
    end;
end;

procedure TBigClock.Update;
var
  w, h, m, s, hs: word;
begin
  GetTime(h, m, s, hs);
  w:= h div 10;
  Message(Seg[1], evBroadCast, cmChange7Segment, @w); (* Hours   - 10^1 *)
  w:= h mod 10;
  Message(Seg[2], evBroadCast, cmChange7Segment, @w); (* Hours   - 10^0 *)
  w:= m div 10;
  Message(Seg[3], evBroadCast, cmChange7Segment, @w); (* Minutes - 10^1 *)
  w:= m mod 10;
  Message(Seg[4], evBroadCast, cmChange7Segment, @w); (* Minutes - 10^0 *)
  w:= s div 10;
  Message(Seg[5], evBroadCast, cmChange7Segment, @w); (* Seconds - 10^1 *)
  w:= s mod 10;
  Message(Seg[6], evBroadCast, cmChange7Segment, @w); (* Seconds - 10^0 *)
end;


end.

{ -------------------- DEMO -------------- CUT HERE ------------ }

program XTest1;

{ usage of TDate, TClock and THeap defined in Unit XVIEWS }

uses Drivers, Objects, App, Views, Menus, XViews;

const
  cmWindow = 1000;

type
  PMyApp = ^TMyApp;
  TMyApp = object(TApplication)
    constructor Init;
    procedure Idle; virtual;
    procedure HandleEvent(var Event: TEvent); virtual;
    procedure Window;
    procedure InitStatusLine; virtual;
  end;

constructor TMyApp.Init;
var R: TRect;
begin
  { TP/BP7: inherited Init; }
  TApplication.Init;

  GetExtent(R);
  R.A.X:= R.B.X - 11;
  R.A.Y:= R.B.Y - 1;
  Date:= New(PDate, Init(R));
  Insert(Date);

  GetExtent(R);
  R.A.X:= R.B.X - 9;
  R.B.Y:= R.A.Y + 1;
  Clock:= New(PClock, Init(R));
  Insert(Clock);

  GetExtent(R);
  R.A.X:= R.A.X + 1;
  R.B.X:= R.A.X + 20;
  R.B.Y:= R.A.Y + 1;
  Heap:= New(PHeap, Init(R));
  Insert(Heap);
end;

procedure TMyApp.Idle;
var Event: TEvent;
begin
  { TP/BP7: inherited Idle; }
  TApplication.Idle;
  Date^.Update;
  Clock^.Update;
  Heap^.Update;
end;

procedure TMyApp.HandleEvent(var Event: TEvent);
begin
  { TP/BP7: inherited HandleEvent(Event); }
  TApplication.HandleEvent(Event);
  case Event.What of
    evCommand:
      case Event.Command of
        cmWindow : Window;
      end;
  end;
end;

procedure TMyApp.Window;
var
  P: PWindow;
  R: TRect;
begin
  Desktop^.GetExtent(R);
  P:= New(PWindow, Init(R, 'Memory-Eater', 0));
  P^.Options:= P^.Options or ofTileAble;
  Desktop^.Insert(P);
  Cascade;
end;

procedure TMyApp.InitStatusLine;
var R: TRect;
begin
  GetExtent(R);
  R.A.Y:= R.B.Y - 1;
  New(StatusLine, Init(R,
    NewStatusDef(0, $FFFF,
      NewStatusKey('~Alt-X~ Exit',               kbAltX,  cmQuit,
      NewStatusKey('~F3~ Open Window',           kbF3,    cmWindow,
      NewStatusKey('',                           kbAltF3, cmClose,
      nil))),
    nil)));
end;


var
  MyApp: TMyApp;

begin
  MyApp.Init;
  MyApp.Run;
  MyApp.Done;
end.

{ -------------------- DEMO -------------- CUT HERE ------------ }
program XTest2;

{ usage of TInfoWindow defined in Unit XVIEWS }

uses Drivers, Objects, App, Views, XViews;

type
  PMyApp = ^TMyApp;
  TMyApp = object(TApplication)
      Info: PInfoWindow;
    constructor Init;
    procedure Idle; virtual;
  end;

constructor TMyApp.Init;
var R: TRect;
begin
  { TP/BP7: inherited Init; }
  TApplication.Init;

  R.Assign(0,0,1,1);
  Date:= New(PDate, Init(R));
  Date^.Hide;
  Insert(Date);

  Clock:= New(PClock, Init(R));
  Clock^.Hide;
  Insert(Clock);

  Heap:= New(PHeap, Init(R));
  Heap^.Hide;
  Insert(Heap);

  R.Assign(1,1,35,8);
  Info:= New(PInfoWindow, Init(R));
  Info^.Options:= Info^.Options or ofCentered;
  Insert(Info);
end;

procedure TMyApp.Idle;
var Event: TEvent;
begin
  { TP/BP7: inherited Idle; }
  TApplication.Idle;
  if assigned(Date) then Date^.Update;
  if assigned(Clock) then Clock^.Update;
  if assigned(Heap) then Heap^.Update;
  Info^.Redraw;
end;

var
  MyApp: TMyApp;

begin
  MyApp.Init;
  MyApp.Run;
  MyApp.Done;
end.
{ -------------------- DEMO -------------- CUT HERE ------------ }
program XTest3;

{ usage of TBigClock defined in Unit XVIEWS }

uses Drivers, Objects, App, Menus, Views, XViews;

const
  cmToggle = 1000;

type
  PMyApp = ^TMyApp;
  TMyApp = object(TApplication)
      BigClock: PBigClock;
    constructor Init;
    procedure InitStatusLine; virtual;
    procedure HandleEvent(var Event: TEvent); virtual;
    procedure Idle; virtual;
  end;


constructor TMyApp.Init;
var P: TPoint;
begin
  { TP/BP7: inherited Init; }
  TApplication.Init;
  P.X:= 15; P.Y:= 9;
  BigClock:= new(PBigClock, Init(P, true));
  Insert(BigClock);
end;

procedure TMyApp.InitStatusLine;
var R: TRect;
begin
  GetExtent(R);
  R.A.Y:= R.B.Y - 1;
  New(StatusLine, Init(R,
    NewStatusDef(0, $FFFF,
      NewStatusKey('~Alt-X~ Exit',            kbAltX, cmQuit,
      NewStatusKey('~F2~ Toggle Background',  kbF2,   cmToggle,
      nil)),
    nil)));
end;

procedure TMyApp.HandleEvent(var Event: TEvent);
begin
  { TP/BP7: inherited HandleEvent(Event); }
  TApplication.HandleEvent(Event);
  if Event.What = evCommand then
    if Event.Command = cmToggle then
      Message(BigClock, evBroadCast, cmChangeBack, nil);
end;

procedure TMyApp.Idle;
var Event: TEvent;
begin
  { TP/BP7: inherited Idle; }
  TApplication.Idle;
  if assigned(BigClock) then BigClock^.Update;
end;


var
  MyApp: TMyApp;

begin
  MyApp.Init;
  MyApp.Run;
  MyApp.Done;
end.