Create New Commands in Tcl

2023-10-13 12:49:46

Create New Commands in Tcl

摘要Abstract：Tcl/Tk脚本可以很容易实现用户自定义的命令，方便的创建图形化的用户界面GUI，所以Tcl和Tk的应用领域几乎覆盖了图形和工程应用的全部范围，包括计算机辅助设计、软件开发、测试、仪器控制、科学可视化及多媒体方面。本文主要详解如何在C程序中使用Tcl来创建自定义的命令，并理解OpenCascade的Draw Test Harness的实现。

关键字Key Words：OpenCascade, Tcl/Tk, Draw Test Harness, Software Customization

一、引言 Introduction

Tcl是”Tool Command Language”，和Python、Perl、Lua等一样也是一种脚本语言。利用Tcl可以很容易实现自定义的命令，利用Tk可以很方便地创建出跨平台的用户界面UI。因Tcl/Tk功能强大，跨平台便于移植，且是开源免费的，所以在OpenCascade中就利用这个库来实现了测试程序Draw Test Harness，并且也利用Tcl实现了自动化测试。

因为Tcl是解析语言，所以Tcl可用来做为程序中的二次开发语言。因为修改Tcl的脚本不需要重新编译链接，只需要重新加载下，加快开发速度。

通过在Tcl中实现自定义的命令，来理解OpenCascade中Draw Test Harness的实现，并去感受Tcl的强大功能。

Figure 1.1 Draw Test Harness with Tcl/Tk

二、Tcl/Tk应用 OpenCascade Draw Test Harness

在Draw Test Harness中输入自定义的命令就可以对相应的建模造型程序进行检验。理解其实现方法，也可以加深对OpenCascade的其他模块的理解。如下图所示为自定义命令：

Figure 2.1 User defined command in Draw Test Harness

Figure 2.2 Command result in Test3d view

可以结合《OpenCascade Test Harness User’s Guide》来试试Draw Test Harness，如果将命令做在自己的程序中，就可以实现脚本建模啦。

Draw Test Harness中的命令都是用Tcl/Tk来实现的，下面通过一个简单的示例来说明如何在Tcl中实现自定义的命令。学会Tcl脚本应该也是掌握了一种强大的脚本工具，可以为自己的程序实现二次开发功能。

三、程序示例 Example Code

在Tcl中实现自定义命令很方便，只需要按Tcl的格式定义一个命令函数。基于对象的命令函数的声明如下：

typedef int (Tcl_ObjCmdProc) _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, int objc, struct Tcl_Obj * CONST * objv));

为了能在Tcl中调用一个命令函数，必须先调用Tcl_CreateObjCommand注册它，格式如下所示：

EXTERN Tcl_Command Tcl_CreateObjCommand (Tcl_Interp * interp, CONST char * cmdName, Tcl_ObjCmdProc * proc, ClientData clientData, Tcl_CmdDeleteProc * deleteProc);

这就是把Tcl中的字符串与实现它的C函数关联起来“魔术”。一个完整的程序如下所示，程序实现了两个自定义的命令randomcmd和equalcmd，分别用来生成一个随机数和相等判断：

/*
*    Copyright (c) 2014 eryar All Rights Reserved.
*
*           File : Main.cpp
*         Author : eryar@163.com
*           Date : 2014-01-09 18:58
*        Version : 1.0v
*
*    Description : Create new command for Tcl in C. Refer to
*                  1. Tcl and Tk Toolkit
*                  2. Practical Programming in Tcl and Tk
*
*      Key Words : Tcl/Tk, C Interface, New Command
*                  
*/

#include <tcl.h>
#include <stdlib.h>
#include <string.h>

#pragma comment(lib, "tcl85.lib")


/*
* @breif Definitions for application-specific command procedures.
*/
int RandomCmd(ClientData clientData, Tcl_Interp* interp, int objc, Tcl_Obj *CONST objv[])
{
    if (objc != 2)
    {
        Tcl_WrongNumArgs(interp, 1, objv, "?range");
        return TCL_ERROR;
    }

    int limit = 0;
    Tcl_Obj* result = NULL;

    Tcl_GetIntFromObj(interp, objv[1], &limit);

    result = Tcl_NewIntObj(rand() % limit);

    Tcl_SetObjResult(interp, result);

    return TCL_OK;
}


int EqualCmd(ClientData clientData, Tcl_Interp* interp, int objc, Tcl_Obj *CONST objv[])
{
    if (objc != 3)
    {
        Tcl_WrongNumArgs(interp, 1, objv, "string1 string2");
        return TCL_ERROR;
    }

    Tcl_Obj* result = NULL;

    char* arg1 = Tcl_GetString(objv[1]);
    char* arg2 = Tcl_GetString(objv[2]);

    if (strcmp(arg1, arg2) == 0)
    {
        result = Tcl_NewBooleanObj(1);
    }
    else
    {
        result = Tcl_NewBooleanObj(0);
    }

    Tcl_SetObjResult(interp, result);

    return TCL_OK;
}


/*
* @breif Tcl_AppInit is called from Tcl_Main after the Tcl interpreter has been created,
*        and before the script file or interactive command loop is entered.
*/
int Tcl_AppInit(Tcl_Interp* interp)
{
    // Initialize packages Tcl_Init sets up the Tcl library facility.
    if (Tcl_Init(interp) == TCL_ERROR)
    {
        return TCL_ERROR;
    }

    // Register application-specific commands.
    Tcl_CreateObjCommand(interp, "randomcmd", RandomCmd, NULL, NULL);
    Tcl_CreateObjCommand(interp, "equalcmd", EqualCmd, NULL, NULL);

    return TCL_OK;
}


int main(int argc, char* argv[])
{
    Tcl_Main(argc, argv, Tcl_AppInit);

    return 0;
}