Added upstream from http://ftp.icm.edu.pl/pub/loglan/
[loglan.git] / examples / process / parth.log
1 Program tri;\r
2 \r
3 (*******************************************************************)\r
4 \r
5 Unit newpage:procedure;\r
6 begin\r
7   write(chr(27),"[2J");\r
8 end newpage;\r
9 \r
10 (*******************************************************************)\r
11 \r
12 Unit gotoxy : procedure (row, column : integer);\r
13         var c, d, e, f : char,\r
14             i, j : integer;\r
15 begin\r
16      i := row div 10;\r
17      j := row mod 10;\r
18      c := chr (48+i);\r
19      d := chr (48+j);\r
20      i := column div 10;\r
21      j := column mod 10;\r
22      e := chr (48+i);\r
23      f := chr (48+j);\r
24      write (chr(27), "[", c, d, ";", e, f, "H");\r
25  end gotoxy;\r
26 \r
27 (*******************************************************************)\r
28 \r
29 Unit pause:procedure(input seconde:integer);\r
30   var temps:integer;\r
31 begin\r
32   for temps:=1 to (9000*seconde) do od;\r
33 end pause;\r
34 \r
35 (*******************************************************************)\r
36 \r
37 Unit affiche:procedure(input position:integer;\r
38                        inout tableau:arrayof integer);\r
39 var i:integer;\r
40 begin\r
41 for i:=1 to upper(tableau) do\r
42    if i=position then write(chr(27),"[33m");\r
43                       write(" ",tableau(i):4," ");\r
44                       write(chr(27),"[36m")\r
45    else\r
46    write(" ",tableau(i):4," ") fi;\r
47 od;\r
48 writeln;\r
49 end affiche;\r
50 \r
51 (*******************************************************************)\r
52 \r
53 Unit A:process(n:integer;p:B);\r
54 var tabA:arrayof integer,\r
55     max,position,nb,i,nombre,j:integer,\r
56     bo:boolean;\r
57 \r
58                       (********************)\r
59 \r
60 Unit rech_max:procedure(output max,position:integer);\r
61 (* Recherche du plus grand \82l\82ment de tabA *)\r
62 var i:integer;\r
63 begin\r
64 max:=tabA(1);\r
65 position:=1;\r
66 for i:=2 to nb do\r
67   if tabA(i)>max then max:=tabA(i);\r
68                       position:=i;\r
69   fi;\r
70 od;\r
71 end rech_max;\r
72 \r
73                       (********************)\r
74 \r
75 begin\r
76         call gotoxy(2,20);\r
77         write(chr(27),"[33m");\r
78         writeln("- SAISIE DU TABLEAU A -");\r
79         write(chr(27),"[36m");\r
80         call gotoxy(4,1);\r
81         write("Quelle est la dimension de tabA ? ");\r
82         read(nb);\r
83         array tabA dim (1:nb);\r
84         for i:=1 to nb do\r
85           write("Donnez tabA(",i:3,") : ");\r
86           readln(nombre);\r
87           tabA(i):=nombre;\r
88         od;\r
89         call newpage;\r
90         call gotoxy(2,15);\r
91         writeln("AFFICHAGE DES DIFFERENTES ETAPES DU TRI");\r
92         writeln;\r
93         return;\r
94         j:=0;\r
95         do\r
96 \r
97                 call rech_max(max,position);\r
98                 writeln;\r
99                 if j<>0 then writeln("Etape ",j:2," : ") fi;\r
100                 call p.ec;\r
101                 write("TabA = ");\r
102                 call affiche(position,tabA);\r
103                 call p.rire;\r
104                 call p.echange(max,bo);\r
105                 tabA(position):=max;\r
106                 j:=j+1;\r
107                 if bo then exit fi;\r
108         od;\r
109         position:=0;\r
110         write(chr(27),"[32m");\r
111         writeln("Resultat Final : ");\r
112         write(chr(27),"[36m");\r
113         call p.ec;\r
114         write("TabA = ");\r
115         call affiche(position,tabA);\r
116         call p.rire;\r
117 end A;\r
118 \r
119 (*******************************************************************)\r
120 \r
121 Unit B:process(n:integer);\r
122 var tabB:arrayof integer,\r
123     min,position,nb,i,nombre,j:integer,\r
124     bidon:char,\r
125     arret:boolean;\r
126 \r
127                       (********************)\r
128 \r
129 Unit rech_min:procedure(output min,position:integer);\r
130 (* Recherche du plus petit \82l\82ment de tabB *)\r
131 var i:integer;\r
132 begin\r
133 min:=tabB(1);\r
134 position:=1;\r
135 for i:=2 to nb do\r
136   if tabB(i)<min then min:=tabB(i);\r
137                       position:=i;\r
138   fi;\r
139 od;\r
140 end rech_min;\r
141 \r
142                       (********************)\r
143 \r
144 Unit echange:procedure(inout max:integer;\r
145                        output bo:boolean);\r
146 begin\r
147         if min<max then tabB(position):=max;\r
148                         max:=min;\r
149                         bo:=false\r
150         else bo:=true;\r
151              arret:=true fi;\r
152 end echange;\r
153 \r
154 Unit ec:procedure;\r
155 end ec;\r
156 \r
157 Unit rire:procedure;\r
158 end rire;\r
159 \r
160                      (********************)\r
161 \r
162 begin\r
163         call gotoxy(2,20);\r
164         write(chr(27),"[33m");\r
165         writeln("- SAISIE DU TABLEAU B -");\r
166         write(chr(27),"[36m");\r
167         call gotoxy(4,1);\r
168         write("Quelle est la dimension de tabB ? ");\r
169         read(nb);\r
170         array tabB dim (1:nb);\r
171         for i:=1 to nb do\r
172           write("Donnez tabB(",i:3,") : ");\r
173           readln(nombre);\r
174           tabB(i):=nombre;\r
175         od;\r
176         call newpage;\r
177         return;\r
178         j:=0;\r
179         do\r
180 \r
181                 call rech_min(min,position);\r
182                 accept ec;\r
183                 accept rire;\r
184                 write("TabB = ");\r
185                 call affiche(position,tabB);\r
186                 writeln;\r
187                 j:=j+1;\r
188                 if (j mod 4)=0 then write(chr(27),"[32m");\r
189                                     writeln("< Appuyez sur Retour >");\r
190                                     write(chr(27),"[36m");\r
191                                     read(bidon);\r
192                                     call newpage fi;\r
193 \r
194                 accept echange;\r
195                 if arret then exit fi;\r
196         od;\r
197         accept ec;\r
198         accept rire;\r
199         position:=0;\r
200         write("TabB = ");\r
201         call affiche(position,tabB);\r
202 end B;\r
203 \r
204 (*******************************************************************)\r
205 \r
206 Unit baniere:procedure;\r
207 begin\r
208  call newpage;\r
209  write(chr(27),"[31m");\r
210  call gotoxy(7,22);\r
211  writeln("PARTITION DE DEUX ENSEMBLES :");\r
212  call gotoxy(9,31);\r
213  writeln("Min & Max");\r
214  write(chr(27),"[36m");\r
215  call gotoxy(15,29);\r
216  writeln("Presented by");\r
217  call gotoxy(22,26);\r
218  write(chr(27),"[32m");\r
219  writeln("- Dupin Christophe -");\r
220  call pause(2);\r
221  write(chr(27),"[36m");\r
222  call newpage;\r
223 end baniere;\r
224 \r
225 (************************* Programme principal *****************************)\r
226 \r
227 var arret:boolean,\r
228     processusA : A,\r
229     processusB : B;\r
230 \r
231 begin\r
232         call baniere;\r
233         processusB:=new B(0);\r
234         processusA:=new A(0,processusB);\r
235         resume(processusA);\r
236         resume(processusB);\r
237 end tri;\r
238 \r
239 \1a