1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117 | {* tcl_demo.pas
* ------------------------------------------------
* Copyright 2002 by Bert Raccoon aka Max Artemev
* (bert@furry.ru, bert_raccoon@freemail.ru)
* ------------------------------------------------ * Demo for tcl80.pas unit.
* Creating the Tcl interpreter, executing file, registering
* new commands, call a function defined in the script.
*
* Under Win32 can cause crash. *}
program test;
uses tcl80, SysUtils;
{*
* Function for testing that string is correct number
*}
function is_num(const src: PChar): Boolean;
var i: integer;
begin
is_num:=True;
i:=0;
repeat is_num:=is_num and ((src + i)^ in ['0'..'9']);
inc(i);
until (src + i)^ = #0;
end;
function Test_max(clientData: Tcl_ClientData; {* Some user defined data. *}
interp: PTcl_Interp; {* Pointer to Tcl interpreter *}
argc: integer; {* Arguments counter, arguments, etc *}
argv: Tcl_Argv): longint; {* Remeber! *NIX `integer` type is 16 bit! *}
cdecl; {* C calling convention *}var
arg : PChar;
idx,
value,
maxVal : LongInt;begin
maxVal := 0; {* Zero variable. Very stupid comment? ;)) *}
{* The `max` can be done with at least two digits
* In ArgvItem(argv,0) passed function name *}
if (argc < 3) then
begin
Tcl_AppendResult(interp, ['bad # arg: ', ArgvItem(argv,0), ' num1 num2 [..numN]', nil]);
{* Under Win32 calling of this function can cause crash *}
Test_max:=TCL_ERROR; {* Error was occured *}
exit; {* Leave *}
end;
for idx := 1 to argc-1 do {* In argv[0] passed function name, so
* go from the first index, not zero.
*}
begin
arg := ArgvItem(argv,idx); {* get an argument *} if (not is_num(arg)) then {* Is right number? *}
begin
Tcl_AppendResult(interp,[' "', arg, '" is not a valid integer value']);
Test_max:=TCL_ERROR; {* Error was occured *}
exit; {* leave *} end;
Value:=StrToInt(arg); {* Convert PChar->Integer *}
if (value > maxVal) then
maxVal := value; {* Calculate maximum number *}
end;
{* Set the result for the our function.
* result type always is PChar
*}
Tcl_SetResult(interp, PChar(IntToStr(maxVal)), nil);
{* exit successful *}
Test_max:=TCL_OK;
end;
{*
* Old and good known Pascal procedure :)
*}
function Test_writeln(clientData: Tcl_ClientData; interp: pTcl_Interp; argc: integer; argv: Tcl_Argv): longint; cdecl;
var i: integer;
Buff: string;
begin
Buff := '';
for i:=1 to argc-1 do Buff:=Buff + ArgvItem(argv,i); {* work around some bugs *}
writeln(Buff);
Test_writeln:=TCL_OK;
end;
var
interp: PTcl_Interp;
code: integer;
begin interp := Tcl_CreateInterp(); {* Create an interpreter *}
Tcl_Init(interp); {* Initialize *}
{* Register/override in the Tcl engine our new functions *}
Tcl_CreateCommand(interp,'max', TTclCmdProc(@Test_max),nil,nil); Tcl_CreateCommand(interp,'writeln',TTclCmdProc(@Test_writeln),nil,nil);
code := Tcl_EvalFile(interp,'test.tcl'); {* Execute script *}
if (code <> TCL_OK) then {* Is all okay? *}
writeln(Tcl_GetStringResult(interp));
{* Call a function `foo` defined in the script *}
code := Tcl_VarEval(interp,['foo ','1 2 3',nil]);
if (code <> TCL_OK) then
writeln(Tcl_GetStringResult(interp)); Tcl_DeleteInterp(interp); {* Release interpreter *}
end. |
