I didn't seem to have any problems, aside from 'feature-creep' in my test code.
Here's a lengthier bit of test code (and not thoroughly tested nor necessarily complete but full of possibilities and certainly good enough):
Code: Select all
EnableExplicit
Global Window = OpenWindow(#PB_Any,0,0,300,350,"test")
Global Canvas = CanvasGadget(#PB_Any,0,0,300,350)
Procedure Endprogram()
End
EndProcedure
Structure color_RGBA
StructureUnion
c.l
s.RGBQUAD
EndStructureUnion
EndStructure
Structure color_RGBA_arr
arr.color_RGBA[0]
EndStructure
Structure image_pattern
*bitmap.color_RGBA_arr ;memory = w * ([A}[B][G][R]) * h;contains color pattern data
w.i ;width
h.i ;height
EndStructure
Structure filterPattern
*foreground.image_pattern
*background.image_pattern
foregroundTint.i
backgroundTint.i
EndStructure
Global filterPattern.filterPattern, *pattern_blank.image_pattern
Declare createPattern(w, h, imageNum, hasAlpha = #False)
Declare freePattern(*pattern.image_pattern)
Declare setFilterPattern(*foreground, *background, foregroundTint = #PB_Default, backgroundTint = #PB_Default)
;blank pattern
CreateImage(0, 2, 2, 32, #Black)
If StartDrawing(ImageOutput(0))
Box(0, 0, 2, 2)
StopDrawing()
*pattern_blank = createPattern(2, 2, 0, #True)
If *pattern_blank = #Null: End: EndIf
EndIf
Define.image_pattern *pattern_diagstripe, *pattern_checker, *pattern_spot
;create and return a image_pattern structure from an image
Procedure createPattern(w, h, imageNum, hasAlpha = #False)
Protected *bitmap.color_RGBA_arr, *pattern.image_pattern, x, y, pix
;it is possible to reuse an existing pattern structure
If *pattern = #Null
*pattern = AllocateStructure(image_pattern)
If *pattern = #Null
ProcedureReturn #False
EndIf
EndIf
If w = 0 And h = 0
ProcedureReturn #False ;error width and height must be > 0
EndIf
*pattern\w = w
*pattern\h = h
;check for reuse of pattern
If *pattern\bitmap And MemorySize(*pattern\bitmap) <> (*pattern\w * *pattern\h * SizeOf(RGBQUAD))
FreeMemory(*pattern\bitmap)
EndIf
*bitmap.color_RGBA_arr = AllocateMemory(*pattern\w * *pattern\h * SizeOf(RGBQUAD))
If *bitmap
If StartDrawing(ImageOutput(imageNum))
If hasAlpha
For x = 0 To *pattern\w - 1
For y = 0 To *pattern\h - 1
pix = Point(x, y)
*bitmap\arr[y * *pattern\w + x]\c = RGBA(Red(pix), Green(pix), Blue(pix), Alpha(pix))
Next
Next
Else
For x = 0 To *pattern\w - 1
For y = 0 To *pattern\h - 1
pix = Point(x, y)
*bitmap\arr[y * *pattern\w + x]\c = RGBA(Red(pix), Green(pix), Blue(pix), 255)
Next
Next
EndIf
StopDrawing()
EndIf
EndIf
*pattern\bitmap = *bitmap
ProcedureReturn *pattern
EndProcedure
;free memory used in image_pattern structure
Procedure freePattern(*pattern.image_pattern)
If *pattern
If *pattern\bitmap
FreeMemory(*pattern\bitmap)
EndIf
FreeStructure(*pattern)
*pattern = #Null
EndIf
EndProcedure
Procedure setFilterPattern(*foreground, *background, foregroundTint = #PB_Default, backgroundTint = #PB_Default)
If *foreground = #Null
filterPattern\foreground = *pattern_blank
Else
filterPattern\foreground = *foreground
EndIf
If foregroundTint = #PB_Default
filterPattern\foregroundTint = RGBA(255, 255, 255, 255)
ElseIf foregroundTint <> #PB_Ignore
filterPattern\foregroundTint = foregroundTint
EndIf
If *background = #Null
filterPattern\background = *pattern_blank
Else
filterPattern\background = *background
EndIf
If backgroundTint = #PB_Default
filterPattern\backgroundTint = RGBA(255, 255, 255, 255)
ElseIf backgroundTint <> #PB_Ignore
filterPattern\backgroundTint = backgroundTint
EndIf
EndProcedure
Procedure FilterCallback(x, y, SourceColor, TargetColor)
If Alpha(SourceColor) > 0
ProcedureReturn RGBA(Red(SourceColor), 0, Blue(SourceColor), Alpha(SourceColor))
Else
ProcedureReturn RGBA(Red(TargetColor), Green(TargetColor), Blue(TargetColor), Alpha(TargetColor))
EndIf
EndProcedure
Procedure FilterCallback_pattern(x, y, SourceColor, TargetColor)
If Alpha(SourceColor) > 0
With filterPattern\foreground
Sourcecolor = \bitmap\arr[(y % \h) * \w + (x % \w)]\c
EndWith
ProcedureReturn RGBA(Red(SourceColor) & Red(filterPattern\foregroundTint),
Green(SourceColor) & Green(filterPattern\foregroundTint),
Blue(SourceColor) & Blue(filterPattern\foregroundTint),
Alpha(SourceColor) & Alpha(filterPattern\foregroundTint))
Else
With filterPattern\background
TargetColor = \bitmap\arr[(y % \h) * \w + (x % \w)]\c
EndWith
ProcedureReturn RGBA(Red(TargetColor) & Red(filterPattern\backgroundTint),
Green(TargetColor) & Green(filterPattern\backgroundTint),
Blue(TargetColor) & Blue(filterPattern\backgroundTint),
Alpha(TargetColor) & Alpha(filterPattern\backgroundTint))
EndIf
EndProcedure
;checkered pattern
CreateImage(0, 2, 2, 32, #Black)
If StartDrawing(ImageOutput(0))
Plot(0, 0, #White)
Plot(1, 1, #White)
StopDrawing()
*pattern_checker = createPattern(2, 2, 0)
If *pattern_checker = #Null: End: EndIf
EndIf
;diagonal stripe pattern
CreateImage(0, 4, 4, 32, #Black)
If StartDrawing(ImageOutput(0))
Plot(2, 0, #White)
Plot(3, 1, #White)
Plot(0, 2, #White)
Plot(1, 3, #White)
StopDrawing()
*pattern_diagstripe = createPattern(4, 4, 0)
If *pattern_diagstripe = #Null: End: EndIf
EndIf
;spot pattern
CreateImage(0, 16, 16, 32, #Yellow)
If StartDrawing(ImageOutput(0))
Circle(0, 0, 3, RGB(10, 90, 128))
Circle(OutputWidth() - 1, 0, 3, RGB(10, 90, 128))
Circle(0, OutputHeight() - 1, 3, RGB(10, 90, 128))
Circle(OutputWidth() - 1, OutputHeight() - 1, 3, RGB(10, 90, 128))
Circle(OutputWidth() / 2 - 1, OutputHeight() / 2 - 1, 5, RGB(10, 90, 128))
StopDrawing()
*pattern_spot = createPattern(ImageWidth(0), ImageHeight(0), 0)
If *pattern_spot = #Null: End: EndIf
EndIf
LoadFont(0, "Times New Roman", 100)
LoadFont(1, "Times New Roman", 48)
StartDrawing(CanvasOutput(Canvas))
DrawingMode(#PB_2DDrawing_CustomFilter)
DrawingFont(FontID(0))
setFilterPattern(*pattern_checker, *pattern_spot, RGB(255, 0, 255), RGB(128, 128, 128))
CustomFilterCallback(@FilterCallback_pattern())
DrawText(0, 0, "Hello")
setFilterPattern(*pattern_diagstripe, *pattern_blank, RGB(0, 255, 0))
Box(0, TextHeight("Hello") - 5, TextWidth("Hello"), 10)
DrawingFont(FontID(1))
setFilterPattern(*pattern_spot, *pattern_checker, #PB_Default, RGB(200, 255, 200))
DrawText(0, 200, "123456789", RGBA(0, 255, 0, 15), RGBA(0, 0, 0, 255))
StopDrawing()
BindEvent(#PB_Event_CloseWindow,@Endprogram())
Repeat:WaitWindowEvent():ForEver