boxes-chords
boxe-chord.ads
boxe-chord.adb
boxes
boxes
boxes-arcs
boxes-chords
boxes-clefs
boxes-keys
boxes-measures
boxes-not_head
boxes-staves
boxes-times
engine
boxes/
collectors/
output/
printers/
roemer.adb
test_engine.ad
ada
bin/
engine/
fonts/
internal/
text/
util/
Home
Showcase
Snapshots
Ada Source
PHP Source
Fonts
Sourceforge
Summary
Downloads
Browse CVS
Donate
Activity

Hosted by
SourceForge.net Logo

 -- $Date: 2004/03/08 10:39:48 $
-- $Revision: 1.11 $
-- $Author: jcrocholl $
-- $Hash: 153a5f0cf9a12c519e2e2da31dde5c81 $

-- This file was automatically created with ado.php.
-- Manual changes will be lost when it is updated.

with Enum_Strings; use Enum_Strings;
with Messages; use Messages;

package body Boxes.Chords is

   -- Constructor for instances.
   function Create
     return Chord_Box_Access -- The newly created chord box.
   is
      Result : Chord_Box_Access := new Chord_Box;
   begin
      Result.Note_Heads := Head_Lists.Create;
      return Result;
   end Create;

   procedure Add_Note
     (This     : access Chord_Box; -- The chord box object instance.
      Add      : access Note;      -- Add this note.
      Middle_C : in Integer)       -- Clef in use in this measure.
   is
      Note_Head : Note_Head_Enum; -- The visual type of the note head.
      Filled    : Boolean;        -- Hollow half note or filled quarter?
      Position  : Integer;        -- Vertical offset from middle of staff.
   begin
      Note_Head := Get_Note_Head(Add);
      Filled := Get_Filled(Add);
      Position := Middle_C + Get_Position(Add);

      if Head_Lists.Empty(This.Note_Heads) then
         This.Note_Type := Get_Note_Type(Add);
         This.Stem := This.Note_Type >= Half;
         This.Dots := Get_Dots(Add);
         This.Lowest := Position;
         This.Highest := Position;
      else
         if Position < This.Lowest then This.Lowest := Position; end if;
         if Position > This.Highest then This.Highest := Position; end if;
      end if;

      Head_Lists.Push(This.Note_Heads, Create(Note_Head, Filled, Position));
   end Add_Note;

   procedure Layout_Note_Heads
     (This : access Chord_Box;   -- The chord box object instance.
      Font : access Font_Loader) -- Use this font loader.
   is
      use Head_Lists;
      Note_Head : Note_Head_Box_Access;
      Position  : Integer;
      Extra     : Real;
      Y         : Real;
   begin
      This.Stem_Box := (others => 0.0);

      Reset(This.Note_Heads);
      while Next(This.Note_Heads) loop
         Note_Head := Current(This.Note_Heads);
         Position := Get_Position(Current(This.Note_Heads));

         Extra := 0.0;
         if Position mod 2 = 1 then -- Sitting in a space between lines.
            if Position = This.Highest then -- Above the highest staff line.
               if Position = 5 then Extra := -5.0; end if;
               if Position >= 7 then Extra := -20.0; end if;
            end if;
            if Position = This.Lowest then -- Under the lowest staff line.
               if Position = -5 then Extra := 5.0; end if;
               if Position <= -7 then Extra := 20.0; end if;
            end if;
            if not Get_Filled(Note_Head) then
               Extra := Extra * 2.0;
            end if;
         end if;

         Y := -50.0 * Real(Position) + Extra;
         Set_Center(Note_Head, (0.0, Y));
         This.Stem_Box.Bottom := Real'Max(This.Stem_Box.Bottom, Y - 20.0);
         This.Stem_Box.Top := Real'Min(This.Stem_Box.Top, Y + 20.0);
         Layout(Note_Head, Font);
         Max_Bounds(This, Note_Head);
         -- Last_Position := Position;
         -- if Position - Last_Position < 2 then
         -- This.Center + (130.0, -50.0 * Real(Position)),
      end loop;
   end Layout_Note_Heads;

   procedure Layout_Stem_Down
     (This : access Chord_Box;      -- The chord box object instance.
      Font : access Font_Loader) is -- Use this font loader.
   begin
      This.Stem_Box.Left := This.Bounds.Left + 6.0;
      This.Stem_Box.Right := This.Stem_Box.Left + 8.0;
      -- This.Stem_Box.Top := -50.0 * Real(This.Highest) + 20.0;
      This.Stem_Box.Bottom := -50.0 * Real(This.Lowest - 7);
      if This.Stem_Box.Bottom < 0.0 then
         This.Stem_Box.Bottom := 0.0;
      end if;

      case This.Note_Type is
      when Long | Breve | Whole | Half | Quarter => null;
      when Eighth =>
         This.Flag := Load_Glyph(Font, "flags/stem-down/single");
      when N_16th =>
         This.Flag := Load_Glyph(Font, "flags/stem-down/double");
         This.Stem_Box.Bottom := This.Stem_Box.Bottom + 50.0;
      when N_32nd =>
         This.Flag := Load_Glyph(Font, "flags/stem-down/triple");
         This.Stem_Box.Bottom := This.Stem_Box.Bottom + 100.0;
      when others =>
         Error("unsupported flag type: " & To_XML(This.Note_Type'Img));
      end case;

      if This.Flag /= null then
         This.Flag_Offset := (This.Stem_Box.Left, This.Stem_Box.Bottom);
         This.Bounds := Max(This.Bounds, Get_Bounds(This.Flag) + This.Flag_Offset);
      end if;

      This.Bounds := Max(This.Bounds, This.Stem_Box);
   end Layout_Stem_Down;

   procedure Layout_Stem_Up
     (This : access Chord_Box;      -- The chord box object instance.
      Font : access Font_Loader) is -- Use this font loader.
   begin
      This.Stem_Box.Right := This.Bounds.Right - 6.0;
      This.Stem_Box.Left := This.Stem_Box.Right - 8.0;
      -- This.Stem_Box.Bottom := -50.0 * Real(This.Lowest) - 20.0;
      This.Stem_Box.Top := -50.0 * Real(This.Highest + 7);
      if This.Stem_Box.Top > 0.0 then
         This.Stem_Box.Top := 0.0;
      end if;

      case This.Note_Type is
      when Long | Breve | Whole | Half | Quarter => null;
      when Eighth =>
         This.Flag := Load_Glyph(Font, "flags/stem-up/single");
      when N_16th =>
         This.Flag := Load_Glyph(Font, "flags/stem-up/double");
         This.Stem_Box.Top := This.Stem_Box.Top - 50.0;
      when N_32nd =>
         This.Flag := Load_Glyph(Font, "flags/stem-up/triple");
         This.Stem_Box.Top := This.Stem_Box.Top - 100.0;
      when others =>
         Error("unsupported flag type: " & To_XML(This.Note_Type'Img));
      end case;

      if This.Flag /= null then
         This.Flag_Offset := (This.Stem_Box.Left, This.Stem_Box.Top);
         This.Bounds := Max(This.Bounds, Get_Bounds(This.Flag) + This.Flag_Offset);
      end if;

      This.Bounds := Max(This.Bounds, This.Stem_Box);
   end Layout_Stem_Up;

   procedure Layout_Dots
     (This : access Chord_Box;   -- The chord box object instance.
      Font : access Font_Loader) -- Use this font loader.
   is
      use Head_Lists;
      Note_Head : Note_Head_Box_Access;
      Position  : Integer;
   begin
      if This.Dots /= 0 then
         Reset(This.Note_Heads);
         while Next(This.Note_Heads) loop
            Note_Head := Current(This.Note_Heads);
            Position := Get_Position(Current(This.Note_Heads));
            if Position mod 2 = 1
            then Add_Dots(Note_Head, Font, This.Dots, (150.0, 0.0));
            else Add_Dots(Note_Head, Font, This.Dots, (150.0, -50.0));
            end if;
            Max_Bounds(This, Note_Head);
         end loop;
      end if;
   end Layout_Dots;

   procedure Layout_Ledger
     (This : access Chord_Box;      -- The chord box object instance.
      Font : access Font_Loader) is -- Use this font loader.
   begin
      for Index in 3 .. This.Highest / 2 loop
         This.High_Ledger(Index) := Load_Glyph(Font, "lines/ledger");
         This.Bounds := Max(This.Bounds,
           Get_Bounds(This.High_Ledger(Index)) + (0.0, -100.0 * Real(Index)));
      end loop;

      for Index in This.Lowest / 2 .. -3 loop
         This.Low_Ledger(Index) := Load_Glyph(Font, "lines/ledger");
         This.Bounds := Max(This.Bounds,
           Get_Bounds(This.Low_Ledger(Index)) + (0.0, -100.0 * Real(Index)));
      end loop;
   end Layout_Ledger;

   procedure Layout
     (This : access Chord_Box;      -- The chord box object instance.
      Font : access Font_Loader) is -- Use this font loader.
   begin
      Layout_Note_Heads(This, Font);

      if This.Stem then
         This.Stem_Down := -This.Lowest <= This.Highest;
         if This.Stem_Down
         then Layout_Stem_Down(This, Font);
         else Layout_Stem_Up(This, Font);
         end if;
      end if;

      Layout_Dots(This, Font);

      Layout_Ledger(This, Font);
   end Layout;

   procedure Print
     (This   : access Chord_Box;          -- The chord box object instance.
      To     : access Printer'Class; -- Render to this printer.
      Center : in Vector)                 -- Center of container.
   is
      use Head_Lists;
   begin
      Reset(This.Note_Heads);
      while Next(This.Note_Heads) loop
         Print(Current(This.Note_Heads), To, Center + This.Center);
      end loop;

      -- if This.Stem then
      --    Black_Box(Image, Center.X + 55.0, Center.X + 65.0,
      --      -50.0 * Real(Get_Position(First(This.Note_Heads))) - 30.0,
      --      -50.0 * Real(Get_Position(Last(This.Note_Heads))) - 350.0);
      -- end if;

      -- for Y in This.Lowest / 2 .. -3 loop
      --    Render(Load_Glyph(Font, "lines/ledger"),
      --      (Center.X, Center.Y - Real(Y) * 100.0), Image);
      -- end loop;

      for Index in 3 .. This.Highest / 2 loop
         Print(To, This.High_Ledger(Index),
           Center + This.Center + (0.0, -100.0 * Real(Index)));
      end loop;

      for Index in This.Lowest / 2 .. -3 loop
         Print(To, This.Low_Ledger(Index),
           Center + This.Center + (0.0, -100.0 * Real(Index)));
      end loop;

      if This.Stem then
         Fill_Box(To, This.Stem_Box + Center + This.Center, 0);
      end if;

      if This.Flag /= null then
         Print(To, This.Flag, Center + This.Center + This.Flag_Offset);
      end if;

      Print_Bounds(This, To, Center);
   end Print;

end Boxes.Chords;