One Piece Pie Chart Maker

[SierraKen]

I decided to make this today because I've never made a pie chart maker. It makes one piece in the circle and the size depends on what percentage you give it (0-100). I used gradient colors to make it look right. I also made it so people can save it as a .BMP graphic file which is why I have the background white, so people can easily print it later on a graphics program.

Code: QB64: [Select]

1. 'One Piece Pie Chart Maker by Ken G. on Oct. 29, 2019.
2. 'Freeware
3. _TITLE "One Piece Pie Chart Maker"
4. again:
5. SCREEN _NEWIMAGE(800, 600, 32)
6. CLS
7. PAINT (1, 1), _RGB32(255, 255, 255)
8. COLOR _RGB32(0, 0, 0), _RGB32(255, 255, 255)
9. DO
10.     _LIMIT 1000
11.     LOCATE 1, 1: INPUT "Type Percentage Here (0-100):", p
12.     IF p > 100 THEN p = 100
13.     IF p < 0 THEN p = 0
14.     sec = p * .6
15.     c = 100
16.     CLS
17.     CIRCLE (400, 300), 180, _RGB32(255, 0, 0)
18.     seconds = 0
19.     DO
20.         seconds = seconds + .01
21.         s = (60 - seconds) * 6 + 180
22.         x = INT(SIN(s / 180 * 3.141592) * 180) + 400
23.         y = INT(COS(s / 180 * 3.141592) * 180) + 300
24.         c = c + .025
25.         IF seconds > sec THEN LINE (400, 300)-(x, y), _RGB32(c, 0, 255)
26.         IF seconds > sec THEN GOTO two:
27.         CIRCLE (x, y), 2, _RGB32(c, 0, 255)
28.         PAINT (x, y), _RGB32(c, 0, 255)
29.         LINE (400, 300)-(x, y), _RGB32(c, 0, 255)
30.     LOOP
31.     two:
32.     LOCATE 1, 1: INPUT "Save (Y/N):", sv$
33.     LINE (0, 0)-(800, 15), _RGB32(255, 255, 255), BF
34.     IF LEFT$(sv$, 1) = "y" OR LEFT$(sv$, 1) = "Y" THEN GOSUB saving:
35. LOOP
36. saving:
37. _LIMIT 500
38. 'Now we call up the SUB to save the image to BMP.
39. SaveImage 0, "temp.bmp"
40. _DELAY .25
41. CLS
42. LINE (0, 0)-(800, 600), _RGB32(0, 0, 0), BF
43. COLOR _RGB32(255, 255, 255), _RGB32(0, 0, 0)
44. PRINT "                               Saving"
45. PRINT
46. PRINT "                  Your BMP file will be saved in the"
47. PRINT "                  same directory as this program is."
48. PRINT "                  It can be used with almost any"
49. PRINT "                  other graphics program or website."
50. PRINT "                  It is saved using:"
51. PRINT "                  width: 800  height: 600 pixels."
52. PRINT
53. PRINT "                  Type a name to save your picture"
54. PRINT "                  and press the Enter key. Do not"
55. PRINT "                  add .bmp at the end, the program"
56. PRINT "                  will do it automatically."
57. PRINT
58. PRINT "                  Also do not use the name temp"
59. PRINT "                  because the program uses that name"
60. PRINT "                  and it would be erased the next time"
61. PRINT "                  you save a picture."
62. PRINT "                  Example: MyPic"
63. PRINT "                  Q and Enter goes to main screen."
64. PRINT
65. INPUT "         ->"; nm$
66. IF nm$ = "Q" OR nm$ = "q" THEN GOTO again:
67. nm$ = nm$ + ".bmp"
68. 'Checking to see if the file already exists on your computer.
69. theFileExists = _FILEEXISTS(nm$)
70. IF theFileExists = -1 THEN
71.     PRINT
72.     PRINT "             File Already Exists"
73.     PRINT "             Saving will delete your old"
74.     PRINT "             bmp picture."
75.     PRINT "             Would you like to still do it?"
76.     PRINT "             (Y/N)."
77.     PRINT "             Esc goes to start screen."
78.     llloop:
79.     _LIMIT 100
80.     ag2$ = INKEY$
81.     IF ag2$ = CHR$(27) THEN GOTO again:
82.     IF ag2$ = "" THEN GOTO llloop:
83.     IF ag2$ = "y" OR ag$ = "Y" THEN
84.         SHELL _HIDE "DEL " + nm$
85.         GOTO saving2:
86.     END IF
87.     GOTO llloop:
88. END IF
89. saving2:
90. SHELL _HIDE "REN " + "temp.bmp" + " " + nm$
91. nm$ = ""
92. FOR snd = 100 TO 500 STEP 100
93.     SOUND snd, 2
94. NEXT snd
95. CLS
96. GOTO again:
97. SUB SaveImage (image AS LONG, filename AS STRING)
98.     bytesperpixel& = _PIXELSIZE(image&)
99.     IF bytesperpixel& = 0 THEN PRINT "Text modes unsupported!": END
100.     IF bytesperpixel& = 1 THEN bpp& = 8 ELSE bpp& = 24
101.     x& = _WIDTH(image&)
102.     y& = _HEIGHT(image&)
103.     b$ = "BM????QB64????" + MKL$(40) + MKL$(x&) + MKL$(y&) + MKI$(1) + MKI$(bpp&) + MKL$(0) + "????" + STRING$(16, 0) 'partial BMP header info(???? to be filled later)
104.     IF bytesperpixel& = 1 THEN
105.         FOR c& = 0 TO 255 ' read BGR color settings from JPG image + 1 byte spacer(CHR$(0))
106.             cv& = _PALETTECOLOR(c&, image&) ' color attribute to read.
107.             b$ = b$ + CHR$(_BLUE32(cv&)) + CHR$(_GREEN32(cv&)) + CHR$(_RED32(cv&)) + CHR$(0) 'spacer byte
108.         NEXT
109.     END IF
110.     MID$(b$, 11, 4) = MKL$(LEN(b$)) ' image pixel data offset(BMP header)
111.     lastsource& = _SOURCE
112.     _SOURCE image&
113.     IF ((x& * 3) MOD 4) THEN padder$ = STRING$(4 - ((x& * 3) MOD 4), 0)
114.     FOR py& = y& - 1 TO 0 STEP -1 ' read JPG image pixel color data
115.         r$ = ""
116.         FOR px& = 0 TO x& - 1
117.             c& = POINT(px&, py&) 'POINT 32 bit values are large LONG values
118.             IF bytesperpixel& = 1 THEN r$ = r$ + CHR$(c&) ELSE r$ = r$ + LEFT$(MKL$(c&), 3)
119.         NEXT px&
120.         d$ = d$ + r$ + padder$
121.     NEXT py&
122.     _SOURCE lastsource&
123.     MID$(b$, 35, 4) = MKL$(LEN(d$)) ' image size(BMP header)
124.     b$ = b$ + d$ ' total file data bytes to create file
125.     MID$(b$, 3, 4) = MKL$(LEN(b$)) ' size of data file(BMP header)
126.     IF LCASE$(RIGHT$(filename$, 4)) <> ".bmp" THEN ext$ = ".bmp"
127.     f& = FREEFILE
128.     OPEN filename$ + ext$ FOR OUTPUT AS #f&: CLOSE #f& ' erases an existing file
129.     OPEN filename$ + ext$ FOR BINARY AS #f&
130.     PUT #f&, , b$
131.     CLOSE #f&
132. END SUB
133.  

[bplus]

Ken you sure come up with interesting ideas!

Most people might have tried the CIRCLE's arc options. ;)

[SierraKen]

LOL I didn't even think of that. But I like my way, it goes with the same circle equation I've used on quite a few programs now. :)
Oh, one other thing is that using the CIRCLE command, I wouldn't have been able to have the colors change as it goes around. Instead they would change as it goes from center toward outer area.I like mine better. :)

[bplus]

Well the CIRCLE arc drawing also leaks PAINT, so fills would often fill the whole screen.

I like your way better too except for the holes, I might have something of interest...

[SierraKen]

I just made it so almost all the holes are filled. It just leaves some small streaks as a small X. I am adding 2 attachment pictures to show people 2 examples below.
Oh, and thanks! I had fun making it. The streaks make it look like a special design feature. :)

Here is what I have:

Code: QB64: [Select]

1. 'One Piece Pie Chart Maker by Ken G. on Oct. 29, 2019.
2. 'Freeware
3. _TITLE "One Piece Pie Chart Maker"
4. again:
5. SCREEN _NEWIMAGE(800, 600, 32)
6. CLS
7. PAINT (1, 1), _RGB32(255, 255, 255)
8. COLOR _RGB32(0, 0, 0), _RGB32(255, 255, 255)
9. DO
10.     _LIMIT 1000
11.     LOCATE 1, 1: INPUT "Type Percentage Here (0-100):", p
12.     IF p > 100 THEN p = 100
13.     IF p < 0 THEN p = 0
14.     sec = p * .6
15.     c = 100
16.     CLS
17.     CIRCLE (400, 300), 180, _RGB32(255, 0, 0)
18.     seconds = 0
19.     DO
20.         seconds = seconds + .0001
21.         s = (60 - seconds) * 6 + 180
22.         x = INT(SIN(s / 180 * 3.14) * 180) + 400
23.         y = INT(COS(s / 180 * 3.14) * 180) + 300
24.         c = c + .00025
25.         IF seconds > sec THEN LINE (400, 300)-(x, y), _RGB32(c, 0, 255)
26.         IF seconds > sec THEN GOTO two:
27.         LINE (400, 300)-(x, y), _RGB32(c, 0, 255)
28.     LOOP
29.     two:
30.     LOCATE 1, 1: INPUT "Save (Y/N):", sv$
31.     LINE (0, 0)-(800, 15), _RGB32(255, 255, 255), BF
32.     IF LEFT$(sv$, 1) = "y" OR LEFT$(sv$, 1) = "Y" THEN GOSUB saving:
33. LOOP
34. saving:
35. _LIMIT 1000
36. 'Now we call up the SUB to save the image to BMP.
37. SaveImage 0, "temp.bmp"
38. _DELAY .25
39. CLS
40. LINE (0, 0)-(800, 600), _RGB32(0, 0, 0), BF
41. COLOR _RGB32(255, 255, 255), _RGB32(0, 0, 0)
42. PRINT "                               Saving"
43. PRINT
44. PRINT "                  Your BMP file will be saved in the"
45. PRINT "                  same directory as this program is."
46. PRINT "                  It can be used with almost any"
47. PRINT "                  other graphics program or website."
48. PRINT "                  It is saved using:"
49. PRINT "                  width: 800  height: 600 pixels."
50. PRINT
51. PRINT "                  Type a name to save your picture"
52. PRINT "                  and press the Enter key. Do not"
53. PRINT "                  add .bmp at the end, the program"
54. PRINT "                  will do it automatically."
55. PRINT
56. PRINT "                  Also do not use the name temp"
57. PRINT "                  because the program uses that name"
58. PRINT "                  and it would be erased the next time"
59. PRINT "                  you save a picture."
60. PRINT "                  Example: MyPic"
61. PRINT "                  Q and Enter goes to main screen."
62. PRINT
63. INPUT "         ->"; nm$
64. IF nm$ = "Q" OR nm$ = "q" THEN GOTO again:
65. nm$ = nm$ + ".bmp"
66. 'Checking to see if the file already exists on your computer.
67. theFileExists = _FILEEXISTS(nm$)
68. IF theFileExists = -1 THEN
69.     PRINT
70.     PRINT "             File Already Exists"
71.     PRINT "             Saving will delete your old"
72.     PRINT "             bmp picture."
73.     PRINT "             Would you like to still do it?"
74.     PRINT "             (Y/N)."
75.     PRINT "             Esc goes to start screen."
76.     llloop:
77.     _LIMIT 100
78.     ag2$ = INKEY$
79.     IF ag2$ = CHR$(27) THEN GOTO again:
80.     IF ag2$ = "" THEN GOTO llloop:
81.     IF ag2$ = "y" OR ag$ = "Y" THEN
82.         SHELL _HIDE "DEL " + nm$
83.         GOTO saving2:
84.     END IF
85.     GOTO llloop:
86. END IF
87. saving2:
88. SHELL _HIDE "REN " + "temp.bmp" + " " + nm$
89. nm$ = ""
90. FOR snd = 100 TO 500 STEP 100
91.     SOUND snd, 2
92. NEXT snd
93. CLS
94. GOTO again:
95. SUB SaveImage (image AS LONG, filename AS STRING)
96.     bytesperpixel& = _PIXELSIZE(image&)
97.     IF bytesperpixel& = 0 THEN PRINT "Text modes unsupported!": END
98.     IF bytesperpixel& = 1 THEN bpp& = 8 ELSE bpp& = 24
99.     x& = _WIDTH(image&)
100.     y& = _HEIGHT(image&)
101.     b$ = "BM????QB64????" + MKL$(40) + MKL$(x&) + MKL$(y&) + MKI$(1) + MKI$(bpp&) + MKL$(0) + "????" + STRING$(16, 0) 'partial BMP header info(???? to be filled later)
102.     IF bytesperpixel& = 1 THEN
103.         FOR c& = 0 TO 255 ' read BGR color settings from JPG image + 1 byte spacer(CHR$(0))
104.             cv& = _PALETTECOLOR(c&, image&) ' color attribute to read.
105.             b$ = b$ + CHR$(_BLUE32(cv&)) + CHR$(_GREEN32(cv&)) + CHR$(_RED32(cv&)) + CHR$(0) 'spacer byte
106.         NEXT
107.     END IF
108.     MID$(b$, 11, 4) = MKL$(LEN(b$)) ' image pixel data offset(BMP header)
109.     lastsource& = _SOURCE
110.     _SOURCE image&
111.     IF ((x& * 3) MOD 4) THEN padder$ = STRING$(4 - ((x& * 3) MOD 4), 0)
112.     FOR py& = y& - 1 TO 0 STEP -1 ' read JPG image pixel color data
113.         r$ = ""
114.         FOR px& = 0 TO x& - 1
115.             c& = POINT(px&, py&) 'POINT 32 bit values are large LONG values
116.             IF bytesperpixel& = 1 THEN r$ = r$ + CHR$(c&) ELSE r$ = r$ + LEFT$(MKL$(c&), 3)
117.         NEXT px&
118.         d$ = d$ + r$ + padder$
119.     NEXT py&
120.     _SOURCE lastsource&
121.     MID$(b$, 35, 4) = MKL$(LEN(d$)) ' image size(BMP header)
122.     b$ = b$ + d$ ' total file data bytes to create file
123.     MID$(b$, 3, 4) = MKL$(LEN(b$)) ' size of data file(BMP header)
124.     IF LCASE$(RIGHT$(filename$, 4)) <> ".bmp" THEN ext$ = ".bmp"
125.     f& = FREEFILE
126.     OPEN filename$ + ext$ FOR OUTPUT AS #f&: CLOSE #f& ' erases an existing file
127.     OPEN filename$ + ext$ FOR BINARY AS #f&
128.     PUT #f&, , b$
129.     CLOSE #f&
130. END SUB
131.  

[SierraKen]

What I did (above) was I made 100x as many lines and I could do this because I removed the CIRCLE and PAINT commands for the outer edge of the pie piece and this made it go tons faster. There was no need for it anyway because the lines took up the space from the center to the circle anyways. This also smoothed out the outer edge a lot better. :)
So, I'm pretty sure I am done with this one. I'll put it on my website tomorrow (Wednesday).

[bplus]

Well here is a hole filler, maybe you can figure out how to do the fraction part:

Code: QB64: [Select]

1. _TITLE "Rainbow Circle" 'B+ 2019-10-30 trans from JB
2. CONST xmax = 700, ymax = 700, pi = _PI, cx = xmax / 2, cy = ymax / 2, radius = 325
3. SCREEN _NEWIMAGE(xmax, ymax, 32)
4. _SCREENMOVE 400, 20
5. FOR a = 0 TO 2 * pi STEP 1 / radius
6.     x1 = cx + radius * COS(a): y1 = cy + radius * SIN(a)
7.     thic cx, cy, x1, y1, 2, rainbow~&(a / (2 * pi))
8. NEXT
9. SLEEP
10.  
11. FUNCTION rainbow~& (fraction)
12.     radians = fraction * 2 * pi
13.     r = SIN(radians) * 127 + 128
14.     g = SIN(radians - 2 / 3 * pi) * 127 + 128
15.     b = SIN(radians + 2 / 3 * pi) * 127 + 128
16.     rainbow~& = _RGB32(r, g, b)
17. END FUNCTION
18.  
19. SUB thic (x1, y1, x2, y2, thick, K AS _UNSIGNED LONG)  'thick lines
20.     PD2 = pi / 2
21.     DIM t2 AS SINGLE, a AS SINGLE, x3 AS SINGLE, y3 AS SINGLE, x4 AS SINGLE, y4 AS SINGLE
22.     DIM x5 AS SINGLE, y5 AS SINGLE, x6 AS SINGLE, y6 AS SINGLE
23.     t2 = thick / 2
24.     IF t2 < 1 THEN t2 = 1
25.     a = _ATAN2(y2 - y1, x2 - x1)
26.     x3 = x1 + t2 * COS(a + PD2)
27.     y3 = y1 + t2 * SIN(a + PD2)
28.     x4 = x1 + t2 * COS(a - PD2)
29.     y4 = y1 + t2 * SIN(a - PD2)
30.     x5 = x2 + t2 * COS(a + PD2)
31.     y5 = y2 + t2 * SIN(a + PD2)
32.     x6 = x2 + t2 * COS(a - PD2)
33.     y6 = y2 + t2 * SIN(a - PD2)
34.     ftri x6, y6, x4, y4, x3, y3, K
35.     ftri x3, y3, x5, y5, x6, y6, K
36. END SUB
37.  
38. SUB ftri (x1, y1, x2, y2, x3, y3, K AS _UNSIGNED LONG)  ;fill triangle
39.     DIM a&
40.     a& = _NEWIMAGE(1, 1, 32)
41.     _DEST a&
42.     PSET (0, 0), K
43.     _DEST 0
44.     _MAPTRIANGLE _SEAMLESS(0, 0)-(0, 0)-(0, 0), a& TO(x1, y1)-(x2, y2)-(x3, y3)
45.     _FREEIMAGE a& '<<< this is important!
46. END SUB
47.  
48.  
49.  

[codeguy]

Just a tiny change for origin of gradient fill for the original code.

Code: [Select]

_TITLE "Rainbow Circle" 'B+ 2019-10-30 trans from JB
CONST xmax = 700, ymax = 700, pi = _PI, cx = xmax / 2, cy = ymax / 2, radius = 325
SCREEN _NEWIMAGE(xmax, ymax, 32)
_SCREENMOVE 400, 20
f! = .5 '*  the fraction of the circle to fill in with a gradient -- tiny mod by CodeGuy
Rotate! = pi / 2
FOR a = 0 TO (2 * pi) * f! STEP 1 / radius
    x1 = cx + radius * COS(a - Rotate!): y1 = cy + radius * SIN(a - Rotate!)
    thic cx, cy, x1, y1, 2, rainbow~&(a / (2 * pi))
NEXT
SLEEP

FUNCTION rainbow~& (fraction)
    radians = fraction * 2 * pi
    r = SIN(radians) * 127 + 128
    g = SIN(radians - 2 / 3 * pi) * 127 + 128
    b = SIN(radians + 2 / 3 * pi) * 127 + 128
    rainbow~& = _RGB32(r, g, b)
END FUNCTION

SUB thic (x1, y1, x2, y2, thick, K AS _UNSIGNED LONG) 'thick lines
    PD2 = pi / 2
    DIM t2 AS SINGLE, a AS SINGLE, x3 AS SINGLE, y3 AS SINGLE, x4 AS SINGLE, y4 AS SINGLE
    DIM x5 AS SINGLE, y5 AS SINGLE, x6 AS SINGLE, y6 AS SINGLE
    t2 = thick / 2
    IF t2 < 1 THEN t2 = 1
    a = _ATAN2(y2 - y1, x2 - x1)
    x3 = x1 + t2 * COS(a + PD2)
    y3 = y1 + t2 * SIN(a + PD2)
    x4 = x1 + t2 * COS(a - PD2)
    y4 = y1 + t2 * SIN(a - PD2)
    x5 = x2 + t2 * COS(a + PD2)
    y5 = y2 + t2 * SIN(a + PD2)
    x6 = x2 + t2 * COS(a - PD2)
    y6 = y2 + t2 * SIN(a - PD2)
    ftri x6, y6, x4, y4, x3, y3, K
    ftri x3, y3, x5, y5, x6, y6, K
END SUB

SUB ftri (x1, y1, x2, y2, x3, y3, K AS _UNSIGNED LONG) ' ;fill triangle
    DIM a&
    a& = _NEWIMAGE(1, 1, 32)
    _DEST a&
    PSET (0, 0), K
    _DEST 0
    _MAPTRIANGLE _SEAMLESS(0, 0)-(0, 0)-(0, 0), a& TO(x1, y1)-(x2, y2)-(x3, y3)
    _FREEIMAGE a& '<<< this is important!
END SUB


[Petr]

BPlus based:

Code: QB64: [Select]

1. _TITLE "Rainbow Circle" 'B+ 2019-10-30 trans from JB
2. CONST xmax = 700, ymax = 700, pi = _PI, cx = xmax / 2, cy = ymax / 2, radius = 325
3. SCREEN _NEWIMAGE(xmax, ymax, 32)
4. _SCREENMOVE 400, 20
5. INPUT "Insert percentage:"; per
6.  
7. FOR a = -_PI / 2 TO -_PI / 2 + _PI(2) / 100 * per STEP 1 / radius
8.     x1 = cx + radius * COS(a): y1 = cy + radius * SIN(a)
9.     thic cx, cy, x1, y1, 2, rainbow~&(a / (2 * pi))
10. NEXT
11. SLEEP
12.  
13. FUNCTION rainbow~& (fraction)
14.     radians = fraction * 2 * pi
15.     r = SIN(radians) * 127 + 128
16.     g = SIN(radians - 2 / 3 * pi) * 127 + 128
17.     b = SIN(radians + 2 / 3 * pi) * 127 + 128
18.     rainbow~& = _RGB32(r, g, b)
19. END FUNCTION
20.  
21. SUB thic (x1, y1, x2, y2, thick, K AS _UNSIGNED LONG) 'thick lines
22.     PD2 = pi / 2
23.     DIM t2 AS SINGLE, a AS SINGLE, x3 AS SINGLE, y3 AS SINGLE, x4 AS SINGLE, y4 AS SINGLE
24.     DIM x5 AS SINGLE, y5 AS SINGLE, x6 AS SINGLE, y6 AS SINGLE
25.     t2 = thick / 2
26.     IF t2 < 1 THEN t2 = 1
27.     a = _ATAN2(y2 - y1, x2 - x1)
28.     x3 = x1 + t2 * COS(a + PD2)
29.     y3 = y1 + t2 * SIN(a + PD2)
30.     x4 = x1 + t2 * COS(a - PD2)
31.     y4 = y1 + t2 * SIN(a - PD2)
32.     x5 = x2 + t2 * COS(a + PD2)
33.     y5 = y2 + t2 * SIN(a + PD2)
34.     x6 = x2 + t2 * COS(a - PD2)
35.     y6 = y2 + t2 * SIN(a - PD2)
36.     ftri x6, y6, x4, y4, x3, y3, K
37.     ftri x3, y3, x5, y5, x6, y6, K
38. END SUB
39.  
40. SUB ftri (x1, y1, x2, y2, x3, y3, K AS _UNSIGNED LONG)
41.     DIM a&
42.     a& = _NEWIMAGE(1, 1, 32)
43.     _DEST a&
44.     PSET (0, 0), K
45.     _DEST 0
46.     _MAPTRIANGLE _SEAMLESS(0, 0)-(0, 0)-(0, 0), a& TO(x1, y1)-(x2, y2)-(x3, y3)
47.     _FREEIMAGE a& '<<< this is important!
48. END SUB
49.  

[Ashish]

Hi! Nice work SierraKen, Bplus, Codeguy & Bplus!
I made this rainbow circles dance!

Code: QB64: [Select]

1. _TITLE "Rainbow Circle" 'B+ 2019-10-30 trans from JB
2. 'Dance MOD By Ashish
3. CONST xmax = 700, ymax = 700, pi = _PI, cx = xmax / 2, cy = ymax / 2, radius = 325
4. SCREEN _NEWIMAGE(xmax, ymax, 32)
5.  
6. TYPE balls
7.     x AS SINGLE
8.     y AS SINGLE
9.     rotSpeed AS SINGLE
10.     rad AS SINGLE
11.     rot AS SINGLE
12. END TYPE
13.  
14. DIM SHARED ball(300) AS balls, glAllow
15.  
16. FOR i = 0 TO UBOUND(ball)
17.     ball(i).x = RND * 2 - 1
18.     ball(i).y = RND * 2 - 1
19.     ball(i).rad = RND * 0.25 + 0.0625
20.     ball(i).rotSpeed = RND * 0.1 + 0.01
21. NEXT
22. '_SCREENMOVE 400, 20
23. 'INPUT "Insert percentage:"; per
24.  
25. 'FOR a = -_PI / 2 TO -_PI / 2 + _PI(2) / 100 * per STEP 1 / radius
26. '    x1 = cx + radius * COS(a): y1 = cy + radius * SIN(a)
27. '    thic cx, cy, x1, y1, 2, rainbow~&(a / (2 * pi))
28. 'NEXT
29. 'SLEEP
30. glAllow = 1
31. DO
32.     _LIMIT 30
33. LOOP
34.  
35. SUB _GL ()
36.     IF NOT glAllow = 1 THEN EXIT SUB
37.     STATIC glInit
38.     IF glInit = 0 THEN
39.         _glViewport 0, 0, _WIDTH, _HEIGHT
40.         glInit = -1
41.  
42.     END IF
43.     _glMatrixMode _GL_MODELVIEW
44.  
45.  
46.  
47.     FOR i = 0 TO UBOUND(ball)
48.         _glPushMatrix
49.         _glTranslatef ball(i).x, ball(i).y, 0
50.         _glBegin _GL_TRIANGLE_FAN
51.         FOR j = 0 TO _PI(2) STEP 0.05
52.             rainbow j / _PI(2) + ball(i).rot
53.             _glVertex2f COS(j) * ball(i).rad, SIN(j) * ball(i).rad
54.         NEXT
55.         _glEnd
56.         ball(i).rot = ball(i).rot + ball(i).rotSpeed
57.         _glPopMatrix
58.     NEXT
59.  
60.     _glFlush
61. END SUB
62.  
63. SUB rainbow (fraction)
64.     'FUNCTION rainbow~& (fraction)
65.     'MODED for OpenGL use
66.     radians = fraction * 2 * pi
67.     r = SIN(radians) * 127 + 128
68.     g = SIN(radians - 2 / 3 * pi) * 127 + 128
69.     b = SIN(radians + 2 / 3 * pi) * 127 + 128
70.  
71.     _glColor3f r / 255, g / 255, b / 255 'map values between 0 & 1
72.     ' rainbow~& = _RGB32(r, g, b)
73.     'END FUNCTION
74. END SUB
75.  
76. SUB thic (x1, y1, x2, y2, thick, K AS _UNSIGNED LONG) 'thick lines
77.     PD2 = pi / 2
78.     DIM t2 AS SINGLE, a AS SINGLE, x3 AS SINGLE, y3 AS SINGLE, x4 AS SINGLE, y4 AS SINGLE
79.     DIM x5 AS SINGLE, y5 AS SINGLE, x6 AS SINGLE, y6 AS SINGLE
80.     t2 = thick / 2
81.     IF t2 < 1 THEN t2 = 1
82.     a = _ATAN2(y2 - y1, x2 - x1)
83.     x3 = x1 + t2 * COS(a + PD2)
84.     y3 = y1 + t2 * SIN(a + PD2)
85.     x4 = x1 + t2 * COS(a - PD2)
86.     y4 = y1 + t2 * SIN(a - PD2)
87.     x5 = x2 + t2 * COS(a + PD2)
88.     y5 = y2 + t2 * SIN(a + PD2)
89.     x6 = x2 + t2 * COS(a - PD2)
90.     y6 = y2 + t2 * SIN(a - PD2)
91.     ftri x6, y6, x4, y4, x3, y3, K
92.     ftri x3, y3, x5, y5, x6, y6, K
93. END SUB
94.  
95. SUB ftri (x1, y1, x2, y2, x3, y3, K AS _UNSIGNED LONG)
96.     DIM a&
97.     a& = _NEWIMAGE(1, 1, 32)
98.     _DEST a&
99.     PSET (0, 0), K
100.     _DEST 0
101.     _MAPTRIANGLE _SEAMLESS(0, 0)-(0, 0)-(0, 0), a& TO(x1, y1)-(x2, y2)-(x3, y3)
102.     _FREEIMAGE a& '<<< this is important!
103. END SUB
104.  
105.  
106.  
107.  
108.  

[bplus]

Ah Codeguy,

Code: QB64: [Select]

1. f! = .5 '*  the fraction of the circle to fill in with a gradient -- tiny mod by CodeGuy

A clue to Ken, how he may show whole range of color for 50%, right?

Oh and you and Petr are shifting the start of the angle to 12 o'clock, too.

I was hoping Ken might figure these out, but I didn't think about the rotation to 12 o'clock.


Ha! Ashish, another good one for Diwali! :)

[SierraKen]

Wow this is awesome you all found different ways! But guess what? Last night I thought of a much simpler way to fill all the holes. I tried it out this morning and it works perfectly! Here is the snippet of code that fills the holes and a 100% example picture below. Now I don't have to tear apart my code and learn a bunch of stuff. Just remember, we all program differently. :) Although some day I wish to keep learning more of course. And thank you everyone for all the examples you wrote out. I hope you all are learning like I do. I will first put the snippet of code and then I will put the whole program again so you can have it all.  Next, I'm going to make it so people can add text.

Snippet:

Code: QB64: [Select]

1.     two:
2.  
3.     'Hole Filler
4.     FOR xx = 0 TO 800
5.         FOR yy = 20 TO 600
6.             IF POINT(xx, yy) = _RGB32(255, 255, 255) AND POINT(xx - 1, yy) <> _RGB32(255, 255, 255) AND POINT(xx + 1, yy) <> _RGB32(255, 255, 255) THEN
7.                 cl& = POINT(xx + 1, yy)
8.                 PSET (xx, yy), cl&
9.             END IF
10.         NEXT yy
11.     NEXT xx
12.  
13.     LOCATE 1, 1: INPUT "Save (Y/N):", sv$
14.     LINE (0, 0)-(800, 15), _RGB32(255, 255, 255), BF
15.     IF LEFT$(sv$, 1) = "y" OR LEFT$(sv$, 1) = "Y" THEN GOSUB saving:
16.  
17. LOOP
18.  

Code: QB64: [Select]

1. 'One Piece Pie Chart Maker by Ken G. on Oct. 29, 2019.
2. 'Freeware
3. _TITLE "One Piece Pie Chart Maker"
4. again:
5. SCREEN _NEWIMAGE(800, 600, 32)
6. CLS
7. PAINT (1, 1), _RGB32(255, 255, 255)
8. COLOR _RGB32(0, 0, 0), _RGB32(255, 255, 255)
9. DO
10.     _LIMIT 1000
11.     LOCATE 1, 1: INPUT "Type Percentage Here (0-100):", p
12.     IF p > 100 THEN p = 100
13.     IF p < 0 THEN p = 0
14.     sec = p * .6
15.     c = 100
16.     CLS
17.     CIRCLE (400, 300), 180, _RGB32(255, 0, 0)
18.     seconds = 0
19.     DO
20.         seconds = seconds + .0001
21.         s = (60 - seconds) * 6 + 180
22.         x = INT(SIN(s / 180 * 3.14) * 180) + 400
23.         y = INT(COS(s / 180 * 3.14) * 180) + 300
24.         c = c + .00025
25.         IF seconds > sec THEN LINE (400, 300)-(x, y), _RGB32(c, 0, 255)
26.         IF seconds > sec THEN GOTO two:
27.         LINE (400, 300)-(x, y), _RGB32(c, 0, 255)
28.     LOOP
29.     two:
30.  
31.     'Hole Filler
32.     FOR xx = 0 TO 800
33.         FOR yy = 20 TO 600
34.             IF POINT(xx, yy) = _RGB32(255, 255, 255) AND POINT(xx - 1, yy) <> _RGB32(255, 255, 255) AND POINT(xx + 1, yy) <> _RGB32(255, 255, 255) THEN
35.                 cl& = POINT(xx + 1, yy)
36.                 PSET (xx, yy), cl&
37.             END IF
38.         NEXT yy
39.     NEXT xx
40.  
41.     LOCATE 1, 1: INPUT "Save (Y/N):", sv$
42.     LINE (0, 0)-(800, 15), _RGB32(255, 255, 255), BF
43.     IF LEFT$(sv$, 1) = "y" OR LEFT$(sv$, 1) = "Y" THEN GOSUB saving:
44.  
45. LOOP
46. saving:
47. _LIMIT 1000
48. 'Now we call up the SUB to save the image to BMP.
49. SaveImage 0, "temp.bmp"
50. _DELAY .25
51. CLS
52. LINE (0, 0)-(800, 600), _RGB32(0, 0, 0), BF
53. COLOR _RGB32(255, 255, 255), _RGB32(0, 0, 0)
54. PRINT "                               Saving"
55. PRINT
56. PRINT "                  Your BMP file will be saved in the"
57. PRINT "                  same directory as this program is."
58. PRINT "                  It can be used with almost any"
59. PRINT "                  other graphics program or website."
60. PRINT "                  It is saved using:"
61. PRINT "                  width: 800  height: 600 pixels."
62. PRINT
63. PRINT "                  Type a name to save your picture"
64. PRINT "                  and press the Enter key. Do not"
65. PRINT "                  add .bmp at the end, the program"
66. PRINT "                  will do it automatically."
67. PRINT
68. PRINT "                  Also do not use the name temp"
69. PRINT "                  because the program uses that name"
70. PRINT "                  and it would be erased the next time"
71. PRINT "                  you save a picture."
72. PRINT "                  Example: MyPic"
73. PRINT "                  Q and Enter goes to main screen."
74. PRINT
75. INPUT "         ->"; nm$
76. IF nm$ = "Q" OR nm$ = "q" THEN GOTO again:
77. nm$ = nm$ + ".bmp"
78. 'Checking to see if the file already exists on your computer.
79. theFileExists = _FILEEXISTS(nm$)
80. IF theFileExists = -1 THEN
81.     PRINT
82.     PRINT "             File Already Exists"
83.     PRINT "             Saving will delete your old"
84.     PRINT "             bmp picture."
85.     PRINT "             Would you like to still do it?"
86.     PRINT "             (Y/N)."
87.     PRINT "             Esc goes to start screen."
88.     llloop:
89.     _LIMIT 100
90.     ag2$ = INKEY$
91.     IF ag2$ = CHR$(27) THEN GOTO again:
92.     IF ag2$ = "" THEN GOTO llloop:
93.     IF ag2$ = "y" OR ag$ = "Y" THEN
94.         SHELL _HIDE "DEL " + nm$
95.         GOTO saving2:
96.     END IF
97.     GOTO llloop:
98. END IF
99. saving2:
100. SHELL _HIDE "REN " + "temp.bmp" + " " + nm$
101. nm$ = ""
102. FOR snd = 100 TO 500 STEP 100
103.     SOUND snd, 2
104. NEXT snd
105. CLS
106. GOTO again:
107. SUB SaveImage (image AS LONG, filename AS STRING)
108.     bytesperpixel& = _PIXELSIZE(image&)
109.     IF bytesperpixel& = 0 THEN PRINT "Text modes unsupported!": END
110.     IF bytesperpixel& = 1 THEN bpp& = 8 ELSE bpp& = 24
111.     x& = _WIDTH(image&)
112.     y& = _HEIGHT(image&)
113.     b$ = "BM????QB64????" + MKL$(40) + MKL$(x&) + MKL$(y&) + MKI$(1) + MKI$(bpp&) + MKL$(0) + "????" + STRING$(16, 0) 'partial BMP header info(???? to be filled later)
114.     IF bytesperpixel& = 1 THEN
115.         FOR c& = 0 TO 255 ' read BGR color settings from JPG image + 1 byte spacer(CHR$(0))
116.             cv& = _PALETTECOLOR(c&, image&) ' color attribute to read.
117.             b$ = b$ + CHR$(_BLUE32(cv&)) + CHR$(_GREEN32(cv&)) + CHR$(_RED32(cv&)) + CHR$(0) 'spacer byte
118.         NEXT
119.     END IF
120.     MID$(b$, 11, 4) = MKL$(LEN(b$)) ' image pixel data offset(BMP header)
121.     lastsource& = _SOURCE
122.     _SOURCE image&
123.     IF ((x& * 3) MOD 4) THEN padder$ = STRING$(4 - ((x& * 3) MOD 4), 0)
124.     FOR py& = y& - 1 TO 0 STEP -1 ' read JPG image pixel color data
125.         r$ = ""
126.         FOR px& = 0 TO x& - 1
127.             c& = POINT(px&, py&) 'POINT 32 bit values are large LONG values
128.             IF bytesperpixel& = 1 THEN r$ = r$ + CHR$(c&) ELSE r$ = r$ + LEFT$(MKL$(c&), 3)
129.         NEXT px&
130.         d$ = d$ + r$ + padder$
131.     NEXT py&
132.     _SOURCE lastsource&
133.     MID$(b$, 35, 4) = MKL$(LEN(d$)) ' image size(BMP header)
134.     b$ = b$ + d$ ' total file data bytes to create file
135.     MID$(b$, 3, 4) = MKL$(LEN(b$)) ' size of data file(BMP header)
136.     IF LCASE$(RIGHT$(filename$, 4)) <> ".bmp" THEN ext$ = ".bmp"
137.     f& = FREEFILE
138.     OPEN filename$ + ext$ FOR OUTPUT AS #f&: CLOSE #f& ' erases an existing file
139.     OPEN filename$ + ext$ FOR BINARY AS #f&
140.     PUT #f&, , b$
141.     CLOSE #f&
142. END SUB
143.  

[SierraKen]

OK, I have the final version now I think. You can add text anywhere. It explains everything in the TITLE bar. You go to TEXT MODE by pressing T and then use the mouse and press Enter.  Each time you press Enter, it goes back to the main mode. So if you want to make more text, press T again. I also made it so the text stands out with a white font inside the filled pie and a black font on the empty areas. One trick I learned today was in order to see the cursor on a white background, you have to make the background of the COLOR anything except white. So I made a 100 green, even though for some reason it still shows a white background which is what I want, and the cursor shows up that way. I think the white is blending in with the green because I can still see a shade of green when I look carefully on it. But just barely.

Code: QB64: [Select]

1. 'One Piece Pie Chart Maker by Ken G. on Oct. 30, 2019.
2. 'Freeware
3. _TITLE "One Piece Pie Chart Maker"
4. again:
5. SCREEN _NEWIMAGE(800, 600, 32)
6. CLS
7. PAINT (1, 1), _RGB32(255, 255, 255)
8. COLOR _RGB32(0, 0, 0), _RGB32(255, 255, 255)
9. DO
10.     _LIMIT 1000
11.     LOCATE 1, 1: INPUT "Type Percentage Here (0-100):", p
12.     IF p > 100 THEN p = 100
13.     IF p < 0 THEN p = 0
14.     sec = p * .6
15.     c = 100
16.     CLS
17.     CIRCLE (400, 300), 180, _RGB32(255, 0, 0)
18.     seconds = 0
19.     DO
20.         seconds = seconds + .0001
21.         s = (60 - seconds) * 6 + 180
22.         x = INT(SIN(s / 180 * 3.14) * 180) + 400
23.         y = INT(COS(s / 180 * 3.14) * 180) + 300
24.         c = c + .00025
25.         IF seconds > sec THEN LINE (400, 300)-(x, y), _RGB32(c, 0, 255)
26.         IF seconds > sec THEN GOTO two:
27.         LINE (400, 300)-(x, y), _RGB32(c, 0, 255)
28.     LOOP
29. LOOP
30. two:
31. 'Hole Filler
32. FOR xx = 0 TO 800
33.     FOR yy = 20 TO 600
34.         IF POINT(xx, yy) = _RGB32(255, 255, 255) AND POINT(xx - 1, yy) <> _RGB32(255, 255, 255) AND POINT(xx + 1, yy) <> _RGB32(255, 255, 255) THEN
35.             cl& = POINT(xx + 1, yy)
36.             PSET (xx, yy), cl&
37.         END IF
38.     NEXT yy
39. NEXT xx
40. _TITLE "(T)ext, (S)ave, (D)elete, Esc to Quit"
41. DO
42.     a$ = INKEY$
43.     IF a$ = CHR$(27) THEN END
44.     IF a$ = "t" OR a$ = "T" THEN GOSUB Text:
45.     IF a$ = "s" OR a$ = "S" THEN GOTO saving:
46.     IF a$ = "d" OR a$ = "D" THEN GOTO again:
47. LOOP
48. Text:
49. _TITLE "TEXT MODE - Use Mouse To Click Where You Want To Place Text Then Press Enter."
50. DO
51.     _LIMIT 500
52.     DO WHILE _MOUSEINPUT
53.         mouseX = _MOUSEX
54.         mouseY = _MOUSEY
55.         mouseLeftButton = _MOUSEBUTTON(1)
56.     LOOP
57.     IF mouseLeftButton = -1 THEN
58.         clr& = POINT(mouseX, mouseY)
59.         IF clr& <> _RGB32(255, 255, 255) THEN COLOR _RGB32(255, 255, 255), clr&
60.         IF clr& = _RGB32(255, 255, 255) THEN COLOR _RGB32(0, 100, 0), clr&
61.         LOCATE mouseY / 16, mouseX / 8
62.         INPUT "", txt$
63.         _TITLE "(T)ext, (S)ave, (D)elete, Esc to Quit"
64.         RETURN
65.     END IF
66. LOOP
67. saving:
68. _LIMIT 1000
69. 'Now we call up the SUB to save the image to BMP.
70. SaveImage 0, "temp.bmp"
71. _DELAY .25
72. CLS
73. LINE (0, 0)-(800, 600), _RGB32(0, 0, 0), BF
74. COLOR _RGB32(255, 255, 255), _RGB32(0, 0, 0)
75. PRINT "                               Saving"
76. PRINT
77. PRINT "                  Your BMP file will be saved in the"
78. PRINT "                  same directory as this program is."
79. PRINT "                  It can be used with almost any"
80. PRINT "                  other graphics program or website."
81. PRINT "                  It is saved using:"
82. PRINT "                  width: 800  height: 600 pixels."
83. PRINT
84. PRINT "                  Type a name to save your picture"
85. PRINT "                  and press the Enter key. Do not"
86. PRINT "                  add .bmp at the end, the program"
87. PRINT "                  will do it automatically."
88. PRINT
89. PRINT "                  Also do not use the name temp"
90. PRINT "                  because the program uses that name"
91. PRINT "                  and it would be erased the next time"
92. PRINT "                  you save a picture."
93. PRINT "                  Example: MyPic"
94. PRINT "                  Q and Enter goes to main screen."
95. PRINT
96. INPUT "                  ->"; nm$
97. IF nm$ = "Q" OR nm$ = "q" THEN GOTO again:
98. nm$ = nm$ + ".bmp"
99. 'Checking to see if the file already exists on your computer.
100. theFileExists = _FILEEXISTS(nm$)
101. IF theFileExists = -1 THEN
102.     PRINT
103.     PRINT "             File Already Exists"
104.     PRINT "             Saving will delete your old"
105.     PRINT "             bmp picture."
106.     PRINT "             Would you like to still do it?"
107.     PRINT "             (Y/N)."
108.     PRINT "             Esc goes to start screen."
109.     llloop:
110.     _LIMIT 100
111.     ag2$ = INKEY$
112.     IF ag2$ = CHR$(27) THEN GOTO again:
113.     IF ag2$ = "" THEN GOTO llloop:
114.     IF ag2$ = "y" OR ag$ = "Y" THEN
115.         SHELL _HIDE "DEL " + nm$
116.         GOTO saving2:
117.     END IF
118.     GOTO llloop:
119. END IF
120. saving2:
121. SHELL _HIDE "REN " + "temp.bmp" + " " + nm$
122. nm$ = ""
123. FOR snd = 100 TO 500 STEP 100
124.     SOUND snd, 2
125. NEXT snd
126. CLS
127. GOTO again:
128. SUB SaveImage (image AS LONG, filename AS STRING)
129.     bytesperpixel& = _PIXELSIZE(image&)
130.     IF bytesperpixel& = 0 THEN PRINT "Text modes unsupported!": END
131.     IF bytesperpixel& = 1 THEN bpp& = 8 ELSE bpp& = 24
132.     x& = _WIDTH(image&)
133.     y& = _HEIGHT(image&)
134.     b$ = "BM????QB64????" + MKL$(40) + MKL$(x&) + MKL$(y&) + MKI$(1) + MKI$(bpp&) + MKL$(0) + "????" + STRING$(16, 0) 'partial BMP header info(???? to be filled later)
135.     IF bytesperpixel& = 1 THEN
136.         FOR c& = 0 TO 255 ' read BGR color settings from JPG image + 1 byte spacer(CHR$(0))
137.             cv& = _PALETTECOLOR(c&, image&) ' color attribute to read.
138.             b$ = b$ + CHR$(_BLUE32(cv&)) + CHR$(_GREEN32(cv&)) + CHR$(_RED32(cv&)) + CHR$(0) 'spacer byte
139.         NEXT
140.     END IF
141.     MID$(b$, 11, 4) = MKL$(LEN(b$)) ' image pixel data offset(BMP header)
142.     lastsource& = _SOURCE
143.     _SOURCE image&
144.     IF ((x& * 3) MOD 4) THEN padder$ = STRING$(4 - ((x& * 3) MOD 4), 0)
145.     FOR py& = y& - 1 TO 0 STEP -1 ' read JPG image pixel color data
146.         r$ = ""
147.         FOR px& = 0 TO x& - 1
148.             c& = POINT(px&, py&) 'POINT 32 bit values are large LONG values
149.             IF bytesperpixel& = 1 THEN r$ = r$ + CHR$(c&) ELSE r$ = r$ + LEFT$(MKL$(c&), 3)
150.         NEXT px&
151.         d$ = d$ + r$ + padder$
152.     NEXT py&
153.     _SOURCE lastsource&
154.     MID$(b$, 35, 4) = MKL$(LEN(d$)) ' image size(BMP header)
155.     b$ = b$ + d$ ' total file data bytes to create file
156.     MID$(b$, 3, 4) = MKL$(LEN(b$)) ' size of data file(BMP header)
157.     IF LCASE$(RIGHT$(filename$, 4)) <> ".bmp" THEN ext$ = ".bmp"
158.     f& = FREEFILE
159.     OPEN filename$ + ext$ FOR OUTPUT AS #f&: CLOSE #f& ' erases an existing file
160.     OPEN filename$ + ext$ FOR BINARY AS #f&
161.     PUT #f&, , b$
162.     CLOSE #f&
163. END SUB
164.  
165.  

[_vince]

Not my code but check this out!

Code: QB64: [Select]

1. WIDTH 80, 25
2. DIM slices(0 TO 4)
3.  
4. slices(0) = .33
5. slices(1) = .33
6. slices(2) = .2
7. slices(3) = .09
8. slices(4) = .05
9.  
10.  
11. FOR X = 11 TO 70
12.     TX = (X - 40.5) / 30
13.     FOR Y = 1 TO 25
14.         TY = ((Y - 13) * 2 - .5) / 25
15.         GOSUB getc
16.         BG = C
17.  
18.         TY = ((Y - 13) * 2 + .5) / 25
19.         GOSUB getc
20.         FG = C
21.         COLOR FG, BG
22.         LOCATE Y, X: PRINT CHR$(220);
23. NEXT Y, X
24.  
25. END
26.  
27. getc:
28. 'Adapted from London's code
29. turns = ATN(TY / TX) / ATN(1) / 8 - (TX < 0) / 2 - (TX > 0 AND TY < 0)
30. IF SQR(TY * TY + TX * TX) > 1 THEN C = 0: RETURN
31. Acc = 0
32. C = 0
33. FOR I = 0 TO UBOUND(slices)
34.     Acc = Acc + slices(I)
35.     IF Acc + .001 > turns THEN C = I + 1: EXIT FOR
36. NEXT
37.  
38. RETURN
39.  

[TempodiBasic]

Hi _Vince
fine ASCII pie slice!

 

Hey Pete where are you in these ASCII moments?