git.zerfleddert.de Git - micropolis/blob

1 /*

2 * tkGet.c --

3 *

4 * This file contains a number of "Tk_GetXXX" procedures, which

5 * parse text strings into useful forms for Tk. This file has

6 * the simpler procedures, like Tk_GetDirection and Tk_GetUid.

7 * The more complex procedures like Tk_GetColor are in separate

8 * files.

9 *

11 * Permission to use, copy, modify, and distribute this

12 * software and its documentation for any purpose and without

13 * fee is hereby granted, provided that the above copyright

14 * notice appear in all copies. The University of California

15 * makes no representations about the suitability of this

16 * software for any purpose. It is provided "as is" without

17 * express or implied warranty.

18 */

20 #ifndef lint

21 static char rcsid[] = "$Header: /user6/ouster/wish/RCS/tkGet.c,v 1.5 92/08/10 09:02:46 ouster Exp $ SPRITE (Berkeley)";

22 #endif /* not lint */

24 #include <tk.h>

25 #include "tkconfig.h"

27 /*

28 * The hash table below is used to keep track of all the Tk_Uids created

29 * so far.

30 */

32 static Tcl_HashTable uidTable;

33 static int initialized = 0;

34 \f

35 /*

36 *--------------------------------------------------------------

37 *

38 * Tk_GetAnchor --

39 *

40 * Given a string, return the corresponding Tk_Anchor.

41 *

42 * Results:

43 * The return value is a standard Tcl return result. If

44 * TCL_OK is returned, then everything went well and the

45 * position is stored at *anchorPtr; otherwise TCL_ERROR

46 * is returned and an error message is left in

47 * interp->result.

48 *

49 * Side effects:

50 * None.

51 *

52 *--------------------------------------------------------------

53 */

55 int

 Tk_GetAnchor(interp, string, anchorPtr)

57 Tcl_Interp *interp; /* Use this for error reporting. */

58 char *string; /* String describing a direction. */

59 Tk_Anchor *anchorPtr; /* Where to store Tk_Anchor corresponding

60 * to string. */

61 {

     switch (string[0]) {

63 case 'n':

             if (string[1] == 0) {

65 *anchorPtr = TK_ANCHOR_N;

66 return TCL_OK;

             } else if ((string[1] == 'e') && (string[2] == 0)) {

68 *anchorPtr = TK_ANCHOR_NE;

69 return TCL_OK;

             } else if ((string[1] == 'w') && (string[2] == 0)) {

71 *anchorPtr = TK_ANCHOR_NW;

72 return TCL_OK;

73 }

74 goto error;

75 case 's':

             if (string[1] == 0) {

77 *anchorPtr = TK_ANCHOR_S;

78 return TCL_OK;

             } else if ((string[1] == 'e') && (string[2] == 0)) {

80 *anchorPtr = TK_ANCHOR_SE;

81 return TCL_OK;

             } else if ((string[1] == 'w') && (string[2] == 0)) {

83 *anchorPtr = TK_ANCHOR_SW;

84 return TCL_OK;

85 } else {

86 goto error;

87 }

88 case 'e':

             if (string[1] == 0) {

90 *anchorPtr = TK_ANCHOR_E;

91 return TCL_OK;

92 }

93 goto error;

94 case 'w':

             if (string[1] == 0) {

96 *anchorPtr = TK_ANCHOR_W;

97 return TCL_OK;

98 }

99 goto error;

100 case 'c':

             if (strncmp(string, "center", strlen(string)) == 0) {

102 *anchorPtr = TK_ANCHOR_CENTER;

103 return TCL_OK;

104 }

105 goto error;

106 }

107

108 error:

     Tcl_AppendResult(interp, "bad anchor position \"", string,

110 "\": must be n, ne, e, se, s, sw, w, nw, or center",

111 (char *) NULL);

112 return TCL_ERROR;

113 }

114 \f

115 /*

116 *--------------------------------------------------------------

117 *

118 * Tk_NameOfAnchor --

119 *

120 * Given a Tk_Anchor, return the string that corresponds

121 * to it.

122 *

123 * Results:

124 * None.

125 *

126 * Side effects:

127 * None.

128 *

129 *--------------------------------------------------------------

130 */

131

132 char *

133 Tk_NameOfAnchor(anchor)

134 Tk_Anchor anchor; /* Anchor for which identifying string

135 * is desired. */

136 {

137 switch (anchor) {

         case TK_ANCHOR_N: return "n";

         case TK_ANCHOR_NE: return "ne";

         case TK_ANCHOR_E: return "e";

         case TK_ANCHOR_SE: return "se";

         case TK_ANCHOR_S: return "s";

         case TK_ANCHOR_SW: return "sw";

         case TK_ANCHOR_W: return "w";

         case TK_ANCHOR_NW: return "nw";

         case TK_ANCHOR_CENTER: return "center";

147 }

148 return "unknown anchor position";

149 }

150 \f

151 /*

152 *--------------------------------------------------------------

153 *

154 * Tk_GetJoinStyle --

155 *

156 * Given a string, return the corresponding Tk_JoinStyle.

157 *

158 * Results:

159 * The return value is a standard Tcl return result. If

160 * TCL_OK is returned, then everything went well and the

161 * justification is stored at *joinPtr; otherwise

162 * TCL_ERROR is returned and an error message is left in

163 * interp->result.

164 *

165 * Side effects:

166 * None.

167 *

168 *--------------------------------------------------------------

169 */

170

171 int

 Tk_GetJoinStyle(interp, string, joinPtr)

173 Tcl_Interp *interp; /* Use this for error reporting. */

174 char *string; /* String describing a justification style. */

175 int *joinPtr; /* Where to store join style corresponding

176 * to string. */

177 {

178 int c, length;

179

180 c = string[0];

181 length = strlen(string);

182

     if ((c == 'b') && (strncmp(string, "bevel", length) == 0)) {

184 *joinPtr = JoinBevel;

185 return TCL_OK;

186 }

     if ((c == 'm') && (strncmp(string, "miter", length) == 0)) {

188 *joinPtr = JoinMiter;

189 return TCL_OK;

190 }

     if ((c == 'r') && (strncmp(string, "round", length) == 0)) {

192 *joinPtr = JoinRound;

193 return TCL_OK;

194 }

195

     Tcl_AppendResult(interp, "bad join style \"", string,

197 "\": must be bevel, miter, or round",

198 (char *) NULL);

199 return TCL_ERROR;

200 }

201 \f

202 /*

203 *--------------------------------------------------------------

204 *

205 * Tk_NameOfJoinStyle --

206 *

207 * Given a Tk_JoinStyle, return the string that corresponds

208 * to it.

209 *

210 * Results:

211 * None.

212 *

213 * Side effects:

214 * None.

215 *

216 *--------------------------------------------------------------

217 */

218

219 char *

220 Tk_NameOfJoinStyle(join)

221 int join; /* Join style for which identifying string

222 * is desired. */

223 {

224 switch (join) {

         case JoinBevel: return "bevel";

         case JoinMiter: return "miter";

         case JoinRound: return "round";

228 }

229 return "unknown join style";

230 }

231 \f

232 /*

233 *--------------------------------------------------------------

234 *

235 * Tk_GetCapStyle --

236 *

237 * Given a string, return the corresponding Tk_CapStyle.

238 *

239 * Results:

240 * The return value is a standard Tcl return result. If

241 * TCL_OK is returned, then everything went well and the

242 * justification is stored at *capPtr; otherwise

243 * TCL_ERROR is returned and an error message is left in

244 * interp->result.

245 *

246 * Side effects:

247 * None.

248 *

249 *--------------------------------------------------------------

250 */

251

252 int

 Tk_GetCapStyle(interp, string, capPtr)

254 Tcl_Interp *interp; /* Use this for error reporting. */

255 char *string; /* String describing a justification style. */

256 int *capPtr; /* Where to store cap style corresponding

257 * to string. */

258 {

259 int c, length;

260

261 c = string[0];

262 length = strlen(string);

263

     if ((c == 'b') && (strncmp(string, "butt", length) == 0)) {

265 *capPtr = CapButt;

266 return TCL_OK;

267 }

     if ((c == 'p') && (strncmp(string, "projecting", length) == 0)) {

269 *capPtr = CapProjecting;

270 return TCL_OK;

271 }

     if ((c == 'r') && (strncmp(string, "round", length) == 0)) {

273 *capPtr = CapRound;

274 return TCL_OK;

275 }

276

     Tcl_AppendResult(interp, "bad cap style \"", string,

278 "\": must be butt, projecting, or round",

279 (char *) NULL);

280 return TCL_ERROR;

281 }

282 \f

283 /*

284 *--------------------------------------------------------------

285 *

286 * Tk_NameOfCapStyle --

287 *

288 * Given a Tk_CapStyle, return the string that corresponds

289 * to it.

290 *

291 * Results:

292 * None.

293 *

294 * Side effects:

295 * None.

296 *

297 *--------------------------------------------------------------

298 */

299

300 char *

301 Tk_NameOfCapStyle(cap)

302 int cap; /* Cap style for which identifying string

303 * is desired. */

304 {

305 switch (cap) {

         case CapButt: return "butt";

         case CapProjecting: return "projecting";

         case CapRound: return "round";

309 }

310 return "unknown cap style";

311 }

312 \f

313 /*

314 *--------------------------------------------------------------

315 *

316 * Tk_GetJustify --

317 *

318 * Given a string, return the corresponding Tk_Justify.

319 *

320 * Results:

321 * The return value is a standard Tcl return result. If

322 * TCL_OK is returned, then everything went well and the

323 * justification is stored at *justifyPtr; otherwise

324 * TCL_ERROR is returned and an error message is left in

325 * interp->result.

326 *

327 * Side effects:

328 * None.

329 *

330 *--------------------------------------------------------------

331 */

332

333 int

 Tk_GetJustify(interp, string, justifyPtr)

335 Tcl_Interp *interp; /* Use this for error reporting. */

336 char *string; /* String describing a justification style. */

337 Tk_Justify *justifyPtr; /* Where to store Tk_Justify corresponding

338 * to string. */

339 {

340 int c, length;

341

342 c = string[0];

343 length = strlen(string);

344

     if ((c == 'l') && (strncmp(string, "left", length) == 0)) {

346 *justifyPtr = TK_JUSTIFY_LEFT;

347 return TCL_OK;

348 }

     if ((c == 'r') && (strncmp(string, "right", length) == 0)) {

350 *justifyPtr = TK_JUSTIFY_RIGHT;

351 return TCL_OK;

352 }

     if ((c == 'c') && (strncmp(string, "center", length) == 0)) {

354 *justifyPtr = TK_JUSTIFY_CENTER;

355 return TCL_OK;

356 }

     if ((c == 'f') && (strncmp(string, "fill", length) == 0)) {

358 *justifyPtr = TK_JUSTIFY_FILL;

359 return TCL_OK;

360 }

361

     Tcl_AppendResult(interp, "bad justification \"", string,

363 "\": must be left, right, center, or fill",

364 (char *) NULL);

365 return TCL_ERROR;

366 }

367 \f

368 /*

369 *--------------------------------------------------------------

370 *

371 * Tk_NameOfJustify --

372 *

373 * Given a Tk_Justify, return the string that corresponds

374 * to it.

375 *

376 * Results:

377 * None.

378 *

379 * Side effects:

380 * None.

381 *

382 *--------------------------------------------------------------

383 */

384

385 char *

386 Tk_NameOfJustify(justify)

387 Tk_Justify justify; /* Justification style for which

388 * identifying string is desired. */

389 {

390 switch (justify) {

         case TK_JUSTIFY_LEFT: return "left";

         case TK_JUSTIFY_RIGHT: return "right";

         case TK_JUSTIFY_CENTER: return "center";

         case TK_JUSTIFY_FILL: return "fill";

395 }

396 return "unknown justification style";

397 }

398 \f

399 /*

400 *----------------------------------------------------------------------

401 *

402 * Tk_GetUid --

403 *

404 * Given a string, this procedure returns a unique identifier

405 * for the string.

406 *

407 * Results:

408 * This procedure returns a Tk_Uid corresponding to the "string"

409 * argument. The Tk_Uid has a string value identical to string

410 * (strcmp will return 0), but it's guaranteed that any other

411 * calls to this procedure with a string equal to "string" will

412 * return exactly the same result (i.e. can compare Tk_Uid

413 * *values* directly, without having to call strcmp on what they

414 * point to).

415 *

416 * Side effects:

417 * New information may be entered into the identifier table.

418 *

419 *----------------------------------------------------------------------

420 */

421

422 Tk_Uid

423 Tk_GetUid(string)

424 char *string; /* String to convert. */

425 {

426 int dummy;

427

428 if (!initialized) {

429 Tcl_InitHashTable(&uidTable, TCL_STRING_KEYS);

430 initialized = 1;

431 }

     return (Tk_Uid) Tcl_GetHashKey(&uidTable,

             Tcl_CreateHashEntry(&uidTable, string, &dummy));

434 }

435 \f

436 /*

437 *--------------------------------------------------------------

438 *

439 * Tk_GetScreenMM --

440 *

441 * Given a string, returns the number of screen millimeters

442 * corresponding to that string.

443 *

444 * Results:

445 * The return value is a standard Tcl return result. If

446 * TCL_OK is returned, then everything went well and the

447 * screen distance is stored at *doublePtr; otherwise

448 * TCL_ERROR is returned and an error message is left in

449 * interp->result.

450 *

451 * Side effects:

452 * None.

453 *

454 *--------------------------------------------------------------

455 */

456

457 int

 Tk_GetScreenMM(interp, tkwin, string, doublePtr)

459 Tcl_Interp *interp; /* Use this for error reporting. */

460 Tk_Window tkwin; /* Window whose screen determines conversion

461 * from centimeters and other absolute

462 * units. */

463 char *string; /* String describing a screen distance. */

464 double *doublePtr; /* Place to store converted result. */

465 {

466 char *end;

467 double d;

468

     d = strtod(string, &end);

470 if (end == string) {

471 error:

         Tcl_AppendResult(interp, "bad screen distance \"", string,

                 "\"", (char *) NULL);

474 return TCL_ERROR;

475 }

     while ((*end != '\0') && isspace(*end)) {

477 end++;

478 }

479 switch (*end) {

480 case 0:

             d /= WidthOfScreen(Tk_Screen(tkwin));

             d *= WidthMMOfScreen(Tk_Screen(tkwin));

483 break;

484 case 'c':

485 d *= 10;

486 end++;

487 break;

488 case 'i':

489 d *= 25.4;

490 end++;

491 break;

492 case 'm':

493 end++;

494 break;

495 case 'p':

             d *= 25.4/72.0;

497 end++;

498 break;

499 default:

500 goto error;

501 }

     while ((*end != '\0') && isspace(*end)) {

503 end++;

504 }

     if (*end != 0) {

506 goto error;

507 }

508 *doublePtr = d;

509 return TCL_OK;

510 }

511 \f

512 /*

513 *--------------------------------------------------------------

514 *

515 * Tk_GetPixels --

516 *

517 * Given a string, returns the number of pixels corresponding

518 * to that string.

519 *

520 * Results:

521 * The return value is a standard Tcl return result. If

522 * TCL_OK is returned, then everything went well and the

523 * rounded pixel distance is stored at *intPtr; otherwise

524 * TCL_ERROR is returned and an error message is left in

525 * interp->result.

526 *

527 * Side effects:

528 * None.

529 *

530 *--------------------------------------------------------------

531 */

532

533 int

 Tk_GetPixels(interp, tkwin, string, intPtr)

535 Tcl_Interp *interp; /* Use this for error reporting. */

536 Tk_Window tkwin; /* Window whose screen determines conversion

537 * from centimeters and other absolute

538 * units. */

539 char *string; /* String describing a justification style. */

540 int *intPtr; /* Place to store converted result. */

541 {

542 char *end;

543 double d;

544

     d = strtod(string, &end);

546 if (end == string) {

547 error:

         Tcl_AppendResult(interp, "bad screen distance \"", string,

                 "\"", (char *) NULL);

550 return TCL_ERROR;

551 }

     while ((*end != '\0') && isspace(*end)) {

553 end++;

554 }

555 switch (*end) {

556 case 0:

557 break;

558 case 'c':

             d *= 10*WidthOfScreen(Tk_Screen(tkwin));

             d /= WidthMMOfScreen(Tk_Screen(tkwin));

561 end++;

562 break;

563 case 'i':

             d *= 25.4*WidthOfScreen(Tk_Screen(tkwin));

             d /= WidthMMOfScreen(Tk_Screen(tkwin));

566 end++;

567 break;

568 case 'm':

             d *= WidthOfScreen(Tk_Screen(tkwin));

             d /= WidthMMOfScreen(Tk_Screen(tkwin));

571 end++;

572 break;

573 case 'p':

             d *= (25.4/72.0)*WidthOfScreen(Tk_Screen(tkwin));

             d /= WidthMMOfScreen(Tk_Screen(tkwin));

576 end++;

577 break;

578 default:

579 goto error;

580 }

     while ((*end != '\0') && isspace(*end)) {

582 end++;

583 }

     if (*end != 0) {

585 goto error;

586 }

     if (d < 0) {

         *intPtr = (int) (d - 0.5);

589 } else {

         *intPtr = (int) (d + 0.5);

591 }

592 return TCL_OK;

593 }