Sign in Join
Wiki copytemporary

Raspberry Pi : BerryClip/fi: what changed

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

OldNewLine
11# Raspberry Pi : BerryClip
22
33![](/wiki-images/3/3f/Pi_berryclip.png)
44
55BerryClip 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.
66
77## Laitteisto
88
99![](/wiki-images/b/bd/Pi_berryclip_sch.png)
1010
1111Alla olevassa luettelossa on kytketty komponentit vastaaviin liittimen nastoihin ja GPIO viitteisiin:
1212
1313- LED 1 - Pin 7 - GPIO4
1414- LED 2 - Pin 11 - GPIO17
1515- LED 3 - Pin 15 - GPIO22
1616- LED 4 - Pin 19 - GPIO10
1717- LED 5 - Pin 21 - GPIO9
1818- LED 6 - Pin 23 - GPIO11
1919- Summeri - Pin 24 - GPIO8
2020- Kytkin - Pin 26 - GPIO7
2121
2222| GPIO | Pin | | Pin | GPIO |
2323|--------|-----|-----|-----|--------|
2424| GPIO7 | 26 | | 25 | GND |
2525| GPIO8 | 24 | | 23 | GPIO11 |
2626| GPIO25 | 22 | | 21 | GPIO9 |
2727| GND | 20 | | 19 | GPIO10 |
2828| GPIO24 | 18 | | 17 |  +3.3V |
2929| GPIO23 | 16 | | 15 | GPIO22 |
3030| GND | 14 | | 13 | GPIO27 |
3131| GPIO18 | 12 | | 11 | GPIO17 |
3232| GPIO15 | 10 | | 9 | GND |
3333| GPIO14 | 8 | | 7 | GPIO4 |
3434| GND | 6 | | 5 | GPIO3 |
3535|  +5V | 4 | | 3 | GPIO2 |
3636|  +5V | 2 | | 1 |  +3.3V |
3737
3838## Ohjelmisto
3939
4040![](/wiki-images/c/c5/Pi_berryclip_uml.png)
4141
4242Seuraava ohjelmalistaus esimerkki näyttää miten ohjataan BerryClip-levyä.
4343
4444Toimiakseen ohjelma pitää ajaa pääkäyttäjän (root) oikeuksilla (esim. sudo ./berryclipdemo).
4545
4646| Taso | | Käännösyksikkö |
4747|------|------------------------------|-----------------------------------------|
4848| 1 | Käyttöliittymä, sovellustaso | unit1.pas, unit1.lfm, berryclipdemo.lpr |
4949| 2 | Levytaso | uberryclip.pas |
5050| 3 | | uraspberrypi.pas |
5151| 4 | I/O ajuri | pi_io_unit.pas |
5252
5353### Käyttöliittymä
5454
5555![](/wiki-images/e/e5/Pi_berryclipdemo.png)
5656
5757Kä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ä.
5858
5959BerryClipDemo ohjelma käyttää seuraavia komponentteja: [[TApplicationProperties]], [[TButton/fi|TButton]], [[TShape]] ja [[TToggleBox]].
6060
6161#### unit1.pas
6262
6363``` pascal
6464unit Unit1;
6565
6666{$mode objfpc}{$H+}
6767
6868interface
6969
7070uses
7171 Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
7272 ExtCtrls, uberryclip;
7373
7474type
7575
7676 { TForm1 }
7777
7878 TForm1 = class(TForm)
7979 ApplicationProperties1: TApplicationProperties;
8080 Button1: TButton;
8181 Led4ToggleBox: TToggleBox;
8282 Led6ToggleBox: TToggleBox;
8383 Led2ToggleBox: TToggleBox;
8484 Led3ToggleBox: TToggleBox;
8585 Led1ToggleBox: TToggleBox;
8686 Led5ToggleBox: TToggleBox;
8787 Shape1: TShape;
8888 Shape2: TShape;
8989 Shape3: TShape;
9090 Shape4: TShape;
9191 Shape5: TShape;
9292 Shape6: TShape;
9393 Shape7: TShape;
9494 procedure ApplicationProperties1Idle(Sender: TObject; var Done: Boolean);
9595 procedure Button1MouseDown(Sender: TObject; Button: TMouseButton;
9696 Shift: TShiftState; X, Y: Integer);
9797 procedure Button1MouseUp(Sender: TObject; Button: TMouseButton;
9898 Shift: TShiftState; X, Y: Integer);
9999 procedure FormCreate(Sender: TObject);
100100 procedure FormDestroy(Sender: TObject);
101101 procedure Led1ToggleBoxChange(Sender: TObject);
102102 procedure Led2ToggleBoxChange(Sender: TObject);
103103 procedure Led3ToggleBoxChange(Sender: TObject);
104104 procedure Led4ToggleBoxChange(Sender: TObject);
105105 procedure Led5ToggleBoxChange(Sender: TObject);
106106 procedure Led6ToggleBoxChange(Sender: TObject);
107107 private
108108 { private declarations }
109109 Berry_Clip:TBerryClip;
110110 public
111111 { public declarations }
112112 end;
113113
114114var
115115 Form1: TForm1;
116116
117117implementation
118118
119119{$R *.lfm}
120120
121121{ TForm1 }
122122
123123procedure TForm1.ApplicationProperties1Idle(Sender: TObject; var Done: Boolean);
124124begin
125125 if Berry_Clip.ReadSwitch
126126 then shape7.Brush.Color:=clBlack
127127 else shape7.Brush.Color:=clWhite;
128128end;
129129
130130procedure TForm1.Button1MouseDown(Sender: TObject; Button: TMouseButton;
131131 Shift: TShiftState; X, Y: Integer);
132132begin
133133 Berry_Clip.SetBuzzerOn;
134134end;
135135
136136procedure TForm1.Button1MouseUp(Sender: TObject; Button: TMouseButton;
137137 Shift: TShiftState; X, Y: Integer);
138138begin
139139 Berry_Clip.SetBuzzerOff;
140140end;
141141
142142procedure TForm1.FormCreate(Sender: TObject);
143143begin
144144 Berry_Clip := TBerryClip.Create;
145145end;
146146
147147procedure TForm1.FormDestroy(Sender: TObject);
148148begin
149149 Berry_Clip.Free;
150150end;
151151
152152procedure TForm1.Led1ToggleBoxChange(Sender: TObject);
153153begin
154154 if Led1ToggleBox.Checked then
155155 begin
156156 Berry_Clip.SetLedOn(1);
157157 shape1.Brush.Color:=clRed ;
158158 end
159159 else
160160 begin
161161 Berry_Clip.SetLedOff(1);
162162 shape1.Brush.Color:=clWhite;
163163 end;
164164end;
165165
166166procedure TForm1.Led2ToggleBoxChange(Sender: TObject);
167167begin
168168 if Led2ToggleBox.Checked then
169169 begin
170170 Berry_Clip.SetLedOn(2);
171171 shape2.Brush.Color:=clRed;
172172 end
173173 else
174174 begin
175175 Berry_Clip.SetLedOff(2);
176176 shape2.Brush.Color:=clWhite;
177177 end;
178178end;
179179
180180procedure TForm1.Led3ToggleBoxChange(Sender: TObject);
181181begin
182182 if Led3ToggleBox.Checked then
183183 begin
184184 Berry_Clip.SetLedOn(3);
185185 shape3.Brush.Color:=clYellow;
186186 end
187187 else
188188 begin
189189 Berry_Clip.SetLedOff(3);
190190 shape3.Brush.Color:=clWhite;
191191 end;
192192end;
193193
194194procedure TForm1.Led4ToggleBoxChange(Sender: TObject);
195195begin
196196 if Led4ToggleBox.Checked then
197197 begin
198198 Berry_Clip.SetLedOn(4);
199199 shape4.Brush.Color:=clYellow;
200200 end
201201 else
202202 begin
203203 Berry_Clip.SetLedOff(4);
204204 shape4.Brush.Color:=clWhite;
205205 end;
206206end;
207207
208208procedure TForm1.Led5ToggleBoxChange(Sender: TObject);
209209begin
210210 if Led5ToggleBox.Checked then
211211 begin
212212 Berry_Clip.SetLedOn(5);
213213 shape5.Brush.Color:=clGreen;
214214 end
215215 else
216216 begin
217217 Berry_Clip.SetLedOff(5);
218218 shape5.Brush.Color:=clWhite;
219219 end;
220220end;
221221
222222procedure TForm1.Led6ToggleBoxChange(Sender: TObject);
223223begin
224224 if Led6ToggleBox.Checked then
225225 begin
226226 Berry_Clip.SetLedOn(6);
227227 shape6.Brush.Color:=clGreen;
228228 end
229229 else
230230 begin
231231 Berry_Clip.SetLedOff(6);
232232 shape6.Brush.Color:=clWhite;
233233 end;
234234end;
235235
236236end.
237237```
238238
239239#### unit1.lfm
240240
241-``` pascal
241+``` lfm
242242object Form1: TForm1
243243 Left = 269
244244 Height = 184
245245 Top = 175
246246 Width = 176
247247 Caption = 'BerryClip'
248248 ClientHeight = 184
249249 ClientWidth = 176
250250 OnCreate = FormCreate
251251 OnDestroy = FormDestroy
252252 object Led2ToggleBox: TToggleBox
253253 Left = 8
254254 Height = 24
255255 Top = 32
256256 Width = 128
257257 Caption = 'Led2ToggleBox'
258258 OnChange = Led2ToggleBoxChange
259259 TabOrder = 0
260260 end
261261 object Led1ToggleBox: TToggleBox
262262 Left = 8
263263 Height = 24
264264 Top = 8
265265 Width = 128
266266 Caption = 'Led1ToggleBox'
267267 OnChange = Led1ToggleBoxChange
268268 TabOrder = 1
269269 end
270270 object Led3ToggleBox: TToggleBox
271271 Left = 8
272272 Height = 24
273273 Top = 56
274274 Width = 128
275275 Caption = 'Led3ToggleBox'
276276 OnChange = Led3ToggleBoxChange
277277 TabOrder = 2
278278 end
279279 object Led4ToggleBox: TToggleBox
280280 Left = 8
281281 Height = 24
282282 Top = 80
283283 Width = 128
284284 Caption = 'Led4ToggleBox'
285285 OnChange = Led4ToggleBoxChange
286286 TabOrder = 3
287287 end
288288 object Led5ToggleBox: TToggleBox
289289 Left = 8
290290 Height = 24
291291 Top = 104
292292 Width = 128
293293 Caption = 'Led5ToggleBox'
294294 OnChange = Led5ToggleBoxChange
295295 TabOrder = 4
296296 end
297297 object Led6ToggleBox: TToggleBox
298298 Left = 8
299299 Height = 24
300300 Top = 128
301301 Width = 128
302302 Caption = 'Led6ToggleBox'
303303 OnChange = Led6ToggleBoxChange
304304 TabOrder = 5
305305 end
306306 object Shape1: TShape
307307 Left = 144
308308 Height = 18
309309 Top = 12
310310 Width = 16
311311 Shape = stCircle
312312 end
313313 object Shape2: TShape
314314 Left = 144
315315 Height = 18
316316 Top = 34
317317 Width = 16
318318 Shape = stCircle
319319 end
320320 object Shape3: TShape
321321 Left = 144
322322 Height = 18
323323 Top = 58
324324 Width = 16
325325 Shape = stCircle
326326 end
327327 object Shape4: TShape
328328 Left = 144
329329 Height = 18
330330 Top = 82
331331 Width = 16
332332 Shape = stCircle
333333 end
334334 object Shape5: TShape
335335 Left = 144
336336 Height = 18
337337 Top = 106
338338 Width = 16
339339 Shape = stCircle
340340 end
341341 object Shape6: TShape
342342 Left = 144
343343 Height = 18
344344 Top = 130
345345 Width = 16
346346 Shape = stCircle
347347 end
348348 object Shape7: TShape
349349 Left = 144
350350 Height = 18
351351 Top = 158
352352 Width = 16
353353 Shape = stCircle
354354 end
355355 object Button1: TButton
356356 Left = 8
357357 Height = 25
358358 Top = 151
359359 Width = 64
360360 Caption = 'Buzzer'
361361 OnMouseDown = Button1MouseDown
362362 OnMouseUp = Button1MouseUp
363363 TabOrder = 6
364364 end
365365 object ApplicationProperties1: TApplicationProperties
366366 OnIdle = ApplicationProperties1Idle
367367 left = 72
368368 top = 152
369369 end
370370end
371371</source>
372372
373373=== Pääohjelma ===
374374<source>
375375program berryclipdemo;
376376
377377{$mode objfpc}{$H+}
378378
379379uses
380380 {$IFDEF UNIX}{$IFDEF UseCThreads}
381381 cthreads,
382382 {$ENDIF}{$ENDIF}
383383 Interfaces, // this includes the LCL widgetset
384384 Forms, Unit1, pi_io_unit, uberryclip, uraspberrypi
385385 { you can add units after this };
386386
387387{$R *.res}
388388
389389begin
390390 RequireDerivedFormResource := True;
391391 Application.Initialize;
392392 Application.CreateForm(TForm1, Form1);
393393 Application.Run;
394394end.
395395```
396396
397397### Levy
398398
399399#### uberryclip.pas
400400
401401``` pascal
402402unit uberryclip;
403403
404404{$mode objfpc}{$H+}
405405
406406interface
407407
408408uses
409409 Classes, SysUtils,
410410 uRaspberrypi;
411411type
412412
413413 { TBerryClip }
414414
415415 TBerryClip = class
416416 private
417417 RaspBerryPi : TRaspBerryPi;
418418 public
419419 constructor Create;
420420 procedure SetLedOn( led_no :integer );
421421 procedure SetLedOff( led_no :integer );
422422 procedure SetBuzzerOn;
423423 procedure SetBuzzerOff;
424424 function ReadSwitch:boolean;
425425 destructor Destroy; override;
426426 end;
427427implementation
428428
429429{ TBerryClip }
430430
431431constructor TBerryClip.Create;
432432begin
433433 RaspBerryPi := TRaspBerryPi.Create;
434434 RaspBerryPi.SetGpioPinOutput(GPIO4); // Led 1
435435 RaspBerryPi.SetGpioPinOutput(GPIO9); // Led 2
436436 RaspBerryPi.SetGpioPinOutput(GPIO10);// Led 3
437437 RaspBerryPi.SetGpioPinOutput(GPIO11);// Led 4
438438 RaspBerryPi.SetGpioPinOutput(GPIO17);// Led 5
439439 RaspBerryPi.SetGpioPinOutput(GPIO22);// Led 6
440440 RaspBerryPi.SetGpioPinInput(GPIO7); // Switch
441441 RaspBerryPi.SetGpioPinOutput(GPIO8); // Buzzer
442442end;
443443
444444procedure TBerryClip.SetLedOn(led_no: integer);
445445begin
446446 case led_no of
447447 1 : RaspBerryPi.SetGpioBit(GPIO4);
448448 2 : RaspBerryPi.SetGpioBit(GPIO17);
449449 3 : RaspBerryPi.SetGpioBit(GPIO22);
450450 4 : RaspBerryPi.SetGpioBit(GPIO10);
451451 5 : RaspBerryPi.SetGpioBit(GPIO9);
452452 6 : RaspBerryPi.SetGpioBit(GPIO11);
453453 end;
454454end;
455455
456456procedure TBerryClip.SetLedOff(led_no: integer);
457457begin
458458 case led_no of
459459 1 : RaspBerryPi.ClearGpioBit(GPIO4);
460460 2 : RaspBerryPi.ClearGpioBit(GPIO17);
461461 3 : RaspBerryPi.ClearGpioBit(GPIO22);
462462 4 : RaspBerryPi.ClearGpioBit(GPIO10);
463463 5 : RaspBerryPi.ClearGpioBit(GPIO9);
464464 6 : RaspBerryPi.ClearGpioBit(GPIO11);
465465 end;
466466
467467end;
468468
469469procedure TBerryClip.SetBuzzerOn;
470470begin
471471 RaspBerryPi.SetGpioBit(GPIO8);
472472end;
473473
474474procedure TBerryClip.SetBuzzerOff;
475475begin
476476 RaspBerryPi.ClearGpioBit(GPIO8);
477477end;
478478
479479function TBerryClip.ReadSwitch: boolean;
480480begin
481481 result := RaspBerryPi.GetGpioBit(GPIO7);
482482end;
483483
484484destructor TBerryClip.Destroy;
485485begin
486486 RaspBerryPi.Free;
487487 inherited Destroy;
488488end;
489489
490490end.
491491```
492492
493493#### uraspberrypi.pas
494494
495495``` pascal
496496unit uraspberrypi;
497497
498498{$mode objfpc}{$H+}
499499
500500interface
501501
502502uses
503503 Classes, SysUtils, pi_io_unit, dialogs;
504504
505505const
506506
507507 GPIO4 = 4;
508508 GPIO7 = 7;
509509 GPIO8 = 8;
510510 GPIO9 = 9;
511511 GPIO10= 10;
512512 GPIO11= 11;
513513 GPIO17= 17;
514514 GPIO22= 22;
515515
516516type
517517
518518 { TRaspBerryPi }
519519
520520 TRaspBerryPi = class
521521 private
522522 io_port: T_IO_Port;
523523 public
524524 constructor Create;
525525 procedure ClearGpioBit(no:byte);
526526 function GetGpioBit(no:byte):boolean;
527527 procedure SetGpioBit(no:byte);
528528 procedure SetGpioPinInput( no:byte);
529529 procedure SetGpioPinOutput( no:byte);
530530 destructor Destroy; override;
531531 end;
532532
533533implementation
534534
535535{ TRaspBerryPi }
536536
537537constructor TRaspBerryPi.Create;
538538begin
539539 if not MapIo
540540 then ShowMessage('Error mapping gpio')
541541 else
542542 begin
543543 io_port := T_IO_Port.Create;
544544 io_port.f_gpio := CreatePort(GPIO_BASE);
545545 end ;
546546end;
547547
548548procedure TRaspBerryPi.ClearGpioBit(no: byte);
549549begin
550550 io_port.ClearBit(no);
551551end;
552552
553553function TRaspBerryPi.GetGpioBit(no: byte): boolean;
554554begin
555555 result := io_port.GetBit(no);
556556end;
557557
558558procedure TRaspBerryPi.SetGpioBit(no: byte);
559559begin
560560 io_port.SetBit(no);
561561end;
562562
563563procedure TRaspBerryPi.SetGpioPinInput(no: byte);
564564begin
565565 io_port.SetPinMode(no,INPUT);
566566end;
567567
568568procedure TRaspBerryPi.SetGpioPinOutput(no: byte);
569569begin
570570 io_port.SetPinMode(no,OUTPUT);
571571end;
572572
573573destructor TRaspBerryPi.Destroy;
574574begin
575575 io_port.ClearBit(GPIO4);
576576 io_port.ClearBit(GPIO9);
577577 io_port.ClearBit(GPIO10);
578578 io_port.ClearBit(GPIO11);
579579 io_port.ClearBit(GPIO17);
580580 io_port.ClearBit(GPIO22);
581581 io_port.ClearBit(GPIO8);
582582 UnMapIo(io_port);
583583 io_port.free;
584584 inherited Destroy;
585585end;
586586
587587end.
588588</synyaxhighlight>
589589
590590==== pi_io_unit.pas ====
591591
592592<syntaxhighlight lang=pascal>
593593unit pi_io_unit;
594594// This code is tested only RPI2B Processor
595595{$mode objfpc}{$H+}
596596
597597interface
598598
599599uses
600600 Classes, SysUtils, Unix, BaseUnix;
601601
602602const
603603 BCM2709_PBASE= $3F000000; // Peripheral Base in Bytes (RPI2B Processor)
604604 // BCM2708_PBASE= $20000000; // Peripheral Base (maybe RPI1 )
605605 REG_GPIO = BCM2709_PBASE div $1000; // $3F000 ;
606606 PAGE_SIZE = $1000;
607607
608608 GPIO_BASE = (REG_GPIO + $200);
609609
610610 INPUT = 0;
611611 OUTPUT = 1;
612612
613613 GPSET = $1C; // GPIO Pin Output Set
614614 GPCLR = $28; // GPIO Pin Output Clear
615615 GPLEV = $34; // GPIO Pin Level
616616
617617type
618618
619619 { T_IO_Port }
620620
621621 T_IO_Port = class
622622 private
623623 public
624624 f_gpio: PLongWord;
625625 procedure SetPinMode(a_io_pin, a_mode: byte);
626626 function GetBit(a_io_pin : byte):boolean;inline;
627627 procedure ClearBit(a_io_pin : byte);inline;
628628 procedure SetBit(a_io_pin : byte);inline;
629629 end;
630630
631631 function MapIo:boolean;// creates io mapping
632632 procedure UnMapIo(a_Map: T_IO_Port);// close io
633633 function CreatePort(PortGpio: LongWord): PLongWord;
634634
635635implementation
636636
637637var
638638 fd: integer;// /dev/mem file handle
639639
640640function MapIo: boolean;
641641begin
642642 result := true;
643643 fd := fpopen('/dev/mem', O_RdWr or O_Sync);
644644 if fd < 0 then result := false; // unsuccessful mapping
645645end;
646646
647647procedure UnMapIo( a_Map: T_IO_Port);
648648begin
649649 if a_Map.f_gpio <> nil then
650650 begin
651651 fpMUnmap(a_Map.f_gpio, PAGE_SIZE);
652652 a_Map.f_gpio := nil;
653653 end;
654654end;
655655
656656function CreatePort(PortGpio: LongWord): PLongWord;
657657begin
658658 result := FpMmap(nil, PAGE_SIZE, PROT_READ or PROT_WRITE, MAP_SHARED, fd, PortGpio);
659659end;
660660
661661procedure T_IO_Port.SetPinMode(a_io_pin, a_mode: byte);
662662var
663663 fSel, shift : byte;
664664 iof : PLongWord;
665665begin
666666 fSel := (a_io_pin div $A)*4 ;
667667 shift := (a_io_pin mod $A)*3 ;
668668 iof := Pointer(LongWord(Self.f_gpio)+fSel);
669669 case a_mode of
670670 INPUT : iof^ := iof^ and ($FFFFFFFF - (7 shl shift));
671671 OUTPUT : iof^ := iof^ and ($FFFFFFFF - (7 shl shift)) or (1 shl shift);
672672 end;
673673end;
674674
675675procedure T_IO_Port.SetBit(a_io_pin : byte);
676676var
677677 iof : PLongWord;
678678begin
679679 iof := Pointer(LongWord(Self.f_gpio) + GPSET + (a_io_pin shr 5) shl 2);
680680 iof^ := 1 shl a_io_pin;
681681end;
682682
683683procedure T_IO_Port.ClearBit(a_io_pin : byte);
684684var
685685 iof : PLongWord;
686686begin
687687 iof := Pointer(LongWord(Self.f_gpio) + GPCLR + (a_io_pin shr 5) shl 2);
688688 iof^ := 1 shl a_io_pin;
689689end;
690690
691691function T_IO_Port.GetBit(a_io_pin : byte):boolean;
692692var
693693 iof : PLongWord;
694694begin
695695 result := true;
696696 iof := Pointer(LongWord(Self.f_gpio) + GPLEV + (a_io_pin shr 5) shl 2);
697697 if (iof^ and (1 shl a_io_pin)) = 0 then result := false;
698698end;
699699end.
700700```
701701
702702---
703703*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