Program systemefenetrage; (***************************************************************************) (* Programme de systŠme de fenetrage avec boutons et gestion de la souris *) (* PATAUD Fr‚d‚ric & PEYRAT Fran‡ois 1993/1994 *) (***************************************************************************) Begin Pref iiuwgraph block Begin Pref mouse block var f : file, w : windows; Unit Line : procedure (x1,y1,x2,y2,c : integer); Begin call color(c); call move(x1,y1); call draw(x2,y2); End Line; Unit Rectangle : procedure (x1,y1,x2,y2,c : integer); Begin writeln(f,x1,y1,x2,y2,c); call color(c); call move(x1,y1); call draw(x2,y1); call draw(x2,y2); call draw(x1,y2); call draw(x1,y1); End Rectangle; Unit Rectanglef : procedure (x1,y1,x2,y2,c : integer); var i : integer; Begin for i:=y1 to y2 do call Line(x1,i,x2,i,c); od End Rectanglef; Unit windows : class; var ind,indc,x1,y1,x2,y2: integer, rgs_pere : rgs, menubar : menu; unit menu : class(nom : string,action : integer,suiv : menu); var p_rgs : rgs, x1,y1,x2,y2,c : integer; unit affiche : procedure; begin if suiv =/= none then call suiv.affiche; fi; call rectanglef(x1+1,y1+1,x2-1,y2-1,7); call color(c); call move(x1+10,y2-15); call outstring(nom); call rectangle(x1,y1,x2,y2,c); end affiche; begin c := indc; indc := indc + 1; x1 := 20 + ind; y1 := 5; x2 := 120 + ind; y2 := 25; p_rgs := rgs_pere; while p_rgs.suiv =/= none do p_rgs := p_rgs.suiv;od ; p_rgs.suiv := new rgs(x1,y1,x2,y2,action); ind := ind + 120; end menu; unit gestionnaire : procedure; var choix,h,v,p,b:integer, l,r,c:boolean; begin call showcursor; do l,r := false; (* call status(h,v,l,r,c); if r then exit fi; p:=0; call status(h,v,l,r,c);*) while not l and not r do call getpress(0,h,v,p,l,r,c);od; if r then exit fi; if p <>0 then call rectangle(50,50,h,v,3); choix := 0; choix := quoi(h,v); writeln(f,"choix : ",choix); case choix when 1 : call rectangle(200,200,250,250,3); writeln(f,"r1 "); when 2 : call rectangle(160,160,300,300,3); writeln(f,"r2"); when 3 : call rectangle(120,120,350,350,3); writeln(f,"r3"); esac; fi; p := 0; od; end; unit quoi : function (h,v : integer) : integer; var p_rgs : rgs, resultat : integer, a,b,c : boolean; begin p_rgs := rgs_pere; p_rgs := p_rgs.suiv; do a:=(p_rgs.x1 < h and p_rgs.x2> h ) ; b:=(p_rgs.y1 < v and p_rgs.y2 > v) ; c:= a and b; if c then result := p_rgs.code; return; fi; if p_rgs.suiv =/= none then p_rgs:=p_rgs.suiv; else result := 0; return; fi; od; end quoi; unit rgs : class(x1,y1,x2,y2,code : integer); var suiv : rgs; begin call rectangle(x1,y1+100,x2,y2+100,15); end rgs; unit affiche : procedure(x1,y1,x2,y2 : integer); begin call rectangle(x1,y1,x2,y2,1); call rectanglef(x1+3,y1+3,x2-3,30,8); call rectangle(x1+3,33,x2-3,y2-3,9); end affiche; begin ind := 0; indc := 4; x1 := 0; y1 := 0; x2 := 639; y2 := 479; call affiche(x1,y1,x2,y2); rgs_pere := new rgs(0,0,0,0,0); inner; call gestionnaire; End windows; Unit monwindows : windows class; begin menubar := new menu("troisieme",3, new menu("deuxieme",2, new menu("premier",1,none))); call menubar.affiche; End monwindows; Begin open(f,text,unpack("testing")); call rewrite(f); call gron(1); w := new monwindows; call groff; kill(f); end; end; end.