Is there a fast way to use POINT

Author

Message

Barry Pythagoras

11

Years of Service

User Offline

Joined: 14th Mar 2014

Location:

Posted: 21st Mar 2014 14:20

Link

Point is a slow command. I want to take the average colours from a picture, and change them to a single coloured square 10*10. But this is slow...

+ Code Snippet

set display mode 1280,1024,32
sync off
Load image "MyPicture.jpg",1
Load Image "Cursor.jpg",2
Load image "Red.jpg",3
Load image "Blue.jpg",4
`sprite 1,x,y,2

set text opaque
donothing = 0


do
if donothing < 1
inc x
if x > 1280 then x = 0 : inc y
if y > 900 then donothing = 1

Paste image 1,0,0
Text 10,10,"AMOUNT OF RED=" + str$(RGBR(POINT(x,y)))
Paste image 2,x,y
endif
sync
if donothing = 1
WAIT KEY
endif
Loop

Back to top

Profile PM

BatVink

Moderator

22

Years of Service

User Offline

Joined: 4th Apr 2003

Location: Gods own County, UK

Posted: 22nd Mar 2014 10:49

Link

LOCK PIXELS
This command will lock the current bitmap for faster reading and writing of visual data.

The DOT and POINT commands are considerably faster when wrapped within a LOCK/UNLOCK block of code. You can also use this command in combination with GET PIXELS POINTER to write directly to the memory storing the visual data.

ten-net consulting limited

Back to top

Profile PM Email

ShellfishGames

12

Years of Service

User Offline

Joined: 6th Feb 2013

Location:

Posted: 22nd Mar 2014 11:11

Link

Note however that lock/unlock pixels will a) only increase the speed when used on many dot/point operations and not just on single ones, and b) you can't use sync (and probably several other commands as well) while the pixels are locked, as far as I remember.
Hence just putting lock/unlock pixels into the code you posted will probably not speed it up at all. You'd have to first restructure it in a way to make sure a bunch of many pixels are read in one "pixel lock block". If that makes any sense.

However, I think it would be even faster to use memblocks.

Rem Project: Dark Basic Pro Project
Rem Created: Saturday, March 22, 2014

Rem ***** Main Source File *****

color = process(yourImage)
createPreviewImage(previewImage, color, 10)

...

end

function process(img)
    mem = 1
    make memblock from image mem, img
    size = get memblock size(mem)
    pixels = (size-12)/4 `first 12 bytes are header information, each pixel takes 4 bytes (usually)
    dec size `make sure for loop does not go beyond the last pixel ('size' bytes -> byte 0...size-1 exist in memblock)
    rsum = 0
    gsum = 0
    bsum = 0
    for p = 12 to size step 4
        color = memblock dword(mem,p)
        inc rsum, rgbr(color)
        inc gsum, rgbg(color)
        inc bsum, rgbb(color)
    next
    delete memblock mem
    result = rgb(rsum/pixels, gsum/pixels, bsum/pixels)
endfunction result

function createPreviewImage(img, color, sz)
    mem = 1
    size = 12 + 4*sz*sz
    make memblock mem, size
    write memblock dword mem, 0, sz
    write memblock dword mem, 4, sz
    write memblock dword mem, 8, 32
    dec size
    for p = 12 to size step 4
        write memblock dword mem, p, color
    next
    make image from memblock img, mem
    delete memblock mem
endfunction

+ Code Snippet

Rem Project: Dark Basic Pro Project
Rem Created: Saturday, March 22, 2014

Rem ***** Main Source File *****

color = process(yourImage)
createPreviewImage(previewImage, color, 10)

...

end



function process(img)
    mem = 1
    make memblock from image mem, img
    size = get memblock size(mem)
    pixels = (size-12)/4 `first 12 bytes are header information, each pixel takes 4 bytes (usually)
    dec size `make sure for loop does not go beyond the last pixel ('size' bytes -> byte 0...size-1 exist in memblock)
    rsum = 0
    gsum = 0
    bsum = 0
    for p = 12 to size step 4
        color = memblock dword(mem,p)
        inc rsum, rgbr(color)
        inc gsum, rgbg(color)
        inc bsum, rgbb(color)
    next
    delete memblock mem
    result = rgb(rsum/pixels, gsum/pixels, bsum/pixels)
endfunction result

function createPreviewImage(img, color, sz)
    mem = 1
    size = 12 + 4*sz*sz
    make memblock mem, size
    write memblock dword mem, 0, sz
    write memblock dword mem, 4, sz
    write memblock dword mem, 8, 32
    dec size
    for p = 12 to size step 4
        write memblock dword mem, p, color
    next
    make image from memblock img, mem
    delete memblock mem
endfunction

Haven't tested the code, but I think it should do the job.

Back to top

Profile PM Email Website

BatVink

Moderator

22

Years of Service

User Offline

Joined: 4th Apr 2003

Location: Gods own County, UK

Posted: 22nd Mar 2014 12:46

Link

Shellfishgames is right, I hadn't noticed you were syncing between every update. I don't think updating one point per cycle is going to be a huge hit in comparison to the screen update time.

You can also speed up the memblock example because you are working directly with the screen. GET PIXELS POINTER gets you the location of the back buffer, so you don't need to copy out and back in to a memblock.

ten-net consulting limited

Back to top

Profile PM Email

Barry Pythagoras

11

Years of Service

User Offline

Joined: 14th Mar 2014

Location:

Posted: 22nd Mar 2014 16:55

Link

Ok thanks! It did speed up for some reason after I installed the free AppGameKit program. Not sure why.

Back to top

Profile PM

Barry Pythagoras

11

Years of Service

User Offline

Joined: 14th Mar 2014

Location:

Posted: 22nd Mar 2014 16:59

Link

This is my current code. I will try to add a memblock to it.

set display mode 1280,1024,32

set text opaque
sync off
Load image "MyPicture.jpg",1
Load Image "Cursor.jpg",2
Load image "Red.jpg",3
Load image "Blue.jpg",4
Load image "Green.jpg",5
Load image "Green2.jpg",6
`sprite 1,x,y,2
create bitmap 1,1280,1024,32

Paste image 1,0,0
set current bitmap 0

donothing = 0

do
if donothing < 1
RED = 0
BLUE = 0
GREEN = 0
Paste image 1,0,0
R = RGBR(POINT(x,y))
G = RGBG(POINT(x,y))
B = RGBB(POINT(x,y))
if R = 255 and G = 255 and B = 255
x = x + 10
if x > 1280 then x = 0 : y = y + 10
Else
for Y1 = 1 to 10
For X1 = 1 to 10
R = RGBR(POINT(x1+x,y1+y))
B = RGBB(POINT(x1+x,y1+y))
If R = 0 and B = 0 and x < 20 then Donothing = 1
If R > B and R > G
inc Red
endif
If B > R and B > G
inc Blue
endif
If G > R and G > B
Inc Green
Endif

Next X1
Next Y1
set current bitmap 1
If red > blue and Red > Green
paste image 3,x,y
Endif
If blue > Red and Blue > Green
paste image 4,x,y
Endif
If Green > Red and Green > Blue
If G > 234
paste image 5,x,y
else
paste image 6,x,y
Endif
Endif

endif
set current bitmap 0
x = x + 10
if x > 1280 then x = 0 : y = y + 10
if y > 900 then donothing = 1

Text 10,10,"AMOUNT OF RED " + str$(RGBR(POINT(x,y)))
Text 10,20,"AMOUNT OF GREEN " + str$(RGBG(POINT(x,y)))
Text 10,30,"AMOUNT OF BLUE " + str$(RGBB(POINT(x,y)))
Paste image 2,x,y
endif

sync
if donothing = 1
set current bitmap 1
save current bitmap "CMB Recolour.bmp":end
WAIT KEY
endif

Loop

+ Code Snippet

set display mode 1280,1024,32

set text opaque
sync off
Load image "MyPicture.jpg",1
Load Image "Cursor.jpg",2
Load image "Red.jpg",3
Load image "Blue.jpg",4
Load image "Green.jpg",5
Load image "Green2.jpg",6
`sprite 1,x,y,2
create bitmap 1,1280,1024,32

Paste image 1,0,0
set current bitmap 0

donothing = 0


do
if donothing < 1
RED = 0
BLUE = 0
GREEN = 0
Paste image 1,0,0
R = RGBR(POINT(x,y))
G = RGBG(POINT(x,y))
B = RGBB(POINT(x,y))
if R = 255 and G = 255 and B = 255
x = x + 10
if x > 1280 then x = 0 : y = y + 10
Else
for Y1 = 1 to 10
For X1 = 1 to 10
R = RGBR(POINT(x1+x,y1+y))
B = RGBB(POINT(x1+x,y1+y))
If R = 0 and B = 0 and x < 20 then Donothing = 1
If R > B and R > G
inc Red
endif
If B > R and B > G
inc Blue
endif
If G > R and G > B
Inc Green
Endif

Next X1
Next Y1
set current bitmap 1
If red > blue and Red > Green
paste image 3,x,y
Endif
If blue > Red and Blue > Green
paste image 4,x,y
Endif
If Green > Red and Green > Blue
If G > 234
paste image 5,x,y
else
paste image 6,x,y
Endif
Endif

endif
set current bitmap 0
x = x + 10
if x > 1280 then x = 0 : y = y + 10
if y > 900 then donothing = 1


Text 10,10,"AMOUNT OF RED " + str$(RGBR(POINT(x,y)))
Text 10,20,"AMOUNT OF GREEN " + str$(RGBG(POINT(x,y)))
Text 10,30,"AMOUNT OF BLUE " + str$(RGBB(POINT(x,y)))
Paste image 2,x,y
endif

sync
if donothing = 1
set current bitmap 1
save current bitmap "CMB Recolour.bmp":end
WAIT KEY
endif

Loop

Back to top

Profile PM

Barry Pythagoras

11

Years of Service

User Offline

Joined: 14th Mar 2014

Location:

Posted: 22nd Mar 2014 17:11

Link

I didn't need to use a memblock in the end, because this code only takes 1 minute. It still syncs too without the sync. So there must be extra syncs in there hidden away.

set display mode 1280,1024,32

set text opaque
sync off
Load image "MyPicture.jpg",1
Load Image "Cursor.jpg",2
Load image "Red.jpg",3
Load image "Blue.jpg",4
Load image "Green.jpg",5
Load image "Green2.jpg",6
`sprite 1,x,y,2
create bitmap 1,1280,1024,32

Paste image 1,0,0
set current bitmap 0

donothing = 0

do
if donothing < 1

RED = 0
BLUE = 0
GREEN = 0
Paste image 1,0,0
lock pixels

R = RGBR(POINT(x,y))
G = RGBG(POINT(x,y))
B = RGBB(POINT(x,y))
if R = 255 and G = 255 and B = 255
x = x + 10
if x > 1280 then x = 0 : y = y + 10
Else
for Y1 = 1 to 10
For X1 = 1 to 10
R = RGBR(POINT(x1+x,y1+y))
B = RGBB(POINT(x1+x,y1+y))
If R = 0 and B = 0 and x < 20 then Donothing = 1
If R > B and R > G
inc Red
endif
If B > R and B > G
inc Blue
endif
If G > R and G > B
Inc Green
Endif

Next X1
Next Y1
unlock pixels
set current bitmap 1
If red > blue and Red > Green
paste image 3,x,y
Endif
If blue > Red and Blue > Green
paste image 4,x,y
Endif
If Green > Red and Green > Blue
If G > 234
paste image 5,x,y
else
paste image 6,x,y
Endif
Endif

endif
set current bitmap 0
x = x + 10
if x > 1280 then x = 0 : y = y + 10
if y > 900 then donothing = 1

Text 10,10,"AMOUNT OF RED " + str$(RGBR(POINT(x,y)))
Text 10,20,"AMOUNT OF GREEN " + str$(RGBG(POINT(x,y)))
Text 10,30,"AMOUNT OF BLUE " + str$(RGBB(POINT(x,y)))
Paste image 2,x,y
endif

if donothing = 1
set current bitmap 1
save current bitmap "CMB Recolour.bmp":end
WAIT KEY
endif

Loop

+ Code Snippet

set display mode 1280,1024,32

set text opaque
sync off
Load image "MyPicture.jpg",1
Load Image "Cursor.jpg",2
Load image "Red.jpg",3
Load image "Blue.jpg",4
Load image "Green.jpg",5
Load image "Green2.jpg",6
`sprite 1,x,y,2
create bitmap 1,1280,1024,32

Paste image 1,0,0
set current bitmap 0

donothing = 0


do
if donothing < 1

RED = 0
BLUE = 0
GREEN = 0
Paste image 1,0,0
lock pixels


R = RGBR(POINT(x,y))
G = RGBG(POINT(x,y))
B = RGBB(POINT(x,y))
if R = 255 and G = 255 and B = 255
x = x + 10
if x > 1280 then x = 0 : y = y + 10
Else
for Y1 = 1 to 10
For X1 = 1 to 10
R = RGBR(POINT(x1+x,y1+y))
B = RGBB(POINT(x1+x,y1+y))
If R = 0 and B = 0 and x < 20 then Donothing = 1
If R > B and R > G
inc Red
endif
If B > R and B > G
inc Blue
endif
If G > R and G > B
Inc Green
Endif

Next X1
Next Y1
unlock pixels
set current bitmap 1
If red > blue and Red > Green
paste image 3,x,y
Endif
If blue > Red and Blue > Green
paste image 4,x,y
Endif
If Green > Red and Green > Blue
If G > 234
paste image 5,x,y
else
paste image 6,x,y
Endif
Endif

endif
set current bitmap 0
x = x + 10
if x > 1280 then x = 0 : y = y + 10
if y > 900 then donothing = 1


Text 10,10,"AMOUNT OF RED " + str$(RGBR(POINT(x,y)))
Text 10,20,"AMOUNT OF GREEN " + str$(RGBG(POINT(x,y)))
Text 10,30,"AMOUNT OF BLUE " + str$(RGBB(POINT(x,y)))
Paste image 2,x,y
endif


if donothing = 1
set current bitmap 1
save current bitmap "CMB Recolour.bmp":end
WAIT KEY
endif

Loop

Back to top

Profile PM

Barry Pythagoras

11

Years of Service

User Offline

Joined: 14th Mar 2014

Location:

Posted: 22nd Mar 2014 17:17

Link

Oh yes, sync off should have been sync on. I always get them mixed up.

Back to top

Profile PM

Kevin Picone

22

Years of Service

User Offline

Joined: 27th Aug 2002

Location: Australia

Posted: 23rd Mar 2014 04:55 Edited at: 23rd Mar 2014 04:56

Link

seems you're fetching from video memory twice in the loop, where you could just grab it once.

a bit like this,

+ Code Snippet

for Y1 = 1 to 10

	; compute the offset before entering the loop
	 Ypos=y1+y
	 
	For X1 = 1 to 10

;		R = RGBR(POINT(x1+x,y1+y))
;		B = RGBB(POINT(x1+x,y1+y))

		; read the pixel once, this is half the fetching cost from the video memory  
		B = POINT(X1+x,Ypos)
		
		; grab R from the B
		R = RGBR(B)

		; MASK ARG- off B to get B on it's own
		B = B and 255	;RGBB(ThisPixel)		
		
		; 
		If R = 0 and B = 0 and x < 20 then Donothing = 1

		If R > B and R > G
			inc Red
		endif
		If B > R and B > G
				inc Blue
		endif
		If G > R and G > B
			Inc Green
		Endif

Next X1
Next Y1

Could prolly tweak the compares also..

Convert PlayBASIC To Machine Code

Back to top

Profile PM Website

Barry Pythagoras

11

Years of Service

User Offline

Joined: 14th Mar 2014

Location:

Posted: 23rd Mar 2014 09:45

Link

OK Thanks! I'll try that.

Back to top

Profile PM

Barry Pythagoras

11

Years of Service

User Offline

Joined: 14th Mar 2014

Location:

Posted: 23rd Mar 2014 12:15

Link

Well the program worked quite well in the end. I used it to clean up the NASA CMB. I wanted to see how well the Earth fits into it. I think it's possible that the Earth is part of the CMB somehow...