can now handle bmp with bottom-up pixel matric and 32bpp color map

st7565-lcd/raspilcd.adb

@@ -9,7 +9,7 @@ use bcm2835_h;
 
 
 
-package body RaspiLcd is
+package body st7565lcd is
 
 
     procedure io_init is
@@ -64,7 +64,7 @@ package body RaspiLcd is
     end lcd_ascii57;
 
 
-    procedure lcd_picture (xpos : natural; ypos: natural) is
+    procedure lcd_picture (xpos : natural; ypos: natural; picture : t_lcd_array) is
     begin
         for outdex in 0..7 loop 
             lcd_set_page(page => ypos + outdex, column => xpos);
@@ -134,4 +134,42 @@ package body RaspiLcd is
     end lcd_byte;
 
 
-end RaspiLcd;
+    function bmp_to_lcd (bmp : t_bmp_array; color_mask : t_color_mask) return t_lcd_array is
+        lcd   : t_lcd_array := (others => 16#00#);
+        logic : byte;
+    begin
+        for aussen in 0 .. 7 loop
+           logic := 16#01#;
+           for outdex in 0 .. 7 loop
+              for index in 0 .. 127 loop
+                 if ((bmp(aussen * 1024 + outdex * 128 + index)(which_byte(color_mask.red)) or
+                      bmp(aussen * 1024 + outdex * 128 + index)(which_byte(color_mask.green)) or
+                      bmp(aussen * 1024 + outdex * 128 + index)(which_byte(color_mask.blue))) < 16#77#) then
+                    lcd(aussen * 128 + index) := lcd(aussen * 128 + index) or logic;
+                 end if;
+              end loop;
+              logic := Shift_Left(logic, 1);
+           end loop;
+        end loop;
+        return lcd;
+    end bmp_to_lcd;
+
+
+    function which_byte (data : dword) return integer is
+    begin
+        case data is
+            when 16#000000FF# =>
+                return 0;
+            when 16#0000FF00# =>
+                return 1;
+            when 16#00FF0000# =>
+                return 2;
+            when 16#FF000000# =>
+                return 3;
+            when others =>
+                return -1;
+        end case;
+    end which_byte;
+
+
+end st7565lcd;

st7565-lcd/raspilcd.ads

@@ -2,19 +2,53 @@ with Interfaces;
 with Interfaces.C;
 
 
-package RaspiLcd is
+package st7565lcd is
 
 
     -- type definitions
-    subtype byte is Interfaces.Unsigned_8;
+    subtype byte  is Interfaces.Unsigned_8;
+    subtype word  is Interfaces.Unsigned_16;
+    subtype dword is Interfaces.Unsigned_32;
 
-    type byte_array is array (natural range <>) of byte;
+    type t_byte_array is array (natural range <>) of byte;
+    
+    type t_font_array is array (natural range <>) of t_byte_array (0 .. 4);
 
-    type byte_byte_array is array (natural range <>) of byte_array (0 .. 4);
+    type t_bmp_array is array (natural range <>) of t_byte_array (0 .. 3);
+
+    subtype t_lcd_array is t_byte_array (0 .. 128 * 8 - 1);
+
+
+    -- bmp header structure
+    type t_bmp_header is record
+        bfType          : word;
+        bfSize          : dword;
+        bfReserved      : dword;
+        bfOffBits       : dword;
+        biSize          : dword;
+        biWidth         : integer;
+        biHeight        : integer;
+        biPlanes        : word;
+        biBitCount      : word;
+        biCompression   : dword;
+        biSizeImage     : dword;
+        biXPelsPerMeter : integer;
+        biYPelsPerMeter : integer;
+        biClrUsed       : dword;
+        biClrImportant  : dword;
+    end record;
+
+    -- color mask
+    type t_color_mask is record
+        red   : dword := 16#00FF0000#;
+        green : dword := 16#0000FF00#;
+        blue  : dword := 16#000000FF#;
+        alpha : dword := 16#FF000000#;
+    end record;
 
 
     -- character set
-    font_5x7 : constant byte_byte_array (32 .. 126) := (
+    font_5x7 : constant t_font_array (32 .. 126) := (
         ( 16#00#, 16#00#, 16#00#, 16#00#, 16#00# ),  --   - 16#20 - 32
         ( 16#00#, 16#00#, 16#5f#, 16#00#, 16#00# ),  -- ! - 16#21 - 33
         ( 16#00#, 16#07#, 16#00#, 16#07#, 16#00# ),  -- " - 16#22 - 34
@@ -114,7 +148,7 @@ package RaspiLcd is
 
 
     -- raspberry picture
-    picture : constant byte_array := (
+    raspberry : constant t_lcd_array := (
         16#00#,16#00#,16#00#,16#00#,16#00#,16#00#,16#00#,16#00#,16#00#,16#00#,16#00#,16#00#,16#00#,16#00#,16#00#,16#00#, -- 1. row
         16#00#,16#00#,16#00#,16#00#,16#00#,16#00#,16#00#,16#00#,16#00#,16#00#,16#00#,16#00#,16#00#,16#00#,16#00#,16#00#, -- 1. row
         16#00#,16#00#,16#00#,16#00#,16#F0#,16#F8#,16#58#,16#1C#,16#1C#,16#0C#,16#0C#,16#06#,16#86#,16#86#,16#86#,16#0E#, -- 1. row
@@ -183,7 +217,7 @@ package RaspiLcd is
 
 
     -- lcd init values
-    lcd_init_data : constant byte_array := (
+    lcd_init_data : constant t_byte_array := (
         16#a0#,  -- cmd8:  adc select
         16#c0#,  -- cmd15: shl select
         16#a3#,  -- cmd11: lcd bias set
@@ -214,11 +248,14 @@ package RaspiLcd is
     procedure lcd_init;
     procedure lcd_ascii57_string (xpos : natural; ypos : natural; data : string);
     procedure lcd_ascii57 (xpos : natural; ypos : natural; data : character);
-    procedure lcd_picture (xpos : natural; ypos: natural);
+    procedure lcd_picture (xpos : natural; ypos: natural; picture : t_lcd_array);
     procedure lcd_clear;
     procedure lcd_set_page (page : natural; column : natural);
     procedure lcd_transfer_data (value : byte; si : boolean);
     procedure lcd_byte (data : byte);
 
+    function bmp_to_lcd (bmp : t_bmp_array; color_mask : t_color_mask) return t_lcd_array;
+    function which_byte (data : dword) return integer;
+
 
-end RaspiLcd;
+end st7565lcd;

st7565-lcd/raspitest.adb

@@ -1,19 +1,110 @@
 with Ada.Text_IO;
 with bcm2835_h;
-with RaspiLcd;
+with st7565lcd;
 
+with Interfaces; use Interfaces;
+with Ada.Text_IO, Ada.Integer_Text_IO, Ada.Streams.Stream_IO;
+use Ada.Text_IO, Ada.Integer_Text_IO, Ada.Streams.Stream_IO;
+with Ada.Command_Line; use Ada.Command_Line;
 
 
-procedure raspitest is
+procedure raspilcd is
 
 
-    package IO    renames Ada.Text_IO;
-    package LCD renames RaspiLcd;
+    -- shorter names for packages
+    package IO  renames Ada.Text_IO;
+    package LCD renames st7565lcd;
+    package IOS renames Ada.Streams.Stream_IO;
+
+    -- stream.io definitions
+    My_File        : IOS.FILE_TYPE;
+    My_File_Access : IOS.STREAM_ACCESS;
+
+    -- picture data
+    picture_header  : LCD.t_bmp_header;
+    color_mask      : LCD.t_color_mask;
+    picture_data    : LCD.t_bmp_array (0 .. 128 * 64 - 1);
+
+    -- lcd pixel array
+    lcd_data : LCD.t_lcd_array;
+
+    -- exception handling
+    tool_info : string := "raspi-lcd version 0.1, (c) 2014 by tmeissner";
+    usage     : string := "usage: ./raspitest BMP-FILE (as root)";
+    bmp_error : string := "error: malformed BMP-FILE (valid: 128x64, no compression, 32bpp)";
+    cli_exception : exception;
+    bmp_exception : exception;
 
 
 begin
 
 
+    -- no picture given
+    if Argument_Count /= 1 then
+        raise cli_exception;
+    end if;
+
+    -- open picture file
+    declare
+        filename : string := Argument (1);
+    begin
+        IOS.Open(My_File, In_File, filename);
+        My_File_Access := IOS.Stream(My_File);
+    end;
+
+
+    -- read bmp header
+    LCD.t_bmp_header'Read(My_File_Access, picture_header);
+
+    --Put_Line("Width:       " & Integer'Image(picture_header.biWidth));
+    --Put_Line("Height:      " & Integer'Image(picture_header.biHeight));
+    --Put_Line("Color Depth: " & Integer'Image(Integer(picture_header.biBitCount)));
+    --Put_Line("Compression: " & Integer'Image(Integer(picture_header.biCompression)));
+
+    -- check for valid bmp format    
+    if (abs picture_header.biHeight /= 64 or picture_header.biWidth /= 128 or 
+        (picture_header.biCompression /= 0 and picture_header.biCompression /= 3) or
+        picture_header.biBitCount /= 32) then
+        raise bmp_exception;
+    end if;
+
+    -- get color map if existing
+    if picture_header.biCompression = 3 then
+        LCD.t_color_mask'Read(My_File_Access, color_mask);
+    end if;
+   
+    -- read in image data
+    if picture_header.biHeight < 0 then
+
+        -- top-down pixel matrix
+        for index in picture_data'range loop
+            if not IOS.End_Of_File(My_File) then
+                LCD.t_byte_array'Read(My_File_Access, picture_data(index));
+            end if;
+        end loop;
+
+    else
+
+        -- bottom-top pixel matrix
+        for row in reverse 0 .. 63 loop
+            for column in 0 .. 127 loop
+                if not IOS.End_Of_File(My_File) then
+                    LCD.t_byte_array'Read(My_File_Access, picture_data(row * 128 + column));
+                end if;
+            end loop;
+        end loop;
+
+    end if;
+    
+    -- close picture file
+    Ada.Streams.Stream_IO.Close(My_File);
+    
+    -- convert bmp to lcd matrix
+    lcd_data := LCD.bmp_to_lcd(bmp => picture_data, color_mask => color_mask);
+
+
+    -- load bcm2835 lib
+    -- print picture and some text on lcd
     if integer(bcm2835_h.bcm2835_init) = 0 then
 
         IO.Put_Line("Error while initializing BCM2835 library");
@@ -24,7 +115,7 @@ begin
  
         LCD.lcd_init;
  
-        LCD.lcd_picture(xpos => 0, ypos => 0);
+        LCD.lcd_picture(xpos => 0, ypos => 0, picture => lcd_data);
 
         bcm2835_h.bcm2835_delay(5000);
  
@@ -41,4 +132,14 @@ begin
     end if;
 
 
-end raspitest;
+    -- exception handling
+    exception
+    when e: cli_exception =>
+        put_line(tool_info);
+        put_line(usage);
+    when e: bmp_exception =>
+        put_line(tool_info);
+        put_line(bmp_error);
+
+
+end raspilcd;