#define PERL_NO_GET_CONTEXT
#include <EXTERN.h>
#include <perl.h>
#include <XSUB.h>
#include "tkGlue.def"

#include "pTk/tkPort.h"
#include "pTk/tkInt.h"
#include "tkGlue.h"
#include "tkGlue.m"
#include "pTk/tkVMacro.h"

DECLARE_VTABLES;

/* A few sample routines to get at Xlib via perl
   Will eventaually be extended to the point where
   simple pTk widgets can be *implemented* in perl

   Main stumbling block is a clean way of filling in
   a GC.

   The XDraw*() functions may be a bit messy, but
   should be okay via CODE: bodies and variable number
   of args and/or passing in array refs
*/

/* Now we have some sneakyness for Benefit of Win32.
 * As we have tkVMacro.h above any function which exists
 * should be #define'd so we can test for existance.
 */

#ifndef XLoadFont
#define XLoadFont(dpy,name) None
#endif

#ifndef XDrawString
#define XDrawString(dpy,win,gc,x,y,string,len)
#endif

static IV
SvGCIVOBJ(pTHX_ char *class,SV *sv)
{
 if (sv_isa(sv, class))
  return SvIV((SV*)SvRV(sv));
 else
  croak("Not of type %s",class);
 return 0;
}

#define SvGCint(x)           SvIV(x)
#define SvGCBool(x)          SvIV(x)
#define SvGCunsigned_long(x) SvIV(x)
#define SvGCPixmap(x)        (Pixmap) SvGCIVOBJ(aTHX_ "Pixmap",x)
#define SvGCFont(x)          (Font)   SvGCIVOBJ(aTHX_ "Font",x)

#define GCField(name,bit,field,func) \
 if (!strcmp(key,name)) {            \
  values->field = func(value);       \
  valuemask |= bit;                  \
 } else

unsigned long
GCSetValue(pTHX_ unsigned long valuemask,
           XGCValues *values,char *key,SV *value)
{
#include "GC.def"
 croak("Setting GC %s not implemented",key);
 return valuemask;
}

static void
tmpLine(tkwin,x1,y1,x2,y2,flags)
Tk_Window tkwin;
int x1,y1,x2,y2;
int flags;
{
 GC gc = None;
 XGCValues values;
 Window root = Tk_WindowId(tkwin);
 unsigned long valuemask = GCForeground | GCBackground
                           | GCSubwindowMode | GCFunction
#if 0
                           | GCLineStyle
#endif
                           ;
 values.line_style     = LineDoubleDash;

 if (flags & 4)
  {
   Window child;
   root = XRootWindow(Tk_Display(tkwin), Tk_ScreenNumber(tkwin));
   XTranslateCoordinates(Tk_Display(tkwin),Tk_WindowId(tkwin),root,
                         x1, y1, &x1, &y1, &child);
   XTranslateCoordinates(Tk_Display(tkwin),Tk_WindowId(tkwin),root,
                         x2, y2, &x2, &y2, &child);
   values.subwindow_mode = IncludeInferiors;
  }
 else
  {
   values.subwindow_mode = ClipByChildren;
  }

 if (flags & 2)
  {
   values.background     = 0x0a;
   values.foreground     = 0x05;
   values.function       = GXxor;
  }
 else
  {
   values.function       = GXcopy;
   if (flags & 1)
    {
     values.foreground     = BlackPixelOfScreen(Tk_Screen(tkwin));
     values.background     = WhitePixelOfScreen(Tk_Screen(tkwin));
    }
   else
    {
     values.background     = BlackPixelOfScreen(Tk_Screen(tkwin));
     values.foreground     = WhitePixelOfScreen(Tk_Screen(tkwin));
    }
  }
 gc = Tk_GetGC(tkwin, valuemask, &values);
 if (gc != None)
  {
   XDrawLine(Tk_Display(tkwin), root, gc, x1, y1, x2, y2);
   Tk_FreeGC(Tk_Display(tkwin),gc);
  }
 else
  croak("Cannot get graphic context");
}

#if defined(WIN32) || defined(__WIN32__) || defined(__PM__)
/* wrap the naive macro versions of these ... */
static int
pTk_XSync(Display *dpy, int flush)
{
 XSync(dpy,flush);
 return 0;
}

static int
pTk_XFlush(Display *dpy)
{
 XFlush(dpy);
 return 0;
}
#else
#define pTk_XSync  XSync
#define pTk_XFlush XFlush
#endif /* WIN32 or friends */



MODULE = Tk::Xlib	PACKAGE = Tk::Widget

void
tmpLine(win,x1,y1,x2,y2,onroot = 0)
Tk_Window	win
int	x1
int	y1
int	x2
int	y2
int	onroot


MODULE = Tk::Xlib	PACKAGE = ScreenPtr

PROTOTYPES: DISABLE

int
WidthOfScreen(s)
Screen *	s

int
WidthMMOfScreen(s)
Screen *	s

int
HeightOfScreen(s)
Screen *	s

int
HeightMMOfScreen(s)
Screen *	s

GC
DefaultGCOfScreen(s)
Screen *	s

unsigned long
BlackPixelOfScreen(s)
Screen *	s

unsigned long
WhitePixelOfScreen(s)
Screen *	s

MODULE = Tk::Xlib	PACKAGE = DisplayPtr	PREFIX = pTk_

int
pTk_XSync(dpy,discard = False)
Display *	dpy
int		discard

int
pTk_XFlush(dpy)
Display *	dpy

int
ConnectionNumber(dpy)
Display *	dpy

Font
XLoadFont(dpy,name)
Display *	dpy
char *		name

void
XListFonts(dpy,pattern,max)
Display *	dpy
char *		pattern
int		max
PPCODE:
 {
  int  count = 0;
#if !defined(__WIN32__) && !defined(__PM__)
  char **list = XListFonts(dpy, pattern, max, &count);
  int i;
  EXTEND(sp, count);
  for (i=0; i < count; i++)
   {
    PUSHs(sv_2mortal(newSVpv(list[i],0)));
   }
  XFreeFontNames(list);
#endif
  XSRETURN(count);
 }

void
XDrawLine(dpy,win,gc,x1,y1,x2,y2)
Display *	dpy
Window		win
GC		gc
int		x1
int		y1
int		x2
int		y2

void
XDrawRectangle(dpy,win,gc,x,y,width,height)
Display *	dpy
Window		win
GC		gc
int		x
int		y
int		width
int		height

void
XDrawString(dpy,win,gc,x,y,string)
Display *	dpy
Window		win
GC		gc
int		x
int		y
SV *		string
CODE:
 {
  if (SvOK(string))
   {STRLEN len;
    char *s = SvPV(string,len);
    if (s && len)
     {
      XDrawString(dpy,win,gc,x,y,s,len);
     }
   }
 }

Window
RootWindow(dpy,scr = DefaultScreen(dpy))
Display *	dpy
int		scr

char *
DisplayString(dpy)
Display *	dpy

int
DefaultScreen(dpy)
Display *	dpy

Screen *
ScreenOfDisplay(dpy,scr = DefaultScreen(dpy))
Display *	dpy
int		scr

GC
DefaultGC(dpy,scr)
Display *	dpy
int		scr

void
XQueryTree(dpy,w,root = NULL,parent = NULL)
Display *	dpy
Window		w
SV *		root
SV *		parent
PPCODE:
 {Window *children = NULL;
  unsigned int count = 0;
  Window pw = None;
  Window rw = None;
  if (XQueryTree(dpy, w, &rw, &pw, &children, &count))
   {
    unsigned int i;
    for (i=0; i < count; i++)
     {
      SV *sv = sv_newmortal();
      sv_setref_iv(sv, "Window", (IV) (children[i]));
      XPUSHs(sv);
     }
    XFree((char *) children);
   }
  else
   {
    count = 0;
    XSRETURN(0);
   }
  if (parent)
   {
    if (pw == None)
     sv_setsv(parent,&PL_sv_undef);
    else
     sv_setref_iv(parent, "Window", (IV) (pw));
   }
  if (root)
   {
    if (rw == None)
     sv_setsv(root,&PL_sv_undef);
    else
     sv_setref_iv(root, "Window", (IV) (rw));
   }
  XSRETURN(count);
 }

MODULE = Tk::Xlib	PACKAGE = GC	PREFIX = XSet

static GC
GC::new(dpy,win,...)
Display *	dpy
Window		win
CODE:
  {unsigned long valuemask = 0;
   XGCValues values;
   STRLEN na;
   int i;
   for (i=3; i < items; i += 2)
    {char *key = SvPV(ST(i),na);
     if (i+1 < items)
      valuemask = GCSetValue(aTHX_ valuemask,&values,key,ST(i+1));
     else
      croak("No value for %s",key);
    }
   RETVAL = XCreateGC(dpy,win,valuemask,&values);
  }
OUTPUT:
  RETVAL

void
XSetForeground(dpy,gc,val)
Display *	dpy
GC		gc
unsigned long	val

BOOT:
 {
  IMPORT_VTABLES;
 }