Colour-coded plot of a polynomial function of x and y.

A fun and rather unusual plot!

    '   *** fish5.bas   8/02/2013 ***

nomainwin

UpperLeftX   =  10
UpperLeftY   =  10

WindowWidth  = 680
WindowHeight = 556

graphicbox #w.gb, 10, 10, 656, 502

open "Fish graph" for window as #w

#w        "trapclose [quit]"
#w.gb     "down ; fill black"

loadbmp   "scr", "repeat.bmp"
#w.gb     "drawbmp scr 250 2 ; flush"
unloadbmp "scr"

dim colour$( 255)

call getColValues

#w.gb     "size 6"

col$ ="128 128 128"

for x =-2 to 11 step 4 *13 /640
    for y =-4 to 4 step 4 *8 /480
        f   =   25   *x^6_
            +   75   *x^4   *y^2_
            +   75   *x^2   *y^4_
            +   25          *y^6_
            -  650   *x^5_
            -   50   *x^4   *y_
            -  800   *x^3   *y^2_
            -  100   *x^2   *y^3_
            -  150   *x     *y^4_
            -   50          *y^5_
            + 5621   *x^4_
            +  500   *x^3   *y_
            -  758   *x^2   *y^2_
            -  500   *x     *y^3_
            + 1621          *y^4_
            -16210   *x^3_
            +16210   *x     *y^2

        f       =abs( f)
        lf      =max( -1, 20 *log( f)) +1
        index   =min( 255, lf)
        print index
        col$    =colour$( index)

        #w.gb "color "; col$
        #w.gb "set "; 10 +( x +2) /13   *640; " "; 72 +( 6 -( y +3)) /8 *480
    next y
    scan
next x

#w.gb "flush"
wait

[quit]
close #w
end

Function KCGetPixel$( x, y)                             'x, y = window coordinates     Thanks KCDan!!
        #w.gb "Getbmp pixel ";      250 +x; " "; 2 +y; " 1 1"      'A 1x1 bitmap, contains exactly 1 pixel
        #w.gb "color black ; set "; 250 +x; " "; 2 +y
        Bmpsave "pixel", "kcGetPixelData.datkc"         'Save that one pixel as a temporary bmp file
        Open "kcGetPixelData.datkc" for Binary as #kc   'Open that one pixel bmp file as a binary file
            Seek #kc, 66                                'Blue Info
            b =Asc( Input$( #kc, 1))                    'Blue
            Seek #kc, 67                                'Green Info
            g =Asc( Input$( #kc, 1))                    'Green
            Seek #kc, 68                                'Red Info
            r =Asc( Input$( #kc, 1))    'Red
        Close #kc
        Kill "kcGetPixelData.datkc"                     'Delete the temporary bmp file
        KCGetPixel$ =r; " "; g; " "; b                  'Place the values in a string
End Function

sub getColValues
    for v =1 to 256
        colour$( v -1) =KCGetPixel$( 256 -v, 5)
     next v
end sub