60 lines
1.6 KiB
Forth
60 lines
1.6 KiB
Forth
program RLE
|
|
implicit none
|
|
|
|
integer, parameter :: bufsize = 100 ! Sets maximum size of coded and decoded strings, adjust as necessary
|
|
character(bufsize) :: teststr = "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW"
|
|
character(bufsize) :: codedstr = "", decodedstr = ""
|
|
|
|
call Encode(teststr, codedstr)
|
|
write(*,"(a)") trim(codedstr)
|
|
call Decode(codedstr, decodedstr)
|
|
write(*,"(a)") trim(decodedstr)
|
|
|
|
contains
|
|
|
|
subroutine Encode(instr, outstr)
|
|
character(*), intent(in) :: instr
|
|
character(*), intent(out) :: outstr
|
|
character(8) :: tempstr = ""
|
|
character(26) :: validchars = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
|
|
integer :: a, b, c, i
|
|
|
|
if(verify(trim(instr), validchars) /= 0) then
|
|
outstr = "Invalid input"
|
|
return
|
|
end if
|
|
outstr = ""
|
|
c = 1
|
|
a = iachar(instr(1:1))
|
|
do i = 2, len(trim(instr))
|
|
b = iachar(instr(i:i))
|
|
if(a == b) then
|
|
c = c + 1
|
|
else
|
|
write(tempstr, "(i0)") c
|
|
outstr = trim(outstr) // trim(tempstr) // achar(a)
|
|
a = b
|
|
c = 1
|
|
end if
|
|
end do
|
|
write(tempstr, "(i0)") c
|
|
outstr = trim(outstr) // trim(tempstr) // achar(b)
|
|
end subroutine
|
|
|
|
subroutine Decode(instr, outstr)
|
|
character(*), intent(in) :: instr
|
|
character(*), intent(out) :: outstr
|
|
character(26) :: validchars = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
|
|
integer :: startn, endn, n
|
|
|
|
outstr = ""
|
|
startn = 1
|
|
do while(startn < len(trim(instr)))
|
|
endn = scan(instr(startn:), validchars) + startn - 1
|
|
read(instr(startn:endn-1), "(i8)") n
|
|
outstr = trim(outstr) // repeat(instr(endn:endn), n)
|
|
startn = endn + 1
|
|
end do
|
|
end subroutine
|
|
end program
|