vanishing disc

[BasicCoder2]

When I was looking at a silhouette of a zebra to be outlined with an edge traversing program I noted that because it was just made up of individual stripes there was no actual outline of the zebra to be traced. It reminded me of another kind of outline where the edge traversing program would fail. It is one seen as a result of movement. In the program below when you move the mouse you will see the outline of a disc otherwise it will vanish.

Code: Select all

screenres 640,480,32
dim as integer mx,my,mb

dim as any ptr disc,background
disc = imagecreate(200,200,rgb(255,0,255))
background = imagecreate(640,480,rgb(0,0,0))

circle disc,(100,100),95,rgb(0,0,0),,,,f

dim as integer x,y
for i as integer = 0 to 500
    x = int(rnd(1)*200)
    y = int(rnd(1)*200)
    if point(x,y,disc)=rgb(0,0,0) then
        pset disc,(x,y),rgb(255,255,255)
    end if
next i

'fill  background with stars
for i as integer = 0 to 5000
    x = int(rnd(1)*640)
    y = int(rnd(1)*480)
    pset background,(x,y),rgb(255,255,255)
next i

do
    getmouse mx,my,,mb
    screenlock
    cls
    put (0,0),background
    put (mx-100,my-100),disc,trans
    screenunlock
    sleep 2
loop until multikey(&H01)

[grindstone]

Oh yes, I remember having seen something similar some years ago in a science TV show, with a background pattern of short coloured strokes and a moving shape of a human. It should demonstrate how the human sense of sight is meant for perceiveing movements.

[D.J.Peters]

I changed the main loop and it looks better here without the mouse pointer.

Joshy

Code: Select all

 ' ...
dim as integer ox,oy
put (0,0),background
setmouse ,,0 ' remove mouse pointer
windowtitle "move the mouse"
do
  ' is mouse inside ?
  if getmouse(mx,my)=0 then
    ' mouse coords are new ?
    if ox<>mx or oy<>my then
      screenlock : cls
      put (0,0),background
      put (mx-100,my-100),disc,trans
      screenunlock
      ox=mx:oy=my
    end if
  end if
  ' time sharing
  sleep 10
loop until multikey(&H01)

[dodicat]

I think when folk tinker with and adjust your code, it a reflection of your good code quality.

I would perhaps align the background star density with the disc star density, try to get them the same.
Maybe getting the ratio of the window area to the image area and using this as a looping multiple could achieve this?
So here is you snippet tinkered with once more.

I think that you should move this topic to the camouflage section.

Code: Select all

'Basiccoder2's code adjusted a little.

screenres 640,480,32
dim as integer mx,my,mb

dim as any ptr disc,background
disc = imagecreate(200,200,rgb(255,0,255))
background = imagecreate(640,480,rgb(0,0,0))

circle disc,(100,100),95,rgb(0,0,0),,,,f

var ratio= (640*480)/(200*200)

dim as integer starpitch =500 '< -- adjustable



dim as integer x,y
for i as integer = 0 to starpitch
    x = int(rnd(1)*200)
    y = int(rnd(1)*200)
    if point(x,y,disc)=rgb(0,0,0) then
        pset disc,(x,y),rgb(255,255,255)
    end if
next i

'fill  background with stars
for i as integer = 0 to starpitch*ratio
    x = int(rnd(1)*640)
    y = int(rnd(1)*480)
    pset background,(x,y),rgb(255,255,255)
next i


do
    getmouse mx,my,,mb
    screenlock
    cls
    put (0,0),background
    put (mx-100,my-100),disc,trans
    screenunlock
    sleep 2
loop until multikey(&H01)

imagedestroy disc
imagedestroy background
  

[BasicCoder2]

I think that you should move this topic to the camouflage section.

I wasn't sure where to put it as it wasn't a question and it wasn't really a coding tip or trick. Indeed I wasn't sure if I should even post it. Perhaps the Projects section would have been a closer match.

The dot density in the disc being consistent with the background dot density did cross my mind, thanks for fixing that.

[BasicCoder2]

I changed the main loop and it looks better here without the mouse pointer.

Much better look. Thank you.