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

Unit GVColor;

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

interface

{$ifdef FPK}
uses Objects, Views, Drivers, GvViews, GvDialog, GvApp,
  Bgi, ExtGraph, GVTexts;
{$else}
{$ifdef Windows}
uses Objects, Views, Drivers, GvViews, GvDialog, GvApp;
{$else}
uses Objects, Views, Drivers, GVDriver, GVViews, GVDialog, GVApp;
{$endif}
{$endif}

const
  cmColorChanged           = 71;
  cmNewColorItem           = 72;
  cmNewColorIndex          = 73;

type

  { TColorItem record }

    PColorItem = ^TColorItem;
    TColorItem = record
      Name: PString;
      Index: Byte;
      Next: PColorItem;
    end;

  { TColorGroup record }

    PColorGroup = ^TColorGroup;
    TColorGroup = record
      Name:  PString;
      Items: PColorItem;
      Next:  PColorGroup;
    end;

  { TSelector object }

  PSelector = ^TSelector;
  TSelector = object (TGView)
    Color: Byte;
    constructor Init (var Bounds: TRect);
    constructor Load (var S: TStream);
    procedure Draw; virtual;
    procedure HandleEvent (var Event: TEvent); virtual;
    procedure Store (var S: TStream);
  private
    procedure DrawMarker (Index, Col: Byte);
  end;

  { TColorGroupList object }

  PColorGroupList = ^TColorGroupList;
  TColorGroupList = object (TListViewer)
    Groups: PColorGroup;
    constructor Init (var Bounds: TRect; AScrollBar: PScrollBar;
      AGroups: PColorGroup);
    constructor Load (var S: TStream);
    destructor Done; virtual;
    procedure FocusItem (Item: Integer); virtual;
    function GetText (Item: Integer; MaxLen: Integer): String; virtual;
    procedure Store (var S: TStream);
  end;

  { TColorItemList object }

  PColorItemList = ^TColorItemList;
  TColorItemList = object (TListViewer)
    Items: PColorItem;
    constructor Init (var Bounds: TRect; AScrollBar: PScrollBar;
      AItems: PColorItem);
    procedure FocusItem (Item: Integer); virtual;
    function GetText (Item: Integer; MaxLen: Integer): String; virtual;
    procedure HandleEvent (var Event: TEvent); virtual;
  end;

  { TColorDialog object }

  PColorDialog = ^TColorDialog;
  TColorDialog = object (TDialog)
    Groups: PColorGroupList;
    ColLabel: PLabel;
    ColSel: PSelector;
    Pal: TPalette;
    constructor Init (APalette: TPalette; AGroups: PColorGroup);
    constructor Load (var S: TStream);
    function DataSize: Sw_Word; virtual;
    procedure GetData (var Rec); virtual;
    procedure SetData (var Rec); virtual;
    procedure Store (var S: TStream);
  end;

{ Color list building routines }

function ColorItem (Name: String; Index: Byte; Next: PColorItem): PColorItem;
function ColorGroup (Name: String; Items: PColorItem; Next: PColorGroup):
  PColorGroup;

{ ColorSel registration procedure }

procedure RegisterGVColor;

{ Stream registration records }

const

  RSelector: TStreamRec = (
     ObjType: 180;
     VmtLink: Ofs(TypeOf(TSelector)^);
     Load:    @TSelector.Load;
     Store:   @TSelector.Store
  );

  RColorGroupList: TStreamRec = (
     ObjType: 181;
     VmtLink: Ofs(TypeOf(TColorGroupList)^);
     Load:    @TColorGroupList.Load;
     Store:   @TColorGroupList.Store
  );

  RColorItemList: TStreamRec = (
     ObjType: 182;
     VmtLink: Ofs(TypeOf(TColorItemList)^);
     Load:    @TColorItemList.Load;
     Store:   @TColorItemList.Store
  );

  RColorDialog: TStreamRec = (
     ObjType: 183;
     VmtLink: Ofs(TypeOf(TColorDialog)^);
     Load:    @TColorDialog.Load;
     Store:   @TColorDialog.Store
  );

implementation

{$ifndef FPK}
{$ifdef Windows}
uses WinGr, ExtGraph, GVTexts;
{$else}
uses MetaGr, ExtGraph, GVTexts;
{$endif}
{$endif FPK}

{****************************** TSelector object ****************************}

constructor TSelector.Init(var Bounds: TRect);
Begin
  TGView.Init (Bounds);
  Options := Options or (ofSelectable + ofFirstClick);
  EventMask := EventMask or (evBroadcast+evMouse+evKeyBoard);
  Color := 0;
End;

constructor TSelector.Load(var S: TStream);
Begin
  TGView.Load (S);
  S.Read (Color, SizeOf (Color));
End;

procedure TSelector.Draw;
var I: Integer;
Begin
  SetViewPort;
  HideMouse;
  SetColor (Black);
  RectAngle (0, 0, Size.X-1, Size.Y-1);

  For I:=0 to 15 do Begin
    SetFillStyle (SolidFill, I);
    Bar (1+(I mod 4)*30, 1+ I div 4 * 20, (I mod 4)*30+30, I div 4 * 20 + 20);
  End;

  ShowMouse;
  RestoreViewPort;
  If Color = 0 then DrawMarker (Color, White)
               else DrawMarker (Color, Black);
End;

procedure TSelector.DrawMarker(Index, Col: Byte);
Begin
  SetViewPort;
  HideMouse;
  SetColor (Col);

  Line (1+(Index mod 4)*30, 1+Index div 4 * 20, (Index mod 4)*30+30,
        Index div 4 * 20 + 20);
  Line (1+(Index mod 4)*30, Index div 4 * 20+20, (Index mod 4)*30+30,
        1+Index div 4 * 20);

  {
  RectAngle (1+(Index mod 4)*30+7, 1+Index div 4 * 20+5, (Index mod 4)*30+30-7,
             Index div 4 * 20 + 20 - 5);
  }
  ShowMouse;
  RestoreViewPort;
End;

procedure TSelector.HandleEvent(var Event: TEvent);
var Mouse: TPoint;
    OldColor, Temp: Byte;

 procedure ColorChanged;
 Begin
   Message (GOwner, evBroadcast, cmColorChanged, Pointer (LongInt(Color)));
 End;

Begin
  TGView.HandleEvent(Event);
  Case Event.What of
    evMouseDown: Begin
                   OldColor := Color;
                   Repeat
                     If MouseInView (Event.Where) then Begin
                       MakeLocal (Event.Where, Mouse);
                       Temp := Color;
                       Color := Mouse.Y div 20 * 4 + Mouse.X div 30;
                       If Temp <> Color then Begin
                         DrawMarker (Temp, Temp);
                         If Color = 0 then DrawMarker (Color, White)
                                      else DrawMarker (Color, Black);
                       End;
                     End
                     Else If Color <> OldColor then Begin
                            DrawMarker (Color, Color);
                            Color := OldColor;
                            If Color = 0 then DrawMarker (Color, White)
                                         else DrawMarker (Color, Black);
                          End;
                   Until not MouseEvent (Event, evMouseAuto);
                End;
    evKeyDown: Begin
                 Case CtrlToArrow (Event.KeyCode) of
                   kbLeft : Begin
                              DrawMarker (Color, Color);
                              If Color > 0 then Dec (Color)
                                           else Color := 15;
                            End;
                   kbRight: Begin
                              DrawMarker (Color, Color);
                              If Color < 15 then Inc (Color)
                                            else Color := 0;
                            End;
                   kbUp   : Begin
                              DrawMarker (Color, Color);
                              If Color > 3 then Dec (Color, 4)
                              Else If Color = 0 then Color := 15
                                                else Inc (Color, 11);
                            End;
                   kbDown : Begin
                              DrawMarker (Color, Color);
                              If Color < 12 then Inc (Color, 4)
                              Else If Color = 15 then Color := 0
                                                 else Dec (Color, 11);
                            End;
                  else Exit;
                 End;
                 If Color = 0 then DrawMarker (Color, White)
                              else DrawMarker (Color, Black);
               End;
    evBroadcast: If Event.Command = cmNewColorIndex then Begin
                   Temp:=Color;
                   Color:=Ord (PColorDialog (GOwner)^.Pal [Byte (LongInt(Event.InfoPtr))]);
                   If Exposed and (Temp <> Color) then Begin
                     DrawMarker (Temp, Temp);
                     If Color = 0 then DrawMarker (Color, White)
                                  else DrawMarker (Color, Black);
                   End;
                   Exit;
                 End
                 Else Exit;
   else Exit;
  End;
  ColorChanged;
  ClearEvent (Event);
End;

procedure TSelector.Store(var S: TStream);
Begin
  TGView.Store (S);
  S.Write (Color, SizeOf (Color));
End;

{************************* TColorGroupList object ***************************}

constructor TColorGroupList.Init(var Bounds: TRect; AScrollBar: PScrollBar;
      AGroups: PColorGroup);
var I: Integer;
Begin
  TListViewer.Init (Bounds, AScrollBar);
  Groups := AGroups;
  I := 0;
  While AGroups <> nil do Begin
    AGroups := AGroups^.Next;
    Inc (I);
  End;
  SetRange (I);
End;

constructor TColorGroupList.Load (var S: TStream);

 function ReadItems: PColorItem;
 var Itms:  PColorItem;
     CurItm: ^PColorItem;
     Count, I: Integer;
 Begin
   S.Read (Count, SizeOf(Integer));
   Itms := nil;
   CurItm := @Itms;
   for I := 1 to Count do Begin
     New (CurItm^);
     With CurItm^^ do Begin
       Name := S.ReadStr;
       S.Read (Index, SizeOf (Byte));
     End;
     CurItm := @CurItm^^.Next;
   End;
   CurItm^ := nil;
   ReadItems := Itms;
 End;

 function ReadGroups: PColorGroup;
 var Grps:  PColorGroup;
     CurGrp: ^PColorGroup;
     Count, I: Integer;
 Begin
   S.Read (Count, SizeOf(Integer));
   Grps := nil;
   CurGrp := @Grps;
   for I := 1 to Count do Begin
     New (CurGrp^);
     With CurGrp^^ do Begin
       Name := S.ReadStr;
       Items := ReadItems;
     End;
     CurGrp := @CurGrp^^.Next;
   End;
   CurGrp^ := nil;
   ReadGroups := Grps;
 End;

Begin
  TListViewer.Load (S);
  Groups := ReadGroups;
End;

destructor TColorGroupList.Done;

 procedure FreeItems (CurITem: PColorItem);
 var P: PColorItem;
 Begin
   While CurItem <> nil do Begin
     P := CurItem;
     DisposeStr (CurItem^.Name);
     CurItem := CurItem^.Next;
     Dispose (P);
   End;
 End;

 procedure FreeGroups (CurGroup: PColorGroup);
 var P: PColorGroup;
 Begin
   While CurGroup <> nil do Begin
     P := CurGroup;
     FreeItems (CurGroup^.Items);
     DisposeStr (CurGroup^.Name);
     CurGroup := CurGroup^.Next;
     Dispose (P);
   End
 End;

Begin
  inherited Done;
  FreeGroups (Groups);
End;

procedure TColorGroupList.FocusItem(Item: Integer);
var CurGroup: PColorGroup;
Begin
  If not IsSelected (Item) then TListViewer.FocusItem (Item);
  CurGroup := Groups;
  While (Item > 0) and (CurGroup <> nil) do Begin
    CurGroup := CurGroup^.Next;
    Dec (Item);
  End;
  If (CurGroup <> nil) then
    Message (GOwner, evBroadcast, cmNewColorItem, CurGroup^.Items);
End;

function TColorGroupList.GetText(Item: Integer; MaxLen: Integer): String;
var CurGroup: PColorGroup;
Begin
  CurGroup := Groups;
  While Item > 0 do Begin
    CurGroup := CurGroup^.Next;
    Dec (Item);
  End;
  GetText := CurGroup^.Name^;
End;

procedure TColorGroupList.Store (var S: TStream);

 procedure WriteItems (Items: PColorItem);
 var CurItm: PColorItem;
     Count: Integer;
 Begin
   Count := 0;
   CurItm := Items;
   While CurItm <> nil do Begin
     CurItm := CurItm^.Next;
     Inc (Count);
   End;
   S.Write (Count, SizeOf (Count));
   CurItm := Items;
   While CurItm <> nil do Begin
     With CurItm^ do Begin
       S.WriteStr (Name);
       S.Write (Index, SizeOf (Index));
     End;
     CurItm := CurItm^.Next;
   End;
 End;

 procedure WriteGroups (Groups: PColorGroup);
 var CurGrp: PColorGroup;
     Count: Integer;
 Begin
   Count := 0;
   CurGrp := Groups;
   While CurGrp <> nil do Begin
     CurGrp := CurGrp^.Next;
     Inc (Count);
   End;
   S.Write (Count, SizeOf (Count));
   CurGrp := Groups;
   While CurGrp <> nil do Begin
     With CurGrp^ do Begin
       S.WriteStr (Name);
       WriteItems (Items);
     End;
     CurGrp := CurGrp^.Next;
   End;
 End;

Begin
  TListViewer.Store (S);
  WriteGroups (Groups);
End;

{*************************** TColorItemList object **************************}

constructor TColorItemList.Init(var Bounds: TRect; AScrollBar: PScrollBar;
      AItems: PColorItem);
var I: Integer;
Begin
  TListViewer.Init (Bounds, AScrollBar);
  EventMask := EventMask or evBroadcast;
  Items := AItems;
  I := 0;
  While AItems <> nil do Begin
    AItems := AItems^.Next;
    Inc(I);
  End;
  SetRange (I);
End;

procedure TColorItemList.FocusItem(Item: Integer);
var CurItem: PColorItem;
Begin
  If not IsSelected (Item) then TListViewer.FocusItem (Item);
  CurItem := Items;
  While Item > 0 do Begin
    CurItem := CurItem^.Next;
    Dec (Item);
  End;
  Message (GOwner, evBroadcast, cmNewColorIndex, Pointer (LongInt(CurItem^.Index)));
End;

function TColorItemList.GetText(Item: Integer; MaxLen: Integer): String;
var CurItem: PColorItem;
Begin
  CurItem := Items;
  While Item > 0 do Begin
    CurItem := CurItem^.Next;
    Dec (Item);
  End;
  GetText := CurItem^.Name^;
End;

procedure TColorItemList.HandleEvent(var Event: TEvent);
var CurItem, Item: PColorItem;
    I, OldF: Integer;
Begin
  TListViewer.HandleEvent (Event);
  Case Event.What of
    evBroadcast:
      If Event.Command = cmNewColorItem then Begin
        Item := Items;
        Items := Event.InfoPtr;
        If Item <> Items then Begin
          CurItem := Items;
          I := 0;
          While CurItem <> nil do Begin
            CurItem := CurItem^.Next;
            Inc (I);
          End;
          OldF:=Focused;
          SetRange (I);
          FocusItem (0);
          DrawView;
        End;
      End
      Else If Event.Command = cmColorChanged then Begin
             I:=Focused;
             CurItem:=Items;
             While I>0 do Begin
               CurItem := CurItem^.Next;
               Dec (I);
             End;
             PColorDialog (GOwner)^.Pal [CurItem^.Index] := Chr (LongInt(Event.InfoPtr));
           End;
  End;
End;

{****************************** TColorDialog object *************************}

constructor TColorDialog.Init(APalette: TPalette; AGroups: PColorGroup);
var R: TRect;
    P: PGView;

Begin
  R.Assign(0, 0, 500, 280);
  TDialog.Init (R, GetStr(8));
  Options := Options or ofCentered;
  Pal := APalette;

  R.Assign (129, 60, 147, 201);
  P := New (PScrollBar, Init (R));
  Insert (P);
  R.Assign (20, 60, 130, 201);
  Groups := New (PColorGroupList, Init (R, PScrollBar (P), AGroups));
  Insert (Groups);
  R.Assign (20, 40, 80, 60);
  Insert (New (PLabel, Init (R, GetStr(9), Groups)));

  R.Assign (319, 60, 337, 201);
  P := New (PScrollBar, Init (R));
  Insert (P);
  R.Assign (170, 60, 320, 201);
  P := New (PColorItemList, Init (R, PScrollBar (P), AGroups^.Items));
  Insert (P);
  R.Assign (170, 40, 240, 60);
  Insert (New (PLabel, Init (R, GetStr(10), P)));

  R.Assign (360, 60, 482, 142);
  ColSel := New (PSelector, Init (R));
  Insert (ColSel);
  R.Assign (360, 40, 430, 60);
  ColLabel := New (PLabel, Init (R, GetStr(11), ColSel));
  Insert (ColLabel);

  {
  Message (ColSel, evBroadcast, cmNewColorIndex, Pointer (AGroups^.Items^.Index));
  }

  R.Assign (100, 230, 200, 260);
  P := New (PButton, Init(R, GetStr(12), cmOk, bfDefault));
  Insert (P);
  R.Assign (300, 230, 400, 260);
  P := New (PButton, Init (R, GetStr(13), cmCancel, bfNormal));
  Insert (P);
  SelectNext (False);
end;

constructor TColorDialog.Load(var S: TStream);
var Len: Byte;
Begin
  inherited Load (S);
  GetSubViewPtr(S, Groups);
  GetSubViewPtr(S, ColLabel);
  GetSubViewPtr(S, ColSel);
  S.Read (Len, SizeOf (Byte));
  S.Read (Pal[1], Len);
  Pal[0] := Char (Len);
End;

procedure TColorDialog.Store(var S: TStream);
Begin
  inherited Store (S);
  PutSubViewPtr (S, Groups);
  PutSubViewPtr (S, ColLabel);
  PutSubViewPtr (S, ColSel);
  S.Write (Pal, Length(Pal)+1);
End;

function TColorDialog.DataSize: Sw_Word;
Begin
  DataSize := SizeOf (TPalette);
End;

procedure TColorDialog.GetData(var Rec);
Begin
  String (Rec) := Pal;
End;

procedure TColorDialog.SetData(var Rec);
Begin
  Pal := String (Rec);
  Groups^.FocusItem (0);
  Message(ColSel, evBroadcast, cmNewColorIndex,
    Pointer(LongInt(Groups^.Groups^.Items^.Index)));
  Groups^.Select;
End;

{*********************** Color list building routines ***********************}

function ColorItem(Name: String; Index: Byte; Next: PColorItem): PColorItem;
var Item: PColorItem;
Begin
  New (Item);
  Item^.Name := NewStr (Name);
  Item^.Index := Index;
  Item^.Next := Next;
  ColorItem := Item;
End;

function ColorGroup(Name: String; Items: PColorItem; Next: PColorGroup):
  PColorGroup;
var Group: PColorGroup;
Begin
  New (Group);
  Group^.Name := NewStr (Name);
  Group^.Items := Items;
  Group^.Next := Next;
  ColorGroup := Group;
End;

{*********************** ColorSel registration procedure ********************}

procedure RegisterGVColor;
Begin
{$ifndef FPK}
  RegisterType (RSelector);
  RegisterType (RColorGroupList);
  RegisterType (RColorItemList);
  RegisterType (RColorDialog);
{$endif FPK}
End;

End.
