projects / powerfractal.git / blob
? search:
summary | shortlog | log | commit | commitdiff | tree
history | raw | HEAD
Premier commit
[powerfractal.git] / CD / Src / Power_Console.adb
1 ---------------------------------------------------------------------------------------------------
2 -- Nom : Power_console / fait partie du programme Power Fractal --
3 -- --
4 -- Auteurs : Gregory Burri & Adrien Crivelli --
5 ---------------------------------------------------------------------------------------------------
6 -- But : Outils de hauts niveau pour mettre a disposition de l'utilisateur les --
7 -- differentes fonction du programme --
8 ---------------------------------------------------------------------------------------------------
9
10 with Ada.Text_IO; use Ada.Text_IO;
11 with Ada.Long_Float_Text_Io; use Ada.Long_Float_Text_Io;
12 with Ada.Integer_Text_Io; use Ada.Integer_Text_Io;
13
14 with Power_Tools; use Power_Tools;
15 with Power_Types; use Power_Types;
16 with Power_Io;
17 with Ada.Numerics.Discrete_Random;
18
19
20 package body Power_Console is
21
22 -- Type pour gerer un String de longueur indéfinie
23 type T_Chaine is
24 record
25 Chaine : String(1 .. Longueur_Max) := (others => ' ');
26 Longueur : Integer := 0;
27 end record;
28
29 --Les commandes a diposition
30 type T_Commande is (Help, Info, Choose, Switch, Zoom, Zin, Zout, Center, Iteration, Limit,
31 Cst, Angle, Color, Nbcolors, Random, Drawcolors, Default, Defaultlist,
32 Auto, Draw, Anti, Render, Create, Del, Save, Load, Savelist, Loadlist,
33 About, Quit);
34
35 --Pour faire des entrees-sorties sur les commandes
36 package T_Commande_Io is new Ada.Text_IO.Enumeration_IO(T_Commande); use T_Commande_Io;
37
38
39 --Pour faire des entree-sortie sur le type byte
40 package Modulo_IO is new Modular_IO (Byte); use Modulo_IO;
41
42 --Pour faire des entrees-sorties sur le type T_Ensemble
43 package T_Ensemble_IO is new Ada.Text_IO.Enumeration_IO(T_Ensemble); use T_Ensemble_IO;
44
45 --Pour tirer une composante de couleur au hasard
46 package Random_Composante is new Ada.Numerics.Discrete_Random(Byte); use Random_Composante;
47
48 --La longeur d'une ligne d'aide
49 Longeur_Ligne : constant := 60;
50
51 --Contient l'aide pour une commande
52 type T_Type_Info_Commandes is
53 record
54 Info_Para : String(1..Longeur_Ligne); --Parametres des commandes
55 Info_Supp : String(1..Longeur_Ligne); --Decription des commandes
56 end record;
57
58 --Contient toute l'aide pour les commandes
59 type T_Commande_Aide is array (T_Commande'range) of T_Type_Info_Commandes;
60
61 Commande_Aide : constant T_Commande_Aide :=
62
63 (
64 Help =>
65 (" [<any commands>] the stuff in brackets[] is not neccessary",
66 " Im So Happy Cuz I Found My Friends... "),
67
68 Info =>
69 (" ",
70 " View some informations about the current fractal "),
71
72 Choose =>
73 (" [<number of a fractal in the list>] ",
74 " Select a fractal in the list and draw it "),
75
76 Switch =>
77 (" ",
78 " Switch between Mandelbrot end Julia "),
79
80 Zoom =>
81 (" [<Value of zoom>] ",
82 " for zooming in the current fractal "),
83
84 Zin =>
85 (" [<Factor>] ",
86 " Zoom in "),
87
88 Zout =>
89 (" [<Factor>] ",
90 " Zoom out "),
91
92 Center =>
93 (" [<x> <y>] ",
94 " Center in a point of the fractal "),
95
96 Iteration =>
97 (" <value> ",
98 " Set the number of iteration "),
99
100 Limit =>
101 (" <value> ",
102 " Set the divergence limit "),
103
104 Cst =>
105 (" <a> <b> ",
106 " Set the complex number of 'c' (only for Julia) "),
107
108 Angle =>
109 (" <value> ",
110 " Set the absolute value of angle "),
111
112 Color =>
113 (" <number> (<r> <g> <b>) ",
114 " Change one of colors. r, g and b are the channels "),
115
116 Nbcolors =>
117 (" <number> ",
118 " Set numbers of colors "),
119
120 Random =>
121 (" ",
122 " Choice a randomize range of colors "),
123
124 Drawcolors =>
125 (" <1> ! <0> ",
126 " Set or unset the drawing of the range of colors "),
127
128 Default =>
129 (" ",
130 " Reset the current fractal "),
131
132 Defaultlist =>
133 (" ",
134 " Reset all fractals in the list "),
135 Auto =>
136 (" <1> ! <0> ",
137 " Set or unset the autoredraw "),
138
139 Draw =>
140 (" ",
141 " Draw the fractal "),
142
143 Anti =>
144 (" <1> ! <0> ",
145 " Set or unset the antialiasing "),
146
147 Render =>
148 (" <name of file> [<x> <y>] ",
149 " Render the fractal in a bmp file. x y are the resolution "),
150
151 Create =>
152 (" ",
153 " Create a new fractal in the list "),
154
155 Del =>
156 (" <number of a fractal in the list> ",
157 " View some informations about the curent fractal "),
158
159 Save =>
160 (" <name of file> ",
161 " Save the current fractal in a file "),
162
163 Load =>
164 (" <name of file> ",
165 " Load a fractal from a file "),
166
167 Savelist =>
168 (" <name of file> ",
169 " Save the list of fractal in a file "),
170
171 Loadlist =>
172 (" <name of file> ",
173 " Load a list of fractal from a file "),
174
175 About =>
176 (" ",
177 " ... and they're in my head "),
178
179 Quit =>
180 (" ",
181 " Quit Power Fractal ")
182 );
183
184
185 -------------------------ERREURS------------------------
186 Erreur_Trop_Parametre : exception; -- La commande n'as pas besoin de parametre
187 Erreur_Manque_Parametre : exception; -- La commande a besoin de parametre
188
189
190
191 ------------------------------------------------------------------------------------------------
192 -- Nom : Verif_Extension --
193 -- But : Verifie si un string comporte une extension ou non, si non l'ajoute --
194 -- --
195 -- Parametres ----------------------------------------------------------------------------------
196 -- In : * Le nom du fichier a modifier : Nom_Fichier --
197 -- * L'extension du fichier : Extension --
198 -- --
199 -- Return : * Le string verifie, et modifier si il faut --
200 ------------------------------------------------------------------------------------------------
201 function Verif_Extension (Nom_Fichier : String; Extension : String) return String is
202
203 ---------------------------------------------------------------------------------------------
204 -- Nom : Tout_Minuscule --
205 -- But : Mettre tout les lettres d'un texte passe en parametre en minuscule --
206 ---------------------------------------------------------------------------------------------
207 function Tout_Minuscule (Texte : in String) return String is
208
209 --Une variable temporaire egal au string en entree
210 Texte_Tmp : String (Texte'range) := Texte; --Variable Temporaire De 'Texte'
211
212 --Le decalage entre les minuscules est les majuscules
213 Decal_Min_Maj : constant := Character'Pos('a') - Character'Pos('A');
214
215 begin --Tout_Minuscule
216
217 --Boucle parcourant tout les caracteres de Texte_Tmp
218 for I in Texte_Tmp'First..Texte_Tmp'Last loop
219
220 if Texte_Tmp(I) in 'A'..'Z' then --Si il tombe sur une majuscule alors
221
222 --Convertie la majuscule en minuscule
223 Texte_Tmp(I) := Character'Val( Character'Pos(Texte(I)) + Decal_Min_Maj );
224 end if;
225
226 end loop;
227
228 return Texte_Tmp; --Retourne la valeur modifie de Texte
229
230 end Tout_Minuscule;
231 --Nom du fichier plus l'ajout de l'extension
232 Nom_Fichier_Ajout_Extension : String (1..Nom_Fichier'Length + Extension'Length);
233
234 begin --Verif_Extension
235
236 --Si la longueur du fichier est superieur a 4 (il y a la possibilite qu'il y ai l'extension)
237 --et que l'extension est correct alors renvois le nom du fichier sans rien modifier
238 if Nom_Fichier'Length > 4 and then
239 Tout_Minuscule(Nom_Fichier(Nom_Fichier'Last - 3 .. Nom_Fichier'Last)) =
240 "." & Tout_Minuscule(Extension) then
241
242 return Nom_Fichier;
243 else --Sinon ajoute l'extension
244 return Nom_Fichier & "." & Tout_Minuscule(Extension);
245 end if;
246
247 end Verif_Extension;
248
249
250 ------------------------------------------------------------------------------------------------
251 -- Nom : Parametre --
252 -- But : Determine si une commande est suivie d'un ou plusieurs parametre --
253 -- Parametres ----------------------------------------------------------------------------------
254 -- In : (aucun) --
255 -- --
256 -- return : * Si un (des) parametre existe : type : boolean --
257 ------------------------------------------------------------------------------------------------
258 function Parametre return Boolean is
259 Cara : Character;
260 Fin_Ligne : Boolean;
261 begin -- Parametre
262 -- Cherche un parametre
263 Look_Ahead(Cara, Fin_Ligne);
264 -- Tant que rencontre que des espace sur la ligne
265 while Cara = Espace and not End_Of_Line loop
266 Get(Cara);
267 Look_Ahead(Cara, Fin_Ligne);
268 end loop;
269 return not Fin_Ligne;
270 end Parametre;
271
272
273 ------------------------------------------------------------------------------------------------
274 -- Nom : Get --
275 -- But : Lit un mot entier de caractere d'une longueur max de 50 --
276 -- Parametres ----------------------------------------------------------------------------------
277 -- In : (aucun) --
278 -- --
279 -- Out : * Un mot : type : T_Chaine --
280 ------------------------------------------------------------------------------------------------
281 procedure Get (Chaine : out T_Chaine) is
282 Cara : Character; -- Caractere temporaire
283 Fin_Ligne : Boolean; -- Si fin de ligne ou non
284 begin
285 Chaine.Longueur := 0;
286 Look_Ahead(Cara, Fin_Ligne);
287 -- Tant que le mot ou la ligne est pas fini
288 while Cara /= Espace and not End_Of_Line loop
289 Get(Cara);
290 Chaine.Longueur := Chaine.Longueur + 1;
291 Chaine.Chaine(Chaine.Longueur) := Cara;
292 Look_Ahead(Cara, Fin_Ligne);
293 end loop;
294
295 end Get;
296
297
298 ------------------------------------------------------------------------------------------------
299 -- Nom : Get --
300 -- But : Lit une couleur en RGB selon le format: ( R G B ) --
301 -- Parametres ----------------------------------------------------------------------------------
302 -- In : (aucun) --
303 -- --
304 -- Out : * Ue couleur : type : T_Couleur --
305 ------------------------------------------------------------------------------------------------
306 procedure Get (Couleur : out T_Couleur) is
307 Cara : Character;
308 Fin_Ligne : Boolean;
309 begin -- Get
310
311 if Parametre then
312 Get(Cara);
313 if Cara = '(' then
314
315 -- Si existe lit chaque composante de la couleur
316 if Parametre then
317 Look_Ahead(Cara, Fin_Ligne);
318 Get(Couleur.R);
319 else
320 raise Data_Error;
321 end if;
322 if Parametre then
323 Get(Couleur.G);
324 else
325 raise Data_Error;
326 end if;
327 if Parametre then
328 Get(Couleur.B);
329 else
330 raise Data_Error;
331 end if;
332
333 -- Toute les composante trouvee -> cherche la parenthese fermante
334 if Parametre then
335 -- Trouve la parenthese fermante
336 Get(Cara);
337 if Cara /= ')' then
338 -- Pas de ')'
339 raise Data_Error;
340 end if;
341 else
342 -- Plus rien apres les 3 composante donc pas de ')'
343 raise Data_Error;
344 end if;
345 else
346 -- Pas de '('
347 raise Data_Error;
348 end if;
349 else
350 -- Plus rien apres la commande
351 raise Erreur_Manque_Parametre;
352 end if;
353 end Get;
354
355
356
357 ------------------------------------------------------------------------------------------------
358 -- Nom : Get --
359 -- But : Lit un boolean entre au clavier (1 / 0) --
360 -- Parametres ----------------------------------------------------------------------------------
361 -- In : (aucun) --
362 -- --
363 -- Out : * Un booleen : type : boolean --
364 ------------------------------------------------------------------------------------------------
365 procedure Get (Flag : out Boolean) is
366 Tmp : Integer; -- Variable temporaire pour la lecture
367 begin -- Get
368 Get(Tmp);
369 Flag := Tmp = 1;
370 if Tmp not in 0 .. 1 then
371 raise Data_Error;
372 end if;
373 end Get;
374
375
376 ------------------------------------------------------------------------------------------------
377 -- Nom : Console --
378 -- But : Gere une console avec commandes et parametre --
379 -- Parametres ----------------------------------------------------------------------------------
380 -- In : * le prompt utilise dans la console --
381 -- --
382 -- In out : La liste des fractals --
383 ------------------------------------------------------------------------------------------------
384 procedure Console(Liste : in out T_Liste_Fractals; Prompt : in String) is
385 Courant : T_Lien := Fractal_Num(Liste, 1); -- Fractal courante de la liste
386
387 Generateur_Composante : Generator; --Utilise pour tirer une composante au hasard
388
389 Commande : T_Commande; -- La commande
390
391 Facteur_Zoom : Long_Float; -- facteur en parametre a zoom
392 Largeur : Integer; -- Pour la resolution du BMP
393 Hauteur : Integer; -- Pour la resolution du BMP
394 Nom : T_Chaine; -- Pour le nom du fichier BMP ou du POF
395 Couleur : T_Couleur; -- Couleur (pour le changement de couleur)
396 Numero : Positive; -- Numero/nombre de la couleur ou de la fractale a selectionner
397 Long_Float_Tmp : Long_Float; -- Variable temporaire pour la saisie de 2 parametres long_float
398
399 Auto_Rafraichi : Boolean := True; -- Si redessine a chaque changement de parametre
400 Fractal_Change : Boolean := False; -- Si les parametres ont ete change par une commande
401 Couleur_Change : Boolean := False; -- Si les couleurs ont change par une commande
402
403
404 begin
405 Courant := Fractal_Num(Liste, Choix_Mosaic(Liste));
406 Power_Tools.Dessiner_Fractal(Courant.Fractal);
407
408 loop
409 begin
410
411 -- Saisie d'une commande correcte
412 loop
413 begin
414 New_Line;
415 Put(Prompt);
416 Get(Commande);
417 exit;
418 exception
419 when Data_Error =>
420 Skip_Line;
421 New_Line;
422 Put_Line(" Command unknown !");
423 Put(" (");
424 Put(T_Commande'First);
425 Put_Line(" for details)");
426 end;
427 end loop;
428
429
430 case Commande is
431 -- Aide
432 when T_Commande'Val(0) =>
433 if Parametre then
434 Get(Commande);
435 Skip_Line;
436 New_Line;
437 Put(" ");
438 Put(Commande);
439 Put(Commande_Aide(Commande).Info_Para);
440 New_Line;
441 Put(Commande_Aide(Commande).Info_Supp);
442 New_Line;
443
444 else
445 New_Line;
446 for I in T_Commande'range loop
447 Put(" ");
448 Put(I);
449 Put(Commande_Aide(I).Info_Para);
450 New_Line;
451 end loop;
452 end if;
453
454
455 -- Info
456 when T_Commande'Val(1) =>
457 if Parametre then
458 raise Erreur_Trop_Parametre;
459 end if;
460
461 New_Line;
462 Put(" ");
463 Put(Courant.Fractal.Ensemble);
464 New_Line;
465
466 Put(" Zoom : ");
467 Put(Courant.Fractal.Zoom,0, 6, 0);
468 New_Line;
469
470 Put(" Divergence limit : ");
471 Put(Courant.Fractal.C_Diverge_Limite,0 ,6, 0);
472 New_Line;
473
474 Put(" Iterations number : ");
475 Put(Courant.Fractal.Nb_Iteration_Max, 0);
476 New_Line;
477
478 Put(" Center : (");
479 Put(Courant.Fractal.Centre.X, 0,6,0);
480 Put(", ");
481 Put(Courant.Fractal.Centre.Y, 0,6,0);
482 Put(")");
483 New_Line;
484
485 Put(" Angle : ");
486 Put(Courant.Fractal.Angle, 0, 6, 0);
487 New_Line;
488
489
490 Put(" Antialiasing : ");
491 if Courant.Fractal.Antialiasing then
492 Put("yes");
493 else
494 Put("no");
495 end if;
496 New_Line;
497
498 if Courant.Fractal.Ensemble = Julia then
499 Put(" Constant : (");
500 Put(Courant.Fractal.Cx, 0,6,0);
501 Put(", ");
502 Put(Courant.Fractal.Cy, 0,6,0);
503 Put(")");
504 New_Line;
505 end if;
506
507 Put(" Colors (");
508 Put(Courant.Fractal.Nb_Couleur, 2);
509 Put(") :");
510 for I in Courant.Fractal.Couleur'range loop
511 Put(" (");
512 Put(Courant.Fractal.Couleur(I).R, 3);
513 Put(", ");
514 Put(Courant.Fractal.Couleur(I).G, 3);
515 Put(", ");
516 Put(Courant.Fractal.Couleur(I).B, 3);
517 Put(")");
518 New_Line;
519 Put(" ");
520 end loop;
521
522
523 -- Choisir une fractal dans la liste
524 when T_Commande'Val(2) =>
525 -- Si une seule fractale ne choisit pas
526 if Nb_Fractals(Liste) > 1 then
527 if Parametre then
528 Get(Numero);
529 Skip_Line;
530 -- Si le numero existe: prends la fractal
531 if Numero in 1 .. Nb_Fractals(Liste) then
532 Courant := Fractal_Num(Liste, Numero);
533 Fractal_Change:= True;
534 else
535 raise Data_Error;
536 end if;
537 else
538 -- Aucun parametre: affiche le choix
539 Courant := Fractal_Num(Liste, Choix_Mosaic(Liste));
540 Fractal_Change:= True;
541 end if;
542 else
543
544 New_Line;
545 Put_Line("There is only one fractal !");
546 end if;
547
548
549 -- Echange entre les ensemblea
550 when T_Commande'Val(3) =>
551 if Parametre then
552 raise Erreur_Trop_Parametre;
553 end if;
554 if Courant.Fractal.Ensemble = Julia then
555 Courant.Fractal := (Mandelbrot, Courant.Fractal.Nb_Couleur,
556 Courant.Fractal.Nb_Iteration_Max,
557 Courant.Fractal.C_Diverge_Limite, Courant.Fractal.Zoom,
558 Courant.Fractal.Centre, Courant.Fractal.Angle,
559 Courant.Fractal.Couleur, Courant.Fractal.Antialiasing,
560 Courant.Fractal.Dessine_Degrade);
561 else
562 Courant.Fractal := (Julia, Courant.Fractal.Nb_Couleur,
563 Courant.Fractal.Nb_Iteration_Max,
564 Courant.Fractal.C_Diverge_Limite, Courant.Fractal.Zoom,
565 Courant.Fractal.Centre, Courant.Fractal.Angle,
566 Courant.Fractal.Couleur, Courant.Fractal.Antialiasing,
567 Courant.Fractal.Dessine_Degrade,
568 Fractal_Initial_Julia.Cx, Fractal_Initial_Julia.Cy);
569 end if;
570 Fractal_Change:= True;
571
572
573 -- Zoom
574 when T_Commande'Val(4) =>
575
576 -- si parametre trouve
577 if Parametre then
578 Get(Courant.Fractal.Zoom);
579
580 -- Le zoom ne depasse pas la limite inferieure
581 if Courant.Fractal.Zoom < Zoom_Min then
582 Courant.Fractal.Zoom := Zoom_Min;
583 end if;
584 Fractal_Change := True;
585 else
586 Put_Line("Press ESC to return to console mode...");
587 -- Si la fractal affichee n'est plus actuelle: la redessine
588 if Fractal_Change then
589 Power_Tools.Dessiner_Fractal(Courant.Fractal);
590 Fractal_Change := False;
591 Couleur_Change := False;
592 end if;
593 Power_Tools.Zoom_Souris(Courant.Fractal);
594 end if;
595 Skip_Line;
596
597
598 -- Zoom avant
599 when T_Commande'Val(5) =>
600 if Parametre then
601 Get(Facteur_Zoom);
602 Courant.Fractal.Zoom := Courant.Fractal.Zoom * Facteur_Zoom;
603 else
604 Courant.Fractal.Zoom := Courant.Fractal.Zoom * Facteur_Zin;
605 end if;
606
607 -- Le zoom ne depasse pas la limite inferieure
608 if Courant.Fractal.Zoom < Zoom_Min then
609 Courant.Fractal.Zoom := Zoom_Min;
610 end if;
611 Skip_Line;
612 Fractal_Change := True;
613
614
615 -- Zoom arriere
616 when T_Commande'Val(6) =>
617 if Parametre then
618 Get(Facteur_Zoom);
619 Courant.Fractal.Zoom := Courant.Fractal.Zoom / Facteur_Zoom;
620 else
621 Courant.Fractal.Zoom := Courant.Fractal.Zoom / Facteur_Zout;
622 end if;
623
624 -- Le zoom ne depasse pas la limite inferieure
625 if Courant.Fractal.Zoom < Zoom_Min then
626 Courant.Fractal.Zoom := Zoom_Min;
627 end if;
628 Skip_Line;
629 Fractal_Change := True;
630
631
632 -- Centrer la fractal
633 when T_Commande'Val(7) =>
634
635 -- si parametre trouve
636 if Parametre then
637 Get(Long_Float_Tmp);
638 if Parametre then
639 Get(Courant.Fractal.Centre.Y);
640 Skip_Line;
641 Courant.Fractal.Centre.X := Long_Float_Tmp;
642 Fractal_Change := True;
643 else
644 raise Erreur_Manque_Parametre;
645 end if;
646 else
647 Put_Line("Press ESC to return to console mode...");
648 -- Si la fractal affichee n'est plus actuelle: la redessine
649 if Fractal_Change then
650 Power_Tools.Dessiner_Fractal(Courant.Fractal);
651 Fractal_Change := False;
652 Couleur_Change := False;
653 end if;
654 Power_Tools.Centrer(Courant.Fractal);
655 end if;
656
657
658 -- Nombre d'iteration
659 when T_Commande'Val(8) =>
660 if not Parametre then
661 raise Erreur_Manque_Parametre;
662 end if;
663 Get(Courant.Fractal.Nb_Iteration_Max);
664
665 -- Le nb d'iteration ne depasse pas la limite inferieure
666 if Courant.Fractal.Nb_Iteration_Max < Nb_Iteration_Min then
667 Courant.Fractal.Nb_Iteration_Max := Nb_Iteration_Min;
668 end if;
669 Skip_Line;
670 Fractal_Change := True;
671
672
673 -- Limite de divergence
674 when T_Commande'Val(9) =>
675 if not Parametre then
676 raise Erreur_Manque_Parametre;
677 end if;
678 Get(Courant.Fractal.C_Diverge_Limite);
679 Skip_Line;
680 -- Limite la valeur
681 if Courant.Fractal.C_Diverge_Limite < 0.0 then
682 Courant.Fractal.C_Diverge_Limite := 0.0;
683 elsif Courant.Fractal.C_Diverge_Limite > 4.0 then
684 Courant.Fractal.C_Diverge_Limite := 4.0;
685 end if;
686 Fractal_Change := True;
687
688
689
690 -- Constante pour le calcul de Julia
691 when T_Commande'Val(10) =>
692 if Courant.Fractal.Ensemble = Julia then
693 if Parametre then
694 Get(Long_Float_Tmp);
695 else
696 raise Erreur_Manque_Parametre;
697 end if;
698 if Parametre then
699 Get(Courant.Fractal.Cy);
700 Courant.Fractal.Cx := Long_Float_Tmp;
701 Fractal_Change := True;
702 else
703 raise Erreur_Manque_Parametre;
704 end if;
705 else
706 New_Line;
707 Put_Line(" Only with Julia set !");
708 end if;
709
710
711 -- Rotation de la fractale
712 when T_Commande'Val(11) =>
713 if Parametre then
714 Get(Courant.Fractal.Angle);
715 Skip_Line;
716
717 if Courant.Fractal.Angle > 0.0 then
718 while Courant.Fractal.Angle not in 0.0 .. 360.0 loop
719 Courant.Fractal.Angle := Courant.Fractal.Angle - 360.0;
720 end loop;
721 else
722 while Courant.Fractal.Angle not in 0.0 .. 360.0 loop
723 Courant.Fractal.Angle := Courant.Fractal.Angle + 360.0;
724 end loop;
725 end if;
726
727 Fractal_Change := True;
728 else
729 raise Erreur_Manque_Parametre;
730 end if;
731
732
733 -- Couleur par numero de la couleur
734 when T_Commande'Val(12) =>
735 if Parametre then
736 Get(Numero);
737 else
738 raise Erreur_Manque_Parametre;
739 end if;
740
741 -- Si le numero ne corespond a rien: erreur
742 if Numero not in Courant.Fractal.Couleur'range then
743 raise Data_Error;
744 end if;
745
746 if Parametre then
747 Get(Courant.Fractal.Couleur(Numero));
748 Couleur_Change := True;
749 else
750 raise Erreur_Manque_Parametre;
751 end if;
752
753
754 -- Le nombre de couleur definie du degrade
755 when T_Commande'Val(13) =>
756 if Parametre then
757 Get(Numero);
758 Skip_Line;
759 if Numero < 2 then
760 Numero := 2;
761 elsif Numero > Nb_Couleur_Max then
762 Numero := Nb_Couleur_Max;
763 end if;
764 -- Devient le nombre de couleur a ajouter (relatif, plus absolu)
765 Numero := Numero - Courant.Fractal.Nb_Couleur;
766
767 -- Redefinit la fractal avec le bon nombre de couleur
768 if Courant.Fractal.Ensemble = Mandelbrot then
769 Courant.Fractal := (Mandelbrot, Courant.Fractal.Nb_Couleur + Numero,
770 Courant.Fractal.Nb_Iteration_Max,
771 Courant.Fractal.C_Diverge_Limite,
772 Courant.Fractal.Zoom, Courant.Fractal.Centre,
773 Courant.Fractal.Angle, Courant.Fractal.Couleur(
774 Courant.Fractal.Couleur'First ..
775 Courant.Fractal.Nb_Couleur + Numero),
776 Courant.Fractal.Antialiasing,
777 Courant.Fractal.Dessine_Degrade);
778 else
779 Courant.Fractal := (Julia, Courant.Fractal.Nb_Couleur + Numero,
780 Courant.Fractal.Nb_Iteration_Max,
781 Courant.Fractal.C_Diverge_Limite,
782 Courant.Fractal.Zoom, Courant.Fractal.Centre,
783 Courant.Fractal.Angle, Courant.Fractal.Couleur(
784 Courant.Fractal.Couleur'First ..
785 Courant.Fractal.Nb_Couleur + Numero),
786 Courant.Fractal.Antialiasing,
787 Courant.Fractal.Dessine_Degrade,
788 Courant.Fractal.Cx, Courant.Fractal.Cy);
789 end if;
790
791 -- Quand le nouveau nb de couleur est plus grand: repete la derniere
792 -- couleur connue dans le reste des couleurs
793 Courant.Fractal.Couleur(Courant.Fractal.Nb_Couleur - Numero + 1 ..
794 Courant.Fractal.Couleur'Last) := (others =>
795 Courant.Fractal.Couleur(Courant.Fractal.Nb_Couleur - Numero));
796 Couleur_Change := True;
797 else
798 raise Erreur_Manque_Parametre;
799 end if;
800
801
802 -- Tire les couleurs au hasard
803 when T_Commande'Val(14) =>
804 if Parametre then
805 raise Erreur_Trop_Parametre;
806 else
807 Reset(Generateur_Composante);
808 -- Tire au hasard chaque couleur de la composante
809 for I in Courant.Fractal.Couleur'range loop
810 Courant.Fractal.Couleur(I) := (Random(Generateur_Composante),
811 Random(Generateur_Composante), Random(Generateur_Composante));
812 end loop;
813 Couleur_Change := True;
814 end if;
815
816
817 -- Si dessine le degrade de couleur
818 when T_Commande'Val(15) =>
819 if not Parametre then
820 raise Erreur_Manque_Parametre;
821 end if;
822 Get(Courant.Fractal.Dessine_Degrade);
823 Skip_Line;
824 Couleur_Change := True;
825
826
827 -- Reinitialise tous les parametres
828 when T_Commande'Val(16) =>
829 if Parametre then
830 raise Erreur_Trop_Parametre;
831 end if;
832 -- Inialise selon l'ensebmle de la fractal
833 if Courant.Fractal.Ensemble = Julia then
834 Courant.Fractal := Fractal_Initial_Julia;
835 else
836 Courant.Fractal := Fractal_Initial_Mandel;
837 end if;
838 Fractal_Change := True;
839
840
841 -- Reprends la liste par defaut
842 when T_Commande'Val(17) =>
843 if Parametre then
844 raise Erreur_Trop_Parametre;
845 else
846 Liste := Liste_Defaut;
847 Courant := Fractal_Num(Liste, Choix_Mosaic(Liste));
848 Fractal_Change:= True;
849 end if;
850
851
852 -- Rafraichissement automatique
853 when T_Commande'Val(18) =>
854 if not Parametre then
855 raise Erreur_Manque_Parametre;
856 end if;
857 Get(Auto_Rafraichi);
858 Skip_Line;
859
860
861 -- Dessine la fractale
862 when T_Commande'Val(19) =>
863 if Parametre then
864 raise Erreur_Trop_Parametre;
865 end if;
866 Power_Tools.Dessiner_Fractal(Courant.Fractal);
867 Fractal_Change := False;
868 Couleur_Change := False;
869
870
871 -- Antialiasing
872 when T_Commande'Val(20) =>
873 if not Parametre then
874 -- Aucun parametre: erreur
875 raise Erreur_Manque_Parametre;
876 end if;
877 Get(Courant.Fractal.Antialiasing);
878 Skip_Line;
879 Fractal_Change := True;
880
881
882 -- Rendre dans un fichier BMP
883 when T_Commande'Val(21) =>
884 if Parametre then
885 -- Prends le premier parametre
886 Get(Nom);
887 else
888 -- Aucun parametre: erreur
889 raise Erreur_Manque_Parametre;
890 end if;
891
892 if Parametre then
893 -- Prends le 2eme parametre
894 Get(Largeur);
895 if Parametre then
896 -- Prends 3eme parametre et balance le reste
897 Get(Hauteur);
898 Skip_Line;
899
900 -- Ajuste la resolution a min 5 et max 10'000
901 if Largeur < 5 then
902 Largeur := 5;
903 elsif Largeur > 10000 then
904 Largeur := 10000;
905 elsif Hauteur < 5 then
906 Hauteur := 5;
907 elsif Hauteur > 10000 then
908 Hauteur := 10000;
909 end if;
910
911 -- 3 parametres lu correctement: crée le BMP avec la resolution demandée
912 Power_Io.Rendre_Bmp (Courant.Fractal,
913 Verif_Extension(Nom.Chaine(1 .. Nom.Longueur), "BMP"),
914 Largeur, Hauteur);
915 else
916 -- 2 parametres
917 raise Erreur_Manque_Parametre;
918 end if;
919 else
920 -- 1 seul parametre: cree le BMP avec valeur par defaut
921 Power_Io.Rendre_Bmp ( Courant.Fractal,
922 Verif_Extension(Nom.Chaine(1 .. Nom.Longueur), "BMP"));
923 end if;
924
925
926 -- Cree une nouvelle fractal
927 when T_Commande'Val(22) =>
928 if Parametre then
929 raise Erreur_Trop_Parametre;
930 else
931 Ajouter(Liste, Fractal_Initial_Mandel);
932 Courant := Fractal_Num(Liste, Nb_Fractals(Liste));
933 Fractal_Change:= True;
934 end if;
935
936
937 -- Supprime une fractal de la liste
938 when T_Commande'Val(23) =>
939 if Nb_Fractals(Liste) > 1 then
940 if Parametre then
941 Get(Numero);
942 Skip_Line;
943 -- Si la fractal existe
944 if Numero in 1 .. Nb_Fractals(Liste) then
945
946 --Si veut effacer la fractal courante: change la courante
947 if Courant = Fractal_Num(Liste, Numero) and Numero > 1 then
948 Courant := Fractal_Num(Liste, Numero - 1);
949 Fractal_Change := True;
950 elsif Courant = Fractal_Num(Liste, Numero) and Numero = 1 then
951 Courant := Fractal_Num(Liste, 2);
952 Fractal_Change := True;
953 end if;
954
955 Effacer(Liste, Numero);
956 else
957 raise Data_Error;
958 end if;
959 -- Si aucun parametre
960 else
961 Numero := Choix_Mosaic(Liste);
962 --Si veut effacer la fractal courante: change la courante
963 if Courant = Fractal_Num(Liste, Numero) and Numero > 1 then
964 Courant := Fractal_Num(Liste, Numero - 1);
965 elsif Courant = Fractal_Num(Liste, Numero) and Numero = 1 then
966 Courant := Fractal_Num(Liste, 2);
967 end if;
968 Effacer(Liste, Numero);
969 Fractal_Change := True;
970 end if;
971 -- Si veux effacer la derniere fractal
972 else
973 New_Line;
974 Put_Line("The last fractal can't be deleted !");
975 end if;
976
977
978
979 -- Sauve les donnee de la fractale
980 when T_Commande'Val(24) =>
981 if Parametre then
982 Get(Nom);
983 Skip_Line;
984 Power_Io.Enregistrer_Fractal(Verif_Extension(Nom.Chaine(1 .. Nom.Longueur),
985 "JOF"), Courant.Fractal);
986 else
987 raise Erreur_Manque_Parametre;
988 end if;
989
990
991 -- Charge les donnee de la fractale
992 when T_Commande'Val(25) =>
993 if Parametre then
994 Get(Nom);
995 Skip_Line;
996 -- Ajoute a la liste et la prend comme fractale courante
997 Ajouter(Liste, Power_Io.Charger_Fractal
998 (Verif_Extension(Nom.Chaine(1 .. Nom.Longueur), "JOF")));
999
1000 Courant := Fractal_Num(Liste, Nb_Fractals(Liste));
1001 Fractal_Change := True;
1002 else
1003 raise Erreur_Manque_Parametre;
1004 end if;
1005
1006
1007
1008
1009
1010 -- Sauve les donnee de toute la liste
1011 when T_Commande'Val(26) =>
1012 if Parametre then
1013 Get(Nom);
1014 Skip_Line;
1015 Power_Io.Enregistrer_Liste
1016 (Verif_Extension(Nom.Chaine(1 .. Nom.Longueur), "LOF"), Liste);
1017 else
1018 raise Erreur_Manque_Parametre;
1019 end if;
1020
1021
1022 -- Charge les donnee de toute la liste
1023 when T_Commande'Val(27) =>
1024 if Parametre then
1025 Get(Nom);
1026 Skip_Line;
1027 Power_Io.Charger_Liste
1028 (Verif_Extension(Nom.Chaine(1 .. Nom.Longueur), "LOF"), Liste);
1029
1030 Courant := Fractal_Num(Liste, Choix_Mosaic(Liste));
1031 Fractal_Change := True;
1032 else
1033 raise Erreur_Manque_Parametre;
1034 end if;
1035
1036
1037 -- A propos du programme
1038 when T_Commande'Val(28) =>
1039 if Parametre then
1040 raise Erreur_Trop_Parametre;
1041 end if;
1042 Skip_Line;
1043 Put_Line(" ____ ___ __ __ _____ ____");
1044 Put_Line(" | _ \ / _ \\ \ / /| ____|| _ \ ");
1045 Put_Line(" | |_) || | | |\ \ /\ / / | _| | |_) |");
1046 Put_Line(" | __/ | |_| | \ V V / | |___ | _ < ");
1047 Put_Line(" |_| \___/ \_/\_/ |_____||_| \_\");
1048 New_Line;
1049 Put_Line(" _____ ____ _ ____ _____ _ _");
1050 Put_Line(" | ___|| _ \ / \ / ___||_ _| / \ | |");
1051 Put_Line(" | |_ | |_) | / _ \ | | | | / _ \ | |");
1052 Put_Line(" | _| | _ < / ___ \| |___ | | / ___ \ | |__");
1053 Put_Line(" |_| |_| \_\/_/ \_\\____| |_|/_/ \_\|____|");
1054 Put_Line(" V 1.0");
1055 Put_Line(" by G.Burri and A.Crivelli");
1056 New_Line;
1057 Put_Line(" e-mail : greg.burri@net2000.ch");
1058 Put_Line(" powerkiki@urbanet.ch");
1059 New_Line;
1060 Put_Line(" Url : http://pifou.servehttp.com/powerfractal");
1061
1062
1063 -- Quitte le programme
1064 when T_Commande'Val(29) =>
1065 if Parametre then
1066 raise Erreur_Trop_Parametre;
1067 end if;
1068 Skip_Line;
1069 exit;
1070
1071
1072 end case;
1073
1074 -- En mode auto: redessine la fractal si un ou plusieurs parametres ont change
1075 if Auto_Rafraichi and Fractal_Change then
1076 Power_Tools.Dessiner_Fractal(Courant.Fractal);
1077 Fractal_Change := False;
1078 Couleur_Change := False;
1079 -- En mode auto: redessine la fractal si les couleurs ont changé
1080 elsif Auto_Rafraichi and Couleur_Change then
1081 Power_Tools.Rafraichir_Couleur(Courant.Fractal);
1082 Couleur_Change := False;
1083 end if;
1084
1085
1086 exception
1087 when Erreur_Trop_Parametre =>
1088 Skip_Line;
1089 New_Line;
1090 Put_Line(" Too much parameters !");
1091 Put(" (");
1092 Put(T_Commande'First);
1093 Put_Line(" for details)");
1094
1095 when Erreur_Manque_Parametre =>
1096 Skip_Line;
1097 New_Line;
1098 Put_Line(" Parameter(s) missing !");
1099 Put(" (");
1100 Put(T_Commande'First);
1101 Put_Line(" for details)");
1102
1103 when Data_Error =>
1104 Skip_Line;
1105 New_Line;
1106 Put_Line(" Bad parameter(s) !");
1107 Put(" (");
1108 Put(T_Commande'First);
1109 Put_Line(" for details)");
1110
1111 when Power_Io.Erreur_Fichier =>
1112 New_Line;
1113 Put_Line(" File not found !");
1114
1115 end;
1116 end loop;
1117 end Console;
1118
1119
1120 end Power_Console;
Logiciel de dessin de fractals écrit en ADA.