On Thu, 05 Aug 2004 01:29:24 +0900 (JST), Masahiro Sakai  
<sakai / tom.sfc.keio.ac.jp> wrote:
>> なんか色々とやっちゃダメなことをやっているらしいです。
>> Filter の基礎的なやり方について教えてもらったので、それを元に書き換えて
>> みます。
>
> 結局のところ、どんなエラーが出ていて、
> 「やっちゃダメなこと」ってのは何だったんでしょうか?

その後も意見を交わしていました。

エラーメッセージはでなくて、

1.まずは範囲外をつついていること、
http://blade.nagaokaut.ac.jp/cgi-bin/scat.rb/haskell/haskell-jp/425

2.オリジナルの bitmap を削除したらデータが invalid になる

3.image を書き換えたら pixelBuffer も変わるのでオリジナルの pixelBuffer
を消してはいけない

4.onPaint が呼ばれるたびに更新してたら計算量が馬鹿にならない。

5.無限ループ……間違い
> pixelColorInt (Point ptx pty) (Size szx szy)
>  | ptx < 0   = pixelColorInt (Point 0 pty)  (Size szx szy)
>  | pty < 0   = pixelColorInt (Point ptx 0)  (Size szx szy)
>  | ptx > szx = pixelColorInt (Point ptx pty)  (Size 0 szy)
>  | pty < szy = pixelColorInt (Point ptx pty)  (Size 0 szy)
>  | otherwise = do pixel <- pixelBufferGetPixel pb

などが「やっちゃダメなこと」にあたります。

で、改善してもらったがこれですが、きちんと動いていないじゃないかと思わせら
れるくらいに遅いです。

Buffer の操作をもっと早くするためのものを CVS にコミットしてくれると言って
いましたがまだコミットされていません。


     openImage sw vbitmap mclose status fname
       = do -- load the new bitmap
            bm <- bitmapLoad fname
            closeImage vbitmap
            varSet vbitmap (Just bm)
            set mclose [enabled := True]
            set status [text := fname]
            -- reset the scrollbars
            bmsize <- bitmapGetSize bm
            set sw [virtualSize := bmsize]
            repaint sw

     onPaint vbitmap dc viewArea
       = do mbBitmap <- varGet vbitmap
            case mbBitmap of
              Nothing -> dcClear dc
              Just bm -> drawBitmap dc bm pointZero True []



     bitmapLoad :: FilePath -> IO (Bitmap ())
     bitmapLoad fpath
       = do wxcBeginBusyCursor
            im1 <- imageCreateFromFile fpath
            px1 <- imageGetPixels im1
            im2 <- imageCreateFromPixels (lowpassFilter px1)
            bm2 <- bitmapCreateFromImage im2 (-1)
            wxcEndBusyCursor
            -- delete for performance reasons.
            imageDelete im2
            imageDelete im1
            return bm2


-- Low pass filter.
type Pixels = Array Point Color

lowpassFilter :: Pixels -> Pixels
lowpassFilter pixels
   = listArray (bounds pixels) [lowpass p | p <- indices pixels]
   where
     lowpass :: Point -> Color
     lowpass (Point px py)
       = average [pixels!p | dx <- [-1..1]
                           , dy <- [-1..1]
                           , let p = Point (px+dx) (py+dy)
                           , valid p
                           ]

     average :: [Color] -> Color
     average colors
       = let r = avg colorRed
             g = avg colorGreen
             b = avg colorBlue
         in colorRGB r g b
       where
         avg f = sum (map f colors) `div` len
         len   = length colors

     valid :: Point -> Bool
     valid p
       = let (low,hi) = bounds pixels
             bound    = rectBetween low hi
         in rectContains bound p


-- Pixel helpers
imageGetPixels :: Image a -> IO Pixels
imageGetPixels image
   = do pb <- imageGetPixelBuffer image
        h  <- imageGetHeight image
        w  <- imageGetWidth image
        let bounds = (pointZero, point (w-1) (h-1))
        ps <- mapM (pixelBufferGetPixel pb) (range bounds)
        return (listArray bounds ps)


imageCreateFromPixels :: Pixels -> IO (Image ())
imageCreateFromPixels pixels
   = do let (Point x y) = snd (bounds pixels)
        pb    <- pixelBufferCreate (sz (x+1) (y+1))
        mapM_ (\(p,c) -> pixelBufferSetPixel pb p c) (assocs pixels)
        image <- imageCreateFromPixelBuffer pb
        return image

imageSetPixels :: Image a -> Pixels -> IO ()
imageSetPixels image pixels
   = do pb <- imageGetPixelBuffer image
        mapM_ (\(pt,c) -> pixelBufferSetPixel pb pt c) (assocs pixels)


----------------------------------
-- This should be in the library
imageGetSize :: Image a -> IO Size
imageGetSize image
   = do h  <- imageGetHeight image
        w  <- imageGetWidth image
        return (Size w h)


instance Ord Point where
   compare (Point x1 y1) (Point x2 y2)
     = case compare y1 y2 of
         EQ  -> compare x1 x2
         neq -> neq


instance Ix Point where
   range (Point x1 y1,Point x2 y2)
     = [Point x y | y <- [y1..y2], x <- [x1..x2]]

   inRange (Point x1 y1, Point x2 y2) (Point x y)
     = (x >= x1 && x <= x2 && y >= y1 && y <= y2)

   rangeSize (Point x1 y1, Point x2 y2)
     = let w = abs (x2 - x1) + 1
           h = abs (y2 - y1) + 1
       in w*h

   index bnd@(Point x1 y1, Point x2 y2) p@(Point x y)
     = if inRange bnd p
        then let w = abs (x2 - x1) + 1
             in (y-y1)*w + x
        else error "out-of-bound"

-- 
shelarcy <shelarcy / capella.freemail.ne.jp>
http://page.freett.com/shelarcy/