Added upstream from http://ftp.icm.edu.pl/pub/loglan/
[loglan.git] / examples / examples / strassen.log
1 program STRAS ;\r
2 (*************************************************************************\r
3        Auteurs : AKPAMOLI Eudes\r
4                  HANNOYER Philippe\r
5        ___________________________\r
6  \r
7  \r
8        Projet nø 1 Li1\r
9  \r
10  \r
11        Multiplication de deux matrices selon l'algorithme r\82cursif\r
12        de Strassen (ou diviser pour r\8agner)\r
13  \r
14        Programme r\82alis\82 en Loglan 82, sur un PC 486,\r
15        \82cran SVGA Couleur (640 x 480) avec h\82ritage des deux unit\82s\r
16            * unit\82 graphique : IIUWGRAPH\r
17            * unit\82 de gestion de la souris : MOUSE.\r
18  \r
19        Remarque : Ce programme n\82cessite obligatoirement un PC avec \82cran\r
20                   graphique (640 x 480). Il est pr\82f\82rable d'uiliser une souris.\r
21                   En effet certaines parties de l'interface graphique ne\r
22                   r\82agissent qu'avec la souris (ascenseurs g\82rants les scrollings).\r
23  \r
24 **************************************************************************)\r
25  \r
26  \r
27 begin\r
28   Pref iiuwgraph block              (* h\82ritage de l'unt\82 graphique *)\r
29   begin\r
30     Pref mouse block                (* h\82ritage de l'unit\82 souris *)\r
31  \r
32  \r
33  \r
34     (* DEBUT PARTIE GRAPHIQUE *)\r
35  \r
36     (* Sauve une partie de l'\82cran d\82finie par X, Y, XX, YY *)\r
37     unit GET_MAP : function (X, Y, XX, YY : integer) : arrayof integer ;\r
38     begin\r
39       call move (XX,YY) ;\r
40       result:=getmap(X, Y) ;\r
41     end GET_MAP ;\r
42  \r
43     (* Restore la partie d'\82cran sauv\82e par GET_MAP *)\r
44     unit PUT_MAP : procedure (X, Y : integer; Map : arrayof integer) ;\r
45     begin\r
46       call move (X, Y) ;\r
47       call putmap (Map) ;\r
48     end PUT_MAP ;\r
49  \r
50  \r
51  \r
52     (********* BOUTON **********)\r
53     (* Class g\82rant les procedure sur les boutons\r
54              X,Y,XX,YY : Coordonn\82es du bouton,\r
55              Epais : Epaisseur du bord du bouton,\r
56              C1, C2, C3 : Trois couleurs (Fond, Bordure une, Bordure deux).\r
57  \r
58              map_bouton : Sauvegarde de la partie d'\82cran avant affichage,\r
59              Bouton_aff : Bool\82en indiquant si le bouton est affich\82.*)\r
60     unit BOUTON  : class (X, Y, XX, YY, Epais, C1, C2, C3 : Integer) ;\r
61       var map_Bouton : arrayof integer,\r
62           Bouton_Aff : boolean ;\r
63  \r
64       (* Affichage de la bordure d'un bouton *)\r
65       unit BORDURE : procedure (couleur1,couleur2 : integer) ;\r
66         var i : integer ;\r
67       begin\r
68         for i:=0 to Epais-1\r
69         do\r
70           call color(couleur1) ;\r
71           call move (x+1+i,yy-1-i) ;\r
72           call draw (x+1+i,y+1+i) ;\r
73           call draw (xx-1-i,y+1+i) ;\r
74           call color(couleur2) ;\r
75           call draw (xx-1-i,yy-1-i) ;\r
76           call draw (x+1+i,yy-1-i) ;\r
77         od ;\r
78       end BORDURE ;\r
79  \r
80  \r
81       (* Modifie les coordonn\82es d'un bouton *)\r
82       unit CHG_BOUTON_XY : procedure (Nv_X,Nv_Y : integer) ;\r
83       begin\r
84         XX:=Nv_X+(XX-X) ;\r
85         YY:=Nv_Y+(YY-Y) ;\r
86         X:=Nv_X ;\r
87         Y:=Nv_Y ;\r
88       end CHG_BOUTON_XY ;\r
89  \r
90       (* Affichage d'un bouton *)\r
91       unit AFF_BOUTON : procedure ;\r
92       begin\r
93         Bouton_Aff:=True ;\r
94         map_Bouton:=GET_MAP(X,Y,XX,YY) ;\r
95         call patern(x,y,xx,yy,0,1) ;\r
96         call patern(x+1,y+1,xx-1,yy-1,C1,1) ;\r
97         call BORDURE (C2, C3) ;\r
98       end AFF_BOUTON ;\r
99  \r
100       (* Effa\87age d'un bouton *)\r
101       unit EFF_BOUTON : procedure ;\r
102       begin\r
103         Bouton_Aff:=False ;\r
104         call PUT_MAP (X, Y, map_Bouton) ;\r
105       end EFF_BOUTON ;\r
106  \r
107       (* Simulation du clique sur un bouton avec la souris *)\r
108       unit BOUTON_ENFONCE : function (Num,NumSouris,XSouris,YSouris : Integer)\r
109                                                                     : boolean ;\r
110       begin\r
111         result:=(Num=NumSouris) and (Bouton_Aff and (X<=XSouris) and (XX>=XSouris)\r
112                                                 and (Y<=YSouris) and (YY>=YSouris)) ;\r
113         if result\r
114         then\r
115           (* simulation de l'onfoncement du bouton *)\r
116           call BORDURE (C3,C2) ;\r
117           call BORDURE (C2,C3) ;\r
118         fi\r
119       end BOUTON_ENFONCE;\r
120  \r
121 (*       Bouton_Aff := False ;*)\r
122     end BOUTON ;\r
123     (******** BOUTON *********)\r
124  \r
125  \r
126     (********** ASCENSEUR *********)\r
127     (* Class g\82rant les proc\82dures relatives aux Ascenseur\r
128              Hor : Bool\82en \85 vrai si l'ascenseur est horizontal,\r
129              Max : Valeur indiquant le maximum pour le d\82placement de l'ascenseur,\r
130              X, Y : Coordonn\82es haut gauche de l'ascenseur,\r
131              Lgr : Longueur (ou hauteur) de l'ascenseur,\r
132              C1, C2, C3 : Trois couleurs (Fond, Bordure une, Bordure deux).\r
133  \r
134              BPlus, BDep, BBar, BMoins : Boutons de l'ascenseur,\r
135              Map : Sauvegarde l'\82cran avant l'affichage du bouton,\r
136              Courant : Valeur de d\82placement de l'ascenseur. *)\r
137     unit ASCENSEUR : class (Hor:Boolean,Max,X,Y,Lgr,c1,c2,c3 : integer) ;\r
138       Var BPlus, BDep, BBar, BMoins : BOUTON,\r
139           Map : arrayof integer,\r
140           Courant : Integer ;\r
141  \r
142  \r
143       (* Bouge le bouton de d\82placement de l'ascenseur. *)\r
144       unit BOUGE_ASC : procedure (EffAvt : boolean) ;\r
145       begin\r
146         if EffAvt then\r
147           call BDep.EFF_BOUTON ;\r
148         fi ;\r
149         if Max > 0\r
150         then\r
151           if (Hor)\r
152           then\r
153             BDep.X:=X+20+(Lgr-60)*Courant/Max ;\r
154             BDep.XX:=BDep.X+20 ;\r
155           else\r
156             BDep.Y:=Y+20+(Lgr-60)*Courant/Max ;\r
157             BDep.YY:=BDep.Y+20 ;\r
158           fi ;\r
159         fi ;\r
160         call BDep.AFF_BOUTON ;\r
161       end BOUGE_ASC;\r
162  \r
163       (* Affiche l'ascenseur *)\r
164       unit AFF_ASC : procedure  ;\r
165         Var i : Integer ;\r
166       begin\r
167         call BPlus.AFF_BOUTON ;\r
168         call BMoins.AFF_BOUTON ;\r
169         call BBar.AFF_BOUTON ;\r
170         call Color(0) ;\r
171         for i:=1 to 6\r
172         do\r
173           if (Hor) then\r
174             call move (X+5+i,y+11-i) ;\r
175             call draw (X+5+i,y+9+i) ;\r
176             call move (X+Lgr-14+i,y+4+i) ;\r
177             call draw (X+Lgr-14+i,y+16-i) ;\r
178           else\r
179             call move (X+11-i,y+5+i) ;\r
180             call draw (X+9+i,y+5+i) ;\r
181             call move (X+4+i,y+Lgr-14+i) ;\r
182             call draw (X+16-i,y+Lgr-14+i) ;\r
183           fi ;\r
184         od ;\r
185         call BOUGE_ASC (False) ;\r
186       end AFF_ASC ;\r
187  \r
188     begin\r
189       if (Lgr<70) then Lgr := 70 fi ;\r
190       BPlus := new BOUTON (X,Y,X+20,Y+20,2,c1,c3,c2) ;\r
191     if (Hor)\r
192       then\r
193         BDep := new BOUTON (X+20,Y,X+40,Y+20,2,c1,c3,c2) ;\r
194         BBar := new BOUTON (X+20,Y,X+Lgr-20,Y+20,2,c1,c1,c1) ;\r
195         BMoins := new BOUTON (X+Lgr-20,Y,X+Lgr,Y+20,2,c1,c3,c2) ;\r
196        else\r
197         BDep := new BOUTON ( X,Y+20,X+20,Y+40,2,c1,c3,c2) ;\r
198         BBar := new BOUTON ( X,Y+20,X+20,Y+Lgr-20,2,c1,c1,c1) ;\r
199         BMoins := new BOUTON ( X,Y+Lgr-20,X+20,Y+Lgr,2,c1,c3,c2) ;\r
200       fi ;\r
201       Courant := 0 ;\r
202     end ASCENSEUR ;\r
203     (********** ASCENSEUR *********)\r
204  \r
205  \r
206     (********** WINDOWS *********)\r
207     (* Class g\82rant les proc\82dures relatives aux Fen\88tres (ces fen\88tres sont\r
208        celles qui permettent d'afficher les trois matrices (A, B, Res ou Tmp)\r
209              Titre : Nom de la fen\88tre ("A", "B", "Tmp" ou "Res"),\r
210              Maxi : Valeur indiquant la taille de la matrice,\r
211              X, Y : Coordonn\82es haut gauche de la fen\88tre,\r
212  \r
213              A1, A2 : Deux ascenseur (horizontal, vertical),\r
214              Map : Sauvegarde l'\82cran avant l'affichage du bouton,\r
215              Courant : Valeur de d\82placement de l'ascenseur.\r
216              Taille, Fond_win : Deux bouton (les 1er pour afficher la taille de la\r
217                                 matrice, le second qui sert de fond \85 la fen\88tre *)\r
218      unit WINDOWS : class (Titre : string ; Maxi, X, Y : Integer);\r
219       var A1, A2 : ASCENSEUR,\r
220           i : integer,\r
221           Taille, Fond_Win : BOUTON ;\r
222  \r
223       (* Affiche la matrice : au maximum 4 x 4 *)\r
224       unit AFF_MATRICE : procedure (M : arrayof arrayof integer) ;\r
225         var max, i, j : integer ;\r
226       begin\r
227         (* max ne peut \88tre plus grand que 4 *)\r
228         max:=imin(4,upper(M)) ;\r
229         for i:=1 to 4\r
230         do\r
231           (* On efface les \82ventuelles anciennes valeures *)\r
232           call outstring (X+10+(i*58),Y+7,"   ",4,12) ;\r
233           call outstring (X+10,Y+(i*38),"   ",4,12) ;\r
234           for j:=1 to 4\r
235           do\r
236             call outstring (X-21+(i*58),Y+(j*38),"       ",4,12) ;\r
237           od ;\r
238         od ;\r
239         for i:=1 to max\r
240         do\r
241           (* On \82crit les nouvelles valeures *)\r
242           call track (X+10+(i*58),Y+7,A1.Courant+i,12,4) ;\r
243           call track (X+10,Y+(i*38),A2.Courant+i,12,4) ;\r
244           for j:=1 to max\r
245           do\r
246             if Aff_Num_Grd  or M(j+A1.Courant,i+A2.Courant)<=9999999 and\r
247                M(j+A1.Courant,i+A2.Courant)>=-100000\r
248             then\r
249               call track (X-21+(i*58),Y+(j*38),M(j+A1.Courant,i+A2.Courant),12,4) ;\r
250             else\r
251               call outstring (X-21+(i*58),Y+(j*38)," #####",4,12) ;\r
252             fi ;\r
253           od ;\r
254         od ;\r
255       end AFF_MATRICE ;\r
256  \r
257       (* Test si un clique a eu lieu sur un des bouton (+ ou -) de l'ascenseur,\r
258          enventuellement modifie la valeur de courant de l'ascenseur et\r
259          bouge l'ascenseur *)\r
260       unit MOUVE_ASC : procedure (M : arrayof arrayof integer;\r
261                                   A : ASCENSEUR;NumSouris, X_S, Y_S : integer) ;\r
262       begin\r
263         if (A.BMoins.BOUTON_ENFONCE (1,NumSouris,X_S, Y_S))\r
264         then\r
265           if (A.Courant<A.Max)\r
266           then\r
267             (* si le bouton - de l'ascenseur est cliquer et que la valeure courant\r
268             est plus petite que la valeur maximale, alors on bouge l'ascenseur,\r
269             on d\82cr\82ment la valeure courant et on r\82affiche la matrice *)\r
270             A.Courant:=A.Courant+1 ;\r
271             call A.BOUGE_ASC (True) ;\r
272             call AFF_MATRICE (M) ;\r
273           fi ;\r
274         fi ;\r
275         if (A.BPlus.BOUTON_ENFONCE(1,NumSouris,X_S, Y_S))\r
276         then\r
277           if (A.Courant>0)\r
278           then\r
279             (* si le bouton + de l'ascenseur est cliquer et que la valeure courant\r
280             est sup\82rieure  \85 0, alors on bouge l'ascenseur, on d\82cr\82ment la\r
281             valeure courant et on r\82affiche la matrice *)\r
282             A.Courant:=A.Courant-1 ;\r
283             call A.BOUGE_ASC (True) ;\r
284             call AFF_MATRICE (M) ;\r
285           fi ;\r
286         fi ;\r
287       end MOUVE_ASC ;\r
288  \r
289       (* Efface une fen\88tre *)\r
290       unit EFF_WINDOWS : procedure ;\r
291       begin\r
292         call A1.BPlus.EFF_BOUTON ;\r
293         call A2.BPlus.EFF_BOUTON ;\r
294         call A1.BMoins.EFF_BOUTON ;\r
295         call A2.BMoins.EFF_BOUTON ;\r
296         call Fond_Win.EFF_BOUTON ;\r
297         call Fond_Win.EFF_BOUTON ;\r
298         call Taille.EFF_BOUTON ;\r
299       end EFF_WINDOWS;\r
300  \r
301     begin\r
302       Fond_Win:=new BOUTON (X,Y,X+270,Y+180,3,12,13,5) ;\r
303       Taille:= new BOUTON (X+270,Y+180,X+290,Y+200,0,15,15,15) ;\r
304       call Fond_Win.AFF_BOUTON ;\r
305       call Color (0) ;\r
306       (* double cadre dans la fen\88tre *)\r
307       call Move (X+34,Y+4) ; call Draw (X+34,Y+176) ;\r
308       call Move (X+36,Y+4) ; call Draw (X+36,Y+176) ;\r
309       call Move (X+4,Y+27) ; call Draw (X+266,Y+27) ;\r
310       call Move (X+4,Y+29) ; call Draw (X+266,Y+29) ;\r
311       for i:=1 to 3\r
312       do\r
313         (* Cadre s\82parant les valeures *)\r
314         call Move (X+36+(i*58),Y+4) ; call Draw (X+36+(i*58),Y+176) ;\r
315         call Move (X+4,Y+29+(i*38)) ; call Draw (X+266,Y+29+(i*38)) ;\r
316       od ;\r
317       A1 := new ASCENSEUR(True,maxi-4,X,Y+180,270,7,8,15) ;\r
318       A2 := new ASCENSEUR(False,maxi-4,X+270,Y,180,7,8,15) ;\r
319       call A1.AFF_ASC ;\r
320       call A2.AFF_ASC ;\r
321       call Taille.AFF_BOUTON ;\r
322       call Outstring (X+7,Y+10,Titre,12,4) ;\r
323       call track (X+273,Y+184,Maxi,15,0) ;\r
324     end WINDOWS ;\r
325     (********** WINDOWS *********)\r
326  \r
327     (********** AIDE *********)\r
328     (* Class g\82rant les diff\82rents \82cran d'aide\r
329              B1 .. B6 : Six bouton permettant l'affichage des menu d'aide,\r
330              FinAide : Bool\82en qui permet de quitter le menu d'aide,\r
331              Interrupt, x_s, y_s, Key1, Key2, Flags, Num_Mouse : Permet la\r
332                                   gestion des \82v\8anement de la souris *)\r
333     unit AIDE : procedure ;\r
334       var B1, B2, B3, B4, B5, B6 : BOUTON,\r
335           FinAIDE, Interupt : Boolean,\r
336           x_s,y_s,Key1,Key2,Flags,Num_Mouse : integer ;\r
337  \r
338       (* Texte du menu g\82n\82ral *)\r
339       unit AIDE_GRL : procedure ;\r
340       begin\r
341         call outstring (170, 80,"Pour utiliser cette aide cliquez sur le bouton",0,3) ;\r
342         call outstring (170,100,"de votre choix.",0,3) ;\r
343         call outstring (170,130,"Vous trouverez une aide sur :",0,3) ;\r
344         call outstring (170,155,"  -->",0,3) ;\r
345         call outstring (219,155,"Menu :",4,3) ;\r
346         call outstring (170,175,"   Explication des choix du menu.",0,3) ;\r
347         call outstring (170,200,"  -->",0,3) ;\r
348         call outstring (219,200,"Principe du calcul :",4,3) ;\r
349         call outstring (170,220,"   STRASSEN ou diviser pour r\82gner.",0,3) ;\r
350         call outstring (170,245,"  -->",0,3) ;\r
351         call outstring (219,245,"Am\82lioration :",4,3) ;\r
352         call outstring (170,265,"   Comment utiliser des matrices de grandeurs",0,3) ;\r
353         call outstring (170,285,"   diff\82rentes.",0,3) ;\r
354         call outstring (170,310,"Remarques  Le signe '>' dans les menus signifie",5,3) ;\r
355         call outstring (170,330,"           qu'une fen\88tre d\82pend de ce menu.",5,3);\r
356         call outstring (170,360,"           Vous pouvez activer un choix du menu",5,3);\r
357         call outstring (170,380,"           soit en cliquant dessus, soit en tapant",5,3);\r
358         call outstring (170,400,"           la lettre en noire.",5,3);\r
359  \r
360       end AIDE_GRL ;\r
361  \r
362       (* Texte du menu "Aide" *)\r
363       unit AIDE_MENU : procedure ;\r
364       begin\r
365         call outstring (170,75,"Quitter :",4,3) ;\r
366         call outstring (170,95,"  Retourne au syst\8ame d'exploitation.",0,3) ;\r
367         call outstring (170,120,"Variables :",4,3) ;\r
368         call outstring (170,140,"  Affichage de l'\82tat des 7 variables de travail",0,3) ;\r
369         call outstring (170,160,"  ainsi que le nombre de multiplications et",0,3) ;\r
370         call outstring (170,180,"  d'additions utilis\82es en r\82cursif normal, ou par",0,3) ;\r
371         call outstring (170,200,"  STRASSEN.",0,3) ;\r
372         call outstring (170,225,"Suite :",4,3) ;\r
373         call outstring (170,245,"  Etape suivante du calcul.",0,3) ;\r
374         call outstring (170,270,"R\82sultat :",4,3) ;\r
375         call outstring (170,290,"  Calcul direct (pas d'\82tapes interm\82diaires).",0,3) ;\r
376         call outstring (170,315,"Affichage :",4,3) ;\r
377         call outstring (170,335,"  Permet de changer le format des grands nombres.",0,3) ;\r
378         call outstring (170,360,"Aide :",4,3) ;\r
379         call outstring (170,380,"  Pour que la vie soit plus douce ....",0,3) ;\r
380        end ;\r
381  \r
382       (* Texte du menu "Calcul" *)\r
383       unit AIDE_CAL : procedure ;\r
384       begin\r
385         call outstring (170,100,"Soit \85 multiplier 2 matrices n x n.",0,3) ;\r
386         call outstring (170,130,"Principe :",0,3) ;\r
387         call outstring (170,160,"1. Si n > 2 : Calcul de 7 matrices n/2 x n/2",0,3) ;\r
388         call outstring (170,180,"   Remarque : A chaque fois qu'un produit de",0,3) ;\r
389         call outstring (170,200,"   sous_matrices sera rencontr\82 dans le calcul,",0,3) ;\r
390         call outstring (170,220,"   il faudra refaire de m\88me; d'o\97 la r\82cursivit\82.",0,3) ;\r
391         call outstring (170,250,"2. Sinon : Les diff\82rentes composantes de la",0,3) ;\r
392         call outstring (170,270,"   matrice_r\82sultat se d\82duisent directement en",0,3) ;\r
393         call outstring (170,290,"   rempla\87ant la m\82thode classique du produit ",0,3) ;\r
394         call outstring (170,310,"   scalaire par une m\82thode propre \85 Strassen.",0,3) ;\r
395         call outstring (170,330,"N.B. : On \82conomise une multiplication pour",0,3) ;\r
396         call outstring (170,350,"       plusieurs additions.",0,3) ;\r
397         end AIDE_CAL ;\r
398  \r
399       (* Texte du menu "Am\82lioration" *)\r
400       unit AIDE_AMEL : procedure ;\r
401       begin\r
402         call outstring (170,100,"L'algorithme de STRASSEN n\82cessite deux matrices",0,3) ;\r
403         call outstring (170,130,"carr\82es de taille identique et dont l'ordre doit",0,3) ;\r
404         call outstring (170,160,"\88tre sous la forme d'une puissance exacte de deux",0,3) ;\r
405         call outstring (170,190,"(ordre = 2 ).",0,3) ;\r
406         call outstring (170+80,180,"k",0,3) ;\r
407         call outstring (170,230,"Le programme accepte des matrices ne satisfaisant",0,3) ;\r
408         call outstring (170,260,"pas \85 ces conditions. Il ajuste ensuite celles-ci",0,3) ;\r
409         call outstring (170,290,"en compl\82tant, \82ventuellement, avec des 0.",0,3) ;\r
410         call outstring (170,330,"Le programme laisse donc \85 l'utilisateur une plus",0,3) ;\r
411         call outstring (170,360,"grande souplesse d'utilisation.",0,3) ;\r
412       end AIDE_AMEL ;\r
413  \r
414  \r
415     begin\r
416       (* Bouton du fond de l'aide *)\r
417       B1:=new BOUTON (150,31,600,431,2,3,11,1) ;\r
418       (* Bouton du fond du menu de l'aide *)\r
419       B2:=new BOUTON (156,37,256,60,2,7,15,8) ;\r
420       (* Bouton du menu "Menu" *)\r
421       B3:=new BOUTON (258,37,358,60,2,7,15,8) ;\r
422       (* Bouton du menu "Calcul" *)\r
423       B4:=new BOUTON (360,37,490,60,2,7,15,8) ;\r
424       (* Bouton du menu "Am\82lioration" *)\r
425       B5:=new BOUTON (492,37,592,60,2,7,15,8) ;\r
426       (* Bouton du menu "Fermer" *)\r
427       B6:=new BOUTON (160,70,580,421,0,3,3,3) ;\r
428       call B1.AFF_BOUTON ;\r
429       call B2.AFF_BOUTON ;\r
430       call outstring (162,40,"Menu >",1,7) ;\r
431       call outstring (162,40,"M",0,7) ;\r
432       call B3.AFF_BOUTON ;\r
433       call outstring (264,40,"Calcul >",1,7) ;\r
434       call outstring (264,40,"C",0,7) ;\r
435       call B4.AFF_BOUTON ;\r
436       call outstring (366,40,"Am\82lioration >",1,7) ;\r
437       call outstring (366,40,"A",0,7) ;\r
438       call B5.AFF_BOUTON ;\r
439       call outstring (498,40,"Fermer",1,7) ;\r
440       call outstring (498,40,"F",0,7) ;\r
441       call B6.AFF_BOUTON ;\r
442       call AIDE_GRL ;\r
443       FinAIDE:=False ;\r
444       while (not FinAIDE)\r
445       do\r
446         Interupt:=getpress(x_s,y_s,Key1,Key2,Flags,Num_Mouse) ;\r
447         if Interupt  and (Num_Mouse=1 or key2=102 or key2=109 or\r
448                                            key2=99 or key2=97)\r
449         then\r
450           if B5.BOUTON_ENFONCE(1,Num_Mouse,x_s,y_s) or Key2=102\r
451           then\r
452             (* On ferme ... *)\r
453             FinAIDE:=True ;\r
454             call B6.EFF_BOUTON ;\r
455             call B5.EFF_BOUTON ;\r
456             call B3.EFF_BOUTON ;\r
457             call B2.EFF_BOUTON ;\r
458             call B1.EFF_BOUTON ;\r
459           fi ;\r
460           if B2.BOUTON_ENFONCE(1,Num_Mouse,x_s,y_s) or Key2=109\r
461           then\r
462             (* Appel \85 l'aide sur les menus *)\r
463             call B6.EFF_BOUTON ;\r
464             call B6.AFF_BOUTON ;\r
465             call AIDE_MENU ;\r
466           fi ;\r
467           if B3.BOUTON_ENFONCE(1,Num_Mouse,x_s,y_s) or Key2=99\r
468           then\r
469             (* Appel \85 l'aide sur le calcul *)\r
470             call B6.EFF_BOUTON ;\r
471             call B6.AFF_BOUTON ;\r
472             call AIDE_CAL ;\r
473           fi ;\r
474           if B4.BOUTON_ENFONCE(1,Num_Mouse,x_s,y_s) or Key2=97\r
475           then\r
476             (* Appel \85 l'aide sur l'am\82lioration *)\r
477             call B6.EFF_BOUTON ;\r
478             call B6.AFF_BOUTON ;\r
479             call AIDE_AMEL ;\r
480           fi ;\r
481         fi ;\r
482       od ;\r
483     end AIDE;\r
484     (********** AIDE *********)\r
485  \r
486  \r
487     unit AFF_NUM  : procedure (X, Y : integer, M : arrayof arrayof integer) ;\r
488       var B1, B2, B3 : BOUTON,\r
489           FinAFF, Interupt : Boolean,\r
490           x_s,y_s,Key1,Key2,Flags,Num_Mouse : integer ;\r
491     begin\r
492       B1:=new BOUTON (X,Y,X+380,Y+300,2,3,11,1) ;\r
493       B2:=new BOUTON (X+10,Y+270,X+160,Y+290,2,7,8,15) ;\r
494       B3:=new BOUTON (X+270,Y+270,X+370,Y+290,2,7,8,15) ;\r
495       call B1.AFF_BOUTON ;\r
496       call B2.AFF_BOUTON ;\r
497       call B3.AFF_BOUTON ;\r
498       call outstring (X+15,Y+50,"     AFFICHAGE DES GRANDS NOMBRES",4,3) ;\r
499       call outstring (X+15,Y+90,"Les grands nombres (> 9999999 et <-100000)",0,3) ;\r
500       call outstring (X+15,Y+120,"risquent de provoquer des affichages",0,3) ;\r
501       call outstring (X+15,Y+150,"disgracieux. Ces nombres sont donc, par",0,3) ;\r
502       call outstring (X+15,Y+180,"d\82faut remplac\82s par des #####. Si toutefois",0,3) ;\r
503       call outstring (X+15,Y+210,"vous souhaitez afficher ces valeurs, cliquez",0,3) ;\r
504       call outstring (X+15,Y+240,"sur 'Affiche num\82rique'.",0,3) ;\r
505       call outstring (X+275,Y+273,"Fermer",1,7) ;\r
506       call outstring (X+275,Y+273,"F",0,7) ;\r
507        if Aff_Num_Grd\r
508       then\r
509         call outstring (X+15,Y+273,"Affiche   #####  ",1,7) ;\r
510       else\r
511         call outstring (X+15,Y+273,"Affiche num\82rique",1,7) ;\r
512       fi ;\r
513       call outstring (X+15,Y+273,"A",0,7) ;\r
514       FinAFF:=False ;\r
515       while (not FinAFF)\r
516       do\r
517         Interupt:=getpress(x_s,y_s,Key1,Key2,Flags,Num_Mouse) ;\r
518         if Interupt and (Num_Mouse=1 or key2=102 or key2=97)\r
519         then\r
520           if B3.BOUTON_ENFONCE(1,Num_Mouse,x_s,y_s) or Key2=102\r
521           then\r
522             FinAFF:=True ;\r
523             call B3.EFF_BOUTON ;\r
524             call B2.EFF_BOUTON ;\r
525             call B1.EFF_BOUTON ;\r
526           fi ;\r
527           if B2.BOUTON_ENFONCE(1,Num_Mouse,x_s,y_s) or Key2=97\r
528           then\r
529             FinAFF:=True ;\r
530             call B3.EFF_BOUTON ;\r
531             call B2.EFF_BOUTON ;\r
532             call B1.EFF_BOUTON ;\r
533             if Aff_Num_Grd\r
534             then\r
535               Aff_Num_Grd:=False ;\r
536             else\r
537               Aff_Num_Grd:=True ;\r
538             fi ;\r
539             call W3.AFF_MATRICE (M) ;\r
540           fi ;\r
541         fi ;\r
542       od ;\r
543     end AFF_NUM;\r
544  \r
545  \r
546     (* Procedure de saisie d'une matrice *)\r
547     unit SAISIE_MATRICE : procedure (Mat : String ;\r
548                                      output M : Arrayof arrayof integer) ;\r
549       var Bouton_Saisie, Bout_Pourcent : BOUTON,\r
550           i, j, n1, n2, Nb : integer ;\r
551     begin\r
552       Bouton_Saisie := new BOUTON (50,230,400,430,3,7,15,8) ;\r
553       Bout_Pourcent := new BOUTON (70,390,370,410,3,7,8,15) ;\r
554  \r
555       call Bouton_Saisie.AFF_BOUTON ;\r
556       call outstring (120,240,"SAISIE DE LA MATRICE",4,7) ;\r
557       call outstring (290,240,Mat,4,7) ;\r
558       call outstring (60,270,"Nombre de lignes (de 1 \85 32) :",0,7) ;\r
559       (* Nombre de lignes et de colonnes ??? *)\r
560       n1:=hfont(330,270,4,1,32,1,8,0,15) ;\r
561       call outstring (60,290,"Nombre de colonnes (de 1 \85 32) :",0,7) ;\r
562       n2:=hfont(330,290,4,1,32,1,8,0,15) ;\r
563  \r
564       M:= CREATION (n1,n2) ;\r
565  \r
566       call Bouton_Saisie.EFF_BOUTON ;\r
567       call Bouton_Saisie.AFF_BOUTON ;\r
568       call outstring (120,240,"SAISIE DE LA MATRICE",4,7) ;\r
569       call outstring (290,240,Mat,4,7) ;\r
570       call Bout_Pourcent.AFF_BOUTON ;\r
571       call outstring (70,270,"Entrez la valeur pour la ligne :     ",0,7) ;\r
572       call outstring (70,290,"              et de la colonne :       ",0,7) ;\r
573       call outstring (70,310,"      (valeur entre -999 et 999)",0,7) ;\r
574       call outstring (70,370,"0 %           SAISIE             100 % ",1,7) ;\r
575  \r
576       nb:=0 ;\r
577       for j:=1 to upper(M)\r
578       do\r
579         call outstring(355,270,"   ",7,0) ;\r
580         call track (355,270,j,0,7) ;\r
581         for i:=1 to upper(M(j))\r
582         do\r
583           call outstring(355,290,"   ",7,0) ;\r
584           call track (355,290,i,0,7) ;\r
585           (* saisie des matrices *)\r
586           M(j,i):=hfont(330,310,6,-999,999,0,8,0,15) ;\r
587           nb:=nb+1 ;\r
588           (* remplissage de la barre de pourcentage *)\r
589           call patern(74,394,74+(292*(nb)/(n1*n2)),406,1,1) ;\r
590         od ;\r
591       od ;\r
592       call Bouton_Saisie.EFF_BOUTON ;\r
593     end SAISIE_MATRICE ;\r
594  \r
595     unit HORLOGE : procedure ;\r
596     begin\r
597       (* on fait tourner l'aiguille de l'horloge*)\r
598       call color (7) ;\r
599       call move (395,245) ;\r
600       case Num\r
601         when 2 : call draw(395,245-8) ;\r
602         when 3 : call draw(395+8,245-8) ;\r
603         when 4 : call draw(395+8,245) ;\r
604         when 5 : call draw(395+8,245+8) ;\r
605         when 6 : call draw(395,245+10) ;\r
606         when 7 : call draw(395-8,245+8) ;\r
607         when 8 : call draw(395-8,245) ;\r
608         when 1 : call draw(395-8,245-8) ;\r
609       esac  ;\r
610       call color (15) ;\r
611       call move (395,245) ;\r
612       case Num\r
613         when 1 : Num:=2 ; call draw(395,245-8) ;\r
614         when 2 : Num:=3 ; call draw(395+8,245-8) ;\r
615         when 3 : Num:=4 ; call draw(395+8,245) ;\r
616         when 4 : Num:=5 ; call draw(395+8,245+8) ;\r
617         when 5 : Num:=6 ; call draw(395,245+10) ;\r
618         when 6 : Num:=7 ; call draw(395-8,245+8) ;\r
619         when 7 : Num:=8 ; call draw(395-8,245) ;\r
620         when 8 : Num:=1 ; call draw(395-8,245-8) ;\r
621       esac ;\r
622      end ;\r
623  \r
624  \r
625     (* Procedure de d\82roulement pas \85 pas de l'algo. de Strassen *)\r
626     unit PASAPAS : procedure (M : arrayof arrayof integer ;\r
627                               VarTmp : arrayof integer ; Nb : integer) ;\r
628       var Interupt, Reprise : boolean,\r
629           i, x_s, y_s, Key1, Key2, Flags, Num_Mouse : integer ;\r
630     begin\r
631       if (not Menu)\r
632       then\r
633         (* La premi\8are fois on fait ...\r
634                     Affichage du curseur,\r
635                     initialisation des boutons,\r
636                     affichage du menu,\r
637                     affichage des trois matrices. *)\r
638         call showcursor ;\r
639         (* Bouton1 : Bouton du fond du menu *)\r
640         Bouton1:=new BOUTON (0,0,639,30,3,9,11,1) ;\r
641  \r
642         (* B2 .. B6 : Boutons menu (Quitte, Variables, suite, R\82sultat, Aide). *)\r
643         Bouton2:=new BOUTON (4,4,100,26,0,9,1,11) ;\r
644         Bouton3:=new BOUTON (102,4,202,26,0,9,1,11) ;\r
645         Bouton4:=new BOUTON (204,4,304,26,0,9,1,11) ;\r
646         Bouton5:=new BOUTON (306,4,406,26,0,9,1,11) ;\r
647         Bouton12:=new BOUTON (408,4,508,26,0,9,1,11) ;\r
648         Bouton6:=new BOUTON (510,4,610,26,0,9,1,11) ;\r
649  \r
650         (* Boutons contextuelles (7 Variables, 8 fin variables,\r
651            10 calcul direct). *)\r
652         Bouton7:=new BOUTON (102,31,252,371,3,3,11,1) ;\r
653         Bouton8:=new BOUTON (147,330,207,355,2,7,8,15) ;\r
654  \r
655         call Bouton1.AFF_BOUTON ;\r
656         call Bouton2.AFF_BOUTON ;\r
657         call Outstring  (9,7,"Quitter",10,9) ;\r
658         call Outstring  (9,7,"Q",0,9) ;\r
659         call Bouton3.AFF_BOUTON ;\r
660         call Outstring  (107,7,"Variables >",10,9) ;\r
661         call Outstring  (107,7,"V",0,9) ;\r
662         call Bouton4.AFF_BOUTON ;\r
663         call Outstring  (209,7,"Suite",10,9) ;\r
664         call Outstring  (209,7,"S",0,9) ;\r
665         call Bouton5.AFF_BOUTON ;\r
666         call Outstring  (311,7,"R\82sultat",10,9) ;\r
667         call Outstring  (311,7,"R",0,9) ;\r
668         call Bouton6.AFF_BOUTON ;\r
669         call Outstring  (515,7,"Aide >",10,9) ;\r
670         call Outstring  (523,7,"i",0,9) ;\r
671         call Bouton12.AFF_BOUTON ;\r
672         call Outstring  (413,7,"Affichage >",10,9) ;\r
673         call Outstring  (413,7,"A",0,9) ;\r
674  \r
675         W1:= new WINDOWS("A",upper(V),15,265) ;\r
676         W2:= new WINDOWS("B",upper(V),335,50) ;\r
677         W3:= new WINDOWS("Tmp",0,335,265) ;\r
678  \r
679         call W1.AFF_MATRICE (V) ;\r
680         call W2.AFF_MATRICE (W) ;\r
681  \r
682         Menu:=true ;\r
683       fi ;\r
684  \r
685       if (nb=1 and (Bouton4.BOUTON_Aff or Bouton5.BOUTON_Aff))\r
686       then\r
687         (* si les calculs sont finis mais qu'il reste les boutons\r
688            suite et r\82sultat, alors on les effaces *)\r
689         call Bouton4.EFF_BOUTON ;\r
690         call Bouton5.EFF_BOUTON ;\r
691         W3.Titre:="Res" ;\r
692         call Outstring (342,275,"Res",12,4) ;\r
693       fi ;\r
694  \r
695       if (B_PasAPAS or nb=1)\r
696       then\r
697         (* Si on est toujours en Pas \85 Pas ou que les calculs sont fini,\r
698            on attend un clique sur quitter, suite ou r\82sultat. *)\r
699         if Bouton10.Bouton_Aff\r
700         then\r
701           call Bouton10.EFF_BOUTON ;\r
702         fi ;\r
703         W3.Maxi:=upper(M) ;\r
704         W3.A1.Max:=upper(M)-4 ;\r
705         W3.A2.Max:=upper(M)-4 ;\r
706         call W3.Taille.EFF_BOUTON ;\r
707         call W3.Taille.AFF_BOUTON ;\r
708         call track (W3.X+273,W3.Y+184,W3.Maxi,15,0) ;\r
709         call W3.AFF_MATRICE (M) ;\r
710         Reprise:=false ;\r
711         while (not reprise)\r
712         do\r
713           Interupt:= getpress(x_s, y_s, Key1, Key2, Flags, Num_Mouse) ;\r
714           if Interupt and (Num_Mouse=1 or Key2=97 or Key2=102 or Key2=105 or\r
715                                          (Key2>112 and Key2<116) or Key2=118)\r
716           then\r
717             (* Si le bouton gauche de la souris est enfonc\82 alors *)\r
718             if Bouton7.BOUTON_Aff\r
719             then\r
720               if Bouton8.BOUTON_ENFONCE(1,Num_Mouse,x_s,y_s) or key2=102\r
721               then\r
722                 (* Si le menu Variables est ouvert et que l'on a cliquer\r
723                    sur fermer alors ... *)\r
724                 call Bouton8.EFF_BOUTON ;\r
725                 call Bouton7.EFF_BOUTON ;\r
726               fi ;\r
727             else\r
728               if Bouton2.BOUTON_ENFONCE(1,Num_Mouse,x_s,y_s) or key2=113\r
729               then\r
730                 (* Clique sur quitter *)\r
731                 call groff ;\r
732                 call endrun ;\r
733               fi ;\r
734               if Bouton3.BOUTON_ENFONCE(1,Num_Mouse,x_s,y_s) or Key2=118\r
735               then\r
736                 call Bouton7.AFF_BOUTON ;\r
737                 if nb>1\r
738                 then\r
739                   (* clique variables *)\r
740                   for i:=1 to 7\r
741                   do\r
742                     call outstring (113,30+(i*20),"x  :",10,3) ;\r
743                     call track(123,33+(i*20),i,3,10) ;\r
744                     call track(153,30+(i*20),VarTmp(i),3,10) ;\r
745                   od ;\r
746                 fi ;\r
747                 call outstring (108,200,"M\82thode STRASSEN",4,3) ;\r
748                 call outstring (108,270,"M\82thode normale",4,3) ;\r
749                 call outstring (113,220,"Xø :",1,3) ;\r
750                 call track (153,220,Opp(1),3,10) ;\r
751                 call outstring (113,240,"+ø :",1,3) ;\r
752                 call track (153,240,Opp(2),3,10) ;\r
753                 call outstring (113,290,"Xø :",1,3) ;\r
754                 call track (153,290,Opp(3),3,10) ;\r
755                 call outstring (113,310,"+ø :",1,3) ;\r
756                 call track (153,310,Opp(4),3,10) ;\r
757                 call Bouton8.AFF_BOUTON ;\r
758                 call Outstring  (153,335,"Fermer",1,7) ;\r
759                 call Outstring  (153,335,"F",0,7) ;\r
760                fi ;\r
761               if Bouton4.BOUTON_Aff and (Bouton4.BOUTON_ENFONCE(1,Num_Mouse,x_s,y_s) or Key2=115)\r
762               then\r
763                 (* clique sur suite *)\r
764                 Reprise:=True ;\r
765               fi ;\r
766               if Bouton5.BOUTON_Aff and (Bouton5.BOUTON_ENFONCE(1,Num_Mouse,x_s,y_s) or Key2=114)\r
767               then\r
768                 (* clique sur r\82sultat *)\r
769                 call Bouton4.EFF_BOUTON ;\r
770                 call Bouton5.EFF_BOUTON ;\r
771                 W3.Titre:="Res" ;\r
772                 call Outstring (342,275,"Res",12,4) ;\r
773                 Reprise:=True ;\r
774                 B_PasAPAS := False ;\r
775                 call Bouton10.AFF_BOUTON ;\r
776                 call outstring (310,210,"Patience, je calcule.",0,7) ;\r
777                 Num:=1 ;\r
778  \r
779                 call patern(380,230,410,260,0,0) ;\r
780                 call move (380,230) ; call draw (384,234) ;\r
781                 call move (380,260) ; call draw (384,256) ;\r
782                 call move (410,260) ; call draw (406,256) ;\r
783                 call move (410,230) ; call draw (406,234) ;\r
784  \r
785                 call move (380,245) ; call draw (384,245) ;\r
786                 call move (410,245) ; call draw (406,245) ;\r
787                 call move (395,230) ; call draw (395,234) ;\r
788                 call move (395,260) ; call draw (395,256) ;\r
789               fi ;\r
790               if Bouton6.BOUTON_Aff and Bouton6.BOUTON_ENFONCE(1,Num_Mouse,x_s,y_s) or Key2=105\r
791               then\r
792                 (* clique sur aide *)\r
793                 call AIDE ;\r
794               fi ;\r
795               if Bouton12.BOUTON_ENFONCE(1,Num_Mouse,x_s,y_s) or Key2=97\r
796               then\r
797                 (* clique sur afficahge des nombres *)\r
798                 call AFF_NUM (100,100,M) ;\r
799               fi ;\r
800               call W1.MOUVE_ASC(V,W1.A1,Num_Mouse,X_S,Y_S) ;\r
801               call W1.MOUVE_ASC(V,W1.A2,Num_Mouse,X_S,Y_S) ;\r
802               call W2.MOUVE_ASC(W,W2.A1,Num_Mouse,X_S,Y_S) ;\r
803               call W2.MOUVE_ASC(W,W2.A2,Num_Mouse,X_S,Y_S) ;\r
804               call W3.MOUVE_ASC(M,W3.A1,Num_Mouse,X_S,Y_S) ;\r
805               call W3.MOUVE_ASC(M,W3.A2,Num_Mouse,X_S,Y_S) ;\r
806             fi ;\r
807            fi ;\r
808         od ;\r
809       else\r
810         call HORLOGE ;\r
811       fi ;\r
812       if (Nb=1)\r
813       then\r
814         call groff ;\r
815       fi ;\r
816     end PASAPAS ;\r
817  \r
818  \r
819     (* Gestion de l'\82cran de pr\82sentation *)\r
820     unit PRESENTATION : procedure ;\r
821       Var Bout_Pres : BOUTON,\r
822           i, j, touche_pres,x_s, y_s, special, flags, Etat_souris : integer,\r
823           Map : arrayof integer,\r
824           Interupt:boolean,\r
825           Stars : arrayof arrayof integer ;\r
826  \r
827       (* Allume des \82toiles sur le fond *)\r
828       unit ALLUME : procedure (Num : integer)  ;\r
829       begin\r
830         Stars(Num,1):=Random*638 ;\r
831         Stars(Num,2):=Random*478 ;\r
832         Stars(Num,3):=Random*200 ;\r
833         Stars(Num,4):=Random*15 ;\r
834         if ((Stars(Num,1)>174) and (Stars(Num,1)<466) and\r
835             (Stars(Num,2)>139) and (Stars(Num,2)<341))\r
836         then\r
837           Stars(Num,3):=0 ;\r
838         fi ;\r
839         if Stars(Num,3)>0\r
840         then\r
841           call color (Stars(Num,4)) ;\r
842           call Point (Stars(Num,1),Stars(Num,2)) ;\r
843           call Point (Stars(Num,1)+1,Stars(Num,2)) ;\r
844           call Point (Stars(Num,1),Stars(Num,2)+1) ;\r
845           call Point (Stars(Num,1)+1,Stars(Num,2)+1) ;\r
846         fi ;\r
847       end ALLUME ;\r
848  \r
849       (* Efface les \82toiles *)\r
850       unit ETEIND : procedure (Num : integer) ;\r
851       begin\r
852         if not ((Stars(Num,1)>174) and (Stars(Num,1)<466) and\r
853                 (Stars(Num,2)>139) and (Stars(Num,2)<341))\r
854         then\r
855           call color (0) ;\r
856           call Point(Stars(Num,1),Stars(Num,2)) ;\r
857           call Point (Stars(Num,1)+1,Stars(Num,2)) ;\r
858           call Point (Stars(Num,1),Stars(Num,2)+1) ;\r
859           call Point (Stars(Num,1)+1,Stars(Num,2)+1) ;\r
860         fi ;\r
861       end ETEIND ;\r
862  \r
863     begin\r
864       call gron(0) ;\r
865       call ranset(100) ;\r
866        array Stars dim (1:50) ;\r
867       for i:=1 to 50\r
868       do\r
869         array Stars(i) dim (1:4) ;\r
870         call ALLUME(i) ;\r
871       od ;\r
872  \r
873       Bout_Pres:=new BOUTON (175,140,465,340,4,7,15,8) ;\r
874       call Bout_Pres.AFF_BOUTON ;\r
875       call color (1) ;\r
876       call move (190,155) ; call draw (450,155) ;\r
877       call draw (450,217) ; call draw (190,217) ;\r
878       for i:=1 to 30\r
879       do\r
880         call move (190,155+(i*2)) ; call draw (230,155+(i*2)) ;\r
881       od ;\r
882       call color (7) ;\r
883       for i:=0 to 1\r
884       do\r
885         call move (226,159+(i*2)) ; call draw (194+i,159+(i*2)) ;\r
886         call draw (194+i,187-(i*2)) ; call draw (225+i,187-(i*2)) ;\r
887         call draw (225+i,211+(i*2)) ; call draw (194,211+(i*2)) ;\r
888       od ;\r
889       call outstring (236,200,"trassen",1,7) ;\r
890       call outstring (188,230,"Multiplication de deux matrices",4,7) ;\r
891       call outstring (188,250,"selon l'algorithme de STRASSEN.",4,7) ;\r
892       call outstring (188,275,"Auteurs : AKPAMOLI E. HANNOYER P.",0,7) ;\r
893       call outstring (188,295,"R\82alis\82 en Loglan [Janvier 1995]",0,7) ;\r
894       call color (5) ;\r
895       call patern(184,273,450,310,5,0) ;\r
896       for i:=1 to 2\r
897       do\r
898         call move (450+(i*2),273+(7*i)) ;\r
899         call draw (450+(i*2),310+(2*i)) ;\r
900         call draw (184+(i*7),310+(2*i)) ;\r
901       od ;\r
902       Map:=GET_MAP (Bout_Pres.X,Bout_Pres.Y,Bout_Pres.XX,Bout_Pres.YY) ;\r
903       call outstring (188,315,"<Entr\82e> pour continuer ...",15,7) ;\r
904       touche_pres:=0 ;\r
905       while (not touche_pres=13)\r
906       do\r
907         for i:=1 to 50\r
908         do\r
909           if Stars(i,3)=0 then\r
910             call ETEIND (i) ;\r
911             call ALLUME (i) ;\r
912           else\r
913             Stars(i,3):=Stars(i,3)-1 ;\r
914           fi ;\r
915         od ;\r
916         Interupt:=getpress(x_s,y_s,special,touche_pres,flags,Etat_souris) ;\r
917        od ;\r
918       for i:=1 to 50\r
919       do\r
920         call ETEIND (i) ;\r
921       od ;\r
922       call Bout_Pres.EFF_BOUTON ;\r
923       call Bout_Pres.CHG_BOUTON_XY(15,50) ;\r
924       call Bout_Pres.AFF_BOUTON ;\r
925       call PUT_MAP (Bout_Pres.X,Bout_Pres.Y,Map) ;\r
926       call init (1,0) ;\r
927     end PRESENTATION;\r
928  \r
929  \r
930     (* FIN PARTIE GRAPHIQUE *)\r
931  \r
932  \r
933     (* DEBUT PARTIE CALCUL *)\r
934  \r
935     (* Retourne deux matrice selon la norme pour le calcul avec l'algo. de\r
936        Strassen (les deux matrices sont de tailles identiques, et leur ordre\r
937        est une puissance enti\8are de deux). *)\r
938     unit AJUSTE_MATRICE : procedure (inout M1, M2 : arrayof arrayof integer) ;\r
939       var i, j : integer,\r
940           Tmp1, Tmp2 : arrayof arrayof integer,\r
941           Calcul, Max : integer ;\r
942     begin\r
943       (* Mais quel est la valeure la plus grande entre les lignes et les colonnes\r
944          des deux tableaux ???? (attention si 1 alors 2). *)\r
945       Max:=imax(2,(imax(imax(upper(M1),upper(M1(1))),imax(upper(M2),upper(M2(1)))))) ;\r
946       Calcul := LN(Max)/LN(2) ;\r
947       if (Calcul<>LN(Max)/LN(2))\r
948       then\r
949         (* Max n'est pas une puissance enti\8are de deux alors normalisons : *)\r
950         Max:=EXPO(2,(Calcul+1)) ;\r
951       fi ;\r
952       if  upper(M1)<Max or upper(M1(1))<Max or upper(M2)<Max or upper(M2(1))<Max\r
953       then\r
954         array Tmp1 dim (1:Max) ;\r
955         array Tmp2 dim (1:Max) ;\r
956         for i:=1 to max\r
957         do\r
958           array Tmp1(i) dim (1:Max) ;\r
959           array Tmp2(i) dim (1:Max) ;\r
960           for j:=1 to imax(upper(M1(1)),upper(M2(1)))\r
961           do\r
962             (* Optimisation en ne parcourant que au maximum les colonnes du\r
963                plus grand des deux Matrices M1 ou M2 *)\r
964             if i <= upper(M1) and j <= upper (M1(1))\r
965             then\r
966                    (* on ne rempli que les cases de Tmp1 qu'avec les cases\r
967                       de M1 qui \82taient saisies *)\r
968                Tmp1(i,j):=M1(i,j) ;\r
969             fi ;\r
970             if i <= upper(M2) and j <= upper (M2(1))\r
971             then\r
972                    (* on ne rempli que les cases de Tmp2 qu'avec les cases\r
973                       de M2 qui \82taient saisies *)\r
974                Tmp2(i,j):=M2(i,j) ;\r
975             fi ;\r
976           od ;\r
977         od ;\r
978         M1:=Tmp1 ;\r
979         M2:=Tmp2 ;\r
980       fi ;\r
981     end AJUSTE_MATRICE;\r
982  \r
983  \r
984     (* Fonction retournant une matrice de n1 x n2 *)\r
985     unit CREATION: function (lignes,colonnes:integer) : arrayof arrayof integer ;\r
986       var i:integer;\r
987     begin\r
988       array result dim(1:lignes);\r
989       for i:=1 to lignes\r
990       do\r
991         array result(i) dim(1:colonnes);\r
992       od;\r
993     end CREATION;\r
994  \r
995  \r
996     (* Fonction retournant le r\82sultat d'une soustraction de deux matrices *)\r
997     unit SOUST_MATRICE:function(X,Y:arrayof arrayof integer):arrayof arrayof integer;\r
998       var i,j:integer;\r
999     begin\r
1000       result:=CREATION(upper(X),upper(X));\r
1001       for i:=1 to upper(X)\r
1002       do\r
1003         for j:=1 to upper(X(i))\r
1004         do\r
1005           result(i,j):=X(i,j)-Y(i,j);\r
1006         od\r
1007       od\r
1008     end SOUST_MATRICE;\r
1009  \r
1010     (* Fonction retournant le r\82sultat d'une somme de deux matrices *)\r
1011     unit SOMME_MATRICE:function(X,Y:arrayof arrayof integer):arrayof arrayof integer;\r
1012       var i,j:integer;\r
1013     begin\r
1014       result:=CREATION(upper(X),upper(X));\r
1015       for i:=1 to upper(X)\r
1016       do\r
1017         for j:=1 to upper(X(i))\r
1018         do\r
1019           result(i,j):=X(i,j)+Y(i,j);\r
1020         od\r
1021       od\r
1022     end SOMME_MATRICE;\r
1023  \r
1024  \r
1025     (* Fonction retournant une matrice qui est la somme de deux portions d'une\r
1026        matrice pass\82 en param\8atre *)\r
1027     unit SOMME_PORTION : function(X:arrayof arrayof integer;a,b:integer) :\r
1028                                             arrayof arrayof integer;\r
1029       var sous_ordre,i,j:integer;\r
1030     begin\r
1031       sous_ordre:=upper(X) div 2;\r
1032       result:=CREATION(sous_ordre,sous_ordre);\r
1033       if a=1\r
1034       then\r
1035         case b\r
1036           when 4 :\r
1037             for i:=1 to sous_ordre\r
1038             do\r
1039               for j:=1 to sous_ordre\r
1040               do\r
1041                 result(i,j):=X(i,j)+X(i+sous_ordre,j+sous_ordre);\r
1042               od\r
1043             od\r
1044           when 2 :\r
1045             for i:=1 to sous_ordre\r
1046             do\r
1047               for j:=1 to sous_ordre\r
1048               do\r
1049                 result(i,j):=X(i,j)+X(i,j+sous_ordre);\r
1050               od\r
1051             od\r
1052         esac\r
1053       else\r
1054         if a=3 and b=4\r
1055         then\r
1056           for i:=1 to sous_ordre\r
1057           do\r
1058             for j:=1 to sous_ordre\r
1059             do\r
1060               result(i,j):=X(i+sous_ordre,j)+X(i+sous_ordre,j+sous_ordre);\r
1061             od\r
1062           od\r
1063         fi;\r
1064       fi;\r
1065     end SOMME_PORTION;\r
1066  \r
1067  \r
1068     (* Fonction retournant une matrice qui est la diff\82rence de deux portions\r
1069        d'une matrice pass\82 en param\8atre *)\r
1070     unit SOUST_PORTION : function(X:arrayof arrayof integer;a,b:integer) :\r
1071                                             arrayof arrayof integer;\r
1072       var sous_ordre,i,j:integer;\r
1073     begin\r
1074       sous_ordre:=upper(X) div 2;\r
1075       result:=CREATION(sous_ordre,sous_ordre);\r
1076       if a=2 and b=4\r
1077       then\r
1078         for i:=1 to sous_ordre\r
1079         do\r
1080           for j:=1 to sous_ordre\r
1081           do\r
1082             result(i,j):=X(i,j+sous_ordre)-X(i+sous_ordre,j+sous_ordre);\r
1083           od\r
1084         od\r
1085       else\r
1086         if a=3 and b=1\r
1087         then\r
1088           for i:=1 to sous_ordre\r
1089           do\r
1090             for j:=1 to sous_ordre\r
1091             do\r
1092               result(i,j):=X(i+sous_ordre,j)-X(i,j);\r
1093             od\r
1094           od\r
1095         fi\r
1096       fi\r
1097     end SOUST_PORTION;\r
1098  \r
1099  \r
1100     (* Fonction retournant une portion de la matrice X, (retourne\r
1101                 soit la partie X(1,1) soit la partie X(2,2)). *)\r
1102     unit PORTION:function (X : arrayof arrayof integer;a:integer) :\r
1103                                arrayof arrayof integer;\r
1104       var i,j,sous_ordre:integer;\r
1105     begin\r
1106       sous_ordre:=upper(X) div 2;\r
1107       result:=CREATION(sous_ordre,sous_ordre);\r
1108       case a\r
1109         when 1:\r
1110           for i:=1 to sous_ordre\r
1111           do\r
1112             for j:=1 to sous_ordre\r
1113             do\r
1114               result(i,j):=X(i,j);\r
1115             od\r
1116           od\r
1117         when 4:\r
1118           for i:=1 to sous_ordre\r
1119           do\r
1120             for j:=1 to sous_ordre\r
1121             do\r
1122               result(i,j):=X(i+sous_ordre,j+sous_ordre);\r
1123             od\r
1124           od\r
1125       esac\r
1126     end PORTION;\r
1127  \r
1128  \r
1129     (* Proc\82dure r\82cursive permettant de multiplier les deux matrices pass\82es en\r
1130        param\8atres.\r
1131                  Nb : Niveau de parcour en profondeur (si = 1 transmis dans PasAPas\r
1132                       signifie que les calculs sont termin\82s,\r
1133                  ordre : Ordre des deux Matrices,\r
1134                  A, B : Deux matrices de travail,\r
1135                  C    : Matrice r\82sultat.                    *)\r
1136     unit STRASSEN:procedure(nb : integer ; ordre:integer; A, B :\r
1137                   arrayof arrayof integer ; output C:arrayof arrayof integer);\r
1138       var i,j,m:integer,\r
1139           (* X : tableau contenant les 7 variables de travail *)\r
1140           x : arrayof integer,\r
1141           (* P1 .. P7 : 7 Matrices temporaires *)\r
1142           P1,P2,P3,P4,P5,P6,P7:arrayof arrayof integer;\r
1143     begin\r
1144       C:=CREATION(ordre,ordre);\r
1145       array X dim (1:7) ;\r
1146       nb:=nb+1 ;\r
1147       if ordre>2\r
1148       then\r
1149         (* si l'ordre est plus grand que deux en d\82coupe les matrices en\r
1150            rappelant r\82cursivement STRASSEN*)\r
1151         m:=ordre div 2;\r
1152         call STRASSEN(nb,m,SOMME_PORTION(A,1,4),SOMME_PORTION(B,1,4),P1);\r
1153         call STRASSEN(nb,m,SOMME_PORTION(A,3,4),PORTION(B,1),P2);\r
1154         call STRASSEN(nb,m,PORTION(A,1),SOUST_PORTION(B,2,4),P3);\r
1155         call STRASSEN(nb,m,PORTION(A,4),SOUST_PORTION(B,3,1),P4);\r
1156         call STRASSEN(nb,m,SOMME_PORTION(A,1,2),PORTION(B,4),P5);\r
1157         call STRASSEN(nb,m,SOUST_PORTION(A,3,1),SOMME_PORTION(B,1,2),P6);\r
1158         call STRASSEN(nb,m,SOUST_PORTION(A,2,4),SOMME_PORTION(B,3,4),P7);\r
1159         for i:=1 to m\r
1160         do\r
1161           for j:=1 to m\r
1162           do\r
1163             C(i,j):=SOUST_MATRICE(SOMME_MATRICE(P1,P4),SOUST_MATRICE(P5,P7))(i,j);\r
1164           od;\r
1165         od;\r
1166         for i:=m+1 to ordre\r
1167         do\r
1168           for j:=1 to m\r
1169           do\r
1170             C(i,j):=SOMME_MATRICE(P2,P4)(i-m,j);\r
1171           od;\r
1172         od;\r
1173         for i:=1 to m\r
1174         do\r
1175           for j:=m+1 to ordre\r
1176           do\r
1177             C(i,j):=SOMME_MATRICE(P3,P5)(i,j-m);\r
1178           od;\r
1179         od;\r
1180         for i:=m+1 to ordre\r
1181         do\r
1182           for j:=m+1 to ordre\r
1183           do\r
1184             C(i,j):=SOMME_MATRICE(SOUST_MATRICE(P1,P2),SOMME_MATRICE(P3,P6))(i-m,j-m);\r
1185           od;\r
1186         od;\r
1187       else\r
1188         (* calcul des 7 variables de travail *)\r
1189         x(1):=(A(1,1)+A(2,2))*(B(1,1)+B(2,2));\r
1190         x(2):=(A(2,1)+A(2,2))*B(1,1);\r
1191         x(3):=A(1,1)*(B(1,2)-B(2,2));\r
1192         x(4):=A(2,2)*(B(2,1)-B(1,1));\r
1193         x(5):=(A(1,1)+A(1,2))*B(2,2);\r
1194         x(6):=(A(2,1)-A(1,1))*(B(1,1)+B(1,2));\r
1195         x(7):=(A(1,2)-A(2,2))*(B(2,1)+B(2,2));\r
1196         (* Calcul du nombre d'opp\82ration :\r
1197                   1, 2 : xø, +ø pour la m\82thode r\82cursive de Strassen,\r
1198                   3, 4 : xø, +ø pour la m\82thode r\82cursive traditionnelle. *)\r
1199         Opp(1):=Opp(1)+7 ; Opp(2):= Opp(2) + 18 ;\r
1200         Opp(3):=Opp(3)+8 ; Opp(4):= Opp(4) + 4 ;\r
1201         (* Calcul de la matrice r\82sultat avec les variables de travail *)\r
1202         C(1,1):=x(1)+x(4)-x(5)+x(7);\r
1203         C(2,1):=x(2)+x(4);\r
1204         C(1,2):=x(3)+x(5);\r
1205         C(2,2):=x(1)-x(2)+x(3)+x(6);\r
1206       fi ;\r
1207       call PASAPAS (C,x,nb) ;\r
1208     end STRASSEN;\r
1209  \r
1210     (* Function calculant A**B *)\r
1211     unit EXPO : function (A, B : integer):Integer ;\r
1212     begin\r
1213       if (B=0)\r
1214       then\r
1215         result:=1 ;\r
1216       else\r
1217         result:=EXPO(A,B-1)*A ;\r
1218       fi ;\r
1219     end EXPO ;\r
1220  \r
1221     var Prof,Num : integer,\r
1222         W1, W2, W3, W4 : WINDOWS ,\r
1223         Menu, Aff_Num_Grd, B_PasAPAS : boolean,\r
1224         Opp : arrayof integer,\r
1225         Bouton1,\r
1226         Bouton2, Bouton3, Bouton4, Bouton5, Bouton6, bouton12,\r
1227         Bouton7, Bouton8, Bouton10 : Bouton,\r
1228         V, W, Z : arrayof arrayof integer ;\r
1229  \r
1230     begin\r
1231       array Opp dim (1:4) ;\r
1232       call PRESENTATION ;\r
1233       call SAISIE_MATRICE("A",V);\r
1234       call SAISIE_MATRICE("B",W);\r
1235       call AJUSTE_MATRICE(V,W) ;\r
1236       call init (1,1) ;\r
1237       B_PasAPAS:=True ;\r
1238       Bouton10:=new BOUTON (300,200,490,270,2,7,15,8) ;\r
1239       call STRASSEN (Prof,upper(V),V,W,Z) ;\r
1240     end ;\r
1241   end ;\r
1242 end STRAS;\r
1243  \r
1244  \r