home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
OS/2 Shareware BBS: 10 Tools
/
10-Tools.zip
/
tk42r2s.zip
/
tk4.2
/
os2
/
tkOS2Init.c
< prev
next >
Wrap
C/C++ Source or Header
|
1999-07-27
|
7KB
|
227 lines
/*
* tkOS2Init.c --
*
* This file contains OS/2-specific interpreter initialization
* functions.
*
* Copyright (c) 1996-1998 Illya Vaes
* Copyright (c) 1995 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
#include "tkOS2Int.h"
/*
* Global variables necessary in modules in the DLL
*/
HAB hab; /* Anchor block (instance handle) */
HMQ hmq; /* Handle to message queue */
LONG aDevCaps[CAPS_DEVICE_POLYSET_POINTS]; /* Device Capabilities */
LONG nextLogicalFont = 1; /* First free logical font ID */
PFNWP oldFrameProc = NULL; /* subclassed frame procedure */
LONG xScreen; /* System Value Screen width */
LONG yScreen; /* System Value Screen height */
LONG titleBar; /* System Value Title Bar */
LONG xBorder; /* System Value X nominal border */
LONG yBorder; /* System Value Y nominal border */
LONG xSizeBorder; /* System Value X Sizing border */
LONG ySizeBorder; /* System Value Y Sizing border */
LONG xDlgBorder; /* System Value X dialog-frame border */
LONG yDlgBorder; /* System Value Y dialog-frame border */
HDC hScreenDC; /* Device Context for screen */
HPS globalPS; /* Global PS for Fonts (Gpi*Char*) */
HBITMAP globalBitmap; /* Bitmap for global PS */
TkOS2Font logfonts[255]; /* List of logical fonts */
LONG nextColor; /* Next free index in color table */
#ifdef IGNOREPMRES
LONG overrideResolution= 72; /* If IGNOREPMRES is defined */
#endif
LONG rc; /* For checking return values */
/*
* The following string is the startup script executed in new
* interpreters. It looks on disk in several different directories
* for a script "tk.tcl" that is compatible with this version
* of Tk. The tk.tcl script does all of the real work of
* initialization.
*/
static char *initScript =
"proc init {} {\n\
global tk_library tk_version tk_patchLevel env\n\
rename init {}\n\
set dirs {}\n\
if [info exists env(TK_LIBRARY)] {\n\
lappend dirs $env(TK_LIBRARY)\n\
}\n\
lappend dirs $tk_library\n\
lappend dirs [file dirname [info library]]/lib/tk$tk_version\n\
lappend dirs [file dirname [file dirname [info nameofexecutable]]]/lib/tk$tk_version\n\
if [string match {*[ab]*} $tk_patchLevel] {\n\
set lib tk$tk_patchLevel\n\
} else {\n\
set lib tk$tk_version\n\
}\n\
lappend dirs [file dirname [file dirname [pwd]]]/$lib/library\n\
lappend dirs [file dirname [pwd]]/library\n\
foreach i $dirs {\n\
set tk_library $i\n\
if ![catch {uplevel #0 source [list $i/tk.tcl]}] {\n\
return\n\
}\n\
}\n\
set msg \"Can't find a usable tk.tcl in the following directories: \n\"\n\
append msg \" $dirs\n\"\n\
append msg \"This probably means that Tk wasn't installed properly.\n\"\n\
error $msg\n\
}\n\
init";
/*
*----------------------------------------------------------------------
*
* TkPlatformInit --
*
* Performs OS/2-specific interpreter initialization related to the
* tk_library variable.
*
* Results:
* A standard Tcl completion code (TCL_OK or TCL_ERROR). Also
* leaves information in interp->result.
*
* Side effects:
* Sets "tk_library" Tcl variable, runs "tk.tcl" script.
*
*----------------------------------------------------------------------
*/
int
TkPlatformInit(interp)
Tcl_Interp *interp;
{
char *libDir;
/*
* If the path doesn't exist, look for the library relative to the
* tk.dll library.
*/
libDir = Tcl_GetVar(interp, "tk_library", TCL_GLOBAL_ONLY);
if (libDir == NULL) {
Tcl_SetVar(interp, "tk_library", ".", TCL_GLOBAL_ONLY);
}
return Tcl_Eval(interp, initScript);
}
/*
*----------------------------------------------------------------------
*
* TkOS2InitPM --
*
* Performs OS/2 Presentation Manager intialisation.
*
* Results:
* None.
*
* Side effects:
* Fills the global variables hab and hmq.
*
*----------------------------------------------------------------------
*/
void
TkOS2InitPM (void)
{
BOOL rc;
HDC hScreenDC;
LONG lStart, lCount;
DEVOPENSTRUC doStruc= {0L, (PSZ)"DISPLAY", NULL, 0L, 0L, 0L, 0L, 0L, 0L};
SIZEL sizel = {0,0};
BITMAPINFOHEADER2 bmpInfo;
#ifdef IGNOREPMRES
char *tkPmPixRes;
#endif
/* Initialize PM */
hab = WinInitialize (0);
/* Create message queue, increased size from 10 */
hmq= WinCreateMsgQueue (hab, 64);
/* Determine system values */
xScreen = WinQuerySysValue(HWND_DESKTOP, SV_CXSCREEN);
yScreen = WinQuerySysValue(HWND_DESKTOP, SV_CYSCREEN);
titleBar = WinQuerySysValue(HWND_DESKTOP, SV_CYTITLEBAR);
xBorder = WinQuerySysValue(HWND_DESKTOP, SV_CXBORDER);
yBorder = WinQuerySysValue(HWND_DESKTOP, SV_CYBORDER);
xSizeBorder = WinQuerySysValue(HWND_DESKTOP, SV_CXSIZEBORDER);
ySizeBorder = WinQuerySysValue(HWND_DESKTOP, SV_CYSIZEBORDER);
xDlgBorder = WinQuerySysValue(HWND_DESKTOP, SV_CXDLGFRAME);
yDlgBorder = WinQuerySysValue(HWND_DESKTOP, SV_CYDLGFRAME);
/* Get device characteristics from PM */
hScreenDC= DevOpenDC(hab, OD_MEMORY, (PSZ)"*", 0, (PDEVOPENDATA)&doStruc,
NULLHANDLE);
lStart= CAPS_FAMILY; lCount= CAPS_DEVICE_POLYSET_POINTS;
rc= DevQueryCaps (hScreenDC, lStart, lCount, aDevCaps);
#ifdef IGNOREPMRES
s = getenv("TK_PM_PIXRES");
if (s) {
overrideResolution = atol(s);
}
#endif
globalPS = GpiCreatePS(hab, hScreenDC, &sizel,
PU_PELS | GPIT_MICRO | GPIA_ASSOC);
if (globalPS == GPI_ERROR) {
return;
}
GpiSetCharMode(globalPS, CM_MODE2);
bmpInfo.cbFix = 16L;
bmpInfo.cx = xScreen;
bmpInfo.cy = yScreen;
bmpInfo.cPlanes = 1;
bmpInfo.cBitCount = aDevCaps[CAPS_COLOR_BITCOUNT];
globalBitmap = GpiCreateBitmap(globalPS, &bmpInfo, 0L, NULL, NULL);
rc = GpiSetBitmap(globalPS, globalBitmap);
/* Determine color table if no palette support but color table support */
if (!(aDevCaps[CAPS_ADDITIONAL_GRAPHICS] & CAPS_PALETTE_MANAGER) &&
aDevCaps[CAPS_COLOR_TABLE_SUPPORT]) {
LONG aClrData[4];
nextColor = 16; /* Assume VGA color table */
rc = GpiQueryColorData(globalPS, 4, aClrData);
nextColor = aClrData[QCD_LCT_HIINDEX] + 1;
}
}
/*
*----------------------------------------------------------------------
*
* TkOS2ExitPM --
*
* Performs OS/2 Presentation Manager sign-off routines.
*
* Results:
* None.
*
* Side effects:
* Resets global variables hab and hmq.
*
*----------------------------------------------------------------------
*/
void
TkOS2ExitPM (void)
{
GpiSetBitmap(globalPS, NULLHANDLE);
GpiDestroyPS(globalPS);
DevCloseDC(hScreenDC);
WinDestroyMsgQueue(hmq);
WinTerminate(hab);
hmq= hab= 0;
}