Squares

General FreeBASIC programming questions.
albert
Posts: 5015
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Postby albert » Aug 02, 2019 1:03

@Dodicat

Check this code out...

Adjust the size to suit your imagination..

if "size" = even value , it compresses , odd values 3 , 5 , 7 , 9 , 11, etc.. don't compress but get all 256 correct.

"size" = 10 gets 128 ( 128 to 255 ) correct...

Code: Select all


screen 19

dim as longint count1 = 0 , count2 = 0

dim as ubyte n1 , n2 , outs , ans , chk , size = 5 ' adjust size to suit.. odds don't compress but get all 256 correct...

for a as longint = 0 to 255 step 1
   
        n2 = a * size
       
        outs = n2
         
        for b as longint = 0 to 255*size step size
            chk = b
            if chk = outs then ans = (b \ size )
        next
       
        if ans   = a then count1+=1 : print a , n2  , ans , "CORRECT"
        if ans <> a then count2+=1 : print a , n2  , ans , "WRONG  "
               
        if a > 0 and a mod 16 = 0 then print "pres a key for next 16" : sleep
       
        if inkey = chr(27) then exit for
       
next

print "done..."
sleep

print "Got " ; count1 ; " correct , out of ( 0 to 255 ) "
print
print "Got " ; count2 ; " wrong , out of ( 0 to 255 ) "

sleep
end

albert
Posts: 5015
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Postby albert » Aug 02, 2019 1:47

@Richard
@Dodicat

I got it working with "size" = 10 ... Getting all 256 values correct... But it doesn't compress..

Code: Select all


screen 19

dim as longint count1 = 0 , count2 = 0

dim as ubyte n1 , n2 , outs , ans , chk , size = 10 ' adjust size to suit.. 11 doesn't compress but gets all 256 correct

for a as longint = 0 to 255 step 1
   
        n2 = a * size
       
        if a <= 127 then n1 = 1 else n1 = 0
       
        outs = n2
         
        for b as longint = 0 to 255*size step size
            chk = b
            if n1 = 1 then
                if chk = outs then ans = b \ size : exit for
            else
                if b > 127 * 10 then if chk = outs then ans = (b \ size ) : exit for
            end if
        next
       
        if ans   = a then count1+=1 : print a , n2  , ans , "CORRECT"
        if ans <> a then count2+=1 : print a , n2  , ans , "WRONG  "
               
        if a > 0 and a mod 16 = 0 then print "pres a key for next 16" : sleep
       
        if inkey = chr(27) then exit for
       
next

print "done..."
sleep

print "Got " ; count1 ; " correct , out of ( 0 to 255 ) "
print
print "Got " ; count2 ; " wrong , out of ( 0 to 255 ) "

sleep
end

albert
Posts: 5015
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Postby albert » Aug 02, 2019 3:45

This one , you can play with , adjusting the "size" var , to what ever you want..

size = 64 , compresses , but only gets 4 correct out of every 64..

Code: Select all


screen 19

dim as longint count1 = 0 , count2 = 0

dim as ubyte n1 , n2 , outs , ans , chk , size = 4 ' adjust size to suit.. odd numbers get all 256 correct but don't compress.

for a as longint = 0 to 255 step 1
   
        n2 = a * size
       
        if a <=   63 then n1 = 0 : goto done
        if a <= 127 then n1 = 1 : goto done
        if a <= 191 then n1 = 2 : goto done
        if a <= 255 then n1 = 3 : goto done
       
        done:
       
        outs = n2
         
        if n1 = 0 then
            for b as longint = 0 to 63 step 1
                chk = b*size
                if chk = outs then ans = b : exit for
            next
        end if
       
        if n1 = 1 then
            for b as longint = 64 to 127 step 1
                chk = b*size
                if chk = outs then ans = b : exit for
            next
        end if
       
        if n1 = 2 then
            for b as longint = 128 to 191 step 1
                chk = b*size
                if chk = outs then ans = b : exit for
            next
        end if
       
        if n1 = 3 then
            for b as longint = 192 to 255 step 1
                chk = b*size
                if chk = outs then ans = b : exit for
            next
        end if
       
        if ans   = a then count1+=1 : print a , n2  , ans , "CORRECT"
        if ans <> a then count2+=1 : print a , n2  , ans , "WRONG  "
               
        if a > 0 and a mod 16 = 0 then print "pres a key for next 16" : sleep
       
        if inkey = chr(27) then exit for
       
next

print "done..."
sleep

print "Got " ; count1 ; " correct , out of ( 0 to 255 ) "
print
print "Got " ; count2 ; " wrong , out of ( 0 to 255 ) "

sleep
end

Knatterton
Posts: 157
Joined: Apr 19, 2019 19:03

Re: Squares

Postby Knatterton » Aug 02, 2019 7:40

Albert, i want to thank you for all the joy you bring us through your programming work with a song:

https://www.youtube.com/watch?v=0dcbw4IEY5w
albert
Posts: 5015
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Postby albert » Aug 02, 2019 16:11

@Dodicat

I think i finally got compression.... It uses val * 64 ...

val * 64 can equal 0 , 64 , 128 , 192. only 4 values. and ( 255 \ ( 256\64 ) ) = 63 values...So it only uses 67 bytes out of 256..


Now to write the de-compressor.....

Code: Select all


Declare Function   compress_loop( chrs as string ) as string
Declare Function decompress_loop( chrs as string ) as string


Namespace Zlibrary

#inclib "zlib"
Extern "C"
    Declare Function compressBound(Byval sourceLen As Ulong) As Ulong
    Declare Function uncompress(Byval dest As Ubyte Ptr, Byval destLen As Uinteger Ptr, Byval source As  Ubyte Ptr, Byval sourceLen As Ulong) As Long
    Declare Function compress(Byval dest As Ubyte Ptr, Byval destLen As Uinteger Ptr, Byval source As  Ubyte Ptr, Byval sourceLen As Ulong) As Long
End Extern

Function getpassedinfo(text As String,Byref passed_length As Integer) As String
    Dim As String var1,var2
    Dim As Integer pst
    #macro splice(stri,char,var1,var2)
    pst=Instr(stri,char)
    var1="":var2=""
    If pst<>0 Then
        var1=Mid(stri,1,pst-1)
        var2=Mid(stri,pst+1)
    Else
        var1=stri
    End If
    #endmacro
    splice(text,"|",var1,var2)
    text=var2
    passed_length=Valint(var1)
    Return text
End Function


'=================   UNPACK ===============
Function unpack(file As String) As String
    Dim As Integer passed_length
    Dim As String text=getpassedinfo(file,passed_length)
    Dim As Integer stringlength,destinationlength
    stringlength=Len(text)
    destinationlength =passed_length
    Dim As Ubyte Ptr source
    Dim As Ubyte Ptr  destination =Callocate(destinationlength,1)
    source=@text[0]
    Var mistake=uncompress(destination,@destinationlength, source, stringlength)
    If mistake<>0 Then Print "There was an error":Sleep:End
    Dim As String uncompressed
    uncompressed=String(destinationlength,0)
    For i As Integer = 0 To destinationlength- 1
        uncompressed[i]=(destination[i])
    Next
    Deallocate destination
    Return uncompressed
End Function

'===================  PACK ============
Function pack(file As String) As String
    Dim As String text=file
    Dim As Integer stringlength,destinationlength
    stringlength=Len(text)
    destinationlength = compressBound(stringlength)
    Dim As Ubyte Ptr source
    Dim As Ubyte Ptr destination =Callocate(destinationlength,1)
    source=@text[0]
    Var mistake=compress(destination, @destinationlength, source, stringlength)
    If mistake <>0 Then Print "There was an error"
    Dim As String compressed
    compressed=String(destinationlength,0)
    For n As Integer=0 To destinationlength-1
        compressed[n]=destination[n]
    Next n
    compressed=stringlength &"|"+compressed
    Deallocate destination
    Return compressed
End Function

End Namespace


'==================================================================
'==================================================================
'test zipper
'==================================================================
'==================================================================
screen 19

Dim Shared As String s

Randomize

s=""
dim as string check=""
dim as string compare=""
dim as longint length = 0
dim as double compression = 0
dim as longint loops = 0
do
   
    loops+=1
   
    'one time run , create initial string
    if loops = 1 then
        For n As Long = 1 To 10000
            s+=chr(Int(Rnd*256))'+48)
        Next
        compare =  s
        length = len(s)
    else
        'modify compression to make further compression possible
       
        s = compress_loop(s)
       
    end if
    check = s
    compression = (100 - ( 100 / ( length / len(check) ) ))
   
    Print "original string"
    Print Len(s)
    Print
   
    Dim As String compressed=Zlibrary.pack(s)
    s = compressed
   
    Print "packed string "
    Print Len(compressed)
    Print
   
    Dim As String uncompressed=Zlibrary.unpack(compressed)
   
    Print "Retrieve"
    Print Len(uncompressed)
    Print
    'Print "compression ratio  "; 100 - ( 100 / ( Len(s) / len(compressed) ) ) ; "%"
    Print "compression ratio  "; 100 - ( 100 / ( length / len(s) ) ) ; "%"
    Print Iif(uncompressed=check,"OK","ERROR")
    Print "-------------------------------"
   
    'sleep 1000
   
    'if loops > 2 and (100 - ( 100 / ( length / len(s) ) )) < compression then exit do
   
    print "press a key for next compression." ; " loops = " ; loops ; " out of 40."
    print
    print "press esc to exit."
    sleep
   
    if inkey = chr(27) then exit do
   
loop until loops = 40

print "Press a key to decompress." 
sleep

s = str(loops) + "_" + s ' save as an output file...

'==================================================================
'decompress
'==================================================================
dim as longint dec = instr(1,s,"_")
dim as longint count = val(left(s,dec-1))
dim as string comp = mid(s,dec+1)
dim as string val1
dim as string outs
for a as longint = count to 2 step -1
    s = Zlibrary.unpack(comp)
    outs = decompress_loop(s)
    comp = outs
next

comp = Zlibrary.unpack(comp)

print
print "input = "; length , "output = " ; len(comp) , "compression ratio  "; 100 - ( 100 / ( length / len(s) ) ) ; "%"
print
if comp = compare then print "Decompression successful." else print "ERROR"
print
Print "!!~~Done~~!!"

Sleep
end
'===============================================================================
'===============================================================================
'begin functions
'===============================================================================
'================='==============================================================
Function compress_loop( chrs as string ) as string
   
    dim as string outputs=""
    dim as ubyte n1 , n2
    for a as longint = 0 to  len(chrs)-1 step 1
       
        n1 = chrs[a]
        n2 = chrs[a]
       
        n1*= 64
       
        if n1 =      0 then outputs+="0"
        if n1 =    64 then outputs+="1"
        if n1 = 128 then outputs+="2"
        if n1 = 192 then outputs+="3"
       
        outputs+=right("00"+str(n2\(256\64)),2)
       
    next
   
    dim as string final_out=""
    for a as longint = 1 to len(outputs) step 3
        final_out+=chr(val("&O"+mid(outputs,a,3)))
    next
   
    return final_out
       
end function
'===============================================================================
'============================================================================
Function decompress_loop( chrs as string ) as string
   
    return chrs

end function

albert
Posts: 5015
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Postby albert » Aug 02, 2019 17:46

@Dodicat


outputs+=right("00"+str(n2\(256\64)),2) ' 0 to 63 , the highest is 363 which is less and then (oct 377 = 255).

final_out+=chr(val("&O"+mid(outputs,a,3))) ' using oct , converts the last 2 digits to oct , how to reverse it ?

Code: Select all


Declare Function      compress_loop( chrs as string ) as string
Declare Function decompress_loop( chrs as string ) as string

screen 19

dim as double time1 , time2 , time3 , time4
do
   
    randomize
   
    dim as string s=""
    For n As Long = 1 To 10
        s+=chr(Int(Rnd*256))'+8)
    Next
   
    time1=timer
    'begin compress
        dim as string comp = s
        'do
        '    dim as longint chk = len(comp) - 1
        '    comp = compress_loop(comp)
        '    if len(comp) >= chk then exit do
        'loop
       
        for a as longint = 1 to 1 step 1
            comp = compress_loop(comp)
        next
    'end compress
    time2 = timer
   
    time3=timer
    'begin decompress
        dim as string final_out = comp
        for a as longint = 1 to 1 step 1
            final_out = decompress_loop(final_out)
        next
    'end decompress
    time4 = timer
   
   'sleep
   
    'cls
    'draw string( 0,10) , left(s,100)
    'draw string( 0,30) , left(final_out,100)
    print string(99,"=")
    print "inp = " ; (s)
    print string(99,"=")
    print "out = " ; (final_out)
    print
    print "compress time   = "; time2-time1
    print "decompress time = "; time4-time3
    print
   
    if s = final_out then print "Decompressed OK" else print "Decompression failed."
    print string(99,"=")
   
    sleep
   
loop until inkey = chr(27)

sleep
end
'===============================================================================
'===============================================================================
'begin functions
'===============================================================================
'===============================================================================
Function compress_loop( chrs as string ) as string
   
    dim as string outputs=""
    dim as ubyte n1 , n2
    for a as longint = 0 to  len(chrs)-1 step 1
       
        n1 = chrs[a]
        n2 = chrs[a]
       
        n1*= 64
       
        if n1 =      0 then outputs+="0"
        if n1 =    64 then outputs+="1"
        if n1 = 128 then outputs+="2"
        if n1 = 192 then outputs+="3"
       
        outputs+=right("00"+str(n2\(256\64)),2) ' 0 to 63 , the highest is 363 which is less and then (oct 377 = 255).
       
    next
   
    print "c out = " ; len(outputs) , outputs
   
    dim as string final_out=""
    for a as longint = 1 to len(outputs) step 3
        final_out+=chr(val("&O"+mid(outputs,a,3)))  ' using oct , converts the last 2 digits to oct , how to reverse it ?
    next
   
    return final_out
       
end function
'===============================================================================
'============================================================================
Function decompress_loop( chrs as string ) as string
   
    dim as string octs=""
    dim as ubyte n1 , n2 , ans
    for a as longint = 0 to  len(chrs)-1 step 1
       
        octs+= right("000"+str(chrs[a]),3)
       
    next
   
    print "d out = " ; len(octs) , octs
   
    return chrs

end function

albert
Posts: 5015
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Postby albert » Aug 02, 2019 23:24

@Richard
@Dodicat

Can one of you guys figure this one out?? Need help reversing the formula..

It's a little confusing...

Code: Select all


screen 19

dim as longint count1 = 0 , count2 = 0

dim as ubyte n1 , ans , size = 4

for a as longint = 0 to 255 step 1
   
        n1 = a * size
       
        if a <= 063 then n1+= 0 : goto done
        if a <= 127 then n1+= 1 : goto done
        if a <= 191 then n1+= 3 : goto done
        if a <= 255 then n1+= 5 : goto done
       
        done:
       
        ' Try to get the right answer..??
        if (n1-5) mod 4 = 0 then ans = ( (n1-5) \ size ) + 192 : goto ends
        if (n1-3) mod 4 = 0 then ans = ( (n1-3) \ size ) + 128 : goto ends
        if (n1-1) mod 4 = 0 then ans = ( (n1-1) \ size ) + 064 : goto ends
        if (n1-0) mod 4 = 0 then ans = ( (n1-0) \ size ) + 000 : goto ends
       
        ends:
       
        if ans   = a then count1+=1 : print a , n1 , ans ,  "CORRECT"
        if ans <> a then count2+=1 : print a , n1 , ans ,  "WRONG  "
               
        if a > 0 and a mod 16 = 0 then print "pres a key for next 16" : sleep
       
        if inkey = chr(27) then exit for
       
next

print "done..."
sleep

print "Got " ; count1 ; " correct , out of ( 0 to 255 ) "
print
print "Got " ; count2 ; " wrong , out of ( 0 to 255 ) "

sleep
end

albert
Posts: 5015
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Postby albert » Aug 03, 2019 0:51

@Dodicat

if n2 <= 063 then n1+= 0 : goto done
if n2 <= 127 then n1+= 1 : goto done
if n2 <= 191 then n1+= 2 : goto done
if n2 <= 255 then n1+= 3 : goto done

Returns all 256 correct , but it doesn't compress..
0 , 1, 3 , 5 , compresses , but i can't figure out how to undo it...

Code: Select all


Declare Function   compress_loop( chrs as string ) as string
Declare Function decompress_loop( chrs as string ) as string


Namespace Zlibrary

#inclib "zlib"
Extern "C"
    Declare Function compressBound(Byval sourceLen As Ulong) As Ulong
    Declare Function uncompress(Byval dest As Ubyte Ptr, Byval destLen As Uinteger Ptr, Byval source As  Ubyte Ptr, Byval sourceLen As Ulong) As Long
    Declare Function compress(Byval dest As Ubyte Ptr, Byval destLen As Uinteger Ptr, Byval source As  Ubyte Ptr, Byval sourceLen As Ulong) As Long
End Extern

Function getpassedinfo(text As String,Byref passed_length As Integer) As String
    Dim As String var1,var2
    Dim As Integer pst
    #macro splice(stri,char,var1,var2)
    pst=Instr(stri,char)
    var1="":var2=""
    If pst<>0 Then
        var1=Mid(stri,1,pst-1)
        var2=Mid(stri,pst+1)
    Else
        var1=stri
    End If
    #endmacro
    splice(text,"|",var1,var2)
    text=var2
    passed_length=Valint(var1)
    Return text
End Function


'=================   UNPACK ===============
Function unpack(file As String) As String
    Dim As Integer passed_length
    Dim As String text=getpassedinfo(file,passed_length)
    Dim As Integer stringlength,destinationlength
    stringlength=Len(text)
    destinationlength =passed_length
    Dim As Ubyte Ptr source
    Dim As Ubyte Ptr  destination =Callocate(destinationlength,1)
    source=@text[0]
    Var mistake=uncompress(destination,@destinationlength, source, stringlength)
    If mistake<>0 Then Print "There was an error":Sleep:End
    Dim As String uncompressed
    uncompressed=String(destinationlength,0)
    For i As Integer = 0 To destinationlength- 1
        uncompressed[i]=(destination[i])
    Next
    Deallocate destination
    Return uncompressed
End Function

'===================  PACK ============
Function pack(file As String) As String
    Dim As String text=file
    Dim As Integer stringlength,destinationlength
    stringlength=Len(text)
    destinationlength = compressBound(stringlength)
    Dim As Ubyte Ptr source
    Dim As Ubyte Ptr destination =Callocate(destinationlength,1)
    source=@text[0]
    Var mistake=compress(destination, @destinationlength, source, stringlength)
    If mistake <>0 Then Print "There was an error"
    Dim As String compressed
    compressed=String(destinationlength,0)
    For n As Integer=0 To destinationlength-1
        compressed[n]=destination[n]
    Next n
    compressed=stringlength &"|"+compressed
    Deallocate destination
    Return compressed
End Function

End Namespace


'==================================================================
'==================================================================
'test zipper
'==================================================================
'==================================================================
screen 19

Dim Shared As String s

Randomize

s=""
dim as string check=""
dim as string compare=""
dim as longint length = 0
dim as double compression = 0
dim as longint loops = 0
do
   
    loops+=1
   
    'one time run , create initial string
    if loops = 1 then
        For n As Long = 1 To 10000
            s+=chr(Int(Rnd*256))'+48)
        Next
        compare =  s
        length = len(s)
    else
        'modify compression to make further compression possible
       
        s = compress_loop(s)
       
    end if
    check = s
    compression = (100 - ( 100 / ( length / len(check) ) ))
   
    Print "original string"
    Print Len(s)
    Print
   
    Dim As String compressed=Zlibrary.pack(s)
    s = compressed
   
    Print "packed string "
    Print Len(compressed)
    Print
   
    Dim As String uncompressed=Zlibrary.unpack(compressed)
   
    Print "Retrieve"
    Print Len(uncompressed)
    Print
    'Print "compression ratio  "; 100 - ( 100 / ( Len(s) / len(compressed) ) ) ; "%"
    Print "compression ratio  "; 100 - ( 100 / ( length / len(s) ) ) ; "%"
    Print Iif(uncompressed=check,"OK","ERROR")
    Print "-------------------------------"
   
    'sleep 1000
   
    'if loops > 2 and (100 - ( 100 / ( length / len(s) ) )) < compression then exit do
   
    print "press a key for next compression." ; " loops = " ; loops ; " out of 40."
    print
    print "press esc to exit."
    sleep
   
    if inkey = chr(27) then exit do
   
loop until loops = 40

print "Press a key to decompress." 
sleep

s = str(loops) + "_" + s ' save as an output file...

'==================================================================
'decompress
'==================================================================
dim as longint dec = instr(1,s,"_")
dim as longint count = val(left(s,dec-1))
dim as string comp = mid(s,dec+1)
dim as string val1
dim as string outs
for a as longint = count to 2 step -1
    s = Zlibrary.unpack(comp)
    outs = decompress_loop(s)
    comp = outs
next

comp = Zlibrary.unpack(comp)

print
print "input = "; length , "output = " ; len(comp) , "compression ratio  "; 100 - ( 100 / ( length / len(s) ) ) ; "%"
print
if comp = compare then print "Decompression successful." else print "ERROR"
print
Print "!!~~Done~~!!"

Sleep
end
'===============================================================================
'===============================================================================
'begin functions
'===============================================================================
'================='==============================================================
Function compress_loop( chrs as string ) as string
   
    dim as string outs=""
    dim as ubyte n1 , n2
    dim as ubyte ptr ubp = cptr(ubyte ptr,strptr(chrs))
    for a as longint = 1 to  len(chrs) step 1
       
        n1 = (*ubp) * 4
       
        n2 = *ubp
       
        if n2 <= 063 then n1+= 0 : goto done
        if n2 <= 127 then n1+= 1 : goto done
        if n2 <= 191 then n1+= 2: goto done
        if n2 <= 255 then n1+= 3: goto done
       
        done:
   
        *ubp = n1
       
        ubp+=1
       
    next
   
    return chrs
       
end function
'===============================================================================
'============================================================================
Function decompress_loop( chrs as string ) as string
   
    dim as ubyte n1 , ans , size = 4
    dim as ubyte ptr ubp = cptr(ubyte ptr,strptr(chrs))
    for a as longint = 1 to  len(chrs) step 1
       
        n1 = *ubp
       
        if (n1-3) mod 4 = 0 then ans = ( (n1-3) \ size ) + 192 : goto ends
        if (n1-2) mod 4 = 0 then ans = ( (n1-2) \ size ) + 128 : goto ends
        if (n1-1) mod 4 = 0 then ans = ( (n1-1) \ size ) + 064 : goto ends
        if (n1-0) mod 4 = 0 then ans = ( (n1-0) \ size ) + 000 : goto ends
       
        ends:
       
        *ubp = ans
       
        ubp+=1
   
    next
   
    return chrs

end function

albert
Posts: 5015
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Postby albert » Aug 03, 2019 18:42

@Dodicat

I thought up a way to compress random data..

You turn the random data , into a "formula" , that will recreate the random data..
I don't think the formula will exceed to size of the random data...

I'll start working on formulas.

Can you post your "factor solving code" ??
I'll start ; by seeing if the factors , are larger than the input data..

maybe stepping by 8's using a ulongint ptr.. and solving the factors..
dodicat
Posts: 5938
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Squares

Postby dodicat » Aug 03, 2019 22:29

Hi Albert.
A little play around.

Code: Select all

 

Declare Function   compress_loop( chrs as string ) as string
Declare Function decompress_loop( chrs as string ) as string


Namespace Zlibrary

#inclib "zlib"
Extern "C"
    Declare Function compressBound(Byval sourceLen As Ulong) As Ulong
    Declare Function uncompress(Byval dest As Ubyte Ptr, Byval destLen As Uinteger Ptr, Byval source As  Ubyte Ptr, Byval sourceLen As Ulong) As Long
    Declare Function compress(Byval dest As Ubyte Ptr, Byval destLen As Uinteger Ptr, Byval source As  Ubyte Ptr, Byval sourceLen As Ulong) As Long
End Extern

Function getpassedinfo(text As String,Byref passed_length As Integer) As String
    Dim As String var1,var2
    Dim As Integer pst
    #macro splice(stri,char,var1,var2)
    pst=Instr(stri,char)
    var1="":var2=""
    If pst<>0 Then
        var1=Mid(stri,1,pst-1)
        var2=Mid(stri,pst+1)
    Else
        var1=stri
    End If
    #endmacro
    splice(text,"|",var1,var2)
    text=var2
    passed_length=Valint(var1)
    Return text
End Function


'=================   UNPACK ===============
Function unpack(file As String) As String
    Dim As Integer passed_length
    Dim As String text=getpassedinfo(file,passed_length)
    Dim As Integer stringlength,destinationlength
    stringlength=Len(text)
    destinationlength =passed_length
    Dim As Ubyte Ptr source
    Dim As Ubyte Ptr  destination =Callocate(destinationlength,1)
    source=@text[0]
    Var mistake=uncompress(destination,@destinationlength, source, stringlength)
    If mistake<>0 Then Print "There was an error":Sleep:End
    Dim As String uncompressed
    uncompressed=String(destinationlength,0)
    For i As Integer = 0 To destinationlength- 1
        uncompressed[i]=(destination[i])
    Next
    Deallocate destination
    Return uncompressed
End Function

'===================  PACK ============
Function pack(file As String) As String
    Dim As String text=file
    Dim As Integer stringlength,destinationlength
    stringlength=Len(text)
    destinationlength = compressBound(stringlength)
    Dim As Ubyte Ptr source
    Dim As Ubyte Ptr destination =Callocate(destinationlength,1)
    source=@text[0]
    Var mistake=compress(destination, @destinationlength, source, stringlength)
    If mistake <>0 Then Print "There was an error"
    Dim As String compressed
    compressed=String(destinationlength,0)
    For n As Integer=0 To destinationlength-1
        compressed[n]=destination[n]
    Next n
    compressed=stringlength &"|"+compressed
    Deallocate destination
    Return compressed
End Function

End Namespace



randomize
dim as string s="abcdefghijkXXXmnopqrstuvwxAAAyz0123456789ubfurt5433qwertyuiopasdfghjklCCCzxcvbnmlkjhugt"
for n as long=1 to 10
    s+=s
next

for n as long=0 to 5000 'add some randoms
    s+=chr(rnd*255)
next

var L=len(s)
for n as long=1 to 10000  'shuffle everything
    swap s[rnd*L],s[rnd*L]
    next
   
   

function compress(byval s as string) as string
    dim as string start=chr(s[0])
    for i as long=1 to len(s)-1
        var t=str(s[i]-s[i-1])
        if instr(t,"-")=0  then t="+"+t
        start=start+t
     next i
     return start
    end function
   
    function decompress(byval s as string) as string
        dim as string start=chr(s[0])
        dim as long k
         s=ltrim(s,chr(s[0]))
        for i as long=1 to len(s)-1
            var t=valint(s)
            if t<0 then k=1 else k=2
            var L=len(str(t))+k
            s=mid(s,L)
            start+=chr(start[i-1]+t)
             if s="" then exit for
            next i
        return start
    end function
   
    print "original  ";len(s)
    var c= compress(s)
    var c2=zlibrary.pack(c)
    print "Packed    ";len(c2)
    var c3=zlibrary.unpack(c2)
    var c4=decompress(c3)
    print c4=s;" check return"
    print "Done"
    sleep
   
 
albert
Posts: 5015
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Postby albert » Aug 04, 2019 0:51

@Dodicat

Using less than 256 chars in a string ,almost always compresses....
It's when you use all 256 chars it doesn't compress..

I'm trying to compress a string that has all 256 chars in it..

========================================================================
I though of an idea!!

On screen 19 you can plot 100 digits..

You print out the number , and start at a distance , and draw lines to the different numbers.
Lines to all the 0's , 1's , 2's ,,,, 9's , And use ten trig formulas , to draw the lines to the numbers...Or record the angles to the numbers

The 10 trig formulas might be less than 100 bytes. You can skip one number ; maybe zero...
=======================================================================
albert
Posts: 5015
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Postby albert » Aug 04, 2019 2:27

@Dodicat

Check this one out.... Compresses 90+% after 40 loops.

See: compress_loop()

Here it is in your Zlib code...

Code: Select all


Declare Function   compress_loop( chrs as string ) as string
Declare Function decompress_loop( chrs as string ) as string


Namespace Zlibrary

#inclib "zlib"
Extern "C"
    Declare Function compressBound(Byval sourceLen As Ulong) As Ulong
    Declare Function uncompress(Byval dest As Ubyte Ptr, Byval destLen As Uinteger Ptr, Byval source As  Ubyte Ptr, Byval sourceLen As Ulong) As Long
    Declare Function compress(Byval dest As Ubyte Ptr, Byval destLen As Uinteger Ptr, Byval source As  Ubyte Ptr, Byval sourceLen As Ulong) As Long
End Extern

Function getpassedinfo(text As String,Byref passed_length As Integer) As String
    Dim As String var1,var2
    Dim As Integer pst
    #macro splice(stri,char,var1,var2)
    pst=Instr(stri,char)
    var1="":var2=""
    If pst<>0 Then
        var1=Mid(stri,1,pst-1)
        var2=Mid(stri,pst+1)
    Else
        var1=stri
    End If
    #endmacro
    splice(text,"|",var1,var2)
    text=var2
    passed_length=Valint(var1)
    Return text
End Function


'=================   UNPACK ===============
Function unpack(file As String) As String
    Dim As Integer passed_length
    Dim As String text=getpassedinfo(file,passed_length)
    Dim As Integer stringlength,destinationlength
    stringlength=Len(text)
    destinationlength =passed_length
    Dim As Ubyte Ptr source
    Dim As Ubyte Ptr  destination =Callocate(destinationlength,1)
    source=@text[0]
    Var mistake=uncompress(destination,@destinationlength, source, stringlength)
    If mistake<>0 Then Print "There was an error":Sleep:End
    Dim As String uncompressed
    uncompressed=String(destinationlength,0)
    For i As Integer = 0 To destinationlength- 1
        uncompressed[i]=(destination[i])
    Next
    Deallocate destination
    Return uncompressed
End Function

'===================  PACK ============
Function pack(file As String) As String
    Dim As String text=file
    Dim As Integer stringlength,destinationlength
    stringlength=Len(text)
    destinationlength = compressBound(stringlength)
    Dim As Ubyte Ptr source
    Dim As Ubyte Ptr destination =Callocate(destinationlength,1)
    source=@text[0]
    Var mistake=compress(destination, @destinationlength, source, stringlength)
    If mistake <>0 Then Print "There was an error"
    Dim As String compressed
    compressed=String(destinationlength,0)
    For n As Integer=0 To destinationlength-1
        compressed[n]=destination[n]
    Next n
    compressed=stringlength &"|"+compressed
    Deallocate destination
    Return compressed
End Function

End Namespace


'==================================================================
'==================================================================
'test zipper
'==================================================================
'==================================================================
screen 19

Dim Shared As String s

Randomize

s=""
dim as string check=""
dim as string compare=""
dim as longint length = 0
dim as double compression = 0
dim as longint loops = 0
do
   
    loops+=1
   
    'one time run , create initial string
    if loops = 1 then
        For n As Long = 1 To 10000
            s+=chr(Int(Rnd*256))'+48)
        Next
        compare =  s
        length = len(s)
    else
        'modify compression to make further compression possible
       
        s = compress_loop(s)
       
    end if
    check = s
    compression = (100 - ( 100 / ( length / len(check) ) ))
   
    Print "original string"
    Print Len(s)
    Print
   
    Dim As String compressed=Zlibrary.pack(s)
    s = compressed
   
    Print "packed string "
    Print Len(compressed)
    Print
   
    Dim As String uncompressed=Zlibrary.unpack(compressed)
   
    Print "Retrieve"
    Print Len(uncompressed)
    Print
    'Print "compression ratio  "; 100 - ( 100 / ( Len(s) / len(compressed) ) ) ; "%"
    Print "compression ratio  "; 100 - ( 100 / ( length / len(s) ) ) ; "%"
    Print Iif(uncompressed=check,"OK","ERROR")
    Print "-------------------------------"
   
    'sleep 1000
   
    'if loops > 2 and (100 - ( 100 / ( length / len(s) ) )) < compression then exit do
   
    print "press a key for next compression." ; " loops = " ; loops ; " out of 40."
    print
    print "press esc to exit."
    sleep
   
    if inkey = chr(27) then exit do
   
loop until loops = 40

print "Press a key to decompress." 
sleep

s = str(loops) + "_" + s ' save as an output file...

'==================================================================
'decompress
'==================================================================
dim as longint dec = instr(1,s,"_")
dim as longint count = val(left(s,dec-1))
dim as string comp = mid(s,dec+1)
dim as string val1
dim as string outs
for a as longint = count to 2 step -1
    s = Zlibrary.unpack(comp)
    outs = decompress_loop(s)
    comp = outs
next

comp = Zlibrary.unpack(comp)

print
print "input = "; length , "output = " ; len(comp) , "compression ratio  "; 100 - ( 100 / ( length / len(s) ) ) ; "%"
print
if comp = compare then print "Decompression successful." else print "ERROR"
print
Print "!!~~Done~~!!"

Sleep
end
'===============================================================================
'===============================================================================
'begin functions
'===============================================================================
'================='==============================================================
Function compress_loop( chrs as string ) as string
   
    dim as string outs1=""
    dim as string zeros = string(20,"0")
    dim as ulongint n1
    dim as ulongint ptr ulp = cptr(ulongint ptr,strptr(chrs))
    for a as longint = 1 to len(chrs) step 8
        n1 = *ulp : ulp+=1
        outs1+=right( zeros + str(n1),20)
    next
   
    dim as string outputs=""
    dim as string num
    for a as longint = 1 to len(outs1) step 1
       
        num = bin(val(mid(outs1,a,1)))
       
        dim as longint count = 0
        for b as longint = 0 to len(num)-1 step 1
           
            if num[b] = 48 then outputs+=str(len(num)-b) : count = 1
           
        next
       
        if count = 0 then outputs+= "~"
       
    next
   
    return outputs
       
end function
'===============================================================================
'============================================================================
Function decompress_loop( chrs as string ) as string
   
    return chrs

end function



Here's the test bed , where i write the de-compressor.

Code: Select all


Declare Function      compress_loop( chrs as string ) as string
Declare Function decompress_loop( chrs as string ) as string

screen 19

dim as double time1 , time2 , time3 , time4
do
   
    randomize
   
    dim as string s=""
    For n As Long = 1 To 8
        s+=chr(Int(Rnd*256))'+8)
    Next
   
    time1=timer
    'begin compress
        dim as string comp = s
        'do
        '    dim as longint chk = len(comp) - 1
        '    comp = compress_loop(comp)
        '    if len(comp) >= chk then exit do
        'loop
       
        for a as longint = 1 to 1 step 1
            comp = compress_loop(comp)
        next
    'end compress
    time2 = timer
   
    time3=timer
    'begin decompress
        dim as string final_out = comp
        for a as longint = 1 to 1 step 1
            final_out = decompress_loop(final_out)
        next
    'end decompress
    time4 = timer
   
   'sleep
   
    'cls
    'draw string( 0,10) , left(s,100)
    'draw string( 0,30) , left(final_out,100)
    print string(99,"=")
    print "inp = " ; (s)
    print string(99,"=")
    print "out = " ; (final_out)
    print
    print "compress time   = "; time2-time1
    print "decompress time = "; time4-time3
    print
   
    if s = final_out then print "Decompressed OK" else print "Decompression failed."
    print string(99,"=")
   
    sleep
   
loop until inkey = chr(27)

sleep
end
'===============================================================================
'===============================================================================
'begin functions
'===============================================================================
'===============================================================================
Function compress_loop( chrs as string ) as string
   
    dim as string outs1=""
    dim as string zeros = string(20,"0")
    dim as ulongint n1
    dim as ulongint ptr ulp = cptr(ulongint ptr,strptr(chrs))
    for a as longint = 1 to len(chrs) step 8
        n1 = *ulp : ulp+=1
        outs1+=right( zeros + str(n1),20)
    next
   
    dim as string outputs=""
    dim as string num
    for a as longint = 1 to len(outs1) step 1
       
        num = bin(val(mid(outs1,a,1)))
       
        dim as longint count = 0
        for b as longint = 0 to len(num)-1 step 1
           
            if num[b] = 48 then outputs+=str(len(num)-b) : count = 1
           
        next
       
        if count = 0 then outputs+= "~"
       
    next
   
    print "c inp = " ; bin(valulng(outs1))
    print "c out = " ; outputs
   
   
    return outputs
       
end function
'===============================================================================
'============================================================================
Function decompress_loop( chrs as string ) as string
   
    return chrs

end function

albert
Posts: 5015
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Postby albert » Aug 04, 2019 19:46

@Dodicat

I finally got it this time... Achieved the impossible!!!!

See: compress_loop()

Code: Select all


Declare Function   compress_loop( chrs as string ) as string
Declare Function decompress_loop( chrs as string ) as string


Namespace Zlibrary

#inclib "zlib"
Extern "C"
    Declare Function compressBound(Byval sourceLen As Ulong) As Ulong
    Declare Function uncompress(Byval dest As Ubyte Ptr, Byval destLen As Uinteger Ptr, Byval source As  Ubyte Ptr, Byval sourceLen As Ulong) As Long
    Declare Function compress(Byval dest As Ubyte Ptr, Byval destLen As Uinteger Ptr, Byval source As  Ubyte Ptr, Byval sourceLen As Ulong) As Long
End Extern

Function getpassedinfo(text As String,Byref passed_length As Integer) As String
    Dim As String var1,var2
    Dim As Integer pst
    #macro splice(stri,char,var1,var2)
    pst=Instr(stri,char)
    var1="":var2=""
    If pst<>0 Then
        var1=Mid(stri,1,pst-1)
        var2=Mid(stri,pst+1)
    Else
        var1=stri
    End If
    #endmacro
    splice(text,"|",var1,var2)
    text=var2
    passed_length=Valint(var1)
    Return text
End Function


'=================   UNPACK ===============
Function unpack(file As String) As String
    Dim As Integer passed_length
    Dim As String text=getpassedinfo(file,passed_length)
    Dim As Integer stringlength,destinationlength
    stringlength=Len(text)
    destinationlength =passed_length
    Dim As Ubyte Ptr source
    Dim As Ubyte Ptr  destination =Callocate(destinationlength,1)
    source=@text[0]
    Var mistake=uncompress(destination,@destinationlength, source, stringlength)
    If mistake<>0 Then Print "There was an error":Sleep:End
    Dim As String uncompressed
    uncompressed=String(destinationlength,0)
    For i As Integer = 0 To destinationlength- 1
        uncompressed[i]=(destination[i])
    Next
    Deallocate destination
    Return uncompressed
End Function

'===================  PACK ============
Function pack(file As String) As String
    Dim As String text=file
    Dim As Integer stringlength,destinationlength
    stringlength=Len(text)
    destinationlength = compressBound(stringlength)
    Dim As Ubyte Ptr source
    Dim As Ubyte Ptr destination =Callocate(destinationlength,1)
    source=@text[0]
    Var mistake=compress(destination, @destinationlength, source, stringlength)
    If mistake <>0 Then Print "There was an error"
    Dim As String compressed
    compressed=String(destinationlength,0)
    For n As Integer=0 To destinationlength-1
        compressed[n]=destination[n]
    Next n
    compressed=stringlength &"|"+compressed
    Deallocate destination
    Return compressed
End Function

End Namespace


'==================================================================
'==================================================================
'test zipper
'==================================================================
'==================================================================
screen 19

Dim Shared As String s

Randomize

s=""
dim as string check=""
dim as string compare=""
dim as longint length = 0
dim as double compression = 0
dim as longint loops = 0
do
   
    loops+=1
   
    'one time run , create initial string
    if loops = 1 then
        For n As Long = 1 To 10000
            s+=chr(Int(Rnd*256))'+48)
        Next
        compare =  s
        length = len(s)
    else
        'modify compression to make further compression possible
       
        s = compress_loop(s)
       
    end if
    check = s
    compression = (100 - ( 100 / ( length / len(check) ) ))
   
    Print "original string"
    Print Len(s)
    Print
   
    Dim As String compressed=Zlibrary.pack(s)
    s = compressed
   
    Print "packed string "
    Print Len(compressed)
    Print
   
    Dim As String uncompressed=Zlibrary.unpack(compressed)
   
    Print "Retrieve"
    Print Len(uncompressed)
    Print
    'Print "compression ratio  "; 100 - ( 100 / ( Len(s) / len(compressed) ) ) ; "%"
    Print "compression ratio  "; 100 - ( 100 / ( length / len(s) ) ) ; "%"
    Print Iif(uncompressed=check,"OK","ERROR")
    Print "-------------------------------"
   
    'sleep 1000
   
    'if loops > 2 and (100 - ( 100 / ( length / len(s) ) )) < compression then exit do
   
    print "press a key for next compression." ; " loops = " ; loops ; " out of 40."
    print
    print "press esc to exit."
    sleep
   
    if inkey = chr(27) then exit do
   
loop until loops = 40

print "Press a key to decompress." 
sleep

s = str(loops) + "_" + s ' save as an output file...

'==================================================================
'decompress
'==================================================================
dim as longint dec = instr(1,s,"_")
dim as longint count = val(left(s,dec-1))
dim as string comp = mid(s,dec+1)
dim as string val1
dim as string outs
for a as longint = count to 2 step -1
    s = Zlibrary.unpack(comp)
    outs = decompress_loop(s)
    comp = outs
next

comp = Zlibrary.unpack(comp)

print
print "input = "; length , "output = " ; len(comp) , "compression ratio  "; 100 - ( 100 / ( length / len(s) ) ) ; "%"
print
if comp = compare then print "Decompression successful." else print "ERROR"
print
Print "!!~~Done~~!!"

Sleep
end
'===============================================================================
'===============================================================================
'begin functions
'===============================================================================
'================='==============================================================
Function compress_loop( chrs as string ) as string
   
    dim as string outs1=""
    dim as string zeros = string(22,"0")
    dim as ulongint n1
    dim as ulongint ptr ulp = cptr(ulongint ptr,strptr(chrs))
    for a as longint = 1 to len(chrs) step 8
        n1 = *ulp : ulp+=1
        outs1+=right( zeros + oct(n1),22)
    next
   
    dim as string outputs=""
    dim as string num
    for a as longint = 1 to len(outs1) step 1
       
        'num = right(string(4,"0") + bin(val("&O"+oct(val(mid(outs1,a,1))))),4)
       
        num = mid(outs1,a,1)
        num = bin(val(num))
        num = right("000" + num,3)

        dim as longint count=0
        for b as longint = 0 to len(num)-1 step 1
           
            if num[b] = 49 then outputs+=right("00"+bin(2-b),2) : count=1
           
        next
       
       if count = 0 then outputs+="11"
       
    next
   
    dim as string final=""
    for a as longint = 1 to len(outputs) step 8
        final+=chr(val("&B"+mid(outputs,a,8)))
    next
       
    return final
       
end function
'===============================================================================
'============================================================================
Function decompress_loop( chrs as string ) as string
   
    return chrs

end function

albert
Posts: 5015
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Postby albert » Aug 04, 2019 20:33

Now I got to speed it up...It takes like 5 minutes , to compress a megabyte..
albert
Posts: 5015
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Postby albert » Aug 04, 2019 20:45

Got the speed doubled.. But it's still too slow..

Code: Select all


Declare Function   compress_loop( chrs as string ) as string
Declare Function decompress_loop( chrs as string ) as string


Namespace Zlibrary

#inclib "zlib"
Extern "C"
    Declare Function compressBound(Byval sourceLen As Ulong) As Ulong
    Declare Function uncompress(Byval dest As Ubyte Ptr, Byval destLen As Uinteger Ptr, Byval source As  Ubyte Ptr, Byval sourceLen As Ulong) As Long
    Declare Function compress(Byval dest As Ubyte Ptr, Byval destLen As Uinteger Ptr, Byval source As  Ubyte Ptr, Byval sourceLen As Ulong) As Long
End Extern

Function getpassedinfo(text As String,Byref passed_length As Integer) As String
    Dim As String var1,var2
    Dim As Integer pst
    #macro splice(stri,char,var1,var2)
    pst=Instr(stri,char)
    var1="":var2=""
    If pst<>0 Then
        var1=Mid(stri,1,pst-1)
        var2=Mid(stri,pst+1)
    Else
        var1=stri
    End If
    #endmacro
    splice(text,"|",var1,var2)
    text=var2
    passed_length=Valint(var1)
    Return text
End Function


'=================   UNPACK ===============
Function unpack(file As String) As String
    Dim As Integer passed_length
    Dim As String text=getpassedinfo(file,passed_length)
    Dim As Integer stringlength,destinationlength
    stringlength=Len(text)
    destinationlength =passed_length
    Dim As Ubyte Ptr source
    Dim As Ubyte Ptr  destination =Callocate(destinationlength,1)
    source=@text[0]
    Var mistake=uncompress(destination,@destinationlength, source, stringlength)
    If mistake<>0 Then Print "There was an error":Sleep:End
    Dim As String uncompressed
    uncompressed=String(destinationlength,0)
    For i As Integer = 0 To destinationlength- 1
        uncompressed[i]=(destination[i])
    Next
    Deallocate destination
    Return uncompressed
End Function

'===================  PACK ============
Function pack(file As String) As String
    Dim As String text=file
    Dim As Integer stringlength,destinationlength
    stringlength=Len(text)
    destinationlength = compressBound(stringlength)
    Dim As Ubyte Ptr source
    Dim As Ubyte Ptr destination =Callocate(destinationlength,1)
    source=@text[0]
    Var mistake=compress(destination, @destinationlength, source, stringlength)
    If mistake <>0 Then Print "There was an error"
    Dim As String compressed
    compressed=String(destinationlength,0)
    For n As Integer=0 To destinationlength-1
        compressed[n]=destination[n]
    Next n
    compressed=stringlength &"|"+compressed
    Deallocate destination
    Return compressed
End Function

End Namespace


'==================================================================
'==================================================================
'test zipper
'==================================================================
'==================================================================
screen 19

Dim Shared As String s

Randomize

s=""
dim as string check=""
dim as string compare=""
dim as longint length = 0
dim as double compression = 0
dim as longint loops = 0
do
   
    loops+=1
   
    'one time run , create initial string
    if loops = 1 then
        For n As Long = 1 To 10000
            s+=chr(Int(Rnd*256))'+48)
        Next
        compare =  s
        length = len(s)
    else
        'modify compression to make further compression possible
       
        s = compress_loop(s)
       
    end if
    check = s
    compression = (100 - ( 100 / ( length / len(check) ) ))
   
    Print "original string"
    Print Len(s)
    Print
   
    Dim As String compressed=Zlibrary.pack(s)
    s = compressed
   
    Print "packed string "
    Print Len(compressed)
    Print
   
    Dim As String uncompressed=Zlibrary.unpack(compressed)
   
    Print "Retrieve"
    Print Len(uncompressed)
    Print
    'Print "compression ratio  "; 100 - ( 100 / ( Len(s) / len(compressed) ) ) ; "%"
    Print "compression ratio  "; 100 - ( 100 / ( length / len(s) ) ) ; "%"
    Print Iif(uncompressed=check,"OK","ERROR")
    Print "-------------------------------"
   
    'sleep 1000
   
    'if loops > 2 and (100 - ( 100 / ( length / len(s) ) )) < compression then exit do
   
    print "press a key for next compression." ; " loops = " ; loops ; " out of 40."
    print
    print "press esc to exit."
    sleep
   
    if inkey = chr(27) then exit do
   
loop until loops = 40

print "Press a key to decompress." 
sleep

s = str(loops) + "_" + s ' save as an output file...

'==================================================================
'decompress
'==================================================================
dim as longint dec = instr(1,s,"_")
dim as longint count = val(left(s,dec-1))
dim as string comp = mid(s,dec+1)
dim as string val1
dim as string outs
for a as longint = count to 2 step -1
    s = Zlibrary.unpack(comp)
    outs = decompress_loop(s)
    comp = outs
next

comp = Zlibrary.unpack(comp)

print
print "input = "; length , "output = " ; len(comp) , "compression ratio  "; 100 - ( 100 / ( length / len(s) ) ) ; "%"
print
if comp = compare then print "Decompression successful." else print "ERROR"
print
Print "!!~~Done~~!!"

Sleep
end
'===============================================================================
'===============================================================================
'begin functions
'===============================================================================
'================='==============================================================
Function compress_loop( chrs as string ) as string
   
    dim as string outs1=""
    dim as string zeros = string(64,"0")
    dim as ulongint n1
    dim as ulongint ptr ulp = cptr(ulongint ptr,strptr(chrs))
    for a as longint = 1 to len(chrs) step 8
        n1 = *ulp : ulp+=1
        outs1+=right( zeros + bin(n1),64)
    next
   
    dim as string outputs=""
    dim as string num
    for a as longint = 1 to len(outs1) step 3
       
        num = mid(outs1,a,3)
       
        if num = "000" then outputs+="11"  ' all 0's
        if num = "001" then outputs+="00"  ' bit 1 set
        if num = "010" then outputs+="01"   'bit2 set
        if num = "011" then outputs+="0100" ' bits 2 and 1 set
        if num = "100" then outputs+="10"      ' bit 3 set
        if num = "101" then outputs+="1000"  ' bits 3 and 1 set
        if num = "110" then outputs+="1001"   ' bits 3 and 2 set
        if num = "111" then outputs+="100100" ' bits 3 2 1 set
       
    next
   
    dim as string final=""
    for a as longint = 1 to len(outputs) step 8
        final+=chr(val("&B"+mid(outputs,a,8)))
    next
       
    return final
       
end function
'===============================================================================
'============================================================================
Function decompress_loop( chrs as string ) as string
   
    return chrs

end function



EDITED!!!

Return to “General”

Who is online

Users browsing this forum: MSN [Bot] and 18 guests