Run-length encoding: Difference between revisions

Added solution for Action!
(Added solution for Action!)
Line 129:
 
The hexdump above converts to: <code>12W 1B 12W 3B 24W 1B 14W</code>
 
=={{header|Action!}}==
<lang Action!>BYTE FUNC GetLength(CHAR ARRAY s BYTE pos)
CHAR c
BYTE len
 
c=s(pos)
len=1
DO
pos==+1
IF pos<=s(0) AND s(pos)=c THEN
len==+1
ELSE
EXIT
FI
OD
RETURN (len)
 
BYTE FUNC GetNumber(CHAR ARRAY s BYTE POINTER pos)
BYTE num,len
CHAR ARRAY tmp(5)
 
len=0
DO
len==+1
tmp(len)=s(pos^)
pos^==+1
IF s(pos^)<'0 OR s(pos^)>'9 THEN
EXIT
FI
OD
tmp(0)=len
num=ValB(tmp)
RETURN (num)
 
PROC Append(CHAR ARRAY text,suffix)
BYTE POINTER srcPtr,dstPtr
BYTE len
 
len=suffix(0)
IF text(0)+len>255 THEN
len=255-text(0)
FI
IF len THEN
srcPtr=suffix+1
dstPtr=text+text(0)+1
MoveBlock(dstPtr,srcPtr,len)
text(0)==+suffix(0)
FI
RETURN
 
PROC Encode(CHAR ARRAY in,out)
BYTE pos,len
CHAR ARRAY tmp(5)
 
pos=1 len=0 out(0)=0
WHILE pos<=in(0)
DO
len=GetLength(in,pos)
StrB(len,tmp)
Append(out,tmp)
out(0)==+1
out(out(0))=in(pos)
pos==+len
OD
RETURN
 
PROC Decode(CHAR ARRAY in,out)
BYTE pos,num,i
CHAR c
 
pos=1 out(0)=0
WHILE pos<=in(0)
DO
num=GetNumber(in,@pos)
c=in(pos)
pos==+1
FOR i=1 TO num
DO
out(0)==+1
out(out(0))=c
OD
OD
RETURN
 
PROC Main()
CHAR ARRAY data="WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW"
CHAR ARRAY encoded(256),decoded(256)
 
PrintE("original:")
PrintE(data)
PutE()
 
Encode(data,encoded)
PrintE("encoded:")
PrintE(encoded)
PutE()
 
Decode(encoded,decoded)
PrintE("decoded:")
PrintE(decoded)
RETURN</lang>
{{out}}
[https://gitlab.com/amarok8bit/action-rosetta-code/-/raw/master/images/Run-length_encoding.png Screenshot from Atari 8-bit computer]
<pre>
original:
WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW
 
encoded:
12W1B12W3B24W1B14W
 
decoded:
WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW
</pre>
 
=={{header|Ada}}==
Anonymous user