vanishing disc

Post your FreeBASIC tips and tricks here. Please don’t post your code without including an explanation.
BasicCoder2
Posts: 3558
Joined: Jan 01, 2009 7:03
Location: Australia

vanishing disc

Postby BasicCoder2 » Jul 20, 2015 5:24

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
Posts: 726
Joined: May 05, 2015 5:35
Location: Germany

Re: vanishing disc

Postby grindstone » Jul 20, 2015 9:18

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
Posts: 8027
Joined: May 28, 2005 3:28
Contact:

Re: vanishing disc

Postby D.J.Peters » Jul 20, 2015 10:21

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
Posts: 6547
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: vanishing disc

Postby dodicat » Jul 20, 2015 13:23

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
Posts: 3558
Joined: Jan 01, 2009 7:03
Location: Australia

Re: vanishing disc

Postby BasicCoder2 » Jul 20, 2015 21:38

dodicat wrote: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.
Last edited by BasicCoder2 on Jul 20, 2015 23:14, edited 1 time in total.
BasicCoder2
Posts: 3558
Joined: Jan 01, 2009 7:03
Location: Australia

Re: vanishing disc

Postby BasicCoder2 » Jul 20, 2015 23:13

D.J.Peters wrote:I changed the main loop and it looks better here without the mouse pointer.

Much better look. Thank you.

Return to “Tips and Tricks”

Who is online

Users browsing this forum: No registered users and 7 guests