with Gwindows.Drawing_Objects;
with Gwindows.Base;
with Ada.Unchecked_Conversion;
with Peer;
use Peer;
package body Mcc.Gui.Fonts is
   type Font_Access is access all Gwindows.Drawing_Objects.Font_Type;
   function Convert is new Ada.Unchecked_Conversion(Peer.Peer,
      Font_Access);
   function Convert is new Ada.Unchecked_Conversion(Font_Access,
      Peer.Peer);
      
   ------------
   -- Create --
   ------------

   procedure Create
     (Obj    : in out Font;
      Family : in     Font_Family := Serif;
      Size   : in     Font_Size := 12;
      Style  : in     Font_Style := Plain)
   is
      Weight  : Gwindows.Drawing_Objects.Font_Weight_Type;
      Italics : Boolean;
      My_Peer : Font_Access;
   begin
      My_Peer := new Gwindows.Drawing_Objects.Font_Type;
      case Style is
         when Plain =>
            Weight := Gwindows.Drawing_Objects.FW_NORMAL;
            Italics := False;
         when Bold =>
            Weight := Gwindows.Drawing_Objects.FW_BOLD;
            Italics := False;
         when Italic =>
            Weight := Gwindows.Drawing_Objects.FW_NORMAL;
            Italics := True;
         when Bold_Italic =>
            Weight := Gwindows.Drawing_Objects.FW_BOLD;
            Italics := True;
      end case;
      case Family is
         when Serif =>
            Gwindows.Drawing_Objects.Create_Font (
               Font       => My_Peer.all,
               Name       => +"Times New Roman",
               Size       => Size,
               Weight     => Weight,
               Italics    => Italics,
               Underline  => False,
               Strike_Out => False);
         when Sans_Serif =>
            Gwindows.Drawing_Objects.Create_Font (
               Font       => My_Peer.all,
               Name       => +"Arial",
               Size       => Size,
               Weight     => Weight,
               Italics    => Italics,
               Underline  => False,
               Strike_Out => False);
         when Monospaced =>
            Gwindows.Drawing_Objects.Create_Font (
               Font       => My_Peer.all,
               Name       => +"Courier New",
               Size       => Size,
               Weight     => Weight,
               Italics    => Italics,
               Underline  => False,
               Strike_Out => False);
      end case;
      Obj.My_Peer := Convert(My_Peer);
   end Create;

   --------------
   -- Set_Font --
   --------------

   procedure Set_Font
     (Obj      : in out Sized_Object'Class;
      New_Font : in     Font)
   is
   begin
      Gwindows.Base.Set_Font (
         Window => Obj.My_Peer.all,
         Font   => Convert(New_Font.My_Peer).all);
   end Set_Font;

end Mcc.Gui.Fonts;

