|
| 1 | +------------------------------------------------------------------------------ |
| 2 | +-- -- |
| 3 | +-- Copyright (C) 2023, 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.Unchecked_Conversion; |
| 33 | + |
| 34 | +package body XPT2046 is |
| 35 | + |
| 36 | + type Power_Down_Mode is |
| 37 | + (Power_Down, -- Power Down Between Conversions |
| 38 | + Reference_Off, -- Reference off, ADC on |
| 39 | + ADC_Off, -- Reference on, ADC off |
| 40 | + Always_On); |
| 41 | + |
| 42 | + for Power_Down_Mode use |
| 43 | + (Power_Down => 0, |
| 44 | + Reference_Off => 1, |
| 45 | + ADC_Off => 2, |
| 46 | + Always_On => 3); |
| 47 | + |
| 48 | + type Conversion_Mode is (Use_12_Bits, Use_8_Bits); |
| 49 | + pragma Unreferenced (Use_8_Bits); |
| 50 | + |
| 51 | + type Control_Byte is record |
| 52 | + Power_Down : Power_Down_Mode; |
| 53 | + Reference : Reference_Kind; |
| 54 | + Mode : Conversion_Mode; |
| 55 | + Channel : Natural range 0 .. 7; |
| 56 | + Start : Boolean; |
| 57 | + end record; |
| 58 | + |
| 59 | + for Control_Byte use record |
| 60 | + Power_Down at 0 range 0 .. 1; |
| 61 | + Reference at 0 range 2 .. 2; |
| 62 | + Mode at 0 range 3 .. 3; |
| 63 | + Channel at 0 range 4 .. 6; |
| 64 | + Start at 0 range 7 .. 7; |
| 65 | + end record; |
| 66 | + |
| 67 | + function Cast is new Ada.Unchecked_Conversion (Control_Byte, HAL.UInt8); |
| 68 | + |
| 69 | + procedure Read_Sensors |
| 70 | + (This : XPT2046_Device'Class; |
| 71 | + X, Y, Z1, Z2 : out Sensor_Value); |
| 72 | + |
| 73 | + Z_Treshold : constant Sensor_Value := 3200; |
| 74 | + |
| 75 | + ------------------------- |
| 76 | + -- Active_Touch_Points -- |
| 77 | + ------------------------- |
| 78 | + |
| 79 | + overriding |
| 80 | + function Active_Touch_Points |
| 81 | + (This : in out XPT2046_Device) return HAL.Touch_Panel.Touch_Identifier |
| 82 | + is |
| 83 | + X, Y, Z1, Z2 : Sensor_Value; |
| 84 | + begin |
| 85 | + This.Read_Sensors (X, Y, Z1, Z2); |
| 86 | + return (if Z2 - Z1 < Z_Treshold then 1 else 0); |
| 87 | + end Active_Touch_Points; |
| 88 | + |
| 89 | + --------------- |
| 90 | + -- Calibrate -- |
| 91 | + --------------- |
| 92 | + |
| 93 | + procedure Calibrate |
| 94 | + (This : in out XPT2046_Device'Class; |
| 95 | + Min_X : Sensor_Value; |
| 96 | + Max_X : Sensor_Value; |
| 97 | + Min_Y : Sensor_Value; |
| 98 | + Max_Y : Sensor_Value) is |
| 99 | + begin |
| 100 | + This.Min_X := Min_X; |
| 101 | + This.Max_X := Max_X; |
| 102 | + This.Min_Y := Min_Y; |
| 103 | + This.Max_Y := Max_Y; |
| 104 | + end Calibrate; |
| 105 | + |
| 106 | + -------------------------- |
| 107 | + -- Get_All_Touch_Points -- |
| 108 | + -------------------------- |
| 109 | + |
| 110 | + overriding |
| 111 | + function Get_All_Touch_Points |
| 112 | + (This : in out XPT2046_Device) return HAL.Touch_Panel.TP_State |
| 113 | + is |
| 114 | + Result : constant TP_Touch_State := This.Get_Touch_Point (1); |
| 115 | + begin |
| 116 | + if Result = Null_Touch_State then |
| 117 | + return (1 .. 0 => <>); |
| 118 | + else |
| 119 | + return (1 => Result); |
| 120 | + end if; |
| 121 | + end Get_All_Touch_Points; |
| 122 | + |
| 123 | + --------------------- |
| 124 | + -- Get_Touch_Point -- |
| 125 | + --------------------- |
| 126 | + |
| 127 | + overriding |
| 128 | + function Get_Touch_Point |
| 129 | + (This : in out XPT2046_Device; |
| 130 | + Touch_Id : HAL.Touch_Panel.Touch_Identifier) |
| 131 | + return HAL.Touch_Panel.TP_Touch_State |
| 132 | + is |
| 133 | + pragma Unreferenced (Touch_Id); |
| 134 | + |
| 135 | + Result : HAL.Touch_Panel.TP_Touch_State; |
| 136 | + X, Y, Z1, Z2 : Sensor_Value; |
| 137 | + begin |
| 138 | + This.Read_Sensors (X, Y, Z1, Z2); |
| 139 | + |
| 140 | + if Z2 - Z1 >= Z_Treshold or Z1 = 0 or X < This.Min_X then |
| 141 | + return Null_Touch_State; |
| 142 | + end if; |
| 143 | + |
| 144 | + Result.X := Natural (X - Sensor_Value'Min (This.Min_X, X)) |
| 145 | + * This.LCD_Natural_Width / Natural (This.Max_X - This.Min_X); |
| 146 | + |
| 147 | + Result.Y := Natural (Y - Sensor_Value'Min (This.Min_Y, Y)) |
| 148 | + * This.LCD_Natural_Height / Natural (This.Max_Y - This.Min_Y); |
| 149 | + |
| 150 | + Result.X := Natural'Min (Result.X, This.LCD_Natural_Width - 1); |
| 151 | + Result.Y := Natural'Min (Result.Y, This.LCD_Natural_Height - 1); |
| 152 | + |
| 153 | + if (This.Swap and Invert_X) /= 0 then |
| 154 | + Result.X := This.LCD_Natural_Width - 1 - Result.X; |
| 155 | + end if; |
| 156 | + |
| 157 | + if (This.Swap and Invert_Y) /= 0 then |
| 158 | + Result.Y := This.LCD_Natural_Height - 1 - Result.Y; |
| 159 | + end if; |
| 160 | + |
| 161 | + if (This.Swap and Swap_XY) /= 0 then |
| 162 | + declare |
| 163 | + Temp : constant Natural := Result.X; |
| 164 | + begin |
| 165 | + Result.X := Result.Y; |
| 166 | + Result.Y := Temp; |
| 167 | + end; |
| 168 | + end if; |
| 169 | + |
| 170 | + Result.Weight := Natural (X) * Natural (Z2 - Z1) / Natural (Z1); |
| 171 | + Result.Weight := Result.Weight / 500; |
| 172 | + Result.Weight := Natural'Max (4, Result.Weight); |
| 173 | + Result.Weight := Natural'Min (19, Result.Weight); |
| 174 | + Result.Weight := 20 - Result.Weight; |
| 175 | + |
| 176 | + return Result; |
| 177 | + end Get_Touch_Point; |
| 178 | + |
| 179 | + ----------------- |
| 180 | + -- Read_Sensor -- |
| 181 | + ----------------- |
| 182 | + |
| 183 | + function Read_Sensor |
| 184 | + (This : XPT2046_Device'Class; |
| 185 | + Channel : Natural; |
| 186 | + Last : Boolean := False; |
| 187 | + Reference : Reference_Kind := Differential) return Sensor_Value |
| 188 | + is |
| 189 | + use all type HAL.SPI.SPI_Status; |
| 190 | + |
| 191 | + Status : HAL.SPI.SPI_Status; |
| 192 | + Response : HAL.SPI.SPI_Data_8b (1 .. 2); |
| 193 | + |
| 194 | + Mode : constant Power_Down_Mode := |
| 195 | + (if Last then Power_Down else Reference_Off); |
| 196 | + -- elsif Reference = Differential then Reference_Off |
| 197 | + -- else Always_On); |
| 198 | + |
| 199 | + Control : constant Control_Byte := |
| 200 | + (Power_Down => Mode, |
| 201 | + Reference => Reference, |
| 202 | + Mode => Use_12_Bits, |
| 203 | + Channel => Channel, |
| 204 | + Start => True); |
| 205 | + begin |
| 206 | + This.SPI.Transmit (HAL.SPI.SPI_Data_8b'(1 => Cast (Control)), Status); |
| 207 | + pragma Assert (Status = Ok); |
| 208 | + This.SPI.Receive (Response, Status); |
| 209 | + pragma Assert (Status = Ok); |
| 210 | + |
| 211 | + return HAL.Shift_Left (HAL.UInt16 (Response (1)) and 127, 5) + |
| 212 | + HAL.Shift_Right (HAL.UInt16 (Response (2)), 3); |
| 213 | + end Read_Sensor; |
| 214 | + |
| 215 | + ------------------- |
| 216 | + -- Read_Sensor_3 -- |
| 217 | + ------------------- |
| 218 | + |
| 219 | + function Read_Sensor_3 |
| 220 | + (This : XPT2046_Device'Class; |
| 221 | + Channel : Natural; |
| 222 | + Last : Boolean := False; |
| 223 | + Reference : Reference_Kind := Differential) return Sensor_Value |
| 224 | + is |
| 225 | + List : array (1 .. 3) of Sensor_Value; |
| 226 | + Max : Sensor_Value := Sensor_Value'First; |
| 227 | + Min : Sensor_Value := Sensor_Value'Last; |
| 228 | + begin |
| 229 | + for J in 1 .. 3 loop |
| 230 | + List (J) := This.Read_Sensor |
| 231 | + (Channel, |
| 232 | + Last => J = 3 and Last, |
| 233 | + Reference => Reference); |
| 234 | + |
| 235 | + Min := Sensor_Value'Min (Min, List (J)); |
| 236 | + Max := Sensor_Value'Max (Max, List (J)); |
| 237 | + end loop; |
| 238 | + |
| 239 | + for X of List loop |
| 240 | + if X < Max and X > Min then |
| 241 | + return X; |
| 242 | + end if; |
| 243 | + end loop; |
| 244 | + |
| 245 | + if List (1) in List (2) | List (3) then |
| 246 | + return List (1); |
| 247 | + else |
| 248 | + return List (2); |
| 249 | + end if; |
| 250 | + end Read_Sensor_3; |
| 251 | + |
| 252 | + ------------------ |
| 253 | + -- Read_Sensors -- |
| 254 | + ------------------ |
| 255 | + |
| 256 | + procedure Read_Sensors |
| 257 | + (This : XPT2046_Device'Class; |
| 258 | + X, Y, Z1, Z2 : out Sensor_Value) is |
| 259 | + begin |
| 260 | + This.CS.Clear; |
| 261 | + X := This.Read_Sensor (Channel_X); |
| 262 | + Y := This.Read_Sensor_3 (Channel_Y); -- Y is so noisy |
| 263 | + Z1 := This.Read_Sensor (Channel_Z1); |
| 264 | + Z2 := This.Read_Sensor (Channel_Z2, Last => True); |
| 265 | + This.CS.Set; |
| 266 | + end Read_Sensors; |
| 267 | + |
| 268 | + ---------------- |
| 269 | + -- Set_Bounds -- |
| 270 | + ---------------- |
| 271 | + |
| 272 | + overriding |
| 273 | + procedure Set_Bounds |
| 274 | + (This : in out XPT2046_Device; |
| 275 | + Width : Natural; |
| 276 | + Height : Natural; |
| 277 | + Swap : HAL.Touch_Panel.Swap_State) is |
| 278 | + begin |
| 279 | + This.LCD_Natural_Width := Width; |
| 280 | + This.LCD_Natural_Height := Height; |
| 281 | + This.Swap := Swap; |
| 282 | + end Set_Bounds; |
| 283 | + |
| 284 | +end XPT2046; |
0 commit comments