Posts: 4,702
Threads: 222
Joined: Apr 2022
Reputation:
322
(06-05-2023, 05:35 PM)Kernelpanic Wrote: 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.  Go ahead and type ( r ) without the spaces here in editor and see how it comes out as (r).
724 855 599 923 575 468 400 206 147 564 878 823 652 556 bxor cross forever
Posts: 957
Threads: 52
Joined: May 2022
Reputation:
38
(06-05-2023, 05:37 PM)bplus Wrote: (06-05-2023, 05:35 PM)Kernelpanic Wrote: 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. Go ahead and type ( r ) without the spaces here in editor and see how it comes out as (r). Is this now an English or an Ameran joke? I do not know what You mean.
You need more relaxations! Really!
Posts: 4,702
Threads: 222
Joined: Apr 2022
Reputation:
322
06-05-2023, 05:50 PM
(This post was last modified: 06-05-2023, 05:54 PM by bplus.)
(06-05-2023, 05:45 PM)Kernelpanic Wrote: (06-05-2023, 05:37 PM)bplus Wrote: (06-05-2023, 05:35 PM)Kernelpanic Wrote: You need more inner relaxation @bplus! Hm, "unexpected character" . . . did you forget "Option Explicit" again? - The old Basic veterans. Go ahead and type ( r ) without the spaces here in editor and see how it comes out as (r). Is this now an English or an Ameran joke? I do not know what You mean.
You need more relaxations! Really! Type "(" then "r" then ")" in this here editor and watch it turned into (r), no joke.
but
Code: (Select All) print "(r)"
should be ok
but Code: (Select All)
print "(r)"
might not be ok
Here is what I see:
724 855 599 923 575 468 400 206 147 564 878 823 652 556 bxor cross forever
Posts: 4,702
Threads: 222
Joined: Apr 2022
Reputation:
322
06-05-2023, 06:06 PM
(This post was last modified: 06-05-2023, 07:53 PM by bplus.)
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...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
Not having much luck with qbjs, every time I try some stupid thing hangs things up.
What is it this time? @dbox
724 855 599 923 575 468 400 206 147 564 878 823 652 556 bxor cross forever
Posts: 957
Threads: 52
Joined: May 2022
Reputation:
38
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)
Posts: 4,702
Threads: 222
Joined: Apr 2022
Reputation:
322
06-05-2023, 06:17 PM
(This post was last modified: 06-05-2023, 07:54 PM by bplus.)
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
724 855 599 923 575 468 400 206 147 564 878 823 652 556 bxor cross forever
Posts: 4,702
Threads: 222
Joined: Apr 2022
Reputation:
322
(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!
724 855 599 923 575 468 400 206 147 564 878 823 652 556 bxor cross forever
Posts: 957
Threads: 52
Joined: May 2022
Reputation:
38
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)
Posts: 957
Threads: 52
Joined: May 2022
Reputation:
38
With Option Explicit It runs too! Where is the problem? 
Posts: 4,702
Threads: 222
Joined: Apr 2022
Reputation:
322
06-05-2023, 06:43 PM
(This post was last modified: 06-05-2023, 06:44 PM by bplus.)
(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???
724 855 599 923 575 468 400 206 147 564 878 823 652 556 bxor cross forever
|
