a pattern ?challenge?

[tsh73]

Found this while Googling through "circle pattern"
The problem is, I don't have code for drawing it.
(basically if I have code for rotated crescent moon, I probably arrange the rest)
So you can consider this to be a challenge - how to draw this (or similar) in JB?
(of course nice & small code gets extra points )

[B+]

Sure got me thinking!

[Rod]

Wish I had more time. This code draws the basic crescent shape. Taking the bottom half of the circle gives a clean image which could be flipped and mirrored to create all of the components you would need. Or resort to maths!


   WindowWidth = DisplayWidth
   WindowHeight = DisplayHeight
   UpperLeftX = int((DisplayWidth-WindowWidth)/2)
   UpperLeftY = int((DisplayHeight-WindowHeight)/2)
   midx=int(WindowWidth/2)
   midy=int(WindowHeight/2)
   button #1, "Again", [clear], LR, 50, 10
   open "Arc" for graphics_nsb as #1
   print #1, "trapclose [quit]"

   [clear]
   print #1, "down ; fill black"
   print #1, "color white"

   [circle]
   for n= 1 to 360 step 30
   if b then #1 "backcolor red" : b=0 else #1 "backcolor blue" : b=1
           x=midx-(20*sin(n/57.29577951))
           y=midy-(20*cos(n/57.29577951))
           print #1, "place ";x;" ";y;" ; circlefilled 20"
   next n


   wait


   [quit]
   close #1
   end


[tenochtitlanuk]

Fun idea! I did a quick bit of coding and then mocked-up in GIMP to get a feel for the orientations. Will put up code if I refine it a bit, but will probably do it in LB with the ability to flood-fill areas easily..

[ntech]

Jun 26, 2019 20:33:33 GMT tsh73 said:

Found this while Googling through "circle pattern"
The problem is, I don't have code for drawing it.
(basically if I have code for rotated crescent moon, I probably arrange the rest)
So you can consider this to be a challenge - how to draw this (or similar) in JB?
(of course nice & small code gets extra points )

My idea would be:

Create multiple sprites, one for each circle, and layer them.

[B+]

OK got it in JB:
'6 cresent moon about point pattern.txt for JB v2 bplus 2019-06-27
global PI, xmax, ymax
PI = 3.14159265
xmax = 700 'full screen width
ymax = 700

nomainwin
UpperLeftX = 100
UpperLeftY = 10

WindowWidth = xmax + 8   'adjust +10 for screen frame plus slight white frame
WindowHeight = ymax + 32  'add +32 for screen frame plus slight white frame

'_nf =no full screen, _nsb =no scroll bars
open "6 Cresent Moon about Point Pattern" for graphics_nsb_nf as #gr
#gr "trapclose [quit]"
#gr "down"

call ink 0, 0, 0
polyR = 32
stepX = polyR * 4
stepY = polyR * 2 * SQR(3)
FOR y = ymax/2 - 6 * polyR TO ymax/2 + polyR*6 STEP stepY
   scan
   xoff = (xoff + 1) MOD 2
   FOR x = xmax/2 - 4*polyR -.5*stepX TO xmax/2 + polyR*8 STEP stepX
       scan
       call cresentX6 x - xoff * .5 * stepX, y
   NEXT
NEXT
wait

[quit]
   timer 0
   close #gr
   end

SUB cresentX6 x0, y0
   r = 32: x01 = x0 + r: y01 = y0
   FOR x = -1*r TO r STEP .01
       scan
       y = SQR(r ^ 2 - x ^ 2)
       py = .53 * y
       x1 = x + x01
       y1 = y + y0
       x2 = x1
       y2 = py + y0
       call aline x1, y1, x2, y2
       FOR a = 0 TO 2 * PI STEP PI / 3
           scan
           dist1 = SQR((x1 - x0) ^ 2 + (y1 - y0) ^ 2)
           a1 = ATAN2(y1 - y0, x1 - x0)
           x3 = x0 + dist1 * COS(a1 + a)
           y3 = y0 + dist1 * SIN(a1 + a)

           dist2 = SQR((x2 - x0) ^ 2 + (y2 - y0) ^ 2)
           a2 = ATAN2(y2 - y0, x2 - x0)
           x4 = x0 + dist2 * COS(a2 + a)
           y4 = y0 + dist2 * SIN(a2 + a)
           call aline x3, y3, x4, y4
       NEXT
   NEXT
END SUB

sub ink r,g,b
   #gr "color ";r;" ";g;" ";b
   #gr "backcolor ";r;" ";g;" ";b
end sub

sub aline x0,y0,x1,y1
   #gr "line ";x0;" ";y0;" ";x1;" ";y1
end sub

Function ATAN2(y, x)
   'Atan2 is a function which determines the angle between points
   'x1, y1 and x2, y2. The angle returned is in radians
   'The angle returned is always in the range of
   '-PI to PI radians (-180 to 180 degrees)
   '==============================================================
   'NOTE the position of Y and X arguments
   'This keeps Atan2 function same as other language versions
   '==============================================================
  If x = 0 Then
      If y < 0 Then
           ATAN2 = -1.5707963267948967
       Else
           ATAN2 = 1.5707963267948967
       End If
  Else
      chk = atn(y/x)
      If x < 0 Then
          If y < 0 Then
               chk = chk - 3.1415926535897932
           Else
               chk = chk + 3.1415926535897932
           End If
      End If
       ATAN2 = chk
  End If
  'thanks Andy Amaya
End Function



[tenochtitlanuk]

I wrote a general-purpose arc routine to call, producing the outlines. Then in LB do the flood-fills.
Here's a sample from the stage when I was saving the outlines and filling by hand!

Code below has the floodfill bits rem'med out, Not yet abutting the shapes correctly, but it was fun and people may like to see a different algorithm. I got lots of other fascinating figures during its 'development'!

   nomainwin

   global offset

   WindowWidth  =1200
   WindowHeight = 700

   open "Interlocking arcs." for graphics_nsb as #wg

   'hw =hwnd( #wg)                                          '     <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
   'calldll #user32, "GetDC", hw as ulong, hdc as ulong     '    <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

   #wg "trapclose quit"
   #wg "down ; color black ; size 2 ; fill 120 120 80"
   #wg "when leftButtonDown [paint]"

       radius      =50
       shift       = 0

       for yDispt =360 to 1100 step 175
           'offset =0
           for xDispt =0 to 1220 step 201
               offset =0
               for th =0 to 360 step 30
                   call arc radius *cosRad( th) +xDispt +100 *shift +10, 1000 +radius *sinRad( th) -yDispt +10, radius, 360
                   offset =offset +30
               next th
           next xDispt
           if shift =0 then shift =1 else shift =0
       next yDispt

       #wg "flush ; getbmp scr 1 1 1200 700"
       bmpsave "scr", "arc" +str$( time$( "seconds")) +".bmp"
   wait

   [paint]
       'fillCol$ ="255 60 60"
       '#wg "color "; fillCol$; " ; up ; backcolor "; fillCol$

       'xVar            =MouseX
       'yVar            =MouseY
       'targetcolor     =0                  '   black- this is the colour of the outline to fill out to.

       'calldll #gdi32, "ExtFloodFill",_
           'hdc                as ulong,_
           'xVar               as long,_
           'yVar               as long,_
           'targetcolor        as long,_
           '_FLOODFILLBORDER   as long,_    '   '   ie fill out 'til this colour is met... <<<<<<<<<<<<<<<<<<<<<<<<<<
           'result             as long

           'calldll #kernel32, "Sleep", 100 as long, ret as void

       'wait

   sub arc x, y, r, span
           for th =0 to 361 step 0.5
               if th >90 and th <300 then #wg "set "; x -r *sinRad( th +offset); " "; y +r *cosRad( th +offset)
               scan
            next th
   end sub

   sub quit h$
       #wg "flush ; getbmp scr 1 1 1200 700"
       bmpsave "scr", "arc" +str$( time$( "seconds")) +".bmp"
       'calldll #user32, "ReleaseDC", hw as ulong, hdc as ulong, ret as void   'release the DC    <<<<<<<<<<<<<<<<<<<<<
       close #wg
       end
   end sub

   function sinRad( t)
       sinRad =sin( t *3.141593 /180)
   end function

   function cosRad( t)
       cosRad =cos( t *3.141593 /180)
   end function


[B+]

If you show Liberty code, let me show you another Basic that kicks butt with graphics! That has normal PAINT and POINT and... well I can't say can I? ;-))

Update: I posted this challenge at another forum and have seen allot of different approaches but I did not see arcs, good idea too.

[B+]

Oh boy! Someone just showed me a better way that should work in JB.

Update: It did use PAINT but I modified to fill in with lines PLUS "SIZE 2" saves time and fills in gaps.


'Crescent Challenge Vince Version.txt for JB v2 bplus 2019-06-28
global PI, xmax, ymax, r
PI = 3.14159265
xmax = 700 'full screen width
ymax = 623
r = 70

nomainwin
UpperLeftX = 100
UpperLeftY = 10

WindowWidth = xmax + 8   'adjust +10 for screen frame plus slight white frame
WindowHeight = ymax + 32  'add +32 for screen frame plus slight white frame

'_nf =no full screen, _nsb =no scroll bars
open "Crescent Challenge Vince Version" for graphics_nsb_nf as #gr
#gr "trapclose [quit]"
#gr "down"
#gr "size 2"  'oh this works great for filling gaps between lines!
call ink 0, 0, 0
FOR yy = 0 TO 4
   scan
   FOR xx = 0 TO 5
       scan
       call swirl xx * 2 * r + r * (yy AND 1), 0 + yy * 2 * r * COS(PI / 6)
   NEXT
NEXT
wait

[quit]
   timer 0
   close #gr
   end

SUB swirl x, y
   FOR i = 0 TO 5
       scan
       xx = x + 0.5 * r * COS(i * PI / 3) - r
       yy = y + 0.5 * r * SIN(i * PI / 3) + r
       a = i * PI / 3
       FOR b = a TO a + PI STEP .01
           scan
           c = b - a
           call aline xx + 0.5 * r * COS(b), yy + 0.5 * r * SIN(b), xx + 0.5 * r * COS(c) * COS(a) - 0.28 * r * SIN(c) * SIN(a), yy + 0.5 * r * COS(c) * SIN(a) + 0.28 * r * SIN(c) * COS(a)
       NEXT
   NEXT
END SUB

sub ink r,g,b
   #gr "color ";r;" ";g;" ";b
   #gr "backcolor ";r;" ";g;" ";b
end sub

sub aline x0,y0,x1,y1
   #gr "line ";x0;" ";y0;" ";x1;" ";y1
end sub



[B+]

Have Basic fans looking in here from: www.qb64.org/forum/index.php?topic=1467.0

We are having fun with challenge, I am up to this:

[B+]

Now I have mounted my Tricolor Crescent Pattern on a slightly tilted Hexagonal Layout. Eyeballing the angles, I got nice round number tilt of -pi/8.

[B+]

Here is JB translation of Tricolor Crescent Pattern in Tilted Hexagonal Layout:

'Crescent LFCA Hexagonal Layout.txt for JB v2 bplus translate 2019-06-30 LFCA = Lined Filled Circular Arcs
global pi, xmax, ymax
pi = 3.14159265
xmax = 700 'screen width
ymax = 700

nomainwin
UpperLeftX = 100
UpperLeftY = 10

WindowWidth = xmax + 8   'adjust +10 for screen frame plus slight white frame
WindowHeight = ymax + 32  'add +32 for screen frame plus slight white frame

'_nf =no full screen, _nsb =no scroll bars
open "Crescent LFCA Hexagonal Layout" for graphics_nsb_nf as #gr
#gr "trapclose [quit]"
#gr "down"
#gr "size 2"  'oh this works great for filling gaps between lines!

DIM hx(45), hy(45)
r = 50
tilt = -1*pi / 8 'to match tilt in original challenge
hex = 2 * pi / 6
x0 = xmax / 2
y0 = ymax / 2

' get point locations of hexagonal shape
'main 6 that orbit center, each has 6 more satellites but redundant points
FOR a = tilt TO 2 * pi STEP hex
   hx(i) = int(x0 + 2 * r * COS(a))
   hy(i) = int(y0 + 2 * r * SIN(a))
   i = i + 1
NEXT
' 2nd phase orbiters
FOR j = 0 TO 5
   FOR a = tilt TO 2 * pi - tilt - 1 STEP hex
       scan
       hx(i) = int(hx(j) + 2 * r * COS(a))
       hy(i) = int(hy(j) + 2 * r * SIN(a))
       i = i + 1
   NEXT
NEXT
i = i - 1 ' now i is top index of hx(), hy()
'remove redundant
FOR j = 0 TO i - 1
   FOR k = j + 1 TO i
       scan
       IF hx(j) THEN
           IF abs(hx(j) - hx(k)) < 2  AND abs(hy(j) - hy(k)) < 2 THEN hx(k) = 0
       END IF
   NEXT
NEXT
'draw the crescents at the points given
FOR j = 0 TO i
   scan
   IF hx(j) <> 0 THEN call crescentLFCA hx(j), hy(j), r, -2.8*tilt
NEXT
playwave "tada.wav"
wait

[quit]
   timer 0
   close #gr
   end

'crescent Line Filled Circular Arcs  combines arc drawing sub with crescentPattern sub
SUB crescentLFCA x0, y0, r6, aoff
   'r6 is radius of 6 crescent pattern
   r1 = r6 / 2 ' the radius of each crescent
   a12 = 2 * pi / 12 ' 30 degrees to draw 12 arcs about x0, y0
   a6 = 2 * pi / 6
   al = .1 * pi * r1 * r1 * (pi + pi / 6) / (pi*2)
   FOR i = 1 TO 6 'draw 6 crescents find x, y of leading and trailing edges
       scan
       x6 = x0 + r1 * COS(i * a6 + aoff): y6 = y0 + r1 * SIN(i * a6 + aoff) 'origins of leading edges
       x6m12 = x0 + r1 * COS(i * a6 - a12 + aoff): y6m12 = y0 + r1 * SIN(i * a6 - a12 + aoff) 'origins of trailing edges
       FOR a = (i * a6 + aoff - 3 * pi / 24) TO (i * a6 + aoff + pi - 3 * pi / 24) STEP 1 / al 'draw arc chords for dist a
           scan
           x1 = x6 + r1 * COS(a): y1 = y6 + r1 * SIN(a) ' point on leading edge
           x2 = x6m12 + r1 * COS(a): y2 = y6m12 + r1 * SIN(a) ' matching point on trailing edge
           select case i MOD 3
               case 0 : #gr "color ";160;" ";0;" ";0
               case 1 : #gr "color ";0;" ";160;" ";0
               case 2 : #gr "color ";0;" ";0;" ";160
           end select
           #gr "line ";x1;" ";y1;" ";x2;" ";y2
       NEXT
   NEXT
END SUB


[tsh73]

Hello everybody
Thanks for participating in this thread

Rod,
your "star" looks really close to original picture. I was aware that circles will go overlapping in the end – but using flip/mirror just never occurred to me!
Especially then I actually had this code
justbasiccom.proboards.com/thread/233/flip-mirror

But while I got to program - I made it without flip. Just draw a picture with a hole up - grab correct bottom - continue loops so up is correct and bottom has hole - DRWBMP saved bottom!

ntech,
thanks, probably sprites are simplest way of achieving transparency in JB.

John(tenochtitlanuk),
I wonder if such shapes are better served with vector graphic program (like Inkscape) then raster one (GIMP). After some thinking one needs something scriptable... Wait, does it differs from JB then?

B+,
you nailed relative placement of stars. (actually better then I do – I saw it and close it, so I remembered it being hexadecimal but not rotated 90 degrees. And not even saying about final small rotation you added). As for your “crescent moon”, then first attempt was a bit weird in the inner circle. Actually final version is good but a bit different from the source picture. I think Rod’s/John’s are close to source.

(initially) I had much stranger attempt with "star". I draw concentric arcs, going from 0-0 to 30-60 to 0-0 start-end angle along radius. Why it ended up looking tike that I have no idea.

'a pattern ?challenge?
'tsh73 Jul 2019
WindowWidth=610
WindowHeight=640
nomainwin
open "pattern" for graphics_nsb_nf as #gr
#gr "trapclose [quit]"
#gr "down"
#gr "home; posxy cx cy"

'#gr "home; circle 50"

r=50
pi=acs(-1)

cy=cy-r/2
s=1
for i = s to s+12+6
   a=2*pi*(i/12+1/8)   '1/8 is a fudge for stars to connect each other
   x=cx+r/2*cos(a)
   y=cy+r/2*sin(a)
   #gr "color ";word$("black white", i mod 2 +1)
   #gr "backcolor ";word$("black white", i mod 2 +1)
   #gr "place ";x;" ";y
   #gr "circlefilled ";r/2
   if i = s+12 then 'save upper part
       #gr "getbmp up ";cx-r;" ";cy-r;" ";2*r;" ";r
       'wait
   end if
next
'we end with "hole" up there, so restore upper part
#gr "drawbmp  up ";cx-r;" ";cy-r
'It is a mask part of sprite. Image sprite - black square!
   #gr "color black"
   #gr "backcolor black"
   #gr "place ";cx-r;" ";cy+r
   #gr "boxfilled ";cx+r;" ";cy+3*r
'grab a sprite
   #gr "getbmp star ";cx-r;" ";cy-r;" ";2*r;" ";4*r
   #gr "home; posxy cx cy" 'restore center
   'draw with it
    #gr "cls"
'wait
   '#gr "addsprite spr1 star"
   '#gr "spritemovexy spr1 ";cx-r;" "; cy-r
   #gr "drawsprites"
   'now, add more sprites
   sq32=sqr(3)/2
   for i = 0 to 4
       for j = 0 to 4
           if instr("00 04 40 44 41 43", i;j) then [skip]  'this one brain-dead but really effective check (job done in small code)
           x=60+r*(2*i+j mod 2)*.97
           y=80+2*r*j*sq32*.97 '.97 - fudge it
           #gr "addsprite spr";i;j;" star"
           #gr "spritemovexy spr";i;j;" ";x;" "; y
[skip]
       next
   next
   #gr "drawsprites"

#gr "flush"
wait

[quit]
timer 0
close #gr
end


[tsh73]

(initially) I had much stranger attempt with "star". I draw concentric arcs, going from 0-0 to 30-60 to 0-0 start-end angle along radius. Why it ended up looking tike that I have no idea.

(I found arc sub is some program from 2013, I just reused it - kludged against "Floating point invalid op" error)

'(Failed) attempt at “crescent moon”
'tsh73 Jul 2019
WindowWidth=610
WindowHeight=640
nomainwin
open "pattern" for graphics_nsb_nf as #gr
#gr "trapclose [quit]"
#gr "down"
#gr "home; posxy cx cy"

'#gr "home; circle 50"

r=150
pi=acs(-1)

for da = 60 to 360 step 60
   for i = 1 to r
       a0 = 30*sin(i/r*pi)
       a1 = 60*sin(i/r*pi)
       'print i, r, a0, a1
       call arc "#gr", cx, cy, i, a0+da, a1+da
   next
next

wait

sub arc handle$, x0, y0, r, a0, a1
   pi = acs(-1)
   arcLen = 2*pi*r*abs(a1-a0)/360 'pixels
   if abs(a1-a0)<0.001 then 'some invalid floating point
       h = 1
   else
       h =(a1-a0)/arcLen
   end if
   'initial point
   t=a0*pi/180
   x=x0+r*cos(t)
   y=y0-r*sin(t)   'y upside down
   #handle$ "place ";x;" ";y
   for a = a0 to a1 step h
       t=a*pi/180
       x=x0+r*cos(t)
       y=y0-r*sin(t)   'y upside down
       #handle$ "goto ";x;" ";y
       'print "goto ";x;" ";y
   next
end sub

[quit]
timer 0
close #gr
end