Data update

Task/Bitwise-IO/Ada/bitwise-io-1.adb

@@ -0,0 +1,20 @@
+with Ada.Streams;  use Ada.Streams;
+with Ada.Finalization;
+
+package Bit_Streams is
+   type Bit is range 0..1;
+   type Bit_Array is array (Positive range <>) of Bit;
+   type Bit_Stream (Channel : not null access Root_Stream_Type'Class) is limited private;
+   procedure Read (Stream : in out Bit_Stream; Data : out Bit_Array);
+   procedure Write (Stream : in out Bit_Stream; Data : Bit_Array);
+private
+   type Bit_Stream (Channel : not null access Root_Stream_Type'Class) is
+      new Ada.Finalization.Limited_Controlled with
+   record
+      Read_Count  : Natural := 0;
+      Write_Count : Natural := 0;
+      Input       : Stream_Element_Array (1..1);
+      Output      : Stream_Element_Array (1..1);
+   end record;
+   overriding procedure Finalize (Stream : in out Bit_Stream);
+end Bit_Streams;

Task/Bitwise-IO/Ada/bitwise-io-2.adb

@@ -0,0 +1,33 @@
+package body Bit_Streams is
+   procedure Finalize (Stream : in out Bit_Stream) is
+   begin
+      if Stream.Write_Count > 0 then
+         Stream.Output (1) := Stream.Output (1) * 2**(Stream_Element'Size - Stream.Write_Count);
+         Stream.Channel.Write (Stream.Output);
+      end if;
+   end Finalize;
+   procedure Read (Stream : in out Bit_Stream; Data : out Bit_Array) is
+      Last : Stream_Element_Offset;
+   begin
+      for Index in Data'Range loop
+         if Stream.Read_Count = 0 then
+            Stream.Channel.Read (Stream.Input, Last);
+            Stream.Read_Count := Stream_Element'Size;
+         end if;
+         Data (Index) := Bit (Stream.Input (1) / 2**(Stream_Element'Size - 1));
+         Stream.Input (1)  := Stream.Input (1) * 2;
+         Stream.Read_Count := Stream.Read_Count - 1;
+      end loop;
+   end Read;
+   procedure Write (Stream : in out Bit_Stream; Data : Bit_Array) is
+   begin
+      for Index in Data'Range loop
+         if Stream.Write_Count = Stream_Element'Size then
+            Stream.Channel.Write (Stream.Output);
+            Stream.Write_Count := 0;
+         end if;
+         Stream.Output (1)  := Stream.Output (1) * 2 or Stream_Element (Data (Index));
+         Stream.Write_Count := Stream.Write_Count + 1;
+      end loop;
+   end Write;
+end Bit_Streams;

Task/Bitwise-IO/Ada/bitwise-io-3.adb

@@ -0,0 +1,33 @@
+with Ada.Streams.Stream_IO;  use Ada.Streams.Stream_IO;
+with Bit_Streams;            use Bit_Streams;
+
+procedure Test_Bit_Streams is
+   File   : File_Type;
+   ABACUS : Bit_Array :=
+               (  1,0,0,0,0,0,1,  -- A, big endian
+                  1,0,0,0,0,1,0,  -- B
+                  1,0,0,0,0,0,1,  -- A
+                  1,0,0,0,0,1,1,  -- C
+                  1,0,1,0,1,0,1,  -- U
+                  1,0,1,0,0,1,1   -- S
+               );
+   Data : Bit_Array (ABACUS'Range);
+begin
+   Create (File, Out_File, "abacus.dat");
+   declare
+      Bits : Bit_Stream (Stream (File));
+   begin
+      Write (Bits, ABACUS);
+   end;
+   Close (File);
+   Open (File, In_File, "abacus.dat");
+   declare
+      Bits : Bit_Stream (Stream (File));
+   begin
+      Read (Bits, Data);
+   end;
+   Close (File);
+   if Data /= ABACUS then
+      raise Data_Error;
+   end if;
+end Test_Bit_Streams;

Task/Bitwise-IO/Rebol/bitwise-io.rebol

@@ -0,0 +1,59 @@
+Rebol [
+    title: "Rosetta code: Bitwise IO"
+    file:  %Bitwise_IO.r3
+    url:   https://rosettacode.org/wiki/Bitwise_IO
+    note:  "Based on Vasyl Zubko's Red language implementation!"
+]
+
+compress-7bit: function [
+    "Pack 8-bit bytes into 7-bit chunks (lossless for 7-bit ASCII)"
+    str [string! binary!]
+][
+    buf:  clear ""                       ;; string buffer for 7-bit bitstream
+    bits: enbase/flat str 2              ;; convert input to a flat binary string "0101..."
+    while [not tail? bits][              ;; take 7 bits out of every 8
+        append buf copy/part next bits 7 ;; append bits 2..8 (skip the first bit of each byte)
+        bits: skip bits 8                ;; move to next 8-bit group
+    ]
+    ;; Pad to multiple of 8 bits so it can be debased to bytes
+    unless zero? (pad-bits: (length? buf) // 8) [
+        append/dup buf #"0" 8 - pad-bits
+    ]
+    debase buf 2                        ;; turn the 7-bit stream (padded) back into binary bytes
+]
+
+decompress-7bit: function [
+    "Unpack 7-bit chunks back to 8-bit by re-inserting the leading zero bit per group of 7"
+    bin [binary!]
+][
+    bits: enbase/flat bin 2             ;; bitstring of the compressed bytes
+    filled: 0                           ;; counter within a 7-bit group
+    buf: clear #{}                      ;; output binary buffer
+    acc: clear ""                       ;; accumulator for 7 bits
+
+    foreach bit bits [
+        append acc bit                  ;; collect one bit
+        filled: filled + 1
+        if filled = 7 [
+            ;; Prepend a '0' to restore 8th bit, debase to a byte, append to output
+            append buf debase join #"0" acc 2
+            clear acc
+            filled: 0
+        ]
+    ]
+    ;; If padding produced a final 0 byte, drop it
+    if 0 == last buf [take/last buf]
+    to string! buf                      ;; return original as string
+]
+
+;- DEMO:
+in-string: "Rebol is not dead!"
+compressed: compress-7bit in-string    ;; compress to 7-bit packed binary
+expanded:   decompress-7bit compressed ;; decompress back to original
+
+print [
+    "^/in-string :"  in-string
+    "^/in-binary :"  to binary! in-string
+    "^/compressed:"  compressed
+    "^/expanded  :"  expanded
+]