git.zerfleddert.de Git - micropolis/blob

1 /*

2 * main.c --

3 *

4 * A simple program to test the toolkit facilities.

5 *

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

8 * software and its documentation for any purpose and without

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

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

11 * makes no representations about the suitability of this

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

13 * express or implied warranty.

14 */

16 #ifndef lint

17 static char rcsid[] = "$Header: /user6/ouster/wish/RCS/main.c,v 1.68 92/05/07 08:52:02 ouster Exp $ SPRITE (Berkeley)";

18 #endif

20 #include "tkconfig.h"

21 #include "tkint.h"

23 /*

24 * Declarations for library procedures:

25 */

27 extern int isatty();

29 /*

30 * Command used to initialize wish:

31 */

33 char initCmd[] = "source $tk_library/wish.tcl";

35 Tk_Window w; /* NULL means window has been deleted. */

36 Tk_TimerToken timeToken = 0;

37 int idleHandler = 0;

38 Tcl_Interp *interp;

39 int x, y;

40 Tcl_CmdBuf buffer;

41 int tty;

 extern int Tk_SquareCmd _ANSI_ARGS_((ClientData clientData,

         Tcl_Interp *interp, int argc, char **argv));

45 /*

46 * Information for testing out command-line options:

47 */

49 int synchronize = 0;

50 char *fileName = NULL;

51 char *name = NULL;

52 char *display = NULL;

53 char *geometry = NULL;

55 Tk_ArgvInfo argTable[] = {

     {"-file", TK_ARGV_STRING, (char *) NULL, (char *) &fileName,

57 "File from which to read commands"},

     {"-geometry", TK_ARGV_STRING, (char *) NULL, (char *) &geometry,

59 "Initial geometry for window"},

     {"-display", TK_ARGV_STRING, (char *) NULL, (char *) &display,

61 "Display to use"},

     {"-name", TK_ARGV_STRING, (char *) NULL, (char *) &name,

63 "Name to use for application"},

     {"-sync", TK_ARGV_CONSTANT, (char *) 1, (char *) &synchronize,

65 "Use synchronous mode for display server"},

     {(char *) NULL, TK_ARGV_END, (char *) NULL, (char *) NULL,

67 (char *) NULL}

68 };

70 /* ARGSUSED */

71 void

72 StdinProc(clientData, mask)

73 ClientData clientData; /* Not used. */

74 int mask;

75 {

76 char line[200];

77 static int gotPartial = 0;

78 char *cmd;

79 int result;

81 if (mask & TK_READABLE) {

         if (fgets(line, 200, stdin) == NULL) {

83 if (!gotPartial) {

84 if (tty) {

                     Tcl_Eval(interp, "destroy .", 0, (char **) NULL);

86 exit(0);

87 } else {

88 Tk_DeleteFileHandler(0);

89 }

90 return;

91 } else {

                 line[0] = 0;

93 }

94 }

         cmd = Tcl_AssembleCmd(buffer, line);

96 if (cmd == NULL) {

97 gotPartial = 1;

98 return;

99 }

100 gotPartial = 0;

         result = Tcl_RecordAndEval(interp, cmd, 0);

         if (*interp->result != 0) {

             if ((result != TCL_OK) || (tty)) {

                 printf("%s\n", interp->result);

105 }

106 }

107 if (tty) {

108 printf("wish: ");

109 fflush(stdout);

110 }

111 }

112 }

113

114 /* ARGSUSED */

115 static void

116 StructureProc(clientData, eventPtr)

117 ClientData clientData; /* Information about window. */

118 XEvent *eventPtr; /* Information about event. */

119 {

     if (eventPtr->type == DestroyNotify) {

121 w = NULL;

122 }

123 }

124

125 /*

126 * Procedure to map initial window. This is invoked as a do-when-idle

127 * handler. Wait for all other when-idle handlers to be processed

128 * before mapping the window, so that the window's correct geometry

129 * has been determined.

130 */

131

132 /* ARGSUSED */

133 static void

134 DelayedMap(clientData)

135 ClientData clientData; /* Not used. */

136 {

137

     while (Tk_DoOneEvent(TK_IDLE_EVENTS) != 0) {

139 /* Empty loop body. */

140 }

141 if (w == NULL) {

142 return;

143 }

144 Tk_MapWindow(w);

145 }

146

147 /* ARGSUSED */

148 int

 DotCmd(dummy, interp, argc, argv)

150 ClientData dummy; /* Not used. */

151 Tcl_Interp *interp; /* Current interpreter. */

152 int argc; /* Number of arguments. */

153 char **argv; /* Argument strings. */

154 {

155 int x, y;

156

     if (argc != 3) {

         Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],

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

160 return TCL_ERROR;

161 }

     x = strtol(argv[1], (char **) NULL, 0);

     y = strtol(argv[2], (char **) NULL, 0);

164 Tk_MakeWindowExist(w);

     XDrawPoint(Tk_Display(w), Tk_WindowId(w),

             DefaultGCOfScreen(Tk_Screen(w)), x, y);

167 return TCL_OK;

168 }

169

170 /* ARGSUSED */

171 int

 MovetoCmd(dummy, interp, argc, argv)

173 ClientData dummy; /* Not used. */

174 Tcl_Interp *interp; /* Current interpreter. */

175 int argc; /* Number of arguments. */

176 char **argv; /* Argument strings. */

177 {

     if (argc != 3) {

         Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],

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

181 return TCL_ERROR;

182 }

     x = strtol(argv[1], (char **) NULL, 0);

     y = strtol(argv[2], (char **) NULL, 0);

185 return TCL_OK;

186 }

187 /* ARGSUSED */

188 int

 LinetoCmd(dummy, interp, argc, argv)

190 ClientData dummy; /* Not used. */

191 Tcl_Interp *interp; /* Current interpreter. */

192 int argc; /* Number of arguments. */

193 char **argv; /* Argument strings. */

194 {

195 int newX, newY;

196

     if (argc != 3) {

         Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],

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

200 return TCL_ERROR;

201 }

     newX = strtol(argv[1], (char **) NULL, 0);

     newY = strtol(argv[2], (char **) NULL, 0);

204 Tk_MakeWindowExist(w);

     XDrawLine(Tk_Display(w), Tk_WindowId(w),

             DefaultGCOfScreen(Tk_Screen(w)), x, y, newX, newY);

207 x = newX;

208 y = newY;

209 return TCL_OK;

210 }

211

212 int

213 main(argc, argv)

214 int argc;

215 char **argv;

216 {

     char *args, *p, *msg;

218 char buf[20];

219 int result;

220 Tk_3DBorder border;

221

     { extern char *TCL_Library, *TK_Library;

223 extern int TK_CreateColormap;

       char *tcllib = getenv("TCL_LIBRARY");

       char *tklib = getenv("TK_LIBRARY");

       char *create = getenv("CREATE_COLORMAP");

227 if (tklib != NULL)

228 TK_Library = tklib;

229 if (tcllib != NULL)

230 TCL_Library = tcllib;

231 if (create != NULL)

232 TK_CreateColormap = 1;

233 }

234

235 interp = Tcl_CreateInterp();

236 #ifdef TCL_MEM_DEBUG

237 Tcl_InitMemory(interp);

238 #endif

     if (Tk_ParseArgv(interp, (Tk_Window) NULL, &argc, argv, argTable, 0)

240 != TCL_OK) {

         fprintf(stderr, "%s\n", interp->result);

242 exit(1);

243 }

244 if (name == NULL) {

245 if (fileName != NULL) {

246 p = fileName;

247 } else {

248 p = argv[0];

249 }

         name = strrchr(p, '/');

251 if (name != NULL) {

252 name++;

253 } else {

254 name = p;

255 }

256 }

     w = Tk_CreateMainWindow(interp, display, name);

258 if (w == NULL) {

         fprintf(stderr, "%s\n", interp->result);

260 exit(1);

261 }

     Tk_SetClass(w, "Tk");

     Tk_CreateEventHandler(w, StructureNotifyMask, StructureProc,

264 (ClientData) NULL);

     Tk_DoWhenIdle(DelayedMap, (ClientData) NULL);

     tty = isatty(0);

267

     args = Tcl_Merge(argc-1, argv+1);

     Tcl_SetVar(interp, "argv", args, TCL_GLOBAL_ONLY);

270 ckfree(args);

     sprintf(buf, "%d", argc-1);

     Tcl_SetVar(interp, "argc", buf, TCL_GLOBAL_ONLY);

273

274 if (synchronize) {

         XSynchronize(Tk_Display(w), True);

276 }

     Tk_GeometryRequest(w, 200, 200);

     border = Tk_Get3DBorder(interp, w, None, "#4eee94");

279 if (border == NULL) {

         Tcl_SetResult(interp, (char *) NULL, TCL_STATIC);

         Tk_SetWindowBackground(w, WhitePixelOfScreen(Tk_Screen(w)));

282 } else {

283 Tk_SetBackgroundFromBorder(w, border);

284 }

     XSetForeground(Tk_Display(w), DefaultGCOfScreen(Tk_Screen(w)),

             BlackPixelOfScreen(Tk_Screen(w)));

     Tcl_CreateCommand(interp, "dot", DotCmd, (ClientData) w,

288 (void (*)()) NULL);

     Tcl_CreateCommand(interp, "lineto", LinetoCmd, (ClientData) w,

290 (void (*)()) NULL);

     Tcl_CreateCommand(interp, "moveto", MovetoCmd, (ClientData) w,

292 (void (*)()) NULL);

293 #ifdef SQUARE_DEMO

     Tcl_CreateCommand(interp, "square", Tk_SquareCmd, (ClientData) w,

295 (void (*)()) NULL);

296 #endif

297 if (geometry != NULL) {

         Tcl_SetVar(interp, "geometry", geometry, TCL_GLOBAL_ONLY);

299 }

     result = Tcl_Eval(interp, initCmd, 0, (char **) NULL);

301 if (result != TCL_OK) {

302 goto error;

303 }

304 if (fileName != NULL) {

         result = Tcl_VarEval(interp, "source ", fileName, (char *) NULL);

306 if (result != TCL_OK) {

307 goto error;

308 }

309 tty = 0;

310 } else {

         tty = isatty(0);

         Tk_CreateFileHandler(0, TK_READABLE, StdinProc, (ClientData) 0);

313 if (tty) {

314 printf("wish: ");

315 }

316 }

317 fflush(stdout);

318 buffer = Tcl_CreateCmdBuf();

     (void) Tcl_Eval(interp, "update", 0, (char **) NULL);

320

321 Tk_MainLoop();

322 Tcl_DeleteInterp(interp);

323 Tcl_DeleteCmdBuf(buffer);

324 exit(0);

325

326 error:

     msg = Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY);

328 if (msg == NULL) {

329 msg = interp->result;

330 }

     fprintf(stderr, "%s\n", msg);

     Tcl_Eval(interp, "destroy .", 0, (char **) NULL);

333 exit(1);

334 }