From f2fd11b7d0f98bca942b29dda0723f4527b19b87 Mon Sep 17 00:00:00 2001 From: RREE Date: Sun, 10 Apr 2022 14:28:21 +0200 Subject: [PATCH 01/11] new component: the old pcf8574 8bit io-expander. --- .../src/io_expander/pcf8574/pcf8574.adb | 51 +++++++++++++++++++ .../src/io_expander/pcf8574/pcf8574.ads | 41 +++++++++++++++ 2 files changed, 92 insertions(+) create mode 100644 components/src/io_expander/pcf8574/pcf8574.adb create mode 100644 components/src/io_expander/pcf8574/pcf8574.ads diff --git a/components/src/io_expander/pcf8574/pcf8574.adb b/components/src/io_expander/pcf8574/pcf8574.adb new file mode 100644 index 000000000..7e2f24480 --- /dev/null +++ b/components/src/io_expander/pcf8574/pcf8574.adb @@ -0,0 +1,51 @@ +-- +-- Copyright 2022 (C) Rolf Ebert +-- +-- SPDX-License-Identifier: BSD-3-Clause +-- + + +package body PCF8574 is + + ----------------- + -- Configure -- + ----------------- + + procedure Configure (This : in out Module; + Port : Any_I2C_Master_Port; + Addr : Module_Address) + is begin + This.Port := Port; + This.Addr := Addr; + end Configure; + + ----------- + -- Get -- + ----------- + + function Get (This : Module) return UInt8 + is + Val : I2C_Data (1 .. 1); + Status : I2C_Status; + begin + This.Port.Receive (This.Addr, Val, Status); + return Val(1); + end Get; + + procedure Get (This : Module; Data : out UInt8) + is begin + Data := Get (This); + end Get; + + ----------- + -- Set -- + ----------- + + procedure Set (This : Module; Data : UInt8) + is + Status : I2C_Status; + begin + This.Port.Transmit (This.Addr, (1=>Data), Status); + end Set; + +end PCF8574; diff --git a/components/src/io_expander/pcf8574/pcf8574.ads b/components/src/io_expander/pcf8574/pcf8574.ads new file mode 100644 index 000000000..5080fcd19 --- /dev/null +++ b/components/src/io_expander/pcf8574/pcf8574.ads @@ -0,0 +1,41 @@ +-- +-- Copyright 2022 (C) Rolf Ebert +-- +-- SPDX-License-Identifier: BSD-3-Clause +-- + +with HAL; use HAL; +with HAL.I2C; use HAL.I2C; +with HAL.I2C.Master; use HAL.I2C.Master; + +-- I2C 8-bit IO expander with quasi bidirectional I/O, no data +-- direction, no latch + +package PCF8574 is + + subtype Module_Address is I2C_7bit_Address range 16#20# .. 16#2F#; + + type Module is tagged private; + type Any_Module is access all Module'Class; + + procedure Configure (This : in out Module; + Port : Any_I2C_Master_Port; + Addr : Module_Address); + + procedure Set (This : Module; Data : UInt8); + + function Get (This : Module) return UInt8; + procedure Get (This : Module; Data : out UInt8); + -- when reading the input from keys (buttons) carefully read the + -- datasheet. The input line should be set high before reading. + -- E.g. if all lines are key input: + -- M.Set (16#FF#); + -- Keys := M.Get; + +private + type Module is tagged record + Port : Any_I2C_Master_Port; + Addr : Module_Address; + end record; + +end PCF8574; From eaaaa1a6d50cbdb293cfc1edd39e75efc9d49cf9 Mon Sep 17 00:00:00 2001 From: RREE Date: Sun, 1 May 2022 17:31:03 +0200 Subject: [PATCH 02/11] correct interface to current HAL (v0.3) --- .../src/io_expander/pcf8574/pcf8574.adb | 10 ++++---- .../src/io_expander/pcf8574/pcf8574.ads | 25 +++++++++---------- 2 files changed, 17 insertions(+), 18 deletions(-) diff --git a/components/src/io_expander/pcf8574/pcf8574.adb b/components/src/io_expander/pcf8574/pcf8574.adb index 7e2f24480..7163d2173 100644 --- a/components/src/io_expander/pcf8574/pcf8574.adb +++ b/components/src/io_expander/pcf8574/pcf8574.adb @@ -11,9 +11,9 @@ package body PCF8574 is -- Configure -- ----------------- - procedure Configure (This : in out Module; - Port : Any_I2C_Master_Port; - Addr : Module_Address) + procedure Configure (This : in out PCF8574_Module; + Port : Any_I2C_Port; + Addr : PCF8574_Address) is begin This.Port := Port; This.Addr := Addr; @@ -23,7 +23,7 @@ package body PCF8574 is -- Get -- ----------- - function Get (This : Module) return UInt8 + function Get (This : PCF8574_Module) return UInt8 is Val : I2C_Data (1 .. 1); Status : I2C_Status; @@ -41,7 +41,7 @@ package body PCF8574 is -- Set -- ----------- - procedure Set (This : Module; Data : UInt8) + procedure Set (This : PCF8574_Module; Data : UInt8) is Status : I2C_Status; begin diff --git a/components/src/io_expander/pcf8574/pcf8574.ads b/components/src/io_expander/pcf8574/pcf8574.ads index 5080fcd19..0cd78f650 100644 --- a/components/src/io_expander/pcf8574/pcf8574.ads +++ b/components/src/io_expander/pcf8574/pcf8574.ads @@ -6,26 +6,25 @@ with HAL; use HAL; with HAL.I2C; use HAL.I2C; -with HAL.I2C.Master; use HAL.I2C.Master; -- I2C 8-bit IO expander with quasi bidirectional I/O, no data -- direction, no latch package PCF8574 is - subtype Module_Address is I2C_7bit_Address range 16#20# .. 16#2F#; + subtype PCF8574_Address is I2C_Address range 16#40# .. 16#5F#; - type Module is tagged private; - type Any_Module is access all Module'Class; + type PCF8574_Module is tagged private; + type Any_PCF8574_Module is access all PCF8574_Module'Class; - procedure Configure (This : in out Module; - Port : Any_I2C_Master_Port; - Addr : Module_Address); + procedure Configure (This : in out PCF8574_Module; + Port : Any_I2C_Port; + Addr : PCF8574_Address); - procedure Set (This : Module; Data : UInt8); + procedure Set (This : PCF8574_Module; Data : UInt8); - function Get (This : Module) return UInt8; - procedure Get (This : Module; Data : out UInt8); + function Get (This : PCF8574_Module) return UInt8; + procedure Get (This : PCF8574_Module; Data : out UInt8); -- when reading the input from keys (buttons) carefully read the -- datasheet. The input line should be set high before reading. -- E.g. if all lines are key input: @@ -33,9 +32,9 @@ package PCF8574 is -- Keys := M.Get; private - type Module is tagged record - Port : Any_I2C_Master_Port; - Addr : Module_Address; + type PCF8574_Module is tagged record + Port : Any_I2C_Port; + Addr : PCF8574_Address; end record; end PCF8574; From df80b9038a492c08328463488580b0198b0a6e87 Mon Sep 17 00:00:00 2001 From: RREE Date: Mon, 2 May 2022 21:19:22 +0200 Subject: [PATCH 03/11] make address and I2C_Port discriminants, so that variables cannot be declared without initialization --- .../src/io_expander/pcf8574/pcf8574.adb | 19 ++++--------------- .../src/io_expander/pcf8574/pcf8574.ads | 14 ++++++-------- 2 files changed, 10 insertions(+), 23 deletions(-) diff --git a/components/src/io_expander/pcf8574/pcf8574.adb b/components/src/io_expander/pcf8574/pcf8574.adb index 7163d2173..2a26e88a5 100644 --- a/components/src/io_expander/pcf8574/pcf8574.adb +++ b/components/src/io_expander/pcf8574/pcf8574.adb @@ -7,18 +7,6 @@ package body PCF8574 is - ----------------- - -- Configure -- - ----------------- - - procedure Configure (This : in out PCF8574_Module; - Port : Any_I2C_Port; - Addr : PCF8574_Address) - is begin - This.Port := Port; - This.Addr := Addr; - end Configure; - ----------- -- Get -- ----------- @@ -28,11 +16,12 @@ package body PCF8574 is Val : I2C_Data (1 .. 1); Status : I2C_Status; begin - This.Port.Receive (This.Addr, Val, Status); + -- if not This.Is_Initialized then raise Program_Error; end if; + This.Port.Master_Receive (This.Addr, Val, Status); return Val(1); end Get; - procedure Get (This : Module; Data : out UInt8) + procedure Get (This : PCF8574_Module; Data : out UInt8) is begin Data := Get (This); end Get; @@ -45,7 +34,7 @@ package body PCF8574 is is Status : I2C_Status; begin - This.Port.Transmit (This.Addr, (1=>Data), Status); + This.Port.Master_Transmit (This.Addr, (1=>Data), Status); end Set; end PCF8574; diff --git a/components/src/io_expander/pcf8574/pcf8574.ads b/components/src/io_expander/pcf8574/pcf8574.ads index 0cd78f650..587083f70 100644 --- a/components/src/io_expander/pcf8574/pcf8574.ads +++ b/components/src/io_expander/pcf8574/pcf8574.ads @@ -14,12 +14,11 @@ package PCF8574 is subtype PCF8574_Address is I2C_Address range 16#40# .. 16#5F#; - type PCF8574_Module is tagged private; + type PCF8574_Module (Port : not null Any_I2C_Port; + Addr : I2C_Address) is tagged private; + type Any_PCF8574_Module is access all PCF8574_Module'Class; - procedure Configure (This : in out PCF8574_Module; - Port : Any_I2C_Port; - Addr : PCF8574_Address); procedure Set (This : PCF8574_Module; Data : UInt8); @@ -32,9 +31,8 @@ package PCF8574 is -- Keys := M.Get; private - type PCF8574_Module is tagged record - Port : Any_I2C_Port; - Addr : PCF8574_Address; - end record; + + type PCF8574_Module (Port : not null Any_I2C_Port; + Addr : I2C_Address) is tagged null record; end PCF8574; From 2228fc370f619dfb39041a8b9301110092742fe8 Mon Sep 17 00:00:00 2001 From: RREE Date: Tue, 3 May 2022 12:34:57 +0200 Subject: [PATCH 04/11] cleared style issues (missing blanks) and made the type limited --- components/src/io_expander/pcf8574/pcf8574.adb | 5 ++--- components/src/io_expander/pcf8574/pcf8574.ads | 18 +++++++++--------- 2 files changed, 11 insertions(+), 12 deletions(-) diff --git a/components/src/io_expander/pcf8574/pcf8574.adb b/components/src/io_expander/pcf8574/pcf8574.adb index 2a26e88a5..8d94f770c 100644 --- a/components/src/io_expander/pcf8574/pcf8574.adb +++ b/components/src/io_expander/pcf8574/pcf8574.adb @@ -16,9 +16,8 @@ package body PCF8574 is Val : I2C_Data (1 .. 1); Status : I2C_Status; begin - -- if not This.Is_Initialized then raise Program_Error; end if; This.Port.Master_Receive (This.Addr, Val, Status); - return Val(1); + return Val (1); end Get; procedure Get (This : PCF8574_Module; Data : out UInt8) @@ -34,7 +33,7 @@ package body PCF8574 is is Status : I2C_Status; begin - This.Port.Master_Transmit (This.Addr, (1=>Data), Status); + This.Port.Master_Transmit (This.Addr, (1 => Data), Status); end Set; end PCF8574; diff --git a/components/src/io_expander/pcf8574/pcf8574.ads b/components/src/io_expander/pcf8574/pcf8574.ads index 587083f70..6cdcbeca0 100644 --- a/components/src/io_expander/pcf8574/pcf8574.ads +++ b/components/src/io_expander/pcf8574/pcf8574.ads @@ -7,15 +7,15 @@ with HAL; use HAL; with HAL.I2C; use HAL.I2C; --- I2C 8-bit IO expander with quasi bidirectional I/O, no data --- direction, no latch +-- I2C 8-bit IO expander with quasi bidirectional I/O, no data +-- direction, no latch package PCF8574 is subtype PCF8574_Address is I2C_Address range 16#40# .. 16#5F#; type PCF8574_Module (Port : not null Any_I2C_Port; - Addr : I2C_Address) is tagged private; + Addr : I2C_Address) is tagged limited private; type Any_PCF8574_Module is access all PCF8574_Module'Class; @@ -24,15 +24,15 @@ package PCF8574 is function Get (This : PCF8574_Module) return UInt8; procedure Get (This : PCF8574_Module; Data : out UInt8); - -- when reading the input from keys (buttons) carefully read the - -- datasheet. The input line should be set high before reading. - -- E.g. if all lines are key input: - -- M.Set (16#FF#); - -- Keys := M.Get; + -- when reading the input from keys (buttons) carefully read the + -- datasheet. The input line should be set high before reading. + -- E.g. if all lines are key input: + -- M.Set (16#FF#); + -- Keys := M.Get; private type PCF8574_Module (Port : not null Any_I2C_Port; - Addr : I2C_Address) is tagged null record; + Addr : I2C_Address) is tagged limited null record; end PCF8574; From 31c8ec3d9d1351b2143f7f3877d49607b9e31c15 Mon Sep 17 00:00:00 2001 From: RREE Date: Thu, 5 May 2022 19:06:48 +0200 Subject: [PATCH 05/11] first working version of a HD44780 LCD driver, based on I2C PCF8574 --- .../src/screen/lcd/lcd_hd44780-pcf8574.adb | 188 ++++++++++++++++++ .../src/screen/lcd/lcd_hd44780-pcf8574.ads | 95 +++++++++ components/src/screen/lcd/lcd_hd44780.adb | 134 +++++++++++++ components/src/screen/lcd/lcd_hd44780.ads | 135 +++++++++++++ 4 files changed, 552 insertions(+) create mode 100644 components/src/screen/lcd/lcd_hd44780-pcf8574.adb create mode 100644 components/src/screen/lcd/lcd_hd44780-pcf8574.ads create mode 100644 components/src/screen/lcd/lcd_hd44780.adb create mode 100644 components/src/screen/lcd/lcd_hd44780.ads diff --git a/components/src/screen/lcd/lcd_hd44780-pcf8574.adb b/components/src/screen/lcd/lcd_hd44780-pcf8574.adb new file mode 100644 index 000000000..e7471e778 --- /dev/null +++ b/components/src/screen/lcd/lcd_hd44780-pcf8574.adb @@ -0,0 +1,188 @@ +------------------------------------------------------------------------------ +-- -- +-- Copyright (C) 2022, AdaCore -- +-- -- +-- Redistribution and use in source and binary forms, with or without -- +-- modification, are permitted provided that the following conditions are -- +-- met: -- +-- 1. Redistributions of source code must retain the above copyright -- +-- notice, this list of conditions and the following disclaimer. -- +-- 2. Redistributions in binary form must reproduce the above copyright -- +-- notice, this list of conditions and the following disclaimer in -- +-- the documentation and/or other materials provided with the -- +-- distribution. -- +-- 3. Neither the name of the copyright holder nor the names of its -- +-- contributors may be used to endorse or promote products derived -- +-- from this software without specific prior written permission. -- +-- -- +-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -- +-- "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -- +-- LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR -- +-- A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -- +-- HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, -- +-- SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -- +-- LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, -- +-- DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -- +-- THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT -- +-- (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE -- +-- OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -- +-- -- +------------------------------------------------------------------------------ + +-- driver for text based LCDs connected via I2C port expander PCF8574 + +pragma Restrictions (No_Allocators); +pragma Restrictions (No_Implicit_Heap_Allocations); + +package body LCD_HD44780.PCF8574 is + + + type Shadow_Bits is array (Bit_Number) of Boolean + with Pack, Size => 8; + + I2C_Shadow : Shadow_Bits; + + procedure Write_Shadow (This : Lcd_Pcf8574) + with Inline; + + function Create (Display_Width : Char_Position; + Display_Height : Line_Position; + Time : not null HAL.Time.Any_Delays; + Expander : Standard.PCF8574.Any_PCF8574_Module; + Mapping : Bit_Mapping := Standard_Mapping) return LCD_PCF8574 + is + begin + I2C_Shadow := (others => False); + return L : LCD_PCF8574 (Display_Width, Display_Height, Time) do + L.I2C_Driver := Expander; + L.Pins := Mapping; + end return; + end Create; + + + procedure Write_Shadow (This : LCD_PCF8574) + is + Shadow_As_Byte : UInt8 + with Address => I2C_Shadow'Address; + begin + This.I2C_Driver.Set (Shadow_As_Byte); + end Write_Shadow; + + + overriding + procedure Set_Backlight (This : LCD_PCF8574; + Is_On : Boolean := True) + is + Bl : Boolean renames I2C_Shadow (This.Pins (Backlight)); + begin + Bl := Is_On; + This.Write_Shadow; + end Set_Backlight; + + + overriding + procedure Toggle_Enable (This : LCD_PCF8574) + is + Bit : constant Bit_Number := This.Pins (Enable); + En : Boolean renames I2C_Shadow (Bit); + begin + En := True; + This.Write_Shadow; + En := False; + This.Write_Shadow; + This.Time.Delay_Microseconds (280); + end Toggle_Enable; + + + overriding + procedure Output (This : in out LCD_PCF8574; + Cmd : UInt8; + Is_Data : Boolean := False) + is + RW_Bit : constant Bit_Number := This.Pins (ReadWrite); + RS_Bit : constant Bit_Number := This.Pins (RegSel); + B0_Bit : constant Bit_Number := This.Pins (D0); + B1_Bit : constant Bit_Number := This.Pins (D1); + B2_Bit : constant Bit_Number := This.Pins (D2); + B3_Bit : constant Bit_Number := This.Pins (D3); + RW : Boolean renames I2C_Shadow (RW_Bit); + RS : Boolean renames I2C_Shadow (RS_Bit); + P0 : Boolean renames I2C_Shadow (B0_Bit); + P1 : Boolean renames I2C_Shadow (B1_Bit); + P2 : Boolean renames I2C_Shadow (B2_Bit); + P3 : Boolean renames I2C_Shadow (B3_Bit); + begin + -- control pins + RW := False; + RS := Is_Data; + -- write data + -- high nibble first + P0 := (Cmd and 16#10#) /= 0; + P1 := (Cmd and 16#20#) /= 0; + P2 := (Cmd and 16#40#) /= 0; + P3 := (Cmd and 16#80#) /= 0; + + This.Toggle_Enable; + + P0 := (Cmd and 16#01#) /= 0; + P1 := (Cmd and 16#02#) /= 0; + P2 := (Cmd and 16#04#) /= 0; + P3 := (Cmd and 16#08#) /= 0; + + This.Toggle_Enable; + + This.Time.Delay_Microseconds (50); + end Output; + + + overriding + procedure Init_4bit_Mode (This : LCD_PCF8574) + is + RW_Bit : constant Bit_Number := This.Pins (ReadWrite); + RS_Bit : constant Bit_Number := This.Pins (RegSel); + En_Bit : constant Bit_Number := This.Pins (Enable); + B0_Bit : constant Bit_Number := This.Pins (D0); + B1_Bit : constant Bit_Number := This.Pins (D1); + B2_Bit : constant Bit_Number := This.Pins (D2); + B3_Bit : constant Bit_Number := This.Pins (D3); + RW : Boolean renames I2C_Shadow (RW_Bit); + RS : Boolean renames I2C_Shadow (RS_Bit); + En : Boolean renames I2C_Shadow (En_Bit); + P0 : Boolean renames I2C_Shadow (B0_Bit); + P1 : Boolean renames I2C_Shadow (B1_Bit); + P2 : Boolean renames I2C_Shadow (B2_Bit); + P3 : Boolean renames I2C_Shadow (B3_Bit); + begin + I2C_Shadow := (others => False); + + -- all control lines low + RS := False; + En := False; + RW := False; + -- write 1 into pins 0 and 1 + P0 := True; + P1 := True; + P2 := False; + P3 := False; + This.Write_Shadow; + + This.Toggle_Enable; + This.Time.Delay_Milliseconds (5); + + -- send last command again (is still in register, just toggle E) + This.Toggle_Enable; + This.Time.Delay_Milliseconds (5); + + -- send last command a third time + This.Toggle_Enable; + + This.Time.Delay_Microseconds (150); + + -- set 4 bit mode, clear data bit 0 + P0 := False; + + This.Toggle_Enable; + + end Init_4bit_Mode; + +end LCD_HD44780.PCF8574; diff --git a/components/src/screen/lcd/lcd_hd44780-pcf8574.ads b/components/src/screen/lcd/lcd_hd44780-pcf8574.ads new file mode 100644 index 000000000..f3b738bca --- /dev/null +++ b/components/src/screen/lcd/lcd_hd44780-pcf8574.ads @@ -0,0 +1,95 @@ +------------------------------------------------------------------------------ +-- -- +-- Copyright (C) 2022, AdaCore -- +-- -- +-- Redistribution and use in source and binary forms, with or without -- +-- modification, are permitted provided that the following conditions are -- +-- met: -- +-- 1. Redistributions of source code must retain the above copyright -- +-- notice, this list of conditions and the following disclaimer. -- +-- 2. Redistributions in binary form must reproduce the above copyright -- +-- notice, this list of conditions and the following disclaimer in -- +-- the documentation and/or other materials provided with the -- +-- distribution. -- +-- 3. Neither the name of the copyright holder nor the names of its -- +-- contributors may be used to endorse or promote products derived -- +-- from this software without specific prior written permission. -- +-- -- +-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -- +-- "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -- +-- LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR -- +-- A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -- +-- HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, -- +-- SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -- +-- LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, -- +-- DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -- +-- THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT -- +-- (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE -- +-- OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -- +-- -- +------------------------------------------------------------------------------ + +-- driver for text based LCDs connected via I2C port expander PCF8574 + +-- with HAL; use HAL; +with HAL.Time; +with HAL.I2C; +with PCF8574; + +package LCD_HD44780.PCF8574 is + + -- Describe the internal wiring between the PCF8574 output pins + -- and the HD44780 input pins. The PCF8574 pins are the bit numbers. + + type Bit_Number is range 0 .. 7; + + type Bit_Mapping is array (HD44780_4bit_Pins) of Bit_Number; + + Standard_Mapping : constant Bit_Mapping := + (Enable => 2, + ReadWrite => 1, + RegSel => 0, + Backlight => 3, + D0 => 4, + D1 => 5, + D2 => 6, + D3 => 7); + + type LCD_PCF8574 (Display_Width : Char_Position; + Display_Height : Line_Position; + Time : not null HAL.Time.Any_Delays) + is limited new LCD_Module with private; + + function Create (Display_Width : Char_Position; + Display_Height : Line_Position; + Time : not null HAL.Time.Any_Delays; + Expander : Standard.PCF8574.Any_PCF8574_Module; + Mapping : Bit_Mapping := Standard_Mapping) return LCD_PCF8574; + + overriding + procedure Set_Backlight (This : LCD_PCF8574; + Is_On : Boolean := True); + +private + + type LCD_PCF8574 (Display_Width : Char_Position; + Display_Height : Line_Position; + Time : not null HAL.Time.Any_Delays) + is limited new LCD_Module (Display_Width, Display_Height, Time) with + record + I2C_Driver : Standard.PCF8574.Any_PCF8574_Module; + Pins : Bit_Mapping; + end record; + + overriding + procedure Toggle_Enable (This : LCD_PCF8574); + + overriding + procedure Output (This : in out LCD_PCF8574; + Cmd : UInt8; + Is_Data : Boolean := False); + + overriding + procedure Init_4bit_Mode (This : LCD_PCF8574); + +end LCD_HD44780.PCF8574; diff --git a/components/src/screen/lcd/lcd_hd44780.adb b/components/src/screen/lcd/lcd_hd44780.adb new file mode 100644 index 000000000..b6d18d89c --- /dev/null +++ b/components/src/screen/lcd/lcd_hd44780.adb @@ -0,0 +1,134 @@ +------------------------------------------------------------------------------ +-- -- +-- Copyright (C) 2022, AdaCore -- +-- -- +-- Redistribution and use in source and binary forms, with or without -- +-- modification, are permitted provided that the following conditions are -- +-- met: -- +-- 1. Redistributions of source code must retain the above copyright -- +-- notice, this list of conditions and the following disclaimer. -- +-- 2. Redistributions in binary form must reproduce the above copyright -- +-- notice, this list of conditions and the following disclaimer in -- +-- the documentation and/or other materials provided with the -- +-- distribution. -- +-- 3. Neither the name of the copyright holder nor the names of its -- +-- contributors may be used to endorse or promote products derived -- +-- from this software without specific prior written permission. -- +-- -- +-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -- +-- "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -- +-- LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR -- +-- A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -- +-- HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, -- +-- SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -- +-- LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, -- +-- DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -- +-- THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT -- +-- (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE -- +-- OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -- +-- -- +------------------------------------------------------------------------------ + +-- +-- From the Hitachi HD44780U data sheet: +-- +-- The HD44780U has two 8-bit registers, an instruction register (IR) +-- and a data register (DR). +-- +-- The IR stores instruction codes, such as display clear and cursor +-- shift, and address information for display data RAM (DDRAM) and +-- character generator RAM (CGRAM). The IR can only be written from +-- the MPU. +-- +-- The DR temporarily stores data to be written into DDRAM or CGRAM +-- and temporarily stores data to be read from DDRAM or CGRAM. Data +-- written into the DR from the MPU is automatically written into +-- DDRAM or CGRAM by an internal operation. The DR is also used for +-- data storage when reading data from DDRAM or CGRAM. When address +-- information is written into the IR, data is read and then stored +-- into the DR from DDRAM or CGRAM by an internal operation. Data +-- transfer between the MPU is then completed when the MPU reads the +-- DR. After the read, data in DDRAM or CGRAM at the next address is +-- sent to the DR for the next read from the MPU. By the register +-- selector (RS) signal, these two registers can be selected + + + +package body LCD_HD44780 is + + -- initialize display + procedure Initialize (This : not null Any_LCD_Module) is + begin + This.Init_4bit_Mode; + + -- now we can use the standard Command routine for set up + Command (This, Commands.Display_On); -- implies blink off and cursor off + Clear_Screen (This); + Command (This, Commands.Entry_Inc); + end Initialize; + + -- output at the current cursor location + procedure Put (This : not null Any_LCD_Module; C : Character) is + begin + This.Output (Character'Pos (C), Is_Data => True); + end Put; + + -- output at the current cursor location + procedure Put (This : not null Any_LCD_Module; Text : String) is + begin + for C of Text loop + Put (This, C); + end loop; + end Put; + + -- output at the specified cursor location + procedure Put (This : not null Any_LCD_Module; + X : Char_Position; + Y : Line_Position; + Text : String) + is + begin + Goto_XY (This, X, Y); + Put (This, Text); + end Put; + + -- output the command code Cmd to the display + procedure Command (This : not null Any_LCD_Module; Cmd : Command_Type) is + begin + This.Output (UInt8 (Cmd), Is_Data => False); + end Command; + + -- clear display and move cursor to home position + procedure Clear_Screen (This : not null Any_LCD_Module) is + begin + Command (This, Commands.Clear); + This.Time.Delay_Microseconds (1_500); + end Clear_Screen; + + -- move cursor to home position + procedure Home (This : not null Any_LCD_Module) is + begin + Command (This, 16#02#); + end Home; + + -- move cursor into line Y and before character position X. Lines + -- are numbered 1 to 2 (or 1 to 4 on big displays). The left most + -- character position is Y = 1. The right most position is + -- defined by Lcd.Display.Width; + procedure Goto_XY (This : not null Any_LCD_Module; + X : Char_Position; + Y : Line_Position) + is + begin + if X > This.Display_Width then return; end if; + if Y > This.Display_Height then return; end if; + case Y is + when 1 => Command (This, 16#80# + Command_Type (X) - 1); + when 2 => Command (This, 16#C0# + Command_Type (X) - 1); + when 3 => Command (This, 16#80# + Command_Type (X + This.Display_Width) - 1); + when 4 => Command (This, 16#C0# + Command_Type (X + This.Display_Width) - 1); + -- when others => null; + end case; + end Goto_XY; + +end LCD_HD44780; diff --git a/components/src/screen/lcd/lcd_hd44780.ads b/components/src/screen/lcd/lcd_hd44780.ads new file mode 100644 index 000000000..dfd3d07b3 --- /dev/null +++ b/components/src/screen/lcd/lcd_hd44780.ads @@ -0,0 +1,135 @@ +------------------------------------------------------------------------------ +-- -- +-- Copyright (C) 2022, AdaCore -- +-- -- +-- Redistribution and use in source and binary forms, with or without -- +-- modification, are permitted provided that the following conditions are -- +-- met: -- +-- 1. Redistributions of source code must retain the above copyright -- +-- notice, this list of conditions and the following disclaimer. -- +-- 2. Redistributions in binary form must reproduce the above copyright -- +-- notice, this list of conditions and the following disclaimer in -- +-- the documentation and/or other materials provided with the -- +-- distribution. -- +-- 3. Neither the name of the copyright holder nor the names of its -- +-- contributors may be used to endorse or promote products derived -- +-- from this software without specific prior written permission. -- +-- -- +-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -- +-- "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -- +-- LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR -- +-- A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -- +-- HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, -- +-- SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -- +-- LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, -- +-- DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -- +-- THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT -- +-- (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE -- +-- OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -- +-- -- +------------------------------------------------------------------------------ + +-- driver for text based LCDs in the typical sizes of 16x2 or 20x4 + +with HAL; use HAL; +with HAL.Time; + +package LCD_HD44780 is + + subtype Char_Position is UInt8 range 1 .. 40; + subtype Line_Position is UInt8 range 1 .. 4; + + -- typical display formats are: + -- 8x1 16x1 20x1 + -- 8x2 12x2 16x2 20x2 24x2 40x2 + -- 16x4 20x4 40x4 + + type LCD_Module (Display_Width : Char_Position; + Display_Height : Line_Position; + Time : not null HAL.Time.Any_Delays) + is abstract tagged limited private; + + type Any_LCD_Module is access all LCD_Module'Class; + + procedure Initialize (This : not null Any_LCD_Module); + + procedure Put (This : not null Any_LCD_Module; C : Character) with Inline; + procedure Put (This : not null Any_LCD_Module; Text : String); + -- output at the current cursor location + + procedure Put (This : not null Any_LCD_Module; + X : Char_Position; + Y : Line_Position; + Text : String); + -- output at the specified cursor location + + procedure Clear_Screen (This : not null Any_LCD_Module); + -- clear display and move cursor to home position + + procedure Home (This : not null Any_LCD_Module); + -- move cursor to home position + + procedure Goto_XY (This : not null Any_LCD_Module; X : Char_Position; Y : Line_Position); + -- move cursor into line Y and before character position X. Lines + -- are numbered 1 to 2 (or 1 to 4 on big displays). The left most + -- character position is Y = 1. The right most position is + -- defined by Display_Width; + + procedure Set_Backlight (This : LCD_Module; + Is_On : Boolean := True) is abstract; + + type HD44780_Pins is (Enable, ReadWrite, RegSel, Backlight, D0, D1, D2, D3, D4, D5, D6, D7); + subtype HD44780_4bit_Pins is HD44780_Pins range Enable .. D3; + + type Command_Type is new UInt8; + procedure Command (This : not null Any_LCD_Module; Cmd : Command_Type) + with Inline; + -- send the command code Cmd to the display + + package Commands is + Clear : constant Command_Type := 16#01#; + Home : constant Command_Type := 16#02#; + + -- interface data width and number of lines + Mode_4bit_1line : constant Command_Type := 16#20#; + Mode_4bit_2line : constant Command_Type := 16#28#; + Mode_8bit_1line : constant Command_Type := 16#30#; + Mode_8bit_2line : constant Command_Type := 16#38#; + + -- display on/off, cursor on/off, blinking char at cursor position + Display_Off : constant Command_Type := 16#08#; + Display_On : constant Command_Type := 16#0C#; + Display_On_Blink : constant Command_Type := 16#0D#; + Display_On_Cursor : constant Command_Type := 16#0E#; + Display_On_Cursor_Blink : constant Command_Type := 16#0F#; + + -- entry mode + Entry_Inc : constant Command_Type := 16#06#; + Entry_Dec : constant Command_Type := 16#04#; + Entry_Shift_Inc : constant Command_Type := 16#07#; + Entry_Shift_Dec : constant Command_Type := 16#05#; + + -- cursor/shift display + Move_Cursor_Left : constant Command_Type := 16#10#; + Move_Cursor_Right : constant Command_Type := 16#14#; + Move_Display_Left : constant Command_Type := 16#18#; + Move_Display_Right : constant Command_Type := 16#1C#; + end Commands; + + +private + + type LCD_Module (Display_Width : Char_Position; + Display_Height : Line_Position; + Time : not null HAL.Time.Any_Delays) + is abstract tagged limited null record; + + procedure Toggle_Enable (This : LCD_Module) is null; + + procedure Output (This : in out LCD_Module; + Cmd : UInt8; + Is_Data : Boolean := False) is null; + + procedure Init_4bit_Mode (This : LCD_Module) is null; + +end LCD_HD44780; From bbf2500898256195706b4ae0c76693c1bd6807b2 Mon Sep 17 00:00:00 2001 From: RREE Date: Fri, 6 May 2022 18:44:51 +0200 Subject: [PATCH 06/11] use controlling parameter directly in in out mode, not the pointer to class wide --- .../src/screen/lcd/lcd_hd44780-pcf8574.adb | 8 ++-- .../src/screen/lcd/lcd_hd44780-pcf8574.ads | 8 ++-- components/src/screen/lcd/lcd_hd44780.adb | 38 ++++++++++--------- components/src/screen/lcd/lcd_hd44780.ads | 26 ++++++------- 4 files changed, 41 insertions(+), 39 deletions(-) diff --git a/components/src/screen/lcd/lcd_hd44780-pcf8574.adb b/components/src/screen/lcd/lcd_hd44780-pcf8574.adb index e7471e778..35fd12dd7 100644 --- a/components/src/screen/lcd/lcd_hd44780-pcf8574.adb +++ b/components/src/screen/lcd/lcd_hd44780-pcf8574.adb @@ -70,7 +70,7 @@ package body LCD_HD44780.PCF8574 is overriding - procedure Set_Backlight (This : LCD_PCF8574; + procedure Set_Backlight (This : in out LCD_PCF8574; Is_On : Boolean := True) is Bl : Boolean renames I2C_Shadow (This.Pins (Backlight)); @@ -95,9 +95,9 @@ package body LCD_HD44780.PCF8574 is overriding - procedure Output (This : in out LCD_PCF8574; - Cmd : UInt8; - Is_Data : Boolean := False) + procedure Output (This : LCD_PCF8574; + Cmd : UInt8; + Is_Data : Boolean := False) is RW_Bit : constant Bit_Number := This.Pins (ReadWrite); RS_Bit : constant Bit_Number := This.Pins (RegSel); diff --git a/components/src/screen/lcd/lcd_hd44780-pcf8574.ads b/components/src/screen/lcd/lcd_hd44780-pcf8574.ads index f3b738bca..8e7dec911 100644 --- a/components/src/screen/lcd/lcd_hd44780-pcf8574.ads +++ b/components/src/screen/lcd/lcd_hd44780-pcf8574.ads @@ -67,7 +67,7 @@ package LCD_HD44780.PCF8574 is Mapping : Bit_Mapping := Standard_Mapping) return LCD_PCF8574; overriding - procedure Set_Backlight (This : LCD_PCF8574; + procedure Set_Backlight (This : in out LCD_PCF8574; Is_On : Boolean := True); private @@ -85,9 +85,9 @@ private procedure Toggle_Enable (This : LCD_PCF8574); overriding - procedure Output (This : in out LCD_PCF8574; - Cmd : UInt8; - Is_Data : Boolean := False); + procedure Output (This : LCD_PCF8574; + Cmd : UInt8; + Is_Data : Boolean := False); overriding procedure Init_4bit_Mode (This : LCD_PCF8574); diff --git a/components/src/screen/lcd/lcd_hd44780.adb b/components/src/screen/lcd/lcd_hd44780.adb index b6d18d89c..28f089300 100644 --- a/components/src/screen/lcd/lcd_hd44780.adb +++ b/components/src/screen/lcd/lcd_hd44780.adb @@ -57,65 +57,67 @@ package body LCD_HD44780 is -- initialize display - procedure Initialize (This : not null Any_LCD_Module) is + procedure Initialize (This : in out LCD_Module) is + Dispatch : constant Any_LCD_Module := This'Unchecked_Access; begin - This.Init_4bit_Mode; + Dispatch.Init_4bit_Mode; -- now we can use the standard Command routine for set up - Command (This, Commands.Display_On); -- implies blink off and cursor off - Clear_Screen (This); - Command (This, Commands.Entry_Inc); + Dispatch.Command (Commands.Display_On); -- implies blink off and cursor off + This.Clear_Screen; + Dispatch.Command (Commands.Entry_Inc); end Initialize; -- output at the current cursor location - procedure Put (This : not null Any_LCD_Module; C : Character) is + procedure Put (This : in out LCD_Module; C : Character) is begin This.Output (Character'Pos (C), Is_Data => True); end Put; -- output at the current cursor location - procedure Put (This : not null Any_LCD_Module; Text : String) is + procedure Put (This : in out LCD_Module; Text : String) is begin for C of Text loop - Put (This, C); + This.Put (C); end loop; end Put; -- output at the specified cursor location - procedure Put (This : not null Any_LCD_Module; + procedure Put (This : in out LCD_Module; X : Char_Position; Y : Line_Position; Text : String) is begin - Goto_XY (This, X, Y); - Put (This, Text); + This.Goto_XY (X, Y); + This.Put (Text); end Put; -- output the command code Cmd to the display - procedure Command (This : not null Any_LCD_Module; Cmd : Command_Type) is + procedure Command (This : in out LCD_Module; Cmd : Command_Type) is + Dispatch : constant Any_LCD_Module := This'Unchecked_Access; begin - This.Output (UInt8 (Cmd), Is_Data => False); + Dispatch.Output (UInt8 (Cmd), Is_Data => False); end Command; -- clear display and move cursor to home position - procedure Clear_Screen (This : not null Any_LCD_Module) is + procedure Clear_Screen (This : in out LCD_Module) is begin - Command (This, Commands.Clear); + This.Command (Commands.Clear); This.Time.Delay_Microseconds (1_500); end Clear_Screen; -- move cursor to home position - procedure Home (This : not null Any_LCD_Module) is + procedure Home (This : in out LCD_Module) is begin - Command (This, 16#02#); + This.Command (16#02#); end Home; -- move cursor into line Y and before character position X. Lines -- are numbered 1 to 2 (or 1 to 4 on big displays). The left most -- character position is Y = 1. The right most position is -- defined by Lcd.Display.Width; - procedure Goto_XY (This : not null Any_LCD_Module; + procedure Goto_XY (This : in out LCD_Module; X : Char_Position; Y : Line_Position) is diff --git a/components/src/screen/lcd/lcd_hd44780.ads b/components/src/screen/lcd/lcd_hd44780.ads index dfd3d07b3..0fd22df15 100644 --- a/components/src/screen/lcd/lcd_hd44780.ads +++ b/components/src/screen/lcd/lcd_hd44780.ads @@ -29,7 +29,7 @@ -- -- ------------------------------------------------------------------------------ --- driver for text based LCDs in the typical sizes of 16x2 or 20x4 +-- driver for text based LCDs in the typical sizes of 8x1, 16x2 or 20x4 with HAL; use HAL; with HAL.Time; @@ -51,38 +51,38 @@ package LCD_HD44780 is type Any_LCD_Module is access all LCD_Module'Class; - procedure Initialize (This : not null Any_LCD_Module); + procedure Initialize (This : in out LCD_Module); - procedure Put (This : not null Any_LCD_Module; C : Character) with Inline; - procedure Put (This : not null Any_LCD_Module; Text : String); + procedure Put (This : in out LCD_Module; C : Character) with Inline; + procedure Put (This : in out LCD_Module; Text : String); -- output at the current cursor location - procedure Put (This : not null Any_LCD_Module; + procedure Put (This : in out LCD_Module; X : Char_Position; Y : Line_Position; Text : String); -- output at the specified cursor location - procedure Clear_Screen (This : not null Any_LCD_Module); + procedure Clear_Screen (This : in out LCD_Module); -- clear display and move cursor to home position - procedure Home (This : not null Any_LCD_Module); + procedure Home (This : in out LCD_Module); -- move cursor to home position - procedure Goto_XY (This : not null Any_LCD_Module; X : Char_Position; Y : Line_Position); + procedure Goto_XY (This : in out LCD_Module; X : Char_Position; Y : Line_Position); -- move cursor into line Y and before character position X. Lines -- are numbered 1 to 2 (or 1 to 4 on big displays). The left most -- character position is Y = 1. The right most position is -- defined by Display_Width; - procedure Set_Backlight (This : LCD_Module; + procedure Set_Backlight (This : in out LCD_Module; Is_On : Boolean := True) is abstract; type HD44780_Pins is (Enable, ReadWrite, RegSel, Backlight, D0, D1, D2, D3, D4, D5, D6, D7); subtype HD44780_4bit_Pins is HD44780_Pins range Enable .. D3; type Command_Type is new UInt8; - procedure Command (This : not null Any_LCD_Module; Cmd : Command_Type) + procedure Command (This : in out LCD_Module; Cmd : Command_Type) with Inline; -- send the command code Cmd to the display @@ -126,9 +126,9 @@ private procedure Toggle_Enable (This : LCD_Module) is null; - procedure Output (This : in out LCD_Module; - Cmd : UInt8; - Is_Data : Boolean := False) is null; + procedure Output (This : LCD_Module; + Cmd : UInt8; + Is_Data : Boolean := False) is null; procedure Init_4bit_Mode (This : LCD_Module) is null; From 3b5dc72aa5b6bdbcc82b77f0278e13569b770d2c Mon Sep 17 00:00:00 2001 From: RREE Date: Sun, 8 May 2022 21:26:29 +0200 Subject: [PATCH 07/11] make the call to Output dispatching --- components/src/screen/lcd/lcd_hd44780.adb | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/components/src/screen/lcd/lcd_hd44780.adb b/components/src/screen/lcd/lcd_hd44780.adb index 28f089300..b8728d025 100644 --- a/components/src/screen/lcd/lcd_hd44780.adb +++ b/components/src/screen/lcd/lcd_hd44780.adb @@ -70,8 +70,9 @@ package body LCD_HD44780 is -- output at the current cursor location procedure Put (This : in out LCD_Module; C : Character) is + Dispatch : constant Any_LCD_Module := This'Unchecked_Access; begin - This.Output (Character'Pos (C), Is_Data => True); + Dispatch.Output (Character'Pos (C), Is_Data => True); end Put; -- output at the current cursor location From 6cafb6d27b9f36b1f77df5659d174fb89faac823 Mon Sep 17 00:00:00 2001 From: RREE Date: Tue, 10 May 2022 21:57:09 +0200 Subject: [PATCH 08/11] corrected GNAT style issues --- .../src/screen/lcd/lcd_hd44780-pcf8574.adb | 22 +++++++++++++-- components/src/screen/lcd/lcd_hd44780.adb | 28 ++++++++++++++++--- components/src/screen/lcd/lcd_hd44780.ads | 1 - 3 files changed, 44 insertions(+), 7 deletions(-) diff --git a/components/src/screen/lcd/lcd_hd44780-pcf8574.adb b/components/src/screen/lcd/lcd_hd44780-pcf8574.adb index 35fd12dd7..5b0e0b7ba 100644 --- a/components/src/screen/lcd/lcd_hd44780-pcf8574.adb +++ b/components/src/screen/lcd/lcd_hd44780-pcf8574.adb @@ -36,15 +36,18 @@ pragma Restrictions (No_Implicit_Heap_Allocations); package body LCD_HD44780.PCF8574 is - type Shadow_Bits is array (Bit_Number) of Boolean with Pack, Size => 8; I2C_Shadow : Shadow_Bits; - procedure Write_Shadow (This : Lcd_Pcf8574) + procedure Write_Shadow (This : LCD_PCF8574) with Inline; + ------------ + -- Create -- + ------------ + function Create (Display_Width : Char_Position; Display_Height : Line_Position; Time : not null HAL.Time.Any_Delays; @@ -59,6 +62,9 @@ package body LCD_HD44780.PCF8574 is end return; end Create; + ------------------ + -- Write_Shadow -- + ------------------ procedure Write_Shadow (This : LCD_PCF8574) is @@ -68,6 +74,9 @@ package body LCD_HD44780.PCF8574 is This.I2C_Driver.Set (Shadow_As_Byte); end Write_Shadow; + ------------------- + -- Set_Backlight -- + ------------------- overriding procedure Set_Backlight (This : in out LCD_PCF8574; @@ -79,6 +88,9 @@ package body LCD_HD44780.PCF8574 is This.Write_Shadow; end Set_Backlight; + ------------------- + -- Toggle_Enable -- + ------------------- overriding procedure Toggle_Enable (This : LCD_PCF8574) @@ -93,6 +105,9 @@ package body LCD_HD44780.PCF8574 is This.Time.Delay_Microseconds (280); end Toggle_Enable; + ------------ + -- Output -- + ------------ overriding procedure Output (This : LCD_PCF8574; @@ -134,6 +149,9 @@ package body LCD_HD44780.PCF8574 is This.Time.Delay_Microseconds (50); end Output; + -------------------- + -- Init_4bit_Mode -- + -------------------- overriding procedure Init_4bit_Mode (This : LCD_PCF8574) diff --git a/components/src/screen/lcd/lcd_hd44780.adb b/components/src/screen/lcd/lcd_hd44780.adb index b8728d025..07ceeac6e 100644 --- a/components/src/screen/lcd/lcd_hd44780.adb +++ b/components/src/screen/lcd/lcd_hd44780.adb @@ -52,11 +52,12 @@ -- sent to the DR for the next read from the MPU. By the register -- selector (RS) signal, these two registers can be selected - - package body LCD_HD44780 is - -- initialize display + ---------------- + -- Initialize -- + ---------------- + procedure Initialize (This : in out LCD_Module) is Dispatch : constant Any_LCD_Module := This'Unchecked_Access; begin @@ -68,6 +69,10 @@ package body LCD_HD44780 is Dispatch.Command (Commands.Entry_Inc); end Initialize; + --------- + -- Put -- + --------- + -- output at the current cursor location procedure Put (This : in out LCD_Module; C : Character) is Dispatch : constant Any_LCD_Module := This'Unchecked_Access; @@ -94,6 +99,10 @@ package body LCD_HD44780 is This.Put (Text); end Put; + ------------- + -- Command -- + ------------- + -- output the command code Cmd to the display procedure Command (This : in out LCD_Module; Cmd : Command_Type) is Dispatch : constant Any_LCD_Module := This'Unchecked_Access; @@ -101,6 +110,10 @@ package body LCD_HD44780 is Dispatch.Output (UInt8 (Cmd), Is_Data => False); end Command; + ------------------ + -- Clear_Screen -- + ------------------ + -- clear display and move cursor to home position procedure Clear_Screen (This : in out LCD_Module) is begin @@ -108,12 +121,20 @@ package body LCD_HD44780 is This.Time.Delay_Microseconds (1_500); end Clear_Screen; + ---------- + -- Home -- + ---------- + -- move cursor to home position procedure Home (This : in out LCD_Module) is begin This.Command (16#02#); end Home; + ------------- + -- Goto_XY -- + ------------- + -- move cursor into line Y and before character position X. Lines -- are numbered 1 to 2 (or 1 to 4 on big displays). The left most -- character position is Y = 1. The right most position is @@ -130,7 +151,6 @@ package body LCD_HD44780 is when 2 => Command (This, 16#C0# + Command_Type (X) - 1); when 3 => Command (This, 16#80# + Command_Type (X + This.Display_Width) - 1); when 4 => Command (This, 16#C0# + Command_Type (X + This.Display_Width) - 1); - -- when others => null; end case; end Goto_XY; diff --git a/components/src/screen/lcd/lcd_hd44780.ads b/components/src/screen/lcd/lcd_hd44780.ads index 0fd22df15..64c0b399d 100644 --- a/components/src/screen/lcd/lcd_hd44780.ads +++ b/components/src/screen/lcd/lcd_hd44780.ads @@ -116,7 +116,6 @@ package LCD_HD44780 is Move_Display_Right : constant Command_Type := 16#1C#; end Commands; - private type LCD_Module (Display_Width : Char_Position; From 0811ea574e36bfd59017d1bdc61173cafcc7f2b7 Mon Sep 17 00:00:00 2001 From: RREE Date: Tue, 17 May 2022 21:18:35 +0200 Subject: [PATCH 09/11] add support for user defined custom characters --- .../lcd/lcd_hd44780-custom_characters.ads | 70 +++++++++++++++++++ components/src/screen/lcd/lcd_hd44780.adb | 27 +++++++ components/src/screen/lcd/lcd_hd44780.ads | 11 +++ 3 files changed, 108 insertions(+) create mode 100644 components/src/screen/lcd/lcd_hd44780-custom_characters.ads diff --git a/components/src/screen/lcd/lcd_hd44780-custom_characters.ads b/components/src/screen/lcd/lcd_hd44780-custom_characters.ads new file mode 100644 index 000000000..555675053 --- /dev/null +++ b/components/src/screen/lcd/lcd_hd44780-custom_characters.ads @@ -0,0 +1,70 @@ +------------------------------------------------------------------------------ +-- -- +-- Copyright (C) 2022, AdaCore -- +-- -- +-- Redistribution and use in source and binary forms, with or without -- +-- modification, are permitted provided that the following conditions are -- +-- met: -- +-- 1. Redistributions of source code must retain the above copyright -- +-- notice, this list of conditions and the following disclaimer. -- +-- 2. Redistributions in binary form must reproduce the above copyright -- +-- notice, this list of conditions and the following disclaimer in -- +-- the documentation and/or other materials provided with the -- +-- distribution. -- +-- 3. Neither the name of the copyright holder nor the names of its -- +-- contributors may be used to endorse or promote products derived -- +-- from this software without specific prior written permission. -- +-- -- +-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -- +-- "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -- +-- LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR -- +-- A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -- +-- HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, -- +-- SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -- +-- LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, -- +-- DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -- +-- THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT -- +-- (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE -- +-- OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -- +-- -- +------------------------------------------------------------------------------ + +-- sample definitions for custom characters + +package LCD_HD44780.Custom_Characters is + + -- + -- Sample Custom Characters + -- + + Filled_Heart : constant Custom_Character_Definition := + (2#00000#, + 2#00000#, + 2#01010#, + 2#11111#, + 2#11111#, + 2#11111#, + 2#01110#, + 2#00100#); + + Open_Heart : constant Custom_Character_Definition := + (2#00000#, + 2#00000#, + 2#01010#, + 2#10101#, + 2#10001#, + 2#10001#, + 2#01010#, + 2#00100#); + + Thermometer : constant Custom_Character_Definition := + (2#00100#, + 2#01010#, + 2#01010#, + 2#01010#, + 2#01010#, + 2#10001#, + 2#10001#, + 2#01110#); + +end LCD_HD44780.Custom_Characters; diff --git a/components/src/screen/lcd/lcd_hd44780.adb b/components/src/screen/lcd/lcd_hd44780.adb index 07ceeac6e..234bec781 100644 --- a/components/src/screen/lcd/lcd_hd44780.adb +++ b/components/src/screen/lcd/lcd_hd44780.adb @@ -154,4 +154,31 @@ package body LCD_HD44780 is end case; end Goto_XY; + ----------------------------- + -- Create_Custom_Character -- + ----------------------------- + + procedure Create_Custom_Character (This : in out LCD_Module; + Position : Custom_Character_Index; + Definition : Custom_Character_Definition) + is + Start_Address : constant := 16#40#; + Dispatch : constant Any_LCD_Module := This'Unchecked_Access; + begin + Dispatch.Output (UInt8 (Start_Address + 8 * Position), Is_Data => False); + for Line of Definition loop + Dispatch.Output (UInt8 (Line), Is_Data => True); + end loop; + end Create_Custom_Character; + + ----------------- + -- Custom_Char -- + ----------------- + + function Custom_Char (From_Index : Custom_Character_Index) return Character + is + begin + return Character'Val (From_Index); + end Custom_Char; + end LCD_HD44780; diff --git a/components/src/screen/lcd/lcd_hd44780.ads b/components/src/screen/lcd/lcd_hd44780.ads index 64c0b399d..84a3360ea 100644 --- a/components/src/screen/lcd/lcd_hd44780.ads +++ b/components/src/screen/lcd/lcd_hd44780.ads @@ -81,6 +81,17 @@ package LCD_HD44780 is type HD44780_Pins is (Enable, ReadWrite, RegSel, Backlight, D0, D1, D2, D3, D4, D5, D6, D7); subtype HD44780_4bit_Pins is HD44780_Pins range Enable .. D3; + -- + -- Custom Characters + -- + type Custom_Character_Definition is array (1 .. 8) of UInt5; + subtype Custom_Character_Index is Integer range 0 .. 7; + procedure Create_Custom_Character (This : in out LCD_Module; + Position : Custom_Character_Index; + Definition : Custom_Character_Definition); + function Custom_Char (From_Index : Custom_Character_Index) return Character; + + type Command_Type is new UInt8; procedure Command (This : in out LCD_Module; Cmd : Command_Type) with Inline; From 7e5d67cdbd978a3edbaf195dccacf313d788f045 Mon Sep 17 00:00:00 2001 From: RREE Date: Tue, 31 May 2022 21:17:00 +0200 Subject: [PATCH 10/11] use standard Adacore copyright notice --- .../src/io_expander/pcf8574/pcf8574.adb | 36 +++++++++++++++---- .../src/io_expander/pcf8574/pcf8574.ads | 35 +++++++++++++++--- .../src/screen/lcd/lcd_hd44780-pcf8574.ads | 1 - 3 files changed, 60 insertions(+), 12 deletions(-) diff --git a/components/src/io_expander/pcf8574/pcf8574.adb b/components/src/io_expander/pcf8574/pcf8574.adb index 8d94f770c..ea6424c1c 100644 --- a/components/src/io_expander/pcf8574/pcf8574.adb +++ b/components/src/io_expander/pcf8574/pcf8574.adb @@ -1,9 +1,33 @@ --- --- Copyright 2022 (C) Rolf Ebert --- --- SPDX-License-Identifier: BSD-3-Clause --- - +------------------------------------------------------------------------------ +-- -- +-- Copyright (C) 2022, AdaCore -- +-- -- +-- Redistribution and use in source and binary forms, with or without -- +-- modification, are permitted provided that the following conditions are -- +-- met: -- +-- 1. Redistributions of source code must retain the above copyright -- +-- notice, this list of conditions and the following disclaimer. -- +-- 2. Redistributions in binary form must reproduce the above copyright -- +-- notice, this list of conditions and the following disclaimer in -- +-- the documentation and/or other materials provided with the -- +-- distribution. -- +-- 3. Neither the name of the copyright holder nor the names of its -- +-- contributors may be used to endorse or promote products derived -- +-- from this software without specific prior written permission. -- +-- -- +-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -- +-- "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -- +-- LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR -- +-- A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -- +-- HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, -- +-- SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -- +-- LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, -- +-- DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -- +-- THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT -- +-- (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE -- +-- OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -- +-- -- +------------------------------------------------------------------------------ package body PCF8574 is diff --git a/components/src/io_expander/pcf8574/pcf8574.ads b/components/src/io_expander/pcf8574/pcf8574.ads index 6cdcbeca0..04b4054a9 100644 --- a/components/src/io_expander/pcf8574/pcf8574.ads +++ b/components/src/io_expander/pcf8574/pcf8574.ads @@ -1,8 +1,33 @@ --- --- Copyright 2022 (C) Rolf Ebert --- --- SPDX-License-Identifier: BSD-3-Clause --- +------------------------------------------------------------------------------ +-- -- +-- Copyright (C) 2022, AdaCore -- +-- -- +-- Redistribution and use in source and binary forms, with or without -- +-- modification, are permitted provided that the following conditions are -- +-- met: -- +-- 1. Redistributions of source code must retain the above copyright -- +-- notice, this list of conditions and the following disclaimer. -- +-- 2. Redistributions in binary form must reproduce the above copyright -- +-- notice, this list of conditions and the following disclaimer in -- +-- the documentation and/or other materials provided with the -- +-- distribution. -- +-- 3. Neither the name of the copyright holder nor the names of its -- +-- contributors may be used to endorse or promote products derived -- +-- from this software without specific prior written permission. -- +-- -- +-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -- +-- "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -- +-- LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR -- +-- A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -- +-- HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, -- +-- SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -- +-- LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, -- +-- DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -- +-- THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT -- +-- (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE -- +-- OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -- +-- -- +------------------------------------------------------------------------------ with HAL; use HAL; with HAL.I2C; use HAL.I2C; diff --git a/components/src/screen/lcd/lcd_hd44780-pcf8574.ads b/components/src/screen/lcd/lcd_hd44780-pcf8574.ads index 8e7dec911..b800c7d6d 100644 --- a/components/src/screen/lcd/lcd_hd44780-pcf8574.ads +++ b/components/src/screen/lcd/lcd_hd44780-pcf8574.ads @@ -31,7 +31,6 @@ -- driver for text based LCDs connected via I2C port expander PCF8574 --- with HAL; use HAL; with HAL.Time; with HAL.I2C; with PCF8574; From a622cb1ab7f062eab93629060dff930a0742b600 Mon Sep 17 00:00:00 2001 From: RREE Date: Sat, 11 Jun 2022 10:50:56 +0200 Subject: [PATCH 11/11] remove unneeded with clause --- components/src/screen/lcd/lcd_hd44780-pcf8574.ads | 1 - 1 file changed, 1 deletion(-) diff --git a/components/src/screen/lcd/lcd_hd44780-pcf8574.ads b/components/src/screen/lcd/lcd_hd44780-pcf8574.ads index b800c7d6d..939704722 100644 --- a/components/src/screen/lcd/lcd_hd44780-pcf8574.ads +++ b/components/src/screen/lcd/lcd_hd44780-pcf8574.ads @@ -32,7 +32,6 @@ -- driver for text based LCDs connected via I2C port expander PCF8574 with HAL.Time; -with HAL.I2C; with PCF8574; package LCD_HD44780.PCF8574 is