You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

187 lines
4.4 KiB

with Ada.Text_IO;
with Interfaces.C;
use Interfaces.C;
use Ada.Text_IO;
package body gpio is
procedure export_inner ( pin: in integer; filename : in String ) is
file : File_Type;
begin
-- exports the pin by using the file under /sys/class/gpio ...
open ( file, mode => Out_File,
Name => filename );
if (pin<10) then
declare
text : String := "" & integer'image (pin)(2);
begin
put (file, text);
end;
elsif (pin<100) then
declare
text : String := "" & integer'image(pin)(2) & integer'image(pin)(3);
begin
put (file, text);
end;
end if;
close ( file );
delay DURATION(0.1);
end;
procedure export ( pin : in integer ) is
begin
export_inner ( pin, "/sys/class/gpio/export" );
end;
procedure unexport ( pin : in integer ) is
begin
export_inner ( pin, "/sys/class/gpio/unexport" );
end;
procedure pinMode_inner ( filename: in String; mode: in String ) is
file : File_Type;
begin
open ( file, mode => Out_File,
Name => filename );
put ( file, item => mode );
close ( file );
end;
procedure pinMode ( pin : in integer; output: in Boolean ) is
begin
if (pin < 10) then
declare
filename: String := "/sys/class/gpio/gpio" & integer'image(pin)(2) & "/direction";
begin
if (output = true) then
pinMode_inner ( filename, "out" );
else
pinMode_inner ( filename, "in" );
end if;
end;
elsif (pin < 100) then
declare
filename: String := "/sys/class/gpio/gpio" & integer'image(pin)(2) & integer'image(pin)(3) & "/direction";
begin
if (output = true) then
pinMode_inner ( filename, "out" );
else
pinMode_inner ( filename, "in" );
end if;
end;
end if;
end;
function bcm2Wpi ( pin: In integer ) return integer is
pins : array ( 1 .. 28 ) of Integer :=
( 30, -- BCM PIN 0!!!,
31, 8, 9, 7, 21, 22, 11, 10, 13, 12, -- 1 .. 10
14, 26, 23, 15, 16, 27, 0, 1, 24, 28, -- 11 .. 20
29, 3, 4, 5, 6, 25, 2 ); -- 21 .. 28
begin
if ((pin+1) in pins'range) then
return pins(pin+1);
else
return -1;
end if;
end;
-- using the C-system function to call "gpio mode <pin> up"
procedure pullUp ( pin: In integer ) is
function Sys ( ARg: Char_Array) return Integer;
pragma Import ( C, Sys, "system" );
ret_val : Integer;
p : Integer;
begin
p := bcm2Wpi ( pin );
declare
text : String := "gpio mode "&integer'image(p) & " up";
begin
ret_val := sys ( To_C ( text ) );
end;
end;
-- using the C-system function to call "gpio mode <pin> down"
procedure pullDown ( pin: In integer ) is
function Sys ( ARg: Char_Array) return Integer;
pragma Import ( C, Sys, "system" );
ret_val : Integer;
p : Integer;
begin
p := bcm2Wpi ( pin );
declare
text : String := "gpio mode "&integer'image(p) & " down";
begin
ret_val := sys ( To_C ( text ) );
end;
end;
procedure digitalWrite ( pin : in integer; value: in boolean ) is
file : File_type;
outval : Integer;
begin
if (value = True) then
outval := 1;
else
outval := 0;
end if;
if (pin <10) then
declare
filename : String := "/sys/class/gpio/gpio" & integer'image(pin)(2) & "/value";
begin
open ( file, mode => Out_file,
name => filename );
put ( file, item => integer'image ( outval )(2) );
close ( file );
end;
elsif (pin <100) then
declare
filename : String := "/sys/class/gpio/gpio" & integer'image(pin)(2) & integer'image(pin)(3) & "/value";
begin
open ( file, mode => Out_file,
name => filename );
put ( file, item => integer'image ( outval )(2) );
close ( file );
end;
end if;
end;
function digitalRead ( pin : in integer ) return boolean is
file : File_type;
outval : Character;
begin
if (pin < 10) then
declare
filename : String := "/sys/class/gpio/gpio" & integer'image(pin)(2) & "/value";
begin
open ( file, mode => In_file,
name => filename );
get ( file, outval );
close ( file );
if (outval = '1') then return True;
else return False;
end if;
end;
elsif (pin < 100) then
declare
filename : String := "/sys/class/gpio/gpio" & integer'image(pin)(2) & integer'image(pin)(3) & "/value";
begin
open ( file, mode => In_file,
name => filename );
get ( file, outval );
close ( file );
if (outval = '1') then return True;
else return False;
end if;
end;
end if;
return False;
end;
end gpio;