|
|
Post by bluatigro on Jan 18, 2019 7:28:19 GMT -5
this is a try at quasi cristals in 2D
this are tiles whit whitch you can not make a repeting patern
they are based on a 5 conered tile
this is my first try :
'' bluatigro 16 nov 2018
'' 2D quasi cristals
WindowWidth = 800
WindowHeight = 600
global winx , winy , pi , hDC
global black , yellow , white , ptel , size
dim x( 20 * 4 ) , y( 20 * 4 )
black = rgb( 0 , 0 , 0 )
yellow = rgb( 255 , 255 , 0 )
white = rgb( 255 , 255 , 255 )
winx = WindowWidth
winy = WindowHeight
size = 60
pi = atn( 1 ) * 4
open "5 base tile" for graphics as #m
#m "trapclose [quit]"
hw = hwnd( #m )
calldll #user32, "GetDC" _
, hw as ulong _ 'handle of window or graphicbox client area
, hDC as ulong 'returns handle of Device Context - 0=failure
ptel = 0
call tile5 0,0 , irange( 1 , 4 ) , 0
wait
[quit]
calldll #user32 , "ReleaseDC" _
, hw as ulong _ 'window handle
, hdc as ulong _ 'device context
, ret as long 'nonzero=success
close #m
end
function irange( low , high )
irange = int( rnd(0) * ( high - low + 1 ) + low )
end function
sub tile5 x , y , d , hoek
x( ptel ) = x
y( ptel ) = y
dx = size
dy = 0
call rotate dx , dy , hoek
x( ptel + 1 ) = x + dx
y( ptel + 1 ) = y + dy
dx1 = dx
dy1 = dy
call rotate dx1 , dy1 , d * 36
x( ptel + 2 ) = x + dx1
y( ptel + 2 ) = y + dy1
x( ptel + 3 ) = x + dx + dx1
y( ptel + 3 ) = y + dy + dy1
ptel = ptel + 1
x = x + winx / 2
y = y + winy / 2
call triangle x,y , x+dx,y+dy , x+dx1,y+dy1 , yellow
call triangle x+dx+dx1,y+dy+dy1 , x+dx,y+dy , x+dx1,y+dy1 , yellow
#m "color black"
#m "down"
#m "line ";x;" ";y;" ";x+dx;" ";y+dy
#m "line ";x+dx;" ";y+dy;" ";x+dx+dx1;" ";y+dy+dy1
#m "line ";x+dx+dx1;" ";y+dy+dy1;" ";x+dx1;" ";y+dy1
#m "line ";x+dx1;" ";y+dy1;" ";x;" ";y
#m "up"
end sub
sub rotate byref k , byref l , deg
s = sin( rad( deg ) )
c = cos( rad( deg ) )
hk = k * c - l * s
hl = k * s + l * c
k = hk
l = hl
end sub
function rad( deg )
rad = deg * pi / 180
end function
function getpixel( x , y )
calldll #gdi32 , "GetPixel" _
, hDC as ulong _
, x as long _
, y as long _
, getpixel as ulong
end function
sub triangle x1,y1 , x2,y2 , x3,y3 , kl
r = int( kl ) and 255
g = int( kl / 256 ) and 255
b = int( kl / 256 ^ 2 ) and 255
#m "color ";r;" ";g;" ";b
if y1 = y2 then y1 = y1 - 1e-6
if y2 = y3 then y3 = y3 + 1e-6
if y1 > y3 then
call swap y1 , y3
call swap x1 , x3
end if
if y1 > y2 then
call swap y1 , y2
call swap x1 , x2
end if
if y2 > y3 then
call swap y2 , y3
call swap x2 , y3
end if
for i = y1 to y3
a = x1 + ( x3 - x1 ) * (i-y1) / ( y3 - y1 )
if i < y2 then
b = x1 + ( x2 - x1 ) * (i-y1) / ( y2 - y1 )
else
b = x2 + ( x3 - x2 ) * (i-y2) / ( y3 - y2 )
end if
#m "down"
#m "line " ; a ; " " ; i _
; " " ; b ; " " ; i
#m "up"
next i
end sub
sub swap byref a , byref b
h = a
a = b
b = h
end sub
|
|
|
|
Post by bluatigro on Jan 18, 2019 8:02:38 GMT -5
error :
?
'' bluatigro 16 nov 2018
'' 2D quasi cristals
WindowWidth = 800
WindowHeight = 600
global winx , winy , pi , hDC
global black , yellow , white , ptel , size
dim x( 20 * 4 ) , y( 20 * 4 )
black = rgb( 0 , 0 , 0 )
yellow = rgb( 255 , 255 , 0 )
white = rgb( 255 , 255 , 255 )
winx = WindowWidth
winy = WindowHeight
size = 60
pi = atn( 1 ) * 4
open "5 base tile" for graphics as #m
#m "trapclose [quit]"
hw = hwnd( #m )
calldll #user32, "GetDC" _
, hw as ulong _ 'handle of window or graphicbox client area
, hDC as ulong 'returns handle of Device Context - 0=failure
ptel = 0
''draw a random tile
call tile5 0,0 , irange( 1 , 4 ) , 0
while ptel < 20 * 4
''sort points
for h = 1 to ptel
for l = 0 to h - 1
if length(x(h),y(h))<length(x(l),y(l)) then
hx = x(h)
hy = y(h)
x(h)=x(l)
y(h)=y(l)
x(l)=hx
y(l)=hy
end if
next l
next h
x = x( 0 )
y = y( 0 )
dx = size
dy = 0
call rotate dx , dy , 18
dtel = 0
hoek = 0
fl = 0
for i = 0 to 9
if getpixel( x+dx , y+dy ) = white then
dtel = dtel + 1
if fl = 0 then
fl = 1
hoek = dtel * 36
end if
end if
call rotate dx , dy , 36
next i
select case dtel
case 1
call triangle x,y , 1 , hoek
case 2
call triangle x,y , irange( 1 , 2 ) , hoek
case 3
call triangle x,y , irange( 1 , 3 ) , hoek
case else
call triangle x,y , irange( 1 , 4 ) , hoek
end select
wend
wait
[quit]
calldll #user32 , "ReleaseDC" _
, hw as ulong _ 'window handle
, hdc as ulong _ 'device context
, ret as long 'nonzero=success
close #m
end
function length( x , y )
length = sqr( x ^ 2 , y ^ 2 )
end function
function irange( low , high )
irange = int( rnd(0) * ( high - low + 1 ) + low )
end function
sub tile5 x , y , d , hoek
x( ptel ) = x
y( ptel ) = y
dx = size
dy = 0
call rotate dx , dy , hoek
x( ptel + 1 ) = x + dx
y( ptel + 1 ) = y + dy
dx1 = dx
dy1 = dy
call rotate dx1 , dy1 , d * 36
x( ptel + 2 ) = x + dx1
y( ptel + 2 ) = y + dy1
x( ptel + 3 ) = x + dx + dx1
y( ptel + 3 ) = y + dy + dy1
ptel = ptel + 4
x = x + winx / 2
y = y + winy / 2
call triangle x,y , x+dx,y+dy , x+dx1,y+dy1 , yellow
call triangle x+dx+dx1,y+dy+dy1 , x+dx,y+dy , x+dx1,y+dy1 , yellow
#m "color black"
#m "down"
#m "line ";x;" ";y;" ";x+dx;" ";y+dy
#m "line ";x+dx;" ";y+dy;" ";x+dx+dx1;" ";y+dy+dy1
#m "line ";x+dx+dx1;" ";y+dy+dy1;" ";x+dx1;" ";y+dy1
#m "line ";x+dx1;" ";y+dy1;" ";x;" ";y
#m "up"
end sub
sub rotate byref k , byref l , deg
s = sin( rad( deg ) )
c = cos( rad( deg ) )
hk = k * c - l * s
hl = k * s + l * c
k = hk
l = hl
end sub
function rad( deg )
rad = deg * pi / 180
end function
function getpixel( x , y )
calldll #gdi32 , "GetPixel" _
, hDC as ulong _
, x as long _
, y as long _
, getpixel as ulong
end function
sub triangle x1,y1 , x2,y2 , x3,y3 , kl
r = int( kl ) and 255
g = int( kl / 256 ) and 255
b = int( kl / 256 ^ 2 ) and 255
#m "color ";r;" ";g;" ";b
if y1 = y2 then y1 = y1 - 1e-6
if y2 = y3 then y3 = y3 + 1e-6
if y1 > y3 then
call swap y1 , y3
call swap x1 , x3
end if
if y1 > y2 then
call swap y1 , y2
call swap x1 , x2
end if
if y2 > y3 then
call swap y2 , y3
call swap x2 , y3
end if
for i = y1 to y3
a = x1 + ( x3 - x1 ) * (i-y1) / ( y3 - y1 )
if i < y2 then
b = x1 + ( x2 - x1 ) * (i-y1) / ( y2 - y1 )
else
b = x2 + ( x3 - x2 ) * (i-y2) / ( y3 - y2 )
end if
#m "down"
#m "line " ; a ; " " ; i _
; " " ; b ; " " ; i
#m "up"
next i
end sub
sub swap byref a , byref b
h = a
a = b
b = h
end sub
|
|
|
|
Post by tenochtitlanuk on Jan 18, 2019 12:59:11 GMT -5
I'll be very glad if you get this working- I've wanted to code this for years. My brother's son is Material Science prof running a lab at Stanford & stunned me when he showed photos of pentagonal crystals he'd grown back when they were first discovered- my crystallography background had taught me they were impossible.
You've left off the rgb() function definition. When I add it it fails on the triangle sub being called with fewer than the seven parameters it is defined as needing..
|
|
|
|
Post by bluatigro on Jan 20, 2019 4:17:54 GMT -5
update :
i look now for the closesed point to midscreen
added some REM so you can see what what shoot do
error :
dynamic lib call error
'' bluatigro 20 jan 2019
'' 2D quasi cristals
WindowWidth = 800
WindowHeight = 600
global winx , winy , pi , hDC , hw
global black , yellow , white , ptel , size
dim x( 20 * 4 ) , y( 20 * 4 )
black = rgb( 0 , 0 , 0 )
yellow = rgb( 255 , 255 , 0 )
white = rgb( 255 , 255 , 255 )
winx = WindowWidth
winy = WindowHeight
size = 60
pi = atn( 1 ) * 4
open "5 base tile" for graphics as #m
#m "trapclose [quit]"
hw = hwnd( #m )
calldll #user32, "GetDC" _
, hw as ulong _ 'handle of window or graphicbox client area
, hDC as ulong 'returns handle of Device Context - 0=failure
ptel = 0
''draw a random tile
call tile5 0,0 , irange( 1 , 4 ) , 0
while ptel < 20 * 4
''sort points
for h = 1 to ptel
for l = 0 to h - 1
if length(x(h),y(h))<length(x(l),y(l)) then
hx = x(h)
hy = y(h)
x(h)=x(l)
y(h)=y(l)
x(l)=hx
y(l)=hy
end if
next l
next h
dtel = 0
h = 0
''look for point whit white closest to mid screen
''and for rotation new tlie5 [ hoek ] [ first white ]
''and for size of white [ dtel ]
while dtel = 0
dx = size / 5
dy = 0
call rotate dx , dy , 18
dtel = 0
hoek = 0
fl = 0
washigh = 0
for i = 0 to 9
if getpixel( winx/2+x(h)+dx , winy/2+y(h)+dy ) = white then
dtel = dtel + 1
if fl = 0 then
if washigh = 0 then
fl = 1
hoek = i * 36
end if
end if
else
washigh = 1
fl = 0
end if
call rotate dx , dy , 36
next i
h = h + 1
wend
''draw new tile5
x = x( h )
y = y( h )
select case dtel
case 1
call tile5 x,y , 1 , hoek
case 2
call tile5 x,y , irange( 1 , 2 ) , hoek
case 3
call tile5 x,y , irange( 1 , 3 ) , hoek
case else
call tile5 x,y , irange( 1 , 4 ) , hoek
end select
wend
wait
[quit]
calldll #user32 , "ReleaseDC" _
, hw as ulong _ 'window handle
, hDC as ulong _ 'device context
, ret as long 'nonzero=success
close #m
end
function rgb( r , g , b )
rgb = r + g * 256 + b * 256 ^ 2
end function
function length( x , y )
length = sqr( x ^ 2 + y ^ 2 )
end function
function irange( low , high )
irange = int( rnd(0) * ( high - low + 1 ) + low )
end function
sub tile5 x , y , d , hoek
x( ptel ) = x
y( ptel ) = y
dx = size
dy = 0
call rotate dx , dy , hoek
x( ptel + 1 ) = x + dx
y( ptel + 1 ) = y + dy
dx1 = dx
dy1 = dy
call rotate dx1 , dy1 , d * 36
x( ptel + 2 ) = x + dx1
y( ptel + 2 ) = y + dy1
x( ptel + 3 ) = x + dx + dx1
y( ptel + 3 ) = y + dy + dy1
ptel = ptel + 4
x = x + winx / 2
y = y + winy / 2
call triangle x,y , x+dx,y+dy , x+dx1,y+dy1 , yellow
call triangle x+dx+dx1,y+dy+dy1 , x+dx,y+dy , x+dx1,y+dy1 , yellow
#m "color black"
#m "down"
#m "line ";x;" ";y;" ";x+dx;" ";y+dy
#m "line ";x+dx;" ";y+dy;" ";x+dx+dx1;" ";y+dy+dy1
#m "line ";x+dx+dx1;" ";y+dy+dy1;" ";x+dx1;" ";y+dy1
#m "line ";x+dx1;" ";y+dy1;" ";x;" ";y
#m "up"
end sub
sub rotate byref k , byref l , deg
s = sin( rad( deg ) )
c = cos( rad( deg ) )
hk = k * c - l * s
hl = k * s + l * c
k = hk
l = hl
end sub
function rad( deg )
rad = deg * pi / 180
end function
function getpixel( x , y )
calldll #gdi32 , "GetPixel" _
, hDC as ulong _
, x as long _
, y as long _
, getpixel as ulong
end function
sub triangle x1,y1 , x2,y2 , x3,y3 , kl
r = int( kl ) and 255
g = int( kl / 256 ) and 255
b = int( kl / 256 ^ 2 ) and 255
#m "color ";r;" ";g;" ";b
if y1 = y2 then y1 = y1 - 1e-6
if y2 = y3 then y3 = y3 + 1e-6
if y1 > y3 then
call swap y1 , y3
call swap x1 , x3
end if
if y1 > y2 then
call swap y1 , y2
call swap x1 , x2
end if
if y2 > y3 then
call swap y2 , y3
call swap x2 , y3
end if
for i = y1 to y3
a = x1 + ( x3 - x1 ) * (i-y1) / ( y3 - y1 )
if i < y2 then
b = x1 + ( x2 - x1 ) * (i-y1) / ( y2 - y1 )
else
b = x2 + ( x3 - x2 ) * (i-y2) / ( y3 - y2 )
end if
#m "down"
#m "line " ; a ; " " ; i _
; " " ; b ; " " ; i
#m "up"
next i
end sub
sub swap byref a , byref b
h = a
a = b
b = h
end sub
|
|
|
|
Post by Rod on Jan 20, 2019 4:48:12 GMT -5
Your getpixel function needs to make x and y an integer before calling the API.
|
|
|
|
Post by Rod on Jan 20, 2019 5:09:50 GMT -5
The forum can mess up the code spacing.
'' bluatigro 20 jan 2019
'' 2D quasi cristals
WindowWidth = 800
WindowHeight = 600
global winx , winy , pi , hDC , hw
global black , yellow , white , ptel , size
dim x( 20 * 4 ) , y( 20 * 4 )
black = rgb( 0 , 0 , 0 )
yellow = rgb( 255 , 255 , 0 )
white = rgb( 255 , 255 , 255 )
winx = WindowWidth
winy = WindowHeight
size = 60
pi = atn( 1 ) * 4
open "5 base tile" for graphics as #m
#m "trapclose [quit]"
hw = hwnd( #m )
calldll #user32, "GetDC" , hw as ulong , hDC as ulong
ptel = 0
''draw a random tile
call tile5 0,0 , irange( 1 , 4 ) , 0
while ptel < 20 * 4
''sort points
for h = 1 to ptel
for l = 0 to h - 1
if length(x(h),y(h))<length(x(l),y(l)) then
hx = x(h)
hy = y(h)
x(h)=x(l)
y(h)=y(l)
x(l)=hx
y(l)=hy
end if
next l
next h
dtel = 0
h = 0
''look for point whit white closest to mid screen
''and for rotation new tlie5 [ hoek ] [ first white ]
''and for size of white [ dtel ]
while dtel = 0
dx = size / 5
dy = 0
call rotate dx , dy , 18
dtel = 0
hoek = 0
fl = 0
washigh = 0
for i = 0 to 9
if getpixel( winx/2+x(h)+dx , winy/2+y(h)+dy ) = white then
dtel = dtel + 1
if fl = 0 then
if washigh = 0 then
fl = 1
hoek = i * 36
end if
end if
else
washigh = 1
fl = 0
end if
call rotate dx , dy , 36
next i
h = h + 1
wend
''draw new tile5
x = x( h )
y = y( h )
select case dtel
case 1
call tile5 x,y , 1 , hoek
case 2
call tile5 x,y , irange( 1 , 2 ) , hoek
case 3
call tile5 x,y , irange( 1 , 3 ) , hoek
case else
call tile5 x,y , irange( 1 , 4 ) , hoek
end select
wend
wait
[quit]
calldll #user32 , "ReleaseDC" , hw as ulong , hDC as ulong , ret as long
close #m
end
function rgb( r , g , b )
rgb = r + g * 256 + b * 256 ^ 2
end function
function length( x , y )
length = sqr( x ^ 2 + y ^ 2 )
end function
function irange( low , high )
irange = int( rnd(0) * ( high - low + 1 ) + low )
end function
sub tile5 x , y , d , hoek
x( ptel ) = x
y( ptel ) = y
dx = size
dy = 0
call rotate dx , dy , hoek
x( ptel + 1 ) = x + dx
y( ptel + 1 ) = y + dy
dx1 = dx
dy1 = dy
call rotate dx1 , dy1 , d * 36
x( ptel + 2 ) = x + dx1
y( ptel + 2 ) = y + dy1
x( ptel + 3 ) = x + dx + dx1
y( ptel + 3 ) = y + dy + dy1
ptel = ptel + 4
x = x + winx / 2
y = y + winy / 2
call triangle x,y , x+dx,y+dy , x+dx1,y+dy1 , yellow
call triangle x+dx+dx1,y+dy+dy1 , x+dx,y+dy , x+dx1,y+dy1 , yellow
#m "color black"
#m "down"
#m "line ";x;" ";y;" ";x+dx;" ";y+dy
#m "line ";x+dx;" ";y+dy;" ";x+dx+dx1;" ";y+dy+dy1
#m "line ";x+dx+dx1;" ";y+dy+dy1;" ";x+dx1;" ";y+dy1
#m "line ";x+dx1;" ";y+dy1;" ";x;" ";y
#m "up"
end sub
sub rotate byref k , byref l , deg
s = sin( rad( deg ) )
c = cos( rad( deg ) )
hk = k * c - l * s
hl = k * s + l * c
k = hk
l = hl
end sub
function rad( deg )
rad = deg * pi / 180
end function
function getpixel( x , y )
x=int(x)
y=int(y)
calldll #gdi32 , "GetPixel" _
, hDC as ulong _
, x as long _
, y as long _
, getpixel as ulong
end function
sub triangle x1,y1 , x2,y2 , x3,y3 , kl
r = int( kl ) and 255
g = int( kl / 256 ) and 255
b = int( kl / 256 ^ 2 ) and 255
#m "color ";r;" ";g;" ";b
if y1 = y2 then y1 = y1 - 1e-6
if y2 = y3 then y3 = y3 + 1e-6
if y1 > y3 then
call swap y1 , y3
call swap x1 , x3
end if
if y1 > y2 then
call swap y1 , y2
call swap x1 , x2
end if
if y2 > y3 then
call swap y2 , y3
call swap x2 , y3
end if
for i = y1 to y3
a = x1 + ( x3 - x1 ) * (i-y1) / ( y3 - y1 )
if i < y2 then
b = x1 + ( x2 - x1 ) * (i-y1) / ( y2 - y1 )
else
b = x2 + ( x3 - x2 ) * (i-y2) / ( y3 - y2 )
end if
#m "down"
#m "line " ; a ; " " ; i ; " " ; b ; " " ; i
#m "up"
next i
end sub
sub swap byref a , byref b
h = a
a = b
b = h
end sub
|
|
|
|
Post by bluatigro on Jan 21, 2019 3:02:05 GMT -5
update :
try 3
WARNING : this wil freze your pc
'' bluatigro 20 jan 2019
'' 2D quasi cristals
WindowWidth = 800
WindowHeight = 600
global winx , winy , pi , hDC , hw
global black , yellow , white , ptel , size
dim x( 20 * 4 ) , y( 20 * 4 )
black = rgb( 0 , 0 , 0 )
yellow = rgb( 255 , 255 , 0 )
white = rgb( 255 , 255 , 255 )
winx = WindowWidth
winy = WindowHeight
size = 60
pi = atn( 1 ) * 4
open "5 base tile" for graphics as #m
#m "trapclose [quit]"
hw = hwnd( #m )
calldll #user32, "GetDC" _
, hw as ulong _ 'handle of window or graphicbox client area
, hDC as ulong 'returns handle of Device Context - 0=failure
ptel = 0
''draw a random tile
call tile5 0,0 , irange( 1 , 4 ) , 0
while ptel < 20 * 4
''sort points
for h = 1 to ptel
for l = 0 to h - 1
if length(x(h),y(h))<length(x(l),y(l)) then
hx = x(h)
hy = y(h)
x(h)=x(l)
y(h)=y(l)
x(l)=hx
y(l)=hy
end if
next l
next h
dtel = 0
h = 0
''look for point whit white closest to mid screen
''and for size of white [ dtel ]
while dtel = 0
''point in tile
dx = size / 5
dy = 0
call rotate dx , dy , 18
for i = 0 to 9
if getpixel( winx/2+x(h)+dx , winy/2+y(h)+dy ) = white then
dtel = dtel + 1
end if
call rotate dx , dy , 36
next i
wend
''look for rotation [ hoek ] of tile
dx = size / 5
dy = 0
x = x( h )
y = y( h )
hoek = 0
call rotate dx , dy , 18
if getpixel(winx/2+x+dx,winy/2+y+dy) = white then
fl = 1
while getpixel(winx/2+x+dx,winy/2+y+dy ) = white
call rotate dx , dy , -38
hoek = hoek - 38
wend
else
fl = 0
while getpixel(winx/2+x+dx,winy/2+y+dy ) = yellow
call rotate dx , dy , 38
hoek = hoek + 38
wend
end if
''draw new tile5
select case dtel
case 1
call tile5 x,y , 1 , hoek
case 2
call tile5 x,y , irange( 1 , 2 ) , hoek
case 3
call tile5 x,y , irange( 1 , 3 ) , hoek
case else
call tile5 x,y , irange( 1 , 4 ) , hoek
end select
wend
wait
[quit]
calldll #user32 , "ReleaseDC" _
, hw as ulong _ 'window handle
, hDC as ulong _ 'device context
, ret as long 'nonzero=success
close #m
end
function rgb( r , g , b )
rgb = r + g * 256 + b * 256 ^ 2
end function
function length( x , y )
length = sqr( x ^ 2 + y ^ 2 )
end function
function irange( low , high )
irange = int( rnd(0) * ( high - low + 1 ) + low )
end function
sub tile5 x , y , d , hoek
x( ptel ) = x
y( ptel ) = y
dx = size
dy = 0
call rotate dx , dy , hoek
x( ptel + 1 ) = x + dx
y( ptel + 1 ) = y + dy
dx1 = dx
dy1 = dy
call rotate dx1 , dy1 , d * 36
x( ptel + 2 ) = x + dx1
y( ptel + 2 ) = y + dy1
x( ptel + 3 ) = x + dx + dx1
y( ptel + 3 ) = y + dy + dy1
ptel = ptel + 4
x = x + winx / 2
y = y + winy / 2
call triangle x,y , x+dx,y+dy , x+dx1,y+dy1 , yellow
call triangle x+dx+dx1,y+dy+dy1 , x+dx,y+dy , x+dx1,y+dy1 , yellow
#m "color black"
#m "down"
#m "line ";x;" ";y;" ";x+dx;" ";y+dy
#m "line ";x+dx;" ";y+dy;" ";x+dx+dx1;" ";y+dy+dy1
#m "line ";x+dx+dx1;" ";y+dy+dy1;" ";x+dx1;" ";y+dy1
#m "line ";x+dx1;" ";y+dy1;" ";x;" ";y
#m "up"
end sub
sub rotate byref k , byref l , deg
s = sin( rad( deg ) )
c = cos( rad( deg ) )
hk = k * c - l * s
hl = k * s + l * c
k = hk
l = hl
end sub
function rad( deg )
rad = deg * pi / 180
end function
function getpixel( x , y )
x = int( x )
y = int( y )
calldll #gdi32 , "GetPixel" _
, hDC as ulong _
, x as long _
, y as long _
, getpixel as ulong
end function
sub triangle x1,y1 , x2,y2 , x3,y3 , kl
r = int( kl ) and 255
g = int( kl / 256 ) and 255
b = int( kl / 256 ^ 2 ) and 255
#m "color ";r;" ";g;" ";b
if y1 = y2 then y1 = y1 - 1e-6
if y2 = y3 then y3 = y3 + 1e-6
if y1 > y3 then
call swap y1 , y3
call swap x1 , x3
end if
if y1 > y2 then
call swap y1 , y2
call swap x1 , x2
end if
if y2 > y3 then
call swap y2 , y3
call swap x2 , y3
end if
for i = y1 to y3
a = x1 + ( x3 - x1 ) * (i-y1) / ( y3 - y1 )
if i < y2 then
b = x1 + ( x2 - x1 ) * (i-y1) / ( y2 - y1 )
else
b = x2 + ( x3 - x2 ) * (i-y2) / ( y3 - y2 )
end if
#m "down"
#m "line " ; a ; " " ; i _
; " " ; b ; " " ; i
#m "up"
next i
end sub
sub swap byref a , byref b
h = a
a = b
b = h
end sub
|
|
|
|
Post by bluatigro on Jan 21, 2019 3:30:13 GMT -5
update :
frezing fixed
error :
some of my tiles are verry not good
'' bluatigro 21 jan 2019
'' 2D quasi cristals
WindowWidth = 800
WindowHeight = 600
global winx , winy , pi , hDC , hw
global black , yellow , white , ptel , size
dim x( 20 * 4 ) , y( 20 * 4 )
black = rgb( 0 , 0 , 0 )
yellow = rgb( 255 , 255 , 0 )
white = rgb( 255 , 255 , 255 )
winx = WindowWidth
winy = WindowHeight
size = 60
pi = atn( 1 ) * 4
nomainwin
open "5 base tile" for graphics as #m
#m "trapclose [quit]"
hw = hwnd( #m )
calldll #user32, "GetDC" _
, hw as ulong _ 'handle of window or graphicbox client area
, hDC as ulong 'returns handle of Device Context - 0=failure
ptel = 0
''draw a random tile
call tile5 0,0 , irange( 1 , 4 ) , 0
while ptel < 20 * 4
''sort points
for h = 1 to ptel
for l = 0 to h - 1
if length(x(h),y(h))<length(x(l),y(l)) then
hx = x(h)
hy = y(h)
x(h)=x(l)
y(h)=y(l)
x(l)=hx
y(l)=hy
end if
next l
next h
dtel = 0
h = 0
''look for point whit white closest to mid screen
''and for size of white [ dtel ]
while dtel = 0
''point in tile
dx = size / 5
dy = 0
call rotate dx , dy , 18
for i = 0 to 9
if getpixel( winx/2+x(h)+dx , winy/2+y(h)+dy ) = white then
dtel = dtel + 1
end if
call rotate dx , dy , 36
next i
wend
''look for rotation [ hoek ] of tile
dx = size / 5
dy = 0
x = x( h )
y = y( h )
hoek = 0
tel = 0
call rotate dx , dy , 18
if getpixel(winx/2+x+dx,winy/2+y+dy) = white then
fl = 1
while getpixel(winx/2+x+dx,winy/2+y+dy ) = white _
and tel < 9
call rotate dx , dy , -38
hoek = hoek - 38
tel = tel + 1
wend
else
fl = 0
while getpixel(winx/2+x+dx,winy/2+y+dy ) = yellow _
and tel < 9
call rotate dx , dy , 38
hoek = hoek + 38
tel = tel + 1
wend
end if
''draw new tile5
select case dtel
case 1
call tile5 x,y , 1 , hoek
case 2
call tile5 x,y , irange( 1 , 2 ) , hoek
case 3
call tile5 x,y , irange( 1 , 3 ) , hoek
case else
call tile5 x,y , irange( 1 , 4 ) , hoek
end select
wend
wait
[quit]
calldll #user32 , "ReleaseDC" _
, hw as ulong _ 'window handle
, hDC as ulong _ 'device context
, ret as long 'nonzero=success
close #m
end
function rgb( r , g , b )
rgb = r + g * 256 + b * 256 ^ 2
end function
function length( x , y )
length = sqr( x ^ 2 + y ^ 2 )
end function
function irange( low , high )
irange = int( rnd(0) * ( high - low + 1 ) + low )
end function
sub tile5 x , y , d , hoek
x( ptel ) = x
y( ptel ) = y
dx = size
dy = 0
call rotate dx , dy , hoek
x( ptel + 1 ) = x + dx
y( ptel + 1 ) = y + dy
dx1 = dx
dy1 = dy
call rotate dx1 , dy1 , d * 36
x( ptel + 2 ) = x + dx1
y( ptel + 2 ) = y + dy1
x( ptel + 3 ) = x + dx + dx1
y( ptel + 3 ) = y + dy + dy1
ptel = ptel + 4
x = x + winx / 2
y = y + winy / 2
call triangle x,y , x+dx,y+dy , x+dx1,y+dy1 , yellow
call triangle x+dx+dx1,y+dy+dy1 , x+dx,y+dy , x+dx1,y+dy1 , yellow
#m "color black"
#m "down"
#m "line ";x;" ";y;" ";x+dx;" ";y+dy
#m "line ";x+dx;" ";y+dy;" ";x+dx+dx1;" ";y+dy+dy1
#m "line ";x+dx+dx1;" ";y+dy+dy1;" ";x+dx1;" ";y+dy1
#m "line ";x+dx1;" ";y+dy1;" ";x;" ";y
#m "up"
end sub
sub rotate byref k , byref l , deg
s = sin( rad( deg ) )
c = cos( rad( deg ) )
hk = k * c - l * s
hl = k * s + l * c
k = hk
l = hl
end sub
function rad( deg )
rad = deg * pi / 180
end function
function getpixel( x , y )
x = int( x )
y = int( y )
calldll #gdi32 , "GetPixel" _
, hDC as ulong _
, x as long _
, y as long _
, getpixel as ulong
end function
sub triangle x1,y1 , x2,y2 , x3,y3 , kl
r = int( kl ) and 255
g = int( kl / 256 ) and 255
b = int( kl / 256 ^ 2 ) and 255
#m "color ";r;" ";g;" ";b
if y1 = y2 then y1 = y1 - 1e-6
if y2 = y3 then y3 = y3 + 1e-6
if y1 > y3 then
call swap y1 , y3
call swap x1 , x3
end if
if y1 > y2 then
call swap y1 , y2
call swap x1 , x2
end if
if y2 > y3 then
call swap y2 , y3
call swap x2 , y3
end if
for i = y1 to y3
a = x1 + ( x3 - x1 ) * (i-y1) / ( y3 - y1 )
if i < y2 then
b = x1 + ( x2 - x1 ) * (i-y1) / ( y2 - y1 )
else
b = x2 + ( x3 - x2 ) * (i-y2) / ( y3 - y2 )
end if
#m "down"
#m "line " ; a ; " " ; i _
; " " ; b ; " " ; i
#m "up"
next i
end sub
sub swap byref a , byref b
h = a
a = b
b = h
end sub
|
|
