Raspberry Pi : BerryClip/fi: what changed

Revision 0 to 1. Removed lines have a minus sign; added lines have a plus sign.

Title: Raspberry Pi : BerryClip/fi

New		Line
1	+	# Raspberry Pi : BerryClip
2	+
3	+	![](/wiki-images/3/3f/Pi_berryclip.png)
4	+
5	+	BerryClip on kuusi (6) ledinen lisäkortti Raspberry Pi:hin. Se koostuu piirilevystä johon on sijoitettu kuusi LEDiä, yksi kytkin ja yksi summeri. Kortti on helppo liittää "raspin" GPIO liittimeen.
6	+
7	+	## Laitteisto
8	+
9	+	![](/wiki-images/b/bd/Pi_berryclip_sch.png)
10	+
11	+	Alla olevassa luettelossa on kytketty komponentit vastaaviin liittimen nastoihin ja GPIO viitteisiin:
12	+
13	+	- LED 1 - Pin 7 - GPIO4
14	+	- LED 2 - Pin 11 - GPIO17
15	+	- LED 3 - Pin 15 - GPIO22
16	+	- LED 4 - Pin 19 - GPIO10
17	+	- LED 5 - Pin 21 - GPIO9
18	+	- LED 6 - Pin 23 - GPIO11
19	+	- Summeri - Pin 24 - GPIO8
20	+	- Kytkin - Pin 26 - GPIO7
21	+
22	+	\| GPIO \| Pin \| \| Pin \| GPIO \|
23	+	\|--------\|-----\|-----\|-----\|--------\|
24	+	\| GPIO7 \| 26 \| \| 25 \| GND \|
25	+	\| GPIO8 \| 24 \| \| 23 \| GPIO11 \|
26	+	\| GPIO25 \| 22 \| \| 21 \| GPIO9 \|
27	+	\| GND \| 20 \| \| 19 \| GPIO10 \|
28	+	\| GPIO24 \| 18 \| \| 17 \| +3.3V \|
29	+	\| GPIO23 \| 16 \| \| 15 \| GPIO22 \|
30	+	\| GND \| 14 \| \| 13 \| GPIO27 \|
31	+	\| GPIO18 \| 12 \| \| 11 \| GPIO17 \|
32	+	\| GPIO15 \| 10 \| \| 9 \| GND \|
33	+	\| GPIO14 \| 8 \| \| 7 \| GPIO4 \|
34	+	\| GND \| 6 \| \| 5 \| GPIO3 \|
35	+	\| +5V \| 4 \| \| 3 \| GPIO2 \|
36	+	\| +5V \| 2 \| \| 1 \| +3.3V \|
37	+
38	+	## Ohjelmisto
39	+
40	+	![](/wiki-images/c/c5/Pi_berryclip_uml.png)
41	+
42	+	Seuraava ohjelmalistaus esimerkki näyttää miten ohjataan BerryClip-levyä.
43	+
44	+	Toimiakseen ohjelma pitää ajaa pääkäyttäjän (root) oikeuksilla (esim. sudo ./berryclipdemo).
45	+
46	+	\| Taso \| \| Käännösyksikkö \|
47	+	\|------\|------------------------------\|-----------------------------------------\|
48	+	\| 1 \| Käyttöliittymä, sovellustaso \| unit1.pas, unit1.lfm, berryclipdemo.lpr \|
49	+	\| 2 \| Levytaso \| uberryclip.pas \|
50	+	\| 3 \| \| uraspberrypi.pas \|
51	+	\| 4 \| I/O ajuri \| pi_io_unit.pas \|
52	+
53	+	### Käyttöliittymä
54	+
55	+	![](/wiki-images/e/e5/Pi_berryclipdemo.png)
56	+
57	+	Käyttöliittymä sisältyy vaihtopainonapeista jotka ohjaa lediä ja painonapista joka soittaa summeria. Näiden lisäksi kytkimen tila näytetään lomakkeella olevalla "ledillä". Piirilevyjen ledien tila näytetään lomakkeella olevilla ledeillä.
58	+
59	+	BerryClipDemo ohjelma käyttää seuraavia komponentteja: [[TApplicationProperties]], [[TButton/fi\|TButton]], [[TShape]] ja [[TToggleBox]].
60	+
61	+	#### unit1.pas
62	+
63	+	``` pascal
64	+	unit Unit1;
65	+
66	+	{$mode objfpc}{$H+}
67	+
68	+	interface
69	+
70	+	uses
71	+	Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
72	+	ExtCtrls, uberryclip;
73	+
74	+	type
75	+
76	+	{ TForm1 }
77	+
78	+	TForm1 = class(TForm)
79	+	ApplicationProperties1: TApplicationProperties;
80	+	Button1: TButton;
81	+	Led4ToggleBox: TToggleBox;
82	+	Led6ToggleBox: TToggleBox;
83	+	Led2ToggleBox: TToggleBox;
84	+	Led3ToggleBox: TToggleBox;
85	+	Led1ToggleBox: TToggleBox;
86	+	Led5ToggleBox: TToggleBox;
87	+	Shape1: TShape;
88	+	Shape2: TShape;
89	+	Shape3: TShape;
90	+	Shape4: TShape;
91	+	Shape5: TShape;
92	+	Shape6: TShape;
93	+	Shape7: TShape;
94	+	procedure ApplicationProperties1Idle(Sender: TObject; var Done: Boolean);
95	+	procedure Button1MouseDown(Sender: TObject; Button: TMouseButton;
96	+	Shift: TShiftState; X, Y: Integer);
97	+	procedure Button1MouseUp(Sender: TObject; Button: TMouseButton;
98	+	Shift: TShiftState; X, Y: Integer);
99	+	procedure FormCreate(Sender: TObject);
100	+	procedure FormDestroy(Sender: TObject);
101	+	procedure Led1ToggleBoxChange(Sender: TObject);
102	+	procedure Led2ToggleBoxChange(Sender: TObject);
103	+	procedure Led3ToggleBoxChange(Sender: TObject);
104	+	procedure Led4ToggleBoxChange(Sender: TObject);
105	+	procedure Led5ToggleBoxChange(Sender: TObject);
106	+	procedure Led6ToggleBoxChange(Sender: TObject);
107	+	private
108	+	{ private declarations }
109	+	Berry_Clip:TBerryClip;
110	+	public
111	+	{ public declarations }
112	+	end;
113	+
114	+	var
115	+	Form1: TForm1;
116	+
117	+	implementation
118	+
119	+	{$R *.lfm}
120	+
121	+	{ TForm1 }
122	+
123	+	procedure TForm1.ApplicationProperties1Idle(Sender: TObject; var Done: Boolean);
124	+	begin
125	+	if Berry_Clip.ReadSwitch
126	+	then shape7.Brush.Color:=clBlack
127	+	else shape7.Brush.Color:=clWhite;
128	+	end;
129	+
130	+	procedure TForm1.Button1MouseDown(Sender: TObject; Button: TMouseButton;
131	+	Shift: TShiftState; X, Y: Integer);
132	+	begin
133	+	Berry_Clip.SetBuzzerOn;
134	+	end;
135	+
136	+	procedure TForm1.Button1MouseUp(Sender: TObject; Button: TMouseButton;
137	+	Shift: TShiftState; X, Y: Integer);
138	+	begin
139	+	Berry_Clip.SetBuzzerOff;
140	+	end;
141	+
142	+	procedure TForm1.FormCreate(Sender: TObject);
143	+	begin
144	+	Berry_Clip := TBerryClip.Create;
145	+	end;
146	+
147	+	procedure TForm1.FormDestroy(Sender: TObject);
148	+	begin
149	+	Berry_Clip.Free;
150	+	end;
151	+
152	+	procedure TForm1.Led1ToggleBoxChange(Sender: TObject);
153	+	begin
154	+	if Led1ToggleBox.Checked then
155	+	begin
156	+	Berry_Clip.SetLedOn(1);
157	+	shape1.Brush.Color:=clRed ;
158	+	end
159	+	else
160	+	begin
161	+	Berry_Clip.SetLedOff(1);
162	+	shape1.Brush.Color:=clWhite;
163	+	end;
164	+	end;
165	+
166	+	procedure TForm1.Led2ToggleBoxChange(Sender: TObject);
167	+	begin
168	+	if Led2ToggleBox.Checked then
169	+	begin
170	+	Berry_Clip.SetLedOn(2);
171	+	shape2.Brush.Color:=clRed;
172	+	end
173	+	else
174	+	begin
175	+	Berry_Clip.SetLedOff(2);
176	+	shape2.Brush.Color:=clWhite;
177	+	end;
178	+	end;
179	+
180	+	procedure TForm1.Led3ToggleBoxChange(Sender: TObject);
181	+	begin
182	+	if Led3ToggleBox.Checked then
183	+	begin
184	+	Berry_Clip.SetLedOn(3);
185	+	shape3.Brush.Color:=clYellow;
186	+	end
187	+	else
188	+	begin
189	+	Berry_Clip.SetLedOff(3);
190	+	shape3.Brush.Color:=clWhite;
191	+	end;
192	+	end;
193	+
194	+	procedure TForm1.Led4ToggleBoxChange(Sender: TObject);
195	+	begin
196	+	if Led4ToggleBox.Checked then
197	+	begin
198	+	Berry_Clip.SetLedOn(4);
199	+	shape4.Brush.Color:=clYellow;
200	+	end
201	+	else
202	+	begin
203	+	Berry_Clip.SetLedOff(4);
204	+	shape4.Brush.Color:=clWhite;
205	+	end;
206	+	end;
207	+
208	+	procedure TForm1.Led5ToggleBoxChange(Sender: TObject);
209	+	begin
210	+	if Led5ToggleBox.Checked then
211	+	begin
212	+	Berry_Clip.SetLedOn(5);
213	+	shape5.Brush.Color:=clGreen;
214	+	end
215	+	else
216	+	begin
217	+	Berry_Clip.SetLedOff(5);
218	+	shape5.Brush.Color:=clWhite;
219	+	end;
220	+	end;
221	+
222	+	procedure TForm1.Led6ToggleBoxChange(Sender: TObject);
223	+	begin
224	+	if Led6ToggleBox.Checked then
225	+	begin
226	+	Berry_Clip.SetLedOn(6);
227	+	shape6.Brush.Color:=clGreen;
228	+	end
229	+	else
230	+	begin
231	+	Berry_Clip.SetLedOff(6);
232	+	shape6.Brush.Color:=clWhite;
233	+	end;
234	+	end;
235	+
236	+	end.
237	+	```
238	+
239	+	#### unit1.lfm
240	+
241	+	``` pascal
242	+	object Form1: TForm1
243	+	Left = 269
244	+	Height = 184
245	+	Top = 175
246	+	Width = 176
247	+	Caption = 'BerryClip'
248	+	ClientHeight = 184
249	+	ClientWidth = 176
250	+	OnCreate = FormCreate
251	+	OnDestroy = FormDestroy
252	+	object Led2ToggleBox: TToggleBox
253	+	Left = 8
254	+	Height = 24
255	+	Top = 32
256	+	Width = 128
257	+	Caption = 'Led2ToggleBox'
258	+	OnChange = Led2ToggleBoxChange
259	+	TabOrder = 0
260	+	end
261	+	object Led1ToggleBox: TToggleBox
262	+	Left = 8
263	+	Height = 24
264	+	Top = 8
265	+	Width = 128
266	+	Caption = 'Led1ToggleBox'
267	+	OnChange = Led1ToggleBoxChange
268	+	TabOrder = 1
269	+	end
270	+	object Led3ToggleBox: TToggleBox
271	+	Left = 8
272	+	Height = 24
273	+	Top = 56
274	+	Width = 128
275	+	Caption = 'Led3ToggleBox'
276	+	OnChange = Led3ToggleBoxChange
277	+	TabOrder = 2
278	+	end
279	+	object Led4ToggleBox: TToggleBox
280	+	Left = 8
281	+	Height = 24
282	+	Top = 80
283	+	Width = 128
284	+	Caption = 'Led4ToggleBox'
285	+	OnChange = Led4ToggleBoxChange
286	+	TabOrder = 3
287	+	end
288	+	object Led5ToggleBox: TToggleBox
289	+	Left = 8
290	+	Height = 24
291	+	Top = 104
292	+	Width = 128
293	+	Caption = 'Led5ToggleBox'
294	+	OnChange = Led5ToggleBoxChange
295	+	TabOrder = 4
296	+	end
297	+	object Led6ToggleBox: TToggleBox
298	+	Left = 8
299	+	Height = 24
300	+	Top = 128
301	+	Width = 128
302	+	Caption = 'Led6ToggleBox'
303	+	OnChange = Led6ToggleBoxChange
304	+	TabOrder = 5
305	+	end
306	+	object Shape1: TShape
307	+	Left = 144
308	+	Height = 18
309	+	Top = 12
310	+	Width = 16
311	+	Shape = stCircle
312	+	end
313	+	object Shape2: TShape
314	+	Left = 144
315	+	Height = 18
316	+	Top = 34
317	+	Width = 16
318	+	Shape = stCircle
319	+	end
320	+	object Shape3: TShape
321	+	Left = 144
322	+	Height = 18
323	+	Top = 58
324	+	Width = 16
325	+	Shape = stCircle
326	+	end
327	+	object Shape4: TShape
328	+	Left = 144
329	+	Height = 18
330	+	Top = 82
331	+	Width = 16
332	+	Shape = stCircle
333	+	end
334	+	object Shape5: TShape
335	+	Left = 144
336	+	Height = 18
337	+	Top = 106
338	+	Width = 16
339	+	Shape = stCircle
340	+	end
341	+	object Shape6: TShape
342	+	Left = 144
343	+	Height = 18
344	+	Top = 130
345	+	Width = 16
346	+	Shape = stCircle
347	+	end
348	+	object Shape7: TShape
349	+	Left = 144
350	+	Height = 18
351	+	Top = 158
352	+	Width = 16
353	+	Shape = stCircle
354	+	end
355	+	object Button1: TButton
356	+	Left = 8
357	+	Height = 25
358	+	Top = 151
359	+	Width = 64
360	+	Caption = 'Buzzer'
361	+	OnMouseDown = Button1MouseDown
362	+	OnMouseUp = Button1MouseUp
363	+	TabOrder = 6
364	+	end
365	+	object ApplicationProperties1: TApplicationProperties
366	+	OnIdle = ApplicationProperties1Idle
367	+	left = 72
368	+	top = 152
369	+	end
370	+	end
371	+	</source>
372	+
373	+	=== Pääohjelma ===
374	+	<source>
375	+	program berryclipdemo;
376	+
377	+	{$mode objfpc}{$H+}
378	+
379	+	uses
380	+	{$IFDEF UNIX}{$IFDEF UseCThreads}
381	+	cthreads,
382	+	{$ENDIF}{$ENDIF}
383	+	Interfaces, // this includes the LCL widgetset
384	+	Forms, Unit1, pi_io_unit, uberryclip, uraspberrypi
385	+	{ you can add units after this };
386	+
387	+	{$R *.res}
388	+
389	+	begin
390	+	RequireDerivedFormResource := True;
391	+	Application.Initialize;
392	+	Application.CreateForm(TForm1, Form1);
393	+	Application.Run;
394	+	end.
395	+	```
396	+
397	+	### Levy
398	+
399	+	#### uberryclip.pas
400	+
401	+	``` pascal
402	+	unit uberryclip;
403	+
404	+	{$mode objfpc}{$H+}
405	+
406	+	interface
407	+
408	+	uses
409	+	Classes, SysUtils,
410	+	uRaspberrypi;
411	+	type
412	+
413	+	{ TBerryClip }
414	+
415	+	TBerryClip = class
416	+	private
417	+	RaspBerryPi : TRaspBerryPi;
418	+	public
419	+	constructor Create;
420	+	procedure SetLedOn( led_no :integer );
421	+	procedure SetLedOff( led_no :integer );
422	+	procedure SetBuzzerOn;
423	+	procedure SetBuzzerOff;
424	+	function ReadSwitch:boolean;
425	+	destructor Destroy; override;
426	+	end;
427	+	implementation
428	+
429	+	{ TBerryClip }
430	+
431	+	constructor TBerryClip.Create;
432	+	begin
433	+	RaspBerryPi := TRaspBerryPi.Create;
434	+	RaspBerryPi.SetGpioPinOutput(GPIO4); // Led 1
435	+	RaspBerryPi.SetGpioPinOutput(GPIO9); // Led 2
436	+	RaspBerryPi.SetGpioPinOutput(GPIO10);// Led 3
437	+	RaspBerryPi.SetGpioPinOutput(GPIO11);// Led 4
438	+	RaspBerryPi.SetGpioPinOutput(GPIO17);// Led 5
439	+	RaspBerryPi.SetGpioPinOutput(GPIO22);// Led 6
440	+	RaspBerryPi.SetGpioPinInput(GPIO7); // Switch
441	+	RaspBerryPi.SetGpioPinOutput(GPIO8); // Buzzer
442	+	end;
443	+
444	+	procedure TBerryClip.SetLedOn(led_no: integer);
445	+	begin
446	+	case led_no of
447	+	1 : RaspBerryPi.SetGpioBit(GPIO4);
448	+	2 : RaspBerryPi.SetGpioBit(GPIO17);
449	+	3 : RaspBerryPi.SetGpioBit(GPIO22);
450	+	4 : RaspBerryPi.SetGpioBit(GPIO10);
451	+	5 : RaspBerryPi.SetGpioBit(GPIO9);
452	+	6 : RaspBerryPi.SetGpioBit(GPIO11);
453	+	end;
454	+	end;
455	+
456	+	procedure TBerryClip.SetLedOff(led_no: integer);
457	+	begin
458	+	case led_no of
459	+	1 : RaspBerryPi.ClearGpioBit(GPIO4);
460	+	2 : RaspBerryPi.ClearGpioBit(GPIO17);
461	+	3 : RaspBerryPi.ClearGpioBit(GPIO22);
462	+	4 : RaspBerryPi.ClearGpioBit(GPIO10);
463	+	5 : RaspBerryPi.ClearGpioBit(GPIO9);
464	+	6 : RaspBerryPi.ClearGpioBit(GPIO11);
465	+	end;
466	+
467	+	end;
468	+
469	+	procedure TBerryClip.SetBuzzerOn;
470	+	begin
471	+	RaspBerryPi.SetGpioBit(GPIO8);
472	+	end;
473	+
474	+	procedure TBerryClip.SetBuzzerOff;
475	+	begin
476	+	RaspBerryPi.ClearGpioBit(GPIO8);
477	+	end;
478	+
479	+	function TBerryClip.ReadSwitch: boolean;
480	+	begin
481	+	result := RaspBerryPi.GetGpioBit(GPIO7);
482	+	end;
483	+
484	+	destructor TBerryClip.Destroy;
485	+	begin
486	+	RaspBerryPi.Free;
487	+	inherited Destroy;
488	+	end;
489	+
490	+	end.
491	+	```
492	+
493	+	#### uraspberrypi.pas
494	+
495	+	``` pascal
496	+	unit uraspberrypi;
497	+
498	+	{$mode objfpc}{$H+}
499	+
500	+	interface
501	+
502	+	uses
503	+	Classes, SysUtils, pi_io_unit, dialogs;
504	+
505	+	const
506	+
507	+	GPIO4 = 4;
508	+	GPIO7 = 7;
509	+	GPIO8 = 8;
510	+	GPIO9 = 9;
511	+	GPIO10= 10;
512	+	GPIO11= 11;
513	+	GPIO17= 17;
514	+	GPIO22= 22;
515	+
516	+	type
517	+
518	+	{ TRaspBerryPi }
519	+
520	+	TRaspBerryPi = class
521	+	private
522	+	io_port: T_IO_Port;
523	+	public
524	+	constructor Create;
525	+	procedure ClearGpioBit(no:byte);
526	+	function GetGpioBit(no:byte):boolean;
527	+	procedure SetGpioBit(no:byte);
528	+	procedure SetGpioPinInput( no:byte);
529	+	procedure SetGpioPinOutput( no:byte);
530	+	destructor Destroy; override;
531	+	end;
532	+
533	+	implementation
534	+
535	+	{ TRaspBerryPi }
536	+
537	+	constructor TRaspBerryPi.Create;
538	+	begin
539	+	if not MapIo
540	+	then ShowMessage('Error mapping gpio')
541	+	else
542	+	begin
543	+	io_port := T_IO_Port.Create;
544	+	io_port.f_gpio := CreatePort(GPIO_BASE);
545	+	end ;
546	+	end;
547	+
548	+	procedure TRaspBerryPi.ClearGpioBit(no: byte);
549	+	begin
550	+	io_port.ClearBit(no);
551	+	end;
552	+
553	+	function TRaspBerryPi.GetGpioBit(no: byte): boolean;
554	+	begin
555	+	result := io_port.GetBit(no);
556	+	end;
557	+
558	+	procedure TRaspBerryPi.SetGpioBit(no: byte);
559	+	begin
560	+	io_port.SetBit(no);
561	+	end;
562	+
563	+	procedure TRaspBerryPi.SetGpioPinInput(no: byte);
564	+	begin
565	+	io_port.SetPinMode(no,INPUT);
566	+	end;
567	+
568	+	procedure TRaspBerryPi.SetGpioPinOutput(no: byte);
569	+	begin
570	+	io_port.SetPinMode(no,OUTPUT);
571	+	end;
572	+
573	+	destructor TRaspBerryPi.Destroy;
574	+	begin
575	+	io_port.ClearBit(GPIO4);
576	+	io_port.ClearBit(GPIO9);
577	+	io_port.ClearBit(GPIO10);
578	+	io_port.ClearBit(GPIO11);
579	+	io_port.ClearBit(GPIO17);
580	+	io_port.ClearBit(GPIO22);
581	+	io_port.ClearBit(GPIO8);
582	+	UnMapIo(io_port);
583	+	io_port.free;
584	+	inherited Destroy;
585	+	end;
586	+
587	+	end.
588	+	</synyaxhighlight>
589	+
590	+	==== pi_io_unit.pas ====
591	+
592	+	<syntaxhighlight lang=pascal>
593	+	unit pi_io_unit;
594	+	// This code is tested only RPI2B Processor
595	+	{$mode objfpc}{$H+}
596	+
597	+	interface
598	+
599	+	uses
600	+	Classes, SysUtils, Unix, BaseUnix;
601	+
602	+	const
603	+	BCM2709_PBASE= $3F000000; // Peripheral Base in Bytes (RPI2B Processor)
604	+	// BCM2708_PBASE= $20000000; // Peripheral Base (maybe RPI1 )
605	+	REG_GPIO = BCM2709_PBASE div $1000; // $3F000 ;
606	+	PAGE_SIZE = $1000;
607	+
608	+	GPIO_BASE = (REG_GPIO + $200);
609	+
610	+	INPUT = 0;
611	+	OUTPUT = 1;
612	+
613	+	GPSET = $1C; // GPIO Pin Output Set
614	+	GPCLR = $28; // GPIO Pin Output Clear
615	+	GPLEV = $34; // GPIO Pin Level
616	+
617	+	type
618	+
619	+	{ T_IO_Port }
620	+
621	+	T_IO_Port = class
622	+	private
623	+	public
624	+	f_gpio: PLongWord;
625	+	procedure SetPinMode(a_io_pin, a_mode: byte);
626	+	function GetBit(a_io_pin : byte):boolean;inline;
627	+	procedure ClearBit(a_io_pin : byte);inline;
628	+	procedure SetBit(a_io_pin : byte);inline;
629	+	end;
630	+
631	+	function MapIo:boolean;// creates io mapping
632	+	procedure UnMapIo(a_Map: T_IO_Port);// close io
633	+	function CreatePort(PortGpio: LongWord): PLongWord;
634	+
635	+	implementation
636	+
637	+	var
638	+	fd: integer;// /dev/mem file handle
639	+
640	+	function MapIo: boolean;
641	+	begin
642	+	result := true;
643	+	fd := fpopen('/dev/mem', O_RdWr or O_Sync);
644	+	if fd < 0 then result := false; // unsuccessful mapping
645	+	end;
646	+
647	+	procedure UnMapIo( a_Map: T_IO_Port);
648	+	begin
649	+	if a_Map.f_gpio <> nil then
650	+	begin
651	+	fpMUnmap(a_Map.f_gpio, PAGE_SIZE);
652	+	a_Map.f_gpio := nil;
653	+	end;
654	+	end;
655	+
656	+	function CreatePort(PortGpio: LongWord): PLongWord;
657	+	begin
658	+	result := FpMmap(nil, PAGE_SIZE, PROT_READ or PROT_WRITE, MAP_SHARED, fd, PortGpio);
659	+	end;
660	+
661	+	procedure T_IO_Port.SetPinMode(a_io_pin, a_mode: byte);
662	+	var
663	+	fSel, shift : byte;
664	+	iof : PLongWord;
665	+	begin
666	+	fSel := (a_io_pin div $A)*4 ;
667	+	shift := (a_io_pin mod $A)*3 ;
668	+	iof := Pointer(LongWord(Self.f_gpio)+fSel);
669	+	case a_mode of
670	+	INPUT : iof^ := iof^ and ($FFFFFFFF - (7 shl shift));
671	+	OUTPUT : iof^ := iof^ and ($FFFFFFFF - (7 shl shift)) or (1 shl shift);
672	+	end;
673	+	end;
674	+
675	+	procedure T_IO_Port.SetBit(a_io_pin : byte);
676	+	var
677	+	iof : PLongWord;
678	+	begin
679	+	iof := Pointer(LongWord(Self.f_gpio) + GPSET + (a_io_pin shr 5) shl 2);
680	+	iof^ := 1 shl a_io_pin;
681	+	end;
682	+
683	+	procedure T_IO_Port.ClearBit(a_io_pin : byte);
684	+	var
685	+	iof : PLongWord;
686	+	begin
687	+	iof := Pointer(LongWord(Self.f_gpio) + GPCLR + (a_io_pin shr 5) shl 2);
688	+	iof^ := 1 shl a_io_pin;
689	+	end;
690	+
691	+	function T_IO_Port.GetBit(a_io_pin : byte):boolean;
692	+	var
693	+	iof : PLongWord;
694	+	begin
695	+	result := true;
696	+	iof := Pointer(LongWord(Self.f_gpio) + GPLEV + (a_io_pin shr 5) shl 2);
697	+	if (iof^ and (1 shl a_io_pin)) = 0 then result := false;
698	+	end;
699	+	end.
700	+	```
701	+
702	+	---
703	+	From the Free Pascal wiki, page "Raspberry Pi : BerryClip/fi", as it stood on 2020-02-23 after a change by Trev, out of the wiki's dump of 2024-05-26. Copyright stays with the author who wrote it, according to the old wiki's [[Licensing]] page. If you have concerns about this material, [message the admin](/wiki-contact).

Back to history