view tk/bou.tokio @ 10:f2aa38ce0787

add state display.
author kono
date Fri, 19 Jan 2001 23:14:00 +0900
parents 1c57a78f1d98
children
line wrap: on
line source

%% ------------------------------------------------- BOUNCE

:-use_module(library(tcltk)).

toy :-  static([green, red, move, stop, start,quit]),
	tk([name(toy)]),
	*move:=0,*quit:=0,*stop:=0,*start:=0,*red:=1,*green:=0,
	toy_init,
	fin(tcl_command('destroy .')),
	keep(tcl_command(update)).

toy0 :-  static([green, red, move, stop, start,quit]),
	% tk([name(toy)]),
	*move:=0,*quit:=0,*stop:=0,*start:=0,*red:=1,*green:=0,
	toy_init,
	fin(tcl_command('destroy .')),
	keep(tcl_command(update)).

toy_init :-
	[](check_event),		% Synchronize event
        bounce_init([W|T],R,G),
	@toy1([W|T],R,G).

toy1(W,R,G) :- 
	s1,						% automaton
	[]((button_red(R),button_green(G),bounce(W))).  % output

% ?- compile(['../tableau/gi.out']).

% tokio / tcl event link
start :- *start := 1,@((*start:=0;true)).
stop :-  *stop  := 1,@((*stop:=0;true)).
quit :-  *quit := 1.

button_red(Out) :-
        *red =0, out(Out,'""',red).
button_red(Out) :-
        *red =1, out(Out,'Red',red).
button_green(Out) :-
        *green =0, out(Out,'""',green).
button_green(Out) :-
        *green =1, out(Out,'Green',green).

% size(400,400,10,fixed) :- true.
size(200,200,5,'7x14') :- true.

bounce_init( [Window0, View0, Circ0, Xout0, X, Yout0, 
        Y, Xd, Yd, Ydd, Xlim, Ylim],Xout0,Yout0) :-
%       Tcl/Tk link part

	Window = '.toy',View = '$w.canvas0',
	Xout = '$w.frame1.label3',  	% red
	Yout = '$w.frame1.label2',  	% green
%	Start = '$w.frame1.button6', 	% run
%	Stop = '$w.frame1.button5',  	% stop
%	Quit = '$w.frame1.button4',  	% quit

        size(Hight,Width,R,_Font),
	H0 = Hight-2, W0 = Width-2,
	H1 = Hight/2, W1 = Width/2,
	view(Hight,Width,Window,View),
%	Box <= hbox([vbox([Xout,Yout,space,Start,Stop,Quit]),View]),
	rectangle(0,0,0,H0,W0,View),
        Circ = 'circle',circle(1,Circ,H1,W1,R,View),	
	Window0<--Window, View0<--View, Circ0<--Circ, 
	Xout0<--Xout,  Yout0<--Yout,
	Ylim = Hight-10, Xlim = Width-10, Ydd = -R/2,
	#((@Ylim=Ylim,@Xlim=Xlim,@Ydd=Ydd)),
	@X = H1, @Y = W1, @Xd = R/2, @Yd = R*2.
bounce([_, View, Obj, _Xout, X, _Yout, Y, Xd, Yd, Ydd, Xlim, _]) :- 
	*move = 1,*quit = 0,
	Y1 is Y+Yd,
        moveto(View,Obj,X,Y),      
	calc_xd(X, Xd, Xd1, Xlim),
	calc_yd(Y, Yd, Ydt, Y1, Yt1),
	@X = X+Xd,@Xd = Xd1, @Y = Yt1, @Yd = Ydt+Ydd.
bounce([_, _, _, _, X, _, Y, Xd, Yd, _, _, _]) :- 
	*move = 0,*quit = 0,
	@X = X,@Xd = Xd, @Y = Y, @Yd = Yd.
bounce([_W|_]) :-
	*quit = 1.

calc_xd(X, Xd, Xd1, _) :- X < 10,  Xd1 is abs(Xd).
calc_xd(X, Xd, Xd1, Xlim) :- X > Xlim,  Xd1 is -abs(Xd).
calc_xd(_, Xd, Xd, _):-true.

calc_yd(Y, Yd, Ydt, _, Y0) :-
	Y < 10,  Yd > 0 , Ydt = Yd,Y0 = 10.
calc_yd(Y, Yd, Ydt, _, Y0) :-
	Y < 10, Ydt = 9*(-Yd)/10,Y0 = 10.
calc_yd(_, Yd, Yd, Y1, Y1):-true.

% Tcl/Tk stuff

out(Out,Data,Color) :-
	tcl_command([Out,' configure -text ',Data,' -foreground ',Color]).

view(_H,_W,Window,_View) :- 
	tcl_command(['set w ',Window]),
	tcl_command('source bou.tcl').

rectangle(1,X,Y,X2,Y2,View) :-!,
        tcl_command([View,' create rectangle ',
                  X,' ',Y,' ', X2,' ',Y2,' ',
                 '-stipple gray50 -fill black'
        ]).

rectangle(0,X,Y,X2,Y2,View) :- 
        tcl_command([View,' create rectangle ',
                  X,' ',Y,' ', X2,' ',Y2
        ]).

circle(1,C,X,Y,R,View) :-!, 
	X0 is X-R, Y0 is Y-R, X1 is X+R, Y1 is Y+R,
        tcl_command([View,' create oval ',
                  X0,' ',Y0,' ', X1,' ',Y1,' -tag ',C,
                 ' -stipple gray50 -fill black'
        ]).

circle(0,C,X,Y,R,View) :-!,
	X0 is X-R, Y0 is Y-R, X1 is X+R, Y1 is Y+R,
        tcl_command([View,' create oval ',
                  X0,' ',Y0,' ', X1,' ',Y1,' -tag ',C,
                 ' -stipple gray50 -fill black'
        ]).

move(View,Obj,X,Y) :- prolog((
        tcl_command([View,' move ',Obj,' ',X,' ',Y])
        )).

moveto(View,Obj,X,Y) :- 
        size(H,_,R,_),
	X0 is X-R, Y0 is H-(Y-R), X1 is X+R, Y1 is H-(Y+R),
	tcl_command([View,' coords ',Obj,' ',X0,' ',Y0,' ', X1,' ',Y1]).

tk(X) :- prolog(tk_new(X,I)),*int:=I.
tcl_command(X) :- 
	% write(X),nl,
	I= *int,prolog(tcl_eval(I,X,_)).