#include "xlib.h"

static Display_Visit (dp, f) s48_value *dp; int (*f)(); {
    (*f)(&DISPLAY(*dp)->after);
}

Generic_Predicate (Display)

Generic_Equal (Display, DISPLAY, dpy)

static Display_Print (d, port, raw, depth, length) s48_value d, port; {
    Printf (port, "#[display %lu %s]", (unsigned)DISPLAY(d)->dpy,
	DisplayString (DISPLAY(d)->dpy));
}

s48_value Make_Display (finalize, dpy) Display *dpy; {
    s48_value d;

    d = Find_Object (T_Display, (GENERIC)dpy, Match_X_Obj);
    if (S48_NULL_P (d)) {
	d = Alloc_Object (sizeof (struct S_Display), T_Display, 0);
	DISPLAY(d)->dpy = dpy;
	DISPLAY(d)->free = 0;
	DISPLAY(d)->after = S48_FALSE;
	Register_Object (d, (GENERIC)dpy, finalize ? P_Close_Display :
	    (PFO)0, 1);
    }
    return d;
}

static s48_value P_Open_Display (argc, argv) s48_value *argv; {
    register char *s;
    Display *dpy;

    if (argc == 1) {
	if ((dpy = XOpenDisplay (Get_Strsym (argv[0]))) == 0)
	    Primitive_Error ("cannot open display ~s", argv[0]);
    } else if ((dpy = XOpenDisplay ((char *)0)) == 0) {
	s = XDisplayName ((char *)0);
	Primitive_Error ("cannot open display ~s",
	    Make_String (s, strlen (s)));
    }
    return Make_Display (1, dpy);
}

s48_value P_Close_Display (d) s48_value d; {
    register struct S_Display *p;

    Check_Type (d, T_Display);
    p = DISPLAY(d);
    if (!p->free) {
	Terminate_Group ((GENERIC)p->dpy);
	XCloseDisplay (p->dpy);
    }
    Deregister_Object (d);
    p->free = 1;
    return Void;
}

static s48_value P_Display_Default_Root_Window (d) s48_value d; {
    Check_Type (d, T_Display);
    return Make_Window (0, DISPLAY(d)->dpy,
	DefaultRootWindow (DISPLAY(d)->dpy));
}

static s48_value P_Display_Default_Colormap (d) s48_value d; {
    register Display *dpy;

    Check_Type (d, T_Display);
    dpy = DISPLAY(d)->dpy;
    return Make_Colormap (0, dpy, DefaultColormap (dpy, DefaultScreen (dpy)));
}

static s48_value P_Display_Default_Gcontext (d) s48_value d; {
    register Display *dpy;

    Check_Type (d, T_Display);
    dpy = DISPLAY(d)->dpy;
    return Make_Gc (0, dpy, DefaultGC (dpy, DefaultScreen (dpy)));
}

static s48_value P_Display_Default_Depth (d) s48_value d; {
    register Display *dpy;

    Check_Type (d, T_Display);
    dpy = DISPLAY(d)->dpy;
    return s48_enter_integer (DefaultDepth (dpy, DefaultScreen (dpy)));
}

static s48_value P_Display_Default_Screen_Number (d) s48_value d; {
    Check_Type (d, T_Display);
    return s48_enter_integer (DefaultScreen (DISPLAY(d)->dpy));
}

int Get_Screen_Number (dpy, scr) Display *dpy; s48_value scr; {
    register s;

    if ((s = (int)s48_extract_integer (scr)) < 0 || s > ScreenCount (dpy)-1)
	Primitive_Error ("invalid screen number");
    return s;
}

static s48_value P_Display_Cells (d, scr) s48_value d, scr; {
    Check_Type (d, T_Display);
    return s48_enter_integer (DisplayCells (DISPLAY(d)->dpy,
	Get_Screen_Number (DISPLAY(d)->dpy, scr)));
}

static s48_value P_Display_Planes (d, scr) s48_value d, scr; {
    Check_Type (d, T_Display);
    return s48_enter_integer (DisplayPlanes (DISPLAY(d)->dpy, 
	Get_Screen_Number (DISPLAY(d)->dpy, scr)));
}

static s48_value P_Display_String (d) s48_value d; {
    register char *s;

    Check_Type (d, T_Display);
    s = DisplayString (DISPLAY(d)->dpy);
    return Make_String (s, strlen (s));
}

static s48_value P_Display_Vendor (d) s48_value d; {
    register char *s;
    s48_value ret, name;
    S48_DECLARE_GC_PROTECT(1);

    Check_Type (d, T_Display);
    s = ServerVendor (DISPLAY(d)->dpy);
    name = Make_String (s, strlen (s));
    S48_GC_PROTECT_1 (name);
    ret = s48_cons (S48_NULL, s48_enter_integer (VendorRelease (DISPLAY(d)->dpy)));
    S48_CAR (ret) = name;
    S48_GC_UNPROTECT;
    return ret;
}

static s48_value P_Display_Protocol_Version (d) s48_value d; {
    Check_Type (d, T_Display);
    return s48_cons (s48_enter_integer (ProtocolVersion (DISPLAY(d)->dpy)),
	s48_enter_integer (ProtocolRevision (DISPLAY(d)->dpy)));
}

static s48_value P_Display_Screen_Count (d) s48_value d; {
    Check_Type (d, T_Display);
    return s48_enter_integer (ScreenCount (DISPLAY(d)->dpy));
}

static s48_value P_Display_Image_Byte_Order (d) s48_value d; {
    Check_Type (d, T_Display);
    return Bits_To_Symbols ((unsigned long)ImageByteOrder (DISPLAY(d)->dpy),
	0, Byte_Order_Syms);
}

static s48_value P_Display_Bitmap_Unit (d) s48_value d; {
    Check_Type (d, T_Display);
    return s48_enter_integer (BitmapUnit (DISPLAY(d)->dpy));
}

static s48_value P_Display_Bitmap_Bit_Order (d) s48_value d; {
    Check_Type (d, T_Display);
    return Bits_To_Symbols ((unsigned long)BitmapBitOrder (DISPLAY(d)->dpy),
	0, Byte_Order_Syms);
}

static s48_value P_Display_Bitmap_Pad (d) s48_value d; {
    Check_Type (d, T_Display);
    return s48_enter_integer (BitmapPad (DISPLAY(d)->dpy));
}

static s48_value P_Display_Width (d) s48_value d; {
    Check_Type (d, T_Display);
    return s48_enter_integer (DisplayWidth (DISPLAY(d)->dpy,
	DefaultScreen (DISPLAY(d)->dpy)));
}

static s48_value P_Display_Height (d) s48_value d; {
    Check_Type (d, T_Display);
    return s48_enter_integer (DisplayHeight (DISPLAY(d)->dpy,
	DefaultScreen (DISPLAY(d)->dpy)));
}

static s48_value P_Display_Width_Mm (d) s48_value d; {
    Check_Type (d, T_Display);
    return s48_enter_integer (DisplayWidthMM (DISPLAY(d)->dpy,
	DefaultScreen (DISPLAY(d)->dpy)));
}

static s48_value P_Display_Height_Mm (d) s48_value d; {
    Check_Type (d, T_Display);
    return s48_enter_integer (DisplayHeightMM (DISPLAY(d)->dpy,
	DefaultScreen (DISPLAY(d)->dpy)));
}

static s48_value P_Display_Motion_Buffer_Size (d) s48_value d; {
    Check_Type (d, T_Display);
    return s48_enter_integer (XDisplayMotionBufferSize (DISPLAY(d)->dpy));
}

static s48_value P_Display_Flush_Output (d) s48_value d; {
    Check_Type (d, T_Display);
    XFlush (DISPLAY(d)->dpy);
    return Void;
}

static s48_value P_Display_Wait_Output (d, discard) s48_value d, discard; {
    Check_Type (d, T_Display);
    Check_Type (discard, T_Boolean);
    XSync (DISPLAY(d)->dpy, S48_EQ_P(discard, S48_TRUE));
    return Void;
}

static s48_value P_No_Op (d) s48_value d; {
    Check_Type (d, T_Display);
    XNoOp (DISPLAY(d)->dpy);
    return Void;
}

static s48_value P_List_Depths (d, scr) s48_value d, scr; {
    int num;
    register *p, i;
    s48_value ret;

    Check_Type (d, T_Display);
    if (!(p = XListDepths (DISPLAY(d)->dpy,
	    Get_Screen_Number (DISPLAY(d)->dpy, scr), &num)))
	return S48_FALSE;
    ret = s48_make_vector (num, S48_NULL);
    for (i = 0; i < num; i++)
	S48_VECTOR_SET(ret, i, s48_enter_integer (p[i]);)
    XFree ((char *)p);
    return ret;
}

static s48_value P_List_Pixmap_Formats (d) s48_value d; {
    register XPixmapFormatValues *p;
    int num;
    register i;
    s48_value ret;
    S48_DECLARE_GC_PROTECT(1);

    Check_Type (d, T_Display);
    if (!(p = XListPixmapFormats (DISPLAY(d)->dpy, &num)))
	return S48_FALSE;
    ret = s48_make_vector (num, S48_NULL);
    S48_GC_PROTECT_1 (ret);
    for (i = 0; i < num; i++) {
	s48_value t;
	
	t = P_Make_List (s48_enter_integer (3), S48_NULL);
	S48_VECTOR_SET(ret, i, t;)
	S48_CAR (t) = s48_enter_integer (p[i].depth); t = S48_CDR (t);
	S48_CAR (t) = s48_enter_integer (p[i].bits_per_pixel); t = S48_CDR (t);
	S48_CAR (t) = s48_enter_integer (p[i].scanline_pad);
    }
    S48_GC_UNPROTECT;
    XFree ((char *)p);
    return ret;
}

elk_init_xlib_display () {
    T_Display = Define_Type (0, "display", NOFUNC, sizeof (struct S_Display),
	Display_Equal, Display_Equal, Display_Print, Display_Visit);
    Define_Primitive (P_Displayp,        "display?",         1, 1, EVAL);
    Define_Primitive (P_Open_Display,    "open-display",     0, 1, VARARGS);
    Define_Primitive (P_Close_Display,   "close-display",    1, 1, EVAL);
    Define_Primitive (P_Display_Default_Root_Window,
			"display-default-root-window",       1, 1, EVAL);
    Define_Primitive (P_Display_Default_Colormap,
			"display-default-colormap",          1, 1, EVAL);
    Define_Primitive (P_Display_Default_Gcontext,
			"display-default-gcontext",          1, 1, EVAL);
    Define_Primitive (P_Display_Default_Depth,
			"display-default-depth",             1, 1, EVAL);
    Define_Primitive (P_Display_Default_Screen_Number,
			"display-default-screen-number",     1, 1, EVAL);
    Define_Primitive (P_Display_Cells,   "display-cells",    2, 2, EVAL);
    Define_Primitive (P_Display_Planes,  "display-planes",   2, 2, EVAL);
    Define_Primitive (P_Display_String,  "display-string",   1, 1, EVAL);
    Define_Primitive (P_Display_Vendor,  "display-vendor",   1, 1, EVAL);
    Define_Primitive (P_Display_Protocol_Version,
			"display-protocol-version",          1, 1, EVAL);
    Define_Primitive (P_Display_Screen_Count,
			"display-screen-count",              1, 1, EVAL);
    Define_Primitive (P_Display_Image_Byte_Order,
			"display-image-byte-order",          1, 1, EVAL);
    Define_Primitive (P_Display_Bitmap_Unit,
			"display-bitmap-unit",               1, 1, EVAL);
    Define_Primitive (P_Display_Bitmap_Bit_Order,
			"display-bitmap-bit-order",          1, 1, EVAL);
    Define_Primitive (P_Display_Bitmap_Pad,
			"display-bitmap-pad",                1, 1, EVAL);
    Define_Primitive (P_Display_Width,   "display-width",    1, 1, EVAL);
    Define_Primitive (P_Display_Height,  "display-height",   1, 1, EVAL);
    Define_Primitive (P_Display_Width_Mm,"display-width-mm", 1, 1, EVAL);
    Define_Primitive (P_Display_Height_Mm,
			"display-height-mm",                 1, 1, EVAL);
    Define_Primitive (P_Display_Motion_Buffer_Size,
			"display-motion-buffer-size",        1, 1, EVAL);
    Define_Primitive (P_Display_Flush_Output,
			"display-flush-output",              1, 1, EVAL);
    Define_Primitive (P_Display_Wait_Output,
			"display-wait-output",               2, 2, EVAL);
    Define_Primitive (P_No_Op,           "no-op",            1, 1, EVAL);
    Define_Primitive (P_List_Depths,      "list-depths",     2, 2, EVAL);
    Define_Primitive (P_List_Pixmap_Formats,
			"list-pixmap-formats",               1, 1, EVAL);
}