Cresent Pattern Challenge from JB

[bplus]

Can you draw this pattern:

  [ You are not allowed to view this attachment ]  

[SMcNeill]

Sure I can, and in the easiest way imaginable!

[bplus]

;-)) Pretty hefty .bas file there Steve! But that's smart thinking. :)

Maybe someone can do it in a couple less MB's.

  [ You are not allowed to view this attachment ]  

[SMcNeill]

Honestly, since it’s a black and white pattern, one can turn those data statements into a simple set of on/off counters.  3 white, 13 black, 33 white... 

Instead of saving data as pixel by pixel, save that data as number of white, number of black, number of white...  (3, 13, 33...)

It’d compress down to a fraction of the size.  (Maybe even as small as your screenshot.  ;-D)

[Ashish]

Hi. I tried doing this in approx. 2KB, but I can not get closer than this. ;)

 [ You are not allowed to view this attachment ]    

Code: QB64: [Select]

1. _TITLE "Pattern Challenge Program by Ashish"
2. SCREEN _NEWIMAGE(800, 600, 32)
3. buffer& = _COPYIMAGE(0)
4. CLS , _RGB(255, 255, 255)
5. _DEST buffer&
6. CLS , 1
7. rad = 50
8. FOR y = rad TO _HEIGHT STEP rad * SQR(3)
9.     IF a = 0 THEN
10.         a = 1
11.         k = 0
12.         FOR x = 0 TO _WIDTH STEP rad * 2
13.             IF k = 0 THEN
14.                 k = 1
15.                 pattern x, y, rad, 0
16.             ELSE
17.                 k = 0
18.                 pattern x, y, rad, 0.85
19.             END IF
20.         NEXT x
21.     ELSE
22.         a = 0
23.         k = 0
24.         FOR x = rad TO _WIDTH STEP rad * 2
25.             IF k = 0 THEN
26.                 k = 1
27.                 pattern x, y, rad, 0
28.             ELSE
29.                 k = 0
30.                 pattern x, y, rad, 0.85
31.             END IF
32.  
33.         NEXT x
34.     END IF
35. NEXT y
36. _SOURCE buffer&
37. FOR i = 0 TO _WIDTH - 1
38.     FOR j = 0 TO _HEIGHT - 1
39.         IF POINT(i, j) = _RGB(255, 255, 255) THEN PSET (i, j), _RGB(0, 0, 0)
40. NEXT j, i
41. _SOURCE 0
42. _DEST 0
43. _PUTIMAGE (0, 0), buffer&
44. SLEEP
45. SUB pattern (x, y, r, off_ang)
46.     CIRCLE (x, y), r, _RGB(254, 254, 254)
47.     FOR i = off_ang TO _PI(2) + off_ang STEP _PI(1 / 6) '2pi/12
48.         circ (x + (COS(i) * r + x)) / 2, (y + (SIN(i) * r + y)) / 2, r / 2, r / 2, _RGB(254, 254, 254), i, _PI + i
49.     NEXT
50.     FOR i = off_ang TO _PI(2) + off_ang STEP _PI(1 / 6) '2pi/12
51.         IF n = 0 THEN
52.             n = 1
53.             PAINT (COS(i) * 0.8 * r + x, SIN(i) * 0.8 * r + y), _RGB(255, 255, 255), _RGB(254, 254, 254)
54.         ELSE n = 0
55.         END IF
56.     NEXT
57. END SUB
58. SUB circ (x, y, rx, ry, c~&, theta1, theta2)
59.     FOR i = theta1 TO theta2 STEP 0.01
60.         LINE (COS(i) * rx + x, SIN(i) * ry + y)-(COS(i + 0.01) * rx + x, SIN(i + 0.01) * ry + y), c~&
61.     NEXT
62. END SUB
63.  

[Petr]

Hi BPlus. Mine is not so good as your.
Second radius is ellipse?

Code: QB64: [Select]

1.  
2. DIM Frames(9) AS LONG
3.  
4.  
5. FOR f = 1 TO 9
6.     R = R - _PI(2) / 9
7.     Frames(f) = _NEWIMAGE(101, 101, 256)
8.     _DEST Frames(f)
9.     FOR pi = R TO R + _PI(2) STEP _PI(2) / 6
10.         sx = 50 + COS(pi) * 25
11.         sy = 50 + SIN(pi) * 25
12.         sx2 = 50 + COS(pi + .3) * 25
13.         sy2 = 50 + SIN(pi + .3) * 25
14.         sx3 = 50 + COS(pi + _PI(2) / 6 + .2) * 20
15.         sy3 = 50 + SIN(pi + _PI(2) / 6 + .2) * 20
16.  
17.         FOR c = 0 TO _PI(1.1) STEP .001
18.             PSET (sx + COS(c + pi) * 25, sy + SIN(c + pi) * 25)
19.             PSET (sx2 + COS(c + pi) * 25, sy2 + SIN(c + pi) * 25)
20.         NEXT c
21.         PAINT (sx3, sy3), 15, 15
22.     NEXT
23.     _CLEARCOLOR 0
24. NEXT f
25.  
26. SCREEN _NEWIMAGE(800, 600, 256)
27. _PALETTECOLOR 0, &HFFFFFFFF
28. _PALETTECOLOR 15, &HFF000000
29.  
30. f = 0
31.  
32. DO
33.     CLS
34.     g = 0
35.     FOR y = 0 TO 600 STEP 90
36.         g = g + 1
37.         FOR x = -100 TO 800 STEP 96
38.             f = f + 1
39.             IF f > 9 THEN f = 1
40.             IF g MOD 2 = 0 THEN p = 50 ELSE p = 0
41.             _PUTIMAGE (x + p, y), Frames(f)
42.         NEXT x
43.     NEXT y
44.     _LIMIT 20
45.     _DISPLAY
46. LOOP
47.  

[Ashish]

@Petr
That has nearly damaged my eyesight. :D

[Petr]

Hi Ashish. Am sorry :-D  Bplus destroyed my brain :-D

[FellippeHeitor]

@Petr and @Ashish,

You guys are definitely going places.

[_vince]

Code: QB64: [Select]

1.  
2. declare sub swirl(x, y, r)
3. dim shared pi as double
4. pi = 4*atn(1)
5. r = 70
6.  
7. screen 12
8.  
9. line (0,0)-(640,480),,bf
10.  
11. for yy = 0 to 5
12. for xx = 0 to 5  
13.     swirl xx*2*r + r*(yy and 1), 0 + yy*2*r*cos(pi/6), r
14. next
15. next
16.  
17. sleep
18. system
19.  
20. sub swirl(x, y, r)
21.     dim a as double, b as double
22.  
23.     for i=0 to 6
24.         xx = x + 0.5*r*cos(i*pi/3)
25.         yy = y + 0.5*r*sin(i*pi/3)
26.        
27.         a = i*pi/3
28.        
29.         pset (xx + 0.5*r*cos(a), yy + 0.5*r*sin(a)), 0
30.         for b=a to a + pi step 0.01
31.             line -(xx + 0.5*r*cos(b), yy + 0.5*r*sin(b)), 0
32.         next
33.        
34.         pset (xx + 0.5*r*cos(a), yy + 0.5*r*sin(a)), 0
35.         for b=0 to pi step 0.01
36.             line -(xx + 0.5*r*cos(b)*cos(a) - 0.28*r*sin(b)*sin(a), yy + 0.5*r*cos(b)*sin(a) + 0.28*r*sin(b)*cos(a)), 0
37.         next
38.        
39.         paint (xx - 0.4*r*sin(a), yy + 0.4*r*cos(a)), 0
40.     next
41. end sub
42.  

[bplus]

@Petr and @Ashish,

You guys are definitely going places.

Yeppers!

Ashish, your trailing edge is a radius of a circle as the leading edge, a result I failed to achieve, nice!

Petr, your code has 2 lines more than mine and yours moves! also nice!

Oh Vince just posted! Dang! wow, nice concise code!!!



My trailing edge is not a radius of a circle, I'm not even sure it is ellipse.
If leading edge y = SQR(radius^2 - x^2) then trailing edge is a fraction of y, so I can make the crescent as thick or thin as I want. EDIT minus not plus

Yeah Petr, now I've got to get the cresents twirling too! ;-)) Plus.... :)


PS sorry for my poor spelling of crescent (the spell checker worked!)

[Ashish]

@Vince
Perfect one!

[TempodiBasic]

Hi guys
for  now I'm debugging my idea

to get the slices  putting a circle up to another circle.. :-)

I must stop my idea for now. Job is calling!

here bugged code (only forn now)

Code: QB64: [Select]

1. CONST d = 100
2. SCREEN _NEWIMAGE(800, 600, 32)
3. _TITLE "Cresent"
4. PAINT (1, 1), _RGB32(255, 255, 255)
5. DIM NumX AS INTEGER, NumY AS INTEGER, i AS INTEGER, i2 AS INTEGER
6. NumX = _CEIL(_WIDTH / d): NumY = _CEIL(_HEIGHT / d)
7. FOR i = 0 TO NumX
8.     FOR i2 = 0 TO NumY
9.         IF i2 MOD 2 = 0 THEN k = 0 ELSE k = d / 4
10.         x = (i * d) + k
11.         y = i2 * d
12.         r = d / 2
13.         c~& = _RGB32(0, 0, 0)
14.         CIRCLE (x, y), r, c~&
15.         MakeSlice x, y, r, c~&
16.     NEXT i2
17. NEXT i
18. END
19.  
20. SUB MakeSlice (xp AS INTEGER, yp AS INTEGER, r AS INTEGER, col AS _UNSIGNED LONG)
21.     DIM a AS INTEGER, ax AS INTEGER, ay AS INTEGER, ar AS INTEGER, col2 AS _UNSIGNED LONG
22.     ar = INT(r / 2)
23.     FOR a = 1 TO 12 STEP 1
24.         ax = SIN(15 * a) * ar
25.         ay = COS(15 * a) * ar
26.         IF a MOD 2 = 0 THEN col2 = col ELSE col2 = _RGB32(255, 255, 255)
27.         CIRCLE (ax + xp, ay + yp), ar, col
28.         PAINT STEP(0, 0), col2, col
29.      NEXT
30. END SUB

Here partial result:
  [ You are not allowed to view this attachment ]  

I'll change circle with fillcircle of library of QB64 and I'll search the right number of circle to draw

[Petr]

Very nice, _vince!

[bplus]

Yes, Vince code is really nice compared to mine used to create the screen shot in original post:

Code: QB64: [Select]

1. OPTION _EXPLICIT
2. CONST xmax = 800, ymax = 600
3. _TITLE "Cresent" 'mod B+ makeover started 2019-06-27
4. SCREEN _NEWIMAGE(xmax, ymax, 32)
5. _SCREENMOVE 300, 40
6.  
7. DIM polyR, stepX, stepY, y, x, xoff
8. COLOR &HFF000000, &HFFFFFFFF
9. CLS
10. polyR = 32
11. stepX = polyR * 4
12. stepY = polyR * 2 * SQR(3)
13. FOR y = 16 TO ymax - 16 STEP stepY
14.     xoff = (xoff + 1) MOD 2
15.     FOR x = 0 TO xmax + 7 * polyR STEP stepX
16.         cresentX6 x - xoff * 1.5 * stepX, y
17.     NEXT
18. NEXT
19.  
20. SUB cresentX6 (x0, y0)
21.     DIM r, x, y, py, x1, y1, x2, y2, a, dist1, a1, x3, y3, dist2, a2, x4, y4
22.     r = 32
23.     FOR x = -r TO r STEP .005
24.         y = SQR(r ^ 2 - x ^ 2)
25.         py = .53 * y
26.         x1 = x + x0 + r
27.         y1 = y + y0
28.         x2 = x1
29.         y2 = py + y0
30.         LINE (x1, y1)-(x2, y2)
31.         FOR a = 0 TO 2 * _PI STEP _PI(1 / 3)
32.             dist1 = SQR((x1 - x0) ^ 2 + (y1 - y0) ^ 2)
33.             a1 = _ATAN2(y1 - y0, x1 - x0)
34.             x3 = x0 + dist1 * COS(a1 + a)
35.             y3 = y0 + dist1 * SIN(a1 + a)
36.  
37.             dist2 = SQR((x2 - x0) ^ 2 + (y2 - y0) ^ 2)
38.             a2 = _ATAN2(y2 - y0, x2 - x0)
39.             x4 = x0 + dist2 * COS(a2 + a)
40.             y4 = y0 + dist2 * SIN(a2 + a)
41.             LINE (x3, y3)-(x4, y4)
42.         NEXT
43.     NEXT
44. END SUB
45.  
46.  

I was working up something to post at JB forum but JB does not have PAINT (nor POINT).

I have reworked Vince code without PAINT so I can show it off at JB! ;-))

Code: QB64: [Select]

1. _DEFINE A-Z AS _FLOAT : _TITLE "Crescent by Vince B+ Mod W/O PAINT" 'b+ 2019-06-28
2. CONST K = &HFFFFFFFF, pi = _PI, r = 70
3. SCREEN _NEWIMAGE(700, 623, 32)
4. FOR yy = 0 TO 4
5.     FOR xx = 0 TO 5
6.         swirl xx * 2 * r + r * (yy AND 1), 0 + yy * 2 * r * COS(pi / 6)
7.     NEXT
8. NEXT
9. SLEEP
10. SUB swirl (x, y)
11.     FOR i = 0 TO 5
12.         xx = x + 0.5 * r * COS(i * pi / 3) - r  'Edit: this and next, removed variables not used
13.         yy = y + 0.5 * r * SIN(i * pi / 3) + r
14.         a = i * pi / 3
15.         FOR b = a TO a + pi STEP .0001
16.             c = b - a
17.             LINE (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)), K
18.         NEXT
19.     NEXT
20. END SUB
21.  

I reversed the B&W to save a line, to get lines to 20:
  [ You are not allowed to view this attachment ]