**topcua** OPC Unified Architecture (OPC UA) is a machine to machine communication protocol for industrial automation developed by the OPC Foundation. Refer to https://en.wikipedia.org/wiki/OPC_Unified_Architecture for a detailed overview. A proof-of-concept extension called '''topcua''' provides a Tcl binding to a C based OPC UA implementation from https://open62541.org/ and can be found in https://www.androwish.org/index.html/dir?name=jni/topcua The code is very portable and might run on all Tcl supported platforms provided that the platform's C compiler supports C99. The source tree contains an example script implementing a webcam in a few lines of code. The most interesting piece is how variables/data/things can be mapped between Tcl and OPC/UA domains as shown in the '''_lastimg''' and '''_setparm''' procedures and how the corresponding items in the OPC/UA address space are created in the '''opcua add ...''' invocations. This allows to connect from an OPC/UA client tool like https://www.unified-automation.com/products/development-tools/uaexpert.html%|%UAExpert%|% or https://www.prosysopc.com/products/opc-ua-client%|%OPC UA Client%|% and to display the camera image. But be aware that this is early alpha quality stuff and may contain memory leaks and all other kinds of serious bugs. Although it might seem to be some kind of Tcl dream in Industry 4.0 and to have the theoretical capability of controlling drilling rigs, nuclear power plants, low earth orbital stations, and so on it is far from being complete, tested, verified, and certified. ====== # A little OPC/UA webcam in about 100 LOC # # Requires Linux, MacOSX, or FreeBSD, due to tcluvc support, # but can be easily modified for Windows to use tclwmf instead. package require Tk package require topcua package require tcluvc # hide Tk toplevel wm withdraw . # get first available camera set cam [lindex [uvc devices] 0] if {$cam eq {}} { puts stderr "no camera found" exit 1 } # open camera if {[catch {uvc open $cam capture} cam]} { puts stderr "open failed: $cam" exit 1 } # set format to 320x240 foreach {i fmt} [uvc listformats $cam] { if {[dict get $fmt "frame-size"] eq "320x240"} { uvc format $cam $i 1 break } } # photo image for capture set img [image create photo] # image capture callback proc capture {cam} { # limit frame rate, otherwise it consumes too much CPU for # image processing and the OPC/UA server part starves lassign [uvc counters $cam] all done dropped if {$all % 20 == 0} { uvc image $cam $::img set ::png [$::img data -format png] } } # create OPC/UA server opcua new server 4840 S # implementation of OPC/UA data sources namespace eval ::opcua::S { # data source callback proc _lastimg {node op {value {}}} { if {$op eq "read"} { return [list ByteString $::png] } # hey, this is a camera, not a screen return -code error "write shouldn't happen" } # data source callback proc _setparm {name node op {value {}}} { if {$op eq "read"} { array set p [uvc parameter $::cam] set v 0 if {[info exists p($name)]} { set v $p($name) } return [list Int32 $v] } set v [dict get $value "value"] catch {uvc parameter $::cam $name $v} return {} } } # create our namespace in OPC/UA land set ns [opcua add S Namespace LilWebCam] # get Objects folder set OF [lindex [opcua translate S [opcua root] / Objects] 0] # create an object in our namespace in Objects folder set obj [opcua add S Object "ns=$ns;s=LilWebCam" $OF Organizes "$ns:LilWebCam"] # create some variables in our folder to deal with camera settings set att [opcua attrs default VariableAttributes] dict set att dataType [opcua types nodeid Int32] dict set att accessLevel 3 ;# writable foreach name {brightness contrast gain gamma hue saturation} { opcua add S Variable "ns=$ns;s=[string totitle $name]" $obj HasComponent "$ns:[string totitle $name]" {} $att [list ::opcua::S::_setparm $name] } # get node identifier of Image data type, a subtype of ByteString set IT [lindex [opcua translate S [opcua root] / Types / DataTypes / BaseDataType / ByteString / Image] 0] # create variable in our folder to return last photo image set att [opcua attrs default VariableAttributes] dict set att dataType $IT ;# Image data type dict set att valueRank -1 ;# 1-dimensional array opcua add S Variable "ns=$ns;s=Image" $obj HasComponent "$ns:Image" {} $att ::opcua::S::_lastimg # start server using Tk's event loop opcua start S # start camera uvc start $cam ====== ****Exercises for the interested reader**** * make the camera using the tclwmf extension from http://www.androwish.org to run this on Windows * make the camera using the borg extension from http://www.androwish.org to run this on a tablet or smartphone * add more camera controls using appropriate mappings between tcluvc parameters and OPC/UA variables <>AndroWish