' Сжатие по технологии RLE
'Autor: Johna Smith

#Include "crt.bi"

Dim Shared As FILE Ptr fInput, foutput

Sub compress()
  Dim As UByte c1,c,length
  Dim As UInteger rcounter,wcounter
  fread(@c1,1,1,fInput)
  Do
   c=c1
   length=0
   Do
    fread(@c1,1,1,fInput)
    length+=1
    rcounter+=1
   Loop while (feof(fInput)=0 And c1=c and length<>255)
   fwrite(@c,1,1,foutput)
   fwrite(@length,1,1,foutput)
   wcounter+=1
  Loop while feof(fInput)=0
  printf(!"%ld byte(s) compressed\n",rcounter)
  printf(!"ratio: %d\n",wcounter/rcounter)
End Sub

sub decompress()
  Dim As UByte c,length
  Dim As UInteger rcounter,wcounter
  fread(@c,1,1,fInput)
  Do
   fread(@length,1,1,fInput)
   for i As Integer = 0 To length-1
    fwrite(@c,1,1,foutput)
    wcounter+=1
   Next
   fread(@c,1,1,finput)
   rcounter+=2
  loop while (feof(finput)=0)
  printf(!"%ld byte(s) decompressed\n",wcounter)
  printf(!"ratio: %d\n",wcounter/rcounter)
End Sub

' Компрессия BMP файла
finput=fopen("img.bmp","rb")
fOutput=fopen("img.zip","wb")
If finput<>0 And fOutput<>0 Then
  compress()
  fclose(finput)
  fclose(foutput)
EndIf

' декомпрессия BMP файла
finput=fopen("img.zip","rb")
fOutput=fopen("img2.bmp","wb")
If finput<>0 And fOutput<>0 Then
  decompress()
  fclose(finput)
  fclose(foutput)
EndIf

sleep