377 lines · 8.3 KB · Brainfuck
RawDownload
implement iWindowPeer_L; include "jni.m";    jni : JNI;        ClassModule,        JString,        JArray,        JArrayI,        JArrayC,        JArrayB,        JArrayS,        JArrayJ,        JArrayF,        JArrayD,        JArrayZ,        JArrayJObject,        JArrayJClass,        JArrayJString,        JClass,        JObject : import jni; #>> extra pre includes here##  %W% - %E%# 	cast : Cast;	sys : Sys;        draw: Draw;        Context, Screen, Display, Rect, Font, Point, Image: import draw; include "tk.m";	tk: Tk;	Toplevel: import tk; include	"wmlib.m";	wmlib: Wmlib; include "awt_Color.m";        awt : AwtColor;#<< include "iWindowPeer_L.m"; #>> extra post includes here	str : String;	Value : import jni;	ctxt : ref Draw->Context;	cvm : ref Canvas;#<< init( jni_p : JNI ){    # save java native inteface mod instance    jni = jni_p;    #>>extra initialization here        sys = jni->sys;        str = load String String->PATH;        awt = load AwtColor AwtColor->PATH;        cast = jni->CastMod();        ctxt = jni->getContext();    #<<} getRefImage_rObject( this : ref iWindowPeer_obj) : ref Draw->Image{#>>	return this.pCanvas.image;}#<< getRefOffScreenImage_rObject( this : ref iWindowPeer_obj) : ref Draw->Image{#>>	return this.pCanvas.buf;}#<< pReshape_I_I_I_I_V( this : ref iWindowPeer_obj, p0 : int,p1 : int,p2 : int,p3 : int){#>>	strcmd := ". configure -x " + 		string p0 + " -y " + string p1 + " -width " + string p2 + " -height " + string p3;		tk->cmd(this.pCanvas.top, strcmd);	tk->cmd(this.pCanvas.top, "update");	this.pCanvas.image = this.pCanvas.top.image;	}#<< pHide_V( this : ref iWindowPeer_obj){#>>	tk->cmd(this.pCanvas.top, ". unmap");	this.pCanvas.image = nil;}#<< pShow_riWindowPeer_V( this : ref iWindowPeer_obj, p0: JObject){#>>	tk->cmd(this.pCanvas.top, ". map");	return; 	args := array[0] of ref Value;	(val, err) := jni->CallMethod(this.target, "repaint", "()V", args);	if (err != jni->OK){		sys->print( "CallMethod Error %d: repaint\n",err);	}}#<< getXYLoc_I_I( this : ref iWindowPeer_obj, p0 : int) : int{#>>	if (p0 == 0)		return cvm.rect.min.x;	else		return cvm.rect.min.y;}#<< create_riWindowPeer_V( this : ref iWindowPeer_obj, p0 : JObject){#>>	xval := jni->GetObjField(this.target, "x", "I");	yval := jni->GetObjField(this.target, "y", "I");	wval := jni->GetObjField(this.target, "width", "I");	hval := jni->GetObjField(this.target, "height", "I");		x := xval.Int();	y := yval.Int();	w := wval.Int();	h := hval.Int(); 	makewin(ctxt, x, y, w, h, this, p0); 	this.topInset = 0;	this.leftInset = 0;	this.rightInset = 0;	this.bottomInset = 0;	this.left = this.pCanvas.rect.min.x;	this.top = this.pCanvas.rect.min.y;         tk->cmd(this.pCanvas.top, ". unmap");	this.pCanvas.image = nil;	}#<< pDispose_V( this : ref iWindowPeer_obj){#>>	this.pCanvas.jtd <- = "Die!";		this.pCanvas.top = nil;	this.pCanvas.image = nil;	this.pCanvas.buf = nil;	this.pCanvas = nil;}#<< setCursor_I_V( this : ref iWindowPeer_obj, p0 : int){#>>}#<< toFront_V( this : ref iWindowPeer_obj){#>>	this.pCanvas.image.top();}#<< toBack_V( this : ref iWindowPeer_obj){#>>	this.pCanvas.image.bottom();}#<< #>> screen: ref Screen;display: ref Display;ones: ref Image;white: ref Image; 	Event: adt	{		event:	int;		detail:	string; 		Button, Key,		Icon, DeIcon,		Resize, Shutdown			: con iota;	}; 	Attr: adt	{		origin:	Draw->Point;		dims:		Draw->Point;	}; 	Canvas: adt	{		# interface		image:	ref Draw->Image;		buf:	ref Draw->Image;		rect:		Draw->Rect;		events:	chan of ref Event;		attr:		ref Attr;		jtd : chan of string;		# implementation		ctxt : ref Draw->Context;		top:		ref Tk->Toplevel;		canvas:	string;		pid:		int;	};#<< #>>win_cfg := array[] of {	"canvas .w -height 2 -width 2",	"pack .w -side bottom -fill both -expand 1",	"pack propagate . 0",}; win_bind := array[] of {	"bind # <Motion> {send butt m %b %X %Y}",#	"bind # <Leave> {send butt Leave}",	"bind # <ButtonPress> {focus #;send butt p %b %X %Y}",	"bind # <ButtonRelease> {send butt r %b %X %Y}",	"bind # <Double-Button> {send butt d %b %X %Y}",#	"bind # <Enter> {send butt Enter}",	"bind # <KeyPress> {send key %K}",#        "bind . <FocusIn> {send foc focus}",}; modinit(ctxt: ref Context){	draw = load Draw Draw->PATH;	tk = load Tk Tk->PATH;	wmlib = load Wmlib Wmlib->PATH; 	screen = ctxt.screen;	wmlib->init();} makewin(ctxt: ref Context, x, y, width, height: int, this: ref iWindowPeer_obj, job: JObject){	modinit(ctxt);	where := "-x " + string x + " -y " + string y;	t := tk->toplevel(screen, "-borderwidth 0 -relief raised "+where);#	(t, menu) := wmlib->titlebar(screen, where, title, Wmlib->Appl); 	if (width > 0 && height > 0)		win_cfg[0] = "canvas .w -height " + string height + " -width " + string width; 	wmlib->tkcmds(t, win_cfg);	ones = t.image.display.ones;	white = t.image.display.color(Draw->White);	alloccanvas(t, ctxt, ".w", this, job);} alloccanvas(t: ref Toplevel, ctxt: ref Draw->Context, canvas: string, this :ref iWindowPeer_obj, job: JObject){	cmd := chan of string;	tk->namechan(t, cmd, "cmd");	butt := chan of string;	tk->namechan(t, butt, "butt"); 	key := chan of string;	tk->namechan(t, key, "key"); 	tk->cmd(t, "bind . <Configure> {send cmd resize}");	tk->cmd(t, "bind . <Map> {send cmd map}"); 	for (i := 0; i < len win_bind; i++)		tk->cmd(t, expand(win_bind[i], canvas)); 	tk->cmd(t, "update");		c := ref Canvas;	this.pCanvas = c;	c = nil;         bg := Draw->White;        jcol := jni->GetObjField(this.target, "background", "Ljava/awt/Color;");        if (jcol == nil) {                sys->print("Cannot get background color\n");        } else {                color := jcol.Object();                bg = awt->getColorIndex(jni, color);        } 	this.pCanvas.image = t.image;	display = t.image.display;		this.pCanvas.rect = canvposn(t, canvas);	this.pCanvas.buf = ctxt.display.newimage(ctxt.display.image.r,                                 this.pCanvas.image.ldepth , 0, bg);	this.pCanvas.events = chan of ref Event;	this.pCanvas.top = t;	this.pCanvas.ctxt = ctxt;	this.pCanvas.canvas = canvas;	this.pCanvas.pid = sys->pctl(0, nil); 	spawn handler(cmd, butt, key, this, job);} handler(cmd, butt, key : chan of string, this : ref iWindowPeer_obj, job: JObject){ 	detail: string; 	jtd := chan of string;	this.pCanvas.jtd = jtd; 	for (;;) alt {	detail = <- this.pCanvas.jtd => 		return;	detail = <- cmd =>		(n, word) := sys->tokenize(detail, " ");		case hd word {		"map" =>			this.pCanvas.image = this.pCanvas.top.image;			handleRepaint(this); 		* =>			;		} 	detail = <- butt =>		               doMouseEvent(job, detail);	detail = <- key =>			 (kchar, st) := str->toint(detail, 16);			 args := array[1] of ref Value;			 args[0] = ref Value.TInt(kchar);			(val, err) := jni->CallMethod(job, "handleKeyEvents", "(I)V", args);				if (err != jni->OK){				sys->print( "CallMethod Error %d: handleKeyEvents\n",err);			}	}}expand(cmd, canvas: string): string{	s: string;	for (;;) {		(l, r) := str->splitl(cmd, "#");		s = s + l;		if (r == nil)			return s;		s = s + canvas;		cmd = r[1:];	}} canvposn(t: ref Toplevel, c: string): Rect{	r: Rect; 	r.min.x = int tk->cmd(t, ". cget -actx") + int tk->cmd(t, ".dx get");	r.min.y = int tk->cmd(t, ". cget -acty") + int tk->cmd(t, ".dy get");	r.max.x = r.min.x + int tk->cmd(t, ". cget -actwidth") + int tk->cmd(t, ".dw get");	r.max.y = r.min.y + int tk->cmd(t, ". cget -actheight") + int tk->cmd(t, ".dh get");	return r;} doMouseEvent(job: JObject, detail : string){	(n,toks) := sys->tokenize(detail," ");	if (n != 4) return;	mode := array of byte hd toks;	toks = tl toks;	button:=int hd toks;	toks = tl toks;			x:=int hd toks;	toks = tl toks;			y:=int hd toks;    args := array[4] of ref Value;    args[0] = ref Value.TInt(int mode[0]);    args[1] = ref Value.TInt(button);    args[2] = ref Value.TInt(x);    args[3] = ref Value.TInt(y);    (val, err) := jni->CallMethod(job, "handleMouseEvents", "(IIII)V", args);    if (err != jni->OK){        sys->print( "CallMethod Error %d: handleMouseEvents\n",err);    }} handleRepaint(this : ref iWindowPeer_obj){        args := array[0] of ref Value;        (val, err) := jni->CallMethod(this.target, "repaint", "()V", args);        if (err != jni->OK){                sys->print( "CallMethod Error %d: repaint\n",err);        }}#<<