aparler/RosettaCodeData
1
0
Fork 0
Code Issues 12 Pull requests 3 Projects Releases Packages Wiki Activity Actions

Data update

Browse source
This commit is contained in:
Ingy dot Net 2024-04-19 16:56:29 -07:00
parent 0df55f9f24
commit aec8ed51b6
1045 changed files with 18889 additions and 2777 deletions
Download patch file Download diff file Expand all files Collapse all files

8
Task/Bitwise-IO/11l/bitwise-io.11l
View file

@ -1,10 +1,10 @@
T BitWriter
File out
FileWr out
accumulator = 0
bcount = 0
F (fname)
.out = File(fname, ‘w’)
.out = File(fname, WRITE)
F _writebit(bit)
I .bcount == 8
@ -34,11 +34,11 @@ T BitReader
read = 0
F (fname)
.input = File(fname, ‘r’)
.input = File(fname)
F _readbit()
I .bcount == 0
V a = .input.read_bytes(1)
V a = .input.read_bytes(at_most' 1)
I !a.empty
.accumulator = a[0]
.bcount = 8

112
Task/Bitwise-IO/FreeBASIC/bitwise-io.basic Normal file
View file

@ -0,0 +1,112 @@
Type BitFilter
nombre As String
accu As Integer
bits As Integer
bw As Integer
br As Integer
offset As Integer
End Type
Sub openWriter(bf As BitFilter)
bf.bw = Freefile
Open bf.nombre For Binary Access Write As #bf.bw
End Sub
Sub openReader(bf As BitFilter)
bf.br = Freefile
Open bf.nombre For Binary Access Read As #bf.br
bf.offset = 0
End Sub
Sub escribe(bf As BitFilter, buf() As Byte, start As Integer, nBits As Integer, shift As Integer)
Dim As Integer index = start + (shift \ 8)
shift Mod= 8
While nBits <> 0 Or bf.bits >= 8
While bf.bits >= 8
bf.bits -= 8
Dim As Byte outByte = ((bf.accu Shr bf.bits) And &hFF)
Put #bf.bw, , outByte
Wend
While bf.bits < 8 And nBits <> 0
Dim As Byte b = buf(index)
bf.accu = (bf.accu Shl 1) Or (((128 Shr shift) And b) Shr (7 - shift))
nBits -= 1
bf.bits += 1
shift += 1
If shift = 8 Then
shift = 0
index += 1
End If
Wend
Wend
End Sub
Sub lee(bf As BitFilter, buf() As Byte, start As Integer, nBits As Integer, shift As Integer)
Dim As Integer index = start + (shift \ 8)
shift Mod= 8
While nBits <> 0
While bf.bits <> 0 And nBits <> 0
Dim As Byte mask = 128 Shr shift
buf(index) = Iif((bf.accu And (1 Shl (bf.bits - 1))) <> 0, (buf(index) Or mask) And &hFF, (buf(index) And Not mask) And &hFF)
nBits -= 1
bf.bits -= 1
shift += 1
If shift >= 8 Then
shift = 0
index += 1
End If
Wend
If nBits = 0 Then Exit Sub
Dim As Byte inByte
Get #bf.br, bf.offset + 1, inByte
bf.accu = (bf.accu Shl 8) Or inByte
bf.bits += 8
bf.offset += 1
Wend
End Sub
Sub closeWriter(bf As BitFilter)
If bf.bits <> 0 Then
bf.accu Shl= (8 - bf.bits)
Dim As Byte outByte = (bf.accu And &hFF)
Put #bf.bw, , outByte
End If
Close #bf.bw
bf.accu = 0
bf.bits = 0
End Sub
Sub closeReader(bf As BitFilter)
Close #bf.br
bf.accu = 0
bf.bits = 0
bf.offset = 0
End Sub
Dim As Integer i
Dim As BitFilter bf
bf.nombre = "test.bin"
' for each byte in s, write 7 bits skipping 1
Dim As Byte s(10) => {Asc("a"), Asc("b"), Asc("c"), Asc("d"), _
Asc("e"), Asc("f"), Asc("g"), Asc("h"), Asc("i"), Asc("j"), Asc("k")}
openWriter(bf)
For i = 0 To Ubound(s)
escribe(bf, s(), i, 7, 1)
Next i
closeWriter(bf)
' read 7 bits and expand to each byte of s2 skipping 1 bit
openReader(bf)
Dim As Byte s2(0 To Ubound(s)) = {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0}
For i = 0 To Ubound(s2)
lee(bf, s2(), i, 7, 1)
Next i
closeReader(bf)
For i = 0 To Ubound(s2)
Print Chr(s2(i));
Next i
Print
Sleep

21
Task/Bitwise-IO/Seed7/bitwise-io.seed7
View file

@ -23,23 +23,19 @@ const proc: writeAscii (inout file: outFile, inout integer: bitPos, in string: a
const proc: finishWriteAscii (inout file: outFile, inout integer: bitPos) is func
begin
putBitsMsb(outFile, bitPos, 0, 7); # Write a terminating NUL char.
write(outFile, chr(ord(outFile.bufferChar)));
end func;
const proc: initReadAscii (inout file: outFile, inout integer: bitPos) is func
begin
bitPos := 8;
end func;
const func string: readAscii (inout file: inFile, inout integer: bitPos, in integer: length) is func
const func string: readAscii (inout msbBitStream: aBitStream) is func
result
var string: stri is "";
local
var char: ch is ' ';
begin
while not eof(inFile) and length(stri) < length do
ch := chr(getBitsMsb(inFile, bitPos, 7));
if inFile.bufferChar <> EOF then
while ch <> '\0;' do
ch := chr(getBits(aBitStream, 7));
if ch <> '\0;' then
stri &:= ch;
end if;
end while;
@ -49,12 +45,13 @@ const proc: main is func
local
var file: aFile is STD_NULL;
var integer: bitPos is 0;
var msbBitStream: aBitStream is msbBitStream.value;
begin
aFile := openStrifile;
aFile := openStriFile;
initWriteAscii(aFile, bitPos);
writeAscii(aFile, bitPos, "Hello, Rosetta Code!");
finishWriteAscii(aFile, bitPos);
seek(aFile, 1);
initReadAscii(aFile, bitPos);
writeln(literal(readAscii(aFile, bitPos, 100)));
aBitStream := openMsbBitStream(aFile);
writeln(literal(readAscii(aBitStream)));
end func;