Pentacles

[badidea]

Trying to make a 'snowfall' simulation/demo. So far, it mostly looks like pouring rain. I imagine that house displayed is dodicat's in the cold dark North surrounded wind and water.

Code: Select all

Type int2d
	Dim As Integer x,y
	Declare Constructor
	Declare Constructor(x As Integer, y As Integer)
	Declare Operator Cast () As String
End Type

Constructor int2d
End Constructor

Constructor int2d(x As Integer, y As Integer)
	This.x = x : This.y = y
End Constructor

' "x, y"
Operator int2d.cast () As String
  Return Str(x) & "," & Str(y)
End Operator

Operator + (a As int2d, b As int2d) As int2d
	Return Type(a.x + b.x, a.y + b.y)
End Operator

'===============================================================================

#Include "fbgfx.bi"

#IfNDef int2d
Type int2d
	Dim As Integer x, y
End Type
#EndIf

'triangle drawing routing, single color
'modified & stolen from D.J.Peters?
#Define SHIFTS 8 ' 24:8 fixed point format
Sub triangle(p() As int2d, c As ULong, pImg As ULong Ptr = 0)
	Dim As Integer t = Any, b = Any, l = Any, r = Any
	Dim As Integer d1 = Any, d2 = Any, s1 = Any, s2 = Any, cl = Any, cr = Any
	Dim As ULong Ptr pPix, pRow = Any, pCstart = Any, pCend = Any
	Dim As int2d v0 = Any, v1 = Any, v2 = Any
	Dim As Integer w, h
	If pImg = 0 Then
		pPix = ScreenPtr()
		ScreenInfo w, h
	Else
		'todo: ImageInfo( image [, [width] [, [height] [, [bypp] [, [pitch] [, [pixdata] [, size]]]]]] ) 
		'imageInfo w, h, , pitch, pPix
	End If
	v0 = p(0) : v1 = p(1) : v2 = p(2)
	If (v1.y > v2.y) Then Swap v1, v2
	If (v0.y > v2.y) Then Swap v0, v2
	If (v0.y > v1.y) Then Swap v0, v1
	If (v2.y = v0.y) Then Return
	s1 = ((v2.x - v0.x) ShL SHIFTS) / (v2.y - v0.y)
	d1 = v0.x ShL SHIFTS
	For i As Integer = 0 To 1
		s2 = ((v1.x - v0.x) ShL SHIFTS) / (v1.y - v0.y)
		d2 = v0.x ShL SHIFTS
		t = v0.y 'top
		'begin in first row
		If t < 0 Then
			d1 -= s1 * t
			d2 -= s2 * t
			t = 0
		End If
		b = v1.y 'bottom
		'end in last row
		If b >= h Then b = h - 1
		If b <= t Then GoTo next_triangle
		pRow = pPix + t * w 'first row
		b -= t 'how many scanlines
		'from top to bottom
		While b
			l = d1 ShR SHIFTS : r = d2 ShR SHIFTS
			If l > r Then Swap l, r
			If l >= w Then GoTo next_scanline
			If r < 1 Then GoTo next_scanline
			cl = 0 : cr = 0 'reset clipflag
			If l < 0 Then l = 0 : cl = 1
			If r >= w Then r = w : cr = 1
			pCstart = pRow + l 'first pixel
			pCend  = pRow + r 'last  pixel
			While pCstart < pCend
				*pCstart = c
				pCstart += 1
			Wend
			next_scanline:
			d1 += s1 : d2 += s2 : pRow += w : b-=1
		Wend
		next_triangle:
		d1 = (v0.x ShL SHIFTS) + ((v1.y - v0.y) * s1)
		v0 = v1 : v1 = v2
	Next
End Sub

Sub quad(p() As int2d, c As ULong, pImg As ULong Ptr = 0)
	Static As int2d t1(2), t2(2)
	t1(0) = p(0) : t1(1) = p(1) : t1(2) = p(2) 
	t2(0) = p(3) : t2(1) = p(1) : t2(2) = p(2) 
	triangle(t1(), c, pImg)
	triangle(t2(), c, pImg)
End Sub

'===============================================================================

Const As Single M_PI = Atn(1) * 4
Const As Single M_PI_2 = M_PI * 2
Const As Single M_PI_HALF = M_PI / 2
Const As Single M_RAD = 180 / M_PI

#Define rndrange(a, b) ( Rnd() * (b - a) + a )

Const SW = 800, SH = 600

'-------------------------------------------------------------------------------

Function rotate(v1 As int2d, angle As Single) As int2d
	Dim As int2d v2 = Any
	v2.x =  v1.x * Cos(angle)
	v2.x += v1.y * Cos(angle - M_PI_HALF)
	v2.y =  v1.x * Sin(angle)
	v2.y += v1.y * Sin(angle - M_PI_HALF)
	Return v2
End Function

Sub drawRect(x As Integer, y As Integer, w As Integer, h As Integer, angle As Single, c As ULong)
	Dim As int2d q(0 To 3)
	q(0).x = -w \ 2 : q(0).y = -h \ 2
	q(1).x =  w \ 2 : q(1).y = -h \ 2
	q(2).x = -w \ 2 : q(2).y =  h \ 2
	q(3).x =  w \ 2 : q(3).y =  h \ 2
	For i As Integer = 0 To 3
		q(i) = rotate(q(i), angle)
		q(i).x += x
		q(i).y += y
	Next
	quad(q(), c)
End Sub

Sub drawScene()
	'draw grass
	Line(0, SH * 0.75)-(SW - 1, SH - 1), &h00A000, bf
	'draw fence pole grass
	Circle(SW * 0.49, SH * 0.78), 20, &h209000,,,0.25, f
	Circle(SW * 0.60, SH * 0.795), 20, &h209030,,,0.25, f
	Circle(SW * 0.70, SH * 0.805), 20, &h209020,,,0.25, f
	Circle(SW * 0.805, SH * 0.78), 20, &h209000,,,0.25, f
	'draw fence poles
	drawRect(SW * 0.50, SH * 0.72, 15, 75, +0.07, &h705000)
	drawRect(SW * 0.60, SH * 0.73, 15, 80, 0.05, &h805000)
	drawRect(SW * 0.70, SH * 0.74, 15, 80, -0.02, &h906000)
	drawRect(SW * 0.80, SH * 0.72, 15, 70, -0.13, &h906030)
	'draw fence planks
	drawRect(SW * 0.55, SH * 0.69, 100, 20, 0.15, &h703000)
	drawRect(SW * 0.65, SH * 0.69, 100, 20, 0.1, &h804000)
	drawRect(SW * 0.75, SH * 0.70, 100, 20, -0.18, &h704030)
	'draw house grass
	Circle(SW * 0.25, SH * 0.82), 120, &h209000,,,0.25, f
	'draw house chimney
	drawRect(SW * 0.20, SH * 0.58, 40, 40, 0, &h800020)
	'draw house roof
	drawRect(SW * 0.25, SH * 0.66, 130, 130, 45 / M_RAD, &h900020)
	'draw house base
	drawRect(SW * 0.25, SH * 0.75, 160, 100, 0, &hA00020)
	drawRect(SW * 0.25, SH * 0.665, 170, 4, 0, &h702020)
	'draw house lower window
	drawRect(SW * 0.29, SH * 0.75, 42, 52, 0, &h603010)
	drawRect(SW * 0.29, SH * 0.75, 30, 40, 0, &hC0a000)
	drawRect(SW * 0.29, SH * 0.75, 30, 6, 0, &h603000)
	drawRect(SW * 0.29, SH * 0.75, 6, 40, 0, &h603000)
	'draw house upper window
	' circle(SW * 0.25, SH * 0.60), 15, &h603000,,,, f
	' circle(SW * 0.25, SH * 0.60), 10, &hC0a000,,,, f
	'draw house door
	drawRect(SW * 0.21, SH * 0.77, 38, 66, 0, &h603020)
	drawRect(SW * 0.21, SH * 0.77, 28, 56, 0, &h804030)

	'draw snow man (base, body, head, nose, hat)
	'draw trees
	'draw mountains
	'draw pond
End Sub

'-------------------------------------------------------------------------------

Type simple_list_type
	'private:
	Dim As int2d item(Any)
	Dim As Integer numItems
	'public:
	Declare Constructor(size As Integer)
	Declare Destructor()
	Declare Function Add(newItem As int2d) As boolean
	Declare Sub del(index As Integer)
End Type

Constructor simple_list_type(size As Integer)
	ReDim item(size - 1)
	numItems = 0
End Constructor

Destructor simple_list_type()
	Erase(item)
	numItems = 0
End Destructor

Function simple_list_type.add(newItem As int2d) As boolean
	Dim As Integer ub = UBound(item)
	If numItems > ub Then
		Return false 'list is full
	Else
		item(numItems) = newItem
		numItems += 1
		Return true 'ok
	End If
End Function

Sub simple_list_type.del(index As Integer)
	item(index) = item(numItems - 1) 'move last items into place
	numItems -= 1
End Sub

'-------------------------------------------------------------------------------

Sub addFlakes(snowflakes As simple_list_type, maxAdd As Integer)
	Dim As Integer x, y
	For i As Integer = 0 To maxAdd - 1
		x = Int(rndRange(-0.5 * SW, +1.5 * SW))
		y = Int(rndRange(-100, 0))
		If snowflakes.add(int2d(x, y)) = false Then Exit For
	Next
End Sub

ScreenRes SW, SH, 32, 1
Width SW \ 8, SH \ 16

Var snowflakes = simple_list_type(10000)
Dim As String key
Dim As Integer loopCount = 0, incFlakes = 1

Dim As fb.image Ptr pScene = ImageCreate(SW, SH)
drawScene()
Get(0, 0)-(SW - 1, SH - 1), pScene

While key = ""

	ScreenLock()
	Put (0, 0), pScene, PSet
	'draw snowflakes
	For i As Integer = 0 To snowflakes.numItems - 1
		PSet(snowflakes.item(i).x, snowflakes.item(i).y), &hffffff
	Next
	Draw String(0, 0), Str(snowflakes.numItems), &hb0b000
	ScreenUnLock()

	Sleep(10)
	key = InKey()
	'update snowflakes
	For i As Integer = 0 To snowflakes.numItems - 1
		snowflakes.item(i).y += 2
		If snowflakes.item(i).y > SH Then
			snowflakes.del(i)
			Continue For
		End If
		snowflakes.item(i).x += CInt(Rnd * 3 - 0.7)
	Next
	loopCount += 1
	If incFlakes < 10 Then
		 If loopCount Mod 200 = 0 Then incFlakes += 1
	End If
	addFlakes(snowFlakes, incFlakes)
Wend

'get background screen

[Richard]

The cold and dark North. Brrr.
I'm in the warm and light South Seas.
Today was the December solstice.

[albert]

I stupidly thought that , if you could put all 256 values into the smallest dictionary possible , that it would allow compression..
It turns out that it's 1 for 1 , so you can't use it to compress...

But i found a dictionary that fits all 256 values ( 0 to 255 ) into a dictionary size of 263 bits..

So every bit of the dictionary is utilized ..

Here's the automated dictionary searcher \ builder...

Code: Select all

screen 19

dim as longint max = 0

dim as string dict  = ""
dim as string vals = ""

dim as string n1 , n2

dim as longint count = 0
dim as longint  high = 0
dim as longint iter = 0

dim as string dictionary = ""
dim as string values = ""

'Start dictionary off with a value
for a as longint = 0 to 255

    dict = right( string( 8 , "0" ) + bin( a ) , 8 )
    vals = ""
    
    'Zero values
    count = 0
    high = 0
    iter = 0
    
    'Build dictionary
    do
        
        'Generate next bit for dictionary
        n1 = bin( int( rnd * 2 ) )
        
        'Count number of values in the dictionary
        vals = ""
        count = 0
        for b as longint = 0  to 255 step 1
            n2 = right( string( 8 , "0" ) + bin( b ) , 8 )
            'Check if adding bit n1 , increases the count 
            if instr( 1 , dict + n1 , n2 ) > 0 then count+= 1 : vals+= right( "000" + str( b ) , 3 ) + " "
        next
        
        'Recrod highest count value and add n1 to dictionary 
        if count > high then high = count : iter = 0 : dict+= n1
        
        'Exit loop if it gets stuck
        if count <= high then iter+= 1
        if iter = 10 then exit do
        
        if inkey = chr( 27 ) then end
        
    loop
    
    print  a
    
    'Record the dictionary with ther most values
    if high > max then 
        max  = high
        dictionary = dict
        values = vals
        if max = 256 then exit for
    end if
    
next

print
print "Dictionary size = " ; len( dictionary ) ; " Bits"
print
print "Number of values in dictionary = " ; max
print
print "Dictionary = " ; dictionary
print
print
print "Values in dictionary = "
print
for a as longint = 1 to len( values ) step 64
    print mid( values , a , 64 )
next

sleep
end

On my computer , it gets all 256 values , on the 38th dictionary build...

[albert]

I came up with an idea for power generation..

You have an underwater treadmill , with barrels..
The barrels fill with water at the top and then sink to the bottom of the treadmill..
At the bottom of the treadmill , the water is blown out by a compressor,,
Then the empty barrels buoy to the surface and turn the generator..

The fuel the compressor needs to operate , might be cheaper , than the power produced by the generator???

Here's the Simulator

Code: Select all

screen 19

dim as longint xres , yres

screeninfo( xres , yres )

dim as single xctr = xres / 2
dim as single yctr = yres / 2

dim as single rad = atn( 1 ) / 45

dim as single c1 , s1
dim as longint radius = 200
dim as single x1 , y1
dim as single x2 , y2

do
    
    for a as single = 0 to 90 step 1
    line( 0 , 0 ) - ( xres , 50 ) , 9 , bf
    
    draw string( 20 ,  020 ) , "Above Water"  
    draw string( 20 , 200 ) , "Under Water"
    
    line( xctr - 50 , 10 ) - ( xctr + 50 , 40) , 13 , bf
    
    draw string( xctr-40 , 20 ) , "Compressor" 
    line( xctr - 4 , 40 ) - ( xctr + 4, yctr ) , 15 , bf
    
    draw string( 100 , 100 ) , "Treadmill"
    line( 180 , 120 ) - ( 200 , 140 ) , 15 
    line( 200 , 130 ) - ( 200 , 140 ) , 15
    line( 192 , 140 ) - ( 200 , 140 ) , 15

    draw string( 60 , yctr ) , "Generator"
    line( 135 , yctr + 8 ) - ( 160 , yctr + 8 ) , 15
    line( 150 , yctr - 2 ) - ( 160 , yctr + 8 ) , 15
    line( 150 , yctr + 16 ) - ( 160 , yctr + 8 ) , 15
    
    draw string( xctr - 50 , yctr + 270 ) , "Blow Ballast" 
    line( xctr , yctr + 260 ) - ( xctr , yctr + 240 ) , 15
    line( xctr - 8 , yctr + 250 ) - ( xctr , yctr + 240 ) , 15
    line( xctr + 8 , yctr + 250 ) - ( xctr , yctr + 240 ) , 15
    
     for deg as single = a to a + 360 step 22.5
    
        c1 = cos( deg * rad )
        s1 = sin( deg * rad )
        
        x1 = xctr + ( radius * c1 )
        y1 = yctr + ( radius * s1 )

        x2 = ( xctr - 110 ) + ( 13 * c1 )
        y2 = ( yctr - 000 ) + ( 13 * s1 )

        line( xctr , yctr ) - (  x1 ,  y1 ) , 15
        
        line( xctr - 110 , yctr - 52 ) - ( xctr , yctr - 50 ) , 9
        line( xctr - 110 , yctr + 52 ) - ( xctr , yctr + 50 ) , 9
        
        circle( x1 , y1 ) , 38 , 9
        circle( x1 , y1 ) , 35 , 9
        
        circle( x2 , y2 ) , 38 , 9


        if deg >= 90 and deg <= 270  then 
            paint( x1 , y1 ) , 0 , 9
        else
            paint( x1 , y1 ) , 1 , 9
        end if
        
        circle( xctr , yctr ) , 50 , 9
        
        circle( xctr , yctr ) , radius , 15
        circle( xctr , yctr ) , radius + 5 , 15
        
        if inkey = chr( 27 ) then exit do
    
    next
    sleep 10
    cls
    next

loop

end

[Richard]

Welcome back Albert.
All you need now is a supply of free compressed air.
A trompe is a water-powered air compressor, commonly used before the advent of the electric-powered compressor.
https://en.wikipedia.org/wiki/Trompe

[dodicat]

Welcome back Albert.
Nice graphics.
Your compressor could be aided by the surface waves.

Code: Select all

Screen 20
#define map(a,b,x,c,d) ((d)-(c))*((x)-(a))/((b)-(a))+(c)
Dim As Single d,y
Do
    d-=.01
    Screenlock
    Cls
    
    For n As Long=0 To 1024
        Var ypos=map(-1,1,Sin(n/75+d),600,700)
        Pset(n,ypos)
        If n=500 Then y=ypos
    Next n
    Draw String(450,120),"compression"
    Draw String(450,140),"chamber"
    Line(500-50,100)-(500+50,500),,b
    Line(500-50,250)-(500-10,250)
    Line(500+10,250)-(500+50,250)
    Var cy=map(600,700,y,285,250)
    If y>610 Then cy=294
    Circle(500,cy-50),12,,,,,f
    Line(500-50,500)-(500+50,500),0
    Line(500,y)-(500,y-300)
    Line(500-50,y-300)-(500+50,y-300)
    Line(500+50,250)-(500+50,500),0
    Line(500+50,250)-(500+50,270)
    Line(500+50,290)-(500+50,500)
    cy=map(600,700,y,545,535)
    If y<690 Then cy=545
    Circle(cy,280),12,,,,,f
    Circle(500,y),50,15,,,,f
     draw string(480,y-15),"Float",0
    Screenunlock
    Sleep 1
    Loop Until Inkey=Chr(27) 

[albert]

@Richard

Dodicat's above post ; of wave powered compression , could work..

@Dodicat

There are some places on Earth that get big enough swells on a continuing basis , to power the compressor..
Portugal gets big swells all the time , the surfers love Portugal , for the constant 20 to 40 foot waves..
The gulf of Alaska and Hawaii also get regular 20 to 40 foot swells.

Here on the U.S. west coast , Pismo Beach gets 20 foot swells in the winter time , but it drops to under 10 foot for the most of the year...

I don't know if the wave power , would compress to the extent that is required , to blow the ballast??
If the treadmill is 1,000 foot across , then the compressor needs to generate 400+ PSI at 1,000 foot depth..
The barrels might be 1,000 to 10,000 gallons in size... It might take 30 seconds to blow the ballast...
So there might be like 4 or 5 barrels in stages of blowing the ballast...

You could always charge for the produced power vs. the fuel needed to operate , to make a profit...
If the cost is in a reasonable range of what else is available cost wise..

There are lots of coal and fuel oil powered , power plants , that burn coal and fuel oil to make steam...
They charge for the the cost of the coal and fuel oil plus a profit..

I figure that , the compressor would take somewhere around 100 to 300 gallons of fuel an hour..

[Richard]

There are many wave power plants installed today.
https://en.wikipedia.org/wiki/Wave_power

[albert]

Edited

[albert]

Still working on data compression....

Since there's no patterns in random data. I got to figure a way to group bits together to make the stream compressible..

My above dictionary idea , doesn't work..

Maybe a bubble sort of 8 bits , and record the swaps??

[albert]

I tried the 8 bit bubble sort.. It expands 89% on loop 1 and 190% on loop2

[Richard]

@albert.
I would strongly suggest that you do not discuss your attempts at data compression in this thread, or on this website. We cannot help you with your data compression dreams.

If you want to investigate data compression you need to do it somewhere else, or a moderator is going to have to decide if they should delete your data compression posts, or ban you for many more months.

[Lost Zergling]

I'd plead more tolerance, sometimes sounds a bit like witch hunt.

[Richard]

I'd plead more tolerance, sometimes sounds a bit like witch hunt.

I believe we are remarkably tolerant.

The science of data compression is defined by the mathematics of information. Albert does not understand the concept of high school algebra, and so cannot explain why A = B * A / B. One can have no valid opinion of a science if one does not understand the language of the mathematics that describes that science.

Albert is deluded in his belief that he leads the data compression field and that the science is wrong. He is actually so far behind that he thinks he is first. After 14 years and 5000 posts we weary of Albert's failure to study the first year of school algebra.

[albert]

@Richard

I'm not schooled in math...

a = 2 : b = 2

n = ab

From what i figure "ab" means to mul a * b , so n = 4

Why don't they just write n = a * b or n = a x b..

I'm not hip on the language of math...

But I'm not entirely stupid..

And i got a formula that compresses , but won't post it.. because i plan on selling it...
Dodicat gets a portion , cause i'm using his Zlib code , he wrote for me...