Liberty BASIC Community Forum
« [RC] (suggested tasks) Colour circle »

Welcome Guest. Please Login or Register.
Sep 19th, 2017, 9:12pm


Rules|Home|Help|Search|Recent Posts|Notification


« Previous Topic | Next Topic »
Pages: 1  Notify Send Topic Print
 thread  Author  Topic: [RC] (suggested tasks) Colour circle  (Read 15 times)
tenochtitlanuk
Moderator
ImageImageImageImageImage


member is offline

Avatar




Homepage PM

Gender: Male
Posts: 1162
xx [RC] (suggested tasks) Colour circle
« Thread started on: Feb 20th, 2017, 12:27pm »

Basically the task is to programmatically produce images like these.. which I can now easily do. BUT.. the following is a resume of several hours chasing silly solutions..
User Image

My first attempt was to plot a family of radial lines, cycling the RGB colour values up and down over 120 degree sectors. This leaves visible gaps, and increasing the line width leads to visible distortion at the centre.
User Image

I could have used piefilled of course, or drawn outline sectors and filled them, but I wanted to vary the fill radially, either up to white or down to black.

I managed to do this by modifying my Bresenham algorithm to fade the RGB components up/down depending on radius. But I still had the central region visible distorted.

The I realised- I should be scanning through the x,y space of my image, rather than through the r,theta space of the desired structure. Job done!

Code will go on my site.
User IP Logged

tsh73
Moderator
ImageImageImageImageImage


member is offline

Avatar

Anatoly (real name)


PM

Gender: Male
Posts: 1681
xx Re: [RC] (suggested tasks) Colour circle
« Reply #1 on: Feb 21st, 2017, 03:19am »

John, I could not locate that task.
May be it got renamed and now named
Color wheel?

EDIT
the problem with task is it's vagueness.
"Write a function to draw a HSV color wheel" - what is agreed image that "HSV color wheel" should look like?
« Last Edit: Feb 21st, 2017, 03:36am by tsh73 » User IP Logged

damned Dog in the Manger
tenochtitlanuk
Moderator
ImageImageImageImageImage


member is offline

Avatar




Homepage PM

Gender: Male
Posts: 1162
xx Re: [RC] (suggested tasks) Colour circle
« Reply #2 on: Feb 21st, 2017, 04:31am »

Yeah, totally agree on the vagueness. Just reading the wikipedia stuff on colour spaces does my head in. They are basically three-dimensionable anyway.

It's only a 'suggested task' at present.
Quote:
Color wheel is a draft programming task. It is not yet considered ready to be promoted as a complete task, for reasons that should be found in its talk page.


I haven't uploaded most of my recent Rosetta Code 'solutions' to RC because I find it more interesting to follow the basic idea to wherever it takes me... I posted my programming journey here because it was a classic of heading off in the wrong direction, and only after various wrong turns approaching it the sensible way.

For me, the satisfaction here was to achieve interesting graphics, rather than restricting myself to a poorly defined task!

User Image

Following is the kind of code I've been using in all sorts of variations. The display of the colour number under the mouse is not used in this one.. code is only here, unpolished, to encourage others to play.
Code:
    '   **    colourWheelRethink2.bas   ***

    '   **    raster scan resulting image and calculate angle and radius to find appropriate colour RGB components

    nomainwin

    global hdc, col$, pi
    pi           =4 *atn( 1)
    ptSize       =1

    WindowWidth  =600
    WindowHeight =600

    graphicbox #w.gb, 10, 10, 540, 540

    open "Colour wheel" for window as #w

    h       =hwnd( #w.gb)
    calldll #user32, "GetDC", h as ulong, hdc as ulong

    #w "trapclose quit"

    #w.gb "down ; fill white ; size "; ptSize; " ; font Ubuntu_Mono 12 ; flush"
    #w.gb "when leftButtonDown [getPixel]"

    radius  =250

    for x =0 to 500 step ptSize
        for y =0 to 500 step ptSize
            angle   =atan2( y -250, x -250) *360 / 2 /pi        '   Angle in degrees round full circle....
            sector  =int( angle /60)                            '       ...split into six 60 degree sectors, labelled 0 to 5
            slope   =( angle mod 60) /60 *255                   '       ...and each split into 1 degree sectors.
            scan

            select case sector
                case 0
                    col$    ="255 ";                    str$( int( slope));      "   0"
                case 1
                    col$    =str$( int( 256 -slope)); " 255                          0"
                case 2
                    col$    ="0                         255 ";                     str$( int( slope))
                case 3
                    col$    ="0 ";                      str$( int( 256 -slope)); " 255"
                case 4
                    col$    =str$( int( slope));    "     0                        255"
                case 5
                    col$    ="255                         0 ";                     str$( int( 256 -slope))
            end select

            red     =val( word$( col$, 1)): grn =val( word$( col$, 2)): blu =val( word$( col$, 3))

            R       =( ( x -270)^2 +( y -270)^2)^0.5 /250

            redR    =R *int( red): grnR =R *int( grn): bluR =R *int( blu)     '   fade to rim black

            #w.gb "color "; str$( redR) +" " +str$( grnR) +" " +str$( bluR)
            if R >1 then  #w.gb "color white"
            #w.gb "set "; x; " "; y
        next y
    next x

    #w.gb "flush ; getbmp scr 0 0 540 540"
    bmpsave "scr", "colWheelToRimWhiteNoFade.bmp"

    wait

  [getPixel]
    xx      =MouseX
    yy      =MouseY
    calldll #gdi32, "GetPixel", hdc as ulong, xx as long, yy as long, pixcol as ulong
    #w.gb "up ; goto 20 20 ; down ; color black"
    #w.gb "\ " +right$( "          " +str$( pixcol), 10) +" "
    wait

    sub quit h$
        close #h$
        calldll #user32, "ReleaseDC", hw as ulong, hdc as ulong   'release the DC
        end
    end sub

function atan2( y, x)
    result$     ="Undetermined"
    If ( x =0) and ( y >0) then atan2 = pi /2:      result$ ="Determined"
    if ( x =0) and ( y <0) then atan2 =3 * pi /2:   result$ ="Determined"
    if ( x >0) and ( y =0) then atan2 =0:           result$ ="Determined"
    if ( x <0) and ( y =0) then atan2 =pi:          result$ ="Determined"

    If result$ <>"Determined" then
        if x =0 and y =0 then
            atan2 =0
        else
            baseAngle =atn( abs( y) /abs( x))
            If ( x >0) and ( y >0) then atan2 =       baseAngle
            If ( x <0) and ( y >0) then atan2 = pi   -baseAngle
            If ( x <0) and ( y <0) then atan2 = pi   +baseAngle
            If ( x >0) and ( y <0) then atan2 = 2*pi -baseAngle
        end if
    end if
end function

 

User IP Logged

tsh73
Moderator
ImageImageImageImageImage


member is offline

Avatar

Anatoly (real name)


PM

Gender: Male
Posts: 1681
xx Re: [RC] (suggested tasks) Colour circle
« Reply #3 on: May 17th, 2017, 4:07pm »

Found old code of mine
it might produce not-so-perfect color circle, but it has working HSV 2 RGB code.
Code:
'HSV 2 RGB
'ref from Wikipedia
'http://en.wikipedia.org/wiki/HSL_and_HSV
'by tsh73, June 2008

    nomainwin
    UpperLeftX = 20
    UpperLeftY = 20

    open "color wheel" for graphics_nsb as #main
    'open "color wheel" for graphics_nsb_fs as #main
    #main, "trapclose [quit]"
    #main,  "home ; down ; posxy xc yc"
    'xc, yc give us width, height (c - Center)
    width = 2*xc : height = 2*yc
    #main, "down; fill white"

    print width, height
    'circle len is 2*Pi*Radius
    Radius = min(xc,yc)
    Radius = Radius *0.95   'step inside a bit
    Pi = 355/113
    circLen = 2 * Pi * Radius 'in pixels
    print  Radius, circLen
    aSize = int(circLen/360)+3
    #main, "size "; aSize
    s = 1
    v = 1   'these two should be set for [HSV_2_RGB] to work!!!

    k = 1
        k=aSize/Radius
    'do while k*Radius >1
    'for k = 1 to 0 step 0-aSize/Radius
    hh=aSize/Radius
    for k = hh to 1 step hh 'outward
    'for k =1 to hh step 0-hh   'inward
    'do while k*Radius <1
        'v = k   'value goes from 1 to 0. Color goes black
        'v = 1- k
        's = k   'value goes from 1 to 0. Color goes white (?)
        s = 1-k 'color washes to white
        aStep = (aSize - 3)/ (k*circLen) * 360
        for h = 0 to 359 step  aStep
            scan    'allow CTRL-BREAK
            gosub [HSV_2_RGB]
            #main, "color ";  RGB$
            x = xc + k*Radius*cos(h*Pi/180)
            y = yc + k*Radius*sin(h*Pi/180)
            #main, "set ";x;" ";y
        next
    'k = k - aSize/Radius
    'k = k + aSize/Radius
    'loop
    next

    'Grab a whole bitmap, discard, put it back and flush.
    'This prevents artefacts on redraw
    #main, "getbmp wholeBMP "; 1; " "; 1; " "; width; " "; height
    #main, "discard"
    #main, "drawbmp wholeBMP 1 1"
    unloadbmp "wholeBMP"

    #main, "flush"
    #main, "when mouseMove [getPixel2]"
    #main, "when leftButtonDown [getPixel]"
    #main, "color black"
    #main, "font Courier 10"

    wait

[getPixel]
    if (MouseX-xc)^2 + (MouseY-yc)^2 <= Radius^2 then
        #main, "place ";width-100;" 0"
        #main, "\"
        #main, "\";GetPixelValue$(MouseX, MouseY, "#main")
    end if

[getPixel2]
'    print MouseX, MouseY,cx,cy,  (MouseX-cx)^2 + (MouseY-cy)^2,  Radius^2
    if (MouseX-xc)^2 + (MouseY-yc)^2 <= Radius^2 then
'        print GetPixelValue$(MouseX, MouseY, "#main")
        #main, "place 0 0"
        #main, "\"
        #main, "\";GetPixelValue$(MouseX, MouseY, "#main")
    else
        #main, "place 0 0"
        #main, "\"
        #main, "\           "   'clear thing
    end if

    wait

[quit]
    close #main
    end

[HSV_2_RGB]
    'Input: (h,s,v)
    'h in the range [0, 360), indicating the angle, in degrees of the hue
    's and v varying between 0 and 1, representing the saturation and value, respectively
    'Output: r,g,b  [0,1]
    'and to be useful, R G B [0 255]
    'or to JB RGB$ as "R G B" string.

    hi = int(h/60) mod 6
    f = h/60 -  int(h/60)
    p = v*(1-s)
    q= v*(1-f*s)
    t = v*(1-(1-f)*s)
'    print hi,
    select case hi
    case 0
        r = v: g = t: b = p
    case 1
        r = q: g = v: b = p
    case 2
        r = p: g = v: b = t
    case 3
        r = p: g = q: b = v
    case 4
        r = t: g = p: b = v
    case 5
        r = v: g = p: b = q
    end select
    R = int(r*255)
    G = int(g*255)
    B = int(b*255)
    RGB$= R;" ";G;" ";B
return

'------------------------------------------------
'Uncomment to run in JustBASIC
'function min(x,y)
'    min = x
'    if y<x then min = y
'end function

'*****************************************************
'GetPixelValue$ returns a string with the RGB values of the pixel
'in coordinates x and y in window/graphicbox names handle$ (e.g, "#main.graph")
function GetPixelValue$(x, y, handle$)

'Grab a 1*1 bitmap
    #handle$, "getbmp gpv "; x; " "; y; " "; 1; " "; 1

'Save in a bmp file
    bmpsave "gpv", "getpvaluetemp.bmp"

'Open the file for string input and get it's full contents
    open "getpvaluetemp.bmp" for input as #gpv
    s$ = input$(#gpv, lof(#gpv))
    close #gpv

'Check if user's display is 32-bit, and read the red-green-blue values
'If display 16 bit, then colors are masked. So some last (3 for red, 2 for green, 3 for blue) bits always 0
'That means that you did not get 255 255 255 for white - (248 252 248) instead. You have to experiment
'otherwise function returns nothing (support for other display types could be added (?))
    bpp =  asc(mid$(s$, 29, 1))
    select case bpp
    case 32
        red = asc(mid$(s$, 69, 1))
        green = asc(mid$(s$, 68, 1))
        blue = asc(mid$(s$, 67, 1))
    case 16
        bytes = asc(mid$( s$, 67, 1)) + 256*asc(mid$( s$, 68, 1))
        red =  (bytes AND 63488) /256       '0xF800
        green =  (bytes AND 2016) / 32 * 4  '0x7E0
        blue =  (bytes AND 31) * 8          '0x1F
    end select

'concatenate the return value, delete temporary file and free memory
    GetPixelValue$ = using("###",red)+using("####",green)+using("####",blue)
    kill "getpvaluetemp.bmp"
    unloadbmp "gpv"
end function

 
« Last Edit: May 18th, 2017, 05:35am by tsh73 » User IP Logged

damned Dog in the Manger
tenochtitlanuk
Moderator
ImageImageImageImageImage


member is offline

Avatar




Homepage PM

Gender: Male
Posts: 1162
xx Re: [RC] (suggested tasks) Colour circle
« Reply #4 on: May 18th, 2017, 04:50am »

Just a reminder that 'min()' is now an inbuilt function in LB. A reminder of how long we've been enjoying LB- since 14 I think in my case.
User IP Logged

tsh73
Moderator
ImageImageImageImageImage


member is offline

Avatar

Anatoly (real name)


PM

Gender: Male
Posts: 1681
xx Re: [RC] (suggested tasks) Colour circle
« Reply #5 on: May 18th, 2017, 05:37am »

OOPS
of cource it was done in Just BASIC.
Commented definition of MIN() out
so now it runs in LB without problems.

Thanks, John.
User IP Logged

damned Dog in the Manger
Pages: 1  Notify Send Topic Print
« Previous Topic | Next Topic »

Rules|Home|Help|Search|Recent Posts|Notification

Donate $6.99 for 50,000 Ad-Free Pageviews!

| |

This forum powered for FREE by Conforums ©
Sign up for your own Free Message Board today!
Terms of Service | Privacy Policy | Conforums Support | Parental Controls