Magic Eye Single Random Dot Stereograms.

Basically your brain is fooled into fusing left and right images but with a left-right separation, and as a result thinks they are at a distance whicj=h is either too close or too far. You will need practice seeing the result- you have to look 'past' the screen rather than focus at it.

    '   sirds14.bas

    'John Fisher, tenochtitlanuk     john.fisher@tauntonschool.co.uk

    'SIRDS= Stereo Image made of Random Dots. See eg magiceye.com

    '___________________________________________________________________

    'This is a reprise of versions in other languages.
    'Since LB is a compiled/interpreted language the results are slower
    '   to appear than I'd wish- on my old machine anyway....

    'NB Run in a 24bit colour mode- Truecolor+
    'I hadn't realised the device-free nature of the Windows output.

    'LB writing to the SCREEN is not seen by 'GetPixel'....
    'Similarly SetPixel is not 'flushed' to stay on screen...
    'I spent AGES with pixels appearing on screen yet not visible toGetPixel.

    'I spent much time decoding the internal structure of the bmp file &
    '   writing versions that read pixels direct. I eventually returned
    '   to the current method.

    'It would (please, Carl) be much clearer if there was a pixel-read LB
    '   native command. I still do not understand why points that LB 'sets'
    '   are not visible to GetPixel yet show on the LB window concerned!

    'Program is given a 600 by 200 24bit colour image as source.
    '   Its  name by default should be 'source*.bmp'.
    'This is used as a contour map, where white =backgroundlevel.

    'It also is given a vertical strip 100 by 200 as left-hand seed image.
    '   Its name by default is 'tile*.bmp'.
    '   This should have a random or fine structure.

    'I do no checking of the image sizes- tho. could easily add now I know
    '   the structure of 24bit bitmap header.

    'The source is scanned pixep by pixel & the desired offsets are calculated.
    'The resulting dot is plotted at the offset position.
    'Since this might leave holes in the result bitmap, random source-tile pixels
    '   are used to fill in gaps.

    '_____________________________________________________________________________

    nomainwin

    WindowWidth     = 610
    WindowHeight    = 460
    UpperLeftX      =  50
    UpperLeftY      =  50

    graphicbox #w.1,      2,   2, 600, 200
    graphicbox #w.2,      2, 202, 600, 200
    textbox    #w.t,      2, 404, 400,  30

    button     #w.b8, "Quit", [out_of_here], LR, 20, 2

    filedialog "Open source file", "Source*.bmp", fs$
    loadbmp    "Input", fs$
                        '600 by 200 bitmap, 24bit color

    filedialog "Open seed file", "Tile*.bmp", seed$
    loadbmp    "tile",  seed$
                        '100 by 200 random seed pattern- ideally left/right symmetrical

    open "Random dot stereograms,   Sirds14,        Johnf  Jan 2003" for window_nf as #w

    #w.1 "down ; drawbmp Input 0 0 ; flush"
    #w.2 "down ; backcolor black ; boxfilled 600 200 ; drawbmp tile  0 0 ; flush"

    h1 =hwnd( #w.1)
    h2 =hwnd( #w.2)

    #w.b8   "!font times_roman 10"
    #w      "trapclose [out_of_here]"

    yelo  =hexdec( "&H00FFE0")' colours are lsbyte =r; msbyte =blue
    '   Set up at present for a black/yellow seed tile & therefore result.
    black =hexdec( "&H000000")
    white =hexdec( "&HFFFFFF")

    calldll #user32, "GetDC",     h1 as word, hdc1 as word
    calldll #user32, "GetDC",     h2 as word, hdc2 as word

    for y =0 to 199
      for x =100 to 599
        lh =x -100
        calldll #gdi32,  "GetPixel",  hdc1 as ulong,  x as ulong, y as ulong, pixelcolorsource as ulong
        pixhex$   =dechex$( pixelcolorsource)
        red       = hexdec( mid$( pixhex$, 1, 2))
        green     = hexdec( mid$( pixhex$, 3, 2))
        blue      = hexdec( mid$( pixhex$, 5, 2))
        greyscale =int( 256 -int( ( red +green +blue) /3))
        '   white =backlayer; black =largest 'lift' & therefore offset
        if pixelcolorsource =white then x2 =x else x2 =x -int( 1+greyscale /32)
        #w.t " Source = "; dechex$( greyscale)
        calldll #gdi32,  "GetPixel",  hdc2 as ulong, lh as ulong, y as ulong, pixelcolortarget as ulong
        calldll #gdi32,  "GetPixel",  hdc2 as ulong,  x as ulong, y as ulong, pixelcolorahead  as ulong

        if ( ( pixelcolortarget <>black) and ( pixelcolorahead =black)) then
           calldll #gdi32,  "SetPixel",  hdc2 as ulong, x2 as ulong, y as ulong, pixelcolortarget as ulong, ret as ulong
        else
           calldll #gdi32,  "SetPixel",  hdc2 as ulong, x2 as ulong, y as ulong, black as ulong, ret as ulong
        end if

        if x <>x2 then
           xr =int( 100 *rnd( 1)): yr =int( 200 *rnd( 1))
           calldll #gdi32,  "GetPixel",  hdc2 as ulong, xr as ulong, yr as ulong, oldcol as ulong
           calldll #gdi32,  "SetPixel",  hdc2 as ulong, x as ulong, y as ulong, oldcol as ulong, ret as ulong
        end if
        scan
      next x
    next y

    #w.1 "flush"
    #w.2 "flush"
    #w.2, "getbmp eyeout 1 1 600 200"
    filedialog "Save As...", "saved magic eye.bas", eye$
    if eye$ ="saved magic eye" then
        bmpsave "eyeout", "saved magic eye " +str$( int( 9999 *rnd( 1))) +".bmp"
    else
        bmpsave "eyeout", eye$ +".bmp"
    end if
    wait

    function greyscale( pixel)' find mean rev'd greyscale level. Yeah we spell grey this way in UK....
    blue  =int(   pixel /256 /256)
    green =int( ( pixel -256 *blue) /256)
    red   =int(   pixel -256 *256 *blue -256 *green)
    greyscale =256 -( red +green +blue) /3
    end function

    [out_of_here]
    calldll #user32, "ReleaseDC", h2 as word, hdc2 as word, result as ushort
    calldll #user32, "ReleaseDC", h1 as word, hdc1 as word, result as ushort
    close #w
    unloadbmp "Input"
    unloadbmp "tile"

    end