mirror of
https://github.com/co-dan/ocaml-wiringpi/
synced 2025-12-15 21:43:51 +01:00
Compare commits
4 Commits
| Author | SHA1 | Date | |
|---|---|---|---|
| 720039b78a | |||
| c2ced8a13c | |||
| feb2e218dc | |||
| 2fcb2160f3 |
17
_oasis
17
_oasis
@@ -17,4 +17,19 @@ Executable "wpi-button-example"
|
||||
Path: examples/
|
||||
BuildTools: ocamlbuild
|
||||
MainIs: button.ml
|
||||
BuildDepends: WiringPi,unix
|
||||
BuildDepends: WiringPi,unix
|
||||
|
||||
Executable "adafruit-lcd-example"
|
||||
Path: examples/
|
||||
BuildTools: ocamlbuild
|
||||
MainIs: lcd_example.ml
|
||||
BuildDepends: WiringPi,unix
|
||||
|
||||
Executable "adafruit-lcd-server"
|
||||
CompiledObject: native
|
||||
Path: examples/
|
||||
BuildTools: ocamlbuild
|
||||
MainIs: lcd_lwt.ml
|
||||
BuildDepends: WiringPi,unix,lwt,lwt.unix,threads
|
||||
CCLib: -lwiringPi
|
||||
|
||||
|
||||
125
examples/lcd.ml
Normal file
125
examples/lcd.ml
Normal file
@@ -0,0 +1,125 @@
|
||||
(** An example with Adafruit character LCD, HD44780. *)
|
||||
(* The documentation: https://cdn-shop.adafruit.com/datasheets/HD44780.pdf *)
|
||||
open Gpio3
|
||||
|
||||
(** Parameters *)
|
||||
type mono_lcd = {
|
||||
columns: int;
|
||||
rows: int;
|
||||
rs: pin;
|
||||
en: pin;
|
||||
d4: pin;
|
||||
d5: pin;
|
||||
d6: pin;
|
||||
d7: pin
|
||||
}
|
||||
|
||||
(** MAGIC NUMBERS *)
|
||||
(* Commands *)
|
||||
let _lcd_cleardisplay = (0x01)
|
||||
let _lcd_returnhome = (0x02)
|
||||
let _lcd_entrymodeset = (0x04)
|
||||
let _lcd_displaycontrol = (0x08)
|
||||
let _lcd_cursorshift = (0x10)
|
||||
let _lcd_functionset = (0x20)
|
||||
let _lcd_setcgramaddr = (0x40)
|
||||
let _lcd_setddramaddr = (0x80)
|
||||
|
||||
(* Entry flags *)
|
||||
let _lcd_entryleft = (0x02)
|
||||
let _lcd_entryshiftdecrement = (0x00)
|
||||
|
||||
(* Control flags *)
|
||||
let _lcd_displayon = (0x04)
|
||||
let _lcd_cursoron = (0x02)
|
||||
let _lcd_cursoroff = (0x00)
|
||||
let _lcd_blinkon = (0x01)
|
||||
let _lcd_blinkoff = (0x00)
|
||||
|
||||
(* Move flags *)
|
||||
let _lcd_displaymove = (0x08)
|
||||
let _lcd_moveright = (0x04)
|
||||
let _lcd_moveleft = (0x00)
|
||||
|
||||
(* Function set flags *)
|
||||
let _lcd_4bitmode = (0x00)
|
||||
let _lcd_2line = (0x08)
|
||||
let _lcd_1line = (0x00)
|
||||
let _lcd_5x8dots = (0x00)
|
||||
|
||||
(* Offset for up to 4 rows. *)
|
||||
let _lcd_row_offsets = [|0x00; 0x40; 0x14; 0x54|]
|
||||
|
||||
let pulse_enable lcd =
|
||||
digital_write lcd.en LOW;
|
||||
(* 1 microsec pause *)
|
||||
Unix.sleepf(0.0000001);
|
||||
digital_write lcd.en HIGH;
|
||||
Unix.sleepf(0.0000001);
|
||||
digital_write lcd.en LOW;
|
||||
Unix.sleepf(0.00001)
|
||||
|
||||
(** write 8 bits of data *)
|
||||
let write8 lcd ?(char_mode=false) value =
|
||||
(* one ms delay to prevent writing too quickly *)
|
||||
Unix.sleepf(0.001);
|
||||
let char_mode_value = if char_mode then HIGH else LOW in
|
||||
digital_write lcd.rs char_mode_value;
|
||||
let val_of_int i = if i > 0 then HIGH else LOW in
|
||||
let ival = Char.code value in
|
||||
(* write the UPPER 4 bits (in reverse order) *)
|
||||
digital_write lcd.d4 (val_of_int ((ival lsr 4) land 1));
|
||||
digital_write lcd.d5 (val_of_int ((ival lsr 5) land 1));
|
||||
digital_write lcd.d6 (val_of_int ((ival lsr 6) land 1));
|
||||
digital_write lcd.d7 (val_of_int ((ival lsr 7) land 1));
|
||||
pulse_enable lcd;
|
||||
(* write the LOWER 4 bits *)
|
||||
digital_write lcd.d4 (val_of_int (ival land 1));
|
||||
digital_write lcd.d5 (val_of_int ((ival lsr 1) land 1));
|
||||
digital_write lcd.d6 (val_of_int ((ival lsr 2) land 1));
|
||||
digital_write lcd.d7 (val_of_int ((ival lsr 3) land 1));
|
||||
pulse_enable lcd
|
||||
|
||||
(** same as [write8] but write an int (must be within the range) *)
|
||||
let write8_unsafe lcd ?(char_mode=false) ival =
|
||||
write8 lcd ~char_mode (Char.unsafe_chr ival)
|
||||
|
||||
let setup lcd =
|
||||
Gpio3.setup ();
|
||||
pin_mode lcd.rs OUT;
|
||||
pin_mode lcd.en OUT;
|
||||
pin_mode lcd.d4 OUT;
|
||||
pin_mode lcd.d5 OUT;
|
||||
pin_mode lcd.d6 OUT;
|
||||
pin_mode lcd.d7 OUT;
|
||||
(* send the 4-bit initialization sequence: 0011, 0011, 0011, 0010.
|
||||
see Figure 24 in the docs. *)
|
||||
write8_unsafe lcd 0x33;
|
||||
write8_unsafe lcd 0x32;
|
||||
(* set up some stuff *)
|
||||
let displayctrl = _lcd_displayon lor _lcd_cursoroff lor _lcd_blinkoff in
|
||||
let displayfn = _lcd_4bitmode lor _lcd_2line lor _lcd_5x8dots in
|
||||
let displaymode = _lcd_entryleft lor _lcd_entryshiftdecrement in
|
||||
write8_unsafe lcd (displayctrl lor _lcd_displaycontrol);
|
||||
write8_unsafe lcd (displayfn lor _lcd_functionset);
|
||||
write8_unsafe lcd (displaymode lor _lcd_entrymodeset);
|
||||
Unix.sleepf(0.003)
|
||||
|
||||
let clear lcd =
|
||||
write8_unsafe lcd _lcd_cleardisplay;
|
||||
Unix.sleepf(0.003)
|
||||
|
||||
let shift_left lcd =
|
||||
write8_unsafe lcd (_lcd_cursorshift lor _lcd_displaymove lor _lcd_moveleft)
|
||||
|
||||
let shift_right lcd =
|
||||
write8_unsafe lcd (_lcd_cursorshift lor _lcd_displaymove lor _lcd_moveright)
|
||||
|
||||
let set_position lcd x y =
|
||||
let c = x mod lcd.columns in
|
||||
let r = y mod lcd.rows in
|
||||
if (c < 0 || r < 0) then failwith "Lcd.set_position: Negative row or column";
|
||||
write8_unsafe lcd (_lcd_setddramaddr lor (c + _lcd_row_offsets.(r)))
|
||||
|
||||
let write_bytes lcd bts =
|
||||
Bytes.iter (fun c -> write8 lcd c ~char_mode:true) bts
|
||||
20
examples/lcd_example.ml
Normal file
20
examples/lcd_example.ml
Normal file
@@ -0,0 +1,20 @@
|
||||
(** An example with Adafruit character LCD, HD44780. *)
|
||||
open Gpio3
|
||||
open Lcd
|
||||
|
||||
let lcd = {
|
||||
columns = 16;
|
||||
rows = 2;
|
||||
rs = GPIO20;
|
||||
en = GPIO16;
|
||||
d4 = GPIO19;
|
||||
d5 = GPIO5;
|
||||
d6 = GPIO11;
|
||||
d7 = GPIO10;
|
||||
}
|
||||
|
||||
let _ =
|
||||
setup lcd;
|
||||
clear lcd;
|
||||
set_position lcd 0 0;
|
||||
write_bytes lcd (Bytes.of_string "Hello, world.")
|
||||
152
examples/lcd_lwt.ml
Normal file
152
examples/lcd_lwt.ml
Normal file
@@ -0,0 +1,152 @@
|
||||
(** An example with Adafruit character LCD, HD44780. *)
|
||||
open Gpio3
|
||||
open Lcd
|
||||
open Lwt
|
||||
|
||||
let lcd = {
|
||||
columns = 16;
|
||||
rows = 2;
|
||||
rs = GPIO20;
|
||||
en = GPIO16;
|
||||
d4 = GPIO19;
|
||||
d5 = GPIO5;
|
||||
d6 = GPIO11;
|
||||
d7 = GPIO10;
|
||||
}
|
||||
|
||||
(** A nicer abstraction *)
|
||||
module Cursor = struct
|
||||
type t = { x: int; y: int; visible: bool; blink: bool; _lcd: mono_lcd }
|
||||
|
||||
(** Creates a new cursor at the position (0,0) *)
|
||||
let of_lcd lcd =
|
||||
set_position lcd 0 0;
|
||||
{ x = 0; y = 0; visible = false; blink = false; _lcd = lcd }
|
||||
|
||||
(** Explicitly set the position of the cursor. The arguments will be
|
||||
taken modulo the size of the LCD. *)
|
||||
let set_position x y cur =
|
||||
let col = x mod cur._lcd.columns in
|
||||
let row = y mod cur._lcd.rows in
|
||||
set_position cur._lcd col row;
|
||||
{ cur with x = col; y = row }
|
||||
|
||||
(** Whether to display the cursor *)
|
||||
let set_visible flag cur =
|
||||
let _blinkon = if cur.blink then _lcd_blinkon else _lcd_blinkoff in
|
||||
let _cursoron = if flag then _lcd_cursoron else _lcd_cursoroff in
|
||||
let displayctrl = _lcd_displayon lor _cursoron lor _blinkon in
|
||||
write8_unsafe lcd (displayctrl lor _lcd_displaycontrol);
|
||||
{ cur with visible = flag }
|
||||
|
||||
(** Whether the cursor is blinking *)
|
||||
let set_blink flag cur =
|
||||
let _blinkon = if flag then _lcd_blinkon else _lcd_blinkoff in
|
||||
let _cursoron = if cur.visible then _lcd_cursoron else _lcd_cursoroff in
|
||||
let displayctrl = _lcd_displayon lor _cursoron lor _blinkon in
|
||||
write8_unsafe lcd (displayctrl lor _lcd_displaycontrol);
|
||||
{ cur with blink = flag }
|
||||
|
||||
(** Try writing a character, optionally with wrapping. *)
|
||||
let write_char wrapping v cur =
|
||||
write8 cur._lcd ~char_mode:true v;
|
||||
let col = cur.x + 1 in
|
||||
if not wrapping || col < cur._lcd.columns
|
||||
then { cur with x = col }
|
||||
else let row = cur.y + 1 in
|
||||
let col = 0 in
|
||||
(* set_position should do the wrapping for us *)
|
||||
set_position col row cur
|
||||
|
||||
let write_bytes wrapping bts cur =
|
||||
let f cur chr =
|
||||
if chr = '\n'
|
||||
then set_position 0 (cur.y + 1) cur
|
||||
else if chr = '\r'
|
||||
then set_position 0 cur.y cur
|
||||
else write_char wrapping chr cur in
|
||||
Seq.fold_left f cur (Bytes.to_seq bts)
|
||||
|
||||
let write_string ?(wrap=false) str cur = write_bytes wrap (Bytes.of_string str) cur
|
||||
|
||||
end
|
||||
|
||||
(** A useful combinator for the functions from the [Cursor] module *)
|
||||
let (|>) (m : Cursor.t) (f : Cursor.t -> 'b) = f m
|
||||
|
||||
(** Display two lines without wrapping *)
|
||||
let display_lines l1 l2 =
|
||||
let col_shift = 3 in
|
||||
let maxwidth = int_of_float (float_of_int lcd.columns *. 2.5) - col_shift in
|
||||
let trunc str =
|
||||
let n = min maxwidth (String.length str) in
|
||||
String.sub str 0 n
|
||||
in
|
||||
let open Cursor in
|
||||
clear lcd;
|
||||
of_lcd lcd
|
||||
|> set_visible false
|
||||
|> set_blink false
|
||||
|> set_position col_shift 0
|
||||
|> write_string (trunc l1) ~wrap:false
|
||||
|> set_position col_shift 1
|
||||
|> write_string (trunc l2) ~wrap:false
|
||||
|
||||
(** Scrolling thread *)
|
||||
|
||||
let rec scroll lcd sleep_for : unit Lwt.t =
|
||||
shift_left lcd;
|
||||
Lwt_unix.sleep sleep_for >>= fun () ->
|
||||
scroll lcd sleep_for
|
||||
|
||||
|
||||
(** Networking stuff *)
|
||||
|
||||
let create_socket () =
|
||||
let open Lwt_unix in
|
||||
let sock = socket PF_INET SOCK_STREAM 0 in
|
||||
(* let bind_addr = Unix.inet_addr_loopback in *)
|
||||
gethostbyname "balthasar.local" >>= fun bind_addr ->
|
||||
let bind_addr = bind_addr.h_addr_list.(0) in
|
||||
bind sock @@ ADDR_INET(bind_addr, 8080) >>= fun () ->
|
||||
listen sock 10;
|
||||
return sock
|
||||
|
||||
let rec handle_message ic oc () =
|
||||
Lwt_io.read_line_opt ic >>= fun line1 ->
|
||||
Lwt_io.read_line_opt ic >>= fun line2 ->
|
||||
match line1,line2 with
|
||||
| Some l1, Some l2 ->
|
||||
Lwt_io.printl "Recieved the following message:" >>= fun () ->
|
||||
Lwt_io.printl l1 >>= fun () ->
|
||||
Lwt_io.printl l2 >>= fun () ->
|
||||
Lwt.async (fun () -> Lwt_io.close oc);
|
||||
ignore (display_lines l1 l2);
|
||||
return ()
|
||||
| _,_ -> return ()
|
||||
|
||||
let handle_connection conn =
|
||||
let fd, _ = conn in
|
||||
let ic = Lwt_io.of_fd Lwt_io.Input fd in
|
||||
let oc = Lwt_io.of_fd Lwt_io.Output fd in
|
||||
Lwt.on_failure (handle_message ic oc ())
|
||||
(fun e -> Printf.printf "Error in `handle_message': %s\n" (Printexc.to_string e));
|
||||
return ()
|
||||
|
||||
let create_server sock =
|
||||
let rec serve () =
|
||||
Lwt_unix.accept sock >>= handle_connection >>= serve
|
||||
in serve
|
||||
|
||||
let main () =
|
||||
Lwt.async (fun () -> scroll lcd 0.7);
|
||||
create_socket () >>= fun sock ->
|
||||
create_server sock ()
|
||||
|
||||
|
||||
let _ =
|
||||
setup lcd;
|
||||
clear lcd;
|
||||
ignore (display_lines "Hello, " "world!");
|
||||
Lwt_main.run @@ main ()
|
||||
|
||||
Reference in New Issue
Block a user