Squares

[Stonemonkey]

8 to 32 bits on a single dot? Gonna need some really good paper to get up to those 32 bits.

[albert]

@Dodicat

I got another formula that compresses....Compresses 1,000,000 bytes down to 2300 after 100 loops.. 97.6%

==========================================================
v1 = ( *ubp ) : ubp+= 1

v2 = v1

if v2 > 127 then map1+= bin( (v2 mod 2) ) : v2\= 2 else map1+= "11"
if v2 > 063 then map1+= bin( (v2 mod 2) ) : v2\= 2 else map1+= "11"
if v2 > 031 then map1+= bin( (v2 mod 2) ) : v2\= 2 else map1+= "11"
if v2 > 015 then map1+= bin( (v2 mod 2) ) : v2\= 2 else map1+= "11"

outs1+= hex( v2 )
==========================================================

The problem is : you can't tell a "1" , "1" , from a "11"

[albert]

For my paper backup idea...

With my idea for a "laser , paper toaster" printer..

The laser could be a one or a couple , microns in diameter..
So you could burn a megabyte or more ( maybe a gigabyte ) to a page of paper , for paper backups..

There's 25, 400 microns in an inch.. For a one micron laser...

So that's , 215,900 microns to an 8.5 inch wide piece of printer paper..
So that's , 279,400 microns to an 11 inch tall piece of printer paper..

So the answer is 215,900 * 279,400 = ?? 300,000 * 300,000 = 90,000,000,000 bits * resolution ..to a page..

That's like 10 gigs to a page.... for monochrome for grey scale you multiply the 10 gigs by the number of color scales per bit...

If you could get 100 different colors per bit , with the laser toasting.. that would be like a terabyte of backup , per page..

[badidea]

Paper zoomed in (a bit):

Also, don't spill any coffee on your paper back-up.

[albert]

@Badidea

From your above photos...The laser would have to be 250 microns in diameter , for regular paper..

Or you need a finer grade of paper....or maybe a plastic instead of regular paper..

So that's , 215,900 microns to an 8.5 inch wide piece of printer paper..
So that's , 279,400 microns to an 11 inch tall piece of printer paper..

So the answer is 215,900 * 279,400 = 60,322,460,000

At 250 micron , laser size = 241,289,840 bits

If you can get 100 colors per bit , then the out , would be 24,128,984,000 bits... Or about 3 gigabytes per page...

If you could toast 1,000 different colors per bit , then it would be 30 gigabytes per page..

[albert]

During the covid-19 pandemic the governments of many countries are resorting to online schooling..

I came up with an idea...

You have each school years books on memory sticks.. K - 12 and college

You put in the memory stick and it reads the chapter..
Stopping to show you the formulas.. and asking you to repeat the formulas.. or learning..
So you can draw or write on the tablet screen , then it checks your writing to see if it's correct...
Then at the end of the chapter , it gives you a test to complete... Then grades you on your test answers..
And uploads the test results to the schools computers... for your grading..

So it would be interactive learning... Like a real classroom...

Checking the writing on the screen and matching it to the lesson section would be the problem to solve...
You'd need a program to scan the handwriting , to check it with the correct answers..
Every ones screen writing would be different... So you'd need a program to convert the screen writing into an output..

With this idea , you can take whatever class you like , in any order.. over any time frame.. Great for online college...

[coderJeff]

I got another formula that compresses....Compresses 1,000,000 bytes down to 2300 after 100 loops.. 97.6%

Hey man, every time you run a string of posts I get complaints. And when I try to address, I get complaints. Now, If I suspend your account *permanently* I'll probably get some hate mail for a while, but not forever. I'm thinking that works for me.

Do you have a programming idea in mind that you want to do? You got FB running on your new Linux yet?

[angros47]

Hey man, every time you run a string of posts I get complaints. And when I try to address, I get complaints. Now, If I suspend your account *permanently* I'll probably get some hate mail for a while, but not forever. I'm thinking that works for me.

Sincerely, you would have all my support, for that. You have already showed much more tolerance and patience than is normally expected on a forum.

I can understand that albert might have his fans, but if they want to continue talking with him I suggest to do it in private. This forum cannot help albert with his issues.

[albert]

@CoderJeff

I'll stick to writing non-compression FB programs... Until i come up with a decompressor..
====================================================================

Another "Trig Doodle"

Abstract_0174.bas

Code: Select all

dim as single c1 , c2 , c3
dim as single s1 , s2 , s3
dim as single x1 , x2 , x3
dim as single y1 , y2 , y3
dim as single deg1 , deg2 , deg3
dim as single rad

dim as integer xctr , yctr , radius , divisions , fullcircle
dim as integer xres , yres

screeninfo xres , yres
screenres xres , yres , 8 , 1 , 8

xctr = xres / 2
yctr = yres / 2

'radius = (xres*yres)/((xres+yres)*4)
radius = 500

divisions = 45

rad = atn( 1 ) / divisions

fullcircle = atn( 1 ) * 8 / rad

for deg1 = 0 to fullcircle step .1
    
            c1 = cos( deg1 * rad )
            s1 = sin( deg1 * rad )
   
            x1 = radius * c1 * sqr( deg1 * rad ) / 3 * c1
            y1 = radius * s1 * sqr( deg1 * rad ) / 3 * s1
            
    for deg2 = 0 to fullcircle step 90

            c2 = cos( deg2 * rad )
            s2 =  sin( deg2 * rad )
            
            c3 = cos( ( deg2 + deg1 + c2 + c1 ) * rad )
            s3 =  sin( ( deg2 + deg1 + s2 + s1 ) * rad )
   
            x2 = radius * c2 * log( deg2 * c2 ) * atan2( deg2 * c2 , s2 ) * log( deg2 ) * 20
            y2 = radius * s2 * ( tan( deg2 / deg1 ) / 1000 ) * atan2( c2 , s1 ) * 20 * cos( deg2*deg1 / s2 )
              
            pset( xctr +x1 +x2 , yctr +y1 +y2 ) , 9
            pset( xctr +x1 +x2 , yctr -y1  -y2 ) , 9
            
            pset( xctr -x1 -x2 , yctr +y1 +y2 ) , 9
            pset( xctr -x1 -x2 , yctr -y1 -y2 ) , 9
           
    next
   
next

Sleep
end

[albert]

@Richard

Sorry i put you through the trouble of writing the "Altered Binary" programs...

"Altered Binary" doesn't compress.. Unless some values equal other values...

I tried an octal altered binary , 1 , 2 , 4 , 10 , 20 , 40 , 100 , 200 = 0 to 377 ,, it didn't compress , it expanded 48 bytes a loop... Just like the others..

[deltarho[1859]]

@albert

I see that you have done so - well done.

Good idea to invite others to join in - I can see UEZ and dodicat coming up with a few. You won't see any from me because I am useless at graphics.

I'll stick to writing non-compression FB programs... Until i come up with a decompressor..

When you do come up with a viable decompressor, and only then, then I suggest you start a new thread for that entitled 'AlbertZip'.

[dodicat]

This was wrongly placed in trig shapes.
' ' '
Nice to see squares settled down a bit.
We survived an attack, but if the C word is forgotten for a while then perhaps squares can go on intact.
This is a purge of squares into a great thread.

Code: Select all

Type pt
    As Single x,y,z
End Type

Type angle
    As Single a(1 To 6)
    Declare Sub set(p As pt)
End Type

Sub angle.set(p As pt) 
    This= Type<angle>({Sin(p.x),Sin(p.y),Sin(p.z),Cos(p.x),Cos(p.y),Cos(p.z)}) 
End Sub

Type square
    As pt p(3)
    As angle a
    As pt ctr
    As Ulong col
    As pt da
    As pt b
    Declare Constructor
    Declare Constructor(As pt,As Single,As pt,As Ulong)
    Declare Sub fill(im As Any Ptr=0)
    Declare Function rotate() As square
End Type

#define up <,>
#define down >,<
#macro SetQsort(datatype,fname,b1,b2,dot)
Sub fname(array() As datatype,begin As Long,Finish As Long)
    Dim As Long i=begin,j=finish
    Dim As datatype x =array(((I+J)\2))
    While  I <= J
        While array(I)dot b1 X dot:I+=1:Wend
            While array(J)dot b2 X dot:J-=1:Wend
                If I<=J Then Swap array(I),array(J): I+=1:J-=1
            Wend
            If J > begin Then fname(array(),begin,J)
            If I < Finish Then fname(array(),I,Finish)
        End Sub
        #endmacro  
        
        #define range(f,l) Rnd*((l)-(f))+(f)
        
        Function Rotate(c As pt,p As pt,a As angle,scale As pt=Type<pt>(1,1,1)) As pt
            Dim As Single dx=p.x-c.x,dy=p.y-c.y,dz=p.z-c.z
            Return Type<pt>((scale.x)*((a.a(5)*a.a(6))*dx+(-a.a(4)*a.a(3)+a.a(1)*a.a(2)*a.a(6))*dy+(a.a(1)*a.a(3)+a.a(4)*a.a(2)*a.a(6))*dz)+c.x,_
            (scale.y)*((a.a(5)*a.a(3))*dx+(a.a(4)*a.a(6)+a.a(1)*a.a(2)*a.a(3))*dy+(-a.a(1)*a.a(6)+a.a(4)*a.a(2)*a.a(3))*dz)+c.y,_
            (scale.z)*((-a.a(2))*dx+(a.a(1)*a.a(5))*dy+(a.a(4)*a.a(5))*dz)+c.z)',p.col)
        End Function
        
        Function perspective(p As pt,eyepoint As pt) As pt
            Dim As Single   w=1+(p.z/eyepoint.z)
            Return Type<pt>((p.x-eyepoint.x)/w+eyepoint.x,_
            (p.y-eyepoint.y)/w+eyepoint.y,_
            (p.z-eyepoint.z)/w+eyepoint.z)',p.col)
        End Function 
        
        Function Regulate(Byval MyFps As Long,Byref fps As Long=0) As Long
            Static As Double timervalue,_lastsleeptime,t3,frames
            Var t=Timer
            frames+=1
            If (t-t3)>=1 Then t3=t:fps=frames:frames=0
            Var sleeptime=_lastsleeptime+((1/myfps)-T+timervalue)*1000
            If sleeptime<1 Then sleeptime=1
            _lastsleeptime=sleeptime
            timervalue=T
            Return sleeptime
        End Function
        
        Constructor square
        End Constructor
        
        Constructor square(x As pt,sz As Single,a As pt,colour As Ulong)
        p(0)=x:p(1)=Type(p(0).x+sz,p(0).y)
        p(2)=Type(p(0).x+sz,p(0).y+sz)
        p(3)=Type(p(0).x,p(0).y+sz)
        For n As Long=0 To 3
            p(n).z=x.z
        Next
        ctr=Type<pt>( (p(0).x+p(1).x+p(2).x+p(3).x)/4,(p(0).y+p(1).y+p(2).y+p(3).y)/4, (p(0).z+p(1).z+p(2).z+p(3).z)/4)
        da=a
        col=colour
        End Constructor
        
        Sub square.fill(im As Any Ptr=0)
            #define ub Ubound
            Dim As Long Sy=1e6,By=-1e6,i,j,y,k
            Dim As Single a(Ub(p)+1,1),dx,dy
            For i =0 To Ub(p)
                a(i,0)=p(i).x
                a(i,1)=p(i).y
                If Sy>p(i).y Then Sy=p(i).y
                If By<p(i).y Then By=p(i).y
            Next i
            Dim As Single xi(Ub(a,1)),S(Ub(a,1))
            a(Ub(a,1),0) = a(0,0)
            a(Ub(a,1),1) = a(0,1)
            For i=0 To Ub(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 Ub(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),col
            Next i
        Next y
    End Sub
    
    Function square.rotate() As square
        b.x+=da.x
        b.y+=da.y
        b.x+=da.z
        a.set(b)
        ctr=Type<pt>( (p(0).x+p(1).x+p(2).x+p(3).x)/4,(p(0).y+p(1).y+p(2).y+p(3).y)/4, (p(0).z+p(1).z+p(2).z+p(3).z)/4) 
        Dim As square s=This
        For n As Long=0 To 3
            s.p(n)= ..Rotate(ctr,this.p(n),a)
            s.p(n)= perspective(s.p(n),Type(512,768\2,1500))
        Next
        Return s
    End Function
    
    #define rcolour Rgb(100+Rnd*155,100+Rnd*155,100+Rnd*155)
    Screen 20,32
    Dim As square s(1 To 600)
    For n As Long=1 To Ubound(s)
        Dim As pt tmp=Type((Rnd-Rnd)/20,(Rnd-Rnd)/20,(Rnd-Rnd)/20)
        s(n)=square(Type<pt>(range(-100,1100),range(-100,800),Rnd*1400),10,tmp,rcolour)
    Next
    
    SetQsort(square,QsortZ,down,.ctr.z)
    
    Dim As square z(1 To Ubound(s))
    dim as long fps
    Do
        Screenlock
        cls
        
        For n As Long=1 To Ubound(s)
            For m As Long=0 To 3
                s(n).p(m).z-=5
            Next m
            z(n)=s(n).rotate
            If s(n).ctr.z<-1480 Then
                Dim As pt tmp=Type((Rnd-Rnd)/20,(Rnd-Rnd)/20,(Rnd-Rnd)/20)
                s(n)=square(Type<pt>(range(-100,1100),range(-100,800),800+Rnd*700),10,tmp,rcolour) 
            End If
        Next n
        
        QsortZ(z(),1,Ubound(z))
        
        For n As Long=1 To Ubound(z)
            z(n).fill()
        Next n
        draw string(10,10), "fps " &fps
        Screenunlock
        Sleep regulate(60,fps)
    Loop Until Inkey=Chr(27)
    
    Sleep
    
    
     

Note:
Tested 32/64 and gas64.

[albert]

@Dodicat

Hi Dodicat!!

I've moved over to "Trigonometry-Patterns" for a while... doing trig doodles..

[SARG]

problem with gas64 with this

What is problem ? I ran the program and haven't see one.

[dodicat]

SARG
I now have your latest (WDS 1.07).
It runs OK.
I'll alter the post.