--  This package is free software; you can redistribute it and/or
--  modify it under terms of the GNU General Public License as
--  published by the Free Software Foundation; either version 2, or
--  (at your option) any later version. This package is distributed in
--  the hope that it will be useful, but WITHOUT ANY WARRANTY; without
--  even the implied warranty of MERCHANTABILITY or FITNESS FOR A
--  PARTICULAR PURPOSE. See the GNU General Public License for more
--  details. You should have received a copy of the GNU General Public
--  License distributed with this package; see file COPYING.  If not,
--  write to the Free Software Foundation, 59 Temple Place - Suite
--  330, Boston, MA 02111-1307, USA.

with Ada.Interrupts.Names;
with Ada.Real_Time;
with Digital_IO.Input_Signal_State_Callback;
with System;
with STM32F40x.EXTI;   use STM32F40x.EXTI;
with STM32F40x.GPIO;   use STM32F40x.GPIO;
with STM32F40x.RCC;    use STM32F40x.RCC;
with STM32F40x.SYSCFG; use STM32F40x.SYSCFG;

package body Digital_IO.STM32F4_Support is

   package GPIO_Configuration is

      type EXTI_Line is mod 16;
      --  so named in case we need to use interrupts; not practical if
      --  we're looking for both falling and rising edges, because of
      --  too-rapid changes.

      type Used_Input_Signal (Valid : Boolean := False) is record
         case Valid is
            when False => null;
            when True  => Signal : Input_Signal;
         end case;
      end record;
      Line_To_Input_Signal :
        constant array (EXTI_Line) of Used_Input_Signal :=
        (0      => (True, 0),
         others => <>);

      type GPIO_Access is access all GPIO_Peripheral;

      type GPIO_Index is (A, B, C, D, E, F, G, H, I)
      with
        Warnings => Off;
      --  Note, 'Pos is the bit number in AHB1ENR, and the number to
      --  set in EXTICR to associate the Line with the GPIO.

      GPIOs : constant array (GPIO_Index) of GPIO_Access :=
        (GPIOA_Periph'Access,
         GPIOB_Periph'Access,
         GPIOC_Periph'Access,
         GPIOD_Periph'Access,
         GPIOE_Periph'Access,
         GPIOF_Periph'Access,
         GPIOG_Periph'Access,
         GPIOH_Periph'Access,
         GPIOI_Periph'Access);

      type Used_Line (Valid : Boolean := False) is record
         case Valid is
            when False =>
               null;
            when True  =>
               GPIO : GPIO_Index;
               Line : EXTI_Line;
         end case;
      end record;

      Input_Signal_To_Line : constant array (Input_Signal) of Used_Line :=
        (0      => (True, A, 0),  -- user button
         others => <>);

      Output_Signal_To_Line : constant array (Output_Signal) of Used_Line :=
        (0      => (True, D, 14),  -- red
         1      => (True, D, 12),  -- green
         2      => (True, D, 15),  -- blue
         3      => (True, D, 13),  -- orange
         others => <>);

      --  How often to check for input change
      Debounce_Interval : constant Ada.Real_Time.Time_Span
        := Ada.Real_Time.Milliseconds (5);

      --  Number of successive inputs that must be the same to
      --  recognise a change
      Debounce_Count : constant := 8;

   end GPIO_Configuration;
   use GPIO_Configuration;

   protected EXTI_Handler
   with
     Interrupt_Priority => System.Interrupt_Priority'First
   is
      entry Button_Pressed (B : out Interfaces.Unsigned_32);
   private
      Triggered        : Boolean := False;

      Last_Read_Values : Interfaces.Unsigned_32 := 0;
      --  We accumulate interrupt indications as they arrive, and
      --  clear when retreived by the caller of Button_Pressed.

      procedure EXTI0_IRQ_Handler;
      pragma Attach_Handler (EXTI0_IRQ_Handler,
                               Ada.Interrupts.Names.EXTI0_IRQ);
      procedure EXTI1_IRQ_Handler;
      pragma Attach_Handler (EXTI1_IRQ_Handler,
                               Ada.Interrupts.Names.EXTI1_IRQ);
      procedure EXTI2_IRQ_Handler;
      pragma Attach_Handler (EXTI2_IRQ_Handler,
                               Ada.Interrupts.Names.EXTI2_IRQ);
      procedure EXTI3_IRQ_Handler;
      pragma Attach_Handler (EXTI3_IRQ_Handler,
                               Ada.Interrupts.Names.EXTI3_IRQ);
      procedure EXTI4_IRQ_Handler;
      pragma Attach_Handler (EXTI4_IRQ_Handler,
                               Ada.Interrupts.Names.EXTI4_IRQ);
      procedure EXTI9_5_IRQ_Handler;
      pragma Attach_Handler (EXTI9_5_IRQ_Handler,
                               Ada.Interrupts.Names.EXTI9_5_IRQ);
      procedure EXTI15_10_IRQ_Handler;
      pragma Attach_Handler (EXTI15_10_IRQ_Handler,
                               Ada.Interrupts.Names.EXTI15_10_IRQ);
   end EXTI_Handler;

   task Heartbeat;
   --  Flash the green LED

   task Receive_Button_Interrupt;
   task Debounce_Inputs;

   procedure Configure_Inputs;
   procedure Configure_Outputs;
   procedure Enable_GPIO (Which : GPIO_Index);
   function Get_Input_State
     (For_Input : Digital_IO_Support.Input_Signal)
     return Boolean;
   procedure Set_Output_State
     (For_Output : Digital_IO_Support.Output_Signal;
      To         : Boolean);

   protected body EXTI_Handler is
      entry Button_Pressed (B : out Interfaces.Unsigned_32)
        when Triggered is
      begin
         B := Last_Read_Values;
         Last_Read_Values := 0;
         Triggered := False;
      end Button_Pressed;

      procedure EXTI0_IRQ_Handler is
         Read_Value : constant PR_Register := EXTI_Periph.PR;
         use type Interfaces.Unsigned_32;
      begin
         EXTI_Periph.PR := Read_Value;
         Triggered := True;
         Last_Read_Values :=
           Last_Read_Values or Interfaces.Unsigned_32 (Read_Value.PR.Val);
      end EXTI0_IRQ_Handler;

      procedure EXTI1_IRQ_Handler is
         Read_Value : constant PR_Register := EXTI_Periph.PR;
         use type Interfaces.Unsigned_32;
      begin
         EXTI_Periph.PR := Read_Value;
         Triggered := True;
         Last_Read_Values :=
           Last_Read_Values or Interfaces.Unsigned_32 (Read_Value.PR.Val);
      end EXTI1_IRQ_Handler;

      procedure EXTI2_IRQ_Handler is
         Read_Value : constant PR_Register := EXTI_Periph.PR;
         use type Interfaces.Unsigned_32;
      begin
         EXTI_Periph.PR := Read_Value;
         Triggered := True;
         Last_Read_Values :=
           Last_Read_Values or Interfaces.Unsigned_32 (Read_Value.PR.Val);
      end EXTI2_IRQ_Handler;

      procedure EXTI3_IRQ_Handler is
         Read_Value : constant PR_Register := EXTI_Periph.PR;
         use type Interfaces.Unsigned_32;
      begin
         EXTI_Periph.PR := Read_Value;
         Triggered := True;
         Last_Read_Values :=
           Last_Read_Values or Interfaces.Unsigned_32 (Read_Value.PR.Val);
      end EXTI3_IRQ_Handler;

      procedure EXTI4_IRQ_Handler is
         Read_Value : constant PR_Register := EXTI_Periph.PR;
         use type Interfaces.Unsigned_32;
      begin
         EXTI_Periph.PR := Read_Value;
         Triggered := True;
         Last_Read_Values :=
           Last_Read_Values or Interfaces.Unsigned_32 (Read_Value.PR.Val);
      end EXTI4_IRQ_Handler;

      procedure EXTI9_5_IRQ_Handler is
         Read_Value : constant PR_Register := EXTI_Periph.PR;
         use type Interfaces.Unsigned_32;
      begin
         EXTI_Periph.PR := Read_Value;
         Triggered := True;
         Last_Read_Values :=
           Last_Read_Values or Interfaces.Unsigned_32 (Read_Value.PR.Val);
      end EXTI9_5_IRQ_Handler;

      procedure EXTI15_10_IRQ_Handler is
         Read_Value : constant PR_Register := EXTI_Periph.PR;
         use type Interfaces.Unsigned_32;
      begin
         EXTI_Periph.PR := Read_Value;
         Triggered := True;
         Last_Read_Values :=
           Last_Read_Values or Interfaces.Unsigned_32 (Read_Value.PR.Val);
      end EXTI15_10_IRQ_Handler;
   end EXTI_Handler;

   task body Receive_Button_Interrupt is
      Last_Read_Values : Interfaces.Unsigned_32;
      Bits : Bits_32x1;
   begin
      loop
         EXTI_Handler.Button_Pressed (Last_Read_Values);
         Bits := U32_To_B1 (Last_Read_Values);
         for Line in EXTI_Line loop
            if Bits (Integer (Line)) /= 0
            and then Line_To_Input_Signal (Line).Valid
            then
               declare
                  S : constant Input_Signal
                    := Line_To_Input_Signal (Line).Signal;
               begin
                  Input_Signal_State_Callback.Call_Callbacks
                    ((S     => S,
                      State => Get_Input_State
                        (Digital_IO_Support.Input_Signal (S))));
               end;
            end if;
         end loop;
      end loop;
   end Receive_Button_Interrupt;

   task body Debounce_Inputs is
      type Debounce_Index is mod Debounce_Count;
      type Successive_Inputs is array (Debounce_Index) of Boolean
      with Default_Component_Value => False;
      type Input_Debouncing is record
         Inputs : Successive_Inputs;
         Index : Debounce_Index := Debounce_Index'First;
         Debounced : Boolean := False;
      end record;
      Inputs : array (Input_Signal_To_Line'Range) of Input_Debouncing;
      Next : Ada.Real_Time.Time := Ada.Real_Time.Clock;
      use type Ada.Real_Time.Time;
   begin
      loop
         Next := Next + Debounce_Interval;
         delay until Next;
         for L in Inputs'Range loop
            if Input_Signal_To_Line (L).Valid then
               declare
                  Signal : constant Input_Signal
                    := Line_To_Input_Signal (EXTI_Line (L)).Signal;
               begin
                  Inputs (L).Index := Inputs (L).Index + 1;
                  Inputs (L).Inputs (Inputs (L).Index)
                    := Get_Input_State
                      (Digital_IO_Support.Input_Signal (Signal));
                  if Inputs (L).Inputs = Successive_Inputs'(others => True)
                    and Inputs (L).Debounced = False
                  then
                     Inputs (L).Debounced := True;
                     Input_Signal_State_Callback.Call_Callbacks
                       ((S     => Signal,
                         State => True));
                  elsif Inputs (L).Inputs = Successive_Inputs'(others => False)
                    and Inputs (L).Debounced = True
                  then
                     Inputs (L).Debounced := False;
                     Input_Signal_State_Callback.Call_Callbacks
                       ((S     => Signal,
                         State => False));
                  end if;
               end;
            end if;
         end loop;
      end loop;
   end Debounce_Inputs;

   task body Heartbeat is
      use type Ada.Real_Time.Time;
   begin

      --  flash for 1 second at startup
      for J in 1 .. 5 loop
         Set_Output_State (1, False);
         delay until Ada.Real_Time.Clock + Ada.Real_Time.Milliseconds (100);
         Set_Output_State (1, True);
         delay until Ada.Real_Time.Clock + Ada.Real_Time.Milliseconds (100);
      end loop;

      --  flash every second while running
      loop
         Set_Output_State (1, False);
         delay until Ada.Real_Time.Clock + Ada.Real_Time.Milliseconds (900);
         Set_Output_State (1, True);
         delay until Ada.Real_Time.Clock + Ada.Real_Time.Milliseconds (100);
      end loop;
   end Heartbeat;

   procedure Initialize is
   begin
      Configure_Inputs;
      Configure_Outputs;
      Register (new Implementation);
   end Initialize;

   procedure Configure_Inputs is
   begin
      for J in Input_Signal'Range loop
         if Input_Signal_To_Line (J).Valid then
            Enable_GPIO (Input_Signal_To_Line (J).GPIO);

            declare
               Which_GPIO : constant GPIO_Index
                 := Input_Signal_To_Line (J).GPIO;
               GPIO : GPIO_Peripheral renames
                 GPIOs (Which_GPIO).all;
               Line : constant Natural :=
                 Natural (Input_Signal_To_Line (J).Line);
            begin
               --  Don't need to configure the line as an input, because
               --  that's the default.

               --  Don't need to configure OTYPER, because the pin is an
               --  input.

               --  Don't need to configure OSPEEDR, because the pin is an
               --  input.

               --  Configure PUPDR for neither pull-up nor -down (the
               --  user pushbutton has an internal pull-down
               --  resistor). 0 => released, 1 => pushed.
               GPIO.PUPDR.Arr (Line) := 0;

               --  Enable SYSCFG's clock.
               RCC_Periph.APB2ENR.SYSCFGEN := 1;

               --  Connect the GPIO to the interrupt Line.
               declare
                  type EXTI_CR is range 0 .. 3;
                  Offset : constant EXTI_CR := EXTI_CR (Line / 4);
                  Index : constant Natural := Line mod 4;
                  GPIO_Number : constant STM32F40x.UInt4
                    := GPIO_Index'Pos (Which_GPIO);
               begin
                  case Offset is
                     when 0 =>
                        SYSCFG_Periph.EXTICR1.EXTI.Arr (Index) := GPIO_Number;
                     when 1 =>
                        SYSCFG_Periph.EXTICR2.EXTI.Arr (Index) := GPIO_Number;
                     when 2 =>
                        SYSCFG_Periph.EXTICR3.EXTI.Arr (Index) := GPIO_Number;
                     when 3 =>
                        SYSCFG_Periph.EXTICR4.EXTI.Arr (Index) := GPIO_Number;
                  end case;
               end;

               --  Then, configure EXTI on this line for falling-edge
               --  (button-release) and rising-edge (button-push).
               EXTI_Periph.FTSR.TR.Arr (Line) := 1;
               EXTI_Periph.RTSR.TR.Arr (Line) := 1;

               --  and enable interrupts on the line.
               --  EXTI_Periph.IMR.MR.Arr (Line) := 1;
            end;
         end if;
      end loop;
   end Configure_Inputs;

   procedure Configure_Outputs is
   begin
      for J in Output_Signal'Range loop
         if Output_Signal_To_Line (J).Valid then
            Enable_GPIO (Output_Signal_To_Line (J).GPIO);

            --  Configure the line as an output.
            declare
               GPIO : GPIO_Peripheral renames
                 GPIOs (Output_Signal_To_Line (J).GPIO).all;
               Line : constant Natural :=
                 Natural (Output_Signal_To_Line (J).Line);
            begin
               GPIO.MODER.Arr (Line) := 1;
            end;

            --  Don't need to configure OTYPER, because the default is
            --  push-pull.

            --  Don't need to configure OSPEEDR, because the default
            --  is slow, which is (I expect) more than adequate for an
            --  LED!

            --  Don't need to configure PUPDR, because the default is
            --  no pull-up, no pull-down.
         end if;
      end loop;
   end Configure_Outputs;

   procedure Enable_GPIO (Which : GPIO_Index) is
   begin
      case Which is
         when A => RCC_Periph.AHB1ENR.GPIOAEN := 1;
         when B => RCC_Periph.AHB1ENR.GPIOBEN := 1;
         when C => RCC_Periph.AHB1ENR.GPIOCEN := 1;
         when D => RCC_Periph.AHB1ENR.GPIODEN := 1;
         when E => RCC_Periph.AHB1ENR.GPIOEEN := 1;
         when F => RCC_Periph.AHB1ENR.GPIOFEN := 1;
         when G => RCC_Periph.AHB1ENR.GPIOGEN := 1;
         when H => RCC_Periph.AHB1ENR.GPIOHEN := 1;
         when I => RCC_Periph.AHB1ENR.GPIOIEN := 1;
      end case;
   end Enable_GPIO;


   function Get (This      : Implementation;
                 For_Input : Digital_IO_Support.Input_Signal)
                return Boolean
   is
      pragma Unreferenced (This);  -- only used for dispatching
   begin
      return Get_Input_State (For_Input);
   end Get;

   procedure Set (This       : Implementation;
                  For_Output : Digital_IO_Support.Output_Signal;
                  To         : Boolean)
   is
      pragma Unreferenced (This);  -- only used for dispatching
   begin
      Set_Output_State (For_Output, To);
   end Set;

   function Get_Input_State
     (For_Input : Digital_IO_Support.Input_Signal)
     return Boolean
   is
   begin
      if Input_Signal_To_Line (Input_Signal (For_Input)).Valid then
         declare
            Line : constant Natural :=
              Natural (Input_Signal_To_Line (Input_Signal (For_Input)).Line);
            GPIO : GPIO_Peripheral renames
              GPIOs (Input_Signal_To_Line (Input_Signal (For_Input)).GPIO).all;
            use type STM32F40x.Bit;
         begin
            --  The 'pushed' state is logic 1, because we're pulled down.
            --  XXX this should be parameterised!
            return GPIO.IDR.IDR.Arr (Line) /= 0;
         end;
      else
         return False;
      end if;
   end Get_Input_State;

   procedure Set_Output_State
     (For_Output : Digital_IO_Support.Output_Signal;
      To         : Boolean)
   is
   begin
      if Output_Signal_To_Line (Output_Signal (For_Output)).Valid then
         declare
            Line : constant Natural :=
              Natural (Output_Signal_To_Line
                         (Output_Signal (For_Output)).Line);
            GPIO : GPIO_Peripheral renames
              GPIOs (Output_Signal_To_Line
                       (Output_Signal (For_Output)).GPIO).all;
         begin
            if To then
               GPIO.BSRR.BS.Arr (Line) := 1;
            else
               GPIO.BSRR.BR.Arr (Line) := 1;
            end if;
         end;
      end if;
   end Set_Output_State;

end Digital_IO.STM32F4_Support;
