Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
Random Tessellations
#2
Tessellation madness, because I couldn't help myself.

"x","X","y","Y",",",".","[","]","-","=" all do something.  Maybe this could be made more coherent, but what fun is that?

EDIT: commented out DEflng, shifting X&Y works now.

Code: (Select All)
_Title "Tessellation Madness"
'based on progrma by  b+ 2023-05-09 - Tiling with a pattern
'
' Inspired by Charlie's BAM example:
' https://qb64phoenix.com/forum/showthread.php?tid=1646&pid=15772#pid15772
'
' But I also wanted to try a colorized version.
'
'  So use b key to toggle between:
'  1. a mod of Charlies version with different pixel block size with black backgrounds
'  2. the colorized version which reminds me of Magic Eye Art
'
'DefLng A-Z ' EDITED OUT
Screen _NewImage(800, 600, 256) ' only 16 colors 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 '     Set color mode from Full 16 colors Rainbow to 1 like for printing a label
Dim Shared olap ' tile overlap , probably wrong name
Dim Shared rr 'ramdom offset on or off
Dim Shared xs ' tile x shift
Dim Shared ys 'tile y shift
olap = 0
xs = 1.5
ys = 1.5
Pix = Int(Rnd * 16) + 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

Do
    kk$ = InKey$
    Select Case kk$
        Case "b"
            B = 1 - B
        Case "r"
            r = 1 - r
        Case ",", "<"
            olap = olap - 1
            If olap < -3 Then olap = -3
        Case "x"
            xs = xs - .1
        Case "y"
            ys = ys - .1
        Case "X"
            xs = xs + .1
        Case "Y"
            ys = ys + .1
        Case ".", ">"
            olap = olap + 1
        Case "-"
            Pix = Pix - 1
            If Pix < 2 Then Pix = 2
        Case "="
            Pix = Pix + 1
        Case "["
            Scale = Scale - 1
            If Scale < 2 Then Scale = 2
        Case "]"
            Scale = Scale + 1
    End Select
    MakeTile '                          create a new random tiling pattern
    Tessellate '                        tile the screen with it


    ' 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 MakeTile ' make a random tile to Tesselate according to B Mode coloring
    'Pix = Int(Rnd * 16) + 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(Scale * Pix - 1, Scale * Pix - 1) '   make new one
    _Dest Tile '                       draw in the memory area Tile not on screen
    oneColor = Int(Rnd * 255) + 1 '     one color and black background for B Mode
    For p = 1 To Pix * Pix
        'For y = 0 To Scale * Pix - 1 Step Scale
        '' For x = 0 To Scale * Pix - 1 Step Scale
        y = Int((Rnd * (Scale * Pix - 1) + Rnd * (Scale * Pix - 1)) / 2)
        x = Int((Rnd * (Scale * Pix - 1) + Rnd * (Scale * Pix - 1)) / 2)
        If B Then
            If Rnd < .5 Then c = 0 Else c = oneColor 'one color and black background for B Mode
        Else
            c = Int(Rnd * 256)
        End If
        Line (x, y)-Step(Scale, Scale), c, BF ' draw square that is scaled pixel
        ' Next
        'Next
    Next p
    _Dest 0
End Sub

Sub Tessellate ' just covering the screen with our Tile
    Line (0, 0)-(_Width, _Height), Int(1 + Rnd * 255), BF

    tolap = olap
    If olap + Pix = 0 Then tolap = -(Pix - 1)
    st = (Scale * Pix)
    y = -tolap - st
    x = -tolap - st
    ' For y = 0 To _Height Step st
    Do
        y = y + st + tolap
        'For x = 0 To _Width Step st
        Do
            x = x + st + tolap
            _ClearColor 0
            xoff = Int(Rnd * 3) - Int(Rnd * 3)
            yoff = Int(Rnd * 3) - Int(Rnd * 3)
            _PutImage (x + tolap + xoff, y + tolap + yoff)-Step(st - 1, st - 1), Tile, 0
        Loop While x <= _Width
        If x > _Width Then x = -tolap - st
    Loop While y <= _Height
    y = -tolap - (st * ys)
    x = -tolap - (st * xs)
    ' For y = 0 To _Height Step st
    Do
        y = y + st + tolap
        'For x = 0 To _Width Step st
        Do
            x = x + st + tolap
            _ClearColor 0
            If rr Then
                xoff = Int(Rnd * st * .7) - Int(Rnd * st * .7)
                yoff = Int(Rnd * st * .7) - Int(Rnd * st * .7)
            Else
                xoff = 0
                yoff = 0
            End If
            _PutImage (x + tolap + xoff, y + tolap + yoff)-Step(st - 1, st - 1), Tile, 0
        Loop While x <= _Width
        If x > _Width Then x = -tolap - (st * xs)
    Loop While y <= _Height

End Sub
Reply


Messages In This Thread
Random Tessellations - by bplus - 05-09-2023, 02:29 PM
RE: Random Tessellations - by James D Jarvis - 05-09-2023, 07:37 PM
RE: Random Tessellations - by mnrvovrfc - 05-09-2023, 07:55 PM
RE: Random Tessellations - by bplus - 05-09-2023, 08:00 PM
RE: Random Tessellations - by James D Jarvis - 05-09-2023, 10:30 PM
RE: Random Tessellations - by mnrvovrfc - 05-09-2023, 08:14 PM
RE: Random Tessellations - by bplus - 05-09-2023, 09:11 PM
RE: Random Tessellations - by vince - 05-09-2023, 09:40 PM
RE: Random Tessellations - by bplus - 05-09-2023, 09:45 PM
RE: Random Tessellations - by bplus - 05-10-2023, 12:12 AM
RE: Random Tessellations - by CharlieJV - 05-10-2023, 12:41 AM
RE: Random Tessellations - by mnrvovrfc - 05-15-2023, 10:46 PM
RE: Random Tessellations - by bplus - 05-16-2023, 12:55 AM
RE: Random Tessellations - by bplus - 05-19-2023, 12:14 PM
RE: Random Tessellations - by bplus - 06-04-2023, 09:14 PM
RE: Random Tessellations - by grymmjack - 06-05-2023, 12:29 AM
RE: Random Tessellations - by Kernelpanic - 06-05-2023, 02:35 PM
RE: Random Tessellations - by bplus - 06-05-2023, 04:15 PM
RE: Random Tessellations - by bplus - 06-05-2023, 04:42 PM
RE: Random Tessellations - by Kernelpanic - 06-05-2023, 05:35 PM
RE: Random Tessellations - by bplus - 06-05-2023, 05:37 PM
RE: Random Tessellations - by Kernelpanic - 06-05-2023, 05:45 PM
RE: Random Tessellations - by bplus - 06-05-2023, 05:50 PM
RE: Random Tessellations - by bplus - 06-05-2023, 06:06 PM
RE: Random Tessellations - by Kernelpanic - 06-05-2023, 06:17 PM
RE: Random Tessellations - by bplus - 06-05-2023, 06:24 PM
RE: Random Tessellations - by bplus - 06-05-2023, 06:17 PM
RE: Random Tessellations - by Kernelpanic - 06-05-2023, 06:27 PM
RE: Random Tessellations - by Kernelpanic - 06-05-2023, 06:37 PM
RE: Random Tessellations - by bplus - 06-05-2023, 06:43 PM
RE: Random Tessellations - by Kernelpanic - 06-05-2023, 07:37 PM
RE: Random Tessellations - by bplus - 06-05-2023, 07:49 PM
RE: Random Tessellations - by bplus - 06-05-2023, 08:04 PM
RE: Random Tessellations - by Kernelpanic - 06-05-2023, 09:50 PM



Users browsing this thread: 2 Guest(s)