http://www.purebasic.com
https://www.purebasic.fr/english/
I found it already difficult to follow my own code from a year agoBasicallyPure wrote:I'm hoping you can come up with a fix for this problem.
I've tried looking at the code but it's just too deep for me to follow.
it will need to write note about you in my "finale title" twice ) i know you are our man )) my software for edit console's game too - but SMD, not NES. but main idea i am get from that and apply. thanks a lot If the array consists of 16 values of the type Long, you can use CatchPalette.SeregaZ wrote:i have array with 16 colors. can it have some:
NearestColor::SetPaletteFromArray(Arrayname(), colorscount)
i am make like you say. result is very nice. help with this question. (a lot of unanderstandible text) how to get all coordinates of FillArea command for correct writing it in a array?Code: Select all
Structure colorarraystr
Array Y.u(5)
EndStructure
Global Dim ColorCoordX.colorarraystr(5)
ColorCoordX(0)\Y(0) = 1
ColorCoordX(1)\Y(0) = 1
ColorCoordX(2)\Y(0) = 1
ColorCoordX(3)\Y(0) = 1
ColorCoordX(4)\Y(0) = 1
ColorCoordX(5)\Y(0) = 1
ColorCoordX(0)\Y(1) = 1
ColorCoordX(1)\Y(1) = 2
ColorCoordX(2)\Y(1) = 2
ColorCoordX(3)\Y(1) = 2
ColorCoordX(4)\Y(1) = 2
ColorCoordX(5)\Y(1) = 2 ; test overlimit
ColorCoordX(0)\Y(2) = 1
ColorCoordX(1)\Y(2) = 2
ColorCoordX(2)\Y(2) = 1
ColorCoordX(3)\Y(2) = 2
ColorCoordX(4)\Y(2) = 1
ColorCoordX(5)\Y(2) = 1
ColorCoordX(0)\Y(3) = 1
ColorCoordX(1)\Y(3) = 2
ColorCoordX(2)\Y(3) = 1
ColorCoordX(3)\Y(3) = 2
ColorCoordX(4)\Y(3) = 1
ColorCoordX(5)\Y(3) = 1
ColorCoordX(0)\Y(4) = 1
ColorCoordX(1)\Y(4) = 2
ColorCoordX(2)\Y(4) = 2
ColorCoordX(3)\Y(4) = 1
ColorCoordX(4)\Y(4) = 2
ColorCoordX(5)\Y(4) = 1
ColorCoordX(0)\Y(5) = 1
ColorCoordX(1)\Y(5) = 2 ; test overlimit
ColorCoordX(2)\Y(5) = 1
ColorCoordX(3)\Y(5) = 1
ColorCoordX(4)\Y(5) = 1
ColorCoordX(5)\Y(5) = 1
Procedure ShowImage()
tmp$ = ""
For y = 0 To 5
For x = 0 To 5
tmp$ + Str(ColorCoordX(x)\Y(y)) + " "
Next
tmp$ + Chr(10)
Next
Debug tmp$
EndProcedure
ShowImage()
Procedure FillAreaArray(x.a, y.a, newcolor.a, oldcolor=-1)
If oldcolor = -1
oldcolor = ColorCoordX(x)\Y(y)
EndIf
If ColorCoordX(x)\Y(y) = oldcolor
ColorCoordX(x)\Y(y) = newcolor
If y-1 > -1
If ColorCoordX(x)\Y(y-1) = oldcolor
FillAreaArray(x, y-1, newcolor, oldcolor)
EndIf
EndIf
If y+1 <= ArraySize(ColorCoordX(x)\Y())
If ColorCoordX(x)\Y(y+1) = oldcolor
FillAreaArray(x, y+1, newcolor, oldcolor)
EndIf
EndIf
If x-1 > -1
If ColorCoordX(x-1)\Y(y) = oldcolor
FillAreaArray(x-1, y, newcolor, oldcolor)
EndIf
EndIf
If x+1 <= ArraySize(ColorCoordX())
If ColorCoordX(x+1)\Y(y) = oldcolor
FillAreaArray(x+1, y, newcolor, oldcolor)
EndIf
EndIf
EndIf
EndProcedure
FillAreaArray(1, 2, 3)
ShowImage()Code: Select all
;{
Global Dim FullPalette.l(513)
Dim col.a(8)
col(1) = 0
col(2) = 36
col(3) = 72
col(4) = 109
col(5) = 145
col(6) = 181
col(7) = 219
col(8) = 255
x = 0
y = 0
If CreateImage(0, 256, 32)
If StartDrawing(ImageOutput(0))
For i = 1 To 8
For l = 1 To 8
For k = 1 To 8
Box(x,y,4,4, RGB(col(k),col(l),col(i)))
num + 1
FullPalette(num) = RGB(col(k),col(l),col(i))
x + 4
Next
x - 32
y + 4
Next
x + 32
y - 32
Next
StopDrawing()
EndIf
EndIf ;}
;{
Global Dim Palette.l(1)
Global Dim IndexG.l(255)
EnableASM
CompilerIf #PB_Compiler_Processor = #PB_Processor_x86
Macro rdx : edx : EndMacro
CompilerEndIf
Macro M_FindNearest(i, st)
!nearestcolor.findnearest#i#_loop:
!mov ecx, [p.v_c#i#]
!test ecx, ecx
!jz nearestcolor.findnearest#i#_cont2
!movzx eax, byte [p.v_Color + 1]
!movzx ecx, ch
!sub eax, ecx
!imul eax, eax
!shl eax, 11
!cmp eax, [p.v_bestd]
!jnc nearestcolor.findnearest#i#_cont1
!mov [p.v_d], eax
!movzx eax, byte [p.v_Color]
!movzx ecx, byte [p.v_c#i#]
!lea edx, [eax + ecx] ; edx = rsum
!sub eax, ecx
!imul eax, eax ; eax = r*r
!lea ecx, [edx + 0x400] ; ecx = $400 + rsum
!imul eax, ecx ; eax = ($400+rsum)*r*r
!add [p.v_d], eax
!movzx eax, byte [p.v_Color + 2]
!movzx ecx, byte [p.v_c#i# + 2]
!sub eax, ecx
!imul eax, eax ; eax = b*b
!neg edx
!add edx, 0x5fe ; edx = $5fe - rsum
!imul eax, edx ; eax = ($5fe-rsum)*b*b
!add eax, [p.v_d]
!cmp eax, [p.v_bestd]
!jnc nearestcolor.findnearest#i#_cont0
!mov [p.v_bestd], eax
!mov eax, [p.v_c#i#]
!mov [p.v_c], eax
!nearestcolor.findnearest#i#_cont0:
mov rdx, *p#i
add rdx, st
mov *p#i, rdx
mov eax, [rdx]
!mov [p.v_c#i#], eax
CompilerIf i = 1
!jmp nearestcolor.findnearest0_loop
CompilerElse
!jmp nearestcolor.findnearest1_loop
CompilerEndIf
!nearestcolor.findnearest#i#_cont1:
!mov dword [p.v_c#i#], 0
!nearestcolor.findnearest#i#_cont2:
CompilerIf i = 1
!cmp dword [p.v_c0], 0
!jnz nearestcolor.findnearest0_loop
CompilerEndIf
EndMacro
Procedure.l FindNearest(Color.l)
; Find the nearest color
Protected.l c, c0, c1, d, bestd = $12000000
Protected.Long *p0, *p1
!movzx eax, byte [p.v_Color + 1]
!mov [p.v_d], eax
*p1 = @Palette(IndexG(d)) : *p0 = *p1 - 4
c0 = *p0\l : c1 = *p1\l
M_FindNearest(0, -4)
M_FindNearest(1, 4)
ProcedureReturn c
EndProcedure
Procedure CatchPalette(*MemoryAddress.Long, NumColors.i)
; Catch a palette from memory
Protected.i i, j = 1, t
ReDim Palette(NumColors + 1)
Palette(0) = 0 : Palette(NumColors + 1) = 0
For i = 1 To NumColors
Palette(i) = $ff000000 | *MemoryAddress\l
Debug Hex(Palette(i))
*MemoryAddress + 4
Next
SortStructuredArray(Palette(), 0, 0, #PB_Unicode, 1, NumColors)
For i = 0 To 255
IndexG(i) = j
While ((Palette(j) >> 8) & $ff) = i And j < NumColors
j + 1
Wend
IndexG(i) = (IndexG(i) + j) >> 1
Next
EndProcedure
DisableASM
;}
; fill 1 to palette. 1 like marker, says this slot is empty.
Dim ColorArr(16)
For i = 1 To 15
ColorArr(i) = 1
Next
color.i
If LoadImage(1, "AC-130.bmp")
SetClipboardImage(1)
EndIf
If GetClipboardImage(1, 32)
CatchPalette(@FullPalette(), 513) ; accessible colors
If OpenWindow(0, 100, 200, 500, 360, "PureBasic Window", #PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget)
ImageGadget(10, 10, 10, 96, 56, ImageID(1))
; get first 15 colors. (0 color is purple for transparent)
If StartDrawing(ImageOutput(1))
y = 0
While y < 56
x = 0
While x < 96
bingo = 0
color = Point(x, y)
color = FindNearest(color)
For i = 1 To 15
If ColorArr(i) = color
; already have this color in a palette
bingo = 1
Break
EndIf
Next
If bingo = 0
For i = 1 To 15
If ColorArr(i) = 1
; this slot is empty
ColorArr(i) = color
bingo = 1
Debug "catch some color " + Str(color)
Break
EndIf
Next
If bingo = 0
Debug "all passible colors is catch, ignore others"
Break
EndIf
EndIf
x + 1
Wend
y + 1
Wend
StopDrawing()
EndIf
; create some palette images and gadgets for show
For i = 0 To 15
CreateImage(100 + i, 20, 20, 32, ColorArr(i))
ImageGadget(12 + i, 20 + i * 21, 150, 20, 20, ImageID(100+i))
Next
CopyImage(1, 2)
; now catch from 16 colors
CatchPalette(@ColorArr(), 16)
; repaint with 16 colors
If StartDrawing(ImageOutput(2))
y = 0
While y < 56
x = 0
While x < 96
Plot(x, y, FindNearest(Point(x, y)))
x + 1
Wend
y + 1
Wend
StopDrawing()
EndIf
ImageGadget(11, 10, 70, 96, 56, ImageID(2))
Repeat
Event = WaitWindowEvent()
If Event = #PB_Event_CloseWindow ; If the user has pressed on the close button
Quit = 1
EndIf
Until Quit = 1
EndIf
EndIf
End
Code: Select all
If StartDrawing(ImageOutput(#GFXEditorMAINEditImage))
; for this box need to set untransparent marker. how to make it?
Box(CurIconx8X*5, CurIconx8Y*5, 5, 5, ColorArr(palitranum)\colornum[IcEdColor-1])
StopDrawing()
If StartDrawing(CanvasOutput(#GFXEditorMAINEditGad))
Box(0, 0, 160, 160, ColorArr(palitranum)\colornum[0])
GFXGridLines()
DrawAlphaImage(ImageID(#GFXEditorMAINEditImage), 0, 0)
StopDrawing()
EndIf
EndIf 
and when i am move image on canvas - it shows image only that place, where no transparent. all another place of image is not show image.