source: branches/uq/lang/tcl/src/RpScreenSize.c @ 5315

/*
 * ----------------------------------------------------------------------
 *  Rappture::ScreenSize
 *
 *  TK doesn't know how to read the screen size properly, so until
 *  it gets fixed, Rappture can get the correct size using this.
 * ======================================================================
 *  AUTHOR:  Martin Hunt, Purdue University
 *  Copyright (c) 2015  HUBzero Foundation, LLC
 *
 *  See the file "license.terms" for information on usage and
 *  redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 * ======================================================================
 */
#include "config.h"
#include <tcl.h>
#include <stdlib.h>
#include <stddef.h>
#include <string.h>
#include <stdio.h>
#include <X11/extensions/Xrandr.h>

static Tcl_CmdProc RpScreenSizeCmd;

/*
 * ------------------------------------------------------------------------
 *  RpScreenSize_Init()
 *
 *  Called in Rappture_Init() to initialize the commands defined
 *  in this file.
 * ------------------------------------------------------------------------
 */
int
RpScreenSize_Init(interp)
    Tcl_Interp *interp;  /* interpreter being initialized */
{
    /* install the sysinfo command */
    Tcl_CreateCommand(interp, "::Rappture::ScreenSize", RpScreenSizeCmd,
        (ClientData)NULL, (Tcl_CmdDeleteProc*)NULL);
    return TCL_OK;
}

/*
 * ------------------------------------------------------------------------
 *  RpScreenSizeCmd()
 *
 *  Gets the screen width and height of the default DISPLAY
 *
 *  Returns TCL_OK on success, and TCL_ERROR (along with an error
 *  message in the interpreter) if anything goes wrong.
 * ------------------------------------------------------------------------
 */
static int
RpScreenSizeCmd(cdata, interp, argc, argv)
    ClientData cdata;         /* not used */
    Tcl_Interp *interp;       /* interpreter handling this request */
    int argc;                 /* number of command line args */
    CONST84 char *argv[];     /* strings for command line args */
{
    Tcl_Obj *resultPtr;
    int w, h, screen;

    resultPtr = Tcl_GetObjResult(interp);

    Display *dpy = XOpenDisplay(NULL);
    if (dpy == NULL) {
        Tcl_AppendResult(interp,
                "Could not open the display.", (char*)NULL);
        return TCL_ERROR;
    }
    screen = DefaultScreen(dpy);

    w = DisplayWidth(dpy, screen);
    Tcl_ListObjAppendElement(interp, resultPtr, Tcl_NewIntObj(w));

    h = DisplayHeight(dpy, screen);
    Tcl_ListObjAppendElement(interp, resultPtr, Tcl_NewIntObj(h));

    XCloseDisplay(dpy);
    return TCL_OK;
}