Added texture count

Added dynamic grid to ImagePAZ
Added new 1.16 textures

MCPACLib/Default/MapColors.json

@@ -1,4 +1,10 @@
 [
+  {
+    "ID": 0,
+    "ID_str": "NONE",
+    "Color": "Transparent",
+    "Full": "Air, Void Air, Cave Air, Barrier, Redstone Lamp, Cake, Powered Rail, Detector Rail, Torch, Redstone Wire, Ladder, Rail, Lever, Redstone Torch, Buttons, Repeater, Tripwire Hook, Tripwire, Flower Pot, Head, Comparator, Activator Rail, End Rod, Glass, Glass Pane, Nether Portal, Stained Glass Pane (all colors), Structure Void, Iron Bars, Soul Fire Torch, Chain"
+  },
   {
     "ID": 1,
     "ID_str": "GRASS",

MCPACLib/Helpers/Configuration.vb

@@ -6,6 +6,8 @@ Namespace Helpers
 		Public Shared Config As New ConfigType With {.BlacklistMC = New HashSet(Of String), .ColorToBlock = New Dictionary(Of Integer, String)}
 		Const ConfigFile As String = "Settings.json"
 
+		Public Shared Property TempFolder As String = Path.Combine(FileIO.SpecialDirectories.Temp, "MCPAC")
+
 		Public Shared Sub LoadConfig()
 			If Not File.Exists(ConfigFile) Then Exit Sub
 			Config = JsonConvert.DeserializeObject(Of ConfigType)(File.ReadAllText(ConfigFile))

MCPACLib/Helpers/Extensions.vb

@@ -28,11 +28,34 @@ Public Module Extensions
 		Return New PointF(CSng(p.X * n), CSng(p.Y * n))
 	End Function
 
+	<Extension>
+	Public Sub Save(bitmap As BitmapImage, path As String)
+		Dim Encoder = New PngBitmapEncoder()
+		Encoder.Frames.Add(BitmapFrame.Create(bitmap))
+		Using fileStream = New FileStream(path, FileMode.Create)
+			Encoder.Save(fileStream)
+		End Using
+	End Sub
+
 	<Extension>
 	Public Function Substract(p1 As Point, p2 As Point) As Point
 		Return New Point(p1.X - p2.X, p1.Y - p2.X)
 	End Function
 
+	<Extension>
+	Public Function ToBitmapImage(bitmap As Bitmap) As BitmapImage
+		Using memory = New MemoryStream()
+			bitmap.Save(memory, ImageFormat.Png)
+			memory.Position = 0
+			Dim BitmapImage = New BitmapImage()
+			BitmapImage.BeginInit()
+			BitmapImage.StreamSource = memory
+			BitmapImage.CacheOption = BitmapCacheOption.OnLoad
+			BitmapImage.EndInit()
+			Return BitmapImage
+		End Using
+	End Function
+
 	<Extension>
 	Public Function ToByte(val As Integer) As Byte
 		If val > Byte.MaxValue Then
@@ -49,20 +72,6 @@ Public Module Extensions
 		Return CInt(val).ToByte
 	End Function
 
-	<Extension>
-	Public Function ToBitmapImage(bitmap As Bitmap) As BitmapImage
-		Using memory = New MemoryStream()
-			bitmap.Save(memory, ImageFormat.Bmp)
-			memory.Position = 0
-			Dim BitmapImage = New BitmapImage()
-			BitmapImage.BeginInit()
-			BitmapImage.StreamSource = memory
-			BitmapImage.CacheOption = BitmapCacheOption.OnLoad
-			BitmapImage.EndInit()
-			Return BitmapImage
-		End Using
-	End Function
-
 	'Public Function BitmapImage2Bitmap(bitmapImage As BitmapImage) As Bitmap
 	'	Return New Bitmap(bitmapImage.StreamSource)
 	'End Function

MCPACLib/Helpers/FSDither.vb

@@ -22,9 +22,11 @@ Namespace Helpers
 			For Each P In Proportions
 				If 0 <= x + P.x AndAlso x + P.x <= image.Width - 1 AndAlso y + P.y <= image.Height - 1 Then
 					nPixel = image.GetPixel(x + P.x, y + P.y)
-					Dim newPixel = Color.FromArgb((nPixel.R + diffR * P.p).ToByte,
-												  (nPixel.G + diffG * P.p).ToByte,
-												  (nPixel.B + diffB * P.p).ToByte)
+					Dim newPixel = Color.FromArgb(
+						(nPixel.A),
+						(nPixel.R + diffR * P.p).ToByte,
+						(nPixel.G + diffG * P.p).ToByte,
+						(nPixel.B + diffB * P.p).ToByte)
 					image.SetPixel(x + P.x, y + P.y, newPixel)
 				End If
 			Next
@@ -38,9 +40,11 @@ Namespace Helpers
 			For Each P In Proportions
 				If 0 <= x + P.x AndAlso x + P.x <= image.Width - 1 AndAlso y + P.y <= image.Height - 1 Then
 					nPixel = image.GetPixel(x + P.x, y + P.y)
-					Dim newPixel = Color.FromArgb((nPixel.R + diffR * P.p).ToByte,
-												  (nPixel.G + diffG * P.p).ToByte,
-												  (nPixel.B + diffB * P.p).ToByte)
+					Dim newPixel = Color.FromArgb(
+						(nPixel.A),
+						(nPixel.R + diffR * P.p).ToByte,
+						(nPixel.G + diffG * P.p).ToByte,
+						(nPixel.B + diffB * P.p).ToByte)
 					image.SetPixel(x + P.x, y + P.y, newPixel)
 				End If
 			Next

MCPACLib/Helpers/MapColorsCollection.vb

@@ -11,40 +11,21 @@ Namespace Helpers
 	Public NotInheritable Class MapColorsCollection
 		Public Shared MapBaseColors As List(Of MapBaseColor)
 		Public Shared MapColorsFull As New List(Of MapColor)
-		Private Shared MapColors As New List(Of MapColor)
-		Private Shared DefaultCache As New Dictionary(Of Color, Integer)
-
-		Private Shared Converter As New Conversion.ColourfulConverter
-		Private Shared Comparer As New Difference.CIEDE2000ColorDifference
+		Private Shared ColorNone As MapColor
 		Private Shared ColorCache As New Dictionary(Of Color, Integer)
-		Public Shared Property LabMode As Boolean = False
-		Public Shared Property ColorTypes As MapColor.Type() = {MapColor.Type.Normal}
+		Private Shared Comparer As New Difference.CIEDE2000ColorDifference
+		Private Shared Converter As New Conversion.ColourfulConverter
+		Private Shared DefaultCache As New Dictionary(Of Color, Integer)
+		Private Shared MapColors As New List(Of MapColor)
 
 		Public Shared ReadOnly Property Palette As List(Of Color)
 			Get
 				Return DefaultCache.Keys.ToList
 			End Get
 		End Property
 
-		''' <summary>
-		''' Loads config from folder and converts colors to Lab
-		''' </summary>
-		''' <param name="folder">Folder with config</param>
-		Public Shared Sub Load(Optional folder As String = "Default")
-			Dim config = Path.GetFullPath(folder + Path.DirectorySeparatorChar + "MapColors.json")
-			If Not File.Exists(config) Then
-				ShowError(String.Format("Can't find {0}", config))
-				Exit Sub
-			End If
-			MapBaseColors = JsonConvert.DeserializeObject(Of List(Of MapBaseColor))(File.ReadAllText(config))
-			For Each MC In MapBaseColors
-				MapColorsFull.Add(New MapColor(MC, MapColor.Type.Down))
-				MapColorsFull.Add(New MapColor(MC, MapColor.Type.Normal))
-				MapColorsFull.Add(New MapColor(MC, MapColor.Type.Up)) 'Same as base color
-				MapColorsFull.Add(New MapColor(MC, MapColor.Type.Dark))
-			Next
-			CheckConfig()
-		End Sub
+		Public Shared Property ColorTypes As MapColor.Type() = {MapColor.Type.Up}
+		Public Shared Property LabMode As Boolean = False
 
 		Public Shared Sub CheckConfig()
 			LabMode = Config.LabMode
@@ -53,23 +34,16 @@ Namespace Helpers
 				If Config.BlacklistMC.Contains(MC.ID_str) OrElse Not ColorTypes.Contains(MC.TypeT) Then Continue For
 				MapColors.Add(MC)
 			Next
-			ColorCache.Clear()
 			CreateCache()
 		End Sub
 
-		Private Shared Sub CreateCache()
-			DefaultCache.Clear()
-			For Each color In MapColors
-				DefaultCache.Add(color.Color, color.ID_map)
-			Next
-		End Sub
-
 		''' <summary>
 		''' Returns closest color
 		''' </summary>
 		''' <param name="color">Color to search</param>
 		''' <returns>Closest color</returns>
 		Public Shared Function GetClosest(color As Color) As MapColor
+			If color.A < 256 / 2 Then Return ColorNone
 			Dim id As Integer
 			If ColorCache.TryGetValue(color, id) Then Return MapColors(id)
 			If LabMode Then
@@ -80,6 +54,37 @@ Namespace Helpers
 			If Not ColorCache.ContainsKey(color) Then ColorCache.Add(color, id)
 		End Function
 
+		''' <summary>
+		''' Loads config from folder and converts colors to Lab
+		''' </summary>
+		''' <param name="folder">Folder with config</param>
+		Public Shared Sub Load(Optional folder As String = "Default")
+			Dim config = Path.GetFullPath(folder + Path.DirectorySeparatorChar + "MapColors.json")
+			If Not File.Exists(config) Then
+				ShowError($"Can't find {config}")
+				Exit Sub
+			End If
+			MapBaseColors = JsonConvert.DeserializeObject(Of List(Of MapBaseColor))(File.ReadAllText(config))
+			ColorNone = New MapColor(MapBaseColors(0), MapColor.Type.Up)
+			MapBaseColors.RemoveAt(0)
+			For Each MC In MapBaseColors
+				MapColorsFull.Add(New MapColor(MC, MapColor.Type.Down))
+				MapColorsFull.Add(New MapColor(MC, MapColor.Type.Normal))
+				MapColorsFull.Add(New MapColor(MC, MapColor.Type.Up)) 'Same as base color
+				MapColorsFull.Add(New MapColor(MC, MapColor.Type.Dark))
+			Next
+			CheckConfig()
+		End Sub
+
+		Private Shared Sub CreateCache()
+			DefaultCache.Clear()
+			ColorCache.Clear()
+			For Each color In MapColors
+				DefaultCache.Add(color.Color, color.ID_map)
+				'ColorCache.Add(color.Color, color.ID_map)
+			Next
+		End Sub
+
 		Private Shared Function FindClosest(color As Color, ByRef id As Integer) As MapColor
 			Dim Closest As MapColor = Nothing
 			Dim min, diff As Double

MCPACLib/Helpers/MapResultCreator.vb

@@ -1,4 +1,6 @@
 Imports System.Drawing
+Imports System.Windows.Media
+Imports System.Windows.Media.Imaging
 Imports MCPACLib.Data
 Imports MCPACLib.Data.SPQ
 Imports MCPACLib.Helpers.Configuration
@@ -37,7 +39,6 @@ Namespace Helpers
 									token.ThrowIfCancellationRequested()
 								End If
 								Dim sPixel = InImage.GetPixel(x, y)
-								If sPixel.A < 256 / 2 Then Continue For
 								closest = MapColorsCollection.GetClosest(sPixel)
 
 								If Config.Dither Then
@@ -82,6 +83,35 @@ Namespace Helpers
 			End Function)
 		End Function
 
+		<Obsolete>
+		Public Shared Function CreateTextureImageWPF(map As MapResult) As BitmapSource
+			Dim w = map.Width
+			Dim h = map.Height
+			'Return Await Task.Run(
+			'Function()
+			Dim WB = New WriteableBitmap(w * 16, h * 16, 96, 96, PixelFormats.Pbgra32, Nothing)
+			Dim DV = New DrawingVisual()
+			Dim DrawingContext = DV.RenderOpen()
+			For y = 0 To h - 1
+				For x = 0 To w - 1
+					Dim Texture = TexturesCollection.ItemTex(map(x, y).ID)
+					If IsNothing(Texture) Then
+						Dim c = map(x, y).Color
+						Dim b = New SolidColorBrush(Windows.Media.Color.FromRgb(c.R, c.G, c.B))
+						DrawingContext.DrawRectangle(b, New Windows.Media.Pen(b, 4), New Windows.Rect(x * 16, y * 16, 16, 16))
+					Else
+						DrawingContext.DrawImage(Texture.Image, New Windows.Rect(x * 16, y * 16, 16, 16))
+					End If
+				Next
+			Next
+			DrawingContext.Close()
+			Dim bmp = New RenderTargetBitmap(w * 16, h * 16, 96, 96, PixelFormats.Pbgra32)
+			bmp.Render(DV)
+			Return bmp
+			'End Function)
+		End Function
+
+		<Obsolete>
 		Private Shared Async Function Quantize(img As Image) As Task(Of Image)
 			Dim targetImage As Image = Nothing
 			Dim sourceImage = img

MCPACLib/Helpers/TexturesCollection.vb

@@ -7,26 +7,48 @@ Imports MCPACLib.Helpers.Configuration
 Namespace Helpers
 	Public Class TexturesCollection
 		Public Shared Selections As New List(Of TextureSelection)
-		Private Shared EmptyImage As New Bitmap(16, 16)
-		Private Shared Textures As Dictionary(Of Integer, Image)
+
+		'Private Shared EmptyImage As New Bitmap(16, 16)
+		'Private Shared Images As Dictionary(Of Integer, Image)
+
+		'Private Shared ImagesWPF As Dictionary(Of Integer, BitmapImage)
+		Private Shared Textures As Dictionary(Of Integer, Texture)
 
 		Shared Sub New()
 
 		End Sub
 
 		Public Shared ReadOnly Property Item(id As Integer) As Image
 			Get
-				Return If(Textures.ContainsKey(id), Textures(id), Nothing) 'EmptyImage)
+				Return If(Textures.ContainsKey(id), Textures(id).Img, Nothing) 'EmptyImage)
+			End Get
+		End Property
+
+		Public Shared ReadOnly Property ItemWPF(id As Integer) As BitmapImage
+			Get
+				Return If(Textures.ContainsKey(id), Textures(id).Image, Nothing)
+			End Get
+		End Property
+
+		Public Shared ReadOnly Property ItemTex(id As Integer) As Texture
+			Get
+				Return If(Textures.ContainsKey(id), Textures(id), Nothing)
 			End Get
 		End Property
 
 		Public Shared Sub CheckConfig()
-			Textures = Selections.ToDictionary(Function(x) x.ID, Function(x) x.List.First.Img)
+			'Images = Selections.ToDictionary(Function(x) x.ID, Function(x) x.List.First.Img)
+			'ImagesWPF = Selections.ToDictionary(Function(x) x.ID, Function(x) x.List.First.Image)
+			Textures = Selections.ToDictionary(Function(x) x.ID, Function(x) x.List.First)
 			If Config.ColorToBlock.Count > 0 Then
-				Dim ImageDict = Selections.SelectMany(Function(x) x.List).ToDictionary(Function(x) x.Filename, Function(x) x.Img)
+				'Dim ImageDict = Selections.SelectMany(Function(x) x.List).ToDictionary(Function(x) x.Filename, Function(x) x.Img)
+				'Dim ImageDictWPF = Selections.SelectMany(Function(x) x.List).ToDictionary(Function(x) x.Filename, Function(x) x.Image)
+				Dim TextureDict = Selections.SelectMany(Function(x) x.List).ToDictionary(Function(x) x.Filename, Function(x) x)
 				For Each CBT In Config.ColorToBlock
-					If Textures.ContainsKey(CBT.Key) AndAlso ImageDict.ContainsKey(CBT.Value) Then
-						Textures(CBT.Key) = ImageDict(CBT.Value)
+					If Textures.ContainsKey(CBT.Key) AndAlso TextureDict.ContainsKey(CBT.Value) Then
+						'Images(CBT.Key) = ImageDict(CBT.Value)
+						'ImagesWPF(CBT.Key) = ImageDictWPF(CBT.Value)
+						Textures(CBT.Key) = TextureDict(CBT.Value)
 					End If
 				Next
 			End If

MCPACLib/Locales/MyStrings.resx

@@ -141,4 +141,13 @@
   <data name="T_Textures" xml:space="preserve">
     <value>Textures</value>
   </data>
+  <data name="CB_ShowGrid" xml:space="preserve">
+    <value>Grid</value>
+  </data>
+  <data name="T_TexCr" xml:space="preserve">
+    <value>Creating image</value>
+  </data>
+  <data name="T_TexCrErr" xml:space="preserve">
+    <value>Error creating image (Image too large)</value>
+  </data>
 </root>