Platforms to show: All Mac Windows Linux Cross-Platform
/MacFrameworks/OpenCL/OpenCL Helper 18/OpenCL Helper 18
Required plugins for this example: MBS MacFrameworks Plugin, MBS Picture Plugin
You find this example project in your Plugins Download as a Xojo project file within the examples folder: /MacFrameworks/OpenCL/OpenCL Helper 18/OpenCL Helper 18
This example is the version from Mon, 5th May 2019.
Project "OpenCL Helper 18.xojo_binary_project"
Class App Inherits Application
Const kEditClear = "&Delete"
Const kFileQuit = "&Quit"
Const kFileQuitShortcut = ""
End Class
MenuBar MenuBar1
MenuItem FileMenu = "&File"
MenuItem FileQuit = "#App.kFileQuit"
MenuItem EditMenu = "&Edit"
MenuItem EditUndo = "&Undo"
MenuItem UntitledMenu1 = "-"
MenuItem EditCut = "Cu&t"
MenuItem EditCopy = "&Copy"
MenuItem EditPaste = "&Paste"
MenuItem EditClear = "#App.kEditClear"
MenuItem UntitledMenu0 = "-"
MenuItem EditSelectAll = "Select &All"
End MenuBar
Class Window1 Inherits Window
Control PushButton1 Inherits PushButton
ControlInstance PushButton1 Inherits PushButton
EventHandler Sub Action()
dim f as FolderItem = new FolderItem("Data")
dim ocl as OpenCL = new OpenCL
const RGBbytes = 3
// Input, use Picture.Open in newer REAL Studio versions
dim p1 as Picture = Picture.Open(f.Child("A.png"))
dim p2 as Picture = Picture.Open(f.Child("B.png"))
dim m1 as MemoryBlock = new MemoryBlock(p1.Width * p1.Height * RGBbytes)
call p1.CopyRGBtoMemoryblockMBS(m1, 0)
dim m2 as MemoryBlock = new MemoryBlock(p2.Width * p2.Height * RGBbytes)
call p2.CopyRGBtoMemoryblockMBS(m2, 0)
ocl.AppendInputMemoryBlock(m1)
ocl.AppendInputMemoryBlock(m2)
//
// Output
ocl.SetOutputMemorySize(p1.Width * p1.Height * RGBbytes)
//
// Program template
TextArea1.Text = ocl.OpenCLProgramTemplate // Copy this string and use it as a template for writing your OpenCL program in a text editor
// Program
f = new FolderItem("Programs")
f = f.Child("Blend.cl")
'dim tis as TextInputStream = TextInputStream.Open(f)
dim tis as TextInputStream = f.OpenAsTextFile
ocl.Source = tis.ReadAll
TextArea2.Text = ocl.Source
//
// Run
ocl.Run
// Results
dim p as Picture = MemoryblockRGBtoPictureMBS(ocl.OutputMemoryBlock, 0, p1.Width, p2.Width)
pic1 = p
Canvas1.Invalidate
End EventHandler
End Control
Control Canvas1 Inherits Canvas
ControlInstance Canvas1 Inherits Canvas
EventHandler Sub Paint(g As Graphics, areas() As REALbasic.Rect)
if pic1 <> nil then
g.DrawPicture pic1, 0, 0
end if
End EventHandler
End Control
Control PushButton2 Inherits PushButton
ControlInstance PushButton2 Inherits PushButton
EventHandler Sub Action()
dim f as FolderItem = new FolderItem("Data")
dim ocl as OpenCL = new OpenCL
const kOutputHeightWidth = 256
const RGBbytes = 3
// Input
dim p1 as Picture = f.Child("pattern_154.png").OpenAsPicture
'dim p1 as Picture = Picture.Open(f.Child("pattern_154.png")) // http://www.squidfingers.com/patterns/
dim m1 as MemoryBlock = new MemoryBlock(p1.Width * p1.Height * RGBbytes)
call p1.CopyRGBtoMemoryblockMBS(m1, 0)
ocl.AppendInputMemoryBlock(m1, "tile")
ocl.AppendInputInt32(p1.Width * RGBbytes, "tileWidth")
ocl.AppendInputInt32(p1.Height, "tileHeight")
ocl.AppendInputInt32(kOutputHeightWidth * RGBbytes, "outputWidth")
//
// Output
ocl.SetOutputMemorySize(kOutputHeightWidth * kOutputHeightWidth * RGBbytes)
//
// Program template
TextArea1.Text = ocl.OpenCLProgramTemplate // Copy this string and use it as a template for writing your OpenCL program in a text editor
// Program
f = new FolderItem("Programs")
f = f.Child("Tile.cl")
dim tis as TextInputStream = f.OpenAsTextFile
'dim tis as TextInputStream = TextInputStream.Open(f)
ocl.Source = tis.ReadAll
TextArea2.Text = ocl.Source
//
// Run
ocl.Run
// Results
dim p as Picture = MemoryblockRGBtoPictureMBS(ocl.OutputMemoryBlock, 0, kOutputHeightWidth, kOutputHeightWidth)
'Canvas2.Graphics.DrawPicture(p, 0, 0)
pic2 = p
canvas2.Invalidate
End EventHandler
End Control
Control Canvas2 Inherits Canvas
ControlInstance Canvas2 Inherits Canvas
EventHandler Sub Paint(g As Graphics, areas() As REALbasic.Rect)
if pic2 <> nil then
g.DrawPicture pic2, 0, 0
end if
End EventHandler
End Control
Control TextArea1 Inherits TextArea
ControlInstance TextArea1 Inherits TextArea
End Control
Control Label1 Inherits Label
ControlInstance Label1 Inherits Label
End Control
Control TextArea2 Inherits TextArea
ControlInstance TextArea2 Inherits TextArea
End Control
Control Label2 Inherits Label
ControlInstance Label2 Inherits Label
End Control
Control Canvas3 Inherits Canvas
ControlInstance Canvas3 Inherits Canvas
End Control
Property Pic1 As Picture
Property Pic2 As Picture
End Class
Class OpenCL
ComputedProperty OpenCLProgramTemplate As String
Sub Get()
// Copy the returned string and use it as a template for writing your OpenCL program in a text editor
dim s as String
dim i as Integer
s = "// See a quick reference for OpenCL language here: http://www.khronos.org/files/opencl-quick-reference-card.pdf" + EndOfLine + EndOfLine
// Function signature
s = s + "__kernel " + kDefaultKernelName + "("
for i = 0 to me.Input.Ubound
s = s + me.Input(i).GetParameterDeclaration + ","
next
s = s + me.Output.GetParameterDeclaration + " ) {" + EndOfLine
//
// Function block
s = s + " int i = get_global_id(0);" + EndOfLine
s = s + " if (i < outputCount) {" + EndOfLine
s = s + " output[i] = 0; // Do something interesting here!" + EndOfLine
s = s + " }" + EndOfLine
//
// End
s = s + "}" + EndOfLine
Return s
End Get
End ComputedProperty
ComputedProperty OutputMemoryBlock As MemoryBlock
Sub Get()
if me.Output = nil then Return nil
Return me.Output.Data
End Get
End ComputedProperty
Const kDefaultKernelName = "square"
Sub AppendInputInt32(value as Int32, parameterName as String = "")
dim o as OpenCLDataInt32 = new OpenCLDataInt32(value)
me.Input.Append(o)
if parameterName <> "" then
o.ParameterName = parameterName
else
// Assign a default name
o.ParameterName = "input" + Str(me.Input.Ubound + 1)
end
End Sub
Sub AppendInputMemoryBlock(mb as MemoryBlock, parameterName as String = "")
dim o as OpenCLDataMemoryBlock = new OpenCLDataMemoryBlock(mb, mb.Size)
me.Input.Append(o)
if parameterName <> "" then
o.ParameterName = parameterName
else
// Assign a default name
o.ParameterName = "input" + Str(me.Input.Ubound + 1)
end
End Sub
Sub Run()
dim i as Integer
dim devices(-1) as CLDeviceMBS = OpenCLMBS.AllDevices(CLDeviceMBS.kDeviceTypeGPU)
if devices.Ubound = -1 then Return
dim device as CLDeviceMBS = devices(0) // we use first one
dim context as new CLContextMBS(device, CLContextMBS.kErrorModeLogMessagesToSystemLog)
dim queue as new CLCommandQueueMBS(context, device, 0)
dim program as new CLProgramMBS(context, me.Source)
program.BuildProgram
if program.LastError <> 0 then
MsgBox "Error: Failed to build program executable" + EndOfLine + EndOfLine + Program.BuildLog(device)
Return
end if
// Create the compute kernel in the program we wish to run
dim kernel as new clKernelMBS(program, kDefaultKernelName)
// Create the input and output arrays in device memory for our calculation
'dim inputCL(-1) as CLMemMBS
for i = 0 to me.Input.Ubound
me.Input(i).CreateCLMemory(context, CLMEMMBS.kMemoryReadOnly)
next
me.Output.CreateCLMemory(context, CLMEMMBS.kMemoryWriteOnly)
//
// Write our data set into the input array in device memory
for i = 0 to me.Input.Ubound
me.Input(i).WriteCLMemory(queue)
next
// Set the arguments to our compute kernel
dim ii as Integer = 0
for i = 0 to me.Input.Ubound
ii = ii + me.Input(i).SetKernelArguments(kernel, ii)
next
ii = ii + me.Output.SetKernelArguments(kernel, ii)
// Get the maximum work-group size for executing the kernel on the device
dim maxWorkGroupCount as integer = kernel.GetKernelWorkGroupSize(Device)
// Execute the kernel over the entire range of the data set
queue.EnqueueNDRangeKernel(kernel, me.Output.DataCount, maxWorkGroupCount)
// Wait for the command queue to get serviced before reading back results
queue.finish
// Read the results from the device
queue.EnqueueReadBuffer(me.Output.DataCL, 0, me.Output.Data.Size, me.Output.Data)
// Clean up
for i = 0 to me.Input.Ubound
me.Input(i).ClearCLMemory
next
me.Output.ClearCLMemory
//
End Sub
Sub SetOutputMemory(mb as MemoryBlock)
me.Output = new OpenCLDataMemoryBlock(mb, mb.Size)
me.Output.ParameterName = "output"
End Sub
Sub SetOutputMemorySize(size as Integer)
dim mb as MemoryBlock = new MemoryBlock(size)
me.SetOutputMemory(mb)
End Sub
Property Private Input() As OpenCLData
Property Private Output As OpenCLDataMemoryBlock
Property Source As String
End Class
Class OpenCLData
Sub ClearCLMemory()
End Sub
Sub CreateCLMemory(context as CLContextMBS, flags as UInt64)
End Sub
Function GetParameterDeclaration() As String
End Function
Function SetKernelArguments(kernel as clKernelMBS, argumentOffset as Integer) As Integer
End Function
Sub WriteCLMemory(queue as CLCommandQueueMBS)
End Sub
Property ParameterName As String
End Class
Class OpenCLDataMemoryBlock Inherits OpenCLData
Sub ClearCLMemory()
me.DataCL = nil
End Sub
Sub Constructor(theData as MemoryBlock, theDataCount as Integer)
me.Data = theData
me.DataCount = theDataCount // Number of items in the memory block (i.e., number of bytes, number of ints, number of floats, etc. Not the same as MemoryBlock.Size if data is anything other than bytes.)
End Sub
Sub CreateCLMemory(context as CLContextMBS, flags as UInt64)
me.DataCL = new CLMemMBS(context, flags, me.Data.Size)
End Sub
Function GetParameterDeclaration() As String
Return " __global uchar* " + me.ParameterName + ", const unsigned int " + me.ParameterName + "Count"
End Function
Function SetKernelArguments(kernel as clKernelMBS, argumentOffset as Integer) As Integer
kernel.SetKernelArgMem(argumentOffset, me.DataCL) // Input data buffer
kernel.SetKernelArgInt32(argumentOffset + 1, me.DataCount) // Number of data items in buffer
Return 2
End Function
Sub WriteCLMemory(queue as CLCommandQueueMBS)
queue.EnqueueWriteBuffer(me.DataCL, 0, me.Data.Size, me.Data)
End Sub
Property Data As MemoryBlock
Property DataCL As CLMemMBS
Property DataCount As Integer
End Class
Class OpenCLDataInt32 Inherits OpenCLData
Sub Constructor(v as Int32)
me.Value = v
End Sub
Function GetParameterDeclaration() As String
Return " const unsigned int " + me.ParameterName
End Function
Function SetKernelArguments(kernel as clKernelMBS, argumentOffset as Integer) As Integer
kernel.SetKernelArgInt32(argumentOffset, me.Value)
Return 1
End Function
Property Value As Integer
End Class
End Project
See also:
The items on this page are in the following plugins: MBS MacFrameworks Plugin.
