
{*******************************************************}
{                                                       }
{       Graphics Vision Example program                 }
{                                                       }
{       Copyright (c) 1996 Stefan Milius                }
{                                                       }
{*******************************************************}

(* To run this program you'll have to build EXAM.GVL by:

   GVLC exam.gvl english.gvs englishx.gvs exam.gvs

   Hint: If you want another than the English language just translate all
   the texts in the GVS files into this language and then rebuild EXAM.GVL!
   (Germans only have to translate exam.gvs)


This application shows:

  - the usage of a bitmap desktop.
  - how to use transparent views

*)

uses
  {$ifdef Windows} WinGr, {$else} MyMouse, MetaGr, {$endif}
  Dos, Objects, Drivers, Misc, KeyNames, GVViews, GVBitmap, 
  GVMenus, GVApp, GVStdDlg, GVTexts;

const
  cmOpen = 100; cmNew = 101;

type

{ TTrans object }

  PTrans = ^TTrans;
  TTrans = object(TGView)
	     Color: Word;
	     Direction: TPoint;
	     constructor Init(var Bounds: TRect; AColor: Word);
	     procedure Draw; virtual;
	     procedure HandleEvent(var Event: TEvent); virtual;
	   end;

{ TDemoApp object }

  TDemoApp = object(TApplication)
	       constructor Init;
	       procedure HandleEvent(var Event: TEvent); virtual;
	       procedure InitDesktop; virtual;
	       procedure InitStatusLine; virtual;
	       function LanguageResource: String; virtual;
	     end;

function Min (x, y: Integer): Integer; Assembler;
Asm
	MOV	AX, X
	CMP	AX, Y
	JLE	@@1
	MOV	AX, Y
@@1:
End;

function Max (x, y: Integer): Integer; Assembler;
Asm
	MOV	AX, X
	CMP 	AX, Y
	JGE	@@1
	MOV	AX, Y
@@1:
End;

(******************************** TTrans object *****************************)

constructor TTrans.Init(var Bounds: TRect; AColor: Word);
Begin
  inherited Init(Bounds);
  { make the view transparent }
  State := State or sfTransparent;
  Options := Options or ofBufferOne;
  Color := AColor;
  Direction.X := Random(20) - 10;
  Direction.Y := Random(20) - 10;
  EventMask := EventMask or evMouse;
End;

procedure TTrans.Draw;
Begin
  SetWriteMode(OrPut);
  SetFillStyle(SolidFill, Color);
  SetColor(Color);
  FillCircle(Size.X div 2, Size.Y div 2, Size.X div 2 - 1);
  SetWriteMode(NormalPut);
End;

procedure TTrans.HandleEvent(var Event: TEvent);
const
  Speed = 0.05;
var
  S, N: TPoint;
begin
  If Event.What = evMouseDown then Begin
    ClearEvent(Event);
    Free;
    Exit
  End;
  inherited HandleEvent(Event);
  If (Event.What = evTimer) or
     (Event.What = evBroadcast) and (Event.Command = cmIdle)
  then Begin
    If MouseButtons <> 0
    then begin
      S.X := Size.X div 2;
      S.Y := Size.Y div 2;
      MakeGlobal(S, S);
      Direction.X := Round((MouseWhere.X - S.X) * Speed * Random(5));
      Direction.Y := Round((MouseWhere.Y - S.Y) * Speed * Random(5))
    end;
    S := GOwner^.Size;
    N.X := Min(S.X - Size.X, Max(0, Origin.X + Direction.X));
    N.Y := Min(S.Y - Size.Y, Max(0, Origin.Y + Direction.Y));
    If (N.X = 0) or (N.X = S.X - Size.X) then
      Direction.X := -Direction.X;
    If (N.Y = 0) or (N.Y = S.Y - Size.Y) then
      Direction.Y := -Direction.Y;
    MoveTo(N.X, N.Y);
  End;
end;

(******************************** TDemoApp object ***************************)

constructor TDemoApp.Init;
begin
  { Make it black! }
  TApplication.GetPalette^[1] := #0;
  inherited Init;
  Randomize;
end;

procedure TDemoApp.HandleEvent(var Event: TEvent);

  procedure NewSpot;
  var R: TRect;
      W: PWindow;
  Begin
    R.Assign(0, 0, 90, 90);
    R.Move(Random(Desktop^.Size.X - 90), Random(Desktop^.Size.Y - 90));
    Desktop^.Insert(New(PTrans, Init(R, (1 shl Random(3)) or 8)));
  End;

  procedure LoadDesktop;
  var D: PFileDialog;
      BackBitmap: PathStr;
  Begin
    BackBitmap := '*.bmp';
    D := New(PFileDialog, Init(BackBitmap, GetStr(704), GetStr(702),
      fdOpenButton, 42));
    If ExecuteDialog(D, @BackBitmap) <> cmCancel then
      PNewDesktop(Desktop)^.NewBitmap(BackBitmap);
  End;

Begin
  inherited HandleEvent(Event);
  If Event.What = evCommand then
    Case Event.Command Of
      cmOpen:
	LoadDesktop;
      cmNew:
	NewSpot;
    End
End;

procedure TDemoApp.InitDesktop;
var R: TRect;
Begin
  Main^.GetExtent(R);
  R.Grow(0, -21);
  Desktop := New(PNewDesktop, Init(R, ''));
End;

procedure TDemoApp.InitStatusLine;
var R: TRect;
Begin
  Main^.GetExtent(R);
  R.A.Y := R.B.Y - 21;
  StatusLine := New(PStatusLine, Init(R,
    NewStatusDef(0, $FFFF,
      NewStatusKeyKN(GetStr(600), kbAltX, cmQuit,
      NewStatusKeyKN(GetStr(612), kbF3, cmOpen,
      NewStatusKeyKN(getStr(613), kbF4, cmNew, nil))), nil)));
End;

function TDemoApp.LanguageResource: String;
Begin
  LanguageResource := 'EXAM.GVL';
End;

var App: TDemoApp;

Begin
  App.Init;
  App.Run;
  App.Done;
End.
