
{*******************************************************}
{                                                       }
{       Graphics Vision Unit                            }
{                                                       }
{	Portions copyright (c) 1992 Borland Intl.       }
{       Copyright (c) 1994 Stefan Milius                }
{	Copyright (c) 1998 Matthias Koeppe              }
{                                                       }
{*******************************************************}

Unit GVClock;

{$ifndef FPK}
{$A+,B-,D+,F+,G+,O+,R-,S-,X+,I-}
{$endif}

Interface

{$ifdef FPK}
uses Dos, Objects, Drivers, Views, GVViews, GVApp, GvFonts, GvMenus,
  ExtGraph, Bgi, GvFPK, GvTexts;
  {$i fpkdef.pp}
{$else}
{$ifdef Windows}
Uses WinDos, Dos, Objects, Drivers, Views, GVViews, GVApp, GvFonts, GvMenus;
{$else}
Uses Dos, Objects, Drivers, Views, GVViews, GVApp, GvFonts, GvMenus;
{$endif}
{$endif}

const

{ Color palette }

  CClock = #142#143;

{ Clock Mode flags
}
  clmAnalog = 1;
  clmDigital = 2;
  clmSeconds = 4;
  clmBlinkColon = 8;

{ Standard clock window commands
}
  cmClockAnalog = 900;
  cmClockDigital = 901;
  cmClockFont = 902;
  cmClockSeconds = 903;
  cmClockBlink = 904;
  cmClockForeground = 905;
  cmClockTitle = 906;

type

{ TClock object }

  { Palette layout }
  { 1 = text }
  { 2 = background }

  PClock = ^TClock;
  TClock = object(TGView)
    Refresh: Integer;
    LastTime: DateTime;
    Mode: Word;
    Font: PFont;
    constructor Init(var Bounds: TRect);
    destructor Done; virtual;
    procedure ChangeBounds(var Bounds: TRect); virtual;
    procedure Draw; virtual;
    procedure DrawPointers(NewTime: DateTime);
    function FormatTimeStr(H, M, S: Word): String; virtual;
    function GetPalette: PPalette; virtual;
    procedure HandleEvent(var Event: TEvent); virtual;
    procedure ReadTime(var Time: DateTime);
    procedure SetFont(AFont: PFont);
    procedure SetFontSize;
    procedure SetMode(AMode: Word);
    procedure SetState(AState: Word; Enable: Boolean); virtual;
  end;

{ TClockWindow object
}
  PClockWindow = ^TClockWindow;
  TClockWindow = object(TWindow)
    Clock: PClock;
    constructor Init(var Bounds: TRect);
    procedure InitClock; virtual;
    procedure SizeLimits(var Min, Max: TPoint); virtual;
  end;

{ TStandardClockWindow object
}
  PStandardClockWindow = ^TStandardClockWindow;
  TStandardClockWindow = object(TClockWindow)
    Menu: PMenu;
    constructor Init(var Bounds: TRect; AMode: Word; AFont: PFont);
    destructor Done; virtual;
    function ClockGrown: Boolean;
    procedure GrowClock;
    procedure HandleEvent(var Event: TEvent); virtual;
    procedure UpdateMenu;
  end;

implementation

{$ifndef FPK}
{$ifdef Windows}
uses WinGr, ExtGraph, GvTexts;
{$else}
uses Gr, ExtGraph, MetaGr, MyMouse, MyFonts, GVDriver, GVTexts;
{$endif}
{$endif}

(******************************** TClock object *****************************)

{ Help functions }

{$ifndef NOIASM}
function Min (x, y: Integer): Integer; Assembler;
Asm
	MOV	AX, X
	CMP	AX, Y
	JLE	@@1
        MOV	AX, Y
@@1:
End;
{$endif}

function LeadingZero(w: Word): String;
var s: String;
begin
  Str(w:0, s);
  LeadingZero := Copy('00', 1, 2 - Length(s)) + s;
end;

constructor TClock.Init(var Bounds: TRect);
Begin
  TGView.Init(Bounds);
  Options := Options or ofSelectable;
  EventMask := EventMask or evBroadcast;
  GrowMode := gfGrowHiX + gfGrowHiY;
  FillChar(LastTime, 12, #$FF);
  Mode := clmAnalog + clmSeconds;
  SetFontSize;
  Refresh := 1;
End;

destructor TClock.Done;
begin
  Dispose(Font, Done);
  inherited Done
end;

procedure TClock.ChangeBounds(var Bounds: TRect);
Begin
  TGView.ChangeBounds(Bounds);
  SetFontSize;
End;

procedure TClock.Draw;
var Rad: Integer;
    M, D: TPoint;
    NewTime: DateTime;

  procedure DoRect(X, Y: Integer);
  var L: Integer;
  Begin
    L := Round(Rad *1.0 / SizeY * 21);
    SetFillStyle(SolidFill, Cyan);
    Bar(X - L, Y - L, X + L, Y + L);
    SetColor(White);
    HoriLine(X - L, Y - L, X + L - 1);
    VertLine(X - L, Y - L, Y + L);
    SetColor(Black);
    HoriLine(X - L + 1, Y + L, X + L);
    VertLine(X + L, Y - L, Y + L);
  End;

  procedure DoMark(dX, dY: Integer);
  Begin
    DoRect(M.X + dX, M.Y + dY);
    DoRect(M.X + dX, M.Y - dY);
    DoRect(M.X - dX, M.Y - dY);
    DoRect(M.X - dX, M.Y + dY);
  End;

Begin
  SetFillStyle(SolidFill, GetColor(2));
  Bar(0, 0, Size.X - 1, Size.Y - 1);
  If Mode and clmAnalog <> 0
  then begin
    Rad := Min(Size.X div 2, Size.Y div 2) - 10;
    M.X := Size.X div 2; M.Y := Size.Y div 2;
    { Die vier Hauptrichtungen }
    DoRect(M.X, M.Y - Rad);
    DoRect(M.X, M.Y + Rad);
    DoRect(M.X - Rad, M.Y);
    DoRect(M.X + Rad, M.Y);
    { Nebenrichtungen (30ø)}
    D.X := Rad div 2;            { Rad * sin 30ø }
    D.Y := Round(Rad * 0.866);   { Rad * cos 30ø }
    DoMark(D.X, D.Y);
    { Nebenrichtungen (60ø)}
    DoMark(D.Y, D.X);
  end;
  NewTime := LastTime;
  FillChar(LastTime, 12, #$FF);
  DrawPointers(NewTime);
  LastTime := NewTime
End;

procedure TClock.DrawPointers(NewTime: DateTime);
var M: TPoint;
    Rad, PL: Integer;
    OldS, S: string;
    i, j, x, y1, y2, width: Integer;
    Shown, ToShow, Match: Boolean;

 procedure SecondP(X1, Y1, L: Integer; T: DateTime);
 var D: TPoint;
     a: Real;
 Begin
   a := 2*pi/60*T.sec;
   D.X := Round(L * sin(a));
   D.Y := Round(L * cos(a));
   Line(M.X, M.Y, M.X + D.X, M.Y - D.Y);
 End;

 procedure MinuteP(X1, Y1, L: Integer; T: DateTime);
 var 
     D, dL: TPoint;
     a: Real;
 Begin
   a := 2*pi/60*T.min;
   D.X := Round((L/16.0) * sin(a - pi/2));
   D.Y := Round((L/16.0) * cos(a - pi/2));
   dL.X := Round(L * sin(a));
   dL.Y := Round(L * cos(a));

   Line(X1 - D.X, Y1 + D.Y, X1 - D.Y * 4, Y1 - D.X * 4);
   Line(X1 + D.X, Y1 - D.Y, X1 - D.Y * 4, Y1 - D.X * 4);
   Line(X1 - D.X, Y1 + D.Y, X1 + dL.X, Y1 - dL.Y);
   Line(X1 + D.X, Y1 - D.Y, X1 + dL.X, Y1 - dL.Y);
 End;

 procedure HourP(X1, Y1, L: Integer; T: DateTime);
 var D, dL: TPoint;
     a: Real;
 Begin
   a := 2*pi/12*T.hour + 2*pi/720*T.min;
   D.X := Round((L/8.0) * sin(a - pi/2));
   D.Y := Round((L/8.0) * cos(a - pi/2));
   dL.X := Round(L * sin(a));
   dL.Y := Round(L * cos(a));

   Line(X1 - D.X, Y1 + D.Y, X1 - D.Y * 2, Y1 - D.X * 2);
   Line(X1 + D.X, Y1 - D.Y, X1 - D.Y * 2, Y1 - D.X * 2);
   Line(X1 - D.X, Y1 + D.Y, X1 + dL.X, Y1 - dL.Y);
   Line(X1 + D.X, Y1 - D.Y, X1 + dL.X, Y1 - dL.Y);
 End;

Begin
  SetViewPort;
  If Mode and clmAnalog <> 0
  then begin
    Rad := Min(Size.X div 2, Size.Y div 2) - 10;
    M.X := Size.X div 2; M.Y := Size.Y div 2;
    SetColor(GetColor(2));
    SetWriteMode(XORPut);
    If NewTime.sec <> LastTime.Sec then Begin
      PL := (Rad * 4) div 5;
      If Mode and clmSeconds <> 0
      then begin
	If LastTime.sec <> $FFFF then SecondP(M.X, M.Y, PL, LastTime);
	If NewTime.sec <> $FFFF then SecondP(M.X, M.Y, PL, NewTime)
      end;
      If NewTime.min <> LastTime.min then Begin
	If LastTime.min <> $FFFF then Begin
	  MinuteP(M.X, M.Y, PL, LastTime);
	  HourP(M.X, M.Y, (Rad * 3) div 5 , LastTime);
	End;
	If NewTime.min <> $FFFF then Begin
	  MinuteP(M.X, M.Y, PL, NewTime);
	  HourP(M.X, M.Y, (Rad * 3) div 5, NewTime);
	End;
      End;
    End;
    SetWriteMode(NormalPut);
  end;
  If Mode and clmDigital <> 0
  then begin
    OldS := FormatTimeStr(LastTime.Hour, LastTime.Min, LastTime.Sec);
    S := FormatTimeStr(NewTime.Hour, NewTime.Min, NewTime.Sec);
    SetTextParams(Font^.GetFontHandle, 2, GetColor(1), true);
    width := TextWidth(S);
    x := (Size.X - width) div 2;
    SetTextJustify(LeftText, CenterText);
    SetFillStyle(SolidFill, GetColor(2));
    y1 := (Size.Y - TextHeight('')) div 2 - 1;
    y2 := Size.Y - y1 + 1;
    If TextWidth(OldS) <> width
    then begin
      OldS := '';
      Bar(0, y1, Size.X - 1, y2)
    end;
    i := 1;
    j := 1;
    while i <= Length(S) do
    begin
      if S[i] = '~'
      then begin
	Inc(i);
	ToShow := false
      end
      else
	ToShow := true;
      Shown := false;
      Match := false;
      If j <= Length(OldS)
      then begin
	if OldS[j] = '~'
	then Inc(j)
	else begin
	  Shown := true;
	  Match := ToShow and (OldS[j] = S[i])
	end
      end;
      If not Match
      then begin
	If Shown then Bar(x, y1, x + TextWidth(OldS[j]), y2);
	If ToShow then OutTextXY(x + 1, Size.Y div 2, S[i])
      end;
      Inc(x, TextWidth(S[i]));
      Inc(i);
      Inc(j);
    end
  end;
  RestoreViewPort;
End;

function TClock.FormatTimeStr(H, M, S: Word): String;
Begin
  If h = $FFFF
  then FormatTimeStr := '' else
  if Mode and clmSeconds <> 0
  then FormatTimeStr := LeadingZero(h)+ ':'+ LeadingZero(m) + ':' + LeadingZero(s) else
  if (Mode and clmBlinkColon = 0) or (S and 1 = 0)
  then FormatTimeStr := LeadingZero(h)+ ':'+ LeadingZero(m)
  else FormatTimeStr := LeadingZero(h)+ '~:'+ LeadingZero(m)
End;

function TClock.GetPalette: PPalette;
const
  P: string[Length(CClock)] = CClock;
begin
  GetPalette := @P
end;

procedure TClock.HandleEvent(var Event: TEvent);
var
    NewTime: DateTime;
Begin
  TGView.HandleEvent(Event);
  If ((Event.What = evTimer) or
      (Event.What = evBroadcast) and (Event.Command = cmIdle)) and
     (State and sfDragging = 0)
  then Begin
    ReadTime(NewTime);
    If Abs(NewTime.sec - LastTime.sec) >= Refresh
    then begin
      DrawPointers(NewTime);
      LastTime := NewTime
    end
  End;
End;

procedure TClock.ReadTime(var Time: DateTime);
var
  h, m, s, c: Word;
begin
  GetTime(h, m, s, c);
  with Time do
  begin
    Hour := h;
    Min := m;
    Sec := s
  end
end;

procedure TClock.SetFont(AFont: PFont);
begin
  Dispose(Font, Done);
  Font := AFont;
  SetFontSize;
  DrawView
end;

function LongMin(A, B: LongInt): LongInt;
begin
  if A < B
  then LongMin := A
  else LongMin := B
end;

procedure TClock.SetFontSize;
var
  NewFont: PFont;
  Scaling: LongInt;
  l: Integer;
  s: string;
begin
  s := FormatTimeStr(10, 10, 10);
  l := Length(s);
  If Font = nil
  then Font := New(PFont, Init('Times', 24, ftNormal, nil));
  SetTextParams(Font^.GetFontHandle, 2, 0, true);

  Scaling := LongMin(PixelToScaling(Size.Y),
    PixelToScaling(Round(Size.X * 1.0 / TextWidth(s) * TextHeight('') * 0.8)));
  SetTextParams(ftSystem, 0, 0, false);
  NewFont := New(PFont, InitByFont(Font, Scaling, Font^.Attr, @Font^.TTOptions));
  Dispose(Font, Done);
  Font := NewFont
end;

procedure TClock.SetMode(AMode: Word);
begin
  Mode := AMode;
  SetFontSize;
  DrawView
end;

procedure TClock.SetState(AState: Word; Enable: Boolean);
begin
  If Enable and (AState = sfExposed)
  then ReadTime(LastTime);
  inherited SetState(AState, Enable)
end;

(***************************** TClockWindow object **************************)

constructor TClockWindow.Init(var Bounds: TRect);
Begin
  TWindow.Init(Bounds, GetStr(7), wnNoNumber);
  Options := (Options or ofHoldFirst) and not ofTileable;
  Palette := wpGrayWindow;
  InitClock;
  Insert(Clock);
End;

procedure TClockWindow.InitClock;
var
  R: TRect;
begin
  GetClientRect(R);
  Clock := New(PClock, Init(R));
end;

procedure TClockWindow.SizeLimits(var Min, Max: TPoint);
Begin
  inherited SizeLimits(Min, Max);
  Min.X := 50; Min.Y := 50;
End;

{ ÄÄÄÄÄÄÄÄÄÄÄÄ
}

constructor TStandardClockWindow.Init(var Bounds: TRect; AMode: Word; AFont: PFont);
begin
  inherited Init(Bounds);
  Clock^.SetMode(AMode);
  If AFont <> nil
  then Clock^.SetFont(AFont);
  Menu := NewMenu(
    NewCheckItem(GetStr(270), '', 0, cmClockAnalog, 0, dfMenuCheck,
    NewCheckItem(GetStr(271), '', 0, cmClockDigital, 0, dfMenuCheck,
    NewLine(
    NewCheckItem(GetStr(272), '', 0, cmClockSeconds, 0, dfMenuCheck,
    NewCheckItem(GetStr(273), '', 0, cmClockBlink, 0, dfMenuCheck,
    NewItem(GetStr(274), '', 0, cmClockFont, 0,
    NewLine(
    NewCheckItem(GetStr(275), '', 0, cmClockForeground, 0, dfMenuCheck,
    NewCheckItem(GetStr(276), '', 0, cmClockTitle, 0, dfMenuCheck,
    nil))))))))));
  UpdateMenu
end;

destructor TStandardClockWindow.Done;
begin
  DisposeMenu(Menu);
  inherited Done
end;

function TStandardClockWindow.ClockGrown: Boolean;
begin
  ClockGrown := Flags and wfShowTitle = 0
end;

procedure TStandardClockWindow.GrowClock;
var
  R: TRect;
begin
  Flags := Flags xor wfShowTitle;
  GetClientRect(R);
  Clock^.Locate(R)
end;

procedure TStandardClockWindow.HandleEvent(var Event: TEvent);
var
  R: TRect;
  Min, Max: TPoint;
  Popup: PMenuView;
{$ifndef FPK}
  D:PFontDialog;
{$endif}
  SaveOpt: Word;
begin
  inherited HandleEvent(Event);
  If ((Event.What = evMouseDown) and (Event.Buttons = 2)) or
     ((Event.What = evKeyDown) and
      ((Event.KeyCode = kbEnter) or (Event.KeyCode = kbAltF10)))
  then begin
    If Event.What = evMouseDown
    then R.A := Event.Where
    else begin
      GetClientRect(R);
      MakeGlobal(R.A, R.A)
    end;
    R.B := R.A;
    Popup := New(PMenuPopUp, Init(R, Menu));
    SaveOpt := Options;
    Options := Options and not ofHoldFirst;
    Application^.ExecView(Popup);
    Options := SaveOpt;
    Dispose(Popup, Done);
    ClearEvent(Event);
  end else
  if Event.What = evMouseDown
  then begin
    GOwner^.GetExtent (R);
    SizeLimits(Min, Max);
    DragView(Event,DragMode or dmDragMove, R, Min, Max, 0);
    ClearEvent(Event)
  end else
  if Event.What = evCommand
  then begin
    case Event.Command of
      cmClockAnalog:
	begin
	  Clock^.SetMode((Clock^.Mode or clmAnalog) and not clmDigital);
	  UpdateMenu
	end;
      cmClockDigital:
	begin
	  Clock^.SetMode((Clock^.Mode or clmDigital) and not clmAnalog);
	  UpdateMenu
	end;
      cmClockSeconds:
	begin
	  Clock^.SetMode(Clock^.Mode xor clmSeconds);
	  UpdateMenu
	end;
      cmClockBlink:
	If Clock^.Mode and clmDigital <> 0
	then begin
	  Clock^.SetMode(Clock^.Mode xor clmBlinkColon);
	  UpdateMenu
	end;
      cmClockForeground:
	begin
	  Options := Options xor ofHoldFirst;
	  If Options and ofHoldFirst <> 0
	  then MakeFirst;
	  UpdateMenu
	end;
      cmClockTitle:
	begin
	  GrowClock;
	  UpdateMenu
	end;
{$ifndef FPK}
      cmClockFont:
	If Clock^.Mode and clmDigital <> 0
	then begin
	  D := New(PFontDialog, Init(GetStr(242), Clock^.Font));
	  D^.HideScales;
	  If Application^.ExecView(D) <> cmCancel
	  then Clock^.SetFont(D^.GetFont);
	  Dispose(D, Done);
	  UpdateMenu
	end;
{$endif}
    else
	Exit;
    end;
    ClearEvent(Event)
  end
end;

procedure TStandardClockWindow.UpdateMenu;
var
  Item: PMenuItem;
begin
  ChangeMenuState(Menu, cmClockAnalog, dfCheckState + dfDisabled + dfByCommand,
    Clock^.Mode and clmAnalog <> 0);
  ChangeMenuState(Menu, cmClockDigital, dfCheckState + dfDisabled + dfByCommand,
    Clock^.Mode and clmDigital <> 0);
  ChangeMenuState(Menu, cmClockSeconds, dfCheckState + dfByCommand,
    Clock^.Mode and clmSeconds <> 0);
  ChangeMenuState(Menu, cmClockBlink, dfCheckState + dfByCommand,
    Clock^.Mode and clmBlinkColon <> 0);
  ChangeMenuState(Menu, cmClockBlink, dfDisabled + dfByCommand,
    (Clock^.Mode and clmDigital = 0) or (Clock^.Mode and clmSeconds <> 0));
  ChangeMenuState(Menu, cmClockFont, dfDisabled + dfByCommand,
    Clock^.Mode and clmDigital = 0);
  ChangeMenuState(Menu, cmClockForeground, dfCheckState + dfByCommand,
    Options and ofHoldFirst <> 0);
  ChangeMenuState(Menu, cmClockTitle, dfCheckState + dfByCommand,
    not ClockGrown);
  Item := LookUpMenu(Menu, cmClockFont, dfByCommand);
  DisposeStr(Item^.Param);
  Item^.Param := NewStr(Clock^.Font^.Face^.Name^);
end;

End.
