├── .gdbinit ├── .gitignore ├── .gitmodules ├── LICENSE ├── README.md ├── demo_analog_sensors.gpr ├── demo_hitechnic_gyro.gpr ├── demo_ir_receiver.gpr ├── demo_motors.gpr ├── demo_sound_pwm.gpr ├── demo_touch_sensor.gpr ├── demo_ultrasonic_sensor.gpr ├── gnat.adc └── src ├── addons ├── hitechnic │ ├── hitechnic-gyroscopic_sensor.adb │ ├── hitechnic-gyroscopic_sensor.ads │ ├── hitechnic-ir_receivers.adb │ ├── hitechnic-ir_receivers.ads │ └── hitechnic.ads └── nxt_shield │ └── nxt_shield.ads ├── components ├── bitbanged_io-softwire.adb ├── bitbanged_io-softwire.ads ├── bitbanged_io.adb ├── bitbanged_io.ads ├── discrete_inputs.adb ├── discrete_inputs.ads ├── quadrature_encoders.adb └── quadrature_encoders.ads ├── control_systems ├── process_control_floating_point.adb └── process_control_floating_point.ads ├── demos ├── analog_sensor_factory.adb ├── analog_sensor_factory.ads ├── demo_analog_sensors.adb ├── demo_hitechnic_gyro.adb ├── demo_ir_receiver.adb ├── demo_motors.adb ├── demo_sound_pwm.adb ├── demo_touch_sensor.adb ├── demo_ultrasonic_sensor.adb ├── display_ir_receiver.adb ├── hardware_configuration.ads ├── initialize_nxt_shield.adb ├── initialize_nxt_shield.ads ├── nxt-analog_sensor_calibration_lcd.adb ├── nxt-analog_sensor_calibration_lcd.ads ├── nxt-analog_sensor_utils.adb └── nxt-analog_sensor_utils.ads ├── misc ├── stm32-device-mapping_requests.adb └── stm32-device-mapping_requests.ads ├── nxt ├── motors │ ├── nxt-motors.adb │ └── nxt-motors.ads ├── nxt.ads └── sensors │ ├── nxt-analog-dma.adb │ ├── nxt-analog-dma.ads │ ├── nxt-analog-polling.adb │ ├── nxt-analog-polling.ads │ ├── nxt-analog.adb │ ├── nxt-analog.ads │ ├── nxt-digital.adb │ ├── nxt-digital.ads │ ├── nxt-light_sensors-constructors.adb │ ├── nxt-light_sensors-constructors.ads │ ├── nxt-light_sensors.adb │ ├── nxt-light_sensors.ads │ ├── nxt-sound_sensors-constructors.adb │ ├── nxt-sound_sensors-constructors.ads │ ├── nxt-sound_sensors.adb │ ├── nxt-sound_sensors.ads │ ├── nxt-touch_sensors.adb │ ├── nxt-touch_sensors.ads │ ├── nxt-ultrasonic_sensors.adb │ └── nxt-ultrasonic_sensors.ads ├── signal_processing ├── recursive_moving_average_filters_discretes.adb ├── recursive_moving_average_filters_discretes.ads ├── recursive_moving_average_filters_reals.adb ├── recursive_moving_average_filters_reals.ads ├── simple_moving_average_filters.adb ├── simple_moving_average_filters.ads ├── simple_moving_average_filters_reals.adb └── simple_moving_average_filters_reals.ads └── utils ├── math_utilities.adb ├── math_utilities.ads ├── panic.adb ├── panic.ads ├── poll_for_continuous_state.adb ├── poll_for_continuous_state.ads ├── sequential_bounded_buffers.adb └── sequential_bounded_buffers.ads /.gdbinit: -------------------------------------------------------------------------------- 1 | # This command file will cause a Cortex-M3 or -M4 board to automatically 2 | # reset immediately after a GDB "load" command executes. Note that GPS 3 | # issues that command as part of the Debug->Init menu invocation. Manual 4 | # "load" command invocations will also trigger the action. 5 | # 6 | # The reset is achieved by writing to the "Application Interrupt and Reset 7 | # Control" register located at address 0xE000ED0C. 8 | # 9 | # Both the processor and the peripherals can be reset by writing a value 10 | # of 0x05FA0004. That value will write to the SYSRESETREQ bit. If you want 11 | # to avoid resetting the peripherals, change the value to 0x05FA0001. That 12 | # value will write to the VECTRESET bit. Do *not* use a value that sets both 13 | # bits. 14 | # 15 | # In both cases, any on-board debug hardware is not reset. 16 | # 17 | # See the book "The Definitive Guide to the ARM Cortex-M3 and Cortex-M4 18 | # Processors" by Joseph Yiu, 3rd edition, pp 262-263 for further details. 19 | 20 | define hookpost-load 21 | echo Resetting the processor and peripherals...\n 22 | set *0xE000ED0C := 0x05FA0004 23 | echo Reset complete\n 24 | end -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | obj -------------------------------------------------------------------------------- /.gitmodules: -------------------------------------------------------------------------------- 1 | [submodule "Ada_Drivers_Library"] 2 | path = Ada_Drivers_Library 3 | url = https://github.com/AdaCore/Ada_Drivers_Library.git 4 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Robotics_with_Ada 2 | Robotics with Ada, ARM, and Lego 3 | 4 | This program demonstrates interfacing to Lego NXT Mindstorms sensors and 5 | effectors using Ada and low-cost ARM evaluation boards instead of the 6 | NXT Mindstorms Brick. 7 | 8 | For the touch sensor interfacing demonstration: 9 | 10 | * The program displays output to the LCD screen of an STM32F429I Discovery 11 | board, but does not rely on the specific board other than that. Make sure 12 | the project gpr file matches the target board used. 13 | 14 | * The touch sensor is expected to be connected to ground and the external 15 | circuit in an active-low configuration (per the discriminant value 16 | specified in the source code). Use the sensor's red or black wire for 17 | ground, and the white wire for the input. If a different circuit is used, 18 | providing an active-high configuration, change the discriminant accordingly. 19 | 20 | * The discrete input is to be connected from the external circuit to PB4. 21 | 22 | For the analog sensor interfacing demonstrations: 23 | 24 | * You must have a pull-up resistor for the analog input pin connected to the 25 | +5V power pin. Otherwise you will see odd input (and hence output) values. 26 | 27 | * Note that the two demonstration programs use different STM32 Discovery 28 | Kits. The project gpr files handle this difference directly, when 29 | building, but of course you must use the corresponding board for 30 | execution. The "demo_analog_sensors" demonstration uses the STM32F429I 31 | Discovery board because it displays the inputs on the kit's LCD screen. 32 | That LCD is the only real reason that particular kit is used. The other 33 | demonstration program "demo_sound_sensor" is set up to run on an STM32F4 34 | Discovery kit, because that one can drive an LED with PWM, unlike the 35 | F429I kit. Other supported STM32F4 targets with those capabilities can 36 | be used instead, with minimal changes. 37 | -------------------------------------------------------------------------------- /demo_analog_sensors.gpr: -------------------------------------------------------------------------------- 1 | with "Ada_Drivers_Library/boards/stm32f429_discovery/stm32f429_discovery.gpr"; 2 | 3 | project Demo_Analog_Sensors extends "Ada_Drivers_Library/examples/shared/common/common.gpr" is 4 | 5 | type Build_Type is ("Production", "Debug"); 6 | 7 | App_BUILD : Build_Type := external ("APP_BUILD", "Debug"); 8 | 9 | for Main use ("demo_analog_sensors"); 10 | 11 | for Runtime ("Ada") use STM32F429_Discovery'Runtime ("Ada"); 12 | 13 | for Target use "arm-eabi"; 14 | 15 | for Languages use ("Ada"); 16 | 17 | for Source_Dirs use ("src/**"); 18 | 19 | for Object_Dir use "obj/demo_analog_sensors/" & App_BUILD; 20 | 21 | App_Switches := ""; 22 | 23 | package Compiler is 24 | case App_BUILD is 25 | when "Production" => 26 | App_Switches := ("-g", "-O3", "-gnatp", "-gnatn"); 27 | when "Debug" => 28 | App_Switches := ("-g", "-O0", "-gnata", "-fcallgraph-info=su"); 29 | end case; 30 | for Default_Switches ("ada") use Compiler'Default_Switches ("Ada") & 31 | App_Switches & 32 | ("-gnatwa", "-gnatQ", "-gnatw.X", "-gnaty", "-gnatyO", "-gnatyM120", 33 | "-ffunction-sections", "-fdata-sections"); 34 | end Compiler; 35 | 36 | end Demo_Analog_Sensors; 37 | -------------------------------------------------------------------------------- /demo_hitechnic_gyro.gpr: -------------------------------------------------------------------------------- 1 | with "Ada_Drivers_Library/boards/stm32f429_discovery/stm32f429_discovery.gpr"; 2 | 3 | project Demo_Hitechnic_Gyro extends "Ada_Drivers_Library/examples/shared/common/common.gpr" is 4 | 5 | type Build_Type is ("Production", "Debug"); 6 | 7 | App_BUILD : Build_Type := external ("APP_BUILD", "Debug"); 8 | 9 | for Main use ("demo_hitechnic_gyro"); 10 | 11 | for Runtime ("Ada") use STM32F429_Discovery'Runtime ("Ada"); 12 | 13 | for Target use "arm-eabi"; 14 | 15 | for Languages use ("Ada"); 16 | 17 | for Source_Dirs use ("src/**"); 18 | 19 | for Object_Dir use "obj/demo_hitechnic_gyro/" & App_BUILD; 20 | 21 | App_Switches := ""; 22 | 23 | package Compiler is 24 | case App_BUILD is 25 | when "Production" => 26 | App_Switches := ("-g", "-O3", "-gnatp", "-gnatn"); 27 | when "Debug" => 28 | App_Switches := ("-g", "-O0", "-gnata", "-fcallgraph-info=su"); 29 | end case; 30 | for Default_Switches ("ada") use Compiler'Default_Switches ("Ada") & 31 | App_Switches & 32 | ("-gnatwa", "-gnatQ", "-gnatw.X", "-gnaty", "-gnatyO", "-gnatyM120", 33 | "-ffunction-sections", "-fdata-sections"); 34 | end Compiler; 35 | 36 | end Demo_Hitechnic_Gyro; 37 | -------------------------------------------------------------------------------- /demo_ir_receiver.gpr: -------------------------------------------------------------------------------- 1 | with "Ada_Drivers_Library/boards/stm32f407_discovery/stm32f407_discovery.gpr"; 2 | 3 | project Demo_IR_Receiver extends "Ada_Drivers_Library/examples/shared/common/common.gpr" is 4 | 5 | type Build_Type is ("Production", "Debug"); 6 | 7 | App_BUILD : Build_Type := external ("APP_BUILD", "Debug"); 8 | 9 | for Main use ("demo_ir_receiver", "display_ir_receiver"); 10 | 11 | for Runtime ("Ada") use STM32F407_Discovery'Runtime ("Ada"); 12 | 13 | for Target use "arm-eabi"; 14 | 15 | for Languages use ("Ada"); 16 | 17 | for Source_Dirs use ("src/**"); 18 | 19 | for Object_Dir use "obj/demo_ir_receiver/" & App_BUILD; 20 | 21 | App_Switches := ""; 22 | 23 | package Compiler is 24 | case App_BUILD is 25 | when "Production" => 26 | App_Switches := ("-g", "-O3", "-gnatp", "-gnatn"); 27 | when "Debug" => 28 | App_Switches := ("-g", "-O0", "-gnata", "-fcallgraph-info=su"); 29 | end case; 30 | for Default_Switches ("ada") use Compiler'Default_Switches ("Ada") & 31 | App_Switches & 32 | ("-gnatwa", "-gnatQ", "-gnatw.X", "-gnaty", "-gnatyO", "-gnatyM120", 33 | "-ffunction-sections", "-fdata-sections"); 34 | end Compiler; 35 | 36 | end Demo_IR_Receiver; 37 | -------------------------------------------------------------------------------- /demo_motors.gpr: -------------------------------------------------------------------------------- 1 | with "Ada_Drivers_Library/boards/stm32f407_discovery/stm32f407_discovery.gpr"; 2 | 3 | project Demo_Motors extends "Ada_Drivers_Library/examples/shared/common/common.gpr" is 4 | 5 | type Build_Type is ("Production", "Debug"); 6 | 7 | App_BUILD : Build_Type := external ("APP_BUILD", "Debug"); 8 | 9 | for Main use ("demo_motors.adb"); 10 | 11 | for Runtime ("Ada") use STM32F407_Discovery'Runtime ("Ada"); 12 | 13 | for Target use "arm-eabi"; 14 | 15 | for Languages use ("Ada"); 16 | 17 | for Source_Dirs use ("src/**"); 18 | 19 | for Object_Dir use "obj/demo_motors/" & App_BUILD; 20 | 21 | for Create_Missing_Dirs use "True"; 22 | 23 | App_Switches := ""; 24 | 25 | package Compiler is 26 | case App_BUILD is 27 | when "Production" => 28 | App_Switches := ("-g", "-O3", "-gnatp", "-gnatn"); 29 | when "Debug" => 30 | App_Switches := ("-g", "-O0", "-gnata", "-fcallgraph-info=su"); 31 | end case; 32 | for Default_Switches ("ada") use Compiler'Default_Switches ("Ada") & 33 | App_Switches & 34 | ("-gnatwa", "-gnatQ", "-gnatw.X", "-gnaty", "-gnatyO", "-gnatyM120", 35 | "-ffunction-sections", "-fdata-sections"); 36 | end Compiler; 37 | 38 | end Demo_Motors; 39 | -------------------------------------------------------------------------------- /demo_sound_pwm.gpr: -------------------------------------------------------------------------------- 1 | with "Ada_Drivers_Library/boards/stm32f407_discovery/stm32f407_discovery.gpr"; 2 | 3 | project Demo_Sound_PWM extends "Ada_Drivers_Library/examples/shared/common/common.gpr" is 4 | 5 | type Build_Type is ("Production", "Debug"); 6 | 7 | App_BUILD : Build_Type := external ("APP_BUILD", "Debug"); 8 | 9 | for Main use ("demo_sound_pwm"); 10 | 11 | for Runtime ("Ada") use STM32F407_Discovery'Runtime ("Ada"); 12 | 13 | for Target use "arm-eabi"; 14 | 15 | for Languages use ("Ada"); 16 | 17 | for Source_Dirs use ("src/**"); 18 | 19 | for Object_Dir use "obj/demo_sound_pwm/" & App_BUILD; 20 | 21 | App_Switches := ""; 22 | 23 | package Compiler is 24 | case App_BUILD is 25 | when "Production" => 26 | App_Switches := ("-g", "-O3", "-gnatp", "-gnatn"); 27 | when "Debug" => 28 | App_Switches := ("-g", "-O0", "-gnata", "-fcallgraph-info=su"); 29 | end case; 30 | for Default_Switches ("ada") use Compiler'Default_Switches ("Ada") & 31 | App_Switches & 32 | ("-gnatwa", "-gnatQ", "-gnatw.X", "-gnaty", "-gnatyO", "-gnatyM120", 33 | "-ffunction-sections", "-fdata-sections"); 34 | end Compiler; 35 | 36 | end Demo_Sound_PWM; 37 | -------------------------------------------------------------------------------- /demo_touch_sensor.gpr: -------------------------------------------------------------------------------- 1 | with "Ada_Drivers_Library/boards/stm32f429_discovery/stm32f429_discovery.gpr"; 2 | 3 | project Demo_Touch_Sensor extends "Ada_Drivers_Library/examples/shared/common/common.gpr" is 4 | 5 | type Build_Type is ("Production", "Debug"); 6 | 7 | App_BUILD : Build_Type := external ("APP_BUILD", "Debug"); 8 | 9 | for Main use ("demo_touch_sensor.adb"); 10 | 11 | for Runtime ("Ada") use STM32F429_Discovery'Runtime ("Ada"); 12 | 13 | for Target use "arm-eabi"; 14 | 15 | for Languages use ("Ada"); 16 | 17 | for Source_Dirs use ("src/**"); 18 | 19 | for Object_Dir use "obj/demo_touch_sensor/" & App_BUILD; 20 | 21 | for Create_Missing_Dirs use "True"; 22 | 23 | App_Switches := ""; 24 | 25 | package Compiler is 26 | case App_BUILD is 27 | when "Production" => 28 | App_Switches := ("-g", "-O3", "-gnatp", "-gnatn"); 29 | when "Debug" => 30 | App_Switches := ("-g", "-O0", "-gnata", "-fcallgraph-info=su"); 31 | end case; 32 | for Default_Switches ("ada") use Compiler'Default_Switches ("Ada") & 33 | App_Switches & 34 | ("-gnatwa", "-gnatQ", "-gnatw.X", "-gnaty", "-gnatyO", "-gnatyM120", 35 | "-ffunction-sections", "-fdata-sections"); 36 | end Compiler; 37 | 38 | end Demo_Touch_Sensor; 39 | -------------------------------------------------------------------------------- /demo_ultrasonic_sensor.gpr: -------------------------------------------------------------------------------- 1 | with "Ada_Drivers_Library/boards/stm32f407_discovery/stm32f407_discovery.gpr"; 2 | 3 | project Demo_Ultrasonic_Sensor extends "Ada_Drivers_Library/examples/shared/common/common.gpr" is 4 | 5 | type Build_Type is ("Production", "Debug"); 6 | 7 | App_BUILD : Build_Type := external ("APP_BUILD", "Debug"); 8 | 9 | for Main use ("demo_ultrasonic_sensor"); 10 | 11 | for Runtime ("Ada") use STM32F407_Discovery'Runtime ("Ada"); 12 | 13 | for Target use "arm-eabi"; 14 | 15 | for Languages use ("Ada"); 16 | 17 | for Source_Dirs use ("src/**"); 18 | 19 | for Object_Dir use "obj/demo_ultrasonic_sensor/" & App_BUILD; 20 | 21 | App_Switches := ""; 22 | 23 | package Compiler is 24 | case App_BUILD is 25 | when "Production" => 26 | App_Switches := ("-g", "-O3", "-gnatp", "-gnatn"); 27 | when "Debug" => 28 | App_Switches := ("-g", "-O0", "-gnata", "-fcallgraph-info=su"); 29 | end case; 30 | for Default_Switches ("ada") use Compiler'Default_Switches ("Ada") & 31 | App_Switches & 32 | ("-gnatwa", "-gnatQ", "-gnatw.X", "-gnaty", "-gnatyO", "-gnatyM120", 33 | "-ffunction-sections", "-fdata-sections"); 34 | end Compiler; 35 | 36 | end Demo_Ultrasonic_Sensor; 37 | -------------------------------------------------------------------------------- /gnat.adc: -------------------------------------------------------------------------------- 1 | -- pragma Profile (GNAT_Extended_Ravenscar); 2 | 3 | pragma Partition_Elaboration_Policy (Sequential); 4 | 5 | -------------------------------------------------------------------------------- /src/addons/hitechnic/hitechnic-gyroscopic_sensor.adb: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------ 2 | -- -- 3 | -- Copyright (C) 2017, AdaCore -- 4 | -- -- 5 | -- Redistribution and use in source and binary forms, with or without -- 6 | -- modification, are permitted provided that the following conditions are -- 7 | -- met: -- 8 | -- 1. Redistributions of source code must retain the above copyright -- 9 | -- notice, this list of conditions and the following disclaimer. -- 10 | -- 2. Redistributions in binary form must reproduce the above copyright -- 11 | -- notice, this list of conditions and the following disclaimer in -- 12 | -- the documentation and/or other materials provided with the -- 13 | -- distribution. -- 14 | -- 3. Neither the name of STMicroelectronics nor the names of its -- 15 | -- contributors may be used to endorse or promote products derived -- 16 | -- from this software without specific prior written permission. -- 17 | -- -- 18 | -- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -- 19 | -- "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -- 20 | -- LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR -- 21 | -- A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -- 22 | -- HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, -- 23 | -- SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -- 24 | -- LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, -- 25 | -- DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -- 26 | -- THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT -- 27 | -- (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE -- 28 | -- OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -- 29 | -- -- 30 | ------------------------------------------------------------------------------ 31 | 32 | package body HiTechnic.Gyroscopic_Sensor is 33 | 34 | --------------- 35 | -- Configure -- 36 | --------------- 37 | 38 | procedure Configure 39 | (This : in out Gyro_Sensor; 40 | Converter : not null access Analog_To_Digital_Converter; 41 | Input_Channel : Analog_Input_Channel; 42 | Input_Pin : GPIO_Point) 43 | is 44 | begin 45 | This.Assign_ADC (Converter, Input_Channel, Input_Pin); 46 | Initialize (NXT_Analog_Sensor_Polled (This)); 47 | end Configure; 48 | 49 | --------------- 50 | -- Calibrate -- 51 | --------------- 52 | 53 | procedure Calibrate 54 | (This : in out Gyro_Sensor; 55 | Sampling_Interval : Time_Span) 56 | is 57 | Total : Integer := 0; 58 | Sample_Count : Integer := 0; 59 | Deadline : constant Time := Clock + Sampling_Interval; 60 | Reading : Integer; 61 | Unused : Boolean; 62 | begin 63 | while Clock <= Deadline loop 64 | This.Get_Raw_Reading (Reading, Successful => Unused); 65 | Total := Total + Reading; 66 | Sample_Count := Sample_Count + 1; 67 | end loop; 68 | This.Offset := Total / Sample_Count; 69 | end Calibrate; 70 | 71 | ----------------------- 72 | -- Reset_Calibration -- 73 | ----------------------- 74 | 75 | procedure Reset_Calibration (This : in out Gyro_Sensor) is 76 | begin 77 | This.Offset := 0; 78 | end Reset_Calibration; 79 | 80 | ------------- 81 | -- Reading -- 82 | ------------- 83 | 84 | function Reading (This : in out Gyro_Sensor) return Integer is 85 | Sample : Integer; 86 | Unused : Boolean; 87 | begin 88 | This.Get_Raw_Reading (Sample, Successful => Unused); 89 | return Sample - This.Offset; 90 | end Reading; 91 | 92 | end HiTechnic.Gyroscopic_Sensor; 93 | -------------------------------------------------------------------------------- /src/addons/hitechnic/hitechnic-gyroscopic_sensor.ads: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------ 2 | -- -- 3 | -- Copyright (C) 2017, AdaCore -- 4 | -- -- 5 | -- Redistribution and use in source and binary forms, with or without -- 6 | -- modification, are permitted provided that the following conditions are -- 7 | -- met: -- 8 | -- 1. Redistributions of source code must retain the above copyright -- 9 | -- notice, this list of conditions and the following disclaimer. -- 10 | -- 2. Redistributions in binary form must reproduce the above copyright -- 11 | -- notice, this list of conditions and the following disclaimer in -- 12 | -- the documentation and/or other materials provided with the -- 13 | -- distribution. -- 14 | -- 3. Neither the name of STMicroelectronics nor the names of its -- 15 | -- contributors may be used to endorse or promote products derived -- 16 | -- from this software without specific prior written permission. -- 17 | -- -- 18 | -- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -- 19 | -- "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -- 20 | -- LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR -- 21 | -- A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -- 22 | -- HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, -- 23 | -- SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -- 24 | -- LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, -- 25 | -- DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -- 26 | -- THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT -- 27 | -- (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE -- 28 | -- OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -- 29 | -- -- 30 | ------------------------------------------------------------------------------ 31 | 32 | -- This package provides an interface to the HiTechnic Gyroscopic sensor 33 | 34 | with STM32.ADC; use STM32.ADC; 35 | with STM32.GPIO; use STM32.GPIO; 36 | with Ada.Real_Time; use Ada.Real_Time; 37 | 38 | private with NXT.Analog.Polling; 39 | 40 | package HiTechnic.Gyroscopic_Sensor is 41 | 42 | type Gyro_Sensor is tagged limited private; 43 | 44 | procedure Configure 45 | (This : in out Gyro_Sensor; 46 | Converter : not null access Analog_To_Digital_Converter; 47 | Input_Channel : Analog_Input_Channel; 48 | Input_Pin : GPIO_Point); 49 | 50 | procedure Calibrate 51 | (This : in out Gyro_Sensor; 52 | Sampling_Interval : Time_Span); 53 | -- Takes samples over the sampling interval and assigns the average to the 54 | -- offset for this sensor. The offset is the sensor reading when the sensor 55 | -- is at rest. 56 | 57 | function Reading (This : in out Gyro_Sensor) return Integer; 58 | -- Returns the current raw reading minus the calibrated offset. If the 59 | -- sensor is not calibrated, the offset is zero and so the effect is to 60 | -- get the raw reading. 61 | 62 | procedure Reset_Calibration (This : in out Gyro_Sensor); 63 | -- The gyro's offset is set to zero (the initial value) 64 | 65 | private 66 | 67 | use NXT.Analog.Polling; 68 | 69 | type Gyro_Sensor is new NXT_Analog_Sensor_Polled with record 70 | Offset : Integer := 0; -- the value when the sensor is at rest 71 | end record; 72 | 73 | end HiTechnic.Gyroscopic_Sensor; 74 | -------------------------------------------------------------------------------- /src/addons/hitechnic/hitechnic-ir_receivers.adb: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------ 2 | -- -- 3 | -- Copyright (C) 2018, AdaCore -- 4 | -- -- 5 | -- Redistribution and use in source and binary forms, with or without -- 6 | -- modification, are permitted provided that the following conditions are -- 7 | -- met: -- 8 | -- 1. Redistributions of source code must retain the above copyright -- 9 | -- notice, this list of conditions and the following disclaimer. -- 10 | -- 2. Redistributions in binary form must reproduce the above copyright -- 11 | -- notice, this list of conditions and the following disclaimer in -- 12 | -- the documentation and/or other materials provided with the -- 13 | -- distribution. -- 14 | -- 3. Neither the name of STMicroelectronics nor the names of its -- 15 | -- contributors may be used to endorse or promote products derived -- 16 | -- from this software without specific prior written permission. -- 17 | -- -- 18 | -- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -- 19 | -- "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -- 20 | -- LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR -- 21 | -- A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -- 22 | -- HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, -- 23 | -- SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -- 24 | -- LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, -- 25 | -- DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -- 26 | -- THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT -- 27 | -- (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE -- 28 | -- OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -- 29 | -- -- 30 | ------------------------------------------------------------------------------ 31 | with Ada.Unchecked_Conversion; 32 | with HAL; use HAL; 33 | 34 | package body HiTechnic.IR_Receivers is 35 | 36 | function As_Switch_Value is new Ada.Unchecked_Conversion 37 | (Source => UInt8, Target => Switch_Value); 38 | 39 | ------------------ 40 | -- Get_Raw_Data -- 41 | ------------------ 42 | 43 | procedure Get_Raw_Data 44 | (This : in out IR_Receiver; 45 | Data : out Raw_Sensor_Data; 46 | IO_Successful : out Boolean) 47 | is 48 | Response : Sequence (1 .. 8); 49 | begin 50 | This.Read_Register (Data_Registers, Response, IO_Successful); 51 | -- reading the one register will reply with multiple bytes in response 52 | if IO_Successful then 53 | Data.A (1) := As_Switch_Value (Response (1)); 54 | Data.B (1) := As_Switch_Value (Response (2)); 55 | Data.A (2) := As_Switch_Value (Response (3)); 56 | Data.B (2) := As_Switch_Value (Response (4)); 57 | Data.A (3) := As_Switch_Value (Response (5)); 58 | Data.B (3) := As_Switch_Value (Response (6)); 59 | Data.A (4) := As_Switch_Value (Response (7)); 60 | Data.B (4) := As_Switch_Value (Response (8)); 61 | else 62 | Data := (others => (others => 0)); 63 | end if; 64 | end Get_Raw_Data; 65 | 66 | end HiTechnic.IR_Receivers; 67 | -------------------------------------------------------------------------------- /src/addons/hitechnic/hitechnic-ir_receivers.ads: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------ 2 | -- -- 3 | -- Copyright (C) 2018, AdaCore -- 4 | -- -- 5 | -- Redistribution and use in source and binary forms, with or without -- 6 | -- modification, are permitted provided that the following conditions are -- 7 | -- met: -- 8 | -- 1. Redistributions of source code must retain the above copyright -- 9 | -- notice, this list of conditions and the following disclaimer. -- 10 | -- 2. Redistributions in binary form must reproduce the above copyright -- 11 | -- notice, this list of conditions and the following disclaimer in -- 12 | -- the documentation and/or other materials provided with the -- 13 | -- distribution. -- 14 | -- 3. Neither the name of STMicroelectronics nor the names of its -- 15 | -- contributors may be used to endorse or promote products derived -- 16 | -- from this software without specific prior written permission. -- 17 | -- -- 18 | -- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -- 19 | -- "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -- 20 | -- LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR -- 21 | -- A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -- 22 | -- HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, -- 23 | -- SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -- 24 | -- LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, -- 25 | -- DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -- 26 | -- THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT -- 27 | -- (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE -- 28 | -- OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -- 29 | -- -- 30 | ------------------------------------------------------------------------------ 31 | 32 | -- This package provides a device driver for the HiTechNic IR Receiver sensor 33 | -- used with Lego NXT robotics kits: 34 | -- 35 | -- http://www.hitechnic.com/cgi-bin/commerce.cgi?preadd=action&key=nir1032 36 | 37 | with NXT.Digital; use NXT.Digital; 38 | with Interfaces; 39 | 40 | package HiTechnic.IR_Receivers is 41 | 42 | type IR_Receiver is new NXT_Digital_Sensor with private; 43 | 44 | type Channel_Id is range 1 .. 4; 45 | 46 | type Switch_Value is new Interfaces.Integer_8; 47 | 48 | type Raw_Sensor_Values is array (Channel_Id) of Switch_Value; 49 | 50 | type Raw_Sensor_Data is record 51 | A : Raw_Sensor_Values; 52 | B : Raw_Sensor_Values; 53 | end record; 54 | 55 | procedure Get_Raw_Data 56 | (This : in out IR_Receiver; 57 | Data : out Raw_Sensor_Data; 58 | IO_Successful : out Boolean) 59 | with 60 | Post => (if not IO_Successful then Data = (others => (others => 0))); 61 | -- Note that when True, IO_Successful does not necessarily imply valid 62 | -- data, but when False the data are definitely not current. 63 | 64 | private 65 | 66 | type IR_Receiver is new NXT_Digital_Sensor with null record; 67 | 68 | Data_Registers : constant Register_Address := 16#42#; 69 | 70 | end HiTechnic.IR_Receivers; 71 | -------------------------------------------------------------------------------- /src/addons/hitechnic/hitechnic.ads: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------ 2 | -- -- 3 | -- Copyright (C) 2017, AdaCore -- 4 | -- -- 5 | -- Redistribution and use in source and binary forms, with or without -- 6 | -- modification, are permitted provided that the following conditions are -- 7 | -- met: -- 8 | -- 1. Redistributions of source code must retain the above copyright -- 9 | -- notice, this list of conditions and the following disclaimer. -- 10 | -- 2. Redistributions in binary form must reproduce the above copyright -- 11 | -- notice, this list of conditions and the following disclaimer in -- 12 | -- the documentation and/or other materials provided with the -- 13 | -- distribution. -- 14 | -- 3. Neither the name of STMicroelectronics nor the names of its -- 15 | -- contributors may be used to endorse or promote products derived -- 16 | -- from this software without specific prior written permission. -- 17 | -- -- 18 | -- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -- 19 | -- "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -- 20 | -- LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR -- 21 | -- A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -- 22 | -- HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, -- 23 | -- SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -- 24 | -- LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, -- 25 | -- DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -- 26 | -- THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT -- 27 | -- (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE -- 28 | -- OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -- 29 | -- -- 30 | ------------------------------------------------------------------------------ 31 | 32 | package HiTechnic is 33 | pragma Pure; 34 | end HiTechnic; 35 | -------------------------------------------------------------------------------- /src/addons/nxt_shield/nxt_shield.ads: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------ 2 | -- -- 3 | -- Copyright (C) 2017-2018, AdaCore -- 4 | -- -- 5 | -- Redistribution and use in source and binary forms, with or without -- 6 | -- modification, are permitted provided that the following conditions are -- 7 | -- met: -- 8 | -- 1. Redistributions of source code must retain the above copyright -- 9 | -- notice, this list of conditions and the following disclaimer. -- 10 | -- 2. Redistributions in binary form must reproduce the above copyright -- 11 | -- notice, this list of conditions and the following disclaimer in -- 12 | -- the documentation and/or other materials provided with the -- 13 | -- distribution. -- 14 | -- 3. Neither the name of the copyright holder nor the names of its -- 15 | -- contributors may be used to endorse or promote products derived -- 16 | -- from this software without specific prior written permission. -- 17 | -- -- 18 | -- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -- 19 | -- "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -- 20 | -- LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR -- 21 | -- A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -- 22 | -- HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, -- 23 | -- SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -- 24 | -- LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, -- 25 | -- DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -- 26 | -- THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT -- 27 | -- (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE -- 28 | -- OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -- 29 | -- -- 30 | ------------------------------------------------------------------------------ 31 | 32 | -- This package provides an interface to the "NXT Shield Version 2" produced 33 | -- by TKJ Electronics. 34 | -- 35 | -- http://blog.tkjelectronics.dk/2011/10/nxt-shield-ver2/ 36 | -- http://shop.tkjelectronics.dk/product_info.php?products_id=29 37 | 38 | with NXT.Motors; use NXT.Motors; 39 | with NXT.Ultrasonic_Sensors; use NXT.Ultrasonic_Sensors; 40 | 41 | package NXT_Shield is 42 | 43 | Motor1 : Basic_Motor; 44 | Motor2 : Basic_Motor; 45 | 46 | Sonar : Ultrasonic_Sonar_Sensor (Hardware_Device_Address => 1); 47 | 48 | end NXT_Shield; 49 | -------------------------------------------------------------------------------- /src/components/bitbanged_io-softwire.ads: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------ 2 | -- -- 3 | -- Copyright (C) 2018-2022, AdaCore -- 4 | -- -- 5 | -- Redistribution and use in source and binary forms, with or without -- 6 | -- modification, are permitted provided that the following conditions are -- 7 | -- met: -- 8 | -- 1. Redistributions of source code must retain the above copyright -- 9 | -- notice, this list of conditions and the following disclaimer. -- 10 | -- 2. Redistributions in binary form must reproduce the above copyright -- 11 | -- notice, this list of conditions and the following disclaimer in -- 12 | -- the documentation and/or other materials provided with the -- 13 | -- distribution. -- 14 | -- 3. Neither the name of STMicroelectronics nor the names of its -- 15 | -- contributors may be used to endorse or promote products derived -- 16 | -- from this software without specific prior written permission. -- 17 | -- -- 18 | -- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -- 19 | -- "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -- 20 | -- LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR -- 21 | -- A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -- 22 | -- HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, -- 23 | -- SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -- 24 | -- LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, -- 25 | -- DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -- 26 | -- THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT -- 27 | -- (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE -- 28 | -- OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -- 29 | -- -- 30 | ------------------------------------------------------------------------------ 31 | 32 | -- This package provides an interface to bit-banged I2C based on the Arduino 33 | -- Wire API and the Softwire implementation found here: 34 | -- https://github.com/felias-fogg/SoftI2CMaster/blob/master/SoftWire.h 35 | 36 | package BitBanged_IO.SoftWire is 37 | 38 | type I2C_Master is new BitBanged_IO.Port with private; 39 | 40 | procedure Initialize 41 | (This : in out I2C_Master; 42 | Data_Line : GPIO_Point; 43 | Clock_Line : GPIO_Point; 44 | Clock_Frequency : UInt32; 45 | Success : out Boolean) 46 | with Post => Initialized (This); 47 | -- Success will be true iff Clock_line and Data_Line are both high as a 48 | -- result of the initialization steps. 49 | 50 | function Initialized (This : I2C_Master) return Boolean; 51 | 52 | procedure Begin_Transmission 53 | (This : in out I2C_Master; 54 | Device_Address : UInt8; 55 | Acknowledged : out Boolean) 56 | with Pre => Initialized (This); 57 | 58 | procedure End_Transmission 59 | (This : in out I2C_Master; 60 | Send_Stop : Boolean := True) 61 | with Pre => Initialized (This); 62 | 63 | procedure Write 64 | (This : in out I2C_Master; 65 | Output : UInt8; 66 | Acknowledged : out Boolean) 67 | with Pre => Initialized (This); 68 | 69 | type Sequence is array (Positive range <>) of UInt8; 70 | 71 | procedure Write 72 | (This : in out I2C_Master; 73 | Output : Sequence; 74 | Acknowledged : out Boolean) 75 | with Pre => Initialized (This); 76 | 77 | procedure Request_From 78 | (This : in out I2C_Master; 79 | Device_Address : UInt8; 80 | Buffer : out Sequence; 81 | Quantity : Positive; 82 | Acknowledged : out Boolean; 83 | Send_Stop : Boolean := True) 84 | with Pre => Initialized (This); 85 | 86 | procedure Request_From 87 | (This : in out I2C_Master; 88 | Device_Address : UInt8; 89 | Register_Address : UInt8; 90 | Buffer : out Sequence; 91 | Quantity : Positive; 92 | Acknowledged : out Boolean; 93 | Send_Stop : Boolean := True) 94 | with Pre => Initialized (This); 95 | 96 | private 97 | 98 | Ack : constant := 0; 99 | NAck : constant := 1; 100 | 101 | type I2C_Master is new BitBanged_IO.Port with record 102 | Initialized : Boolean := False; 103 | Transmitting : Boolean := False; 104 | end record; 105 | 106 | type Master_IO_Roles is (Transmitter, Receiver); 107 | 108 | procedure Write_7Bit_Address 109 | (This : in out I2C_Master; 110 | Device_Address : UInt8; 111 | Role : Master_IO_Roles); 112 | -- NB: we don't shift the address into the upper 7 bits, the user must 113 | -- do so beforehand. 114 | 115 | procedure Start 116 | (This : in out I2C_Master; 117 | Device_Address : UInt8; 118 | Role : Master_IO_Roles; 119 | Acknowledged : out Boolean); 120 | 121 | procedure Stop (This : in out I2C_Master); 122 | 123 | procedure Restart 124 | (This : in out I2C_Master; 125 | Device_Address : UInt8; 126 | Role : Master_IO_Roles; 127 | Acknowledged : out Boolean); 128 | 129 | procedure Read (This : in out I2C_Master; Value : out UInt8) 130 | with Pre => Initialized (This); 131 | -- sends an Ack after reading byte 132 | 133 | procedure Read_Last (This : in out I2C_Master; Value : out UInt8) 134 | with Pre => Initialized (This); 135 | -- sends an NAck after reading byte 136 | 137 | function Initialized (This : I2C_Master) return Boolean is 138 | (This.Initialized); 139 | 140 | end BitBanged_IO.SoftWire; 141 | -------------------------------------------------------------------------------- /src/components/discrete_inputs.adb: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------ 2 | -- -- 3 | -- Copyright (C) 2017, AdaCore -- 4 | -- -- 5 | -- Redistribution and use in source and binary forms, with or without -- 6 | -- modification, are permitted provided that the following conditions are -- 7 | -- met: -- 8 | -- 1. Redistributions of source code must retain the above copyright -- 9 | -- notice, this list of conditions and the following disclaimer. -- 10 | -- 2. Redistributions in binary form must reproduce the above copyright -- 11 | -- notice, this list of conditions and the following disclaimer in -- 12 | -- the documentation and/or other materials provided with the -- 13 | -- distribution. -- 14 | -- 3. Neither the name of STMicroelectronics nor the names of its -- 15 | -- contributors may be used to endorse or promote products derived -- 16 | -- from this software without specific prior written permission. -- 17 | -- -- 18 | -- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -- 19 | -- "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -- 20 | -- LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR -- 21 | -- A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -- 22 | -- HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, -- 23 | -- SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -- 24 | -- LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, -- 25 | -- DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -- 26 | -- THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT -- 27 | -- (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE -- 28 | -- OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -- 29 | -- -- 30 | ------------------------------------------------------------------------------ 31 | 32 | with STM32.Device; use STM32.Device; 33 | 34 | with Poll_For_Continuous_State; 35 | 36 | package body Discrete_Inputs is 37 | 38 | --------------------- 39 | -- Poll_For_Active -- 40 | --------------------- 41 | 42 | procedure Poll_For_Active is new Poll_For_Continuous_State 43 | (Input => Discrete_Input, 44 | In_Target_State => Active_Indicated) 45 | with Inline; 46 | 47 | ------------------ 48 | -- Await_Active -- 49 | ------------------ 50 | 51 | procedure Await_Active 52 | (This : Discrete_Input; 53 | Debounce_Time : Time_Span := Default_Debounce_Time) 54 | renames Poll_For_Active; 55 | 56 | ----------------------- 57 | -- Poll_For_Inactive -- 58 | ----------------------- 59 | 60 | procedure Poll_For_Inactive is new Poll_For_Continuous_State 61 | (Input => Discrete_Input, 62 | In_Target_State => Inactive_Indicated) 63 | with Inline; 64 | 65 | -------------------- 66 | -- Await_Inactive -- 67 | -------------------- 68 | 69 | procedure Await_Inactive 70 | (This : Discrete_Input; 71 | Debounce_Time : Time_Span := Default_Debounce_Time) 72 | renames Poll_For_Inactive; 73 | 74 | ------------------------- 75 | -- Initialize_Hardware -- 76 | ------------------------- 77 | 78 | procedure Initialize_Hardware (This : in out Discrete_Input) is 79 | Config : GPIO_Port_Configuration; 80 | begin 81 | Enable_Clock (This.Pin.all); 82 | 83 | Config := (Mode_In, Resistors => (if This.Active = High then Pull_Down else Pull_Up)); 84 | This.Pin.Configure_IO (Config); 85 | end Initialize_Hardware; 86 | 87 | end Discrete_Inputs; 88 | -------------------------------------------------------------------------------- /src/components/discrete_inputs.ads: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------ 2 | -- -- 3 | -- Copyright (C) 2017, AdaCore -- 4 | -- -- 5 | -- Redistribution and use in source and binary forms, with or without -- 6 | -- modification, are permitted provided that the following conditions are -- 7 | -- met: -- 8 | -- 1. Redistributions of source code must retain the above copyright -- 9 | -- notice, this list of conditions and the following disclaimer. -- 10 | -- 2. Redistributions in binary form must reproduce the above copyright -- 11 | -- notice, this list of conditions and the following disclaimer in -- 12 | -- the documentation and/or other materials provided with the -- 13 | -- distribution. -- 14 | -- 3. Neither the name of STMicroelectronics nor the names of its -- 15 | -- contributors may be used to endorse or promote products derived -- 16 | -- from this software without specific prior written permission. -- 17 | -- -- 18 | -- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -- 19 | -- "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -- 20 | -- LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR -- 21 | -- A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -- 22 | -- HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, -- 23 | -- SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -- 24 | -- LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, -- 25 | -- DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -- 26 | -- THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT -- 27 | -- (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE -- 28 | -- OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -- 29 | -- -- 30 | ------------------------------------------------------------------------------ 31 | 32 | with STM32.GPIO; use STM32.GPIO; 33 | with Ada.Real_Time; use Ada.Real_Time; 34 | 35 | package Discrete_Inputs is 36 | 37 | type Logic_Levels is (Low, High); 38 | 39 | type Discrete_Input (Pin : access GPIO_Point; Active : Logic_Levels) is 40 | tagged private; 41 | -- If Active is High, a non-zero voltage will be read on Pin when the input 42 | -- is considered "active". The GPIO pin will read as being "set" in that 43 | -- case. In contrast, when Active is Low, the input is active when there is 44 | -- no voltage present on Pin. The GPIO pin will read as not "set" in that 45 | -- case. Whether Active should be specified as High or Low depends on the 46 | -- electronic circuit connected to the pin. 47 | 48 | procedure Initialize_Hardware (This : in out Discrete_Input); 49 | -- To be called prior to use. Enables the GPIO pin etc. 50 | 51 | function Active_Indicated (This : Discrete_Input) return Boolean is 52 | ((This.Active = High and then This.Pin.Set) or else 53 | (This.Active = Low and then not This.Pin.Set)) 54 | with Inline; 55 | -- This routine reflects whether the pin is currently active, based on 56 | -- the corresponding logic level. Note this result is not debounced! The 57 | -- returned value can fluctuate over successive calls as the pin's input 58 | -- voltage changes, for example due to a button attached to the input being 59 | -- pressed or released. Therefore the pin is not necessarily active or 60 | -- inactive solely based upon what this function returns, hence the name. 61 | -- We consider it truly (in)active only if debounced: when the pin remains 62 | -- in one state or the other over some "debounce time interval" applied. We 63 | -- make the routine visible for the sake of users writing other routines, 64 | -- e.g., interrupt handlers, that need to interrogate the status of inputs. 65 | 66 | function Inactive_Indicated (This : Discrete_Input) return Boolean is 67 | (not Active_Indicated (This)) 68 | with Inline; 69 | -- Exactly as above, but for the inactive state. 70 | 71 | Default_Debounce_Time : Time_Span := Milliseconds (75); 72 | -- The default amount of time used to debounce an input pin. It is passed 73 | -- to calls to the routines below as the default initial value, so changing 74 | -- this value at run-time is a convenient way to change the default 75 | -- globally. Note that any individual call can specify an actual for 76 | -- the parameter so any call can override this default. 77 | -- 78 | -- This value is tunable. Too large a value will reduce the ability to 79 | -- detect events (e.g., button presses) that occur quickly. Too small a 80 | -- value will prevent the debouncing logic from working. 81 | 82 | procedure Await_Active 83 | (This : Discrete_Input; 84 | Debounce_Time : Time_Span := Default_Debounce_Time); 85 | -- Wait until Active_Indicated is True for at least the interval of 86 | -- Debounce_Time. Note that it uses polling. 87 | 88 | procedure Await_Inactive 89 | (This : Discrete_Input; 90 | Debounce_Time : Time_Span := Default_Debounce_Time); 91 | -- Wait until Active_Indicated is False for at least the interval of 92 | -- Debounce_Time. Note that it uses polling. 93 | 94 | private 95 | 96 | type Discrete_Input (Pin : access GPIO_Point; Active : Logic_Levels) is 97 | tagged null record; 98 | 99 | end Discrete_Inputs; 100 | -------------------------------------------------------------------------------- /src/components/quadrature_encoders.adb: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------ 2 | -- -- 3 | -- Copyright (C) 2017, AdaCore -- 4 | -- -- 5 | -- Redistribution and use in source and binary forms, with or without -- 6 | -- modification, are permitted provided that the following conditions are -- 7 | -- met: -- 8 | -- 1. Redistributions of source code must retain the above copyright -- 9 | -- notice, this list of conditions and the following disclaimer. -- 10 | -- 2. Redistributions in binary form must reproduce the above copyright -- 11 | -- notice, this list of conditions and the following disclaimer in -- 12 | -- the documentation and/or other materials provided with the -- 13 | -- distribution. -- 14 | -- 3. Neither the name of the copyright holder nor the names of its -- 15 | -- contributors may be used to endorse or promote products derived -- 16 | -- from this software without specific prior written permission. -- 17 | -- -- 18 | -- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -- 19 | -- "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -- 20 | -- LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR -- 21 | -- A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -- 22 | -- HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, -- 23 | -- SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -- 24 | -- LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, -- 25 | -- DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -- 26 | -- THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT -- 27 | -- (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE -- 28 | -- OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -- 29 | -- -- 30 | ------------------------------------------------------------------------------ 31 | 32 | with STM32.Device; use STM32.Device; 33 | with System; use System; 34 | with STM32_SVD; use STM32_SVD; 35 | 36 | package body Quadrature_Encoders is 37 | 38 | ----------------------- 39 | -- Current_Direction -- 40 | ----------------------- 41 | 42 | function Current_Direction (This : Rotary_Encoder) return Counting_Direction is 43 | begin 44 | case Current_Counter_Mode (This.all) is 45 | when Up => return Up; 46 | when Down => return Down; 47 | when others => raise Program_Error; 48 | end case; 49 | end Current_Direction; 50 | 51 | ----------------- 52 | -- Reset_Count -- 53 | ----------------- 54 | 55 | procedure Reset_Count (This : in out Rotary_Encoder) is 56 | begin 57 | Set_Counter (This.all, UInt16'(0)); 58 | end Reset_Count; 59 | 60 | ------------------- 61 | -- Current_Count -- 62 | ------------------- 63 | 64 | function Current_Count (This : Rotary_Encoder) return UInt32 is 65 | begin 66 | return Current_Counter (This.all); 67 | end Current_Count; 68 | 69 | ---------------- 70 | -- Initialize -- 71 | ---------------- 72 | 73 | procedure Initialize_Encoder 74 | (This : in out Rotary_Encoder; 75 | Encoder_TI1 : GPIO_Point; 76 | Encoder_TI2 : GPIO_Point; 77 | Encoder_Timer : not null access Timer; 78 | Encoder_AF : GPIO_Alternate_Function) 79 | is 80 | Configuration : GPIO_Port_Configuration; 81 | 82 | Debounce_Filter : constant Timer_Input_Capture_Filter := 6; 83 | -- See the STM32 RM, pg 561, re: ICXF, to set the input filtering. 84 | 85 | Period : constant UInt32 := (if Has_32bit_Counter (Encoder_Timer.all) 86 | then UInt32'Last else UInt32 (UInt16'Last)); 87 | begin 88 | This := Rotary_Encoder (Encoder_Timer); 89 | 90 | Enable_Clock (Encoder_TI1); 91 | Enable_Clock (Encoder_TI2); 92 | Enable_Clock (Encoder_Timer.all); 93 | 94 | Configuration := (Mode => Mode_AF, 95 | Resistors => Pull_Up, 96 | AF => Encoder_AF, 97 | AF_Output_Type => Push_Pull, 98 | AF_Speed => Speed_100MHz); 99 | 100 | Encoder_TI1.Configure_IO (Configuration); 101 | Encoder_TI2.Configure_IO (Configuration); 102 | 103 | Encoder_TI1.Lock; 104 | Encoder_TI2.Lock; 105 | 106 | Configure 107 | (Encoder_Timer.all, 108 | Prescaler => 0, 109 | Period => Period, 110 | Clock_Divisor => Div1, 111 | Counter_Mode => Up); 112 | 113 | Configure_Encoder_Interface 114 | (Encoder_Timer.all, 115 | Mode => Encoder_Mode_TI1_TI2, 116 | IC1_Polarity => Rising, 117 | IC2_Polarity => Rising); 118 | 119 | Configure_Channel_Input 120 | (Encoder_Timer.all, 121 | Channel => Channel_1, 122 | Polarity => Rising, 123 | Selection => Direct_TI, 124 | Prescaler => Div1, 125 | Filter => Debounce_Filter); 126 | 127 | Configure_Channel_Input 128 | (Encoder_Timer.all, 129 | Channel => Channel_2, 130 | Polarity => Rising, 131 | Selection => Direct_TI, 132 | Prescaler => Div1, 133 | Filter => Debounce_Filter); 134 | 135 | Set_Autoreload (Encoder_Timer.all, Period); 136 | 137 | Enable_Channel (Encoder_Timer.all, Channel_1); 138 | Enable_Channel (Encoder_Timer.all, Channel_2); 139 | 140 | if Has_32bit_Counter (Encoder_Timer.all) then 141 | Set_Counter (Encoder_Timer.all, UInt32'(0)); 142 | else 143 | Set_Counter (Encoder_Timer.all, UInt16'(0)); 144 | end if; 145 | 146 | Enable (Encoder_Timer.all); 147 | end Initialize_Encoder; 148 | 149 | ------------------- 150 | -- Bidirectional -- 151 | ------------------- 152 | 153 | function Bidirectional (This : Timer) return Boolean is 154 | (This'Address = TIM1_Base or 155 | This'Address = TIM2_Base or 156 | This'Address = TIM3_Base or 157 | This'Address = TIM4_Base or 158 | This'Address = TIM5_Base or 159 | This'Address = TIM8_Base); 160 | 161 | end Quadrature_Encoders; 162 | -------------------------------------------------------------------------------- /src/components/quadrature_encoders.ads: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------ 2 | -- -- 3 | -- Copyright (C) 2017, AdaCore -- 4 | -- -- 5 | -- Redistribution and use in source and binary forms, with or without -- 6 | -- modification, are permitted provided that the following conditions are -- 7 | -- met: -- 8 | -- 1. Redistributions of source code must retain the above copyright -- 9 | -- notice, this list of conditions and the following disclaimer. -- 10 | -- 2. Redistributions in binary form must reproduce the above copyright -- 11 | -- notice, this list of conditions and the following disclaimer in -- 12 | -- the documentation and/or other materials provided with the -- 13 | -- distribution. -- 14 | -- 3. Neither the name of the copyright holder nor the names of its -- 15 | -- contributors may be used to endorse or promote products derived -- 16 | -- from this software without specific prior written permission. -- 17 | -- -- 18 | -- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -- 19 | -- "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -- 20 | -- LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR -- 21 | -- A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -- 22 | -- HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, -- 23 | -- SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -- 24 | -- LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, -- 25 | -- DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -- 26 | -- THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT -- 27 | -- (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE -- 28 | -- OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -- 29 | -- -- 30 | ------------------------------------------------------------------------------ 31 | 32 | -- This package provides an interface to a quadrature motor encoder (so 33 | -- strictly speaking it is a decoder). It uses the specific capabilities of 34 | -- selected ST Micro timers to perform this function, thereby relieving the 35 | -- MCU of having to do so (eg via interrupts). The timer essentially acts as 36 | -- an externally clocked counter, driven by the two discrete inputs. All that 37 | -- clients must do, after initialization, is query the counter value. The 38 | -- counter automatically follows the speed and direction of the motor. See 39 | -- especially Application Note AN4013 (DM00042534). See also the RM (RM0090), 40 | -- section 18.3.12 for discussion. 41 | -- 42 | -- Note that the encoder count is provided as a value of type UInt32, i.e., 43 | -- 32 bits, but the value may only be 16-bits wide, depending on the timer 44 | -- selected when calling Initialize. We ensure that 32 bits are actually 45 | -- provided by the timer via the precondition on the initialization routine. 46 | 47 | with STM32.GPIO; use STM32.GPIO; 48 | with STM32.Timers; use STM32.Timers; 49 | with STM32; use STM32; 50 | with HAL; use HAL; 51 | 52 | package Quadrature_Encoders is 53 | pragma Elaborate_Body; 54 | 55 | type Rotary_Encoder is limited private; 56 | 57 | function Current_Count (This : Rotary_Encoder) return UInt32 58 | with Inline; 59 | 60 | procedure Reset_Count (This : in out Rotary_Encoder) with 61 | Inline, 62 | Post => Current_Count (This) = 0; 63 | 64 | type Counting_Direction is (Up, Down); 65 | 66 | function Current_Direction (This : Rotary_Encoder) return Counting_Direction 67 | with Inline; 68 | 69 | procedure Initialize_Encoder 70 | (This : in out Rotary_Encoder; 71 | Encoder_TI1 : GPIO_Point; -- timer input discrete #1 72 | Encoder_TI2 : GPIO_Point; -- timer input discrete #2 73 | Encoder_Timer : not null access Timer; 74 | Encoder_AF : GPIO_Alternate_Function) 75 | with 76 | Pre => Has_32bit_Counter (Encoder_Timer.all) and 77 | Bidirectional (Encoder_Timer.all), 78 | Post => Current_Count (This) = 0 and 79 | Current_Direction (This) = Up; 80 | -- Note that the encoder always uses channels 1 and 2 on the specified 81 | -- timer for Encoder_TI1 and Encoder_TI2, the two timer input discretes. 82 | 83 | function Bidirectional (This : Timer) return Boolean; 84 | -- The selected timer must be able to count both up and down, so not all 85 | -- are candidates. Only Timers 1..5 and 8 are bidirectional, per the F429 86 | -- Datasheet, Table 6, pg 33. 87 | -- 88 | -- TODO: make this board-independent (move to STM32.Device package?) 89 | 90 | private 91 | 92 | type Rotary_Encoder is access all Timer with Storage_Size => 0; 93 | 94 | end Quadrature_Encoders; 95 | -------------------------------------------------------------------------------- /src/demos/analog_sensor_factory.adb: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------ 2 | -- -- 3 | -- Copyright (C) 2017, AdaCore -- 4 | -- -- 5 | -- Redistribution and use in source and binary forms, with or without -- 6 | -- modification, are permitted provided that the following conditions are -- 7 | -- met: -- 8 | -- 1. Redistributions of source code must retain the above copyright -- 9 | -- notice, this list of conditions and the following disclaimer. -- 10 | -- 2. Redistributions in binary form must reproduce the above copyright -- 11 | -- notice, this list of conditions and the following disclaimer in -- 12 | -- the documentation and/or other materials provided with the -- 13 | -- distribution. -- 14 | -- 3. Neither the name of STMicroelectronics nor the names of its -- 15 | -- contributors may be used to endorse or promote products derived -- 16 | -- from this software without specific prior written permission. -- 17 | -- -- 18 | -- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -- 19 | -- "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -- 20 | -- LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR -- 21 | -- A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -- 22 | -- HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, -- 23 | -- SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -- 24 | -- LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, -- 25 | -- DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -- 26 | -- THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT -- 27 | -- (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE -- 28 | -- OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -- 29 | -- -- 30 | ------------------------------------------------------------------------------ 31 | 32 | with STM32.Device; use STM32.Device; 33 | with STM32.ADC; use STM32.ADC; 34 | with STM32.GPIO; use STM32.GPIO; 35 | with STM32.DMA; use STM32.DMA; 36 | 37 | with NXT.Light_Sensors.Constructors; use NXT.Light_Sensors.Constructors; 38 | with NXT.Sound_Sensors.Constructors; use NXT.Sound_Sensors.Constructors; 39 | 40 | use NXT.Sound_Sensors; 41 | use NXT.Light_Sensors; 42 | 43 | package body Analog_Sensor_Factory is 44 | 45 | Selected_ADC_Unit : Analog_To_Digital_Converter renames ADC_1; 46 | Selected_Input_Channel : constant Analog_Input_Channel := 5; 47 | Matching_Input_Pin : GPIO_Point renames PA5; -- must match the channel! 48 | 49 | Required_DMA_Unit : DMA_Controller renames DMA_2; 50 | -- On the STM32F4 devices, only DMA_2 can attach to an ADC 51 | Matching_Stream : constant DMA_Stream_Selector := Stream_0; 52 | -- maps to ADC_1 on DMA_2 (Stream_4 is the only alternative) 53 | 54 | Digital_Line_0 : constant GPIO_Point := PC11; -- arbitrary 55 | Digital_Line_1 : constant GPIO_Point := PC12; -- arbitrary 56 | 57 | ---------------- 58 | -- New_Sensor -- 59 | ---------------- 60 | 61 | function New_Sensor (Kind : Known_Analog_Sensors) return NXT_Analog_Sensor'Class is 62 | begin 63 | case Kind is 64 | when Light => 65 | return Result : NXT_Analog_Sensor'Class := New_Light_Sensor 66 | (Converter => Selected_ADC_Unit'Access, 67 | Input_Channel => Selected_Input_Channel, 68 | Input_Pin => Matching_Input_Pin, 69 | Controller => Required_DMA_Unit'Access, 70 | Stream => Matching_Stream, 71 | Floodlight_Pin => Digital_Line_0); 72 | when Sound => 73 | return Result : NXT_Analog_Sensor'Class := New_Sound_Sensor 74 | (Converter => Selected_ADC_Unit'Access, 75 | Input_Channel => Selected_Input_Channel, 76 | Input_Pin => Matching_Input_Pin, 77 | Controller => Required_DMA_Unit'Access, 78 | Stream => Matching_Stream, 79 | Mode_Pin_0 => Digital_Line_0, 80 | Mode_Pin_1 => Digital_Line_1); 81 | end case; 82 | end New_Sensor; 83 | 84 | end Analog_Sensor_Factory; 85 | -------------------------------------------------------------------------------- /src/demos/analog_sensor_factory.ads: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------ 2 | -- -- 3 | -- Copyright (C) 2017, AdaCore -- 4 | -- -- 5 | -- Redistribution and use in source and binary forms, with or without -- 6 | -- modification, are permitted provided that the following conditions are -- 7 | -- met: -- 8 | -- 1. Redistributions of source code must retain the above copyright -- 9 | -- notice, this list of conditions and the following disclaimer. -- 10 | -- 2. Redistributions in binary form must reproduce the above copyright -- 11 | -- notice, this list of conditions and the following disclaimer in -- 12 | -- the documentation and/or other materials provided with the -- 13 | -- distribution. -- 14 | -- 3. Neither the name of STMicroelectronics nor the names of its -- 15 | -- contributors may be used to endorse or promote products derived -- 16 | -- from this software without specific prior written permission. -- 17 | -- -- 18 | -- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -- 19 | -- "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -- 20 | -- LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR -- 21 | -- A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -- 22 | -- HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, -- 23 | -- SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -- 24 | -- LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, -- 25 | -- DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -- 26 | -- THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT -- 27 | -- (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE -- 28 | -- OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -- 29 | -- -- 30 | ------------------------------------------------------------------------------ 31 | 32 | -- This package provides a factory function to create sensors in the class of 33 | -- all analog sensors. The specific kind of sensor created is controlled by a 34 | -- parameter. 35 | 36 | -- Note that the factory function is meant to be called only once, in this 37 | -- configuration, because it applies the same exact hardware devices to every 38 | -- sensor created. 39 | 40 | with NXT.Analog; use NXT.Analog; 41 | 42 | package Analog_Sensor_Factory is 43 | 44 | type Known_Analog_Sensors is (Light, Sound); 45 | 46 | function New_Sensor (Kind : Known_Analog_Sensors) return NXT_Analog_Sensor'Class; 47 | 48 | end Analog_Sensor_Factory; 49 | -------------------------------------------------------------------------------- /src/demos/demo_hitechnic_gyro.adb: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------ 2 | -- -- 3 | -- Copyright (C) 2017, AdaCore -- 4 | -- -- 5 | -- Redistribution and use in source and binary forms, with or without -- 6 | -- modification, are permitted provided that the following conditions are -- 7 | -- met: -- 8 | -- 1. Redistributions of source code must retain the above copyright -- 9 | -- notice, this list of conditions and the following disclaimer. -- 10 | -- 2. Redistributions in binary form must reproduce the above copyright -- 11 | -- notice, this list of conditions and the following disclaimer in -- 12 | -- the documentation and/or other materials provided with the -- 13 | -- distribution. -- 14 | -- 3. Neither the name of STMicroelectronics nor the names of its -- 15 | -- contributors may be used to endorse or promote products derived -- 16 | -- from this software without specific prior written permission. -- 17 | -- -- 18 | -- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -- 19 | -- "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -- 20 | -- LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR -- 21 | -- A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -- 22 | -- HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, -- 23 | -- SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -- 24 | -- LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, -- 25 | -- DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -- 26 | -- THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT -- 27 | -- (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE -- 28 | -- OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -- 29 | -- -- 30 | ------------------------------------------------------------------------------ 31 | 32 | -- This program demonstrates setup, calibration, and interaction with the 33 | -- NXT Lego analog sensors. 34 | 35 | -- Note that you must have an external pull-up resistor tied to +5V on the 36 | -- analog input pin. A 10K resistor works well. 37 | 38 | -- The wiring connections are as follows, for the standard Lego NXT 39 | -- connectors: 40 | -- 41 | -- Pin 1 (white wire) - Analog output from the device, required 42 | -- Pin 2 (black wire) - Ground (either one, or both) 43 | -- Pin 3 (red wire) - Ground (either one, or both) 44 | -- Pin 4 (green wire) - Vcc (+5V), required to power the sensor 45 | -- Pin 5 (yellow wire) - Used in some sensors ("Digital0" in literature) 46 | -- Pin 6 (blue wire) - Used in some sensors ("Digital1" in literature) 47 | 48 | with LCD_Std_Out; use LCD_Std_Out; 49 | 50 | with Last_Chance_Handler; pragma Unreferenced (Last_Chance_Handler); 51 | 52 | with STM32.Board; use STM32.Board; 53 | with STM32.Device; use STM32.Device; 54 | with STM32.ADC; use STM32.ADC; 55 | with STM32.GPIO; use STM32.GPIO; 56 | 57 | with HiTechnic.Gyroscopic_Sensor; use HiTechnic.Gyroscopic_Sensor; 58 | 59 | with Ada.Real_Time; use Ada.Real_Time; 60 | 61 | procedure Demo_HiTechnic_Gyro is 62 | 63 | Gyro : Gyro_Sensor; 64 | 65 | Next_Release : Time := Clock; 66 | Period : constant Time_Span := Milliseconds (100); -- arbitrary 67 | 68 | Gyro_ADC_Unit : Analog_To_Digital_Converter renames ADC_1; 69 | Gyro_Input_Channel : constant Analog_Input_Channel := 5; 70 | Gyro_Input_Pin : GPIO_Point renames PA5; -- must match the channel! 71 | 72 | 73 | procedure Set_Up_ADC_General_Settings; 74 | -- Does ADC general setup for all ADC units. 75 | 76 | --------------------------------- 77 | -- Set_Up_ADC_General_Settings -- 78 | --------------------------------- 79 | 80 | procedure Set_Up_ADC_General_Settings is 81 | begin 82 | STM32.Device.Reset_All_ADC_Units; 83 | Configure_Common_Properties 84 | (Mode => Independent, 85 | Prescalar => PCLK2_Div_2, 86 | DMA_Mode => Disabled, -- this is multi-dma mode 87 | Sampling_Delay => Sampling_Delay_5_Cycles); 88 | end Set_Up_ADC_General_Settings; 89 | 90 | begin 91 | Initialize_LEDs; 92 | Set_Up_ADC_General_Settings; 93 | 94 | Gyro.Configure (Gyro_ADC_Unit'Access, Gyro_Input_Channel, Gyro_Input_Pin); 95 | 96 | Gyro.Calibrate (Sampling_Interval => Seconds (2)); 97 | 98 | LCD_Std_Out.Clear_Screen; 99 | 100 | loop 101 | Green_LED.Toggle; -- visually indicate execution rate 102 | 103 | Put_Line (Gyro.Reading'Img & " "); 104 | 105 | Next_Release := Next_Release + Period; 106 | delay until Next_Release; 107 | end loop; 108 | end Demo_HiTechnic_Gyro; 109 | -------------------------------------------------------------------------------- /src/demos/demo_ir_receiver.adb: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AdaCore/Robotics_with_Ada/eca6d3de2ec4ac32e783f047e87a810e42a582ee/src/demos/demo_ir_receiver.adb -------------------------------------------------------------------------------- /src/demos/demo_touch_sensor.adb: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------ 2 | -- -- 3 | -- Copyright (C) 2017, AdaCore -- 4 | -- -- 5 | -- Redistribution and use in source and binary forms, with or without -- 6 | -- modification, are permitted provided that the following conditions are -- 7 | -- met: -- 8 | -- 1. Redistributions of source code must retain the above copyright -- 9 | -- notice, this list of conditions and the following disclaimer. -- 10 | -- 2. Redistributions in binary form must reproduce the above copyright -- 11 | -- notice, this list of conditions and the following disclaimer in -- 12 | -- the documentation and/or other materials provided with the -- 13 | -- distribution. -- 14 | -- 3. Neither the name of STMicroelectronics nor the names of its -- 15 | -- contributors may be used to endorse or promote products derived -- 16 | -- from this software without specific prior written permission. -- 17 | -- -- 18 | -- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -- 19 | -- "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -- 20 | -- LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR -- 21 | -- A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -- 22 | -- HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, -- 23 | -- SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -- 24 | -- LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, -- 25 | -- DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -- 26 | -- THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT -- 27 | -- (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE -- 28 | -- OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -- 29 | -- -- 30 | ------------------------------------------------------------------------------ 31 | 32 | with Last_Chance_Handler; pragma Unreferenced (Last_Chance_Handler); 33 | 34 | with STM32.Device; use STM32.Device; 35 | with LCD_Std_Out; use LCD_Std_Out; 36 | with NXT.Touch_Sensors; use NXT.Touch_Sensors; 37 | with Discrete_Inputs; use Discrete_Inputs; 38 | with Ada.Real_Time; use Ada.Real_Time; 39 | 40 | procedure Demo_Touch_Sensor is 41 | 42 | Button : Touch_Sensor (Pin => PB4'Access, Active => Low); 43 | -- The logic level choice is directly dependent upon the electronic circuit 44 | -- we are using to connect the sensor to the MCU. The proper choice is 45 | -- critical to correct behavior. The GPIO pin choice is arbitrary. 46 | 47 | Toggle_Count : Natural := 0; 48 | -- The touch sensor is a momentary switch. Once depressed, it will be 49 | -- released automatically when no longer held down. This variable keeps 50 | -- the count of these toggle events. 51 | 52 | begin 53 | Clear_Screen; 54 | Button.Initialize_Hardware; 55 | 56 | Discrete_Inputs.Default_Debounce_Time := Milliseconds (50); 57 | -- Be a little more responsive to users toggling the switch 58 | 59 | Put_Line ("Toggle button"); 60 | loop 61 | Button.Await_Toggle; 62 | -- Should not return until the button is released. If it returns as 63 | -- soon as the button is pressed, ie before released, the Button.Active 64 | -- discriminant is set incorrectly for the circuit involved. 65 | 66 | Toggle_Count := Toggle_Count + 1; 67 | Put_Line ("Toggled" & Toggle_Count'Img & " "); 68 | end loop; 69 | end Demo_Touch_Sensor; 70 | -------------------------------------------------------------------------------- /src/demos/display_ir_receiver.adb: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AdaCore/Robotics_with_Ada/eca6d3de2ec4ac32e783f047e87a810e42a582ee/src/demos/display_ir_receiver.adb -------------------------------------------------------------------------------- /src/demos/hardware_configuration.ads: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------ 2 | -- -- 3 | -- Copyright (C) 2018, AdaCore -- 4 | -- -- 5 | -- Redistribution and use in source and binary forms, with or without -- 6 | -- modification, are permitted provided that the following conditions are -- 7 | -- met: -- 8 | -- 1. Redistributions of source code must retain the above copyright -- 9 | -- notice, this list of conditions and the following disclaimer. -- 10 | -- 2. Redistributions in binary form must reproduce the above copyright -- 11 | -- notice, this list of conditions and the following disclaimer in -- 12 | -- the documentation and/or other materials provided with the -- 13 | -- distribution. -- 14 | -- 3. Neither the name of STMicroelectronics nor the names of its -- 15 | -- contributors may be used to endorse or promote products derived -- 16 | -- from this software without specific prior written permission. -- 17 | -- -- 18 | -- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -- 19 | -- "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -- 20 | -- LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR -- 21 | -- A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -- 22 | -- HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, -- 23 | -- SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -- 24 | -- LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, -- 25 | -- DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -- 26 | -- THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT -- 27 | -- (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE -- 28 | -- OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -- 29 | -- -- 30 | ------------------------------------------------------------------------------ 31 | 32 | -- This package declares all the hardware devices and related values on the 33 | -- STM32 board actually used by the application. The purpose is to specify 34 | -- them all in one place, so that changes and/or additions can be checked 35 | -- easily for conflicts. 36 | 37 | with STM32; use STM32; 38 | with STM32.GPIO; use STM32.GPIO; 39 | with STM32.Timers; use STM32.Timers; 40 | with STM32.I2C; use STM32.I2C; 41 | with STM32.Device; use STM32.Device; 42 | 43 | package Hardware_Configuration is 44 | 45 | -- The hardware on the STM32 board used by the Ultrasonic Sonar sensor (on 46 | -- the NXT_Shield) 47 | 48 | Sonar_Clock_Frequency : constant := 9600; 49 | Sonar_Clock_Pin : GPIO_Point renames PB13; -- SCL 50 | Sonar_Data_Pin : GPIO_Point renames PB11; -- SDA 51 | -- The choice of pins is largely arbitrary because we are bit-banging the 52 | -- I/O instead of using an ob-board I2C device. Nonetheless, the internal 53 | -- pull-up resistor values are not the same across all pins. Specifically, 54 | -- PB10 and PB12 have approximately 11K pull-up resistors, whereas the 55 | -- other pins have approximately 40K pull-up resistors. See table 47 56 | -- "I/O Static Characteristics" in the STM32F405xx STM32F407xx Datasheet. 57 | 58 | -- The hardware on the STM32 board used by the two motors (on the 59 | -- NXT_Shield) 60 | 61 | Motor_PWM_Frequency : constant := 490; 62 | 63 | Motor1_Encoder_Input1 : GPIO_Point renames PA15; 64 | Motor1_Encoder_Input2 : GPIO_Point renames PB3; 65 | Motor1_Encoder_Timer : constant access Timer := Timer_2'Access; 66 | Motor1_Encoder_AF : constant STM32.GPIO_Alternate_Function := GPIO_AF_TIM2_1; 67 | Motor1_PWM_Timer : constant access Timer := Timer_4'Access; 68 | Motor1_PWM_AF : constant STM32.GPIO_Alternate_Function := GPIO_AF_TIM4_2; 69 | Motor1_PWM_Output : GPIO_Point renames PB6; 70 | Motor1_PWM_Output_Channel : constant Timer_Channel := Channel_1; 71 | Motor1_Polarity1 : GPIO_Point renames PA10; 72 | Motor1_Polarity2 : GPIO_Point renames PB1; 73 | 74 | Motor2_Encoder_Input1 : GPIO_Point renames PA0; 75 | Motor2_Encoder_Input2 : GPIO_Point renames PA1; 76 | Motor2_Encoder_Timer : constant access Timer := Timer_5'Access; 77 | Motor2_Encoder_AF : constant STM32.GPIO_Alternate_Function := GPIO_AF_TIM5_2; 78 | Motor2_PWM_Timer : constant access Timer := Timer_3'Access; 79 | Motor2_PWM_AF : constant STM32.GPIO_Alternate_Function := GPIO_AF_TIM3_2; 80 | Motor2_PWM_Output : GPIO_Point renames PB4; 81 | Motor2_PWM_Output_Channel : constant Timer_Channel := Channel_1; 82 | Motor2_Polarity1 : GPIO_Point renames PA2; 83 | Motor2_Polarity2 : GPIO_Point renames PA3; 84 | 85 | -- The hardware on the STM32 board used by the remote control IR Receiver 86 | 87 | Receiver_I2C_Port : constant access I2C_Port := I2C_1'Access; 88 | Receiver_I2C_Port_AF : constant STM32.GPIO_Alternate_Function := GPIO_AF_I2C1_4; 89 | Receiver_I2C_Clock_Pin : GPIO_Point renames PB8; -- SCL 90 | Receiver_I2C_Data_Pin : GPIO_Point renames PB9; -- SDA 91 | Lego_NXT_I2C_Frequency : constant := 9600; -- per the Lego HDK 92 | 93 | end Hardware_Configuration; 94 | -------------------------------------------------------------------------------- /src/demos/initialize_nxt_shield.adb: -------------------------------------------------------------------------------- 1 | with NXT_Shield; use NXT_Shield; 2 | with Hardware_Configuration; use Hardware_Configuration; 3 | 4 | procedure Initialize_NXT_Shield is 5 | Successful : Boolean; 6 | begin 7 | Motor1.Initialize 8 | (Encoder_Input1 => Motor1_Encoder_Input1, 9 | Encoder_Input2 => Motor1_Encoder_Input2, 10 | Encoder_Timer => Motor1_Encoder_Timer, 11 | Encoder_AF => Motor1_Encoder_AF, 12 | PWM_Timer => Motor1_PWM_Timer, 13 | PWM_Output_Frequency => Motor_PWM_Frequency, 14 | PWM_AF => Motor1_PWM_AF, 15 | PWM_Output => Motor1_PWM_Output, 16 | PWM_Output_Channel => Motor1_PWM_Output_Channel, 17 | Polarity1 => Motor1_Polarity1, 18 | Polarity2 => Motor1_Polarity2); 19 | 20 | Motor2.Initialize 21 | (Encoder_Input1 => Motor2_Encoder_Input1, 22 | Encoder_Input2 => Motor2_Encoder_Input2, 23 | Encoder_Timer => Motor2_Encoder_Timer, 24 | Encoder_AF => Motor2_Encoder_AF, 25 | PWM_Timer => Motor2_PWM_Timer, 26 | PWM_Output_Frequency => Motor_PWM_Frequency, 27 | PWM_AF => Motor2_PWM_AF, 28 | PWM_Output => Motor2_PWM_Output, 29 | PWM_Output_Channel => Motor2_PWM_Output_Channel, 30 | Polarity1 => Motor2_Polarity1, 31 | Polarity2 => Motor2_Polarity2); 32 | 33 | Sonar.Configure 34 | (Data_Line => Sonar_Data_Pin, 35 | Clock_Line => Sonar_Clock_Pin, 36 | Clock_Frequency => Sonar_Clock_Frequency, 37 | Success => Successful); 38 | if not Successful then 39 | raise Program_Error with "Sonar init"; 40 | end if; 41 | end Initialize_NXT_Shield; 42 | -------------------------------------------------------------------------------- /src/demos/initialize_nxt_shield.ads: -------------------------------------------------------------------------------- 1 | procedure Initialize_NXT_Shield; 2 | -------------------------------------------------------------------------------- /src/demos/nxt-analog_sensor_calibration_lcd.adb: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------ 2 | -- -- 3 | -- Copyright (C) 2017, AdaCore -- 4 | -- -- 5 | -- Redistribution and use in source and binary forms, with or without -- 6 | -- modification, are permitted provided that the following conditions are -- 7 | -- met: -- 8 | -- 1. Redistributions of source code must retain the above copyright -- 9 | -- notice, this list of conditions and the following disclaimer. -- 10 | -- 2. Redistributions in binary form must reproduce the above copyright -- 11 | -- notice, this list of conditions and the following disclaimer in -- 12 | -- the documentation and/or other materials provided with the -- 13 | -- distribution. -- 14 | -- 3. Neither the name of STMicroelectronics nor the names of its -- 15 | -- contributors may be used to endorse or promote products derived -- 16 | -- from this software without specific prior written permission. -- 17 | -- -- 18 | -- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -- 19 | -- "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -- 20 | -- LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR -- 21 | -- A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -- 22 | -- HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, -- 23 | -- SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -- 24 | -- LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, -- 25 | -- DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -- 26 | -- THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT -- 27 | -- (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE -- 28 | -- OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -- 29 | -- -- 30 | ------------------------------------------------------------------------------ 31 | 32 | with LCD_Std_Out; use LCD_Std_Out; 33 | with STM32.Board; 34 | with NXT.Analog_Sensor_Utils; use NXT.Analog_Sensor_Utils; 35 | 36 | package body NXT.Analog_Sensor_Calibration_LCD is 37 | 38 | procedure Await_Button_Toggle; 39 | -- wait for the Blue user button to be pressed and then released, by 40 | -- polling 41 | 42 | ----------------------------- 43 | -- Calibrate_Analog_Sensor -- 44 | ----------------------------- 45 | 46 | procedure Calibrate_Analog_Sensor 47 | (Sensor : in out NXT_Analog_Sensor'Class; 48 | Sampling_Interval : Time_Span; 49 | Successful : out Boolean) 50 | is 51 | Low_Bound : Integer; 52 | High_Bound : Integer; 53 | begin 54 | Clear_Screen; 55 | STM32.Board.Configure_User_Button_GPIO; -- for blue user button 56 | 57 | Put_Line ("--Min levels--"); 58 | Put_Line ("Blue button..."); 59 | Await_Button_Toggle; 60 | Put_Line ("Sampling..."); 61 | Get_Average_Reading (Sensor, Sampling_Interval, Low_Bound, Successful); 62 | if not Successful then 63 | Put_Line ("Read failed"); 64 | return; 65 | end if; 66 | 67 | Put_Line ("--Max levels--"); 68 | Put_Line ("Blue button..."); 69 | Await_Button_Toggle; 70 | Put_Line ("Sampling..."); 71 | Get_Average_Reading (Sensor, Sampling_Interval, High_Bound, Successful); 72 | if not Successful then 73 | Put_Line ("Read failed"); 74 | return; 75 | end if; 76 | 77 | Low_Bound := As_Varying_Directly (Low_Bound); 78 | High_Bound := As_Varying_Directly (High_Bound); 79 | 80 | Put_Line ("--Results--"); 81 | Put_Line ("Min:" & Low_Bound'Img); 82 | Put_Line ("Max:" & High_Bound'Img); 83 | 84 | if Low_Bound = High_Bound then 85 | Put_Line ("Min = Max!"); 86 | Successful := False; 87 | return; 88 | end if; 89 | 90 | if Low_Bound > High_Bound then 91 | Put_Line ("Min > Max!"); 92 | Successful := False; 93 | return; 94 | end if; 95 | 96 | Sensor.Set_Calibration (Least => Low_Bound, Greatest => High_Bound); 97 | 98 | Put_Line ("Blue button..."); 99 | Await_Button_Toggle; 100 | end Calibrate_Analog_Sensor; 101 | 102 | ------------------------- 103 | -- Await_Button_Toggle -- 104 | ------------------------- 105 | 106 | procedure Await_Button_Toggle is 107 | use STM32.Board; 108 | begin 109 | loop 110 | exit when User_Button_Point.Set; 111 | end loop; 112 | loop 113 | exit when not User_Button_Point.Set; 114 | end loop; 115 | end Await_Button_Toggle; 116 | 117 | end NXT.Analog_Sensor_Calibration_LCD; 118 | -------------------------------------------------------------------------------- /src/demos/nxt-analog_sensor_calibration_lcd.ads: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------ 2 | -- -- 3 | -- Copyright (C) 2017, AdaCore -- 4 | -- -- 5 | -- Redistribution and use in source and binary forms, with or without -- 6 | -- modification, are permitted provided that the following conditions are -- 7 | -- met: -- 8 | -- 1. Redistributions of source code must retain the above copyright -- 9 | -- notice, this list of conditions and the following disclaimer. -- 10 | -- 2. Redistributions in binary form must reproduce the above copyright -- 11 | -- notice, this list of conditions and the following disclaimer in -- 12 | -- the documentation and/or other materials provided with the -- 13 | -- distribution. -- 14 | -- 3. Neither the name of STMicroelectronics nor the names of its -- 15 | -- contributors may be used to endorse or promote products derived -- 16 | -- from this software without specific prior written permission. -- 17 | -- -- 18 | -- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -- 19 | -- "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -- 20 | -- LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR -- 21 | -- A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -- 22 | -- HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, -- 23 | -- SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -- 24 | -- LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, -- 25 | -- DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -- 26 | -- THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT -- 27 | -- (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE -- 28 | -- OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -- 29 | -- -- 30 | ------------------------------------------------------------------------------ 31 | 32 | -- This package provides an interactive analog sensor calibration routine that 33 | -- works with any NXT analog sensor (hence the use of NXT_Analog_Sensor'Class 34 | -- in the formal parameter). 35 | 36 | -- NB: this package implementation uses the LCD_Std_Out package and the blue 37 | -- user button. Not all STM32F4xxx Discovery boards have an LCD. Moreover, the 38 | -- STM32F4 Disco board used for some demos has the blue user button disabled 39 | -- by removing a solder bridge. 40 | 41 | with NXT.Analog; use NXT.Analog; 42 | with Ada.Real_Time; use Ada.Real_Time; 43 | 44 | package NXT.Analog_Sensor_Calibration_LCD is 45 | 46 | procedure Calibrate_Analog_Sensor 47 | (Sensor : in out NXT_Analog_Sensor'Class; 48 | Sampling_Interval : Time_Span; 49 | Successful : out Boolean) 50 | with Pre => Enabled (Sensor); 51 | -- This routine interactively calibrates the specified sensor for both low 52 | -- and high inputs. The user is prompted for each state, and then presses 53 | -- the blue User button when ready to take the samples in that state. In 54 | -- particular, the physical sensor is placed in an environment for taking 55 | -- minimum (maximum, respectively) input levels and then the button is to 56 | -- be pushed. The average sensed value is used in each case. The final min 57 | -- and max values are displayed on the LCD screen. The raw low and high 58 | -- bounds are displayed as values that vary directly with the sensed 59 | -- input. The raw values are then set in the sensor. 60 | -- 61 | -- First, the "minimum" (e.g., darkest) sensed input level is calibrated, 62 | -- then the "maximum" (e.g., brightest) input levels. For example, a full 63 | -- successful calibration would appear as follows on the LCD: 64 | -- 65 | -- Min levels: (indicates about to sample low input levels) 66 | -- Blue button... (indicates waiting for user button press) 67 | -- Sampling... (indicates calibration for Sampling_Interval) 68 | -- Blue button... (indicates waiting for user button press) 69 | -- Max levels: (indicates about to sample high input levels) 70 | -- Blue button... (indicates waiting for user button press) 71 | -- Sampling... (indicates calibration for Sampling_Interval) 72 | -- Low: xxxx (the raw low input calibration value) 73 | -- High: yyyy (the raw high input calibration value) 74 | -- Blue button... (indicates waiting for user button press) 75 | -- 76 | -- The last "Button press..." doesn't appear if an error regardng the two 77 | -- values is detected by the calibration routine, in which case an error 78 | -- message appears and Successful is set to False. 79 | -- 80 | -- If any attempt to acquire a raw sensor reading fails, that is 81 | -- indicated on the LCD, Successful is set to False, and the call 82 | -- returns immediately. 83 | 84 | end NXT.Analog_Sensor_Calibration_LCD; 85 | -------------------------------------------------------------------------------- /src/demos/nxt-analog_sensor_utils.adb: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------ 2 | -- -- 3 | -- Copyright (C) 2017, AdaCore -- 4 | -- -- 5 | -- Redistribution and use in source and binary forms, with or without -- 6 | -- modification, are permitted provided that the following conditions are -- 7 | -- met: -- 8 | -- 1. Redistributions of source code must retain the above copyright -- 9 | -- notice, this list of conditions and the following disclaimer. -- 10 | -- 2. Redistributions in binary form must reproduce the above copyright -- 11 | -- notice, this list of conditions and the following disclaimer in -- 12 | -- the documentation and/or other materials provided with the -- 13 | -- distribution. -- 14 | -- 3. Neither the name of STMicroelectronics nor the names of its -- 15 | -- contributors may be used to endorse or promote products derived -- 16 | -- from this software without specific prior written permission. -- 17 | -- -- 18 | -- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -- 19 | -- "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -- 20 | -- LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR -- 21 | -- A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -- 22 | -- HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, -- 23 | -- SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -- 24 | -- LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, -- 25 | -- DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -- 26 | -- THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT -- 27 | -- (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE -- 28 | -- OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -- 29 | -- -- 30 | ------------------------------------------------------------------------------ 31 | 32 | package body NXT.Analog_Sensor_Utils is 33 | 34 | ------------------------- 35 | -- Get_Average_Reading -- 36 | ------------------------- 37 | 38 | procedure Get_Average_Reading 39 | (Sensor : in out NXT_Analog_Sensor'Class; 40 | Interval : Time_Span; 41 | Result : out Integer; 42 | Successful : out Boolean) 43 | is 44 | Deadline : constant Time := Clock + Interval; 45 | Reading : Integer; 46 | Total : Integer := 0; 47 | Count : Integer := 0; 48 | begin 49 | while Clock <= Deadline loop 50 | Get_Raw_Reading (Sensor, Reading, Successful); 51 | if not Successful then 52 | Result := 0; 53 | return; 54 | end if; 55 | -- Reading is in range 0 .. ADC_Conversion_Max_Value, ie 0 .. 1023, 56 | -- so we are not likely to overflow for a reasonable interval, but 57 | -- it is possible... 58 | Total := Total + Reading; 59 | Count := Count + 1; 60 | end loop; 61 | Result := Total / Count; 62 | end Get_Average_Reading; 63 | 64 | end NXT.Analog_Sensor_Utils; 65 | -------------------------------------------------------------------------------- /src/demos/nxt-analog_sensor_utils.ads: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------ 2 | -- -- 3 | -- Copyright (C) 2017, AdaCore -- 4 | -- -- 5 | -- Redistribution and use in source and binary forms, with or without -- 6 | -- modification, are permitted provided that the following conditions are -- 7 | -- met: -- 8 | -- 1. Redistributions of source code must retain the above copyright -- 9 | -- notice, this list of conditions and the following disclaimer. -- 10 | -- 2. Redistributions in binary form must reproduce the above copyright -- 11 | -- notice, this list of conditions and the following disclaimer in -- 12 | -- the documentation and/or other materials provided with the -- 13 | -- distribution. -- 14 | -- 3. Neither the name of STMicroelectronics nor the names of its -- 15 | -- contributors may be used to endorse or promote products derived -- 16 | -- from this software without specific prior written permission. -- 17 | -- -- 18 | -- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -- 19 | -- "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -- 20 | -- LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR -- 21 | -- A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -- 22 | -- HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, -- 23 | -- SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -- 24 | -- LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, -- 25 | -- DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -- 26 | -- THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT -- 27 | -- (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE -- 28 | -- OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -- 29 | -- -- 30 | ------------------------------------------------------------------------------ 31 | 32 | -- This package provides some utility routines for working with NXT analog 33 | -- sensors. 34 | 35 | with NXT.Analog; use NXT.Analog; 36 | with Ada.Real_Time; use Ada.Real_Time; 37 | 38 | package NXT.Analog_Sensor_Utils is 39 | 40 | procedure Get_Average_Reading 41 | (Sensor : in out NXT_Analog_Sensor'Class; 42 | Interval : Time_Span; 43 | Result : out Integer; 44 | Successful : out Boolean); 45 | -- Returns the average of the raw, inversely varying sensed input values 46 | -- acquired via Get_Raw_Reading (Sensor) during the sampling Interval. 47 | -- If any call to Get_Raw_Reading fails to acquire a value from the ADC, 48 | -- Result is 0 and Successful is False. 49 | 50 | end NXT.Analog_Sensor_Utils; 51 | -------------------------------------------------------------------------------- /src/misc/stm32-device-mapping_requests.adb: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------ 2 | -- -- 3 | -- Copyright (C) 2017, AdaCore -- 4 | -- -- 5 | -- Redistribution and use inC source and binary forms, with or without -- 6 | -- modification, are permitted provided that the following conditions are -- 7 | -- met: -- 8 | -- 1. Redistributions of source code must retain the above copyright -- 9 | -- notice, this list of conditions and the following disclaimer. -- 10 | -- 2. Redistributions in binary form must reproduce the above copyright -- 11 | -- notice, this list of conditions and the following disclaimer in -- 12 | -- the documentation and/or other materials provided with the -- 13 | -- distribution. -- 14 | -- 3. Neither the name of STMicroelectronics nor the names of its -- 15 | -- contributors may be used to endorse or promote products derived -- 16 | -- from this software without specific prior written permission. -- 17 | -- -- 18 | -- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -- 19 | -- "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -- 20 | -- LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR -- 21 | -- A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -- 22 | -- HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, -- 23 | -- SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -- 24 | -- LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, -- 25 | -- DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -- 26 | -- THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT -- 27 | -- (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE -- 28 | -- OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -- 29 | -- -- 30 | ------------------------------------------------------------------------------ 31 | 32 | package body STM32.Device.Mapping_Requests is 33 | 34 | -- We could have some nice data structure representing tables 42 and 43, but 35 | -- we usually have much less RAM than space for code on these targets. 36 | 37 | ------------------------------ 38 | -- DMA2_ADC_Request_Mapping -- 39 | ------------------------------ 40 | 41 | function DMA2_ADC_Request_Mapping 42 | (ADC_Unit : not null access Analog_To_Digital_Converter; 43 | DMA_Unit : not null access DMA_Controller; 44 | DMA_Stream : DMA_Stream_Selector) 45 | return DMA_Channel_Selector 46 | is 47 | pragma Unreferenced (DMA_Unit); 48 | begin 49 | if ADC_Unit = ADC_1'Access then 50 | case DMA_Stream is 51 | when Stream_0 | Stream_4 => return Channel_0; 52 | when others => raise Invalid_Mapping_Request; 53 | end case; 54 | elsif ADC_Unit = ADC_2'Access then 55 | case DMA_Stream is 56 | when Stream_2 | Stream_3 => return Channel_1; 57 | when others => raise Invalid_Mapping_Request; 58 | end case; 59 | elsif ADC_Unit = ADC_3'Access then 60 | case DMA_Stream is 61 | when Stream_0 | Stream_1 => return Channel_2; 62 | when others => raise Invalid_Mapping_Request; 63 | end case; 64 | else 65 | raise Invalid_Mapping_Request; 66 | end if; 67 | end DMA2_ADC_Request_Mapping; 68 | 69 | end STM32.Device.Mapping_Requests; 70 | -------------------------------------------------------------------------------- /src/misc/stm32-device-mapping_requests.ads: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------ 2 | -- -- 3 | -- Copyright (C) 2017, AdaCore -- 4 | -- -- 5 | -- Redistribution and use inC source and binary forms, with or without -- 6 | -- modification, are permitted provided that the following conditions are -- 7 | -- met: -- 8 | -- 1. Redistributions of source code must retain the above copyright -- 9 | -- notice, this list of conditions and the following disclaimer. -- 10 | -- 2. Redistributions in binary form must reproduce the above copyright -- 11 | -- notice, this list of conditions and the following disclaimer in -- 12 | -- the documentation and/or other materials provided with the -- 13 | -- distribution. -- 14 | -- 3. Neither the name of STMicroelectronics nor the names of its -- 15 | -- contributors may be used to endorse or promote products derived -- 16 | -- from this software without specific prior written permission. -- 17 | -- -- 18 | -- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -- 19 | -- "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -- 20 | -- LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR -- 21 | -- A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -- 22 | -- HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, -- 23 | -- SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -- 24 | -- LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, -- 25 | -- DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -- 26 | -- THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT -- 27 | -- (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE -- 28 | -- OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -- 29 | -- -- 30 | ------------------------------------------------------------------------------ 31 | 32 | -- This package provides device family-specific services 33 | 34 | package STM32.Device.Mapping_Requests is 35 | 36 | Invalid_Mapping_Request : exception; 37 | 38 | function DMA2_ADC_Request_Mapping 39 | (ADC_Unit : not null access Analog_To_Digital_Converter; 40 | DMA_Unit : not null access DMA_Controller; 41 | DMA_Stream : DMA_Stream_Selector) 42 | return DMA_Channel_Selector 43 | with Pre => DMA_Unit = DMA_2'Access; 44 | -- Implements Table 43, the DMA2 Request Mapping table, for ADC units: 45 | -- given the specified DMA stream on DMA controller #2, returns the DMA 46 | -- channel that is mapped to the specified ADC unit on DMA controller #2. 47 | -- 48 | -- Note that the DMA_Unit parameter is redundant, since this function only 49 | -- works for DMA2, i.e., only DMA2 can be mapped to ADC units on this 50 | -- device. However, we want to detect the potential mistake of calling 51 | -- this function for DMA1, and so we include the parameter for the sake of 52 | -- the precondition. 53 | 54 | -- Other mapping functions for tables 42 and 43, providing the mapping for 55 | -- various devices, such as USARTn_RX and USARTn_TX ... 56 | 57 | end STM32.Device.Mapping_Requests; 58 | -------------------------------------------------------------------------------- /src/nxt/motors/nxt-motors.ads: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------ 2 | -- -- 3 | -- Copyright (C) 2017-2019, AdaCore -- 4 | -- -- 5 | -- Redistribution and use in source and binary forms, with or without -- 6 | -- modification, are permitted provided that the following conditions are -- 7 | -- met: -- 8 | -- 1. Redistributions of source code must retain the above copyright -- 9 | -- notice, this list of conditions and the following disclaimer. -- 10 | -- 2. Redistributions in binary form must reproduce the above copyright -- 11 | -- notice, this list of conditions and the following disclaimer in -- 12 | -- the documentation and/or other materials provided with the -- 13 | -- distribution. -- 14 | -- 3. Neither the name of the copyright holder nor the names of its -- 15 | -- contributors may be used to endorse or promote products derived -- 16 | -- from this software without specific prior written permission. -- 17 | -- -- 18 | -- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -- 19 | -- "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -- 20 | -- LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR -- 21 | -- A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -- 22 | -- HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, -- 23 | -- SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -- 24 | -- LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, -- 25 | -- DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -- 26 | -- THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT -- 27 | -- (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE -- 28 | -- OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -- 29 | -- -- 30 | ------------------------------------------------------------------------------ 31 | 32 | -- This package provides a basic interface for the Lego NXT motors. 33 | 34 | with STM32.GPIO; use STM32.GPIO; 35 | with STM32.Timers; use STM32.Timers; 36 | with STM32; use STM32; 37 | with STM32.PWM; use STM32.PWM; 38 | 39 | with Quadrature_Encoders; use Quadrature_Encoders; 40 | 41 | with HAL; use HAL; 42 | 43 | package NXT.Motors is 44 | pragma Elaborate_Body; 45 | 46 | type Basic_Motor is tagged limited private; 47 | 48 | subtype Power_Level is Integer range 0 .. 100; 49 | 50 | function Throttle (This : Basic_Motor) return Power_Level; 51 | 52 | type Directions is (Forward, Backward); 53 | 54 | function Rotation_Direction (This : Basic_Motor) return Directions; 55 | 56 | type Motor_Encoder_Counts is range -(2 ** 31) .. +(2 ** 31 - 1); 57 | 58 | Encoder_Counts_Per_Revolution : constant := 720; 59 | -- Thus 1/2 degree resolution 60 | 61 | procedure Engage 62 | (This : in out Basic_Motor; 63 | Direction : Directions; 64 | Power : Power_Level) 65 | with Post => Throttle (This) = Power; 66 | 67 | procedure Stop (This : in out Basic_Motor) with 68 | Post => Throttle (This) = 100; 69 | -- Full stop immediately and actively lock motor position. 70 | 71 | procedure Coast (This : in out Basic_Motor) with 72 | Post => Throttle (This) = 0; 73 | -- Gradual stop without locking motor position. 74 | 75 | procedure Reset_Encoder_Count (This : in out Basic_Motor) with 76 | Post => Encoder_Count (This) = 0; 77 | 78 | function Encoder_Count (This : Basic_Motor) return Motor_Encoder_Counts; 79 | 80 | procedure Initialize 81 | (This : in out Basic_Motor; 82 | -- motor encoder 83 | Encoder_Input1 : GPIO_Point; 84 | Encoder_Input2 : GPIO_Point; 85 | Encoder_Timer : not null access Timer; 86 | Encoder_AF : GPIO_Alternate_Function; 87 | -- motor power control 88 | PWM_Timer : not null access Timer; 89 | PWM_Output_Frequency : UInt32; -- in Hertz 90 | PWM_AF : GPIO_Alternate_Function; 91 | PWM_Output : GPIO_Point; 92 | PWM_Output_Channel : Timer_Channel; 93 | -- discrete outputs to H-Bridge that control direction and stopping 94 | Polarity1 : GPIO_Point; 95 | Polarity2 : GPIO_Point) 96 | with 97 | Pre => Has_32bit_Counter (Encoder_Timer.all) and 98 | Bidirectional (Encoder_Timer.all), 99 | Post => Encoder_Count (This) = 0 and 100 | Throttle (This) = 0; 101 | 102 | private 103 | 104 | type Basic_Motor is tagged limited record 105 | Encoder : Rotary_Encoder; 106 | Power_Plant : PWM_Modulator; 107 | Power_Channel : Timer_Channel; -- for PWM modulator 108 | H_Bridge_1 : GPIO_Point; -- for H-Bridge control 109 | H_Bridge_2 : GPIO_Point; -- for H-Bridge control 110 | end record; 111 | 112 | end NXT.Motors; 113 | -------------------------------------------------------------------------------- /src/nxt/nxt.ads: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------ 2 | -- -- 3 | -- Copyright (C) 2017, AdaCore -- 4 | -- -- 5 | -- Redistribution and use in source and binary forms, with or without -- 6 | -- modification, are permitted provided that the following conditions are -- 7 | -- met: -- 8 | -- 1. Redistributions of source code must retain the above copyright -- 9 | -- notice, this list of conditions and the following disclaimer. -- 10 | -- 2. Redistributions in binary form must reproduce the above copyright -- 11 | -- notice, this list of conditions and the following disclaimer in -- 12 | -- the documentation and/or other materials provided with the -- 13 | -- distribution. -- 14 | -- 3. Neither the name of STMicroelectronics nor the names of its -- 15 | -- contributors may be used to endorse or promote products derived -- 16 | -- from this software without specific prior written permission. -- 17 | -- -- 18 | -- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -- 19 | -- "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -- 20 | -- LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR -- 21 | -- A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -- 22 | -- HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, -- 23 | -- SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -- 24 | -- LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, -- 25 | -- DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -- 26 | -- THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT -- 27 | -- (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE -- 28 | -- OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -- 29 | -- -- 30 | ------------------------------------------------------------------------------ 31 | 32 | package NXT is 33 | pragma Pure; 34 | end NXT; 35 | -------------------------------------------------------------------------------- /src/nxt/sensors/nxt-analog-dma.ads: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------ 2 | -- -- 3 | -- Copyright (C) 2017, AdaCore -- 4 | -- -- 5 | -- Redistribution and use in source and binary forms, with or without -- 6 | -- modification, are permitted provided that the following conditions are -- 7 | -- met: -- 8 | -- 1. Redistributions of source code must retain the above copyright -- 9 | -- notice, this list of conditions and the following disclaimer. -- 10 | -- 2. Redistributions in binary form must reproduce the above copyright -- 11 | -- notice, this list of conditions and the following disclaimer in -- 12 | -- the documentation and/or other materials provided with the -- 13 | -- distribution. -- 14 | -- 3. Neither the name of STMicroelectronics nor the names of its -- 15 | -- contributors may be used to endorse or promote products derived -- 16 | -- from this software without specific prior written permission. -- 17 | -- -- 18 | -- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -- 19 | -- "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -- 20 | -- LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR -- 21 | -- A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -- 22 | -- HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, -- 23 | -- SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -- 24 | -- LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, -- 25 | -- DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -- 26 | -- THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT -- 27 | -- (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE -- 28 | -- OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -- 29 | -- -- 30 | ------------------------------------------------------------------------------ 31 | 32 | -- This package provides an abstract subclass for the NXT analog sensors. 33 | -- This subclass uses DMA to acquire the raw sensor readings. 34 | 35 | -- Note that you must have an external pull-up resistor tied to +5V on the 36 | -- analog input pin. A 10K resistor works well. 37 | 38 | -- Note that, on the STM32F4xxx series, only DMA2 can attach to an ADC, per 39 | -- Table 43 of the RM for that series. 40 | 41 | with STM32.DMA; use STM32.DMA; 42 | 43 | package NXT.Analog.DMA is 44 | 45 | type NXT_Analog_Sensor_DMA is abstract new NXT_Analog_Sensor with private; 46 | 47 | procedure Assign_DMA 48 | (This : in out NXT_Analog_Sensor_DMA; 49 | Controller : access DMA_Controller; 50 | Stream : DMA_Stream_Selector); 51 | 52 | overriding 53 | procedure Initialize (This : in out NXT_Analog_Sensor_DMA) with 54 | Post => Enabled (This); 55 | 56 | overriding 57 | procedure Get_Raw_Reading 58 | (This : in out NXT_Analog_Sensor_DMA; 59 | Reading : out Natural; 60 | Successful : out Boolean); 61 | 62 | private 63 | 64 | type NXT_Analog_Sensor_DMA is new NXT_Analog_Sensor with record 65 | Controller : access DMA_Controller; 66 | Stream : DMA_Stream_Selector; 67 | Raw_Value : UInt16 := 0 with Atomic; 68 | end record; 69 | 70 | end NXT.Analog.DMA; 71 | -------------------------------------------------------------------------------- /src/nxt/sensors/nxt-analog-polling.adb: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------ 2 | -- -- 3 | -- Copyright (C) 2017, AdaCore -- 4 | -- -- 5 | -- Redistribution and use in source and binary forms, with or without -- 6 | -- modification, are permitted provided that the following conditions are -- 7 | -- met: -- 8 | -- 1. Redistributions of source code must retain the above copyright -- 9 | -- notice, this list of conditions and the following disclaimer. -- 10 | -- 2. Redistributions in binary form must reproduce the above copyright -- 11 | -- notice, this list of conditions and the following disclaimer in -- 12 | -- the documentation and/or other materials provided with the -- 13 | -- distribution. -- 14 | -- 3. Neither the name of STMicroelectronics nor the names of its -- 15 | -- contributors may be used to endorse or promote products derived -- 16 | -- from this software without specific prior written permission. -- 17 | -- -- 18 | -- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -- 19 | -- "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -- 20 | -- LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR -- 21 | -- A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -- 22 | -- HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, -- 23 | -- SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -- 24 | -- LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, -- 25 | -- DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -- 26 | -- THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT -- 27 | -- (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE -- 28 | -- OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -- 29 | -- -- 30 | ------------------------------------------------------------------------------ 31 | 32 | with STM32.Device; use STM32.Device; 33 | 34 | package body NXT.Analog.Polling is 35 | 36 | ---------------- 37 | -- Initialize -- 38 | ---------------- 39 | 40 | overriding 41 | procedure Initialize 42 | (This : in out NXT_Analog_Sensor_Polled) 43 | is 44 | begin 45 | Initialize (NXT_Analog_Sensor (This)); 46 | 47 | Configure_Regular_Conversions 48 | (This.Converter.all, 49 | Continuous => False, 50 | Trigger => Software_Triggered, 51 | Enable_EOC => True, 52 | Conversions => Regular_Conversion (This.Input_Channel)); 53 | 54 | Enable (This.Converter.all); 55 | end Initialize; 56 | 57 | --------------------- 58 | -- Get_Raw_Reading -- 59 | --------------------- 60 | 61 | overriding 62 | procedure Get_Raw_Reading 63 | (This : in out NXT_Analog_Sensor_Polled; 64 | Reading : out Natural; 65 | Successful : out Boolean) 66 | is 67 | begin 68 | Start_Conversion (This.Converter.all); 69 | Poll_For_Status (This.Converter.all, Regular_Channel_Conversion_Complete, Successful); 70 | if not Successful then 71 | Reading := 0; 72 | else 73 | Reading := Integer (Conversion_Value (This.Converter.all)); 74 | end if; 75 | end Get_Raw_Reading; 76 | 77 | end NXT.Analog.Polling; 78 | -------------------------------------------------------------------------------- /src/nxt/sensors/nxt-analog-polling.ads: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------ 2 | -- -- 3 | -- Copyright (C) 2017, AdaCore -- 4 | -- -- 5 | -- Redistribution and use in source and binary forms, with or without -- 6 | -- modification, are permitted provided that the following conditions are -- 7 | -- met: -- 8 | -- 1. Redistributions of source code must retain the above copyright -- 9 | -- notice, this list of conditions and the following disclaimer. -- 10 | -- 2. Redistributions in binary form must reproduce the above copyright -- 11 | -- notice, this list of conditions and the following disclaimer in -- 12 | -- the documentation and/or other materials provided with the -- 13 | -- distribution. -- 14 | -- 3. Neither the name of STMicroelectronics nor the names of its -- 15 | -- contributors may be used to endorse or promote products derived -- 16 | -- from this software without specific prior written permission. -- 17 | -- -- 18 | -- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -- 19 | -- "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -- 20 | -- LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR -- 21 | -- A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -- 22 | -- HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, -- 23 | -- SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -- 24 | -- LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, -- 25 | -- DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -- 26 | -- THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT -- 27 | -- (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE -- 28 | -- OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -- 29 | -- -- 30 | ------------------------------------------------------------------------------ 31 | 32 | -- This package provides an abstract subclass for the NXT analog sensors. 33 | -- This subclass uses polling to acquire the raw sensor readings. 34 | 35 | -- Note that you must have an external pull-up resistor tied to +5V on the 36 | -- analog input pin. A 10K resistor works well. 37 | 38 | package NXT.Analog.Polling is 39 | 40 | type NXT_Analog_Sensor_Polled is abstract new NXT_Analog_Sensor with private; 41 | 42 | overriding 43 | procedure Initialize (This : in out NXT_Analog_Sensor_Polled) with 44 | Post => Enabled (This); 45 | 46 | overriding 47 | procedure Get_Raw_Reading 48 | (This : in out NXT_Analog_Sensor_Polled; 49 | Reading : out Natural; 50 | Successful : out Boolean); 51 | -- NB: This version initiates an ADC conversion and then polls for 52 | -- completion. If the conversion times out, Reading is zero and 53 | -- Successful is False. The timeout is set to one second. 54 | 55 | private 56 | 57 | type NXT_Analog_Sensor_Polled is new NXT_Analog_Sensor with null record; 58 | 59 | end NXT.Analog.Polling; 60 | -------------------------------------------------------------------------------- /src/nxt/sensors/nxt-analog.adb: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------ 2 | -- -- 3 | -- Copyright (C) 2017, AdaCore -- 4 | -- -- 5 | -- Redistribution and use in source and binary forms, with or without -- 6 | -- modification, are permitted provided that the following conditions are -- 7 | -- met: -- 8 | -- 1. Redistributions of source code must retain the above copyright -- 9 | -- notice, this list of conditions and the following disclaimer. -- 10 | -- 2. Redistributions in binary form must reproduce the above copyright -- 11 | -- notice, this list of conditions and the following disclaimer in -- 12 | -- the documentation and/or other materials provided with the -- 13 | -- distribution. -- 14 | -- 3. Neither the name of STMicroelectronics nor the names of its -- 15 | -- contributors may be used to endorse or promote products derived -- 16 | -- from this software without specific prior written permission. -- 17 | -- -- 18 | -- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -- 19 | -- "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -- 20 | -- LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR -- 21 | -- A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -- 22 | -- HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, -- 23 | -- SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -- 24 | -- LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, -- 25 | -- DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -- 26 | -- THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT -- 27 | -- (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE -- 28 | -- OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -- 29 | -- -- 30 | ------------------------------------------------------------------------------ 31 | 32 | with STM32.Device; use STM32.Device; 33 | 34 | package body NXT.Analog is 35 | 36 | ---------------- 37 | -- Assign_ADC -- 38 | ---------------- 39 | 40 | procedure Assign_ADC 41 | (This : in out NXT_Analog_Sensor; 42 | Converter : access Analog_To_Digital_Converter; 43 | Input_Channel : Analog_Input_Channel; 44 | Input_Pin : GPIO_Point) 45 | is 46 | begin 47 | This.Converter := Converter; 48 | This.Input_Channel := Input_Channel; 49 | This.Input_Pin := Input_Pin; 50 | end Assign_ADC; 51 | 52 | ---------------- 53 | -- Initialize -- 54 | ---------------- 55 | 56 | procedure Initialize 57 | (This : in out NXT_Analog_Sensor) 58 | is 59 | begin 60 | Enable_Clock (This.Input_Pin); 61 | This.Input_Pin.Configure_IO ((Mode_Analog, Resistors => Floating)); 62 | 63 | Enable_Clock (This.Converter.all); 64 | Configure_Unit 65 | (This.Converter.all, 66 | Resolution => NXT_Brick_ADC_Resolution, 67 | Alignment => Right_Aligned); 68 | end Initialize; 69 | 70 | ------------------- 71 | -- Get_Intensity -- 72 | ------------------- 73 | 74 | procedure Get_Intensity 75 | (This : in out NXT_Analog_Sensor; 76 | Reading : out Intensity; 77 | Successful : out Boolean) 78 | is 79 | Raw : Integer; 80 | Scaled : Integer; 81 | begin 82 | Get_Raw_Reading (NXT_Analog_Sensor'Class (This), Raw, Successful); 83 | if not Successful then 84 | Reading := 0; 85 | return; 86 | end if; 87 | Raw := As_Varying_Directly (Raw); 88 | Scaled := Mapped (Raw, This.Low, This.High, Intensity'First, Intensity'Last); 89 | Reading := Constrained (Scaled, Intensity'First, Intensity'Last); 90 | end Get_Intensity; 91 | 92 | ------------ 93 | -- Enable -- 94 | ------------ 95 | 96 | procedure Enable (This : in out NXT_Analog_Sensor) is 97 | begin 98 | STM32.ADC.Enable (This.Converter.all); 99 | end Enable; 100 | 101 | ------------- 102 | -- Disable -- 103 | ------------- 104 | 105 | procedure Disable (This : in out NXT_Analog_Sensor) is 106 | begin 107 | STM32.ADC.Disable (This.Converter.all); 108 | end Disable; 109 | 110 | ------------- 111 | -- Enabled -- 112 | ------------- 113 | 114 | function Enabled (This : NXT_Analog_Sensor) return Boolean is 115 | (STM32.ADC.Enabled (This.Converter.all)); 116 | 117 | --------------------- 118 | -- Set_Calibration -- 119 | --------------------- 120 | 121 | procedure Set_Calibration 122 | (This : in out NXT_Analog_Sensor; 123 | Least : Varying_Directly; 124 | Greatest : Varying_Directly) 125 | is 126 | begin 127 | This.Low := Least; 128 | This.High := Greatest; 129 | end Set_Calibration; 130 | 131 | ----------------- 132 | -- Calibration -- 133 | ----------------- 134 | 135 | function Calibration (This : NXT_Analog_Sensor) return Sensor_Calibration is 136 | (This.Low, This.High); 137 | 138 | end NXT.Analog; 139 | -------------------------------------------------------------------------------- /src/nxt/sensors/nxt-light_sensors-constructors.adb: -------------------------------------------------------------------------------- 1 | package body NXT.Light_Sensors.Constructors is 2 | 3 | ---------------------- 4 | -- New_Light_Sensor -- 5 | ---------------------- 6 | 7 | function New_Light_Sensor 8 | (Converter : not null access Analog_To_Digital_Converter; 9 | Input_Channel : Analog_Input_Channel; 10 | Input_Pin : GPIO_Point; 11 | Controller : not null access DMA_Controller; 12 | Stream : DMA_Stream_Selector; 13 | Floodlight_Pin : GPIO_Point) 14 | return NXT_Light_Sensor 15 | is 16 | begin 17 | return Result : NXT_Light_Sensor do 18 | Result.Assign_ADC (Converter, Input_Channel, Input_Pin); 19 | Result.Assign_DMA (Controller, Stream); 20 | Result.Floodlight_Pin := Floodlight_Pin; 21 | end return; 22 | end New_Light_Sensor; 23 | 24 | end NXT.Light_Sensors.Constructors; 25 | -------------------------------------------------------------------------------- /src/nxt/sensors/nxt-light_sensors-constructors.ads: -------------------------------------------------------------------------------- 1 | with STM32.ADC; use STM32.ADC; 2 | with STM32.DMA; use STM32.DMA; 3 | 4 | package NXT.Light_Sensors.Constructors is 5 | 6 | function New_Light_Sensor 7 | (Converter : not null access Analog_To_Digital_Converter; 8 | Input_Channel : Analog_Input_Channel; 9 | Input_Pin : GPIO_Point; 10 | Controller : not null access DMA_Controller; 11 | Stream : DMA_Stream_Selector; 12 | Floodlight_Pin : GPIO_Point) 13 | return NXT_Light_Sensor; 14 | 15 | end NXT.Light_Sensors.Constructors; 16 | -------------------------------------------------------------------------------- /src/nxt/sensors/nxt-light_sensors.adb: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------ 2 | -- -- 3 | -- Copyright (C) 2017, AdaCore -- 4 | -- -- 5 | -- Redistribution and use inC source and binary forms, with or without -- 6 | -- modification, are permitted provided that the following conditions are -- 7 | -- met: -- 8 | -- 1. Redistributions of source code must retain the above copyright -- 9 | -- notice, this list of conditions and the following disclaimer. -- 10 | -- 2. Redistributions in binary form must reproduce the above copyright -- 11 | -- notice, this list of conditions and the following disclaimer in -- 12 | -- the documentation and/or other materials provided with the -- 13 | -- distribution. -- 14 | -- 3. Neither the name of STMicroelectronics nor the names of its -- 15 | -- contributors may be used to endorse or promote products derived -- 16 | -- from this software without specific prior written permission. -- 17 | -- -- 18 | -- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -- 19 | -- "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -- 20 | -- LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR -- 21 | -- A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -- 22 | -- HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, -- 23 | -- SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -- 24 | -- LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, -- 25 | -- DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -- 26 | -- THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT -- 27 | -- (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE -- 28 | -- OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -- 29 | -- -- 30 | ------------------------------------------------------------------------------ 31 | 32 | with STM32.Device; use STM32.Device; 33 | 34 | package body NXT.Light_Sensors is 35 | 36 | ---------------- 37 | -- Initialize -- 38 | ---------------- 39 | 40 | overriding 41 | procedure Initialize 42 | (This : in out NXT_Light_Sensor) 43 | is 44 | begin 45 | Initialize (NXT_Analog_Sensor_DMA (This)); 46 | 47 | Enable_Clock (This.Floodlight_Pin); 48 | This.Floodlight_Pin.Configure_IO 49 | ((Mode => Mode_Out, 50 | Resistors => Pull_Down, 51 | Speed => Speed_Medium, 52 | Output_Type => Push_Pull)); 53 | 54 | Disable_Floodlight (This); 55 | end Initialize; 56 | 57 | ------------------------- 58 | -- Enable_Output_Light -- 59 | ------------------------- 60 | 61 | procedure Enable_Floodlight (This : in out NXT_Light_Sensor) is 62 | begin 63 | This.Floodlight_Pin.Set; 64 | This.Floodlight_Enabled := True; 65 | end Enable_Floodlight; 66 | 67 | -------------------------- 68 | -- Disable_Output_Light -- 69 | -------------------------- 70 | 71 | procedure Disable_Floodlight (This : in out NXT_Light_Sensor) is 72 | begin 73 | This.Floodlight_Pin.Clear; 74 | This.Floodlight_Enabled := False; 75 | end Disable_Floodlight; 76 | 77 | ------------------------ 78 | -- Floodlight_Enabled -- 79 | ------------------------ 80 | 81 | function Floodlight_Enabled (This : NXT_Light_Sensor) return Boolean is 82 | (This.Floodlight_Enabled); 83 | 84 | end NXT.Light_Sensors; 85 | -------------------------------------------------------------------------------- /src/nxt/sensors/nxt-light_sensors.ads: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------ 2 | -- -- 3 | -- Copyright (C) 2017, AdaCore -- 4 | -- -- 5 | -- Redistribution and use in source and binary forms, with or without -- 6 | -- modification, are permitted provided that the following conditions are -- 7 | -- met: -- 8 | -- 1. Redistributions of source code must retain the above copyright -- 9 | -- notice, this list of conditions and the following disclaimer. -- 10 | -- 2. Redistributions in binary form must reproduce the above copyright -- 11 | -- notice, this list of conditions and the following disclaimer in -- 12 | -- the documentation and/or other materials provided with the -- 13 | -- distribution. -- 14 | -- 3. Neither the name of STMicroelectronics nor the names of its -- 15 | -- contributors may be used to endorse or promote products derived -- 16 | -- from this software without specific prior written permission. -- 17 | -- -- 18 | -- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -- 19 | -- "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -- 20 | -- LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR -- 21 | -- A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -- 22 | -- HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, -- 23 | -- SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -- 24 | -- LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, -- 25 | -- DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -- 26 | -- THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT -- 27 | -- (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE -- 28 | -- OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -- 29 | -- -- 30 | ------------------------------------------------------------------------------ 31 | 32 | -- This package provides a concrete subclass interface to the NXT light 33 | -- sensor. This subclass uses DMA to acquire the raw sensor readings. 34 | 35 | -- Note that you must have an external pull-up resistor tied to +5V on the 36 | -- analog input pin. A 10K resistor works well. 37 | 38 | -- In addition to the sensor-specific call to procedure Initialize, clients 39 | -- are responsible for making the following calls to the ADC routines. They 40 | -- are not called internally by Initialize because the functionality and 41 | -- settings are independent of the specific ADC unit used for the sensor, 42 | -- i.e., we don't want to hard-code them globally for one usage. The arguments 43 | -- to procedure Configure_Common_Properties indicated below work with the NXT 44 | -- sound and light sensors 45 | -- 46 | -- STM32.ADC.Reset_All_ADC_Units; 47 | -- 48 | -- STM32.ADC.Configure_Common_Properties 49 | -- (Mode => Independent, 50 | -- Prescalar => PCLK2_Div_2, 51 | -- DMA_Mode => Disabled, 52 | -- Sampling_Delay => Sampling_Delay_5_Cycles); 53 | 54 | with NXT.Analog.DMA; use NXT.Analog.DMA; 55 | with STM32.GPIO; use STM32.GPIO; 56 | 57 | package NXT.Light_Sensors is 58 | 59 | type NXT_Light_Sensor is new NXT_Analog_Sensor_DMA with private; 60 | 61 | overriding 62 | procedure Initialize (This : in out NXT_Light_Sensor) with 63 | Post => not Floodlight_Enabled (This); 64 | 65 | procedure Enable_Floodlight (This : in out NXT_Light_Sensor) with 66 | Post => Floodlight_Enabled (This); 67 | 68 | procedure Disable_Floodlight (This : in out NXT_Light_Sensor) with 69 | Post => not Floodlight_Enabled (This); 70 | 71 | function Floodlight_Enabled (This : NXT_Light_Sensor) return Boolean; 72 | 73 | private 74 | 75 | type NXT_Light_Sensor is new NXT_Analog_Sensor_DMA with record 76 | Floodlight_Pin : GPIO_Point; 77 | Floodlight_Enabled : Boolean := False; 78 | end record; 79 | 80 | end NXT.Light_Sensors; 81 | -------------------------------------------------------------------------------- /src/nxt/sensors/nxt-sound_sensors-constructors.adb: -------------------------------------------------------------------------------- 1 | package body NXT.Sound_Sensors.Constructors is 2 | 3 | ---------------------- 4 | -- New_Light_Sensor -- 5 | ---------------------- 6 | 7 | function New_Sound_Sensor 8 | (Converter : not null access Analog_To_Digital_Converter; 9 | Input_Channel : Analog_Input_Channel; 10 | Input_Pin : GPIO_Point; 11 | Controller : not null access DMA_Controller; 12 | Stream : DMA_Stream_Selector; 13 | Mode_Pin_0 : GPIO_Point; 14 | Mode_Pin_1 : GPIO_Point) 15 | return NXT_Sound_Sensor 16 | is 17 | begin 18 | return Result : NXT_Sound_Sensor do 19 | Result.Assign_ADC (Converter, Input_Channel, Input_Pin); 20 | Result.Assign_DMA (Controller, Stream); 21 | Result.Mode_Pin_0 := Mode_Pin_0; 22 | Result.Mode_Pin_1 := Mode_Pin_1; 23 | end return; 24 | end New_Sound_Sensor; 25 | 26 | end NXT.Sound_Sensors.Constructors; 27 | -------------------------------------------------------------------------------- /src/nxt/sensors/nxt-sound_sensors-constructors.ads: -------------------------------------------------------------------------------- 1 | with STM32.ADC; use STM32.ADC; 2 | with STM32.DMA; use STM32.DMA; 3 | 4 | package NXT.Sound_Sensors.Constructors is 5 | 6 | function New_Sound_Sensor 7 | (Converter : not null access Analog_To_Digital_Converter; 8 | Input_Channel : Analog_Input_Channel; 9 | Input_Pin : GPIO_Point; 10 | Controller : not null access DMA_Controller; 11 | Stream : DMA_Stream_Selector; 12 | Mode_Pin_0 : GPIO_Point; 13 | Mode_Pin_1 : GPIO_Point) 14 | return NXT_Sound_Sensor; 15 | 16 | end NXT.Sound_Sensors.Constructors; 17 | -------------------------------------------------------------------------------- /src/nxt/sensors/nxt-sound_sensors.adb: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------ 2 | -- -- 3 | -- Copyright (C) 2017, AdaCore -- 4 | -- -- 5 | -- Redistribution and use in source and binary forms, with or without -- 6 | -- modification, are permitted provided that the following conditions are -- 7 | -- met: -- 8 | -- 1. Redistributions of source code must retain the above copyright -- 9 | -- notice, this list of conditions and the following disclaimer. -- 10 | -- 2. Redistributions in binary form must reproduce the above copyright -- 11 | -- notice, this list of conditions and the following disclaimer in -- 12 | -- the documentation and/or other materials provided with the -- 13 | -- distribution. -- 14 | -- 3. Neither the name of STMicroelectronics nor the names of its -- 15 | -- contributors may be used to endorse or promote products derived -- 16 | -- from this software without specific prior written permission. -- 17 | -- -- 18 | -- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -- 19 | -- "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -- 20 | -- LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR -- 21 | -- A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -- 22 | -- HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, -- 23 | -- SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -- 24 | -- LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, -- 25 | -- DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -- 26 | -- THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT -- 27 | -- (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE -- 28 | -- OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -- 29 | -- -- 30 | ------------------------------------------------------------------------------ 31 | 32 | with STM32.Device; use STM32.Device; 33 | 34 | package body NXT.Sound_Sensors is 35 | 36 | ---------------- 37 | -- Initialize -- 38 | ---------------- 39 | 40 | overriding 41 | procedure Initialize 42 | (This : in out NXT_Sound_Sensor) 43 | is 44 | begin 45 | Initialize (NXT_Analog_Sensor_DMA (This)); 46 | 47 | Enable_Clock (This.Mode_Pin_0); 48 | Enable_Clock (This.Mode_Pin_1); 49 | 50 | Configure_IO 51 | (This.Mode_Pin_0 & This.Mode_Pin_1, 52 | (Mode => Mode_Out, 53 | Resistors => Pull_Down, 54 | Speed => Speed_Medium, 55 | Output_Type => Push_Pull)); 56 | 57 | Set_Mode (This, dB); 58 | end Initialize; 59 | 60 | -------------- 61 | -- Set_Mode -- 62 | -------------- 63 | 64 | procedure Set_Mode (This : in out NXT_Sound_Sensor; Mode : Sound_Modes) is 65 | begin 66 | case Mode is 67 | when dB => 68 | This.Mode_Pin_0.Set; 69 | This.Mode_Pin_1.Clear; 70 | when dBA => 71 | This.Mode_Pin_0.Clear; 72 | This.Mode_Pin_1.Set; 73 | end case; 74 | This.Mode := Mode; 75 | end Set_Mode; 76 | 77 | ------------------ 78 | -- Current_Mode -- 79 | ------------------ 80 | 81 | function Current_Mode (This : NXT_Sound_Sensor) return Sound_Modes is 82 | (This.Mode); 83 | 84 | end NXT.Sound_Sensors; 85 | -------------------------------------------------------------------------------- /src/nxt/sensors/nxt-sound_sensors.ads: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------ 2 | -- -- 3 | -- Copyright (C) 2017, AdaCore -- 4 | -- -- 5 | -- Redistribution and use in source and binary forms, with or without -- 6 | -- modification, are permitted provided that the following conditions are -- 7 | -- met: -- 8 | -- 1. Redistributions of source code must retain the above copyright -- 9 | -- notice, this list of conditions and the following disclaimer. -- 10 | -- 2. Redistributions in binary form must reproduce the above copyright -- 11 | -- notice, this list of conditions and the following disclaimer in -- 12 | -- the documentation and/or other materials provided with the -- 13 | -- distribution. -- 14 | -- 3. Neither the name of STMicroelectronics nor the names of its -- 15 | -- contributors may be used to endorse or promote products derived -- 16 | -- from this software without specific prior written permission. -- 17 | -- -- 18 | -- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -- 19 | -- "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -- 20 | -- LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR -- 21 | -- A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -- 22 | -- HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, -- 23 | -- SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -- 24 | -- LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, -- 25 | -- DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -- 26 | -- THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT -- 27 | -- (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE -- 28 | -- OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -- 29 | -- -- 30 | ------------------------------------------------------------------------------ 31 | 32 | -- This package provides a concrete subclass interface to the NXT sound 33 | -- sensor. This subclass uses DMA to acquire the raw sensor readings. 34 | 35 | -- Note that you must have an external pull-up resistor tied to +5V on the 36 | -- analog input pin. A 10K resistor works well. 37 | 38 | -- In addition to the sensor-specific call to procedure Initialize, clients 39 | -- are responsible for making the following calls to the ADC routines. They 40 | -- are not called internally by Initialize because the functionality and 41 | -- settings are independent of the specific ADC unit used for the sensor, 42 | -- i.e., we don't want to hard-code them globally for one usage. The arguments 43 | -- to procedure Configure_Common_Properties indicated below work with the NXT 44 | -- sound and light sensors 45 | -- 46 | -- STM32.ADC.Reset_All_ADC_Units; 47 | -- 48 | -- STM32.ADC.Configure_Common_Properties 49 | -- (Mode => Independent, 50 | -- Prescalar => PCLK2_Div_2, 51 | -- DMA_Mode => Disabled, 52 | -- Sampling_Delay => Sampling_Delay_5_Cycles); 53 | 54 | with NXT.Analog.DMA; use NXT.Analog.DMA; 55 | with STM32.GPIO; use STM32.GPIO; 56 | 57 | package NXT.Sound_Sensors is 58 | 59 | type NXT_Sound_Sensor is new NXT_Analog_Sensor_DMA with private; 60 | 61 | -- For the sensor readings, the following values are roughly what to 62 | -- expect: 63 | -- 64 | -- 4-5% : a silent living room 65 | -- 5-10% : someone talking some distance away 66 | -- 10-30% : a normal conversation close to the sensor 67 | -- 30-100% : people shouting or music being played at a high volume 68 | 69 | overriding 70 | procedure Initialize (This : in out NXT_Sound_Sensor); 71 | 72 | type Sound_Modes is (dB, dBA); 73 | -- The NXT Sound Sensor can be set to work in one of two modes. 74 | -- Specifically, the sensor can detect both decibels [dB] and 75 | -- adjusted decibels [dBA] in the two distinct modes. 76 | -- 77 | -- dBA: in detecting adjusted decibels, the sensitivity of the sensor is 78 | -- adapted to the sensitivity of the human ear. In other words, these are 79 | -- the sounds that your ears are able to hear. 80 | -- 81 | -- dB: in detecting standard [unadjusted] decibels, all sounds are measured 82 | -- with equal sensitivity. Thus, these sounds may include some that are too 83 | -- high or too low for the human ear to hear. 84 | 85 | procedure Set_Mode (This : in out NXT_Sound_Sensor; Mode : Sound_Modes); 86 | 87 | function Current_Mode (This : NXT_Sound_Sensor) return Sound_Modes; 88 | 89 | private 90 | 91 | type NXT_Sound_Sensor is new NXT_Analog_Sensor_DMA with record 92 | Mode_Pin_0 : GPIO_Point; 93 | Mode_Pin_1 : GPIO_Point; 94 | Mode : Sound_Modes := dB; 95 | end record; 96 | 97 | end NXT.Sound_Sensors; 98 | -------------------------------------------------------------------------------- /src/nxt/sensors/nxt-touch_sensors.adb: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------ 2 | -- -- 3 | -- Copyright (C) 2017-2018, AdaCore -- 4 | -- -- 5 | -- Redistribution and use in source and binary forms, with or without -- 6 | -- modification, are permitted provided that the following conditions are -- 7 | -- met: -- 8 | -- 1. Redistributions of source code must retain the above copyright -- 9 | -- notice, this list of conditions and the following disclaimer. -- 10 | -- 2. Redistributions in binary form must reproduce the above copyright -- 11 | -- notice, this list of conditions and the following disclaimer in -- 12 | -- the documentation and/or other materials provided with the -- 13 | -- distribution. -- 14 | -- 3. Neither the name of STMicroelectronics nor the names of its -- 15 | -- contributors may be used to endorse or promote products derived -- 16 | -- from this software without specific prior written permission. -- 17 | -- -- 18 | -- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -- 19 | -- "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -- 20 | -- LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR -- 21 | -- A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -- 22 | -- HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, -- 23 | -- SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -- 24 | -- LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, -- 25 | -- DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -- 26 | -- THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT -- 27 | -- (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE -- 28 | -- OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -- 29 | -- -- 30 | ------------------------------------------------------------------------------ 31 | 32 | package body NXT.Touch_Sensors is 33 | 34 | ----------------------- 35 | -- Currently_Pressed -- 36 | ----------------------- 37 | 38 | function Currently_Pressed (This : Touch_Sensor) return Boolean is 39 | (This.Active_Indicated); 40 | 41 | ------------------- 42 | -- Await_Pressed -- 43 | ------------------- 44 | 45 | procedure Await_Pressed (This : in out Touch_Sensor) is 46 | begin 47 | This.Await_Active; 48 | end Await_Pressed; 49 | 50 | -------------------- 51 | -- Await_Released -- 52 | -------------------- 53 | 54 | procedure Await_Released (This : in out Touch_Sensor) is 55 | begin 56 | This.Await_Inactive; 57 | end Await_Released; 58 | 59 | ------------------ 60 | -- Await_Toggle -- 61 | ------------------ 62 | 63 | procedure Await_Toggle (This : in out Touch_Sensor) is 64 | begin 65 | This.Await_Pressed; 66 | This.Await_Released; 67 | end Await_Toggle; 68 | 69 | ------------------------- 70 | -- Initialize_Hardware -- 71 | ------------------------- 72 | 73 | overriding procedure Initialize_Hardware (This : in out Touch_Sensor) is 74 | begin 75 | Discrete_Input (This).Initialize_Hardware; 76 | end Initialize_Hardware; 77 | 78 | end NXT.Touch_Sensors; 79 | -------------------------------------------------------------------------------- /src/nxt/sensors/nxt-touch_sensors.ads: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------ 2 | -- -- 3 | -- Copyright (C) 2017-2018, AdaCore -- 4 | -- -- 5 | -- Redistribution and use in source and binary forms, with or without -- 6 | -- modification, are permitted provided that the following conditions are -- 7 | -- met: -- 8 | -- 1. Redistributions of source code must retain the above copyright -- 9 | -- notice, this list of conditions and the following disclaimer. -- 10 | -- 2. Redistributions in binary form must reproduce the above copyright -- 11 | -- notice, this list of conditions and the following disclaimer in -- 12 | -- the documentation and/or other materials provided with the -- 13 | -- distribution. -- 14 | -- 3. Neither the name of STMicroelectronics nor the names of its -- 15 | -- contributors may be used to endorse or promote products derived -- 16 | -- from this software without specific prior written permission. -- 17 | -- -- 18 | -- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -- 19 | -- "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -- 20 | -- LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR -- 21 | -- A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -- 22 | -- HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, -- 23 | -- SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -- 24 | -- LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, -- 25 | -- DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -- 26 | -- THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT -- 27 | -- (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE -- 28 | -- OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -- 29 | -- -- 30 | ------------------------------------------------------------------------------ 31 | 32 | with STM32.GPIO; use STM32.GPIO; 33 | with Discrete_Inputs; use Discrete_Inputs; 34 | 35 | package NXT.Touch_Sensors is 36 | 37 | type Touch_Sensor (Pin : access GPIO_Point; Active : Logic_Levels) is 38 | tagged private; 39 | -- A sensor consisting of a momentary button switch on the front. 40 | 41 | function Currently_Pressed (This : Touch_Sensor) return Boolean; 42 | 43 | procedure Await_Pressed (This : in out Touch_Sensor); 44 | -- Wait for the sensor button to be pressed. 45 | -- Uses polling. 46 | 47 | procedure Await_Released (This : in out Touch_Sensor); 48 | -- Wait for the sensor button to be released. 49 | -- Uses polling. 50 | 51 | procedure Await_Toggle (This : in out Touch_Sensor); 52 | -- Wait for the sensor button to be pressed and then subsequently released, 53 | -- in that order. 54 | -- Uses polling. 55 | 56 | procedure Initialize_Hardware (This : in out Touch_Sensor); 57 | 58 | private 59 | 60 | type Touch_Sensor (Pin : access GPIO_Point; Active : Logic_Levels) is 61 | new Discrete_Input (Pin, Active) with null record; 62 | 63 | end NXT.Touch_Sensors; 64 | -------------------------------------------------------------------------------- /src/signal_processing/recursive_moving_average_filters_discretes.adb: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------ 2 | -- -- 3 | -- Copyright (C) 2020, AdaCore -- 4 | -- -- 5 | -- Redistribution and use in source and binary forms, with or without -- 6 | -- modification, are permitted provided that the following conditions are -- 7 | -- met: -- 8 | -- 1. Redistributions of source code must retain the above copyright -- 9 | -- notice, this list of conditions and the following disclaimer. -- 10 | -- 2. Redistributions in binary form must reproduce the above copyright -- 11 | -- notice, this list of conditions and the following disclaimer in -- 12 | -- the documentation and/or other materials provided with the -- 13 | -- distribution. -- 14 | -- 3. Neither the name of the copyright holder nor the names of its -- 15 | -- contributors may be used to endorse or promote products derived -- 16 | -- from this software without specific prior written permission. -- 17 | -- -- 18 | -- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -- 19 | -- "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -- 20 | -- LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR -- 21 | -- A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -- 22 | -- HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, -- 23 | -- SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -- 24 | -- LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, -- 25 | -- DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -- 26 | -- THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT -- 27 | -- (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE -- 28 | -- OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -- 29 | -- -- 30 | ------------------------------------------------------------------------------ 31 | 32 | with Math_Utilities; 33 | 34 | package body Recursive_Moving_Average_Filters_Discretes is 35 | 36 | procedure Safely_Add (Value : Sample; To : in out Accumulator) with Inline; 37 | -- Add sample Value (which can be negative) to the value of To, without 38 | -- overflowing 39 | 40 | procedure Safely_Subtract (Value : Sample; From : in out Accumulator) with Inline; 41 | -- Subtract sample Value (which can be negative) from the value of From, 42 | -- without overflowing 43 | 44 | ----------- 45 | -- Value -- 46 | ----------- 47 | 48 | function Value (This : RMA_Filter) return Sample is 49 | (This.Averaged_Value); 50 | 51 | ----------- 52 | -- Limit -- 53 | ----------- 54 | 55 | procedure Limit is new Math_Utilities.Bound_Integer_Value (T => Accumulator); 56 | 57 | ------------ 58 | -- Insert -- 59 | ------------ 60 | 61 | procedure Insert (This : in out RMA_Filter; New_Sample : Sample) is 62 | Average : Accumulator; 63 | begin 64 | if Empty (This.Samples) then 65 | Put (This.Samples, New_Sample); 66 | This.Total := Accumulator (New_Sample); 67 | This.Averaged_Value := New_Sample; 68 | return; 69 | end if; 70 | 71 | if Full (This.Samples) then 72 | -- Delete the oldest sample and remove its value from total (rather 73 | -- than iterate over all the samples in order to calculate a new 74 | -- total. 75 | declare 76 | Oldest : Sample; 77 | begin 78 | Get (This.Samples, Oldest); 79 | Safely_Subtract (Oldest, From => This.Total); 80 | end; 81 | end if; 82 | 83 | Put (This.Samples, New_Sample); 84 | 85 | Safely_Add (New_Sample, To => This.Total); 86 | 87 | Average := This.Total / Accumulator (Extent (This.Samples)); 88 | Limit (Average, Accumulator (Sample'First), Accumulator (Sample'Last)); 89 | This.Averaged_Value := Sample (Average); 90 | end Insert; 91 | 92 | ---------------- 93 | -- Safely_Add -- 94 | ---------------- 95 | 96 | procedure Safely_Add (Value : Sample; To : in out Accumulator) is 97 | begin 98 | if Value > 0 then 99 | if To <= Accumulator'Last - Accumulator (Value) then 100 | To := To + Accumulator (Value); 101 | else 102 | To := Accumulator'Last; 103 | end if; 104 | else -- Value is negative (or zero) 105 | if To >= Accumulator'First - Accumulator (Value) then 106 | To := To + Accumulator (Value); 107 | else 108 | To := Accumulator'First; 109 | end if; 110 | end if; 111 | end Safely_Add; 112 | 113 | --------------------- 114 | -- Safely_Subtract -- 115 | --------------------- 116 | 117 | procedure Safely_Subtract (Value : Sample; From : in out Accumulator) is 118 | begin 119 | if Value > 0 then 120 | if From >= Accumulator'First + Accumulator (Value) then 121 | From := From - Accumulator (Value); 122 | else 123 | From := Accumulator'First; 124 | end if; 125 | else -- Value is negative (or zero) 126 | if From <= Accumulator'Last + Accumulator (Value) then 127 | From := From - Accumulator (Value); 128 | else 129 | From := Accumulator'Last; 130 | end if; 131 | end if; 132 | end Safely_Subtract; 133 | 134 | ----------- 135 | -- Reset -- 136 | ----------- 137 | 138 | procedure Reset (This : out RMA_Filter) is 139 | begin 140 | Reset (This.Samples); 141 | This.Averaged_Value := 0; 142 | This.Total := 0; 143 | end Reset; 144 | 145 | end Recursive_Moving_Average_Filters_Discretes; 146 | -------------------------------------------------------------------------------- /src/signal_processing/recursive_moving_average_filters_discretes.ads: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------ 2 | -- -- 3 | -- Copyright (C) 2020, AdaCore -- 4 | -- -- 5 | -- Redistribution and use in source and binary forms, with or without -- 6 | -- modification, are permitted provided that the following conditions are -- 7 | -- met: -- 8 | -- 1. Redistributions of source code must retain the above copyright -- 9 | -- notice, this list of conditions and the following disclaimer. -- 10 | -- 2. Redistributions in binary form must reproduce the above copyright -- 11 | -- notice, this list of conditions and the following disclaimer in -- 12 | -- the documentation and/or other materials provided with the -- 13 | -- distribution. -- 14 | -- 3. Neither the name of the copyright holder nor the names of its -- 15 | -- contributors may be used to endorse or promote products derived -- 16 | -- from this software without specific prior written permission. -- 17 | -- -- 18 | -- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -- 19 | -- "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -- 20 | -- LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR -- 21 | -- A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -- 22 | -- HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, -- 23 | -- SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -- 24 | -- LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, -- 25 | -- DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -- 26 | -- THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT -- 27 | -- (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE -- 28 | -- OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -- 29 | -- -- 30 | ------------------------------------------------------------------------------ 31 | 32 | -- Recursive Moving Average (RMA) filters for any integer sample (ie input and 33 | -- output) type. 34 | 35 | -- This implementation keeps a running total of the input values rather 36 | -- than iterating over the current inputs each time a new sample is inserted 37 | -- (in order to compute the running average). In cases that would lead to 38 | -- overflow,the total is limited to Accumulator'First or Accumulator'Last. 39 | -- The average returned from function Value is limited to Sample'First or 40 | -- Sample'Last. 41 | 42 | -- This design assumes new input sample values are acquired one at a time, and 43 | -- thus inserted into RMA_Filter objects individually. These RMA_Filter objects 44 | -- maintain their own buffers, of the size specified by their discriminant. 45 | 46 | with Sequential_Bounded_Buffers; 47 | 48 | generic 49 | 50 | type Sample is range <>; 51 | -- The type used for the input samples and output averages. 52 | 53 | type Accumulator is range <>; 54 | -- The type used for the running total of inputs. The intent is that this 55 | -- type has a larger range than that of type Sample, so that a larger total 56 | -- can be accommodated. 57 | 58 | -- For both types, null ranges are not allowed. We check that with the 59 | -- Compile_Time_Error pragmas below. 60 | 61 | package Recursive_Moving_Average_Filters_Discretes is 62 | 63 | pragma Compile_Time_Error 64 | (Sample'First > Sample'Last, 65 | "Sample range must not be null"); 66 | 67 | pragma Compile_Time_Error 68 | (Accumulator'First > Accumulator'Last, 69 | "Accumulator range must not be null"); 70 | 71 | subtype Filter_Window_Size is Integer range 1 .. Integer'Last / 2; 72 | 73 | type RMA_Filter (Window_Size : Filter_Window_Size) is tagged limited private; 74 | 75 | procedure Insert (This : in out RMA_Filter; New_Sample : Sample); 76 | -- Updates the new average value based on the value of New_Sample 77 | 78 | function Value (This : RMA_Filter) return Sample with Inline; 79 | -- simply returns the average value previously computed by Insert 80 | 81 | procedure Reset (This : out RMA_Filter) with 82 | Post'Class => Value (This) = 0; 83 | 84 | private 85 | 86 | package Sample_Data is new Sequential_Bounded_Buffers (Element => Sample, Default_Value => 0); 87 | use Sample_Data; 88 | 89 | type RMA_Filter (Window_Size : Filter_Window_Size) is tagged limited record 90 | Samples : Sample_Data.Ring_Buffer (Window_Size); 91 | Averaged_Value : Sample := 0; 92 | Total : Accumulator := 0; 93 | -- There is no issue of accumulating round-off errors over time, unlike 94 | -- what would happen if we used a floating point type for the Total 95 | end record; 96 | 97 | end Recursive_Moving_Average_Filters_Discretes; 98 | -------------------------------------------------------------------------------- /src/signal_processing/recursive_moving_average_filters_reals.adb: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------ 2 | -- -- 3 | -- Copyright (C) 2020, AdaCore -- 4 | -- -- 5 | -- Redistribution and use in source and binary forms, with or without -- 6 | -- modification, are permitted provided that the following conditions are -- 7 | -- met: -- 8 | -- 1. Redistributions of source code must retain the above copyright -- 9 | -- notice, this list of conditions and the following disclaimer. -- 10 | -- 2. Redistributions in binary form must reproduce the above copyright -- 11 | -- notice, this list of conditions and the following disclaimer in -- 12 | -- the documentation and/or other materials provided with the -- 13 | -- distribution. -- 14 | -- 3. Neither the name of the copyright holder nor the names of its -- 15 | -- contributors may be used to endorse or promote products derived -- 16 | -- from this software without specific prior written permission. -- 17 | -- -- 18 | -- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -- 19 | -- "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -- 20 | -- LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR -- 21 | -- A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -- 22 | -- HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, -- 23 | -- SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -- 24 | -- LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, -- 25 | -- DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -- 26 | -- THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT -- 27 | -- (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE -- 28 | -- OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -- 29 | -- -- 30 | ------------------------------------------------------------------------------ 31 | 32 | package body Recursive_Moving_Average_Filters_Reals is 33 | 34 | ----------- 35 | -- Value -- 36 | ----------- 37 | 38 | function Value (This : RMA_Filter) return Output is 39 | (This.Averaged_Value); 40 | 41 | ------------ 42 | -- Insert -- 43 | ------------ 44 | 45 | procedure Insert (This : in out RMA_Filter; New_Sample : Sample) is 46 | begin 47 | if Empty (This.Samples) then 48 | Put (This.Samples, New_Sample); 49 | This.Total := Accumulator (New_Sample); 50 | This.Averaged_Value := New_Sample; 51 | return; 52 | end if; 53 | 54 | if Full (This.Samples) then -- delete the oldest sample 55 | -- TODO: why not just call Get??? 56 | This.Total := This.Total - Accumulator (Next_Element_Out (This.Samples)); 57 | Delete (This.Samples, Count => 1); 58 | end if; 59 | 60 | Put (This.Samples, New_Sample); 61 | 62 | This.Total := This.Total + Accumulator (New_Sample); 63 | -- The above potentially overflows, but there is no issue of accumulating 64 | -- round-off errors over time, unlike what would happen if we used a 65 | -- floating point type. 66 | 67 | This.Averaged_Value := Output (This.Total) / Output (Extent (This.Samples)); 68 | end Insert; 69 | 70 | ----------- 71 | -- Reset -- 72 | ----------- 73 | 74 | procedure Reset (This : out RMA_Filter) is 75 | begin 76 | Reset (This.Samples); 77 | This.Averaged_Value := 0.0; 78 | This.Total := 0; 79 | end Reset; 80 | 81 | end Recursive_Moving_Average_Filters_Reals; 82 | -------------------------------------------------------------------------------- /src/signal_processing/recursive_moving_average_filters_reals.ads: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------ 2 | -- -- 3 | -- Copyright (C) 2020, AdaCore -- 4 | -- -- 5 | -- Redistribution and use in source and binary forms, with or without -- 6 | -- modification, are permitted provided that the following conditions are -- 7 | -- met: -- 8 | -- 1. Redistributions of source code must retain the above copyright -- 9 | -- notice, this list of conditions and the following disclaimer. -- 10 | -- 2. Redistributions in binary form must reproduce the above copyright -- 11 | -- notice, this list of conditions and the following disclaimer in -- 12 | -- the documentation and/or other materials provided with the -- 13 | -- distribution. -- 14 | -- 3. Neither the name of the copyright holder nor the names of its -- 15 | -- contributors may be used to endorse or promote products derived -- 16 | -- from this software without specific prior written permission. -- 17 | -- -- 18 | -- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -- 19 | -- "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -- 20 | -- LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR -- 21 | -- A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -- 22 | -- HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, -- 23 | -- SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -- 24 | -- LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, -- 25 | -- DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -- 26 | -- THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT -- 27 | -- (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE -- 28 | -- OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -- 29 | -- -- 30 | ------------------------------------------------------------------------------ 31 | 32 | -- Recursive Moving Average (RMA) filters for any floating point sample (ie input) 33 | -- type 34 | 35 | -- The moving average is the most common filter in DSP, used for reducing 36 | -- random noise while retaining a sharp step response. 37 | 38 | -- This implementation keeps a running total of the input values rather than 39 | -- iterating over the current inputs each time a new input sample is inserted 40 | -- (in order to compute the running average). However, eventual overflow is 41 | -- possible, given sufficiently large input sample values and a sufficiently 42 | -- long execution time. Choose the generic actual type for the type Accumulator 43 | -- accordingly. 44 | 45 | -- This design assumes new input sample values are acquired one at a time, 46 | -- and thus inserted into filter objects individually. These filter objects 47 | -- maintain their own buffers, of the size specified by their discriminant. 48 | 49 | with Sequential_Bounded_Buffers; 50 | 51 | generic 52 | 53 | type Sample is digits <>; 54 | -- the type used for the input samples 55 | 56 | type Output is digits <>; 57 | -- the type used for the output average provided 58 | 59 | type Accumulator is range <>; 60 | -- the type used for the running total of inputs 61 | 62 | package Recursive_Moving_Average_Filters_Reals is 63 | 64 | subtype Filter_Window_Size is Integer range 1 .. Integer'Last / 2; 65 | 66 | type RMA_Filter (Window_Size : Filter_Window_Size) is tagged limited private; 67 | 68 | procedure Insert (This : in out RMA_Filter; New_Sample : Sample); 69 | 70 | function Value (This : RMA_Filter) return Output with Inline; 71 | 72 | procedure Reset (This : out RMA_Filter); 73 | 74 | private 75 | 76 | package Sample_Data is new Sequential_Bounded_Buffers 77 | (Element => Sample, Default_Value => 0.0); 78 | use Sample_Data; 79 | 80 | type RMA_Filter (Window_Size : Filter_Window_Size) is tagged limited record 81 | Samples : Sample_Data.Ring_Buffer (Capacity => Window_Size); 82 | Averaged_Value : Output := 0.0; 83 | Total : Accumulator; 84 | end record; 85 | 86 | end Recursive_Moving_Average_Filters_Reals; 87 | -------------------------------------------------------------------------------- /src/signal_processing/simple_moving_average_filters.adb: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------ 2 | -- -- 3 | -- Copyright (C) 2020, AdaCore -- 4 | -- -- 5 | -- Redistribution and use in source and binary forms, with or without -- 6 | -- modification, are permitted provided that the following conditions are -- 7 | -- met: -- 8 | -- 1. Redistributions of source code must retain the above copyright -- 9 | -- notice, this list of conditions and the following disclaimer. -- 10 | -- 2. Redistributions in binary form must reproduce the above copyright -- 11 | -- notice, this list of conditions and the following disclaimer in -- 12 | -- the documentation and/or other materials provided with the -- 13 | -- distribution. -- 14 | -- 3. Neither the name of the copyright holder nor the names of its -- 15 | -- contributors may be used to endorse or promote products derived -- 16 | -- from this software without specific prior written permission. -- 17 | -- -- 18 | -- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -- 19 | -- "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -- 20 | -- LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR -- 21 | -- A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -- 22 | -- HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, -- 23 | -- SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -- 24 | -- LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, -- 25 | -- DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -- 26 | -- THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT -- 27 | -- (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE -- 28 | -- OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -- 29 | -- -- 30 | ------------------------------------------------------------------------------ 31 | 32 | package body Simple_Moving_Average_Filters is 33 | 34 | function New_Average (This : SMA_Filter) return Output; 35 | 36 | ----------- 37 | -- Value -- 38 | ----------- 39 | 40 | function Value (This : SMA_Filter) return Output is 41 | (This.MA_Value); 42 | 43 | ------------ 44 | -- Insert -- 45 | ------------ 46 | 47 | procedure Insert (This : in out SMA_Filter; New_Sample : Sample) is 48 | begin 49 | Put (This.Samples, New_Sample); 50 | This.MA_Value := New_Average (This); 51 | end Insert; 52 | 53 | ----------------- 54 | -- New_Average -- 55 | ----------------- 56 | 57 | function New_Average (This : SMA_Filter) return Output is 58 | Result : Output := 0.0; 59 | begin 60 | for Value of This.Samples loop 61 | Result := Result + As_Output (Value); 62 | end loop; 63 | 64 | if Extent (This.Samples) > 1 then 65 | Result := Result / Output (Extent (This.Samples)); 66 | end if; 67 | return Result; 68 | end New_Average; 69 | 70 | ----------- 71 | -- Reset -- 72 | ----------- 73 | 74 | procedure Reset (This : in out SMA_Filter) is 75 | begin 76 | Reset (This.Samples); 77 | This.MA_Value := 0.0; 78 | end Reset; 79 | 80 | end Simple_Moving_Average_Filters; 81 | -------------------------------------------------------------------------------- /src/signal_processing/simple_moving_average_filters.ads: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------ 2 | -- -- 3 | -- Copyright (C) 2020, AdaCore -- 4 | -- -- 5 | -- Redistribution and use in source and binary forms, with or without -- 6 | -- modification, are permitted provided that the following conditions are -- 7 | -- met: -- 8 | -- 1. Redistributions of source code must retain the above copyright -- 9 | -- notice, this list of conditions and the following disclaimer. -- 10 | -- 2. Redistributions in binary form must reproduce the above copyright -- 11 | -- notice, this list of conditions and the following disclaimer in -- 12 | -- the documentation and/or other materials provided with the -- 13 | -- distribution. -- 14 | -- 3. Neither the name of the copyright holder nor the names of its -- 15 | -- contributors may be used to endorse or promote products derived -- 16 | -- from this software without specific prior written permission. -- 17 | -- -- 18 | -- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -- 19 | -- "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -- 20 | -- LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR -- 21 | -- A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -- 22 | -- HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, -- 23 | -- SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -- 24 | -- LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, -- 25 | -- DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -- 26 | -- THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT -- 27 | -- (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE -- 28 | -- OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -- 29 | -- -- 30 | ------------------------------------------------------------------------------ 31 | 32 | -- This implementation computes the sum of the current inputs each time a new 33 | -- input is inserted (in order to compute the running average), so the cost is 34 | -- paid per call to insert a new sample, but it should be able to run "forever" 35 | -- without concern for eventual overflow because a total of the entire history 36 | -- of inputs is not maintained (which would be the alternative to summing the 37 | -- values each time, per the Recursive Moving Average design). 38 | 39 | with Sequential_Bounded_Buffers; 40 | 41 | generic 42 | 43 | type Sample is private; 44 | -- the type used for the input samples 45 | 46 | Default_Sample_Value : Sample; 47 | -- an arbitrary value used for internal initialization, but nothing else 48 | 49 | type Output is digits <>; 50 | -- the type used for the output average provided 51 | 52 | with function As_Output (Input : Sample) return Output; 53 | -- a conversion routne from Sample input value to the Output type 54 | 55 | package Simple_Moving_Average_Filters is 56 | 57 | type SMA_Filter (Window_Size : Positive) is tagged limited private; 58 | 59 | procedure Insert (This : in out SMA_Filter; New_Sample : Sample); 60 | 61 | function Value (This : SMA_Filter) return Output with Inline; 62 | 63 | procedure Reset (This : in out SMA_Filter); 64 | 65 | private 66 | 67 | package Sample_Data is new Sequential_Bounded_Buffers 68 | (Element => Sample, Default_Value => Default_Sample_Value); 69 | use Sample_Data; 70 | 71 | type SMA_Filter (Window_Size : Positive) is tagged limited record 72 | Samples : Sample_Data.Ring_Buffer (Window_Size); 73 | MA_Value : Output := 0.0; 74 | end record; 75 | 76 | end Simple_Moving_Average_Filters; 77 | -------------------------------------------------------------------------------- /src/signal_processing/simple_moving_average_filters_reals.adb: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------ 2 | -- -- 3 | -- Copyright (C) 2020, AdaCore -- 4 | -- -- 5 | -- Redistribution and use in source and binary forms, with or without -- 6 | -- modification, are permitted provided that the following conditions are -- 7 | -- met: -- 8 | -- 1. Redistributions of source code must retain the above copyright -- 9 | -- notice, this list of conditions and the following disclaimer. -- 10 | -- 2. Redistributions in binary form must reproduce the above copyright -- 11 | -- notice, this list of conditions and the following disclaimer in -- 12 | -- the documentation and/or other materials provided with the -- 13 | -- distribution. -- 14 | -- 3. Neither the name of the copyright holder nor the names of its -- 15 | -- contributors may be used to endorse or promote products derived -- 16 | -- from this software without specific prior written permission. -- 17 | -- -- 18 | -- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -- 19 | -- "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -- 20 | -- LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR -- 21 | -- A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -- 22 | -- HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, -- 23 | -- SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -- 24 | -- LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, -- 25 | -- DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -- 26 | -- THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT -- 27 | -- (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE -- 28 | -- OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -- 29 | -- -- 30 | ------------------------------------------------------------------------------ 31 | 32 | package body Simple_Moving_Average_Filters_Reals is 33 | 34 | function New_Average (This : SMA_Filter) return Output; 35 | 36 | ----------- 37 | -- Value -- 38 | ----------- 39 | 40 | function Value (This : SMA_Filter) return Output is 41 | (This.MA_Value); 42 | 43 | ------------ 44 | -- Insert -- 45 | ------------ 46 | 47 | procedure Insert (This : in out SMA_Filter; New_Sample : Sample) is 48 | begin 49 | Put (This.Samples, New_Sample); 50 | This.MA_Value := New_Average (This); 51 | end Insert; 52 | 53 | ----------------- 54 | -- New_Average -- 55 | ----------------- 56 | 57 | function New_Average (This : SMA_Filter) return Output is 58 | Result : Output := 0.0; 59 | begin 60 | for Value of This.Samples loop 61 | Result := Result + Output (Value); 62 | end loop; 63 | 64 | if Extent (This.Samples) > 1 then 65 | Result := Result / Output (Extent (This.Samples)); 66 | end if; 67 | return Result; 68 | end New_Average; 69 | 70 | ----------- 71 | -- Reset -- 72 | ----------- 73 | 74 | procedure Reset (This : in out SMA_Filter) is 75 | begin 76 | Reset (This.Samples); 77 | This.MA_Value := 0.0; 78 | end Reset; 79 | 80 | end Simple_Moving_Average_Filters_Reals; 81 | -------------------------------------------------------------------------------- /src/signal_processing/simple_moving_average_filters_reals.ads: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------ 2 | -- -- 3 | -- Copyright (C) 2020, AdaCore -- 4 | -- -- 5 | -- Redistribution and use in source and binary forms, with or without -- 6 | -- modification, are permitted provided that the following conditions are -- 7 | -- met: -- 8 | -- 1. Redistributions of source code must retain the above copyright -- 9 | -- notice, this list of conditions and the following disclaimer. -- 10 | -- 2. Redistributions in binary form must reproduce the above copyright -- 11 | -- notice, this list of conditions and the following disclaimer in -- 12 | -- the documentation and/or other materials provided with the -- 13 | -- distribution. -- 14 | -- 3. Neither the name of the copyright holder nor the names of its -- 15 | -- contributors may be used to endorse or promote products derived -- 16 | -- from this software without specific prior written permission. -- 17 | -- -- 18 | -- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -- 19 | -- "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -- 20 | -- LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR -- 21 | -- A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -- 22 | -- HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, -- 23 | -- SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -- 24 | -- LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, -- 25 | -- DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -- 26 | -- THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT -- 27 | -- (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE -- 28 | -- OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -- 29 | -- -- 30 | ------------------------------------------------------------------------------ 31 | 32 | -- This implementation computes the sum of the current inputs each time a new 33 | -- input is inserted (in order to compute the running average), so the cost is 34 | -- paid per call to insert a new sample, but it should be able to run "forever" 35 | -- without concern for eventual overflow because a total of the entire history 36 | -- of inputs is not maintained (which would be the alternative to summing the 37 | -- values each time, per the Recursive Moving Average design). 38 | 39 | with Sequential_Bounded_Buffers; 40 | 41 | generic 42 | 43 | type Sample is digits <>; 44 | -- the type used for the input samples 45 | 46 | type Output is digits <>; 47 | -- the type used for the output average provided 48 | 49 | package Simple_Moving_Average_Filters_Reals is 50 | 51 | type SMA_Filter (Window_Size : Positive) is tagged limited private; 52 | 53 | procedure Insert (This : in out SMA_Filter; New_Sample : Sample); 54 | 55 | function Value (This : SMA_Filter) return Output with Inline; 56 | 57 | procedure Reset (This : in out SMA_Filter); 58 | 59 | private 60 | 61 | package Sample_Data is new Sequential_Bounded_Buffers 62 | (Element => Sample, Default_Value => 0.0); 63 | use Sample_Data; 64 | 65 | type SMA_Filter (Window_Size : Positive) is tagged limited record 66 | Samples : Sample_Data.Ring_Buffer (Window_Size); 67 | MA_Value : Output := 0.0; 68 | end record; 69 | 70 | end Simple_Moving_Average_Filters_Reals; 71 | -------------------------------------------------------------------------------- /src/utils/math_utilities.adb: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------ 2 | -- -- 3 | -- Copyright (C) 2017, AdaCore -- 4 | -- -- 5 | -- Redistribution and use in source and binary forms, with or without -- 6 | -- modification, are permitted provided that the following conditions are -- 7 | -- met: -- 8 | -- 1. Redistributions of source code must retain the above copyright -- 9 | -- notice, this list of conditions and the following disclaimer. -- 10 | -- 2. Redistributions in binary form must reproduce the above copyright -- 11 | -- notice, this list of conditions and the following disclaimer in -- 12 | -- the documentation and/or other materials provided with the -- 13 | -- distribution. -- 14 | -- 3. Neither the name of STMicroelectronics nor the names of its -- 15 | -- contributors may be used to endorse or promote products derived -- 16 | -- from this software without specific prior written permission. -- 17 | -- -- 18 | -- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -- 19 | -- "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -- 20 | -- LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR -- 21 | -- A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -- 22 | -- HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, -- 23 | -- SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -- 24 | -- LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, -- 25 | -- DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -- 26 | -- THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT -- 27 | -- (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE -- 28 | -- OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -- 29 | -- -- 30 | ------------------------------------------------------------------------------ 31 | 32 | package body Math_Utilities is 33 | 34 | ----------------------------- 35 | -- Range_To_Domain_Mapping -- 36 | ----------------------------- 37 | 38 | function Range_To_Domain_Mapping 39 | (Value, Range_Min, Range_Max, Domain_Min, Domain_Max : T) 40 | return T is 41 | ((Value - Range_Min) * (Domain_Max - Domain_Min) / (Range_Max - Range_Min) + Domain_Min); 42 | 43 | --------------------------- 44 | -- Bounded_Integer_Value -- 45 | --------------------------- 46 | 47 | function Bounded_Integer_Value (Value, Low, High : T) return T is 48 | (if Value < Low then Low elsif Value > High then High else Value); 49 | 50 | ------------------------- 51 | -- Bound_Integer_Value -- 52 | ------------------------- 53 | 54 | procedure Bound_Integer_Value (Value : in out T; Low, High : T) is 55 | begin 56 | if Value < Low then 57 | Value := Low; 58 | elsif Value > High then 59 | Value := High; 60 | end if; 61 | end Bound_Integer_Value; 62 | 63 | ---------------------------- 64 | -- Bounded_Floating_Value -- 65 | ---------------------------- 66 | 67 | function Bounded_Floating_Value (Value, Low, High : T) return T is 68 | (if Value < Low then Low elsif Value > High then High else Value); 69 | 70 | -------------------------- 71 | -- Bound_Floating_Value -- 72 | -------------------------- 73 | 74 | procedure Bound_Floating_Value (Value : in out T; Low, High : T) is 75 | begin 76 | if Value < Low then 77 | Value := Low; 78 | elsif Value > High then 79 | Value := High; 80 | end if; 81 | end Bound_Floating_Value; 82 | 83 | end Math_Utilities; 84 | -------------------------------------------------------------------------------- /src/utils/math_utilities.ads: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------ 2 | -- -- 3 | -- Copyright (C) 2017, AdaCore -- 4 | -- -- 5 | -- Redistribution and use in source and binary forms, with or without -- 6 | -- modification, are permitted provided that the following conditions are -- 7 | -- met: -- 8 | -- 1. Redistributions of source code must retain the above copyright -- 9 | -- notice, this list of conditions and the following disclaimer. -- 10 | -- 2. Redistributions in binary form must reproduce the above copyright -- 11 | -- notice, this list of conditions and the following disclaimer in -- 12 | -- the documentation and/or other materials provided with the -- 13 | -- distribution. -- 14 | -- 3. Neither the name of STMicroelectronics nor the names of its -- 15 | -- contributors may be used to endorse or promote products derived -- 16 | -- from this software without specific prior written permission. -- 17 | -- -- 18 | -- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -- 19 | -- "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -- 20 | -- LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR -- 21 | -- A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -- 22 | -- HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, -- 23 | -- SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -- 24 | -- LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, -- 25 | -- DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -- 26 | -- THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT -- 27 | -- (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE -- 28 | -- OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -- 29 | -- -- 30 | ------------------------------------------------------------------------------ 31 | 32 | -- This package provides useful math utility routines. 33 | 34 | package Math_Utilities is 35 | 36 | generic 37 | type T is range <>; 38 | function Range_To_Domain_Mapping 39 | (Value, Range_Min, Range_Max, Domain_Min, Domain_Max : T) 40 | return T 41 | with 42 | Pre => Range_Min < Range_Max and Domain_Min < Domain_Max, 43 | Post => Range_To_Domain_Mapping'Result in Domain_Min .. Domain_Max, 44 | Inline; 45 | -- Maps the Value, with the range Range_Min .. Range_Max, to a value in the 46 | -- domain Domain_Min .. Domain_Max 47 | 48 | generic 49 | type T is range <>; 50 | function Bounded_Integer_Value 51 | (Value, Low, High : T) 52 | return T 53 | with 54 | Pre => Low < High, 55 | Post => Bounded_Integer_Value'Result in Low .. High, 56 | Inline; 57 | -- Constrains the input value to the range Low .. High 58 | 59 | generic 60 | type T is range <>; 61 | procedure Bound_Integer_Value 62 | (Value : in out T; Low, High : T) 63 | with 64 | Pre => Low < High, 65 | Post => Value in Low .. High, 66 | Inline; 67 | -- Constrains the input value to the range Low .. High 68 | 69 | generic 70 | type T is digits <>; 71 | function Bounded_Floating_Value 72 | (Value, Low, High : T) 73 | return T 74 | with 75 | Pre => Low < High, 76 | Post => Bounded_Floating_Value'Result in Low .. High, 77 | Inline; 78 | -- Constrains the input value to the range Low .. High 79 | 80 | generic 81 | type T is digits <>; 82 | procedure Bound_Floating_Value 83 | (Value : in out T; Low, High : T) 84 | with 85 | Pre => Low < High, 86 | Post => Value in Low .. High, 87 | Inline; 88 | -- Constrains the input value to the range Low .. High 89 | 90 | end Math_Utilities; 91 | -------------------------------------------------------------------------------- /src/utils/panic.adb: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------ 2 | -- -- 3 | -- Copyright (C) 2020, AdaCore -- 4 | -- -- 5 | -- Redistribution and use in source and binary forms, with or without -- 6 | -- modification, are permitted provided that the following conditions are -- 7 | -- met: -- 8 | -- 1. Redistributions of source code must retain the above copyright -- 9 | -- notice, this list of conditions and the following disclaimer. -- 10 | -- 2. Redistributions in binary form must reproduce the above copyright -- 11 | -- notice, this list of conditions and the following disclaimer in -- 12 | -- the documentation and/or other materials provided with the -- 13 | -- distribution. -- 14 | -- 3. Neither the name of the copyright holder nor the names of its -- 15 | -- contributors may be used to endorse or promote products derived -- 16 | -- from this software without specific prior written permission. -- 17 | -- -- 18 | -- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -- 19 | -- "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -- 20 | -- LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR -- 21 | -- A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -- 22 | -- HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, -- 23 | -- SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -- 24 | -- LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, -- 25 | -- DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -- 26 | -- THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT -- 27 | -- (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE -- 28 | -- OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -- 29 | -- -- 30 | ------------------------------------------------------------------------------ 31 | 32 | with STM32.Board; use STM32.Board; 33 | 34 | procedure Panic (Blink_Interval : Time_Span := Milliseconds (250)) is 35 | begin 36 | Initialize_LEDs; 37 | -- "When in danger, or in doubt, run in circles, scream and shout." 38 | loop 39 | All_LEDs_Off; 40 | delay until Clock + Blink_Interval; 41 | All_LEDs_On; 42 | delay until Clock + Blink_Interval; 43 | end loop; 44 | end Panic; 45 | -------------------------------------------------------------------------------- /src/utils/panic.ads: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------ 2 | -- -- 3 | -- Copyright (C) 2020, AdaCore -- 4 | -- -- 5 | -- Redistribution and use in source and binary forms, with or without -- 6 | -- modification, are permitted provided that the following conditions are -- 7 | -- met: -- 8 | -- 1. Redistributions of source code must retain the above copyright -- 9 | -- notice, this list of conditions and the following disclaimer. -- 10 | -- 2. Redistributions in binary form must reproduce the above copyright -- 11 | -- notice, this list of conditions and the following disclaimer in -- 12 | -- the documentation and/or other materials provided with the -- 13 | -- distribution. -- 14 | -- 3. Neither the name of the copyright holder nor the names of its -- 15 | -- contributors may be used to endorse or promote products derived -- 16 | -- from this software without specific prior written permission. -- 17 | -- -- 18 | -- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -- 19 | -- "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -- 20 | -- LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR -- 21 | -- A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -- 22 | -- HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, -- 23 | -- SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -- 24 | -- LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, -- 25 | -- DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -- 26 | -- THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT -- 27 | -- (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE -- 28 | -- OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -- 29 | -- -- 30 | ------------------------------------------------------------------------------ 31 | 32 | with Ada.Real_Time; use Ada.Real_Time; 33 | 34 | procedure Panic (Blink_Interval : Time_Span := Milliseconds (250)) with No_Return; 35 | -- Flash the LEDs to indicate disaster, forever. 36 | 37 | 38 | -------------------------------------------------------------------------------- /src/utils/poll_for_continuous_state.adb: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------ 2 | -- -- 3 | -- Copyright (C) 2017, AdaCore -- 4 | -- -- 5 | -- Redistribution and use in source and binary forms, with or without -- 6 | -- modification, are permitted provided that the following conditions are -- 7 | -- met: -- 8 | -- 1. Redistributions of source code must retain the above copyright -- 9 | -- notice, this list of conditions and the following disclaimer. -- 10 | -- 2. Redistributions in binary form must reproduce the above copyright -- 11 | -- notice, this list of conditions and the following disclaimer in -- 12 | -- the documentation and/or other materials provided with the -- 13 | -- distribution. -- 14 | -- 3. Neither the name of STMicroelectronics nor the names of its -- 15 | -- contributors may be used to endorse or promote products derived -- 16 | -- from this software without specific prior written permission. -- 17 | -- -- 18 | -- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -- 19 | -- "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -- 20 | -- LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR -- 21 | -- A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -- 22 | -- HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, -- 23 | -- SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -- 24 | -- LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, -- 25 | -- DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -- 26 | -- THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT -- 27 | -- (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE -- 28 | -- OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -- 29 | -- -- 30 | ------------------------------------------------------------------------------ 31 | 32 | procedure Poll_For_Continuous_State 33 | (This : Input; 34 | Required_Interval : Time_Span) 35 | is 36 | Interval_Start : Time; 37 | Previously_In_Target_State : Boolean := False; 38 | begin 39 | loop 40 | if In_Target_State (This) then 41 | -- We are in the desired target state. This may be a transition into 42 | -- that state, or we may have been in there for some time. 43 | if not Previously_In_Target_State then 44 | -- This is a transition into the target state so we take a new 45 | -- starting timestamp. Doing so on each transition into the target 46 | -- state ensures that we only exit when we've been in that state 47 | -- continuously. 48 | Interval_Start := Clock; 49 | Previously_In_Target_State := True; 50 | else 51 | -- We are in the target state and were there in the previous 52 | -- iteration too (if not more). Have we been in that state, 53 | -- continuously, long enough? The function Clock represents "now" 54 | -- so the difference between the Clock and the starting time is 55 | -- the elapsed time we have been in the target state. 56 | exit when Clock - Interval_Start >= Required_Interval; 57 | end if; 58 | else 59 | -- We are not in the target state, at least not now. We may have been 60 | -- in there an iteration ago, but the input could be bouncing. By 61 | -- the same token, we may not have been in the target state in the 62 | -- previous iteration either, but setting the variable to False again 63 | -- doesn't incur a significant expense. 64 | Previously_In_Target_State := False; 65 | end if; 66 | end loop; 67 | end Poll_For_Continuous_State; 68 | -------------------------------------------------------------------------------- /src/utils/poll_for_continuous_state.ads: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------ 2 | -- -- 3 | -- Copyright (C) 2017, AdaCore -- 4 | -- -- 5 | -- Redistribution and use in source and binary forms, with or without -- 6 | -- modification, are permitted provided that the following conditions are -- 7 | -- met: -- 8 | -- 1. Redistributions of source code must retain the above copyright -- 9 | -- notice, this list of conditions and the following disclaimer. -- 10 | -- 2. Redistributions in binary form must reproduce the above copyright -- 11 | -- notice, this list of conditions and the following disclaimer in -- 12 | -- the documentation and/or other materials provided with the -- 13 | -- distribution. -- 14 | -- 3. Neither the name of STMicroelectronics nor the names of its -- 15 | -- contributors may be used to endorse or promote products derived -- 16 | -- from this software without specific prior written permission. -- 17 | -- -- 18 | -- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -- 19 | -- "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -- 20 | -- LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR -- 21 | -- A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -- 22 | -- HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, -- 23 | -- SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -- 24 | -- LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, -- 25 | -- DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -- 26 | -- THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT -- 27 | -- (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE -- 28 | -- OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -- 29 | -- -- 30 | ------------------------------------------------------------------------------ 31 | 32 | with Ada.Real_Time; use Ada.Real_Time; 33 | 34 | generic 35 | type Input (<>) is limited private; 36 | with function In_Target_State (This : Input) return Boolean; 37 | procedure Poll_For_Continuous_State 38 | (This : Input; 39 | Required_Interval : Time_Span); 40 | -- A debouncing routine. Iteratively queries (polls) the state of This for the 41 | -- target state, as indicated by the predicate function In_Target_State. Will 42 | -- return only when the required target state of This has been maintained 43 | -- continuously for the Required_Interval. 44 | --------------------------------------------------------------------------------