1 |
10 |
wfjm |
// $Id: Rtcl.cpp 369 2011-03-13 22:39:26Z mueller $
|
2 |
|
|
//
|
3 |
|
|
// Copyright 2011- by Walter F.J. Mueller <W.F.J.Mueller@gsi.de>
|
4 |
|
|
//
|
5 |
|
|
// This program is free software; you may redistribute and/or modify it under
|
6 |
|
|
// the terms of the GNU General Public License as published by the Free
|
7 |
|
|
// Software Foundation, either version 2, or at your option any later version.
|
8 |
|
|
//
|
9 |
|
|
// This program is distributed in the hope that it will be useful, but
|
10 |
|
|
// WITHOUT ANY WARRANTY, without even the implied warranty of MERCHANTABILITY
|
11 |
|
|
// or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
|
12 |
|
|
// for complete details.
|
13 |
|
|
//
|
14 |
|
|
// Revision History:
|
15 |
|
|
// Date Rev Version Comment
|
16 |
|
|
// 2011-03-13 369 1.0.2 add NewListIntObj(vector<uint8_t>)
|
17 |
|
|
// 2011-03-05 366 1.0.1 add AppendResultNewLines()
|
18 |
|
|
// 2011-02-26 364 1.0 Initial version
|
19 |
|
|
// 2011-02-13 361 0.1 First draft
|
20 |
|
|
// ---------------------------------------------------------------------------
|
21 |
|
|
|
22 |
|
|
/*!
|
23 |
|
|
\file
|
24 |
|
|
\version $Id: Rtcl.cpp 369 2011-03-13 22:39:26Z mueller $
|
25 |
|
|
\brief Implemenation of Rtcl.
|
26 |
|
|
*/
|
27 |
|
|
|
28 |
|
|
#include "Rtcl.hpp"
|
29 |
|
|
|
30 |
|
|
using namespace std;
|
31 |
|
|
using namespace Retro;
|
32 |
|
|
|
33 |
|
|
/*!
|
34 |
|
|
\class Retro::Rtcl
|
35 |
|
|
\brief FIXME_docs
|
36 |
|
|
*/
|
37 |
|
|
|
38 |
|
|
//------------------------------------------+-----------------------------------
|
39 |
|
|
//! FIXME_docs
|
40 |
|
|
|
41 |
|
|
Tcl_Obj* Rtcl::NewLinesObj(const std::string& str)
|
42 |
|
|
{
|
43 |
|
|
const char* data = str.data();
|
44 |
|
|
int size = str.length();
|
45 |
|
|
if (size>0 && data[size-1]=='\n') size -= 1;
|
46 |
|
|
return Tcl_NewStringObj(data, size);
|
47 |
|
|
}
|
48 |
|
|
|
49 |
|
|
//------------------------------------------+-----------------------------------
|
50 |
|
|
//! FIXME_docs
|
51 |
|
|
|
52 |
|
|
Tcl_Obj* Rtcl::NewListIntObj(const std::vector<uint8_t>& vec)
|
53 |
|
|
{
|
54 |
|
|
if (vec.size() == 0) return Tcl_NewListObj(0, NULL);
|
55 |
|
|
|
56 |
|
|
vector<Tcl_Obj*> vobj;
|
57 |
|
|
vobj.reserve(vec.size());
|
58 |
|
|
|
59 |
|
|
for (size_t i=0; i<vec.size(); i++) {
|
60 |
|
|
vobj.push_back(Tcl_NewIntObj((int)vec[i]));
|
61 |
|
|
}
|
62 |
|
|
return Tcl_NewListObj(vobj.size(), vobj.data());
|
63 |
|
|
}
|
64 |
|
|
|
65 |
|
|
//------------------------------------------+-----------------------------------
|
66 |
|
|
//! FIXME_docs
|
67 |
|
|
|
68 |
|
|
Tcl_Obj* Rtcl::NewListIntObj(const std::vector<uint16_t>& vec)
|
69 |
|
|
{
|
70 |
|
|
if (vec.size() == 0) return Tcl_NewListObj(0, NULL);
|
71 |
|
|
|
72 |
|
|
vector<Tcl_Obj*> vobj;
|
73 |
|
|
vobj.reserve(vec.size());
|
74 |
|
|
|
75 |
|
|
for (size_t i=0; i<vec.size(); i++) {
|
76 |
|
|
vobj.push_back(Tcl_NewIntObj((int)vec[i]));
|
77 |
|
|
}
|
78 |
|
|
return Tcl_NewListObj(vobj.size(), vobj.data());
|
79 |
|
|
}
|
80 |
|
|
|
81 |
|
|
//------------------------------------------+-----------------------------------
|
82 |
|
|
//! FIXME_docs
|
83 |
|
|
|
84 |
|
|
bool Rtcl::SetVar(Tcl_Interp* interp, const std::string& varname, Tcl_Obj* pobj)
|
85 |
|
|
{
|
86 |
|
|
Tcl_Obj* pret = 0;
|
87 |
|
|
|
88 |
|
|
size_t pos_pbeg = varname.find_first_of('(');
|
89 |
|
|
size_t pos_pend = varname.find_first_of(')');
|
90 |
|
|
if (pos_pbeg != string::npos || pos_pend != string::npos) {
|
91 |
|
|
if (pos_pbeg == string::npos || pos_pbeg == 0 ||
|
92 |
|
|
pos_pend == string::npos || pos_pend != varname.length()-1 ||
|
93 |
|
|
pos_pend-pos_pbeg <= 1) {
|
94 |
|
|
Tcl_AppendResult(interp, "illformed array name \"", varname.c_str(),
|
95 |
|
|
"\"", NULL);
|
96 |
|
|
return false;
|
97 |
|
|
}
|
98 |
|
|
string arrname(varname.substr(0,pos_pbeg));
|
99 |
|
|
string elename(varname.substr(pos_pbeg+1, pos_pend-pos_pbeg-1));
|
100 |
|
|
|
101 |
|
|
pret = Tcl_SetVar2Ex(interp, arrname.c_str(), elename.c_str(), pobj,
|
102 |
|
|
TCL_LEAVE_ERR_MSG);
|
103 |
|
|
} else {
|
104 |
|
|
pret = Tcl_SetVar2Ex(interp, varname.c_str(), NULL, pobj,
|
105 |
|
|
TCL_LEAVE_ERR_MSG);
|
106 |
|
|
}
|
107 |
|
|
|
108 |
|
|
return pret!=0;
|
109 |
|
|
}
|
110 |
|
|
|
111 |
|
|
//------------------------------------------+-----------------------------------
|
112 |
|
|
//! FIXME_docs
|
113 |
|
|
|
114 |
|
|
bool Rtcl::SetVarOrResult(Tcl_Interp* interp, const std::string& varname,
|
115 |
|
|
Tcl_Obj* pobj)
|
116 |
|
|
{
|
117 |
|
|
if (varname != "-") {
|
118 |
|
|
return SetVar(interp, varname, pobj);
|
119 |
|
|
}
|
120 |
|
|
Tcl_SetObjResult(interp, pobj);
|
121 |
|
|
return true;
|
122 |
|
|
}
|
123 |
|
|
|
124 |
|
|
//------------------------------------------+-----------------------------------
|
125 |
|
|
//! FIXME_docs
|
126 |
|
|
|
127 |
|
|
void Rtcl::AppendResultNewLines(Tcl_Interp* interp)
|
128 |
|
|
{
|
129 |
|
|
// check whether ObjResult is non-empty, in that case add an '\n'
|
130 |
|
|
// that allows to append output from multiple AppendResultLines properly
|
131 |
|
|
const char* res = Tcl_GetStringResult(interp);
|
132 |
|
|
if (res && res[0]) {
|
133 |
|
|
Tcl_AppendResult(interp, "\n", NULL);
|
134 |
|
|
}
|
135 |
|
|
return;
|
136 |
|
|
}
|
137 |
|
|
|
138 |
|
|
//------------------------------------------+-----------------------------------
|
139 |
|
|
//! FIXME_docs
|
140 |
|
|
|
141 |
|
|
void Rtcl::SetResult(Tcl_Interp* interp, const std::string& str)
|
142 |
|
|
{
|
143 |
|
|
Tcl_SetObjResult(interp, NewLinesObj(str));
|
144 |
|
|
return;
|
145 |
|
|
}
|
146 |
|
|
|
147 |
|
|
//------------------------------------------+-----------------------------------
|
148 |
|
|
#if (defined(Retro_NoInline) || defined(Retro_Rtcl_NoInline))
|
149 |
|
|
#define inline
|
150 |
|
|
#include "Rtcl.ipp"
|
151 |
|
|
#undef inline
|
152 |
|
|
#endif
|