langs a-z

Task/Bitwise-IO/OCaml/bitwise-io-1.ocaml

@@ -0,0 +1,7 @@
+let write_7bit_string ~filename ~str =
+  let oc = open_out filename in
+  let ob = IO.output_bits(IO.output_channel oc) in
+  String.iter (fun c -> IO.write_bits ob 7 (int_of_char c)) str;
+  IO.flush_bits ob;
+  close_out oc;
+;;

Task/Bitwise-IO/OCaml/bitwise-io-2.ocaml

@@ -0,0 +1,10 @@
+let read_7bit_string ~filename =
+  let ic = open_in filename in
+  let ib = IO.input_bits(IO.input_channel ic) in
+  let buf = Buffer.create 2048 in
+  try while true do
+    let c = IO.read_bits ib 7 in
+    Buffer.add_char buf (char_of_int c);
+  done; ""
+  with IO.No_more_input ->
+    (Buffer.contents buf)

Task/Bitwise-IO/PL-I/bitwise-io.pli

@@ -0,0 +1,11 @@
+declare onebit bit(1) aligned, bs bit (1000) varying aligned;
+on endfile (sysin) go to ending;
+bs = ''b;
+do forever;
+   get edit (onebit) (F(1));
+   bs = bs || onebit;
+end;
+ending:
+bs = bs || copy('0'b, mod(length(bs), 8) );
+                                 /* pad length to a multiple of 8 */
+put edit (bs) (b);

Task/Bitwise-IO/Perl-6/bitwise-io.pl6

@@ -0,0 +1,14 @@
+sub encode-ascii(Str $s) {
+    my @b = $s.ords».fmt("%07b")».comb;
+    @b.push(0) until @b %% 8;   # padding
+    Buf.new: gather while @b { take reduce * *2+*, (@b.pop for ^8) }
+}
+
+sub decode-ascii(Buf $b) {
+    my @b = $b.list».fmt("%08b")».comb;
+    @b.shift until @b %% 7;   # remove padding
+    @b = gather while @b { take reduce * *2+*, (@b.pop for ^7) }
+    return [~] @b».chr;
+}
+say my $encode = encode-ascii 'STRING';
+say decode-ascii $encode;

Task/Bitwise-IO/PureBasic/bitwise-io.purebasic

@@ -0,0 +1,120 @@
+Structure fileDataBits
+  bitsToWrite.i
+  bitsToRead.i
+  outputByte.i
+  inputByte.i
+EndStructure
+#BitsPerByte = SizeOf(Byte) * 8
+#BitsPerInteger = SizeOf(Integer) * 8
+
+Global Dim fileBitMask(8)
+Define i, x
+For i = 0 To 8
+  fileBitMask(i) = x
+  x = (x << 1) + 1
+Next
+
+Global NewMap fileDataBits.fileDataBits()
+Procedure flushBits(fileID)
+  If FindMapElement(fileDataBits(), Str(fileID))
+    If fileDataBits()\bitsToWrite > 0
+      WriteByte(fileID, fileDataBits()\outputByte << (#BitsPerByte - fileDataBits()\bitsToWrite))
+      fileDataBits()\bitsToWrite = 0
+      fileDataBits()\outputByte = 0
+    EndIf
+    DeleteMapElement(fileDataBits())
+  EndIf
+EndProcedure
+
+Procedure writeBits(fileID, Value.i, bitCount)
+  Protected *fileData.fileDataBits = FindMapElement(fileDataBits(), Str(fileID))
+  If Not *fileData
+    *fileData = AddMapElement(fileDataBits(), Str(fileID))
+    If Not *fileData: End: EndIf ;simple error check for lack of memory
+  EndIf
+
+  Value << (#BitsPerInteger - bitCount) ;shift value so it's first bit (HSB) is in the highest position
+  While bitCount > 0
+    If bitCount > #BitsPerByte - *fileData\bitsToWrite
+      bitGroupSize = #BitsPerByte - *fileData\bitsToWrite
+    Else
+      bitGroupSize = bitCount
+    EndIf
+
+    *fileData\outputByte << bitGroupSize
+    *fileData\outputByte + (Value >> (#BitsPerInteger - bitGroupSize)) & fileBitMask(bitGroupSize)
+    Value << bitGroupSize
+    *fileData\bitsToWrite + bitGroupSize
+    If *fileData\bitsToWrite = #BitsPerByte
+      WriteByte(fileID, *fileData\outputByte)
+      *fileData\bitsToWrite = 0
+      *fileData\outputByte = 0
+    EndIf
+    bitCount - bitGroupSize
+  Wend
+EndProcedure
+
+Procedure.i readBits(fileID, bitCount)
+  Protected *fileData.fileDataBits = FindMapElement(fileDataBits(), Str(fileID))
+  If Not *fileData
+    *fileData = AddMapElement(fileDataBits(), Str(fileID))
+    If Not *fileData: End: EndIf ;simple error check for lack of memory
+  EndIf
+
+  Protected Value.i, bitGroupSize
+  While bitCount > 0
+    If *fileData\bitsToRead = 0
+      If Not Eof(fileID)
+        *fileData\inputByte = ReadByte(fileID)
+        *fileData\bitsToRead = #BitsPerByte
+      Else
+        flushBits(fileID)
+        Break ;simple error check aborts if nothing left to read
+      EndIf
+    EndIf
+
+    If bitCount > *fileData\bitsToRead
+      bitGroupSize = *fileData\bitsToRead
+    Else
+      bitGroupSize = bitCount
+    EndIf
+    Value << bitGroupSize
+    Value + (*fileData\inputByte >> (#BitsPerByte - bitGroupSize)) & fileBitMask(bitGroupSize) ;shift last bit being read in byte to the lowest position
+    *fileData\inputByte << bitGroupSize
+    *fileData\bitsToRead - bitGroupSize
+    bitCount - bitGroupSize
+  Wend
+  ProcedureReturn Value
+EndProcedure
+
+;test
+Define testWriteString.s, testReadString.s, fileNum, result.s
+testWriteString = "This is an ascii string that will be crunched, written, read and expanded."
+fileNum = CreateFile(#PB_Any, "BitIO_Test.dat")
+If fileNum
+  For i = 1 To Len(testWriteString)
+    writeBits(fileNum, Asc(Mid(testWriteString, i, 1)), 7)
+  Next
+  flushBits(fileNum)
+  CloseFile(fileNum)
+EndIf
+
+fileNum = ReadFile(#PB_Any, "BitIO_Test.dat")
+If fileNum
+  For i = 1 To Len(testWriteString)
+    testReadString + Chr(readBits(fileNum, 7))
+  Next
+  flushBits(fileNum)
+  CloseFile(fileNum)
+EndIf
+
+result = "Original ascii string is " + Str(Len(testWriteString)) + " bytes." + #LF$
+result + "Filesize written is " + Str(FileSize("test.xxx")) + " bytes." + #LF$
+If testReadString = testWriteString
+  result + "The expanded string is the same as the original." + #LF$
+Else
+  result + "The expanded string is not the same as the original." + #LF$
+EndIf
+result + "Expanded string = '" + testReadString + "'"
+
+MessageRequester("Results", result)