unit IO_GPIO; (* Access GPIO on Raspberry PI 40-pin *)
interface
procedure readInputs;
procedure setOutputs;
procedure unexportGPIO;
var
GPIO: array [0..27] of boolean;
implementation
uses
(*********************************************************************
Uses system units
*********************************************************************)
SysUtils,
Unix,
BaseUnix,
Crt,
(*********************************************************************
Uses user defined units
*********************************************************************)
iolist;
type
Direction = (GPIO_input, GPIO_output,GPIO_NotUsed);
var
aGPIO: array [0..27, 0..2] of string;
dGPIO: array [0..27] of Direction;
(*********************************************************************
Open GPIO for access
*********************************************************************)
procedure gpioExport(pin, dir: string);
var
fileDesc: integer;
gpioPinDirPath: string;
begin
(* Prepare SoC pin for access *)
fileDesc := fpopen('/sys/class/gpio/export', O_WrOnly);
fpwrite(fileDesc, pin[1], Length(pin));
fpclose(fileDesc);
(* Set SoC pin (in/out) direction *)
gpioPinDirPath := '/sys/class/gpio/'+'gpio'+pin+'/direction';
fileDesc := fpopen(gpioPinDirPath, O_WrOnly);
fpwrite(fileDesc, dir[1], Length(dir));
fpclose(fileDesc);
end;
(*********************************************************************
Read GPIO inputs
*********************************************************************)
function input(pin, dir: string): boolean;
var
fileDesc: integer;
gpioPinValuePath: string;
state: string = '0';
begin
input := false;
gpioPinValuePath := '/sys/class/gpio/'+'gpio'+pin+'/value';
gpioExport(pin, dir);
(* Open SoC pin input read-only mode *)
fileDesc := fpopen(gpioPinValuePath, O_RdOnly);
if fileDesc > 0 then
begin
(* Read status of input pin, return true if high *)
fpread(fileDesc, state[1], 1);
if state = '0' then
input := false
else
input := true;
end;
(* Close SoC pin *)
fpclose(fileDesc);
end;
(*********************************************************************
Set GPIO output
*********************************************************************)
procedure output(pin, dir, cmd: string);
var
fileDesc: integer;
gpioPinValuePath: string;
begin
gpioPinValuePath := '/sys/class/gpio/'+'gpio'+pin+'/value';
gpioExport(pin, dir);
(* Set SoC pin output state *)
fileDesc := fpopen(gpioPinValuePath, O_WrOnly);
fpwrite(fileDesc, cmd[1], 1);
fpclose(fileDesc);
end;
(*********************************************************************
Close GPIO
*********************************************************************)
procedure gpioUnexport(pin: string);
var
fileDesc: integer;
begin
(* Free SoC pin *)
fileDesc := fpopen('/sys/class/gpio/unexport', O_WrOnly);
fpwrite(fileDesc, pin[1], Length(pin));
fpclose(fileDesc);
end;
(*********************************************************************
Free (unexport) GPIO pins on program exit
*********************************************************************)
procedure unexportGPIO;
var
io: integer;
begin
for io := 0 to 27 do
if dGPIO[io] in [GPIO_Input..GPIO_Output] then
gpioUnexport(intToStr(io));
end;
(*********************************************************************
Read inputs
*********************************************************************)
procedure readInputs;
var
io:integer;
begin
for io := 0 to 27 do
if dGPIO[io] = GPIO_Input then
GPIO[io] := input(aGPIO[io][0], aGPIO[io][1]); (* input function, returns boolean input state *)
end;
(*********************************************************************
Set outputs
*********************************************************************)
procedure setOutputs;
var
io: integer;
begin
for io := 0 to 27 do
if dGPIO[io] = GPIO_Output then
begin
if GPIO[io] then (* Define command *)
aGPIO[io][2] := '1'
else
aGPIO[io][2] := '0';
output(aGPIO[io][0], aGPIO[io][1], aGPIO[io][2]); (* output procedure, write output state *)
end;
end;
// ----------------------------------------------------------------------
Procedure init_GPIO;
var
i: integer;
begin
for i := 0 to 27 do
begin
aGPIO[i][0] := intToStr(i); //define pin
case IOlist.GPIO[i] of
'output': begin
aGPIO[i][1] := 'out';
aGPIO[i][2] := '0'; // init off state
dGPIO[i] := GPIO_Output;
end;
'input' : begin
aGPIO[i][1] := 'in';
dGPIO[i] := GPIO_Input;
end;
ELSE
begin
dGPIO[i] := GPIO_NotUsed;
end;
end{case};
end;
setOutputs;
readInputs;
writeln ('CHG 12');
end;
begin
writeln ('IO_GPIO Mod version');
init_GPIO;
(*********************************************************************
End unit
*********************************************************************)
end.