Seam carving

Übersicht BlitzMax, BlitzMax NG Codearchiv & Module

Neue Antwort erstellen

Firstdeathmaker

Betreff: Seam carving

 BeitragDo, Jun 19, 2008 18:10
Antworten mit Zitat
Benutzer-Profile anzeigen
Hi, und schon wieder mal was von mir. Diesmal zum Thema seam carving:
www.seamcarving.com

Meine funktion macht genau das, ist dabei nur leider nicht so schnell wie in dem Video. Man kann damit aber wunderbar herumspielen. Code starten, image wählen dass man verkleinert haben möchte und zuschauen wie das Programm arbeitet....

(tipp: nicht im debugmodus starten, dadurch wird es um einiges langsamer)



Code: [AUSKLAPPEN]
Rem
Seam-carving implementation
by Christian Geißler
for the blitzbasic community
19.6.2008
End Rem
SuperStrict


Graphics 800 , 600 , 0
SetBlend alphablend





Local image:TImage = LoadImage(RequestFile$( "Select picture","Image Files:png,jpg,bmp;All Files:*"))
If image = Null End

Local width:Int = 50   'how many x - pixels do you want to remove?
Local height:int = 50   'how many y - pixels do you want to remove?


 


Local pic:TPixmap = SeamCarving(LockImage(image) , ImageWidth(image)-width  , ImageHeight(image)-height ,5, 4)'<Pixmap>, newwidth, newheight, resolution (1=best), showdemoflags: 1=show difference, 2=show flow, 4=show removing

Local savepath:String = RequestFile$( "Save picture" , "png file:png; jpg file:jpg",True)
If Lower(ExtractExt(savepath))="png"
   SavePixmapPNG(pic , savepath )
Else
   SavePixmapJPeg(pic , savepath)
EndIf
Print "saving successfully"

Repeat
Cls
DrawPixmap pic , 0 , 0
DrawText "Press esc to end",10,10
Flip
Until KeyHit(KEY_ESCAPE)
End




Rem
   bbdoc: Scales TPixmap through seam-carving algorithm to lower size
   param map - TPixmap you want to scale
   param newWidth, newHeight - new (lower) size in pixels you want the image to be
   param resolution - steps until new flow will be calculated. Speeds up the function, but if you have enought time use '1' to get best result.
   param demomode - 1=show difference, 2=show flow, 4=show removing
End Rem
Function SeamCarving:TPixmap(map:TPixmap, newWidth:Int , newHeight:Int, resolution:Int = 10, demomode:Byte)
   Local mapwidth:Int = PixmapWidth(map)
   Local mapheight:Int = PixmapHeight(map)
   
   Local pixel:Byte[mapwidth , mapheight,4]
   Local distarray:Long[mapwidth , mapheight]
   Local patharray:Int[mapwidth , mapheight]
      
   Local widthDist:Int = mapwidth - newWidth
   Local heightDist:Int = mapheight - newHeight
   
   Local pathh:Int[]
   Local pathv:Int[]
   Local maxdist:Int
   
   Local drawtmpimages:Byte = demomode 'flags: 1=difference, 2=flow, 4=removing
   
   Local x:Int = 0
   Local y:Int = 0
   
   'Imagepixelwerte in array �bertragen
   For y:Int = 0 Until mapheight
   For x:Int = 0 Until mapwidth
      Local color:Int = ReadPixel(map , x , y)
      'DebugLog "color: "+Hex(color)
      pixel[x , y , 0] = color Shr 24
      pixel[x , y , 1] = color Shr 16
      pixel[x , y , 2] = color Shr 8
      pixel[x , y, 3] = color
   Next
   Next
   
   
   'Horizontal
   Local steps:Int = 0
   While mapheight > newHeight
      If drawtmpimages = 0
         DrawText "horizontal step: " + (steps + 1) , 10 , 10
         Flip 0
      EndIf
      
      If Steps Mod resolution = 0
      
         'Pixeldistanzwerte errechnen
         For y:Int = 0 Until mapheight
            x:Int = 0
            distarray[x , y] = Sqr( (pixel[x + 1 , y , 0] - pixel[x , y , 0]) ^ 2 + (pixel[x + 1 , y , 1] - pixel[x , y , 1]) ^ 2 + (pixel[x + 1 , y , 2] - pixel[x , y , 2]) ^ 2 + (pixel[x + 1 , y , 3] - pixel[x , y , 3]) ^ 2) * 2
            x = mapwidth-1
            distarray[x , y] = Sqr((pixel[x - 1 , y , 0] - pixel[x , y , 0]) ^ 2 + (pixel[x - 1 , y , 1] - pixel[x , y , 1]) ^ 2 + (pixel[x - 1 , y , 2] - pixel[x , y , 2]) ^ 2 + (pixel[x - 1 , y , 3] - pixel[x , y , 3]) ^ 2) * 2
         For x:Int = 1 Until mapwidth - 1
            Local dist1:Long = Sqr((pixel[x - 1 , y , 0] - pixel[x , y , 0]) ^ 2 + (pixel[x - 1 , y , 1] - pixel[x , y , 1]) ^ 2 + (pixel[x - 1 , y , 2] - pixel[x , y , 2]) ^ 2 + (pixel[x - 1 , y , 3] - pixel[x , y , 3]) ^ 2)
            Local dist2:Long = Sqr((pixel[x + 1 , y , 0] - pixel[x , y , 0]) ^ 2 + (pixel[x + 1 , y , 1] - pixel[x , y , 1]) ^ 2 + (pixel[x + 1 , y , 2] - pixel[x , y , 2]) ^ 2 + (pixel[x + 1 , y , 3] - pixel[x , y , 3]) ^ 2)
            distarray[x , y] = dist1 + dist2
         Next
         Next
         
         'TEST
         For x:Int = 0 Until mapwidth
            y:Int = 0
            distarray[x , y]:+Sqr((pixel[x, y+1 , 0] - pixel[x , y , 0]) ^ 2 + (pixel[x, y+1 , 1] - pixel[x , y , 1]) ^ 2 + (pixel[x, y+1 , 2] - pixel[x , y , 2]) ^ 2 + (pixel[x, y+1 , 3] - pixel[x , y , 3]) ^ 2) * 2
            y = mapheight - 1
            distarray[x , y]:+Sqr((pixel[x, y-1 , 0] - pixel[x , y , 0]) ^ 2 + (pixel[x, y-1 , 1] - pixel[x , y , 1]) ^ 2 + (pixel[x, y-1 , 2] - pixel[x , y , 2]) ^ 2 + (pixel[x, y-1 , 3] - pixel[x , y , 3]) ^ 2) * 2
         For y:Int = 1 Until mapheight - 1
            Local dist1:Long = Sqr((pixel[x, y-1 , 0] - pixel[x , y , 0]) ^ 2 + (pixel[x, y-1 , 1] - pixel[x , y , 1]) ^ 2 + (pixel[x, y-1 , 2] - pixel[x , y , 2]) ^ 2 + (pixel[x, y-1 , 3] - pixel[x , y , 3]) ^ 2)
            Local dist2:Long = Sqr((pixel[x, y+1 , 0] - pixel[x , y , 0]) ^ 2 + (pixel[x, y+1 , 1] - pixel[x , y , 1]) ^ 2 + (pixel[x, y+1 , 2] - pixel[x , y , 2]) ^ 2 + (pixel[x, y+1 , 3] - pixel[x , y , 3]) ^ 2)
            distarray[x , y]:+ dist1 + dist2
         Next
         Next
         'TEST ENDE
         
         If drawtmpimages & 1
            map = ResizePixmap(map ,mapwidth , mapheight)
            For y:Int = 0 Until mapheight
            For x:Int = 0 Until mapwidth
               WritePixel(map,x,y,((distarray[x,y]*255)/(8*255))*$10101 + $FF000000) 'shows difference
            Next
            Next
            Cls
            DrawPixmap map , 0 , 0
            DrawText "Horizontal step: " + (steps + 1),10,10
            Flip 0
         EndIf
         
         'Horizontal Pfade berechnen
         patharray = New Int[mapwidth , mapheight]
         For x:Int = 1 Until mapwidth
         For y:Int = 0 Until mapheight
            Local s:Int = 0
            Local toggle:Int = ((x Mod 2)*2-1)
            If y > ((x+1) Mod 2) * (mapheight-1)
               If distarray[x - 1 , y - toggle] + patharray[x - 1 , y - toggle] < distarray[x - 1 , y + s] + patharray[x - s , y + s] s = - toggle
            EndIf
            If y <((x) Mod 2) * (mapheight-1)
               If distarray[x - 1 , y + toggle] + patharray[x - 1 , y + toggle] < distarray[x - 1 , y - s] + patharray[x - 1 , y - s] s = + toggle
            EndIf
            patharray[x , y] = distarray[x - 1 , y + s] + patharray[x - 1 , y + s]
            maxdist = Max(maxdist,patharray[x,y])
         Next
         Next
         
         If drawtmpimages & 2
            map = ResizePixmap(map ,mapwidth , mapheight)
            For y:Int = 0 Until mapheight
            For x:Int = 0 Until mapwidth
               WritePixel(map,x,y,((patharray[x,y]*255)/(maxdist))*$10101 + $FF000000) 'shows flow
               'If pathh[x] = y WritePixel(map,x,y,$FFFF0000)
            Next
            Next
            Cls
            DrawPixmap map , 0 , 0
            DrawText "Horizontal step: " + (steps + 1),10,10
            Flip 0
         EndIf
      EndIf

      'looking for best horizontal path to delete (lowest cost)
         'find startplace
         pathh = New Int[mapwidth]
         Local currentmin:Int = $7FFFFFFF
         For y:Int = 0 Until mapheight
            If patharray[mapwidth - 1 , y] < currentmin
               currentmin = patharray[mapwidth - 1 , y]
               pathh[mapwidth - 1] = y
            EndIf
         Next
         'find way through flow
         For x:Int = mapwidth - 2 To 0 Step - 1
            Local oldy:Int = pathh[x + 1]
            Local s:Int = 0
            If oldy > 0 If patharray[x , oldy - 1] < patharray[x , oldy + s] s = - 1
            If oldy < mapheight - 1 If patharray[x , oldy + 1] < patharray[x , oldy + s] s = 1
            pathh[x] = oldy + s
         Next
         
         If drawtmpimages & 4
            map = ResizePixmap(map ,mapwidth , mapheight)
            For y:Int = 0 Until mapheight
            For x:Int = 0 Until mapwidth
               WritePixel(map,x,y,pixel[x,y,0]*$1000000 + pixel[x,y,1]*$10000 + pixel[x,y,2]*$100 + pixel[x,y,3]) ' shows picture
               'WritePixel(map,x,y,((patharray[x,y]*255)/(maxdist))*$10101 + $FF000000) 'shows flow
               If pathh[x] = y WritePixel(map,x,y,$FFFF0000)
               'WritePixel(map,x,y,((distarray[x,y]*255)/(8*255))*$10101 + $FF000000) 'shows difference
            Next
            Next
            Cls
            DrawPixmap map , 0 , 0
            DrawText "Horizontal step: " + (steps + 1),10,10
            Flip 0
         EndIf
         
      'Delete row from all arrays
      Local oldpixel:Byte[ , , ] = pixel
      Local olddistarray:Long[ , ] = distarray
      Local oldpatharray:Int[ , ] = patharray
         
      pixel = New Byte[mapwidth , mapheight - 1,pixel.Dimensions()[2]]
      distarray = New Long[mapwidth , mapheight - 1]
      patharray = New Int[mapwidth, mapheight-1]
      
      For x:Int = 0 Until mapwidth
      y = 0
      For Local yc:Int = 0 Until mapheight
         If pathh[x] <> yc
            pixel[x , y , 0] = oldpixel[x , yc , 0]
            pixel[x , y , 1] = oldpixel[x , yc , 1]
            pixel[x , y , 2] = oldpixel[x , yc , 2]
            pixel[x , y , 3] = oldpixel[x , yc , 3]
            
            distarray[x , y] = olddistarray[x , yc]
            patharray[x,y] = oldpatharray[x,yc]
            y:+ 1
         EndIf
      Next
      Next
      
      mapheight:- 1
      steps:+1
   Wend

   
   
   steps=0
   
   
   While mapwidth > newWidth
      If drawtmpimages = 0
         DrawText "vertical step: " + (steps + 1) , 10 , 10
         Flip 0
      EndIf
      
      If Steps Mod resolution = 0
         'Vertikal Pixeldistanzwerte errechnen

         For x:Int = 0 Until mapwidth
            y:Int = 0
            distarray[x , y] = Sqr((pixel[x, y+1 , 0] - pixel[x , y , 0]) ^ 2 + (pixel[x, y+1 , 1] - pixel[x , y , 1]) ^ 2 + (pixel[x, y+1 , 2] - pixel[x , y , 2]) ^ 2 + (pixel[x, y+1 , 3] - pixel[x , y , 3]) ^ 2) * 2
            y = mapheight - 1
            distarray[x , y] = Sqr((pixel[x, y-1 , 0] - pixel[x , y , 0]) ^ 2 + (pixel[x, y-1 , 1] - pixel[x , y , 1]) ^ 2 + (pixel[x, y-1 , 2] - pixel[x , y , 2]) ^ 2 + (pixel[x, y-1 , 3] - pixel[x , y , 3]) ^ 2) * 2
         For y:Int = 1 Until mapheight - 1
            Local dist1:Long = Sqr((pixel[x, y-1 , 0] - pixel[x , y , 0]) ^ 2 + (pixel[x, y-1 , 1] - pixel[x , y , 1]) ^ 2 + (pixel[x, y-1 , 2] - pixel[x , y , 2]) ^ 2 + (pixel[x, y-1 , 3] - pixel[x , y , 3]) ^ 2)
            Local dist2:Long = Sqr((pixel[x, y+1 , 0] - pixel[x , y , 0]) ^ 2 + (pixel[x, y+1 , 1] - pixel[x , y , 1]) ^ 2 + (pixel[x, y+1 , 2] - pixel[x , y , 2]) ^ 2 + (pixel[x, y+1 , 3] - pixel[x , y , 3]) ^ 2)
            distarray[x , y]= dist1 + dist2
         Next
         Next
         
         'TEST
         For y:Int = 0 Until mapheight
            x:Int = 0
            distarray[x , y]:+Sqr( (pixel[x + 1 , y , 0] - pixel[x , y , 0]) ^ 2 + (pixel[x + 1 , y , 1] - pixel[x , y , 1]) ^ 2 + (pixel[x + 1 , y , 2] - pixel[x , y , 2]) ^ 2 + (pixel[x + 1 , y , 3] - pixel[x , y , 3]) ^ 2) * 2
            x = mapwidth-1
            distarray[x , y]:+Sqr((pixel[x - 1 , y , 0] - pixel[x , y , 0]) ^ 2 + (pixel[x - 1 , y , 1] - pixel[x , y , 1]) ^ 2 + (pixel[x - 1 , y , 2] - pixel[x , y , 2]) ^ 2 + (pixel[x - 1 , y , 3] - pixel[x , y , 3]) ^ 2) * 2
         For x:Int = 1 Until mapwidth - 1
            Local dist1:Long = Sqr((pixel[x - 1 , y , 0] - pixel[x , y , 0]) ^ 2 + (pixel[x - 1 , y , 1] - pixel[x , y , 1]) ^ 2 + (pixel[x - 1 , y , 2] - pixel[x , y , 2]) ^ 2 + (pixel[x - 1 , y , 3] - pixel[x , y , 3]) ^ 2)
            Local dist2:Long = Sqr((pixel[x + 1 , y , 0] - pixel[x , y , 0]) ^ 2 + (pixel[x + 1 , y , 1] - pixel[x , y , 1]) ^ 2 + (pixel[x + 1 , y , 2] - pixel[x , y , 2]) ^ 2 + (pixel[x + 1 , y , 3] - pixel[x , y , 3]) ^ 2)
            distarray[x , y]:+dist1 + dist2
         Next
         Next
         'TEST END
         
         If drawtmpimages & 1
            map = ResizePixmap(map ,mapwidth , mapheight)
            For y:Int = 0 Until mapheight
            For x:Int = 0 Until mapwidth
               WritePixel(map,x,y,((distarray[x,y]*255)/(8*255))*$10101 + $FF000000) 'shows difference      
            Next
            Next
            Cls
            DrawPixmap map , 0 , 0
            DrawText "Vertikal step: " + (steps + 1),10,10
            Flip 0
         EndIf
         
         'Vertikal Pfade berechnen
         Local maxdist:Int
         patharray = New Int[mapwidth , mapheight]
         For y:Int = 1 Until mapheight
         For x:Int = 0 Until mapwidth
            Local s:Int = 0
            Local toggle:Int = ((y Mod 2)*2-1)
            If x > ((y+1) Mod 2) * (mapwidth-1)
               If distarray[x - toggle , y - 1] + patharray[x - toggle , y - 1] < distarray[x + s , y - 1] + patharray[x + s , y - 1] s = - toggle
            EndIf
            If x <((y) Mod 2) * (mapwidth-1)
               If distarray[x + toggle , y - 1] + patharray[x + toggle , y - 1] < distarray[x + s , y - 1] + patharray[x + s , y - 1] s = toggle
            EndIf
            patharray[x , y] = distarray[x + s , y - 1] + patharray[x + s , y - 1]
            maxdist = Max(maxdist,patharray[x,y])
         Next
         Next
         
         If drawtmpimages & 2
            map = ResizePixmap(map ,mapwidth , mapheight)
            For y:Int = 0 Until mapheight
            For x:Int = 0 Until mapwidth
               WritePixel(map,x,y,((patharray[x,y]*255)/(maxdist))*$10101 + $FF000000) 'shows flow
            Next
            Next
            Cls
            DrawPixmap map , 0 , 0
            DrawText "Vertikal step: " + (steps + 1),10,10
            Flip 0
         EndIf
      EndIf
      
      'looking for best vertical path to delete (lowest cost)
      'find startplace
      pathv = New Int[mapheight]
      Local currentmin:Int = $7FFFFFFF
      For x:Int = 0 Until mapwidth
         If patharray[x , mapheight-1] < currentmin
            currentmin = patharray[x , mapheight-1]
            pathv[mapheight - 1] = x
         EndIf
      Next
      'find way through flow
      For y:Int = mapheight - 2 To 0 Step - 1
         Local oldx:Int = pathv[y + 1]
         Local s:Int = 0
         If oldx > 0 If patharray[oldx-1 , y] < patharray[oldx + s , y] s = - 1
         If oldx < mapwidth - 1 If patharray[oldx + 1,y ] < patharray[oldx + s,y] s = 1
         pathv[y] = oldx + s
      Next
      
         If drawtmpimages & 4
            map = ResizePixmap(map ,mapwidth , mapheight)
            For y:Int = 0 Until mapheight
            For x:Int = 0 Until mapwidth
               WritePixel(map,x,y,pixel[x,y,0]*$1000000 + pixel[x,y,1]*$10000 + pixel[x,y,2]*$100 + pixel[x,y,3]) 'shows picture
               'WritePixel(map,x,y,((patharray[x,y]*255)/(maxdist))*$10101 + $FF000000) 'shows flow
               'WritePixel(map,x,y,((distarray[x,y]*255)/(8*255))*$10101 + $FF000000) 'shows difference   
               If pathv[y] = x WritePixel(map,x,y,$FFFF0000)'shows path
            Next
            Next
            Cls
            DrawPixmap map , 0 , 0
            DrawText "Vertikal step: " + (steps + 1),10,10
            Flip 0
         EndIf
      
      'Delete row from all arrays
      Local oldpixel:Byte[ , , ] = pixel
      Local olddistarray:Long[ , ] = distarray
      Local oldpatharray:Int[ , ] = patharray
         
      pixel = New Byte[mapwidth-1 , mapheight,pixel.Dimensions()[2]]
      distarray = New Long[mapwidth-1 , mapheight]
      patharray = New Int[mapwidth-1, mapheight]
      
      For y:Int = 0 Until mapheight
      x = 0
      For Local xc:Int = 0 Until mapwidth
         If pathv[y] <> xc
            pixel[x , y , 0] = oldpixel[xc , y , 0]
            pixel[x , y , 1] = oldpixel[xc , y , 1]
            pixel[x , y , 2] = oldpixel[xc , y , 2]
            pixel[x , y , 3] = oldpixel[xc , y , 3]
            
            distarray[x , y] = olddistarray[xc , y]
            patharray[x,y] = oldpatharray[xc,y]
            x:+ 1
         EndIf
      Next
      Next
      
      mapwidth:-1
      steps:+1
   Wend
   
   
   
   
   
   

   
   'Imagepixelwerte aus array wieder ins Bild �bertragen
   
   Rem
   For y:Int = 0 Until mapheight
   For x:Int = 0 Until mapwidth
      WritePixel(map,x,y,$FFFFFFFF)
   Next
   Next
   End Rem
   map = ResizePixmap(map , newWidth , newHeight)
   For y:Int = 0 Until mapheight
   For x:Int = 0 Until mapwidth
      WritePixel(map,x,y,pixel[x,y,0]*$1000000 + pixel[x,y,1]*$10000 + pixel[x,y,2]*$100 + pixel[x,y,3])
   Next
   Next
   
   Return map
End Function

  • Zuletzt bearbeitet von Firstdeathmaker am Sa, Okt 11, 2008 12:08, insgesamt einmal bearbeitet

Farbfinsternis

 BeitragDo, Jun 19, 2008 18:29
Antworten mit Zitat
Benutzer-Profile anzeigen
Bereits sehr beeindruckend.

Nächste Aufgabe: Echtzeit Wink
Farbfinsternis.tv

Firstdeathmaker

 BeitragDo, Jun 19, 2008 21:52
Antworten mit Zitat
Benutzer-Profile anzeigen
Ich glaube Echtzeit kann man mit BMax dabei vergessen. Wink
www.illusion-games.de
Space War 3 | Space Race | Galaxy on Fire | Razoon
Gewinner des BCC #57 User posted image

ZaP

 BeitragDo, Jul 28, 2011 22:29
Antworten mit Zitat
Benutzer-Profile anzeigen
Ich habe den Algorithmus ebenfalls implementiert, hier also mein Ansatz:

BlitzMax: [AUSKLAPPEN] 
'Seamcarving Image Resizing Algorithm

SuperStrict

Import maxgui.Drivers

Type SeamCarving
	
	Field window:TGadget
	Field canvas:TGadget
	
	Field width:Int
	Field height:Int
	Field image:TImage
	
	Field pixels:TPixel[0, 0]
		
	' Setup GUI
	' Select & load picture
	Method New()
	
		If(Self.GetImage(RequestFile("Load a picture...", "Images (jpeg, png, bmp):jpg,png,bmp;All Files:*")))
			Self.window = CreateWindow("Seamcarving Blitzmax Example (resize me!)", 0, 0, Self.width, Self.height, Null, WINDOW_CENTER | WINDOW_CLIENTCOORDS | WINDOW_TITLEBAR | WINDOW_RESIZABLE)
			Self.canvas = CreateCanvas(0, 0, Self.width, Self.height, Self.window)
			
			SetGadgetLayout(Self.canvas, EDGE_ALIGNED, EDGE_RELATIVE, EDGE_ALIGNED, EDGE_RELATIVE)
			SetMaxWindowSize(Self.window, Self.width, Self.height)
		Else
			Notify("No image!", True)
			End
		EndIf
				
	End Method

	' Load picture into pixel matrix
	Method GetImage:Byte(path:String)
	
		If path = "" Return 0
	
		Self.image = LoadImage(path)
		If Not Self.image Then Return 0
		
		Self.width = ImageWidth(Self.image) - 1
		Self.height = ImageHeight(Self.image) - 1
		Local pixelmatrix:TPixel[width + 1, height + 1]
		
		Local x:Int
		Local y:Int
		Local pixmap:TPixmap = Self.image.pixmaps[0]
		
		For y:Int = 0 To Self.height
			For x:Int = 0 To Self.width
				Local color:Int = ReadPixel(pixmap, x, y)
				
				pixelmatrix[x, y] = New TPixel
				pixelmatrix[x, y].color = color
				pixelmatrix[x, y].r = (color & $00FF0000) Shr 16
				pixelmatrix[x, y].g = (color & $0000FF00) Shr 8
				pixelmatrix[x, y].b = color & $000000FF
				pixelmatrix[x, y].intensity = (0.299 * pixelmatrix[x, y].r + 0.587 * pixelmatrix[x, y].g + 0.114 * pixelmatrix[x, y].b) / 3.0
			Next
		Next
		
		Self.pixels = pixelmatrix
		
		Self.UpdatePixelEnergies()
		
		Return 1
		
	End Method
	
	' Calculate pixel energy as well as accumulated pixel energy of all pixels
	Method UpdatePixelEnergies()
		
		Local x:Int
		Local y:Int
	
		For y:Int = 0 To Self.height
			For x:Int = 0 To Self.width
				Self.CalculatePixelEnergy(x, y)
			Next
		Next
		
		For y:Int = 0 To Self.height
			For x:Int = 0 To Self.width
				Self.CalculateAccumulatedPixelEnergy(x, y)
			Next
		Next
		
	End Method
	
	' Energy = abs(pixel.intensity - intensity_of_all_adjacent_pixel) / number_of_adjacent_pixels
	Method CalculatePixelEnergy(x:Int, y:Int)
	
		If x < 0 Or x > Self.width Or y < 0 Or y > Self.height Then Return
	
		Local intensity:Float = pixels[x, y].intensity
		Local adjacentpixels:Int = 0
		
		If x > 0 Then intensity:-pixels[x - 1, y].intensity; adjacentpixels:+1
		If x < Self.width - 1 Then intensity:-pixels[x + 1, y].intensity; adjacentpixels:+1
		If y > 0 Then intensity:-pixels[x, y - 1].intensity; adjacentpixels:+1
		If y < Self.height - 1 Then intensity:-pixels[x, y + 1].intensity; adjacentpixels:+1
		
		pixels[x, y].energy = (Abs(intensity) / Float(adjacentpixels))
		
	End Method
	
	' AccumulatedEnergy = pixel.energy + Minimum(E_a[])
	' where E_a[] is all pixels above the current pixel
	' (left-top, top, right,top)
	' thus, pixels in the first row have accumulated energy and energy being equal
	Method CalculateAccumulatedPixelEnergy(x:Int, y:Int)
		
		If x < 0 Or x > Self.width Or y < 0 Or y > Self.height Then Return
	
		Local MinEnergy:Float = 0.0
		
		If y > 0
			MinEnergy = pixels[x, y - 1].energy
		
			If x > 0	
				If pixels[x - 1, y - 1].energy < MinEnergy Then MinEnergy = pixels[x - 1, y - 1].energy
				
				If x < Self.width - 1
					If pixels[x + 1, y - 1].energy < MinEnergy Then MinEnergy = pixels[x + 1, y - 1].energy
				EndIf
			End If
		Else
			MinEnergy = pixels[x, y].energy
		EndIf
		
		pixels[x, y].accumulatedEnergy = pixels[x, y].energy + MinEnergy
		
	End Method
	
	' Execute algorithm
	' Find a seam with lowest cost determined through the pixels accumulated energy values
	Method SeamCarve()
		
		Local HorizontalSteps:Int = Self.width - GadgetWidth(Self.window)
		Local VerticalSteps:Int = Self.height - GadgetHeight(Self.window)
	
		Local i:Int
		Local x:Int
		Local y:Int
		
		For i:Int = 0 To HorizontalSteps - 1
				
			' Find lowest cost pixel in the first row
			' which is SeamX
			Local MinEnergy:Float = pixels[0, 0].accumulatedEnergy
			Local SeamX:Int = 0
			
			For x:Int = 0 To Self.width
				If pixels[x, 0].accumulatedEnergy < MinEnergy
					SeamX = x
					MinEnergy = pixels[x, 0].accumulatedEnergy
				EndIf
			Next
			
			' Find seam path and remove it:
			' beginning at the root, select the cheapest adjacent pixel
			' (bottom-left, bottom, bottom-right) and repeat the procedure
			For y:Int = 0 To Self.height - 1
				Local ae:Float[3] ' ae - accumulated energy of bottom pixels
				
				If SeamX > 0
					ae[0] = pixels[SeamX - 1, y + 1].accumulatedEnergy
				Else
					ae[0] = 2 ^ 31 - 1
				EndIf
				
				ae[1] = pixels[SeamX, y + 1].accumulatedEnergy
				
				If SeamX < Self.width
					ae[2] = pixels[SeamX + 1, y + 1].accumulatedEnergy
				Else
					ae[2] = 2 ^ 31 - 1
				EndIf

				If ae[0] < ae[1] And ae[0] < ae[2]
					SeamX:-1
				ElseIf ae[2] < ae[0] And ae[2] < ae[1]
					SeamX:+1
				EndIf
				
				Self.RemovePixelHorz(SeamX, y)
			Next
			
			Self.width:-1
		Next
		
		For i:Int = 0 To VerticalSteps
			' To be implemented....
		Next
		
		' Update the image pixmap
		Local NewPixmap:TPixmap = CreatePixmap(Self.width, Self.height, 6)

		For y:Int = 0 To Self.height - 1
			For x:Int = 0 To Self.width - 1
				NewPixmap.WritePixel(x, y, pixels[x, y].color)
			Next
		Next

		Self.image.SetPixmap(0, NewPixmap)

	End Method
	
	' Remove a pixel and shift left all pixels in that row
	Method RemovePixelHorz(x:Int, y:Int)
	
		Local h:Int
	
		For h:Int = x To Self.width - 1
			Self.pixels[h, y] = Self.pixels[h + 1, y]
		Next
		
		CalculatePixelEnergy(x - 1, y)
		CalculatePixelEnergy(x, y)
				
		CalculateAccumulatedPixelEnergy(x - 1, y)
		CalculateAccumulatedPixelEnergy(x, y)
				
		Self.pixels[Self.width, y] = Null
	End Method
	
	' Run algorithm
	' Refresh Window
	Method Run()
		Repeat
			Select WaitEvent()
				Case EVENT_APPTERMINATE, EVENT_WINDOWCLOSE
					End
					
				Case EVENT_WINDOWSIZE
					Self.SeamCarve()
					SetMaxWindowSize(Self.window, GadgetWidth(Self.window), GadgetHeight(Self.window))
					SetGadgetShape(Self.canvas, 0, 0, Self.width, Self.height)
					
					SetGraphics CanvasGraphics(Self.canvas)
					DrawPixmap(Self.image.pixmaps[0], 0, 0)

					Flip
				
			End Select
		Forever
	End Method
	
End Type

Type TPixel
	Field r:Byte
	Field g:Byte
	Field b:Byte
	Field color:Int
	Field intensity:Float
	Field energy:Float
	Field accumulatedEnergy:Float
End Type

SetGraphicsDriver(GLMax2DDriver())

Local s:SeamCarving = New SeamCarving
s.Run()

End


Einfach mal das Fenster verkleinern, dann rechnet das Teil los.
Geht insgesamt schon ziemlich fix, aber leider nur fast Echtzeitfähig. Und es geht nur horizontal Razz
Starfare: Worklog, Website (download)

Neue Antwort erstellen


Übersicht BlitzMax, BlitzMax NG Codearchiv & Module

Nach Oben

Gehe zu:

Powered by phpBB © 2001 - 2006, phpBB Group