## Squares

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

### Re: Squares

I tried to make it so you cant have any combos that equal other combos...

I modified the outputs , to make it easier to separate 3 bits vals , from 4 bit vals.

s1 = mid(bits,a,4)

if s1 = "0000" then outs1+="100"
if s1 = "0001" then outs1+="101"
if s1 = "0010" then outs1+="110"
if s1 = "0011" then outs1+="111"
if s1 = "0100" then outs1+="1001"
if s1 = "0101" then outs1+="1011"
if s1 = "0110" then outs1+="1101"

if s1 = "0111" then outs1+="0000"
if s1 = "1000" then outs1+="0001"
if s1 = "1001" then outs1+="0010"
if s1 = "1010" then outs1+="0011"
if s1 = "1011" then outs1+="0100"
if s1 = "1100" then outs1+="0101"
if s1 = "1101" then outs1+="0110"
if s1 = "1110" then outs1+="0111"

if s1 = "1111" then outs1+="1100"

Code: Select all

`Declare Function      compress_loop( chrs as string ) as stringDeclare Function decompress_loop( chrs as string ) as stringscreen 19dim as double time1 , time2 , time3 , time4dim shared as ubyte show = 1 'if doing larger than 8 bytes set show to 0do       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        if show = 0 then            do                dim as longint chk = len(comp) - 1                comp = compress_loop(comp)                if len(comp) >= chk then exit do            loop        else            for a as longint = 1 to 1 step 1                comp = compress_loop(comp)            next        end if    '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)sleepend'==============================================================================='==============================================================================='begin functions'==============================================================================='===============================================================================Function compress_loop( chrs as string ) as string       dim as string bits = ""    dim as string zeros = string(64,"0")    dim as ulongint ptr ulp = cptr(ulongint ptr,strptr(chrs))    dim as string n1    for a as longint = 1 to len(chrs) step 8        n1 = zeros + bin(*ulp) : ulp+=1        bits+=right(n1,64)    next        if show = 1 then print "c inp = "; len(bits) , bits    dim as string outs1=""    dim as string s1    for a as longint = 1 to len(bits) step 4                s1 = mid(bits,a,4)                if s1 = "0000" then outs1+="100"        if s1 = "0001" then outs1+="101"        if s1 = "0010" then outs1+="110"        if s1 = "0011" then outs1+="111"        if s1 = "0100" then outs1+="1001"        if s1 = "0101" then outs1+="1011"        if s1 = "0110" then outs1+="1101"                if s1 = "0111" then outs1+="0000"        if s1 = "1000" then outs1+="0001"        if s1 = "1001" then outs1+="0010"        if s1 = "1010" then outs1+="0011"        if s1 = "1011" then outs1+="0100"        if s1 = "1100" then outs1+="0101"        if s1 = "1101" then outs1+="0110"        if s1 = "1110" then outs1+="0111"                if s1 = "1111" then outs1+="1100"            next        if show = 1 then print "c out = "; len(outs1) , outs1        dim as longint count=0    dim as string str1    dim as longint dec1    do        str1=str(len(outs1)/8)        dec1=instr(1,str1,".")        if dec1<>0 then outs1+="0" : count+=1    loop until dec1=0        dim as string final = ""    for a as longint = 1 to len(outs1) step 8        final+=chr(val("&B"+mid(outs1,a,8)))    next        final = chr(count) + final        print "c fin = "; len(final) ' , final       return final   end function'==============================================================================='============================================================================Function decompress_loop( chrs as string ) as string        dim as longint count = asc(left(chrs,1))    chrs = mid(chrs,2)    dim as string bits = ""    dim as string zeros = string(8,"0")    dim as string n1    for a as longint = 1 to len(chrs) step 1        n1 = zeros + bin( chrs[a-1] )        bits+=right(n1,8)    next        bits = left(bits,len(bits)-count)        if show = 1 then print "d inp = "; len(bits) , bits       return chrsend function`
albert
Posts: 5676
Joined: Sep 28, 2006 2:41
Location: California, USA

### DATA COMPRESSION

@Dodicat

I redid it again...

if it starts with a 0 then you know its 4 bits. If it starts with a 1 , it could be a 4 or 5

just telling 100 from 1000 and 1001 , and telling 101 from 1010 and 1011

Compresses 1,000,000 bytes , down to 3 digits....

s1 = mid(bits,a,4)

if s1 = "0000" then outs1+="100"
if s1 = "0001" then outs1+="101"
if s1 = "0010" then outs1+="110"
if s1 = "0011" then outs1+="111"

if s1 = "0100" then outs1+="0000"
if s1 = "0101" then outs1+="0001"
if s1 = "0110" then outs1+="0010"
if s1 = "0111" then outs1+="0011"
if s1 = "1000" then outs1+="0100"
if s1 = "1001" then outs1+="0101"
if s1 = "1010" then outs1+="0110"
if s1 = "1011" then outs1+="0111"

if s1 = "1100" then outs1+="1000"
if s1 = "1101" then outs1+="1001"
if s1 = "1110" then outs1+="1010"
if s1 = "1111" then outs1+="1011"

Code: Select all

`Declare Function      compress_loop( chrs as string ) as stringDeclare Function decompress_loop( chrs as string ) as stringscreen 19dim as double time1 , time2 , time3 , time4dim shared as ubyte show = 1 'if doing larger than 8 bytes set show to 0do       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        if show = 0 then            do                dim as longint chk = len(comp) - 1                comp = compress_loop(comp)                if len(comp) >= chk then exit do            loop        else            for a as longint = 1 to 1 step 1                comp = compress_loop(comp)            next        end if    '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)sleepend'==============================================================================='==============================================================================='begin functions'==============================================================================='===============================================================================Function compress_loop( chrs as string ) as string       dim as string bits = ""    dim as string zeros = string(64,"0")    dim as ulongint ptr ulp = cptr(ulongint ptr,strptr(chrs))    dim as string n1    for a as longint = 1 to len(chrs) step 8        n1 = zeros + bin(*ulp) : ulp+=1        bits+=right(n1,64)    next        if show = 1 then print "c inp = "; len(bits) , bits    dim as string outs1=""    dim as string s1    for a as longint = 1 to len(bits) step 4                s1 = mid(bits,a,4)                if s1 = "0000" then outs1+="100"        if s1 = "0001" then outs1+="101"        if s1 = "0010" then outs1+="110"        if s1 = "0011" then outs1+="111"                if s1 = "0100" then outs1+="0000"        if s1 = "0101" then outs1+="0001"        if s1 = "0110" then outs1+="0010"        if s1 = "0111" then outs1+="0011"        if s1 = "1000" then outs1+="0100"        if s1 = "1001" then outs1+="0101"        if s1 = "1010" then outs1+="0110"        if s1 = "1011" then outs1+="0111"                if s1 = "1100" then outs1+="1000"        if s1 = "1101" then outs1+="1001"        if s1 = "1110" then outs1+="1010"        if s1 = "1111" then outs1+="1011"            next        if show = 1 then print "c out = "; len(outs1) , outs1        dim as longint count=0    dim as string str1    dim as longint dec1    do        str1=str(len(outs1)/8)        dec1=instr(1,str1,".")        if dec1<>0 then outs1+="0" : count+=1    loop until dec1=0        dim as string final = ""    for a as longint = 1 to len(outs1) step 8        final+=chr(val("&B"+mid(outs1,a,8)))    next        final = chr(count) + final        print "c fin = "; len(final) ' , final       return final   end function'==============================================================================='============================================================================Function decompress_loop( chrs as string ) as string        dim as longint count = asc(left(chrs,1))    chrs = mid(chrs,2)    dim as string bits = ""    dim as string zeros = string(8,"0")    dim as string n1    for a as longint = 1 to len(chrs) step 1        n1 = zeros + bin( chrs[a-1] )        bits+=right(n1,8)    next        bits = left(bits,len(bits)-count)        if show = 1 then print "d inp = "; len(bits) , bits       return chrsend function`
albert
Posts: 5676
Joined: Sep 28, 2006 2:41
Location: California, USA

### Re: Squares

@Dodicat

I tried reversing it , putting the "100" , "101" , "110" , "111" at the bottom , and it only compresses 50%..

So i have to try it on real files...
albert
Posts: 5676
Joined: Sep 28, 2006 2:41
Location: California, USA

### Re: Squares

@Dodicat

Here it is on real files...

You can play with it all you like , it doesn't write to the hard drive....

Compresses *.ZIP files down to under 200 bytes...

I tried it on a 6 megabyte *.mp3 file , and it compressed down to 97 bytes....So it's worth trying to work out..

Code: Select all

`#define WIN_INCLUDEALL#Include "windows.bi"#Include "File.bi"declare sub getfilename()Declare Function      compress_loop( chrs as string ) as stringDeclare Function decompress_loop( chrs as string ) as stringdim shared as string file , extension , file_data , bytes , file_namedim as ubyte value1Dim As MSG msgDim shared As HWND hWndscreen 19'====================================================================='====================================================================='get file'====================================================================='=====================================================================getfilename()if FileExists(file) then        print "Loading file ... please wait.."        for a as ulongint = len(file)-1 to 0 step -1        bytes=chr(file[a])        if bytes = "\" then file_name = mid(file,a+2):exit for    next       print file_name    file_data = ""    open file for binary as #1        do            get #1,,value1            file_data = file_data + chr(value1)        loop until eof(1)    close #1        print "File loaded... Compressing.."     end if'====================================================================='====================================================================='start program'====================================================================='=====================================================================dim as double time1 , time2 , time3 , time4dim shared as ubyte show = 0 'if doing larger than 8 bytes set show to 0do       randomize       dim as string s= file_data    'For n As Long = 1 To 8    '   s+=chr(Int(Rnd*256))'+8)    'Next       time1=timer    'begin compress        dim as string comp = s        if show = 0 then            do                dim as longint chk = len(comp) - 1                comp = compress_loop(comp)                if len(comp) >= chk then exit do            loop        else            for a as longint = 1 to 1 step 1                comp = compress_loop(comp)            next        end if    '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)sleepend'==============================================================================='==============================================================================='compress'==============================================================================='===============================================================================Function compress_loop( chrs as string ) as string       dim as string bits = ""    dim as string zeros = string(64,"0")    dim as ulongint ptr ulp = cptr(ulongint ptr,strptr(chrs))    dim as string n1    for a as longint = 1 to len(chrs) step 8        n1 = zeros + bin(*ulp) : ulp+=1        bits+=right(n1,64)    next        if show = 1 then print "c inp = "; len(bits) , bits    dim as string outs1=""    dim as string s1    for a as longint = 1 to len(bits) step 4                s1 = mid(bits,a,4)                if s1 = "0000" then outs1+="100"        if s1 = "0001" then outs1+="101"        if s1 = "0010" then outs1+="110"        if s1 = "0011" then outs1+="111"                if s1 = "0100" then outs1+="0000"        if s1 = "0101" then outs1+="0001"        if s1 = "0110" then outs1+="0010"        if s1 = "0111" then outs1+="0011"        if s1 = "1000" then outs1+="0100"        if s1 = "1001" then outs1+="0101"        if s1 = "1010" then outs1+="0110"        if s1 = "1011" then outs1+="0111"                if s1 = "1100" then outs1+="1000"        if s1 = "1101" then outs1+="1001"        if s1 = "1110" then outs1+="1010"        if s1 = "1111" then outs1+="1011"            next        if show = 1 then print "c out = "; len(outs1) , outs1        dim as longint count=0    dim as string str1    dim as longint dec1    do        str1=str(len(outs1)/8)        dec1=instr(1,str1,".")        if dec1<>0 then outs1+="0" : count+=1    loop until dec1=0        dim as string final = ""    for a as longint = 1 to len(outs1) step 8        final+=chr(val("&B"+mid(outs1,a,8)))    next        final = chr(count) + final        print "c fin = "; len(final) ' , final       return final   end function'============================================================================'============================================================================'decompress'============================================================================'============================================================================Function decompress_loop( chrs as string ) as string        dim as longint count = asc(left(chrs,1))    chrs = mid(chrs,2)    dim as string bits = ""    dim as string zeros = string(8,"0")    dim as string n1    for a as longint = 1 to len(chrs) step 1        n1 = zeros + bin( chrs[a-1] )        bits+=right(n1,8)    next        bits = left(bits,len(bits)-count)        if show = 1 then print "d inp = "; len(bits) , bits       return chrsend function'==============================================================================='==============================================================================='Get File Name'==============================================================================='===============================================================================sub getfilename()        dim ofn as OPENFILENAME        dim filename as zstring * MAX_PATH+1               with ofn                .lStructSize            = sizeof( OPENFILENAME )                .hwndOwner              = hWnd                .hInstance              = GetModuleHandle( NULL )                .lpstrFilter            = strptr( !"All Files, (*.*)\0*.*\0\0" )                .lpstrCustomFilter      = NULL                .nMaxCustFilter         = 0                .nFilterIndex           = 1                .lpstrFile              = @filename                .nMaxFile               = sizeof( filename )                .lpstrFileTitle         = NULL                .nMaxFileTitle          = 0                .lpstrInitialDir        = NULL                '.lpstrTitle            = @"File Open Test"                .lpstrTitle             = @"File to Compress/Decompress"                .Flags                  = OFN_EXPLORER 'or OFN_FILEMUSTEXIST or OFN_PATHMUSTEXIST                .nFileOffset            = 0                .nFileExtension         = 0                .lpstrDefExt            = NULL                .lCustData              = 0                .lpfnHook               = NULL                .lpTemplateName         = NULL        end with               if( GetOpenFileName( @ofn ) = FALSE ) then            file = ""            return        else            file = filename            extension = right(filename,4)    end ifend sub`
albert
Posts: 5676
Joined: Sep 28, 2006 2:41
Location: California, USA

### Re: Squares

Here's some of my songs i had demo'd.... It cost me \$325 a piece to get the lyrics put to music..

https://soundcloud.com/user-704620747

I spent a couple thousand on different demo companies....
And "Pearl Snap Studios".. Is the best bet..

https://www.pearlsnapstudios.com/

They turn out the best music and vocals...So if you got poetry and want it put to music , try pearl snap..
albert
Posts: 5676
Joined: Sep 28, 2006 2:41
Location: California, USA

### DATA COMPRESSION

@Dodicat

I made some modifications.....it's still the same compression formula... I just modified how the program works..

Code: Select all

`#define WIN_INCLUDEALL#Include "windows.bi"#Include "File.bi"declare sub getfilename()Declare Function      compress_loop( chrs as string ) as stringDeclare Function decompress_loop( chrs as string ) as stringdim shared as string file , extension , file_data , bytes , file_namedim as ubyte value1Dim As MSG msgDim shared As HWND hWndscreen 19'====================================================================='====================================================================='get file'====================================================================='=====================================================================getfilename()if FileExists(file) then        print "Loading file ... please wait.."        for a as ulongint = len(file)-1 to 0 step -1        bytes=chr(file[a])        if bytes = "\" then file_name = mid(file,a+2):exit for    next        file_data = ""    open file for binary as #1        print file_name ; "  " ; lof(1)        do            get #1,,value1            file_data = file_data + chr(value1)        loop until eof(1)    close #1        print "File loaded... Compressing.."     end if'====================================================================='====================================================================='start program'====================================================================='=====================================================================dim as double time1 , time2 , time3 , time4dim shared as ubyte show = 0  ' if doing larger than 8 bytes or opening a file , then set show to 0do        randomize       dim as string s = ""    if len(file_data) > 0 then         s = file_data    else        For n As Long = 1 To 8            s+=chr(Int(Rnd*256))        Next   end if       time1=timer    'begin compress        dim as string comp = s        if show = 0 then            do                dim as longint chk = len(comp) - 1                comp = compress_loop(comp)                if len(comp) >= chk then exit do            loop        else            for a as longint = 1 to 1 step 1                comp = compress_loop(comp)            next        end if    '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) or show = 0sleepend'==============================================================================='==============================================================================='compress'==============================================================================='===============================================================================Function compress_loop( chrs as string ) as string       dim as string bits = ""    dim as string zeros = string(64,"0")    dim as ulongint ptr ulp = cptr(ulongint ptr,strptr(chrs))    dim as string n1    for a as longint = 1 to len(chrs) step 8        n1 = zeros + bin(*ulp) : ulp+=1        bits+=right(n1,64)    next        if show = 1 then print "c inp = "; len(bits) , bits    dim as string outs1=""    dim as string s1    for a as longint = 1 to len(bits) step 4                s1 = mid(bits,a,4)                if s1 = "0000" then outs1+="100"        if s1 = "0001" then outs1+="101"        if s1 = "0010" then outs1+="110"        if s1 = "0011" then outs1+="111"                if s1 = "0100" then outs1+="0000"        if s1 = "0101" then outs1+="0001"        if s1 = "0110" then outs1+="0010"        if s1 = "0111" then outs1+="0011"        if s1 = "1000" then outs1+="0100"        if s1 = "1001" then outs1+="0101"        if s1 = "1010" then outs1+="0110"        if s1 = "1011" then outs1+="0111"                if s1 = "1100" then outs1+="1000"        if s1 = "1101" then outs1+="1001"        if s1 = "1110" then outs1+="1010"        if s1 = "1111" then outs1+="1011"            next        if show = 1 then print "c out = "; len(outs1) , outs1        dim as longint count=0    dim as string str1    dim as longint dec1    do        str1=str(len(outs1)/8)        dec1=instr(1,str1,".")        if dec1<>0 then outs1+="0" : count+=1    loop until dec1=0        dim as string final = ""    for a as longint = 1 to len(outs1) step 8        final+=chr(val("&B"+mid(outs1,a,8)))    next        final = chr(count) + final        print "c fin = "; len(final) ' , final       return final   end function'============================================================================'============================================================================'decompress'============================================================================'============================================================================Function decompress_loop( chrs as string ) as string        dim as longint count = asc(left(chrs,1))    chrs = mid(chrs,2)    dim as string bits = ""    dim as string zeros = string(8,"0")    dim as string n1    for a as longint = 1 to len(chrs) step 1        n1 = zeros + bin( chrs[a-1] )        bits+=right(n1,8)    next        bits = left(bits,len(bits)-count)        if show = 1 then print "d inp = "; len(bits) , bits       return chrsend function'==============================================================================='==============================================================================='Get File Name'==============================================================================='===============================================================================sub getfilename()        dim ofn as OPENFILENAME        dim filename as zstring * MAX_PATH+1               with ofn                .lStructSize            = sizeof( OPENFILENAME )                .hwndOwner              = hWnd                .hInstance              = GetModuleHandle( NULL )                .lpstrFilter            = strptr( !"All Files, (*.*)\0*.*\0\0" )                .lpstrCustomFilter      = NULL                .nMaxCustFilter         = 0                .nFilterIndex           = 1                .lpstrFile              = @filename                .nMaxFile               = sizeof( filename )                .lpstrFileTitle         = NULL                .nMaxFileTitle          = 0                .lpstrInitialDir        = NULL                '.lpstrTitle            = @"File Open Test"                .lpstrTitle             = @"File to Compress/Decompress"                .Flags                  = OFN_EXPLORER 'or OFN_FILEMUSTEXIST or OFN_PATHMUSTEXIST                .nFileOffset            = 0                .nFileExtension         = 0                .lpstrDefExt            = NULL                .lCustData              = 0                .lpfnHook               = NULL                .lpTemplateName         = NULL        end with               if( GetOpenFileName( @ofn ) = FALSE ) then            file = ""            return        else            file = filename            extension = right(filename,4)    end ifend sub`
dodicat
Posts: 6493
Joined: Jan 10, 2006 20:30
Location: Scotland

### Re: Rainbow Peak.

Hi Albert.
Tested on fb 1.7, still wrong decompress.
...
I have updated 3D surface plot.
I like your music very much.
Anyway, you can change the function (within reason) in InputFunction:
using fb 1.7

Code: Select all

` Type V3    As Single x,y,zEnd TypeOperator -(v1 As v3,v2 As v3) As v3 'v1-v2 Return Type(v1.x-v2.x,v1.y-v2.y,v1.z-v2.z)End OperatorOperator ^ (Byref v1 As v3,Byref v2 As v3) As v3 'cross productReturn Type(v1.y*v2.z-v2.y*v1.z,-(v1.x*v2.z-v2.x*v1.z),v1.x*v2.y-v2.x*v1.y)End OperatorType float As V3Type box    As v3 p(1 To 4)    As Ulong c    'colour    As Single zEnd TypeType angle3D             'FLOATS for angles    As Single sx,sy,sz    As Single cx,cy,cz    Declare Static Function construct(As Single,As Single,As Single) As Angle3DEnd TypeDeclare Function InputFunction(x As Double,y As Double) As DoubleDim As Integer wx,wyScreeninfo wx,wywy=.9*wyScreenres wy,wy,32,2Width wy\8,wy\16 'max dos font sizeColor ,Rgb(100,100,100)'============ globals =============Const pi=4*Atn(1)Redim Shared As box b()Redim Shared As box rot1()Dim Shared As Angle3D A3dDim Shared As V3 CC       'grid centreDim Shared As Single MinXDim Shared As Single MaxXDim Shared As Single MinYDim Shared As Single MaxYDim Shared As Integer xres,yresScreeninfo xres,yres'================================== functions ================Sub QsortZ(array() As box,begin As Long,Finish As Long)    Dim As Long i=begin,j=finish    Dim As box x =array(((I+J)\2))    While I <= J        While array(I).z > X.z:I+=1:Wend            While array(J).z < X.z:J-=1:Wend                If I<=J Then Swap array(I),array(J): I+=1:J-=1            Wend            If J >begin Then QsortZ(array(),begin,J)            If I <Finish Then QsortZ(array(),I,Finish)        End Sub                Function Angle3D.construct(x As Single,y As Single,z As Single) As Angle3D            Return   Type (Sin(x),Sin(y),Sin(z), _            Cos(x),Cos(y),Cos(z))        End Function                Function Rotate(c As V3,p As V3,a As Angle3D,scale As float=Type(1,1,1)) As V3            Dim As Single dx=p.x-c.x,dy=p.y-c.y,dz=p.z-c.z            Return Type<V3>((scale.x)*((a.cy*a.cz)*dx+(-a.cx*a.sz+a.sx*a.sy*a.cz)*dy+(a.sx*a.sz+a.cx*a.sy*a.cz)*dz)+c.x,_            (scale.y)*((a.cy*a.sz)*dx+(a.cx*a.cz+a.sx*a.sy*a.sz)*dy+(-a.sx*a.cz+a.cx*a.sy*a.sz)*dz)+c.y,_            (scale.z)*((-a.sy)*dx+(a.sx*a.cy)*dy+(a.cx*a.cy)*dz)+c.z)        End Function                 Function perspective(p As V3,eyepoint As V3) As V3            Dim As Single   w=1+(p.z/eyepoint.z)            If w=0 Then w=1e-6            Return Type<V3>((p.x-eyepoint.x)/w+eyepoint.x,_            (p.y-eyepoint.y)/w+eyepoint.y,_            (p.z-eyepoint.z)/w+eyepoint.z)        End Function                Function dot(v1 As v3,v2 As v3) As Single             Dim As Single d1=Sqr(v1.x*v1.x + v1.y*v1.y + v1.z*v1.z)            Dim As Single d2=Sqr(v2.x*v2.x + v2.y*v2.y + v2.z*v2.z)            Dim As Single v1x=v1.x/d1,v1y=v1.y/d1,v1z=v1.z/d1 'normalize            Dim As Single v2x=v2.x/d2,v2y=v2.y/d2,v2z=v2.z/d2 'normalize            Return v1x*v2x+v1y*v2y+v1z*v2z  'dot product        End Function                Function map(a As Single,b As Single,x As Single,c As Single,d As Single) As Single            Return ((d)-(c))*((x)-(a))/((b)-(a))+(c)        End Function                Function rainbow( x As Single ) As Ulong 'idea from bluatigro            #define rad(n) (pi/180)*(n)            Dim As Ulong r , g , b            r = Sin( rad( x ) ) * 127 + 128            g = Sin( rad( x - 120 ) ) * 127 + 128            b = Sin( rad( x + 120 ) ) * 127 + 128            Return Rgb( r And 255 , g And 255 , b And 255 )        End Function                 Function setgrid(sx As Single,bx As Single,sy As Single,by As Single,st As Single,p() As box,fn As Function(x As Double,y As Double=0) As Double) As v3            #define U Ubound(p)            Redim p(0)            Dim As Single cx,cy,cz,ctr            Static As Single q=15            Var sttx=st*(MaxX-MinX)/(bx-sx)            Var stty=st*(MaxY-MinY)/(by-sy)            For y As Single=sy To by+st/2 Step st                For x As Single=sx To bx+st/2 Step st                    Redim Preserve p(1 To U+1)                    Var lx=map(sx,bx,x,MinX,MaxX)                    Var ly=map(sy,by,y,MinY,MaxY)                                        'temp adjust to use limits for .z                    p(u).p(1)=Type<v3>(lx,ly,          fn(p(u).p(1).x,p(u).p(1).y))                    p(u).p(2)=Type<v3>(lx+sttx,ly,     fn(p(u).p(2).x,p(u).p(2).y))                    p(u).p(3)=Type<v3>(lx+sttx,ly+stty,fn(p(u).p(3).x,p(u).p(3).y))                    p(u).p(4)=Type<v3>(lx,ly+stty,     fn(p(u).p(4).x,p(u).p(4).y))                    're set                    p(u).p(1).x=x:     p(u).p(1).y=y                    p(u).p(2).x=x+st:  p(u).p(2).y=y                    p(u).p(3).x=x+st:  p(u).p(3).y=y+st                    p(u).p(4).x=x:     p(u).p(4).y=y+st                                        'p(u).c=Rgb(x*q, x*q xor y*q,y*q) 'another colour option                    p(u).c=rainbow(((bx/2-x)*(by/2-y)))                Next x            Next y            Dim As Integer x,y            Screeninfo x,y                        For n As Long=Lbound(p) To Ubound(p)                For g As Long=1 To 4                    ctr+=1                    Var xx =map(sx,bx,p(n).p(g).x,.2*x,.8*x)                    Var yy =map(sy,by,p(n).p(g).y,.2*y,.8*y)                    p(n).p(g).x=xx                    p(n).p(g).y=yy                    cx+=xx                    cy+=yy                    cz+= p(n).p(g).z                Next g            Next n                        Return Type(cx/ctr,cy/ctr,cz/ctr)'centre        End Function                Sub fill(p() As v3,c As Ulong,im As Any Ptr=0)            Dim As Long Sy=1e8,By=-1e8,i            Redim As Long a(Ubound(p)-Lbound(p)+1,1)            Dim As Long ctr            For i =Lbound(p) To Ubound(p)                a(ctr,0)=p(i).x                a(ctr,1)=p(i).y                If Sy>p(i).y Then Sy=p(i).y                If By<p(i).y Then By=p(i).y                ctr+=1            Next i            Dim As Long j,k,dy,dx,x,y,xi(Ubound(a,1))            Dim As Single S(Ubound(a,1))            a(Ubound(a,1),0) = a(0,0)            a(Ubound(a,1),1) = a(0,1)            For i=0 To Ubound(a,1)-1                dy=a(i+1,1)-a(i,1)                dx=a(i+1,0)-a(i,0)                If dy=0 Then S(i)=1                If dx=0 Then S(i)=0                If dy<>0 Andalso dx<>0 Then S(i)=dx/dy            Next i            For y=Sy-1 To By+1                k=0                For i=0 To Ubound(a,1)-1                    If (a(i,1)<=y Andalso a(i+1,1)>y) Orelse _                    (a(i,1)>y Andalso a(i+1,1)<=y) Then                    xi(k)=(a(i,0)+S(i)*(y-a(i,1)))                    k+=1                End If            Next i            For j=0 To k-2                For i=0 To k-2                    If xi(i)>xi(i+1) Then Swap xi(i),xi(i+1)                Next i            Next j            For i = 0 To k - 2 Step 2                Line im,(xi(i),y)-(xi(i+1)+1,y),c            Next i        Next y    End Sub        Sub drawboxes(b() As box)        Redim As Long a()        For n As Long=Lbound(b) To Ubound(b)            Var rd=Cast(Ubyte Ptr,@b(n).c)            Var gr=Cast(Ubyte Ptr,@b(n).c)            Var bl=Cast(Ubyte Ptr,@b(n).c)            Dim As v3 screencentre=(xres\2,yres\2)            Var v1=b(n).p(2)-b(n).p(1)            Var v2=b(n).p(3)-b(n).p(2)            Var norm=v1^v2 'cross product            Var dt=dot(norm,Type(1,0,0))            Var f=map(-1,1,dt,.2,1)            fill(b(n).p(),Rgb(f*rd,f*gr,f*bl))        Next    End Sub        Function Regulate(Byval MyFps As Long,Byref fps As Long) As Long        Static As Double timervalue,_lastsleeptime,t3,frames        frames+=1        If (Timer-t3)>=1 Then t3=Timer:fps=frames:frames=0        Var sleeptime=_lastsleeptime+((1/myfps)-Timer+timervalue)*1000        If sleeptime<1 Then sleeptime=1        _lastsleeptime=sleeptime        timervalue=Timer        Return sleeptime    End Function        Sub setup(x1 As Single,x2 As Single,y1 As Single,y2 As Single,meshsize As Single)        CC= setgrid(x1,x2,y1,y2,meshsize,b(),@InputFunction)'create grid, CC is the centre        Redim rot1(Lbound(b) To Ubound(b))                   'working array        A3d=angle3D.construct(0,-pi/2,0)        Var dx=x2-x1,dy=y2-y1        Var s=1/2        For n As Long=Lbound(b) To Ubound(b)            For m As Long=1 To 4                rot1(n).p(m)=rotate(CC,B(n).p(m),A3D,Type(s,s,s)) 'align boxes horizontally based                rot1(n).c=B(n).c                B(n).p(m)=rot1(n).p(m)            Next m        Next n    End Sub        Function display() As Long        #define resetwheel(w,fl) fl=w        #define wheel(w,f) w-f        Screenset 1,0        Static As float ang=(0,-pi/7,pi/2)  'default start view aspect        Static As Long fps        Static As String key        Static As Long mx,my,mw,mb,rflag        Static As Single sc=1                Const k=60         Var f=map(0,40,k,0,.5)                Do            setup(0,k,0,k,f)            Getmouse mx,my,mw,mb            If mb=2 Then 'reset                ang.z=pi/2:ang.y=-pi/7:ang.x=0                resetwheel(mw,rflag)             End If            mw=wheel(mw,rflag)            If mx>0 Then sc=2+(mw/10)'scaler            key=Inkey            If key=Chr(255)+"K" Then ang.z-=.05     'left            If key=Chr(255)+"M" Then ang.z+=.05     'right            If key=Chr(255)+"P" Then ang.y-=.05     'down            If key=Chr(255)+"H" Then ang.y+=.05     'up             If key="q" Then ang.x+=.05                 If key="w" Then ang.x-=.05                             A3D=Angle3D.construct(ang.x,ang.y,ang.z)      'set the rotate trigs                        For n As Long=Lbound(b) To Ubound(b)                For m As Long=1 To 4                    rot1(n).p(m) =rotate(CC,B(n).p(m),A3D,Type(sc,sc,sc))                    rot1(n).p(m) =perspective(rot1(n).p(m),Type(cc.x,cc.y,800*sc))                    If mb=1 Then rot1(n).p(m).x-=cc.x-mx: rot1(n).p(m).y-=cc.y-my'follow the mouse                Next m                                rot1(n).z=(rot1(n).p(1).z+rot1(n).p(3).z)/2            Next n                        qsortz(rot1(),Lbound(rot1), Ubound(rot1))                        Cls            Draw String(50,50),"Framerate "&fps            Draw String (50,80),"keys q and w to rotate round vertical (y) axis"             Draw String(50,110),"Use the arrow keys for x and z axis"            Draw String(50,140), "Mouse wheel to magnify"            Draw String(50,170),"Right mouse click to reset"            drawboxes(rot1())            Flip                        Sleep regulate(80,fps),1        Loop Until key=Chr(27)        Return 0    End Function        End display()    Sleep        Function InputFunction(x As Double,y As Double) As Double ' << --------------- INPUT function -----------        Var l=15 'set the limits        'set the x/y domains        MinX=-l        MaxX=l        MinY=-l        MaxY=l        If MaxX<MinX Then Swap MaxX,MinX        If MaxY<MinY Then Swap MaxY,MinY        If x=0 Then x=.000001 'qsort doesn't like Qnan        If y=0 Then y=.000001        Return (Sin(x)/x*Sin(y)/y)*200-.5*x^2                'Return Sin(x)*Cos(y)*20  'egg box    End Function         `
albert
Posts: 5676
Joined: Sep 28, 2006 2:41
Location: California, USA

### Re: Squares

@Dodicat

I tried all manner of getting the bits into a string , stepping by different values...
Trying to make it , so the bits would form a pattern that would compress.. nothing worked.

Then i came up with the idea , of randomly selecting bits to add to the output...until the output length equals the input length..

It still doesn't compress. But here it is... See : compress_loop()

Code: Select all

`Declare Function   compress_loop( chrs as string ) as stringDeclare Function decompress_loop( chrs as string ) as stringNamespace 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 LongEnd ExternFunction 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 textEnd 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    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 uncompressedEnd 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    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 compressedEnd FunctionEnd Namespace'=================================================================='=================================================================='test zipper'=================================================================='==================================================================screen 19Dim Shared As String sRandomizes=""dim as string check=""dim as string compare=""dim as longint length = 0dim as double compression = 0dim as longint loops = 0do       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 = 40print "Press a key to decompress."sleeps = 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 val1dim as string outsfor a as longint = count to 2 step -1    s = Zlibrary.unpack(comp)    outs = decompress_loop(s)    comp = outsnextcomp = Zlibrary.unpack(comp)printprint "input = "; length , "output = " ; len(comp) , "compression ratio  "; 100 - ( 100 / ( length / len(s) ) ) ; "%"printif comp = compare then print "Decompression successful." else print "ERROR"printPrint "!!~~Done~~!!"Sleepend'==============================================================================='============================,==================================================='begin functions'==============================================================================='================='==============================================================Function compress_loop( chrs as string ) as string       dim as string bits=""    dim as string zeros = string(64,"0")    dim as string s1    dim as ulongint ptr ulp = cptr(ulongint ptr,strptr(chrs))    for a as longint = 1 to len(chrs) step 8        s1 = zeros + bin(*ulp) : ulp+=1        bits+=right(s1,64)    next        print "c inp = " ; len(bits) ', bits        dim as string outs = ""    randomize 0    do                dim as longint rand = int( rnd * (len(bits)+1) )                if mid(bits,rand,1) <> "-" then outs+= mid(bits,rand,1) : mid(bits,rand,1) = "-"            loop until len(outs) = len(bits)        print "c out = " ; len(outs) ', outs        dim as string final=""    for a as longint = 1 to len(outs) step 8        final+=chr(val("&B"+mid(outs,a,8)))    next        print "c fin = "; len(final) ' , final        return final   end function'==============================================================================='============================================================================Function decompress_loop( chrs as string ) as string        return chrsend function`
albert
Posts: 5676
Joined: Sep 28, 2006 2:41
Location: California, USA

### Re: Squares

@Dodicat

This program uses RND() to generate the value... The problem is ; several values equal each other...There should be 31 unique values..

Whats wrong with it???

Code: Select all

`screen 19    dim as string vals(0 to 31)    dim as string match    dim as longint count    dim as string n1    for a as longint = 0 to 31 step 1        n1 = bin(a)        count = 0        randomize 0        do            match=""            for b as longint = 1 to len(n1)                match+=str( int( rnd * 2 ) )            next            count+=1        loop until match = n1        vals(a) = hex(count)    next        for a as longint = 0 to ubound(vals)        print vals(a) ,    next    printsleepend`
Richard
Posts: 3013
Joined: Jan 15, 2007 20:44
Location: Australia

### Re: Squares

You use the same seed "0" every time.
Use Randomize once at the start.

Code: Select all

`Screen 19Randomize Dim As String vals(0 To 31)Dim As String matchDim As Longint countDim As String n1For a As Longint = 0 To 31 Step 1    n1 = Bin(a)    count = 0    Do        match=""        For b As Longint = 1 To Len(n1)            match+=Str( Int( Rnd * 2 ) )        Next        count+=1    Loop Until match = n1    vals(a) = Hex(count)NextFor a As Longint = 0 To Ubound(vals)    Print vals(a) ,NextPrintSleepEnd`
albert
Posts: 5676
Joined: Sep 28, 2006 2:41
Location: California, USA

### Re: Squares

@Richard

I figured it out... You have to use right( "00" + ? , 2 )

Code: Select all

`screen 19    dim as string dict=""    dim as string vals    dim as longint count = 0    randomize 0    do        vals = right("00"+hex( int( rnd * 32 ) ),2)        if instr( 1 , dict , vals ) = 0 then             dict+= vals + " "            count+=1            'print count , dict        end if    loop until count = 31  or inkey = chr(27)        print "dict = " ; len(dict) , dict    sleepend`
albert
Posts: 5676
Joined: Sep 28, 2006 2:41
Location: California, USA

### Binary Data Compressor

@Dodicat
@Richard

I finally succeeded in creating compression....Now to write the de-compressor..

10,000 bytes compresses down to under 1,300 bytes after 60 loops..
100,000 bytes compresses down to under 3,000 bytes after 60 loops.
1,000,000 bytes compresses down to under 30,000 bytes after 60 loops
10,000,000 bytes compresses down to under 30,000 bytes after 100 loops. ( but it takes like 10 minutes to compress 100 loops)

Code: Select all

`Declare Function   compress_loop( chrs as string ) as stringDeclare Function decompress_loop( chrs as string ) as stringNamespace 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 LongEnd ExternFunction 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 textEnd 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    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 uncompressedEnd 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    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 compressedEnd FunctionEnd Namespace'=================================================================='=================================================================='test zipper'=================================================================='==================================================================screen 19Dim Shared As String sRandomizes=""dim as string check=""dim as string compare=""dim as longint length = 0dim as double compression = 0dim as longint loops = 0do       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 60."    print    print "press esc to exit."    sleep       if inkey = chr(27) then exit do   loop until loops = 60print "Press a key to decompress."sleeps = 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 val1dim as string outsfor a as longint = count to 2 step -1    s = Zlibrary.unpack(comp)    outs = decompress_loop(s)    comp = outsnextcomp = Zlibrary.unpack(comp)printprint "input = "; length , "output = " ; len(comp) , "compression ratio  "; 100 - ( 100 / ( length / len(s) ) ) ; "%"printif comp = compare then print "Decompression successful." else print "ERROR"printPrint "!!~~Done~~!!"Sleepend'==============================================================================='============================,==================================================='begin functions'==============================================================================='================='==============================================================Function compress_loop( chrs as string ) as string       dim as string bits=""    dim as string zeros = string(64,"0")    dim as string s1    dim as ulongint ptr ulp = cptr(ulongint ptr,strptr(chrs))    for a as longint = 1 to len(chrs) step 8        s1 = zeros + bin(*ulp) : ulp+=1        bits+=right(s1,64)    next       print "c inp = " ; len(bits) ', bits        dim as string dict=""    dim as string vals    dim as longint count = 0    randomize 0    do        vals = right("00"+hex( int( rnd * 32 ) ),2)        if instr( 1 , dict , vals ) = 0 then             dict+= vals            count+=1        end if    loop until count = 31        dim as string rand( 0 to 31)    count = 0    for a as longint = 1 to len(dict) step 2        rand(count) = mid(dict,a,2)        count+=1    next        dim as string outs = ""    dim as longint n1    for a as longint = 1 to len(bits) step 5        n1 = val( "&B"+mid(bits,a,5) )        outs+=ltrim( rand(n1) , "0" )    next        print "c out = " ; len(outs) ', outs       dim as string final=""    for a as longint = 1 to len(outs) step 2        final+=chr(valulng("&H"+mid(outs,a,2)))    next       print "c fin = "; len(final) ' final       return final   end function'==============================================================================='============================================================================Function decompress_loop( chrs as string ) as string       return chrsend function`
albert
Posts: 5676
Joined: Sep 28, 2006 2:41
Location: California, USA

### Re: Squares

Now i got to figure out what to call it...

I was calling all my other compressors "Binary Data Compressor" outputting *.BDC files.

I think I'll leave it *.BDC...
albert
Posts: 5676
Joined: Sep 28, 2006 2:41
Location: California, USA

### Re: Squares

I can't decompress it... some combos equal other combos... As usual..

Can't tell a 1 , 1 from an 11 and a 1 , B from a 1B
albert
Posts: 5676
Joined: Sep 28, 2006 2:41
Location: California, USA

### Re: Squares

It seems that the only way to compress data : Is to make some bytes equal other bytes.
Or to leave off some bits.. ltrim() the binary...