Fortran - Artifacts in resizing BMP image

Author

Artifacts in resizing BMP image

rrr7rrr@gmail.com

2007-04-14, 4:04 am

I've made somewhere some silly error and can't find it

In short, the code
1) finds x-y size of BMP image
2) places its pixel RGB value into 3-dimensional array A
3) displays it
4) when you chose to resize the image - code linearly maps initial A
array into secondary B array and displays it

First take some BMP picture, say, less than 1024 pixels in size
into the same directory as your fortran and exe files and call it
"init.bmp"
Lets take arbitrary image from Google search
http://206.188.202.62/ProductImages/hon/init.bmp

Then compile fortran text ("filename.for")
It is, basically, FORTRAN-77 text in free format with Salford Fortran
extensions

FTN95 filename.for /link /free

Now run it and try to resize the window with mouse.
You will notice colors become somewhat distorted...
Where is scaling error, the code is written stupidly straightforward ?

Thanks in advance

use clrwin
implicit none

character*128 file
integer*1 a(3,1024,1024)
integer*1 b(3,1024,1024)
common /sdfsdf/a,b
integer j
integer hres,vres,nb_colours,ier,i,k,window_cont
rol,red
common /bbbbbb/ hres,vres,nb_colours,ier,i,k,window_cont
rol,red

integer cb_gr
external cb_gr

file='init.bmp'
call get_dib_size@(file, hres, vres, nb_colours, ier)
! print*,' hres,vres,nb_colours=',hres,vres,nb_colo
urs
if(ier.ne.0.or.hres.gt.1024.or.vres.gt.1024)stop 'TOO LARGE pict
size'
call get_dib_block@(file,a,1024,1024,0,0,hres
,vres,0,0,ier)
if(ier.ne.0)stop 'TROUBLE'

! Display the image
i=winio@('%ww[no_border]%pv%^gr[rgb_colo
urs,user_resize]
%lw&',hres,vres, cb_gr, window_control)
i=winio@('%ac[esc]','exit')

end

!---------------------------------
integer function cb_gr ()
use clrwin
integer*1 a(3,1024,1024)
integer*1 b(3,1024,1024)
common /sdfsdf/a,b

integer hres,vres,nb_colours,ier,i,k,window_cont
rol,red
common /bbbbbb/ hres,vres,nb_colours,ier,i,k,window_cont
rol,red

call get_graphical_resolution@(ix_GrWindow,iy
_GrWindow)
if(ix_GrWindow.le.0.or.iy_GrWindow.le.0) goto 10000
if(ix_GrWindow.gt.1024.or.iy_GrWindow.gt.1024) goto 10000

factx = hres/float(ix_GrWindow)
facty = vres/float(iy_GrWindow)

do ix=1,ix_GrWindow-1
do iy=1,iy_GrWindow-1
do i=1,3
xInOld = ix*factx
ixInOld = xInOld
yInOld = iy*facty
iyInOld = yInOld

cx1=(xInOld-ixInOld)*a(i,ixInOld+1,iyInOld) +(ixInOld+1-
xInOld)*a(i,ixInOld,iyInOld)
cx2=(xInOld- ixInOld)*a(i,ixInOld+1,iyInOld+1)+(ixInO
ld+1-
xInOld)*a(i,ixInOld,iyInOld+1)
cyAv= cx1*(iyInOld+1-yInOld) + cx2*(yInOld-iyInOld)
b(i,ix,iy)=cyAv
enddo
enddo
enddo

call display_dib_block@(0,0,b,
1024,1024,0,0,ix_GrWindow,iy_GrWindow,0,
0,ier)

10000 cb_gr = 1
end

rrr7rrr@gmail.com

2007-04-14, 4:04 am

P.S. After posting, I see some long fortran lines displayed wrapped to
next line. I don't find how correct that post factum. Just will note,
that the code does not have any continuation lines

Edward N Bromhead

2007-04-14, 8:03 am

<rrr7rrr@gmail.com> wrote in message
news:1176532440.440707.315560@q75g2000hsh.googlegroups.com...
> P.S. After posting, I see some long fortran lines displayed wrapped to
> next line. I don't find how correct that post factum. Just will note,
> that the code does not have any continuation lines

Have you tried the Silverfrost Forums (www.silverfrost.com) ?

EB

Edward N Bromhead

2007-04-14, 7:04 pm

> Have you tried the Silverfrost Forums (www.silverfrost.com) ?
>
> EB

I've run your code through the Salford compiler. The algorithm you use to
sample the RGB values in
the rescaled DIB works adequately for areas of comparatively consistent
colour, but fails when you
are close to an "edge".

Edges in your picture also include the top and left edge of the BMP, as well
as the junction between
areas with different overall darkness/lightness or hue. If you look
carefully, you will see "contours" of R, then
G then B as you go from dark to light. You will see the edge problem very
clearly if you create a BMP with
areas of pure R, G and B - these go blurry when you resize. The complete
edge problem is highlighted
if you have a dark border on 'init.bmp' or whatever bitmap you choose.

The "thought police" will have a field day that you use IMPLICIT NONE in
your program unit, but
rely on implicit types in the call back function, and anyone who isn't
familiar with ClearWin won't
have a clue what you are doing! (so the Silverfrost forum is a better place
than this to get advice).

EB

Wade Ward

2007-04-14, 7:04 pm

"Edward N Bromhead" <edward.bromhead@deletethisbitbinternet.com> wrote in
message news:ivCdnZ9tpvbcN73bRVnytwA@bt.com...
>
> <rrr7rrr@gmail.com> wrote in message
> news:1176532440.440707.315560@q75g2000hsh.googlegroups.com...
>
> Have you tried the Silverfrost Forums (www.silverfrost.com) ?
I'll give those forums a try.

I cleaned up the continuation troubles from posting to usenet. There are
maybe five lines that got folded.

I copied the bitmap to the same location as the resulting executable. It
wants to be called init[1].bmp. If this is not changed to "init.bmp," then
ier equals ten when it hits this line:
if(ier.ne.0.or.hres.gt.1024.or.vres.gt.1024)stop 'TOO LARGE pictsize'
triggering the stop.

The image displays at first perfect, but when resized, looks psychedelic. I
don't have an answer for how to fix it. At least you know that others see
the same difficulty you see.
--
WW

Wade Ward

2007-04-14, 7:04 pm

"Edward N Bromhead" <edward.bromhead@deletethisbitbinternet.com> wrote in
message news:YtCdnbECAbiPgrzbRVnyjAA@bt.com...
>
>
> I've run your code through the Salford compiler. The algorithm you use to
> sample the RGB values in
> the rescaled DIB works adequately for areas of comparatively consistent
> colour, but fails when you
> are close to an "edge".
>
> Edges in your picture also include the top and left edge of the BMP, as
> well as the junction between
> areas with different overall darkness/lightness or hue. If you look
> carefully, you will see "contours" of R, then
> G then B as you go from dark to light. You will see the edge problem very
> clearly if you create a BMP with
> areas of pure R, G and B - these go blurry when you resize. The complete
> edge problem is highlighted
> if you have a dark border on 'init.bmp' or whatever bitmap you choose.
>
> The "thought police" will have a field day that you use IMPLICIT NONE in
> your program unit, but
> rely on implicit types in the call back function, and anyone who isn't
> familiar with ClearWin won't
> have a clue what you are doing! (so the Silverfrost forum is a better
> place than this to get advice).
It's my experience in c.l.f. that the "thought police" are around to correct
one's errant thoughts, for which I am grateful. There are certainly other
places on the net where this is not so (comp.lang.not.c comes to mind). I
tried to find the Silverfrost forum without success. Can you post a more
idiot-proof link?
--
WW

Gary Scott

2007-04-14, 7:04 pm

Wade Ward wrote:

> "Edward N Bromhead" <edward.bromhead@deletethisbitbinternet.com> wrote in
> message news:YtCdnbECAbiPgrzbRVnyjAA@bt.com...
>
>
> It's my experience in c.l.f. that the "thought police" are around to correct
> one's errant thoughts, for which I am grateful. There are certainly other
> places on the net where this is not so (comp.lang.not.c comes to mind). I
> tried to find the Silverfrost forum without success. Can you post a more
> idiot-proof link?
> --
> WW
>
>
http://forums.silverfrost.com/index.php

--

Gary Scott
mailto:garylscott@sbcglobal dot net

Fortran Library: http://www.fortranlib.com

Support the Original G95 Project: http://www.g95.org
-OR-
Support the GNU GFortran Project: http://gcc.gnu.org/fortran/index.html

If you want to do the impossible, don't hire an expert because he knows
it can't be done.

-- Henry Ford

Edward N Bromhead

2007-04-15, 7:05 pm

It might be worth thinking about INTEGER*1 arithmetic. Presumably, the
colour intensities
are 0..255, i.e. an UNSIGNED 1-byte value.INTEGER*1 is -128 to 127 so
overflow is
going to be pretty common ....

EB

rrr7rrr@gmail.com

2007-04-18, 8:04 am

On Apr 15, 3:18 pm, "Edward N Bromhead"
<edward.bromh...@deletethisbitbinternet.com> wrote:
> It might be worth thinking about INTEGER*1 arithmetic. Presumably, the
> colour intensities
> are 0..255, i.e. an UNSIGNED 1-byte value.INTEGER*1 is -128 to 127 so
> overflow is
> going to be pretty common ....
>
> EB

Interesting suggestion. But unfortunately integer*4 does not solves
the problem.

Trying to isolate the problem, I found interesting regularities looked
at the classical RGB gradients like in this picture
http://www.kiv.zcu.cz/~lobaz/mhs/cv...mg/gradient.bmp

Any new ideas based on logic of positioning of artifacts?

Registration on Silverfrost is not automatic and requires in each case
personal admin involvement (it's the Kingdom!)...still waiting for
their respond

meek@skyway.usask.ca

2007-04-18, 7:05 pm

In a previous article, rrr7rrr@gmail.com wrote:
>On Apr 15, 3:18 pm, "Edward N Bromhead"
><edward.bromh...@deletethisbitbinternet.com> wrote:
A .bmp does not have colour intensities it just has
pixel colours (a colour being set by 3 bytes: R,G,B)
where grey is R=G=B.
Chris[color=darkred]
>
>Interesting suggestion. But unfortunately integer*4 does not solves
>the problem.
>
>Trying to isolate the problem, I found interesting regularities looked
>at the classical RGB gradients like in this picture
>http://www.kiv.zcu.cz/~lobaz/mhs/cv...mg/gradient.bmp
>
>Any new ideas based on logic of positioning of artifacts?
>
>Registration on Silverfrost is not automatic and requires in each case
>personal admin involvement (it's the Kingdom!)...still waiting for
>their respond
>

Edward N Bromhead

2007-04-23, 7:05 pm

<rrr7rrr@gmail.com> wrote in message
news:1176893411.772506.291330@n76g2000hsh.googlegroups.com...
> On Apr 15, 3:18 pm, "Edward N Bromhead"
> <edward.bromh...@deletethisbitbinternet.com> wrote:
>
> Interesting suggestion. But unfortunately integer*4 does not solves
> the problem.
>
> Trying to isolate the problem, I found interesting regularities looked
> at the classical RGB gradients like in this picture
> http://www.kiv.zcu.cz/~lobaz/mhs/cv...mg/gradient.bmp
>
> Any new ideas based on logic of positioning of artifacts?
>
> Registration on Silverfrost is not automatic and requires in each case
> personal admin involvement (it's the Kingdom!)...still waiting for
> their respond
>
I'll think about it some. Does it help if I post the question there?

EB

Edward N Bromhead

2007-04-23, 7:05 pm

@skyway.usask.ca> wrote in message
news:18APR07.13204134@skyway.usask.ca...
> In a previous article, rrr7rrr@gmail.com wrote:
> A .bmp does not have colour intensities it just has
> pixel colours (a colour being set by 3 bytes: R,G,B)
> where grey is R=G=B.
> Chris

Chris,

It wasn't the answer. However, I'm

. It it simply a matter of
semantics, or how
is a mixture of red intensity (on scale of 0..255, where 0=none and 255=
aximum possible),
green intensity (ditto) and blue intensity (ditto), making up a pixel colour
not a colour
intensity overall?

Eddie

rrr7rrr@gmail.com

2007-04-23, 7:05 pm

On Apr 23, 10:43 am, "Edward N Bromhead"
<edward.bromh...@deletethisbitbinternet.com> wrote:
> <rrr7...@gmail.com> wrote in message
>
> news:1176893411.772506.291330@n76g2000hsh.googlegroups.com...
>
>
>
>
>
>
>
> I'll think about it some. Does it help if I post the question there?
>
> EB

Will appreciate if you please post it, I still wait for his magesty
approval

rrr7rrr@gmail.com

2007-04-25, 7:05 pm

On Apr 23, 4:50 pm, rrr7...@gmail.com wrote:
> On Apr 23, 10:43 am, "Edward N Bromhead"
>
>
>
> <edward.bromh...@deletethisbitbinternet.com> wrote:
>
>
>
>
>
>
>
>
>
>
> Will appreciate if you please post it, I still wait for his magesty
> approval

OK, it was really silly error. I thank all who looked at this example.
Scaling coefficients have to be

cx1=(xInOld- ixInOld)*a(i,ixInOld+1,iyInOld+1)+(ixInO
ld+1-
xInOld)*a(i,ixInOld+1,iyInOld+1)

cx2=(xInOld- ixInOld)*a(i,ixInOld+1,iyInOld+1)+(ixInO
ld+1-
xInOld)*a(i,ixInOld+1,iyInOld+1)

Wade Ward

2007-04-26, 4:08 am

<rrr7rrr@gmail.com> wrote in message
news:1177372212.972333.107490@d57g2000hsg.googlegroups.com...
> On Apr 23, 10:43 am, "Edward N Bromhead"
> <edward.bromh...@deletethisbitbinternet.com> wrote:
>
> Will appreciate if you please post it, I still wait for his magesty
> approval
I have a gift for the great and powerful king. Pleasing images are their
own reward.
http://www.billfordx.net/2007-04-25b.htm
Save this as 'ciko1.jpg', and in the same directory as was init.bmp. The
filename in the source is hard-coded:
program rrr3
use clrwin
implicit none
character*128 file
integer*1 a(3,1024,1024)
integer*1 b(3,1024,1024)
common /sdfsdf/a,b
integer hres,vres,nb_colours,ier,i,k,window_cont
rol,red
common /bbbbbb/ hres,vres,nb_colours,ier,i,k,window_cont
rol,red
! functions
integer cb_gr
external cb_gr
file='ciko1.jpg'
call get_dib_size@(file, hres, vres, nb_colours, ier)
!print*,' hres,vres,nb_colours=',hres,vres,nb_colo
urs
if(ier.ne.0.or.hres.gt.1024.or.vres.gt.1024)stop 'TOO LARGE pictsize'
!column numbering to seventy
!234567891123456789212345678931234567894
123456789512345678961234567897
call get_dib_block@(file,a,1024,1024,0,0,hres
,vres,0,0,ier)
if(ier.ne.0)stop 'TROUBLE'
! Display the image
i=winio@('%ww[no_border]%pv%^gr[rgb_colo
urs,user_resize]%lw&', &
&hres,vres, cb_gr, window_control)
i=winio@('%ac[esc]','exit')
end program rrr3
!---------------------------------
integer function cb_gr ()
use clrwin
integer*1 a(3,1024,1024)
integer*1 b(3,1024,1024)
common /sdfsdf/a,b
integer hres,vres,nb_colours,ier,i,k,window_cont
rol,red
common /bbbbbb/ hres,vres,nb_colours,ier,i,k,window_cont
rol,red

call get_graphical_resolution@(ix_GrWindow,iy
_GrWindow)
if(ix_GrWindow.le.0.or.iy_GrWindow.le.0) goto 10000
if(ix_GrWindow.gt.1024.or.iy_GrWindow.gt.1024) goto 10000

factx = hres/float(ix_GrWindow)
facty = vres/float(iy_GrWindow)

do ix=1,ix_GrWindow-1
do iy=1,iy_GrWindow-1
do i=1,3
xInOld = ix*factx
ixInOld = xInOld
yInOld = iy*facty
iyInOld = yInOld
cx1=(xInOld-ixInOld)*a(i,ixInOld+1,iyInOld+1)+&
&(ixInOld+1-xInOld)*a(i,ixInOld+1,iyInOld+1)
cx2=(xInOld-ixInOld)*a(i,ixInOld+1,iyInOld+1)+&
&(ixInOld+1-xInOld)*a(i,ixInOld+1,iyInOld+1)
cyAv= cx1*(iyInOld+1-yInOld) + cx2*(yInOld-iyInOld)
b(i,ix,iy)=cyAv
enddo
enddo
enddo

call display_dib_block@(0,0,b,1024,1024,&
&0,0,ix_GrWindow,iy_GrWindow,0,0,ier)

10000 cb_gr = 1

end function cb_gr
!end source
--
WW

Sponsored Links