Print Page - One Piece Pie Chart Maker

Title: One Piece Pie Chart Maker
Post by: SierraKen on October 29, 2019, 08:57:12 pm

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]

'One Piece Pie Chart Maker by Ken G. on Oct. 29, 2019.
'Freeware
_TITLE "One Piece Pie Chart Maker"
again:
SCREEN _NEWIMAGE(800, 600, 32)
CLS
PAINT (1, 1), _RGB32(255, 255, 255)
COLOR _RGB32(0, 0, 0), _RGB32(255, 255, 255)
DO
    _LIMIT 1000
    LOCATE 1, 1: INPUT "Type Percentage Here (0-100):", p
    IF p > 100 THEN p = 100
    IF p < 0 THEN p = 0
    sec = p * .6
    c = 100
    CLS
    CIRCLE (400, 300), 180, _RGB32(255, 0, 0)
    seconds = 0
    DO
        seconds = seconds + .01
        s = (60 - seconds) * 6 + 180
        x = INT(SIN(s / 180 * 3.141592) * 180) + 400
        y = INT(COS(s / 180 * 3.141592) * 180) + 300
        c = c + .025
        IF seconds > sec THEN LINE (400, 300)-(x, y), _RGB32(c, 0, 255)
        IF seconds > sec THEN GOTO two:
        CIRCLE (x, y), 2, _RGB32(c, 0, 255)
        PAINT (x, y), _RGB32(c, 0, 255)
        LINE (400, 300)-(x, y), _RGB32(c, 0, 255)
    LOOP
    two:
    LOCATE 1, 1: INPUT "Save (Y/N):", sv$
    LINE (0, 0)-(800, 15), _RGB32(255, 255, 255), BF
    IF LEFT$(sv$, 1) = "y" OR LEFT$(sv$, 1) = "Y" THEN GOSUB saving:
LOOP
saving:
_LIMIT 500
'Now we call up the SUB to save the image to BMP.
SaveImage 0, "temp.bmp"
_DELAY .25
CLS
LINE (0, 0)-(800, 600), _RGB32(0, 0, 0), BF
COLOR _RGB32(255, 255, 255), _RGB32(0, 0, 0)
PRINT "                               Saving"
PRINT
PRINT "                  Your BMP file will be saved in the"
PRINT "                  same directory as this program is."
PRINT "                  It can be used with almost any"
PRINT "                  other graphics program or website."
PRINT "                  It is saved using:"
PRINT "                  width: 800  height: 600 pixels."
PRINT
PRINT "                  Type a name to save your picture"
PRINT "                  and press the Enter key. Do not"
PRINT "                  add .bmp at the end, the program"
PRINT "                  will do it automatically."
PRINT
PRINT "                  Also do not use the name temp"
PRINT "                  because the program uses that name"
PRINT "                  and it would be erased the next time"
PRINT "                  you save a picture."
PRINT "                  Example: MyPic"
PRINT "                  Q and Enter goes to main screen."
PRINT
INPUT "         ->"; nm$
IF nm$ = "Q" OR nm$ = "q" THEN GOTO again:
nm$ = nm$ + ".bmp"
'Checking to see if the file already exists on your computer.
theFileExists = _FILEEXISTS(nm$)
IF theFileExists = -1 THEN
    PRINT
    PRINT "             File Already Exists"
    PRINT "             Saving will delete your old"
    PRINT "             bmp picture."
    PRINT "             Would you like to still do it?"
    PRINT "             (Y/N)."
    PRINT "             Esc goes to start screen."
    llloop:
    _LIMIT 100
    ag2$ = INKEY$
    IF ag2$ = CHR$(27) THEN GOTO again:
    IF ag2$ = "" THEN GOTO llloop:
    IF ag2$ = "y" OR ag$ = "Y" THEN
        SHELL _HIDE "DEL " + nm$
        GOTO saving2:
    END IF
    GOTO llloop:
END IF
saving2:
SHELL _HIDE "REN " + "temp.bmp" + " " + nm$
nm$ = ""
FOR snd = 100 TO 500 STEP 100
    SOUND snd, 2
NEXT snd
CLS
GOTO again:
SUB SaveImage (image AS LONG, filename AS STRING)
    bytesperpixel& = _PIXELSIZE(image&)
    IF bytesperpixel& = 0 THEN PRINT "Text modes unsupported!": END
    IF bytesperpixel& = 1 THEN bpp& = 8 ELSE bpp& = 24
    x& = _WIDTH(image&)
    y& = _HEIGHT(image&)
    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)
    IF bytesperpixel& = 1 THEN
        FOR c& = 0 TO 255 ' read BGR color settings from JPG image + 1 byte spacer(CHR$(0))
            cv& = _PALETTECOLOR(c&, image&) ' color attribute to read.
            b$ = b$ + CHR$(_BLUE32(cv&)) + CHR$(_GREEN32(cv&)) + CHR$(_RED32(cv&)) + CHR$(0) 'spacer byte
        NEXT
    END IF
    MID$(b$, 11, 4) = MKL$(LEN(b$)) ' image pixel data offset(BMP header)
    lastsource& = _SOURCE
    _SOURCE image&
    IF ((x& * 3) MOD 4) THEN padder$ = STRING$(4 - ((x& * 3) MOD 4), 0)
    FOR py& = y& - 1 TO 0 STEP -1 ' read JPG image pixel color data
        r$ = ""
        FOR px& = 0 TO x& - 1
            c& = POINT(px&, py&) 'POINT 32 bit values are large LONG values
            IF bytesperpixel& = 1 THEN r$ = r$ + CHR$(c&) ELSE r$ = r$ + LEFT$(MKL$(c&), 3)
        NEXT px&
        d$ = d$ + r$ + padder$
    NEXT py&
    _SOURCE lastsource&
    MID$(b$, 35, 4) = MKL$(LEN(d$)) ' image size(BMP header)
    b$ = b$ + d$ ' total file data bytes to create file
    MID$(b$, 3, 4) = MKL$(LEN(b$)) ' size of data file(BMP header)
    IF LCASE$(RIGHT$(filename$, 4)) <> ".bmp" THEN ext$ = ".bmp"
    f& = FREEFILE
    OPEN filename$ + ext$ FOR OUTPUT AS #f&: CLOSE #f& ' erases an existing file
    OPEN filename$ + ext$ FOR BINARY AS #f&
    PUT #f&, , b$
    CLOSE #f&
END SUB
 

Title: Re: One Piece Pie Chart Maker
Post by: bplus on October 29, 2019, 11:49:52 pm

Ken you sure come up with interesting ideas!

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

Title: Re: One Piece Pie Chart Maker
Post by: SierraKen on October 29, 2019, 11:53:50 pm

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. :)

Title: Re: One Piece Pie Chart Maker
Post by: bplus on October 30, 2019, 12:07:02 am

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...

Title: Re: One Piece Pie Chart Maker
Post by: SierraKen on October 30, 2019, 12:30:28 am

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]

'One Piece Pie Chart Maker by Ken G. on Oct. 29, 2019.
'Freeware
_TITLE "One Piece Pie Chart Maker"
again:
SCREEN _NEWIMAGE(800, 600, 32)
CLS
PAINT (1, 1), _RGB32(255, 255, 255)
COLOR _RGB32(0, 0, 0), _RGB32(255, 255, 255)
DO
    _LIMIT 1000
    LOCATE 1, 1: INPUT "Type Percentage Here (0-100):", p
    IF p > 100 THEN p = 100
    IF p < 0 THEN p = 0
    sec = p * .6
    c = 100
    CLS
    CIRCLE (400, 300), 180, _RGB32(255, 0, 0)
    seconds = 0
    DO
        seconds = seconds + .0001
        s = (60 - seconds) * 6 + 180
        x = INT(SIN(s / 180 * 3.14) * 180) + 400
        y = INT(COS(s / 180 * 3.14) * 180) + 300
        c = c + .00025
        IF seconds > sec THEN LINE (400, 300)-(x, y), _RGB32(c, 0, 255)
        IF seconds > sec THEN GOTO two:
        LINE (400, 300)-(x, y), _RGB32(c, 0, 255)
    LOOP
    two:
    LOCATE 1, 1: INPUT "Save (Y/N):", sv$
    LINE (0, 0)-(800, 15), _RGB32(255, 255, 255), BF
    IF LEFT$(sv$, 1) = "y" OR LEFT$(sv$, 1) = "Y" THEN GOSUB saving:
LOOP
saving:
_LIMIT 1000
'Now we call up the SUB to save the image to BMP.
SaveImage 0, "temp.bmp"
_DELAY .25
CLS
LINE (0, 0)-(800, 600), _RGB32(0, 0, 0), BF
COLOR _RGB32(255, 255, 255), _RGB32(0, 0, 0)
PRINT "                               Saving"
PRINT
PRINT "                  Your BMP file will be saved in the"
PRINT "                  same directory as this program is."
PRINT "                  It can be used with almost any"
PRINT "                  other graphics program or website."
PRINT "                  It is saved using:"
PRINT "                  width: 800  height: 600 pixels."
PRINT
PRINT "                  Type a name to save your picture"
PRINT "                  and press the Enter key. Do not"
PRINT "                  add .bmp at the end, the program"
PRINT "                  will do it automatically."
PRINT
PRINT "                  Also do not use the name temp"
PRINT "                  because the program uses that name"
PRINT "                  and it would be erased the next time"
PRINT "                  you save a picture."
PRINT "                  Example: MyPic"
PRINT "                  Q and Enter goes to main screen."
PRINT
INPUT "         ->"; nm$
IF nm$ = "Q" OR nm$ = "q" THEN GOTO again:
nm$ = nm$ + ".bmp"
'Checking to see if the file already exists on your computer.
theFileExists = _FILEEXISTS(nm$)
IF theFileExists = -1 THEN
    PRINT
    PRINT "             File Already Exists"
    PRINT "             Saving will delete your old"
    PRINT "             bmp picture."
    PRINT "             Would you like to still do it?"
    PRINT "             (Y/N)."
    PRINT "             Esc goes to start screen."
    llloop:
    _LIMIT 100
    ag2$ = INKEY$
    IF ag2$ = CHR$(27) THEN GOTO again:
    IF ag2$ = "" THEN GOTO llloop:
    IF ag2$ = "y" OR ag$ = "Y" THEN
        SHELL _HIDE "DEL " + nm$
        GOTO saving2:
    END IF
    GOTO llloop:
END IF
saving2:
SHELL _HIDE "REN " + "temp.bmp" + " " + nm$
nm$ = ""
FOR snd = 100 TO 500 STEP 100
    SOUND snd, 2
NEXT snd
CLS
GOTO again:
SUB SaveImage (image AS LONG, filename AS STRING)
    bytesperpixel& = _PIXELSIZE(image&)
    IF bytesperpixel& = 0 THEN PRINT "Text modes unsupported!": END
    IF bytesperpixel& = 1 THEN bpp& = 8 ELSE bpp& = 24
    x& = _WIDTH(image&)
    y& = _HEIGHT(image&)
    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)
    IF bytesperpixel& = 1 THEN
        FOR c& = 0 TO 255 ' read BGR color settings from JPG image + 1 byte spacer(CHR$(0))
            cv& = _PALETTECOLOR(c&, image&) ' color attribute to read.
            b$ = b$ + CHR$(_BLUE32(cv&)) + CHR$(_GREEN32(cv&)) + CHR$(_RED32(cv&)) + CHR$(0) 'spacer byte
        NEXT
    END IF
    MID$(b$, 11, 4) = MKL$(LEN(b$)) ' image pixel data offset(BMP header)
    lastsource& = _SOURCE
    _SOURCE image&
    IF ((x& * 3) MOD 4) THEN padder$ = STRING$(4 - ((x& * 3) MOD 4), 0)
    FOR py& = y& - 1 TO 0 STEP -1 ' read JPG image pixel color data
        r$ = ""
        FOR px& = 0 TO x& - 1
            c& = POINT(px&, py&) 'POINT 32 bit values are large LONG values
            IF bytesperpixel& = 1 THEN r$ = r$ + CHR$(c&) ELSE r$ = r$ + LEFT$(MKL$(c&), 3)
        NEXT px&
        d$ = d$ + r$ + padder$
    NEXT py&
    _SOURCE lastsource&
    MID$(b$, 35, 4) = MKL$(LEN(d$)) ' image size(BMP header)
    b$ = b$ + d$ ' total file data bytes to create file
    MID$(b$, 3, 4) = MKL$(LEN(b$)) ' size of data file(BMP header)
    IF LCASE$(RIGHT$(filename$, 4)) <> ".bmp" THEN ext$ = ".bmp"
    f& = FREEFILE
    OPEN filename$ + ext$ FOR OUTPUT AS #f&: CLOSE #f& ' erases an existing file
    OPEN filename$ + ext$ FOR BINARY AS #f&
    PUT #f&, , b$
    CLOSE #f&
END SUB
 

Title: Re: One Piece Pie Chart Maker
Post by: SierraKen on October 30, 2019, 12:40:16 am

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).

Title: Re: One Piece Pie Chart Maker
Post by: bplus on October 30, 2019, 12:44:55 am

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

Code: QB64: [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
FOR a = 0 TO 2 * pi STEP 1 / radius
    x1 = cx + radius * COS(a): y1 = cy + radius * SIN(a)
    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
 
 
 

Title: Re: One Piece Pie Chart Maker
Post by: codeguy on October 30, 2019, 03:46:08 am

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

Title: Re: One Piece Pie Chart Maker
Post by: Petr on October 30, 2019, 04:12:04 am

BPlus based:

Code: QB64: [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
INPUT "Insert percentage:"; per
 
FOR a = -_PI / 2 TO -_PI / 2 + _PI(2) / 100 * per STEP 1 / radius 
    x1 = cx + radius * COS(a): y1 = cy + radius * SIN(a)
    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)
    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
 

Title: Re: One Piece Pie Chart Maker
Post by: Ashish on October 30, 2019, 11:12:55 am

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

Code: QB64: [Select]

_TITLE "Rainbow Circle" 'B+ 2019-10-30 trans from JB
'Dance MOD By Ashish
CONST xmax = 700, ymax = 700, pi = _PI, cx = xmax / 2, cy = ymax / 2, radius = 325
SCREEN _NEWIMAGE(xmax, ymax, 32)
 
TYPE balls
    x AS SINGLE
    y AS SINGLE
    rotSpeed AS SINGLE
    rad AS SINGLE
    rot AS SINGLE
END TYPE
 
DIM SHARED ball(300) AS balls, glAllow
 
FOR i = 0 TO UBOUND(ball)
    ball(i).x = RND * 2 - 1
    ball(i).y = RND * 2 - 1
    ball(i).rad = RND * 0.25 + 0.0625
    ball(i).rotSpeed = RND * 0.1 + 0.01
NEXT
'_SCREENMOVE 400, 20
'INPUT "Insert percentage:"; per
 
'FOR a = -_PI / 2 TO -_PI / 2 + _PI(2) / 100 * per STEP 1 / radius
'    x1 = cx + radius * COS(a): y1 = cy + radius * SIN(a)
'    thic cx, cy, x1, y1, 2, rainbow~&(a / (2 * pi))
'NEXT
'SLEEP
glAllow = 1
DO
    _LIMIT 30
LOOP
 
SUB _GL ()
    IF NOT glAllow = 1 THEN EXIT SUB
    STATIC glInit
    IF glInit = 0 THEN
        _glViewport 0, 0, _WIDTH, _HEIGHT
        glInit = -1
 
    END IF
    _glMatrixMode _GL_MODELVIEW
 
 
 
    FOR i = 0 TO UBOUND(ball)
        _glPushMatrix
        _glTranslatef ball(i).x, ball(i).y, 0
        _glBegin _GL_TRIANGLE_FAN
        FOR j = 0 TO _PI(2) STEP 0.05
            rainbow j / _PI(2) + ball(i).rot
            _glVertex2f COS(j) * ball(i).rad, SIN(j) * ball(i).rad
        NEXT
        _glEnd
        ball(i).rot = ball(i).rot + ball(i).rotSpeed
        _glPopMatrix
    NEXT
 
    _glFlush
END SUB
 
SUB rainbow (fraction)
    'FUNCTION rainbow~& (fraction)
    'MODED for OpenGL use
    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
 
    _glColor3f r / 255, g / 255, b / 255 'map values between 0 & 1
    ' rainbow~& = _RGB32(r, g, b)
    'END FUNCTION
END SUB
 
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)
    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
 
 
 
 
 

Title: Re: One Piece Pie Chart Maker
Post by: bplus on October 30, 2019, 11:55:25 am

Ah Codeguy,

Code: QB64: [Select]

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! :)

Title: Re: One Piece Pie Chart Maker
Post by: SierraKen on October 30, 2019, 02:03:10 pm

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]

    two:
 
    'Hole Filler
    FOR xx = 0 TO 800
        FOR yy = 20 TO 600
            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
                cl& = POINT(xx + 1, yy)
                PSET (xx, yy), cl&
            END IF
        NEXT yy
    NEXT xx
 
    LOCATE 1, 1: INPUT "Save (Y/N):", sv$
    LINE (0, 0)-(800, 15), _RGB32(255, 255, 255), BF
    IF LEFT$(sv$, 1) = "y" OR LEFT$(sv$, 1) = "Y" THEN GOSUB saving:
 
LOOP
 

Code: QB64: [Select]

'One Piece Pie Chart Maker by Ken G. on Oct. 29, 2019.
'Freeware
_TITLE "One Piece Pie Chart Maker"
again:
SCREEN _NEWIMAGE(800, 600, 32)
CLS
PAINT (1, 1), _RGB32(255, 255, 255)
COLOR _RGB32(0, 0, 0), _RGB32(255, 255, 255)
DO
    _LIMIT 1000
    LOCATE 1, 1: INPUT "Type Percentage Here (0-100):", p
    IF p > 100 THEN p = 100
    IF p < 0 THEN p = 0
    sec = p * .6
    c = 100
    CLS
    CIRCLE (400, 300), 180, _RGB32(255, 0, 0)
    seconds = 0
    DO
        seconds = seconds + .0001
        s = (60 - seconds) * 6 + 180
        x = INT(SIN(s / 180 * 3.14) * 180) + 400
        y = INT(COS(s / 180 * 3.14) * 180) + 300
        c = c + .00025
        IF seconds > sec THEN LINE (400, 300)-(x, y), _RGB32(c, 0, 255)
        IF seconds > sec THEN GOTO two:
        LINE (400, 300)-(x, y), _RGB32(c, 0, 255)
    LOOP
    two:
 
    'Hole Filler
    FOR xx = 0 TO 800
        FOR yy = 20 TO 600
            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
                cl& = POINT(xx + 1, yy)
                PSET (xx, yy), cl&
            END IF
        NEXT yy
    NEXT xx
 
    LOCATE 1, 1: INPUT "Save (Y/N):", sv$
    LINE (0, 0)-(800, 15), _RGB32(255, 255, 255), BF
    IF LEFT$(sv$, 1) = "y" OR LEFT$(sv$, 1) = "Y" THEN GOSUB saving:
 
LOOP
saving:
_LIMIT 1000
'Now we call up the SUB to save the image to BMP.
SaveImage 0, "temp.bmp"
_DELAY .25
CLS
LINE (0, 0)-(800, 600), _RGB32(0, 0, 0), BF
COLOR _RGB32(255, 255, 255), _RGB32(0, 0, 0)
PRINT "                               Saving"
PRINT
PRINT "                  Your BMP file will be saved in the"
PRINT "                  same directory as this program is."
PRINT "                  It can be used with almost any"
PRINT "                  other graphics program or website."
PRINT "                  It is saved using:"
PRINT "                  width: 800  height: 600 pixels."
PRINT
PRINT "                  Type a name to save your picture"
PRINT "                  and press the Enter key. Do not"
PRINT "                  add .bmp at the end, the program"
PRINT "                  will do it automatically."
PRINT
PRINT "                  Also do not use the name temp"
PRINT "                  because the program uses that name"
PRINT "                  and it would be erased the next time"
PRINT "                  you save a picture."
PRINT "                  Example: MyPic"
PRINT "                  Q and Enter goes to main screen."
PRINT
INPUT "         ->"; nm$
IF nm$ = "Q" OR nm$ = "q" THEN GOTO again:
nm$ = nm$ + ".bmp"
'Checking to see if the file already exists on your computer.
theFileExists = _FILEEXISTS(nm$)
IF theFileExists = -1 THEN
    PRINT
    PRINT "             File Already Exists"
    PRINT "             Saving will delete your old"
    PRINT "             bmp picture."
    PRINT "             Would you like to still do it?"
    PRINT "             (Y/N)."
    PRINT "             Esc goes to start screen."
    llloop:
    _LIMIT 100
    ag2$ = INKEY$
    IF ag2$ = CHR$(27) THEN GOTO again:
    IF ag2$ = "" THEN GOTO llloop:
    IF ag2$ = "y" OR ag$ = "Y" THEN
        SHELL _HIDE "DEL " + nm$
        GOTO saving2:
    END IF
    GOTO llloop:
END IF
saving2:
SHELL _HIDE "REN " + "temp.bmp" + " " + nm$
nm$ = ""
FOR snd = 100 TO 500 STEP 100
    SOUND snd, 2
NEXT snd
CLS
GOTO again:
SUB SaveImage (image AS LONG, filename AS STRING)
    bytesperpixel& = _PIXELSIZE(image&)
    IF bytesperpixel& = 0 THEN PRINT "Text modes unsupported!": END
    IF bytesperpixel& = 1 THEN bpp& = 8 ELSE bpp& = 24
    x& = _WIDTH(image&)
    y& = _HEIGHT(image&)
    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)
    IF bytesperpixel& = 1 THEN
        FOR c& = 0 TO 255 ' read BGR color settings from JPG image + 1 byte spacer(CHR$(0))
            cv& = _PALETTECOLOR(c&, image&) ' color attribute to read.
            b$ = b$ + CHR$(_BLUE32(cv&)) + CHR$(_GREEN32(cv&)) + CHR$(_RED32(cv&)) + CHR$(0) 'spacer byte
        NEXT
    END IF
    MID$(b$, 11, 4) = MKL$(LEN(b$)) ' image pixel data offset(BMP header)
    lastsource& = _SOURCE
    _SOURCE image&
    IF ((x& * 3) MOD 4) THEN padder$ = STRING$(4 - ((x& * 3) MOD 4), 0)
    FOR py& = y& - 1 TO 0 STEP -1 ' read JPG image pixel color data
        r$ = ""
        FOR px& = 0 TO x& - 1
            c& = POINT(px&, py&) 'POINT 32 bit values are large LONG values
            IF bytesperpixel& = 1 THEN r$ = r$ + CHR$(c&) ELSE r$ = r$ + LEFT$(MKL$(c&), 3)
        NEXT px&
        d$ = d$ + r$ + padder$
    NEXT py&
    _SOURCE lastsource&
    MID$(b$, 35, 4) = MKL$(LEN(d$)) ' image size(BMP header)
    b$ = b$ + d$ ' total file data bytes to create file
    MID$(b$, 3, 4) = MKL$(LEN(b$)) ' size of data file(BMP header)
    IF LCASE$(RIGHT$(filename$, 4)) <> ".bmp" THEN ext$ = ".bmp"
    f& = FREEFILE
    OPEN filename$ + ext$ FOR OUTPUT AS #f&: CLOSE #f& ' erases an existing file
    OPEN filename$ + ext$ FOR BINARY AS #f&
    PUT #f&, , b$
    CLOSE #f&
END SUB
 

Title: Re: One Piece Pie Chart Maker
Post by: SierraKen on October 30, 2019, 03:20:43 pm

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]

'One Piece Pie Chart Maker by Ken G. on Oct. 30, 2019.
'Freeware
_TITLE "One Piece Pie Chart Maker"
again:
SCREEN _NEWIMAGE(800, 600, 32)
CLS
PAINT (1, 1), _RGB32(255, 255, 255)
COLOR _RGB32(0, 0, 0), _RGB32(255, 255, 255)
DO
    _LIMIT 1000
    LOCATE 1, 1: INPUT "Type Percentage Here (0-100):", p
    IF p > 100 THEN p = 100
    IF p < 0 THEN p = 0
    sec = p * .6
    c = 100
    CLS
    CIRCLE (400, 300), 180, _RGB32(255, 0, 0)
    seconds = 0
    DO
        seconds = seconds + .0001
        s = (60 - seconds) * 6 + 180
        x = INT(SIN(s / 180 * 3.14) * 180) + 400
        y = INT(COS(s / 180 * 3.14) * 180) + 300
        c = c + .00025
        IF seconds > sec THEN LINE (400, 300)-(x, y), _RGB32(c, 0, 255)
        IF seconds > sec THEN GOTO two:
        LINE (400, 300)-(x, y), _RGB32(c, 0, 255)
    LOOP
LOOP
two:
'Hole Filler
FOR xx = 0 TO 800
    FOR yy = 20 TO 600
        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
            cl& = POINT(xx + 1, yy)
            PSET (xx, yy), cl&
        END IF
    NEXT yy
NEXT xx
_TITLE "(T)ext, (S)ave, (D)elete, Esc to Quit"
DO
    a$ = INKEY$
    IF a$ = CHR$(27) THEN END
    IF a$ = "t" OR a$ = "T" THEN GOSUB Text:
    IF a$ = "s" OR a$ = "S" THEN GOTO saving:
    IF a$ = "d" OR a$ = "D" THEN GOTO again:
LOOP
Text:
_TITLE "TEXT MODE - Use Mouse To Click Where You Want To Place Text Then Press Enter."
DO
    _LIMIT 500
    DO WHILE _MOUSEINPUT
        mouseX = _MOUSEX
        mouseY = _MOUSEY
        mouseLeftButton = _MOUSEBUTTON(1)
    LOOP
    IF mouseLeftButton = -1 THEN
        clr& = POINT(mouseX, mouseY)
        IF clr& <> _RGB32(255, 255, 255) THEN COLOR _RGB32(255, 255, 255), clr&
        IF clr& = _RGB32(255, 255, 255) THEN COLOR _RGB32(0, 100, 0), clr&
        LOCATE mouseY / 16, mouseX / 8
        INPUT "", txt$
        _TITLE "(T)ext, (S)ave, (D)elete, Esc to Quit"
        RETURN
    END IF
LOOP
saving:
_LIMIT 1000
'Now we call up the SUB to save the image to BMP.
SaveImage 0, "temp.bmp"
_DELAY .25
CLS
LINE (0, 0)-(800, 600), _RGB32(0, 0, 0), BF
COLOR _RGB32(255, 255, 255), _RGB32(0, 0, 0)
PRINT "                               Saving"
PRINT
PRINT "                  Your BMP file will be saved in the"
PRINT "                  same directory as this program is."
PRINT "                  It can be used with almost any"
PRINT "                  other graphics program or website."
PRINT "                  It is saved using:"
PRINT "                  width: 800  height: 600 pixels."
PRINT
PRINT "                  Type a name to save your picture"
PRINT "                  and press the Enter key. Do not"
PRINT "                  add .bmp at the end, the program"
PRINT "                  will do it automatically."
PRINT
PRINT "                  Also do not use the name temp"
PRINT "                  because the program uses that name"
PRINT "                  and it would be erased the next time"
PRINT "                  you save a picture."
PRINT "                  Example: MyPic"
PRINT "                  Q and Enter goes to main screen."
PRINT
INPUT "                  ->"; nm$
IF nm$ = "Q" OR nm$ = "q" THEN GOTO again:
nm$ = nm$ + ".bmp"
'Checking to see if the file already exists on your computer.
theFileExists = _FILEEXISTS(nm$)
IF theFileExists = -1 THEN
    PRINT
    PRINT "             File Already Exists"
    PRINT "             Saving will delete your old"
    PRINT "             bmp picture."
    PRINT "             Would you like to still do it?"
    PRINT "             (Y/N)."
    PRINT "             Esc goes to start screen."
    llloop:
    _LIMIT 100
    ag2$ = INKEY$
    IF ag2$ = CHR$(27) THEN GOTO again:
    IF ag2$ = "" THEN GOTO llloop:
    IF ag2$ = "y" OR ag$ = "Y" THEN
        SHELL _HIDE "DEL " + nm$
        GOTO saving2:
    END IF
    GOTO llloop:
END IF
saving2:
SHELL _HIDE "REN " + "temp.bmp" + " " + nm$
nm$ = ""
FOR snd = 100 TO 500 STEP 100
    SOUND snd, 2
NEXT snd
CLS
GOTO again:
SUB SaveImage (image AS LONG, filename AS STRING)
    bytesperpixel& = _PIXELSIZE(image&)
    IF bytesperpixel& = 0 THEN PRINT "Text modes unsupported!": END
    IF bytesperpixel& = 1 THEN bpp& = 8 ELSE bpp& = 24
    x& = _WIDTH(image&)
    y& = _HEIGHT(image&)
    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)
    IF bytesperpixel& = 1 THEN
        FOR c& = 0 TO 255 ' read BGR color settings from JPG image + 1 byte spacer(CHR$(0))
            cv& = _PALETTECOLOR(c&, image&) ' color attribute to read.
            b$ = b$ + CHR$(_BLUE32(cv&)) + CHR$(_GREEN32(cv&)) + CHR$(_RED32(cv&)) + CHR$(0) 'spacer byte
        NEXT
    END IF
    MID$(b$, 11, 4) = MKL$(LEN(b$)) ' image pixel data offset(BMP header)
    lastsource& = _SOURCE
    _SOURCE image&
    IF ((x& * 3) MOD 4) THEN padder$ = STRING$(4 - ((x& * 3) MOD 4), 0)
    FOR py& = y& - 1 TO 0 STEP -1 ' read JPG image pixel color data
        r$ = ""
        FOR px& = 0 TO x& - 1
            c& = POINT(px&, py&) 'POINT 32 bit values are large LONG values
            IF bytesperpixel& = 1 THEN r$ = r$ + CHR$(c&) ELSE r$ = r$ + LEFT$(MKL$(c&), 3)
        NEXT px&
        d$ = d$ + r$ + padder$
    NEXT py&
    _SOURCE lastsource&
    MID$(b$, 35, 4) = MKL$(LEN(d$)) ' image size(BMP header)
    b$ = b$ + d$ ' total file data bytes to create file
    MID$(b$, 3, 4) = MKL$(LEN(b$)) ' size of data file(BMP header)
    IF LCASE$(RIGHT$(filename$, 4)) <> ".bmp" THEN ext$ = ".bmp"
    f& = FREEFILE
    OPEN filename$ + ext$ FOR OUTPUT AS #f&: CLOSE #f& ' erases an existing file
    OPEN filename$ + ext$ FOR BINARY AS #f&
    PUT #f&, , b$
    CLOSE #f&
END SUB
 
 

Title: Re: One Piece Pie Chart Maker
Post by: _vince on October 31, 2019, 01:20:11 pm

Not my code but check this out!

Code: QB64: [Select]

WIDTH 80, 25
DIM slices(0 TO 4)
 
slices(0) = .33
slices(1) = .33
slices(2) = .2
slices(3) = .09
slices(4) = .05
 
 
FOR X = 11 TO 70
    TX = (X - 40.5) / 30
    FOR Y = 1 TO 25
        TY = ((Y - 13) * 2 - .5) / 25
        GOSUB getc
        BG = C
 
        TY = ((Y - 13) * 2 + .5) / 25
        GOSUB getc
        FG = C
        COLOR FG, BG
        LOCATE Y, X: PRINT CHR$(220);
NEXT Y, X
 
END
 
getc:
'Adapted from London's code
turns = ATN(TY / TX) / ATN(1) / 8 - (TX < 0) / 2 - (TX > 0 AND TY < 0)
IF SQR(TY * TY + TX * TX) > 1 THEN C = 0: RETURN
Acc = 0
C = 0
FOR I = 0 TO UBOUND(slices)
    Acc = Acc + slices(I)
    IF Acc + .001 > turns THEN C = I + 1: EXIT FOR
NEXT
 
RETURN
 

Title: Re: One Piece Pie Chart Maker
Post by: TempodiBasic on October 31, 2019, 01:52:24 pm

Hi _Vince
fine ASCII pie slice!

[ This attachment cannot be displayed inline in 'Print Page' view ]

Hey Pete where are you in these ASCII moments?

Title: Re: One Piece Pie Chart Maker
Post by: SierraKen on October 31, 2019, 02:35:05 pm

LOL pretty cool Vince and TempodiBasic, but all morning I have been working on Pie Chart Maker 2, which has many pieces (slices). I will start a new thread for it.

Title: Re: One Piece Pie Chart Maker
Post by: TempodiBasic on October 31, 2019, 02:53:31 pm

Thanks to
_vince to share and to you to start with interesting ideas!

Text Only | Text with Attachments

QB64.org Forum

Active Forums => Programs => Topic started by: SierraKen on October 29, 2019, 08:57:12 pm