BPS #16: Schwarzweiß ist das neue Bunt - Auswertung

Übersicht BlitzMax, BlitzMax NG Beginners-Corner

Neue Antwort erstellen

Xeres

Moderator

Betreff: BPS #16: Schwarzweiß ist das neue Bunt - Auswertung

 BeitragSo, Jan 22, 2012 15:33
Antworten mit Zitat
Benutzer-Profile anzeigen
So! Wer konnte die Transformation umsetzen?

Das war die Aufgabe

Postet hier eure Ergebnisse, Codes, Gedanken. Lernt von den anderen, seht euch deren Quelltext an und versucht euren eigenen zu verbessern.

Diskussion
Postet zu euren Codes stets eine kurze Erklärung mit euren Gedanken in denen ihr simpel gesagt die Frage "Wieso habe ich XY auf diese Art gelöst?" beantwortet. Beiträge, die nur den Code enthalten werden wir aus dem Thread entfernen.

Nächste Aufgabe
In einer Woche wird die Musterlösung nach editiert und in 2 die nächste Aufgabe eingestellt.

Viel Spaß & viel Erfolg!

Musterlösung:
BlitzMax: [AUSKLAPPEN] 
SuperStrict

Graphics(512, 256)
SetBlend(AlphaBlend)

'* Bild Laden:
Local img:TImage = LoadImage("ToSW.png")

'* Schwarzweiß Version erzeugen:
Local img_sw:TImage = KonvertiereZuSW(img)

'* Bilder zum Vergleich anzeigen:
DrawImage(img,0,0)
DrawImage(img_sw, 256, 0)

Flip(0)
WaitKey()
End

Function KonvertiereZuSW:TImage(img:TImage)
    Local breit:Int = img.width
    Local hoch:Int = img.height
    
    '* Neues Bild erstellen um das Ursprungsbild nicht zu verändern:
    Local New_img:TImage = CreateImage(breit, hoch)
    '* Die Pixmap des Bildes holen:
    Local pix:TPixmap = LockImage(img)
    '* Pixeldaten kopieren:
    '* pixmaps[0] = Frame 0
    New_img.pixmaps[0] = pix.Copy()
    '* Ursprungspixmap wieder freigeben:
    UnlockImage(img)
    '* Die Pixmap des Bildes holen, um das Bild zu manipulieren
    Local New_pix:TPixmap = LockImage(New_img)
    
    '* X,Y Koordinaten für das Bild
    '* Alpha, Rot, Grün, Blau Farbbestandteile
    '* ARGB Farb-Summe
    Local x:Int, y:Int, a:Int, r:Int, g:Int, b:Int, argb:Int
    
    '* alle Pixel des Bildes durchgehen:
    For y = 0 To hoch-1
        For x = 0 To breit-1
            '* Einlesen der Pixelfarbe:
            argb = New_pix.ReadPixel(x, y)
            
            '* Zerlegen der Farbe in ihre Bestandteile:
            '* & Anstatt AND -> Bitwise AND <> Conditional AND
            a = (argb & $FF000000) / $1000000
            r = (argb & $FF0000) / $10000
            g = (argb & $FF00) / $100
            b = argb & $FF
            
            '* Mittelwert der Farbe:
            Local sw:Int = (r + g + b) / 3
            
            '* Farbe wieder zusammensetzen, Alpha-Kanal bleibt unverändert
            argb = a * $1000000 + sw * $10000 + sw * $100 + sw
            
            '* Pixelfarbe Schreiben:
            New_pix.WritePixel(x, y, argb)
        Next
    Next
    UnlockImage(New_img)
    
    '* Das Fertig bearbeitete Bild zurückliefern:
    Return New_img
End Function

Wie DerHase so richtig im Chat bemerkte (und einige wussten oder nach schlugen) ist der Grauton hier nur ein Mittelwert. Um ein Bild in Grausstufen mit der richtigen Luminanz (d.h. die Helligkeit der Farben bleibt erhalten) zu konvertieren, muss man die Farben in einem Verhältnis von 30% Rot, 59% Grün, und 11% Blau mischen.
Wieder was gelernt!
Win10 Prof.(x64)/Ubuntu 16.04|CPU 4x3Ghz (Intel i5-4590S)|RAM 8 GB|GeForce GTX 960
Wie man Fragen richtig stellt || "Es geht nicht" || Video-Tutorial: Sinus & Cosinus
THERE IS NO FAIR. THERE IS NO JUSTICE. THERE IS JUST ME. (Death, Discworld)
  • Zuletzt bearbeitet von Xeres am Mo, Feb 06, 2012 0:53, insgesamt 2-mal bearbeitet

Lobby

 BeitragSo, Jan 22, 2012 18:14
Antworten mit Zitat
Benutzer-Profile anzeigen
Weil solche Bildoperationen oftmals möglichst schnell ablaufen sollen, beschreibe ich die Speicherplätze der Pixmap-Pixeldaten selbst. Mit Xeres seinem Bild (Auflösung von 256x256) komme ich somit bei folgendem Code auf eine Generierungszeit von durchschnittlich 2ms, ich denke das sollte schnell genug sein.
BlitzMax: [AUSKLAPPEN] 
SuperStrict

Graphics(512, 256, 0)	'Nur ein bisschen Grafik-Initialisierung

Local img:TImage = LoadImage("tosw.png")	'Das zu vergrauende Bild laden

Local ms:Int = MilliSecs()	'Für Zeitmessung den Millisekundenzählerwert abspeichern
Local newImg:TImage = LoadImage(makePixmapMonochrome(img.Lock(0, True, False)))	'Die Pixmap des zu vergrauenden Bildes vergrauen und ein Bild von ihr laden
Print "Needed " + (MilliSecs() - ms) + "ms"	'Die für das Vergrauen benötigte Zeit ausgeben

'Beide Bilder nebeneinander Zeichnen
DrawImage(img, 0, 0)
DrawImage(newImg, img.width, 0)
Flip()

'Standardgedöns
WaitKey()
End

'Die magische Funktion zum Grau-Machen von Pixmaps
Function makePixmapMonochrome:TPixmap(sourcePix:TPixmap)
	If sourcePix.format <> PF_RGBA8888 Then	'Sicherstellen, dass die Pixmap im richtigen Format vorliegt
		sourcePix = sourcePix.Convert(PF_RGBA8888)
	End If
	Local pix:TPixmap = TPixmap.Create(sourcePix.width, sourcePix.Height, PF_RGBA8888)	'Zielpixmap erstellen
	Local Length:Int = sourcePix.Capacity	'Die Länge an Farbdaten der Pixmap zwischenspeichern
	Local r:Int, g:Int, b:Int, a:Int, col:Int	'Die benötigten Variablen definieren
	For Local i:Int = 0 Until Length Step 4	'Jedes Bytequartett an Pixeldaten durchlaufen
		'Die einzelnen Farben aus der Quellpixmap lesen
		r = sourcePix.Pixels[i]
		g = sourcePix.Pixels[i + 1]
		b = sourcePix.Pixels[i + 2]
		a = sourcePix.Pixels[i + 3]
		'Den Grauton bestimmen
		col = (r + g + b) / 3
		'Die Grautöne als Farbe der Zielpixmap setzen, Alpha wird beibehalten
		pix.Pixels[i] = col
		pix.Pixels[i + 1] = col
		pix.Pixels[i + 2] = col
		pix.Pixels[i + 3] = a
	Next
	Return(pix)
End Function

Zur Erklärung des Codes, die Funktion makePixmapMonochrome:TPixmap(sourcePix:TPixmap) liefert eine eingegraute Pixmap der Pixmap sourcePix zurück. Diese hat das Format PF_RGBA8888, könnte also hier unnötigerweise auch verschiedene Farben enthalten, allerdings halte ich sie in diesem Format für universal einsetzbarer. Zum Berechnen der Graustufe verwende ich trivialerweise den Durchschnitt der drei Farbwerte (siehe col = (r + g + b) / 3).
Um aus einem TImage eine Pixmap zu erhalten, verwende ich wie üblich dessen Methode Lock:TPixmap(index:Int, read:Int, write:Int). Um eine Pixmap wieder in ein Image zu verwandeln, gebe ich schlichtweg bei LoadImage:TImage(object:Object) die Pixmap als object an.

Hier noch eine alternative makePixmapMonochrome:TPixmap(sourcePix:TPixmap)-Funktion, die zwar etwas langsamer als meine oben gezeigte Umsetzung zu sein scheint (bei mir ~3ms), dafür aber bedeutend weniger Schreibarbeit ist.
BlitzMax: [AUSKLAPPEN] 
Function makePixmapMonochrome:TPixmap(sourcePix:TPixmap)
	Return(sourcePix.Convert(PF_I8))
End Function

Blitzcraft

 BeitragSo, Jan 22, 2012 23:18
Antworten mit Zitat
Benutzer-Profile anzeigen
Wenn auch noch ein bischen spät, hier ist mein Beitrag und erst im falschen Thread: Shocked

Einfach ein Bild auf das Programm 'dropen' um es in SW umzuwandeln oder das Programm normal starten um einen zufälligen Farbverlauf in SW umzuwandeln.
Ich hab mich für die sprichwörtliche Durchschnittslösung entschieden Wink
Außerdem ist das alles auserordentlich schnell!
Für Xeres' Bild braucht es grade mal 0.007 Sekunden Shocked

Code: [AUSKLAPPEN]
'BPS # 16 Beitrag von Blitzcraft

SuperStrict
AppTitle="Bunt zu Schwarzweiß"
SeedRnd MilliSecs()

'Per Drag'n'Drop übergebenes Bild laden und kopieren und bei Fehler ein Farbverlauf als Bild nehmen
Local IMG_BUNT:TPixmap
If AppArgs.length>1
   IMG_BUNT=LoadPixmap(AppArgs[1])
   If IMG_BUNT=Null
      IMG_BUNT=Farbverlauf:TPixmap(Rnd(30,240),Rnd(30,240),Rnd(30,240))
   End If
Else
   IMG_BUNT=Farbverlauf:TPixmap(Rnd(30,240),Rnd(30,240),Rnd(30,240))
End If
Local IMG_SW:TPixmap=CopyPixmap(IMG_BUNT)

'Graphik aktivieren und Fenstergröße ensprechend einstellen
Graphics 15+PixmapWidth(IMG_BUNT)*2,35+PixmapHeight(IMG_BUNT),0,0

Local t:Float=SW_IMG:Float(IMG_SW) 'SW Bild erstellen
Local timer:TTimer=CreateTimer(60)
While Not AppTerminate()
   Cls
   
   'Fenster vollmalen
   DrawText "Bunt:",6,2
   DrawText "Schwarzweiss:",11+PixmapWidth(IMG_BUNT),2
   DrawText "Das Bild wurde in "+Left$(t,Instr(t,".")+5)+" Sekunden umgewandelt!",6,17+PixmapHeight(IMG_BUNT)
   
   DrawPixmap(IMG_BUNT,5,15)
   DrawPixmap(IMG_SW,10+PixmapWidth(IMG_BUNT),15)
   
   Flip
   
   WaitTimer(timer)
Wend
End

Function SW_IMG:Float(img:TPixmap) 'Bild SW machen
   Local msecs:Int=MilliSecs() 'Zeit merken
   Local pix:Int,rgb:Int,a:Int,r:Int,b:Int,g:Int
   For Local x:Int=0 Until PixmapWidth(img) 'jeden Pixel durchgehen
      For Local y:Int=0 Until PixmapHeight(img)
         'Aktuellen Pixel auslesen und den Mittelwert der RGB-Werte für alle drei übernehmen   
         pix=ReadPixel(img,x,y)
         WritePixel img,x,y,(pix & $FF000000)+((pix & $FF0000)/$10000+(pix & $FF00)/$100+(pix & $FF))/3*$10000+((pix & $FF0000)/$10000+(pix & $FF00)/$100+(pix & $FF))/3*$100+((pix & $FF0000)/$10000+(pix & $FF00)/$100+(pix & $FF))/3
      Next
   Next
   Return (MilliSecs()-msecs)*0.001 'Dauer des Erstellens ausrechnen
End Function

Function Farbverlauf:TPixmap(fr:Int,fg:Int,fb:Int)'Farbverlauf erstellen und als Bild zurückgeben
   Local img:TPixmap=CreatePixmap(500,300,PF_RGB888),r:Float,g:Float,b:Float
   ClearPixels(img)
   For Local x:Int=0 Until 500 'jeden Pixel durchgehen
      'entsprechende RGB-Werte ausrechnen
      r=Float(fr-(x+1)*(fr*0.002))
      g=Float(fg-(x+1)*(fg*0.002))
      b=Float(fb-(x+1)*(fb*0.002))
      For Local y:Int=0 Until 300
         '...und in das Bild malen
         WritePixel img,x,y,255*$1000000+Int(r)*$10000+Int(g)*$100+Int(b)
      Next
   Next
   Return img
End Function
Screenshot aus meinem ersten Projekt

Propellator

 BeitragSo, Jan 22, 2012 23:18
Antworten mit Zitat
Benutzer-Profile anzeigen
BlitzMax: [AUSKLAPPEN] 
SuperStrict

Import Pub.Glew

SetGraphicsDriver(GLMax2DDriver())
Graphics 800,600
glewInit()

Local BlackWhiteShader:TShader = New TShader
BlackWhiteShader.Load("vertexshader.txt", "fragmentshader.txt")
Local Image:TImage = LoadImage("tosw.png")
SetImageHandle(Image, ImageWidth(Image) / 2, ImageHeight(Image) / 2)
BlackWhiteShader.Enable()

Local ImageX:Int = GraphicsWidth() / 2
Local ImageY:Int = GraphicsHeight() / 2

Local ImageRotation:Int

While Not KeyHit(KEY_ESCAPE)
	ImageRotation = (ImageRotation + 1) Mod 360
	SetRotation(ImageRotation)
	DrawImage(Image, ImageX, ImageY)
	Flip 1
	Cls
Wend
End

Rem
vertexshader.txt
----------------

void main()
{
	gl_TexCoord[0] = gl_MultiTexCoord0;
	gl_Position = ftransform();
}

fragmentshader.txt
------------------

uniform sampler2D texture;

void main()
{
	vec4 texel;
	float average;

	texel = texture2D(texture, gl_TexCoord[0].st);
	average = texel.r / 100.0 * 30.0 + texel.g / 100.0 * 59.0 + texel.b / 100.0 * 11.0;
	gl_FragColor = vec4(average, average, average, 1.0);
}
EndRem

' Shader Type voll von Noobody geklaut. :<
' Steht aber unter zlib!!1
Type TShader
	Field ProgramObject:Int
	Field VertexShader:Int
	Field FragmentShader:Int
	
	Method New()
		ProgramObject	= glCreateProgramObjectARB()
		VertexShader	= glCreateShaderObjectARB( GL_VERTEX_SHADER_ARB )
		FragmentShader	= glCreateShaderObjectARB( GL_FRAGMENT_SHADER_ARB )
	End Method
	
	Method Load:TShader( VertexPath:String, FragmentPath:String )
		LoadShader( VertexPath,   VertexShader   )
		LoadShader( FragmentPath, FragmentShader )
		
		glCompileShaderARB( VertexShader   ); CheckForErrors( VertexShader   )
		glCompileShaderARB( FragmentShader ); CheckForErrors( FragmentShader )
		
		glAttachObjectARB( ProgramObject, VertexShader   )
		glAttachObjectARB( ProgramObject, FragmentShader )
		
		glDeleteObjectARB( VertexShader   )
		glDeleteObjectARB( FragmentShader )
		
		glLinkProgramARB( ProgramObject ); CheckForErrors( ProgramObject )
		
		Return Self
	End Method
	
	Method Enable()
		glUseProgramObjectARB( ProgramObject )
	End Method
	
	Method Disable()
		glUseProgramObjectARB( 0 )
	End Method
	
	Method Remove()
		glDeleteObjectARB( ProgramObject )
		
		Print "Removed!"
	End Method
	
	Function LoadShader( Path:String, ShaderObject:Int, ExistingShaderCode:String = "" )
		Local ShaderCode:String
		
		If ExistingShaderCode <> "" Then
			ShaderCode = ExistingShaderCode
		Else
			Try ShaderCode = LoadText( Path ) Catch Error:Object Return; EndTry
		EndIf
		
		If ShaderCode <> "" Then
			Local ShaderCodeC:Byte Ptr		= ShaderCode.ToCString()
			Local ShaderCodeLen:Int		= ShaderCode.Length
			
			glShaderSourceARB( ShaderObject, 1, Varptr ShaderCodeC, Varptr ShaderCodeLen )
			
			MemFree( ShaderCodeC )
		EndIf
	End Function
	
	Function CheckForErrors( ShaderObject:Int )
		Local ErrorLength:Int
		
		glGetObjectParameterivARB( ShaderObject, GL_OBJECT_INFO_LOG_LENGTH_ARB, Varptr ErrorLength )
		
		If ErrorLength Then
			Local Message:Byte[ ErrorLength ], Dummy:Int
			
			glGetInfoLogARB( ShaderObject, ErrorLength, Varptr Dummy, Varptr Message[ 0 ] )
			
			WriteStdout "Shader object '" + ShaderObject + "': " + StringFromCharArray( Message )
			WriteStdout "~n"
		EndIf
	End Function
	
	Function StringFromCharArray:String( Array:Byte[] )
		Local Output:String
		For Local I:Int = 0 To Array.Length - 1
			Output :+ Chr( Array[ I ] )
		Next
		
		Return Output
	End Function
	
	Function CheckCompability:Int()
		Local Extensions:String	= String.FromCString( Byte Ptr glGetString( GL_EXTENSIONS ) )
		Local GLVersion:String		= String.FromCString( Byte Ptr glGetString( GL_VERSION ) )
		Local GLVersionInt:Int		= GLVersion[ .. 3 ].Replace( ".", "" ).ToInt()
		
		If Extensions.Find( "GL_ARB_shader_objects"  ) >= 0 And ..
		   Extensions.Find( "GL_ARB_vertex_shader"   ) >= 0 And ..
		   Extensions.Find( "GL_ARB_fragment_shader" ) >= 0 Or GLVersionInt >= 20 Then Return True
		
		Return False
	End Function
End Type


Realtime mit GLSL Shadern! Habe dafür Noo's Shader-Type gemopst, da ich zu faul war das ganze Laden und Linken der Shader selbst zu machen. Smile
Danke an DerHase fürs Berichtigen der Berechnungen!

Das ganze ist so schnell, dass es alles bei jedem Zeichenvorgang umwandelt, und trotzdem flüssig läuft. True Story.
Propellator - Alles andere ist irrelephant.
Elefanten sind die Könige der Antarktis.
 

MasterSolaris

 BeitragMo, Jan 23, 2012 17:26
Antworten mit Zitat
Benutzer-Profile anzeigen
So, hier mal meine Funktion:
BlitzMax: [AUSKLAPPEN] 

SuperStrict
Const farbbild:String = "tosw.png" 'Bild, welches konvertiert wird
Const graubild:String = "grau.png" 'Datei, in der das Ergebnis gespeichert wird
Global bildhandle:TImage, grauesbildhandle:TImage


AppTitle = "Bild konvertieren"
Graphics 800, 600, 0
bildhandle = LoadImage(farbbild)
grauesbildhandle = BildAusgrauen(farbbild, graubild)
DrawImage bildhandle, 0, 0
DrawImage grauesbildhandle, bildhandle.WIDTH, 0
Flip
WaitKey
End



Function BildAusgrauen:TImage(quelle:String, speicherort:String)
	'Ein paar Variablen
	Local farbe:Int, a:Int, r:Int, g:Int, b:Int, grau:Int, rgrau:Int, ggrau:Int, bgrau:Int, schwarzweiss:Int
	Local breite:Short, hoehe:Short, i:Short, j:Short
	Local pixmap:TPixmap, grauepixmap:TPixmap
	Local bild:TImage, grauesbild:TImage
	bild = LoadImage(quelle) 'Bild laden
	breite = bild.WIDTH 'Breite des Bildes
	hoehe = bild.HEIGHT 'Höhe des Bildes
	grauesbild = CreateImage(breite, hoehe) 'Neues Bild erstellen
	pixmap = LockImage(bild)
	grauepixmap = LockImage(grauesbild)
	For i = 0 To breite-1	'alle einzelnen Pixel durchgehen
		For j = 0 To hoehe-1
			farbe = ReadPixel (pixmap, i, j)	'Farbe der Pixel auslesen
			a = (farbe & $FF000000)/$1000000	'einzelne Farbwerte ermitteln
			r = (farbe & $FF0000)/$10000
			g = (farbe & $FF00)/$100
			b = farbe & $FF
			rgrau = r*0.3		'siehe: http://en.wikipedia.org/wiki/Grayscale
			ggrau = g*0.59
			bgrau = b*0.11
			schwarzweiss = rgrau + ggrau + bgrau 'einzelne Graustufen zusammenfügen
			grau = a*$1000000 + schwarzweiss*$10000 + schwarzweiss*$100 + schwarzweiss 'Graustufen wieder in das ARGB Format wandeln
			WritePixel (grauepixmap, i, j, grau)	'Pixel in neue Pixmap zeichenen
		Next
	Next
	SavePixmapPNG(grauepixmap, speicherort, 0) 'Neues Bild speichern
	UnlockImage bild
	UnlockImage grauesbild
	bild = Null 'Bild aus Speicher entfernen
	Return grauesbild
End Function

Das Bild wird Pixel für Pixel durchgegangen und dabei wird jeder einzelne Pixel in Graustufen konvertiert.
Zum Schluss wird die Pixmap als PNG gespeichert.

Ich hoffe, der Code ist halbwegs lesbar Very Happy

Neue Antwort erstellen


Übersicht BlitzMax, BlitzMax NG Beginners-Corner

Nach Oben

Gehe zu:

Powered by phpBB © 2001 - 2006, phpBB Group