You are not logged in or registered. Please login or register to use the full functionality of this board...
SIGN IN Join Our Community For FREE


Patterns2.bas
05-01-2017, 07:18 PM (This post was last modified: 05-01-2017 07:23 PM by bplus.)
Post: #1
 (Print Post)
Patterns2.bas
Here is a fancied up version of Connett circles, I was calling this Patterns some time ago.

It has user defined keys that allows navigation among the 1000 screens.

It uses + - keys to increase size of pixel/rectangles.

In SmallBASIC rectangles are done with rect and two opposite corners and you can use step like QB64 with line.

Also iff(bool, assignTrueValue, assignFalseValue)
myValue = iff(myLast < 100, myLast + 1, myLast)

This would assign to myValue myLast + 1 iff the boolean expression (True = 1 or False = 0) evaluates to 1 

if the boolean evaluates to false then myVlaue is assigned myLast.

All this is just shorthand for:
if myLast < 100 then myValue = myLast + 1 else myValue = myLast

Code Snippet: [Select]
' patterns 2.bas  SmallBASIC 0.12.7 [B+=MGA] 2016-09-18
' from pattern.bas for SmallBASIC 0.12.0 2015-11-27 Peter W & MGA/B+
' probably Peter's source was (since uses all same variable names...):
' http://shawweb.myzen.co.uk/stephen/sdlbasic.htm

' 2016-09-18 modify (Fix!) to full range R OR G OR B coloring
' test new 0.12.7 update SmallBASIC (2016-09-17)
' add toggles for rectangles 1 to 8 with + for plus, - for minus
' add toggles c for color to B & W, on/off
' add keys u, d, h, e  for like: page up, page down, home, end
' add label, extra code to speed B&W versions
' now modified to 6: 65 to 255 color ranges plus,
' 1/8th pure white and 1/8th pure black for contrast
' The more 0 to 1 is split the more exquisite the detail.

' hit spacebar or click screen to get the next screen sooner than 5 secs

definekey 43, plusPress   ' + increase reactangle size up to 8x8 pixels
definekey 45, minusPress  ' - decrease rectangle size to 1x1 = pixels
definekey 99, cPress      'color toggle B&W
definekey 98, bPress   'b  for back 5,     s back 5 = last s again
definekey 117, uPress  'u  like page up,   s + 100, also click right screen
definekey 100, dPress  'd  like page down, s - 100, also click left screen
definekey 104, hPress  'h  like home,      s = 10 , also click top screen
definekey 101, ePress  'e  like end,       s = 900, also click bottom screen

colr = 1 'color is on
g = 2    'g controls f the rectangle size
u = 500  'u controls s that controls the d number that controls color
pen on
while 1
 cls
 f = g
 s = u
 if colr then
   for i = 0 to xmax / f
     for j = 0 to (ymax - 20) / f
       x = i * s / 600
       y = j * s / 600
       d = (x * x + y * y) / 2
       d = d - int(d)
       if d < .125 then
         cc = 0
       elif d < .25
         z = (d - .125) / .125 * 190 + 65
         cc = rgb( z, 0, 0)
       elif d < .375
         z = (d - 0.25) / 0.125 * 190 + 65
         cc = rgb(z, z, 0)
       elif d < .5
         z = (d - .375) / .125 * 190 + 65
         cc = rgb(0, z, 0)
       elif d < .625
         z = (d - .5) / .125 * 190 + 65
         cc = rgb(0, z, z)
       elif d < .75
         z = (d - .625) / .125 * 190 + 65
         cc = rgb(0, 0, z)
       elif d < .875
         z = (d - .75) / .125 * 190 + 65
         cc = rgb(z, 0, z)
       else
         cc = 15
       fi    
       rect i * f,j * f + 21 step f, f, cc filled
       'pset i,j,cc
     next
   next
 else
   for i = 0 to xmax / f
     for j = 0 to (ymax - 20) / f
       x = i * s / 600
       y = j * s / 600
       c = x * x + y * y
       d = c / 2
       d = d - int(d)
       if d < 0.35 then rect i * f, j * f + 21 step f, f, 15 filled    
     next
   next
 end if
 color 7, 0
 ts = "Patterns 2: s = " + str(s) + ", " + str(f) + "x"
 ts = ts + str(f) + "  key: + - pixel magnification, c color on/off, b backup,"
 ts = ts + " u d h e or click to naviagte s"
 at (xmax -txtw(ts))/2, 1 : ? ts
 showpage
 pause 5 'for snapshot
 if pen(3) then
   mx = pen(4) : my = pen(5)
   delay 100
   if my > 100 and my < ymax - 100 then
     if mx < 100 then dPress
     if mx > xmax - 100 then uPress
   elif my < 100 and my > -1
     hPress
   elif my > ymax - 100  
     ePress
   end if
 end if
 u += 5
 if u > 1000 then u = 5
wend

sub plusPress()
 g = iff(f + 1 < 9, f + 1, f)
end

sub minusPress()
 g = iff(f - 1 > 0, f - 1, f)
end

sub cPress()
 colr = (colr + 1) % 2
end

sub bPress()
 u = iff(u - 10 > 0, u - 10, 990)
end
 
sub uPress()
 u = iff(u + 100 < 1000, u + 100, 900)
end
 
sub dPress()
 u = iff(u - 100 > 0, u - 100, 5)
end
 
sub hPress()
 u = 5
end

sub ePress()
 u = 900
end sub

I posted the code so you could read the instructions to see how it works.

In screenshots I show max pix/rect size in B&W and the high end of 1000 screens where the patterns get interesting in how they repeat slightly differently across the screen.


Attached File(s) Image(s)
       
Find all posts by this user
Like Post
The following 2 users Like bplus's post:
Aurel, Waltersmind (Admin)
05-02-2017, 11:14 PM
Post: #2
 (Print Post)
RE: Patterns2.bas
bplus,

That is a very cool demo. Thank you for sharing.

My goal is to bring joy, excitement, fun and education to all computer programming hobbyists, tinkerers, and amateurs. I also enjoy helping and working with those who aspire at becoming masters of their craft.
Find all posts by this user
Like Post



Forum Jump:


User(s) browsing this thread: 1 Guest(s)




QB64 Member Project - Inside Moves
QB64 Member Project - Sabotage
QB64 Member Project - Spinning Color Wheel
QB64 Member Project - ARB Checkers
QB64 Member Project - Red Scrolling LED Sign
QB64 Member Project - Color Triangles
QB64 Member Project - Swirl
QB64 Member Project - Blokus
QB64 Member Project - Overboard
QB64 Member Project - Othello
QB64 Member Project - STxAxTIC 3D World
QB64 Member Project - Line Thickness
QB64 Member Project - Input
QB64 Member Project - Domain
QB64 Member Project - Rotating Background
QB64 Member Project - Quarto
QB64 Member Project - Basic Dithering
QB64 Member Project - Martin Fractals version two
QB64 Member Project - Foursight
QB64 Member Project - Kings Valley verion one
QB64 Member Project - Touche
QB64 Member Project - Kings Vallery version two
QB64 Member Project - Pivot version two
QB64 Member Project - RGB Color Wheel
QB64 Member Project - Dakapo
QB64 Member Project - Isolation
QB64 Member Project - Rubix's Magic
QB64 Member Project - Bowditch curve
QB64 Member Project - OpenGL Triangles
QB64 Member Project - 9 Board
QB64 Member Project - Point Blank
QB64 Member Project - Kobolts Monopoly
QB64 Member Project - Connect Four
QB64 Member Project - Score 4
QB64 Member Project - Spiro Roses
QB64 Member Project - Martin Fractals version one
QB64 Member Project - Algeria Weather
QB64 Member Project - Exit
QB64 Member Project - Amazon
QB64 Member Project - Splatter
QB64 Member Project - Full Color LED Sign
QB64 Member Project - Qubic
QB64 Member Project - Pivet version one
QB64 Member Project - Kings Court
QB64 Member Project - MAPTRIANGLE
QB64 Member Project - Martin Fractals version three
QB64 Member Project - Color Rotating Text
QB64 Member Project - Martin Fractals version four
QB64 Member Project - Dreamy Clock