A disturbing moving image!

On first seeing an animated image like this on the internet I thought it would be quick to code. I envisaged writing a routine to draw a single star-shaped fan, then writing a second copy over it but displaced, using EXOR plotting. Turns out to be not so easy. 'drawbmp' does not follow rules other than writing 'over' and doesn't handle transparency either.

My next try was to use a Bresenham subroutine rather than LB's 'line'. This allowed me to XOR ( or otherwise process) the different cases along the line, point by point, but the overlapping lines of each fan blade still messed up the result again.

Finally I decided to draw a single fan on one graphic window and copy it to a target graphic window. I then did a pixel by pixel routine- check the source and target pixel values and colour the pixel I then write to the target appropriately.

All that remained was to repeat with several advncing 'phase' contributions.

I save each bmp and then use ImageMagick to stitch the animation. I could do this programmatically from LB but it's so fast from the mouse/screen anyway. Also reverse the phase to get contra-rotation.

Having seen the recent animations on JB using saving as sprites, I will probbably do a version that works this way.

Messy code- if I tidy it a bit I'll update with the new version. Should add a 'mkdir' to create, if non-existent, the 'S' directory.

Code- ( PS -assumes you have created a sub directory 'S' in the directory you save the LB code in.)

    nomainwin

    WindowWidth  = 520
    WindowHeight = 544

    open "Source" for graphics_nsb as #wg

    WindowWidth  =1020
    WindowHeight =1040

    open "Target" for graphics_nsb as #wg2

    #wg "trapclose quit"

    global hDC, hDC2

[again]
    #wg  "down ; fill white ; color black"
    #wg2 "down ; fill white"
    #wg  "size 2"
    #wg2 "size 2"
    #wg2 "font 18 bold"

    handleS  =hwnd( #wg)
    calldll  #user32, "GetDC", handleS as ulong, hDC  as ulong

    handleT  =hwnd( #wg2)
    calldll  #user32, "GetDC", handleT as ulong, hDC2 as ulong

    r       =250
    sep2    =100

    global pi, col$
    pi      =3.14159265
    col$    ="black"

for p =0 to 6

    #wg2 "cls"
    for th =0 to 200 step 0.25
        if ( th mod 4) =0 then
            if col$ ="white" then col$ ="black" else col$ ="white"
        end if
        angle =th /200 *360
        #wg "color "; col$
        ph  =p *pi /3
        #wg "line "; 252; " "; 252; " "; int( 252 +r *cos( ( angle +ph) *pi /180)); " "; int( 252 -r *sin( ( angle +ph) *pi /180))
        scan
    next th

    #wg "getbmp scr 0 0 510 512"
    #wg2 "down ; drawbmp scr 200 300"

    for ys =0 to 500
        for xs =0 to 500
            source$ =getPixelS$( xs,      ys)           '   window  500x 500
            target$ =getPixelT$( xs +300, ys +300)      '   window 1000x1000
            if source$ ="255 255 255" and target$ ="255 255 255" then #wg2 "color white" 'else #wg2 "color darkblue"
            if source$ ="255 255 255" and target$ ="000 000 000" then #wg2 "color black"
            if source$ ="000 000 000" and target$ ="255 255 255" then #wg2 "color black"
            if source$ ="000 000 000" and target$ ="000 000 000" then #wg2 "color white"
            #wg2 "set "; xs +sep +300; " "; ys +300
        next xs
    next ys

    #wg2 "up ; goto 20 20 ; down ; color red"
    #wg2 "\"; rule$
    #wg2 "flush ; getbmp scr 0 0 1000 1000"
    bmpsave "scr", "S/result3" +str$( p) +".bmp"

next p

    wait

    end

    sub quit h$
        callDll #user32, "ReleaseDC", handleT as ulong, hDC2 as ulong, result as ushort
        close #wg2
        callDll #user32, "ReleaseDC", handleS as ulong, hDC  as ulong, result as ushort
        close #wg
        end
    end sub

function getPixelS$( xx, yy)
    calldll #gdi32, "GetPixel", hDC  as ulong, xx as long, yy as long, pixcol as ulong
    bl  =int(  pixcol /( 256 *256))
    gr  =int( (pixcol -bl *256 *256) /256)
    re  =int(  pixcol -bl *256 *256 -gr *256)
    getPixelS$   =right$( "000" + str$( re), 3) +" " +right$( "000" +str$( gr), 3) +" " +right$( "000" +str$( bl), 3)
end function

function getPixelT$( xx, yy)
    calldll #gdi32, "GetPixel", hDC2 as ulong, xx as long, yy as long, pixcol as ulong
    bl  =int(  pixcol /( 256 *256))
    gr  =int( (pixcol -bl *256 *256) /256)
    re  =int(  pixcol -bl *256 *256 -gr *256)
    if bl >255 or gr >255 or re >255 then wait
    getPixelT$   =right$( "000" + str$( re), 3) +" " +right$( "000" +str$( gr), 3) +" " +right$( "000" +str$( bl), 3)
end function