Squares

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

Re: Squares

Postby albert » Feb 05, 2020 23:05

I remember watching a science TV show..

Where they had a compressed air hose , blowing air out , and a funnel at the output ..
And the ping-pong ball they put into the funnel , was sucked into the funnel.. Instead of blowing out with the air..

So maybe only spheres can be Photo-Bernuolli'd into the laser beam...
I don't know , about other shapes???

I only saw the orbs ( spheres ) , coming down, i didn't see and lifeforms or aliens , in the beam..
badidea
Posts: 2039
Joined: May 24, 2007 22:10
Location: The Netherlands

Re: Squares

Postby badidea » Feb 05, 2020 23:08

albert wrote:bla bla

So you saw UFO with blue light coming out of it.
You assumed that you can swim in this light, but never tested it.
And now you are finding an explanation for how swimming in light works?
What a nonsense.
albert
Posts: 5663
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Postby albert » Feb 05, 2020 23:19

@badidea

The Bernoulli effect works in any thing flowing.. gases , liquids..

It should also work with light... Light is a flow..

I didn;t see the UFO , only the beam coming down from a hole in the clouds..


The orbs were hovering around off the ground and making rainbow circles on the ground..
I walked through one of the rainbow circles , and then turned around and looked at where i had walked..
And my footprints where i had walked , were glowing in a turquoise color , inside the rainbow...

So the orbs were doing some sort of heat mapping...
albert
Posts: 5663
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Postby albert » Feb 06, 2020 0:03

The beam coming down from the clouds was a pale sky-blue color...( same color as the sky. )

It was coherent , so it has to be a laser..

Pale blue , would be a nitrogen laser , or an ultra-violet laser..
But some frequency of laser , causes a buoyancy or draw , Photo-Bernoulli effect....

Some frequency of laser , at some power level...

An experiment:
Would be to take an inch wide laser , and see if it draws in a small 1/16th inch , hollow sphere..
Try different frequencies of lasers at different power levels...
Shine the laser down onto a table from above and try putting in the spheres in..
At some freq and power level , the spheres should be drawn upwards into the laser..( or float stationary. )

Some combination of freq and power , will ultimately work...

At some combination of freq and power , you should be able to swim around inside the laser beam..
albert
Posts: 5663
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Postby albert » Feb 06, 2020 2:44

I took a close look at one of the orbs..

It had an outer shell that could glow different colors.. And it also could show red , green ,and blue lasers circling around...

And at the center of the orb was a small 2 inch diameter gray , smaller orb.. like a spherical Rubic cube.
The inner orb was turning like a Rubic cube , with bands rotating horizontally and bands rotating vertically..

As it was talking , you could see the different bands rotating around and up & down..

So the orbs were alien robots...
albert
Posts: 5663
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Postby albert » Feb 06, 2020 2:59

@badidea

I wrote a program to depict the Alien orbs... laser circling...

Code: Select all

'written in FreeBasic for Windows
'http://www.freebasic.net
'Written by Albert Redditt 5/12-15/2010
'
dim as double x1, y1, x2, y2, zy1, zx1, zx2, zy2, x3, y3, x4, y4, x5, y5, x6, y6, deg, span, radians
dim as integer xctr, yctr, radius, divisions, fullcircle, toggle

screen 19
xctr = 400
yctr = 300
radius = 290
divisions = 45
span = 1
toggle = 0
do
    radians = atn(1) / divisions
    fullcircle = atn(1)*8 / radians

    for deg = 0 to fullcircle step 1

        y1 = radius * cos(deg*(span*radians)*radians)
        x1 = radius * sin(deg*(span*radians)*radians)
       
        zy1 = radius * cos(deg*(span*radians)*radians)
        zx1 = radius * sin(deg*(span*radians)*radians)

        y2 = radius * cos(deg*span*radians*radians)*cos(span*radians*span*deg*radians*radians*radians*deg*radians*deg*radians)
        x2 = radius * sin(deg*span*radians*radians)*cos(span*radians*span*deg*radians*radians*radians*deg*radians*deg*radians)
       
        zy2 = radius * cos(deg*span*radians*radians)*sin(span*radians*span*deg*radians*radians*radians*deg*radians*deg*radians)
        zx2 = radius * sin(deg*span*radians*radians)*sin(span*radians*span*deg*radians*radians*radians*deg*radians*deg*radians)

        if deg > 0 then
            'circle(xctr+x1,yctr+y2),3,9,,,,f
            line(xctr+x3,yctr+y3)-(xctr+x1,yctr+y2),9
            'circle(xctr+x2,yctr+y1),3,9,,,,f
            line(xctr+x4,yctr+y4)-(xctr+x2,yctr+y1),10
            'circle(xctr+zx2,yctr+zy1),3,9,,,,f
            line(xctr+x5,yctr+y5)-(xctr+zx2,yctr+zy1),12
        end if
       
        y3 = y2
        x3 = x1
       
        y4 = y1
        x4 = x2
       
        y5 = zy1
        x5 = zx2
   next
   
    sleep(20)
   
    select case toggle
        case 0
            span += 1
            if span > 57*5 then sleep(10):toggle = 1
            cls
        case 1
            span -= 1
            if span = -57*5 then sleep(10):toggle = 0
            cls
    end select
   
loop until inkey <> ""

END

paul doe
Posts: 1212
Joined: Jul 25, 2017 17:22
Location: Argentina

Re: Squares

Postby paul doe » Feb 06, 2020 3:33

dodicat wrote:...
Anyway I am in the middle of an argument with so called environment people who want to cut down native woodland and introduce cattle.
For once instead of being an armchair moaner I take on the role of activist up against organisations and land owners.
These woods are hidden, I have mentioned them vaguely before on the forum, so I work alone.
It is a bigger task than Albert's decompressor I would guess, and I am not a qualified environmental scientist.
but that doesn't mean I shouldn't try.

Know that you may work alone, but you aren't alone. Where there is Light, the Shadow cannot enter. Our sincere respect and support for your cause (which is, incidentally, everybody's cause).

'Cattle'... now that term sends a chill down the spine of many a true human, indeed.

This thread is taking on an interesting twist. Certainly not because of Albert's crack-smoking theories about faster-than-light travel ;) but because of the general overtones of it...
paul doe
Posts: 1212
Joined: Jul 25, 2017 17:22
Location: Argentina

Re: Squares

Postby paul doe » Feb 06, 2020 4:01

@Albert: really nice. Can't say I saw one of those, but they do look familiar for some reason...

When I was a child, I distinctly remember the time when I was idly looking through the window on a rainy day (a trait shared by many fellow autists) from a couch we had next to it, and I caught a glympse of this massive, dome-like structure through a brief opening in the clouds. The vision haunted me for years to come (little did I knew what I actually saw back then).

Just in case some of you were wondering: it isn't neither an argumentum ad verecundiam, nor proves that the Earth is flat. The explanation NASA gives about it is pure, distilled, gluten-free bullsh*t; conscious people know exactly what I'm talking about, and might even consider the explanation an insult. But that's what we're being fed all the time anyways XD
badidea
Posts: 2039
Joined: May 24, 2007 22:10
Location: The Netherlands

Re: Squares

Postby badidea » Feb 06, 2020 22:55

Code: Select all

const PI = atn(1) * 4
const SW = 800, SH = 600
screenres SW, SH, 32
randomize timer

sub drawUfo(pSurface as any ptr, x as integer, y as integer)
   circle pSurface, (x + 50, y + 50), 20, rgb(100, 100, 150), , , 1, f
   circle pSurface, (x + 50, y + 50), 40, rgb(100, 150, 200), , , 0.2, f
   circle pSurface, (x + 50, y + 52), 40, rgb(100, 150, 200), , , 0.2, f
   circle pSurface, (x + 50, y + 48), 20, rgb(100, 100, 150), , , 0.2, f
   circle pSurface, (x + 50, y + 45), 20, rgb(80, 80, 120), , , 0.2, f
   circle pSurface, (x + 50, y + 56), 5, rgb(150, 200, 100), , , 0.2, f
   circle pSurface, (x + 70, y + 54), 5, rgb(150, 200, 100), , , 0.2, f
   circle pSurface, (x + 30, y + 54), 5, rgb(150, 200, 100), , , 0.2, f
   circle pSurface, (x + 78, y + 48), 5, rgb(150, 200, 100), , , 0.2, f
   circle pSurface, (x + 22, y + 48), 5, rgb(150, 200, 100), , , 0.2, f
   circle pSurface, (x + 50, y + 68), 10, rgb(200, 200, 50), , , 0.2, f
end sub

type int2d : dim as integer x,y : end type
dim as int2d ufoPos = type(SW \ 2, SH \ 2), ufoSize = type(90, 50)
dim as any ptr pUfoImg = imagecreate(ufoSize.x, ufoSize.y)
drawUfo(pUfoImg, -5, -25)
const NSTAR = 100
dim as int2d starPos(NSTAR - 1)
dim as ulong starColor(NSTAR - 1)
for i as integer = 0 to NSTAR - 1
   starPos(i) = type(int(rnd * SW), int(rnd * SH))
   starColor(i) = rgb(150 + int(rnd * 100), 150 + int(rnd * 50), 150 + int(rnd * 100))
next

dim as integer quit = 0
dim as integer dx = 2, dy = 1
while quit < 100
   screenlock
   cls
   for i as integer = 0 to NSTAR - 1
      pset (starPos(i).x, starPos(i).y), starColor(i)
   next
   put (ufoPos.x, ufoPos.y), pUfoImg, trans
   screenunlock
   ufoPos.x += dx
   ufoPos.y += dy
   if quit = 0 then
      if inkey <> "" then quit = 1 : dx *= 5 : dy *= 5
      if ufoPos.x <= 0 or(ufoPos.x + ufoSize.x) >= SW then dx = -dx
      if ufoPos.y <= 0 or(ufoPos.y + ufoSize.y) >= SH then dy = -dy
   else
      quit += 1
   end if
   sleep 15
wend

if pUfoImg <> 0 then imagedestroy(pUfoImg) : pUfoImg = 0
albert
Posts: 5663
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Postby albert » Feb 07, 2020 1:39

So: I got it figured out..

The alien space-ships use "Magnetic Repulsion" engines for flight..
And they use lasers or coherent ion beams , to go up and down from the ship.. Bernoulli Effect beams...
albert
Posts: 5663
Joined: Sep 28, 2006 2:41
Location: California, USA

Yah-Zip ( Test Bed )

Postby albert » Feb 07, 2020 22:20

@Dodicat

I've got another compression formula... I need help with the decompression...

==================================================
n1 = mid( bits , a , 3 )

n2 = "0"
if mid( n1 , 1 , 1 ) = "1" then n2+= "1"
if mid( n1 , 2 , 1 ) = "1" then n2+= "10"
if mid( n1 , 3 , 1 ) = "1" then n2+= "11"

bits1+= n2
==================================================

Compresses 100,000 bytes by 98% after 100 loops.. Takes 7 seconds..

Here's the "Test-Bed" where i write the decompression..

I've got the de-compressor , outputting the same string as the compressor..
Just need help with the search and replace..

Code: Select all



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

screen 19
'=====================================================================
'=====================================================================
'start program
'=====================================================================
'=====================================================================
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))
    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
            '    if inkey = chr( 27 ) then end
            '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
   
    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
'===============================================================================
'===============================================================================
'compress
'===============================================================================
'===============================================================================
Function compress_loop( chrs as string ) as string
   
    print "c inp = " ; len(chrs) ' , chrs
   
    dim as string bits = ""
    dim as string n1
    for a as longint = 1 to len( chrs ) step 1
        n1 = "00000000" + bin( chrs[ a - 1 ] )
        n1 = right( n1 , 8 )
        bits+= n1
    next
   
    print "c bit = " ; len( bits ) , bits
   
    dim as longint count1 = 0
    dim as string str1
    dim as longint dec1
    do
        str1 = str( len( bits ) / 3 )
        dec1 = instr( 1 , str1 , "." )
        if dec1 <> 0 then bits+= "0" : count1+= 1
    loop until dec1 = 0
   
    print "c bit = " ; len( bits ) , bits
   
    dim as string bits1
    dim as string n2
    for a as longint = 1 to len( bits ) step 3
       
        n1 = mid( bits , a , 3 )
       
        n2 = "0"
        if mid( n1 , 1 , 1 ) = "1" then n2+= "1"
        if mid( n1 , 2 , 1 ) = "1" then n2+= "10"
        if mid( n1 , 3 , 1 ) = "1" then n2+= "11"
       
        bits1+= n2
       
    next

    print "c out = "; len( bits1 ) , bits1

    dim as longint count2 = 0
    dim as string str2
    dim as longint dec2
    do
        str2 = str( len( bits1 ) / 8 )
        dec2 = instr( 1 , str2 , "." )
        if dec2 <> 0 then bits1+= "0" : count2+= 1
    loop until dec2 = 0

    dim as string final = ""
    for a as longint = 1 to len( bits1 ) step 8
        final+= chr( val( "&B" + mid( bits1 , a , 8 ) ) )
    next
   
    final = chr( count1 )  + chr( count2 ) + final
   
    print "c fin = " ; len(final)
   
    return final
   
end function
'===============================================================================
'============================================================================
Function decompress_loop( chrs as string ) as string
   
    print
    print "d inp = " ; len( chrs )
   
    dim as longint count1 = asc( left( chrs , 1 ) ) : chrs = mid( chrs , 2 )
    dim as longint count2 = asc( left( chrs , 1 ) ) : chrs = mid( chrs , 2 )
   
    dim as string bits = ""
    dim as string n1
    for a as longint = 1 to len( chrs ) step 1
        n1 = "00000000" + bin( chrs[ a - 1 ] )
        n1 = right( n1 , 8 )
        bits+= n1
    next
    bits = left( bits , len( bits ) - count2 )
   
    print "d bit = " ; len( bits ) , bits
   
    return chrs
   
end function



@Dodicat
I edited the above and corrected an error...
Last edited by albert on Feb 07, 2020 23:15, edited 1 time in total.
badidea
Posts: 2039
Joined: May 24, 2007 22:10
Location: The Netherlands

Re: Squares

Postby badidea » Feb 07, 2020 22:24

Keep to compressing until you have 1 byte left. Then try to decompress it.
I give you the byte value: 231. Good luck.
albert
Posts: 5663
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Postby albert » Feb 08, 2020 2:51

@badidea

With the beam coming down from the space-ship..

It was a coherent beam...

So coherent , would be a laser or coherent ion beam..

Tesla had created a Death-Ray , he said could bring down a whole fleet of aircraft..
Maybe that death ray is an ion beam, that would allow you to defy gravity..

Hitting an airplane with an ion beam , might disrupt it's electrical systems , and cause the airplane to fall out of the sky..
So , maybe , you can swim around inside the "Death-Ray" ???
albert
Posts: 5663
Joined: Sep 28, 2006 2:41
Location: California, USA

Yah-Zip ( Test Bed )

Postby albert » Feb 08, 2020 23:39

@Richard
@Dodicat

( !!~~ COMPRESSION SUCCESS ~~!! )

========================================
dim as string bits1 = ""
for a as longint = 1 to len( bits ) step 2

n1 = mid( bits , a , 2 )

if n1 = "00" then bits1+= "0"
if n1 = "01" then bits1+= "10"
if n1 = "10" then bits1+= "2"
if n1 = "11" then bits1+= "20"

next
======================================

There's no mistaking the different values... 0 , 10 , 2 , 20
Unfortunately it only compresses 100,000 bytes in , by 8% to 10% after 100 loops...And takes 125 seconds...( But at least it works.. )

But it compresses 10,000 bytes in , by 47% after 100 loops , and takes only 12 seconds...

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

dim as double time1 , time2

time1 = timer
do
   
    loops+=1
   
    'one time run , create initial string
    if loops = 1 then
        For n As Long = 1 To 100000
            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 esc to exit."
    print
    print "press a key for next compression." ; " loops = " ; loops ; " out of 100."
    'sleep
   
    if inkey = chr(27) then exit do
   
loop until loops = 100

time2 = timer

print
print  "Compress time = " ; time2 - time1
print
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
Print "!!~~Done~~!!"

Sleep
end
'===============================================================================
'============================,===================================================
'begin functions
'===============================================================================
'================='==============================================================
Function compress_loop( chrs as string ) as string
   
    print "c inp = " ; len(chrs) ' , chrs
   
    dim as string bits = ""
    dim as string n1
    for a as longint = 1 to len( chrs ) step 1
        n1 = "00000000" + bin( chrs[ a - 1 ] )
        n1 = right( n1 , 8 )
        bits+= n1
    next
   
    print "c bin = " ; len( bits ) ', bits
   
    dim as string bits1 = ""
    for a as longint = 1 to len( bits ) step 2
       
        n1 = mid( bits , a , 2 )
       
        if n1 = "00" then bits1+= "0"
        if n1 = "01" then bits1+= "10"
        if n1 = "10" then bits1+= "2"
        if n1 = "11" then bits1+= "20"
       
    next
   
    print "c out = "; len( bits1 ) ', bits1
   
    dim as string final = ""
    dim as string s , n
    for a as longint = 1 to len( bits1 ) step 4
        s = mid( bits1 , a ,  4 )
        n = ""
        n+= right( "00" + bin( val( mid( s , 1 , 1 ) ) ) , 2 )
        n+= right( "00" + bin( val( mid( s , 2 , 1 ) ) ) , 2 )
        n+= right( "00" + bin( val( mid( s , 3 , 1 ) ) ) , 2 )
        n+= right( "00" + bin( val( mid( s , 4 , 1 ) ) ) , 2 )
        final+= chr( val( "&B" + n ) )
        'final+= chr( val( "&O" + mid( out1 , a , 3 ) ) )
    next
   
    print "c fin = " ; len(final)
   
    return final
   
end function
'===============================================================================
'============================================================================
Function decompress_loop( chrs as string ) as string
   
    print
    print "d inp = " ; len( chrs )

    return chrs
   
end function



Here's the "Test-Bed" where i write the decompression..

Code: Select all



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

screen 19
'=====================================================================
'=====================================================================
'start program
'=====================================================================
'=====================================================================
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))
    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
            '    if inkey = chr( 27 ) then end
            '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
   
    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
'===============================================================================
'===============================================================================
'compress
'===============================================================================
'===============================================================================
Function compress_loop( chrs as string ) as string
   
    print "c inp = " ; len(chrs) ' , chrs
   
    dim as string bits = ""
    dim as string n1
    for a as longint = 1 to len( chrs ) step 1
        n1 = "00000000" + bin( chrs[ a - 1 ] )
        n1 = right( n1 , 8 )
        bits+= n1
    next
   
    print "c bin = " ; len( bits ) , bits
   
    dim as string bits1 = ""
    for a as longint = 1 to len( bits ) step 2
       
        n1 = mid( bits , a , 2 )
       
        if n1 = "00" then bits1+= "0"
        if n1 = "01" then bits1+= "10"
        if n1 = "10" then bits1+= "2"
        if n1 = "11" then bits1+= "20"
       
    next
   
    print "c out = "; len( bits1 ) , bits1
   
    dim as string final = ""
    dim as string s , n
    for a as longint = 1 to len( bits1 ) step 4
        s = mid( bits1 , a ,  4 )
        n = ""
        n+= right( "00" + bin( val( mid( s , 1 , 1 ) ) ) , 2 )
        n+= right( "00" + bin( val( mid( s , 2 , 1 ) ) ) , 2 )
        n+= right( "00" + bin( val( mid( s , 3 , 1 ) ) ) , 2 )
        n+= right( "00" + bin( val( mid( s , 4 , 1 ) ) ) , 2 )
        final+= chr( val( "&B" + n ) )
        'final+= chr( val( "&O" + mid( out1 , a , 3 ) ) )
    next
   
    print "c fin = " ; len(final)
   
    return final
   
end function
'===============================================================================
'============================================================================
Function decompress_loop( chrs as string ) as string
   
    print
    print "d inp = " ; len( chrs )

    return chrs
   
end function

badidea
Posts: 2039
Joined: May 24, 2007 22:10
Location: The Netherlands

Re: Yah-Zip ( Test Bed )

Postby badidea » Feb 08, 2020 23:53

albert wrote:There's no mistaking the different values... 0 , 10 , 2 , 20

"2", "0" and "20" sounds like a problem to me.

Return to “General”

Who is online

Users browsing this forum: No registered users and 7 guests