+- QB64 Phoenix Edition (https://qb64phoenix.com/forum)
+-- Forum: QB64 Rising (https://qb64phoenix.com/forum/forumdisplay.php?fid=1)
+--- Forum: Code and Stuff (https://qb64phoenix.com/forum/forumdisplay.php?fid=3)
+---- Forum: Programs (https://qb64phoenix.com/forum/forumdisplay.php?fid=7)
+---- Thread: Random Tessellations (/showthread.php?tid=1668)
RE: Random Tessellations - bplus - 06-05-2023
(06-05-2023, 05:35 PM)Kernelpanic Wrote:Go ahead and type ( r ) without the spaces here in editor and see how it comes out as (r).Quote:@bplus - Where is the << coming from?You need more inner relaxation @bplus!Hm, "unexpected character" . . . did you forget "Option Explicit" again? - The old Basic veterans.
RE: Random Tessellations - Kernelpanic - 06-05-2023
(06-05-2023, 05:37 PM)bplus Wrote:Is this now an English or an Ameran joke? I do not know what You mean.(06-05-2023, 05:35 PM)Kernelpanic Wrote:Go ahead and type ( r ) without the spaces here in editor and see how it comes out as (r).Quote:@bplus - Where is the << coming from?You need more inner relaxation @bplus!
You need more relaxations! Really!
RE: Random Tessellations - bplus - 06-05-2023
(06-05-2023, 05:45 PM)Kernelpanic Wrote:Type "(" then "r" then ")" in this here editor and watch it turned into (r), no joke.(06-05-2023, 05:37 PM)bplus Wrote:Is this now an English or an Ameran joke? I do not know what You mean.(06-05-2023, 05:35 PM)Kernelpanic Wrote: You need more inner relaxation @bplus!Go ahead and type ( r ) without the spaces here in editor and see how it comes out as (r).
You need more relaxations! Really!
but
Code: (Select All)
print "(r)"should be ok
but
Code: (Select All)
print "(r)"
Here is what I see:
RE: Random Tessellations - bplus - 06-05-2023
OK now try in qbjs
Code: (Select All)
' Option _Explicit to find undim variables
_Title "Tessellation 4" ' b+ 2023-05-19
' Inspired by Charlie's BAM example:
' https://qb64phoenix.com/forum/showthread.php?tid=1646&pid=15772#pid15772
' b+ 2023-05-09 - Tiling with a pattern
' Tessellation 2 will try color filled with more background black.
' Tessellation 3 Charlie mentions a mirror image for interesting tessellating,
' lets try mirroring both x and y axis.
'
' Tessellation 4
' Use b key to toggle between:
' 1. 3 color tessellation
' 2. 4 color tessellation
' and use c key to toggle between:
' 1. a random set of colors
' 2. contrast (a red, a green, a blue and 4th is white)
'
'DefLng A-Z
Randomize Timer
Screen _NewImage(800, 600, 32) ' full rgb range here
_ScreenMove 250, 50
Dim Shared Pix ' Pix is number of pixels to Tile side
Dim Shared Scale ' Change a pixel to a bigger square block for not so subtle patterns
Dim Shared Tile ' Handle that stores Tile Image in memory to call up with _PutImage
Dim Shared B ' Toggle color mode from 3 to 4 and back
Dim Shared C ' Toggle Contrast set and Random set of colors
ReDim Shared Pal(1 To 4) As _Unsigned Long ' palette to hold 3 or 4 colors
Dim K$, t$
Do
K$ = InKey$
If K$ = "b" Then B = 1 - B ' toggle coloring mode on a b keypress
If K$ = "c" Then C = 1 - C ' toggle coloring mode on a b keypress
' update the title according current b and c toggles
If B Then t$ = "4" Else t$ = "3"
If C Then t$ = t$ + " Contrasted Colors" Else t$ = t$ + " Random Colors"
_Title t$ + ": use b to toggle 3|4 colors, c to toggle random|contrast, any other for next screen"
MakePalette ' 3 or 4 random colors according to b
MakeTile ' create a new random tiling pattern
Tessellate ' tile the screen with it
_PrintString (740, 580), "ZZZ..." ' Show user we are sleeping awaiting a key press
Sleep
Loop Until _KeyDown(27) ' quit when detect escape key on sleep
Sub MakePalette
Dim As Long n, i
If B Then n = 4 Else n = 3
ReDim Pal(1 To n) As _Unsigned Long
For i = 1 To n
If C Then
If B Then
If i = 4 Then Pal(i) = C3~&(999) Else Pal(i) = C3~&(10 ^ (i - 1) * Int(Rnd * 10))
Else
Pal(i) = C3~&(10 ^ (i - 1) * Int(Rnd * 10))
End If
Else
Pal(i) = C3~&(Int(Rnd * 1000))
End If
Next
End Sub
Sub MakeTile ' make a random tile to Tesselate according to B Mode coloring
Pix = Int(Rnd * 9) + 4 ' sets tile size: pix X pix or a 4X4 to 12X12 Tile coloring
Scale = Int(Rnd * 6) + 4 ' to change pixels to square blocks
If Tile Then _FreeImage Tile ' throw old image away
Tile = _NewImage(2 * Scale * Pix - 1, 2 * Scale * Pix - 1) ' make new one
_Dest Tile ' draw in the memory area Tile not on screen
Dim As Long y, x, q
For y = 0 To Scale * Pix Step Scale
For x = 0 To Scale * Pix Step Scale
If B Then q = Int(Rnd * 4) + 1 Else q = Int(Rnd * 3) + 1
Line (x, y)-Step(Scale, Scale), Pal(q), BF ' this should be integer since Tile is
Line (2 * Scale * Pix - x - 1, y)-Step(Scale, Scale), Pal(q), BF
Line (x, 2 * Scale * Pix - y - 1)-Step(Scale, Scale), Pal(q), BF
Line (2 * Scale * Pix - x - 1, 2 * Scale * Pix - y - 1)-Step(Scale, Scale), Pal(q), BF
Next
Next
_Dest 0
End Sub
Sub Tessellate ' just covering the screen with our Tile
Dim As Long y, x
For y = 0 To _Height Step 2 * Scale * Pix
For x = 0 To _Width Step 2 * Scale * Pix
_PutImage (x, y)-Step(2 * Scale * Pix, 2 * Scale * Pix), Tile, 0
Next
Next
End Sub
Function C3~& (n) ' New (even less typing!) New Color System 1000 colors with up to 3 digits
Dim s3$, r As Long, g As Long, b As Long
s3$ = Right$("000" + LTrim$(Str$(n)), 3)
r = Val(Mid$(s3$, 1, 1)): If r Then r = 28 * r + 3
g = Val(Mid$(s3$, 2, 1)): If g Then g = 28 * g + 3
b = Val(Mid$(s3$, 3, 1)): If b Then b = 28 * b + 3
C3~& = _RGB32(r, g, b)
End Function
Not having much luck with qbjs, every time I try some stupid thing hangs things up.
What is it this time? @dbox
RE: Random Tessellations - Kernelpanic - 06-05-2023
Quote:@bplus - Type "(" then "r" then ")" in this here editor and watch it turned into ®, no joke.Well, not with me. It stays as it is.
![[Image: r-Problem2023-06-05-201519.jpg]](https://i.ibb.co/9t2kbTH/r-Problem2023-06-05-201519.jpg)
RE: Random Tessellations - bplus - 06-05-2023
OK all colons removed and still nutt'n in QBJS
Code: (Select All)
Option _Explicit
_Title "Tessellation 4" ' b+ 2023-05-19
' Inspired by Charlie's BAM example
' https(colon)//qb64phoenix.com/forum/showthread.php?tid=1646&pid=15772#pid15772
' b+ 2023-05-09 - Tiling with a pattern
' Tessellation 2 will try color filled with more background black.
' Tessellation 3 Charlie mentions a mirror image for interesting tessellating,
' lets try mirroring both x and y axis.
'
' Tessellation 4
' Use b key to toggle between
' 1. 3 color tessellation
' 2. 4 color tessellation
' and use c key to toggle between
' 1. a random set of colors
' 2. contrast (a red, a green, a blue and 4th is white)
'
'DefLng A-Z
Randomize Timer
Screen _NewImage(800, 600, 32) ' full rgb range here
_ScreenMove 250, 50
Dim Shared Pix ' Pix is number of pixels to Tile side
Dim Shared Scale ' Change a pixel to a bigger square block for not so subtle patterns
Dim Shared Tile ' Handle that stores Tile Image in memory to call up with _PutImage
Dim Shared B ' Toggle color mode from 3 to 4 and back
Dim Shared C ' Toggle Contrast set and Random set of colors
ReDim Shared Pal(1 To 4) As _Unsigned Long ' palette to hold 3 or 4 colors
Dim K$, t$
Do
K$ = InKey$
If K$ = "b" Then B = 1 - B ' toggle coloring mode on a b keypress
If K$ = "c" Then C = 1 - C ' toggle coloring mode on a b keypress
' update the title according current b and c toggles
If B Then t$ = "4" Else t$ = "3"
If C Then t$ = t$ + " Contrasted Colors" Else t$ = t$ + " Random Colors"
_Title t$ + ">>> use b to toggle 3|4 colors, c to toggle random|contrast, any other for next screen"
MakePalette ' 3 or 4 random colors according to b
MakeTile ' create a new random tiling pattern
Tessellate ' tile the screen with it
_PrintString (740, 580), "ZZZ..." ' Show user we are sleeping awaiting a key press
Sleep
Loop Until _KeyDown(27) ' quit when detect escape key on sleep
Sub MakePalette
Dim As Long n, i
If B Then n = 4 Else n = 3
ReDim Pal(1 To n) As _Unsigned Long
For i = 1 To n
If C Then
If B Then
If i = 4 Then Pal(i) = C3~&(999) Else Pal(i) = C3~&(10 ^ (i - 1) * Int(Rnd * 10))
Else
Pal(i) = C3~&(10 ^ (i - 1) * Int(Rnd * 10))
End If
Else
Pal(i) = C3~&(Int(Rnd * 1000))
End If
Next
End Sub
Sub MakeTile ' make a random tile to Tesselate according to B Mode coloring
Pix = Int(Rnd * 9) + 4 ' sets tile size pix X pix or a 4X4 to 12X12 Tile coloring
Scale = Int(Rnd * 6) + 4 ' to change pixels to square blocks
If Tile Then _FreeImage Tile ' throw old image away
Tile = _NewImage(2 * Scale * Pix - 1, 2 * Scale * Pix - 1) ' make new one
_Dest Tile ' draw in the memory area Tile not on screen
Dim As Long y, x, q
For y = 0 To Scale * Pix Step Scale
For x = 0 To Scale * Pix Step Scale
If B Then q = Int(Rnd * 4) + 1 Else q = Int(Rnd * 3) + 1
Line (x, y)-Step(Scale, Scale), Pal(q), BF ' this should be integer since Tile is
Line (2 * Scale * Pix - x - 1, y)-Step(Scale, Scale), Pal(q), BF
Line (x, 2 * Scale * Pix - y - 1)-Step(Scale, Scale), Pal(q), BF
Line (2 * Scale * Pix - x - 1, 2 * Scale * Pix - y - 1)-Step(Scale, Scale), Pal(q), BF
Next
Next
_Dest 0
End Sub
Sub Tessellate ' just covering the screen with our Tile
Dim As Long y, x
For y = 0 To _Height Step 2 * Scale * Pix
For x = 0 To _Width Step 2 * Scale * Pix
_PutImage (x, y)-Step(2 * Scale * Pix, 2 * Scale * Pix), Tile, 0
Next
Next
End Sub
Function C3~& (n) ' New (even less typing!) New Color System 1000 colors with up to 3 digits
Dim s3$, r As Long, g As Long, b As Long
s3$ = Right$("000" + LTrim$(Str$(n)), 3)
r = Val(Mid$(s3$, 1, 1))
If r Then r = 28 * r + 3
g = Val(Mid$(s3$, 2, 1))
If g Then g = 28 * g + 3
b = Val(Mid$(s3$, 3, 1))
If b Then b = 28 * b + 3
C3~& = _RGB32(r, g, b)
End Function
RE: Random Tessellations - bplus - 06-05-2023
(06-05-2023, 06:17 PM)Kernelpanic Wrote:Quote:@bplus - Type "(" then "r" then ")" in this here editor and watch it turned into ®, no joke.Well, not with me. It stays as it is.
You funny guy!
RE: Random Tessellations - Kernelpanic - 06-05-2023
Nullo problemo! It runs.
Code: (Select All)
' Option _Explicit to find undim variables
_Title "Tessellation 4" ' b+ 2023-05-19
' Inspired by Charlie's BAM example:
' https://qb64phoenix.com/forum/showthread...2#pid15772
' b+ 2023-05-09 - Tiling with a pattern
' Tessellation 2 will try color filled with more background black.
' Tessellation 3 Charlie mentions a mirror image for interesting tessellating,
' lets try mirroring both x and y axis.
'
' Tessellation 4
' Use b key to toggle between:
' 1. 3 color tessellation
' 2. 4 color tessellation
' and use c key to toggle between:
' 1. a random set of colors
' 2. contrast (a red, a green, a blue and 4th is white)
'
'DefLng A-Z
Randomize Timer
Screen _NewImage(800, 600, 32) ' full rgb range here
_ScreenMove 250, 50
Dim Shared Pix ' Pix is number of pixels to Tile side
Dim Shared Scale ' Change a pixel to a bigger square block for not so subtle patterns
Dim Shared Tile ' Handle that stores Tile Image in memory to call up with _PutImage
Dim Shared B ' Toggle color mode from 3 to 4 and back
Dim Shared C ' Toggle Contrast set and Random set of colors
ReDim Shared Pal(1 To 4) As _Unsigned Long ' palette to hold 3 or 4 colors
Dim K$, t$
Do
K$ = InKey$
If K$ = "b" Then B = 1 - B ' toggle coloring mode on a b keypress
If K$ = "c" Then C = 1 - C ' toggle coloring mode on a b keypress
' update the title according current b and c toggles
If B Then t$ = "4" Else t$ = "3"
If C Then t$ = t$ + " Contrasted Colors" Else t$ = t$ + " Random Colors"
_Title t$ + ": use b to toggle 3|4 colors, c to toggle random|contrast, any other for next screen"
MakePalette ' 3 or 4 random colors according to b
MakeTile ' create a new random tiling pattern
Tessellate ' tile the screen with it
_PrintString (740, 580), "ZZZ..." ' Show user we are sleeping awaiting a key press
Sleep
Loop Until _KeyDown(27) ' quit when detect escape key on sleep
Sub MakePalette
Dim As Long n, i
If B Then n = 4 Else n = 3
ReDim Pal(1 To n) As _Unsigned Long
For i = 1 To n
If C Then
If B Then
If i = 4 Then Pal(i) = C3~&(999) Else Pal(i) = C3~&(10 ^ (i - 1) * Int(Rnd * 10))
Else
Pal(i) = C3~&(10 ^ (i - 1) * Int(Rnd * 10))
End If
Else
Pal(i) = C3~&(Int(Rnd * 1000))
End If
Next
End Sub
Sub MakeTile ' make a random tile to Tesselate according to B Mode coloring
Pix = Int(Rnd * 9) + 4 ' sets tile size: pix X pix or a 4X4 to 12X12 Tile coloring
Scale = Int(Rnd * 6) + 4 ' to change pixels to square blocks
If Tile Then _FreeImage Tile ' throw old image away
Tile = _NewImage(2 * Scale * Pix - 1, 2 * Scale * Pix - 1) ' make new one
_Dest Tile ' draw in the memory area Tile not on screen
Dim As Long y, x, q
For y = 0 To Scale * Pix Step Scale
For x = 0 To Scale * Pix Step Scale
If B Then q = Int(Rnd * 4) + 1 Else q = Int(Rnd * 3) + 1
Line (x, y)-Step(Scale, Scale), Pal(q), BF ' this should be integer since Tile is
Line (2 * Scale * Pix - x - 1, y)-Step(Scale, Scale), Pal(q), BF
Line (x, 2 * Scale * Pix - y - 1)-Step(Scale, Scale), Pal(q), BF
Line (2 * Scale * Pix - x - 1, 2 * Scale * Pix - y - 1)-Step(Scale, Scale), Pal(q), BF
Next
Next
_Dest 0
End Sub
Sub Tessellate ' just covering the screen with our Tile
Dim As Long y, x
For y = 0 To _Height Step 2 * Scale * Pix
For x = 0 To _Width Step 2 * Scale * Pix
_PutImage (x, y)-Step(2 * Scale * Pix, 2 * Scale * Pix), Tile, 0
Next
Next
End Sub
Function C3~& (n) ' New (even less typing!) New Color System 1000 colors with up to 3 digits
Dim s3$, r As Long, g As Long, b As Long
s3$ = Right$("000" + LTrim$(Str$(n)), 3)
r = Val(Mid$(s3$, 1, 1)): If r Then r = 28 * r + 3
g = Val(Mid$(s3$, 2, 1)): If g Then g = 28 * g + 3
b = Val(Mid$(s3$, 3, 1)): If b Then b = 28 * b + 3
C3~& = _RGB32(r, g, b)
End Function![[Image: Tessellation4-2023-06-05.jpg]](https://i.ibb.co/L5V5wJH/Tessellation4-2023-06-05.jpg)
RE: Random Tessellations - Kernelpanic - 06-05-2023
With Option Explicit It runs too! Where is the problem?
RE: Random Tessellations - bplus - 06-05-2023
(06-05-2023, 06:37 PM)Kernelpanic Wrote: With Option Explicit It runs too! Where is the problem?It doesn't work in QBJS. Have you tried QBJS? pretty nice when it works
I always have bad luck, now can't even get QBJS tags to work???