PROGRAM projet; (* ------------------------------------------------------------------------ *) UNIT Entier_long : CLASS; UNIT elem : CLASS (valeur:INTEGER, suivant:elem); END elem; (* ------------------------------------------------------------------------ *) VAR sommet : elem; (* ------------------------------------------------------------------------ *) UNIT depiler : FUNCTION : INTEGER; (* Cette fonction permet d'extraire d'une pile un ‚lŠment. *) BEGIN IF sommet =/= NONE THEN RESULT := sommet.valeur; sommet := sommet.suivant FI; END depiler; (* ------------------------------------------------------------------------ *) UNIT pile_vide : FUNCTION : BOOLEAN; (* Cette fonction bool‚en confirme si une pile est vide ou non. Si le sommet est faux null alors RESULT prend la valeur vraie sinon faux. *) BEGIN IF sommet = NONE THEN RESULT := TRUE ELSE RESULT := FALSE; FI; END pile_vide; (* ------------------------------------------------------------------------ *) UNIT empiler : PROCEDURE (x : INTEGER); (* Cette proc‚dure permet d'empiler un ‚lŠment au sommet d'une pile. *) BEGIN sommet := NEW elem (x,sommet); END empiler; (* ------------------------------------------------------------------------ *) UNIT addition : FUNCTION (p2 : Entier_long) : Entier_long; (* Cette fonction permet d'effectuer l'addition, elle retourne une Entier_long. On effectue l'addition au fur et … mesure que l'on d‚pile. *) VAR retenu, so : INTEGER; BEGIN retenu := 0; RESULT := NEW Entier_long; WHILE (NOT pile_vide) OR (NOT p2.pile_vide) DO IF pile_vide THEN (* Si p1 est vide alors le calcul se fait avec la d‚pile de p2 et la gestion de la retenu. *) so := p2.depiler + retenu ELSE IF p2.pile_vide (* Si p2 est vide alors le calcul se fait avec la d‚pile de p1 et la gestion de la retenu. *) THEN so := depiler + retenu ELSE so := depiler + p2.depiler + retenu (* Dans les autres cas, on d‚pile les deux piles et on g‚re la retenu. *) FI; FI; IF so > 9 THEN (* On fait en quelque sorte un modulo 10. On enlŠve 10 pour em- piler le chiffre qui en est d‚duit et la retenue vaut alors 1. *) retenu := 1; so := so - 10 ELSE (* Ici le calcul donne un chiffre alors la retenu est nulle. *) retenu := 0; FI; CALL RESULT.empiler (so); OD; (* Gestion de la retenu. *) IF retenu =/= 0 THEN CALL RESULT.empiler (retenu) FI; END addition; (* ------------------------------------------------------------------------ *) UNIT soustraction : FUNCTION (p2 : Entier_long) : Entier_long; (* Cette fonction permet d'effectuer la soustraction, elle retourne une entier long. On effectue la soustraction au fur et … mesure que l'on d‚pile. A la fin de la fonction on va tester la valeur de la retenu, si elle est ‚gale … 1 cela signifie que le r‚sultat est n‚gatif. *) VAR retenu, di : INTEGER; BEGIN retenu := 0; RESULT := NEW Entier_long; WHILE (not pile_vide) OR (not p2.pile_vide) DO IF pile_vide THEN (* Si p1 est vide alors le calcul se fait avec la d‚pile de p2 et la gestion de la retenu. *) di := - p2.depiler - retenu ELSE IF p2.pile_vide THEN (* Si p2 est vide alors le calcul se fait avec la d‚pile de p1 et la gestion de la retenu. *) di := depiler - retenu ELSE (* Dans les autres cas, on d‚pile les deux piles et on g‚re la retenu. *) di := depiler - p2.depiler - retenu FI; FI; IF di < 0 THEN (* Pour ‚viter d'avoir une valeur n‚gative on ajoute 10 … di pour empiler un chiffre positif et la retenu prend la valeur vaut alors 1. *) retenu := 1; di := di + 10 ELSE (* Ici le calcul donne un chiffre positif alors la retenu est nulle. *) retenu := 0; FI; CALL RESULT.empiler(di); OD; IF retenu =/= 0 (* Cette deuxiŠme partie ne concerne que la division. Quand les piles sont vides si la retenu est diff‚rente de 0 c'est que la valeur de p1 est < … celle de p2. *) THEN b1 := FALSE; FI; END soustraction; (* ------------------------------------------------------------------------ *) UNIT multiplication : FUNCTION (p2 : Entier_long ; n : INTEGER) : Entier_long; (* Cette fonction permet d'effectuer la multiplication elle retourne un entier long. n repr‚sente le nombre d'‚lŠments qu'il y a dans la plus grande pile. On d‚coupe les piles jusqu'… obtenir un type ‚lŠment. *) VAR val : INTEGER , x1, x2, x3, x4 : INTEGER , pp1, p11, pp2, pt, p22, pp3, p33, pp4, p44, mul1, mul2, mul3, mul4, som1, som2 : Entier_long; BEGIN pp1 := NEW Entier_long; p11 := NEW Entier_long; pp2 := NEW Entier_long; pp3 := NEW Entier_long; p33 := NEW Entier_long; pp4 := NEW Entier_long; p44 := NEW Entier_long; pt := NEW Entier_long; mul1 := NEW Entier_long; mul2 := NEW Entier_long; mul3 := NEW Entier_long; mul4 := NEW Entier_long; som1 := NEW Entier_long; som2 := NEW Entier_long; RESULT := NEW Entier_long; n := n DIV 2; CALL position (17,60); WRITE ("Calcul en cours..."); WHILE NOT pile_vide DO (* Transfert de la pile p1 vers la pile pt.*) CALL pt.empiler (depiler); OD; (* Le transfert vers 2 piles permet de sauvegarder les informations vers dans une autre pile parce qu'une fois les ‚lŠments utilis‚s la pile qui les contenaient est vide. Et pour les utiliser une autre fois il faut les avoir sauvegarder dans une autre. *) CALL transferer_2_piles (pt,p11,pp1); CALL transferer_2_piles (transferer_pile (p2),p22,pp2); IF n <= 2 THEN x3 := pp1.depiler ; x4 := pp2.depiler ; x1 := pp1.depiler ; x2 := pp2.depiler ; val := x1 * x2 * 100 + (x1 * x4 + x3 * x2) * 10 + (x3 * x4); RESULT := conversion (val,n1); (* Ici n1 ne sert … rien puisse que son but dans la fuction est de compter aussi le nombre d'‚lŠments qui se trou- ve dans la pile. dans laquelle est mise les chiffres qui sont convertis.*) ELSE pp3 := transferer_pile (apparition(pp1,n)); p33 := transferer_pile (apparition(p11,n)); pp4 := transferer_pile (apparition(pp2,n)); p44 := transferer_pile (apparition(p22,n)); (* mul1, mul2, mul3, mul4 : sont 4 traitements r‚cursives au il ajouter pour certain cas un certain nombre de 0. *) mul1 := transferer_pile (pp1.multiplication (pp2,n)); CALL mul1.ajouter_zero (n); mul2 := transferer_pile (p11.multiplication (pp4,n)); CALL mul2.ajouter_zero (n DIV 2); mul3 := transferer_pile (p22.multiplication (pp3,n)); CALL mul3.ajouter_zero (n DIV 2); mul4 := transferer_pile (p33.multiplication (p44,n)); (* Addition des 4 mul trouv‚s qui forment le r‚sultat. *) som1 := transferer_pile (mul1.addition (mul2)); som2 := transferer_pile (mul3.addition (mul4)); RESULT := som1.addition (som2); FI; END multiplication; (* ------------------------------------------------------------------------ *) UNIT carre : FUNCTION (n : INTEGER) : Entier_long; (* Cette fonction permet d'effectuer le carre d'une multiplication. *) VAR p3, p4, pt : Entier_long; BEGIN RESULT := NEW Entier_long; p3 := NEW Entier_long; p4 := NEW Entier_long; pt := NEW Entier_long; WHILE NOT pile_vide DO (* Transfert de la pile p1 vers la pile pt.*) CALL pt.empiler (depiler); OD; CALL transferer_2_piles (pt,p3,p4); RESULT := p4.multiplication (p3,n*2); CALL effacer_partie (1,19,16,58); END carre; (* ------------------------------------------------------------------------ *) UNIT division : FUNCTION (p2 : Entier_Long) : Entier_long; (* Cette fonction permet d'effectuer la division (entiŠre) avec un Entier_long. Elle retourne Entier_long. Un division est une soustraction du dividande avec le diviseur. *) VAR p3, p5, p6, pt : Entier_long; BEGIN b1 := TRUE; RESULT := NEW Entier_long; p3 := NEW Entier_long; p5 := NEW Entier_long; p6 := NEW Entier_long; pt := NEW Entier_long; WHILE NOT pile_vide DO (* Transfert de la pile p1 vers la pile pt.*) CALL pt.empiler (depiler); OD; CALL RESULT.empiler(0); (* R‚sult est initialis‚ … 0. *) pt := transferer_pile (pt); WHILE b1 (* Correspond au bool‚en donn‚e par la soustraction. *) DO CALL position (17,60); WRITE ("Calcul en cours..."); CALL transferer_2_piles (p2,p5,p6); pt := transferer_pile (pt.soustraction(transferer_pile (p5))); p2 := transferer_pile (p6); (* pour ne pas perdre l'information de base de p2 alors p6 redevient p2 qui … son tour redevient p6.*) IF b1 (* Quand on sort de la fonction traiter_soustrac- tion retenu n'est pas forc‚ment ‚gale … 0. *) THEN CALL p3.empiler (1); (* A chaque soustraction on incr‚mente RESULT de 1. Ce 1 est alors empiler dans p3. *) RESULT := transferer_pile (RESULT.addition (p3)); FI; OD; RESULT := transferer_pile (RESULT); CALL effacer_partie (1,19,16,58); END division; (* ------------------------------------------------------------------------ *) UNIT modulo : FUNCTION (p2 : Entier_long) : Entier_long; (* Cette fonction permet de calculer le reste d'une division avec un entier long. Elle retourne un Entier_long. Quand le r‚sultat de la sous- traction est vide est < … 0 il faut avoir garder quelque part la valeur du pr‚c‚dent dividande. En fait tant que le reste est positif, on r‚ini tialise la RESULT. *) VAR p5, p6, pt : Entier_long; BEGIN b1 := TRUE; p5 := NEW Entier_long; p6 := NEW Entier_long; pt := NEW Entier_long; WHILE NOT pile_vide DO (* Transfert de la pile p1 vers la pile pt.*) CALL pt.empiler (depiler); OD; WHILE b1 DO CALL position (17,60); WRITE ("Calcul en cours..."); CALL transferer_2_piles (p2,p5,p6); (* p2 et p6 font faire former un cycle pourque l'information ne soit pas perdu. *) RESULT := NEW Entier_long; (* pt et RESULT contient le dernier reste de la division. Si b1 est faux ce qui signifie que la valeur que contient la pile pt est inf‚rieur … celle qui est incluse dans p5. Tant que la soustraction est positive (b1 est vrai) alors RESULT est reinitialis‚e. *) CALL transferer_2_piles (pt,pt,RESULT); RESULT := transferer_pile (RESULT); pt := transferer_pile(transferer_pile (pt.soustraction(transferer_pile (p5)))); p2 := transferer_pile (p6); OD; CALL effacer_partie (1,19,16,58); END modulo; (* ------------------------------------------------------------------------ *) UNIT pgcd : FUNCTION (p2 : Entier_Long) : Entier_long; (* Cette fonction permet de calculer le pgcd entre deux entiers longs. Elle retourne un Entier_long. Tq r =/=0 fr r <-- a MOD b ; a <-- b ; b <-- r Ftq Ici r repr‚sente p2 et b2 qui lui va prendre FAUX lors du transfert de p2 vers p2 si dans cette derniŠre pile il y la valeur 0. *) VAR p5, pt : Entier_long; BEGIN b2 := TRUE; p5 := NEW Entier_long; pt := NEW Entier_long; WHILE NOT pile_vide DO (* Transfert de la pile p1 vers la pile pt.*) CALL pt.empiler (depiler); OD; pt := transferer_pile (pt); WHILE b2 DO CALL transferer_2_piles (p2,p2,p5); p2 := (pt.modulo (transferer_pile (p2))); RESULT := NEW Entier_long; RESULT := transferer_pile (transferer_pile (p5)); p2 := transferer_pile (p2); IF b2 THEN pt := transferer_pile (RESULT); FI; OD; END pgcd; (* ------------------------------------------------------------------------ *) UNIT ppcm : FUNCTION (p2 : Entier_Long) : Entier_long; (* Cette fonction permet de calculer le ppcm entre deux entiers longs. Elle retourne un Entier_long. ppcm (a,b) = (a * b) / pgcd (a,b). *) VAR p3, p4, pt, pp : Entier_long; BEGIN p3 := NEW Entier_long; p4 := NEW Entier_long; pp := NEW Entier_long; pt := NEW Entier_long; WHILE NOT pile_vide DO (* Transfert de la pile p1 vers la pile pt.*) CALL pt.empiler (depiler); OD; CALL transferer_2_piles (transferer_pile (p2),p2,p4); CALL transferer_2_piles (pt,pt,p3); (* pp prend la valeur de la multiplication de p2 et de pt. *) pp := transferer_pile (pt.multiplication (p2,partition (grand(n1,n2,n3)))); RESULT := pp.division (transferer_pile (p3.pgcd (p4))); END ppcm; (* ------------------------------------------------------------------------ *) UNIT conversion : FUNCTION (nbre : INTEGER ; OUTPUT n : INTEGER) : Entier_long ; (* Cette fonction d‚compose un entier en tout chiffre qui la compose. Elle retourne un type Entier_long et comme paramˆtre le nombre de chiffres qui compose cette description ainsi ce dernier paramˆtre donne une id‚e de la taille de la premiŠre pile. Pareil que la fonction saisie, on va ‚viter d'empiler des 0 en d‚but de nombre inutile. *) VAR x : INTEGER, trouve : BOOLEAN; BEGIN RESULT := NEW Entier_long; trouve := FALSE; n := 0; DO x := nbre MOD 10; IF (x =/= 0) THEN CALL RESULT.empiler (x); trouve := TRUE; nbre := nbre DIV 10; n := n + 1 ELSE IF trouve THEN CALL RESULT.empiler (x); nbre := nbre DIV 10; n := n + 1; FI; FI; IF (nbre = 0) THEN EXIT; FI; OD; END conversion; (* ------------------------------------------------------------------------ *) UNIT transferer_pile : FUNCTION (p2 : Entier_long) : Entier_long; (* Cette fonction permet de d‚piler une pile pour empiler dans une autre.*) VAR i : INTEGER; BEGIN b2 := FALSE; (* b2 va tester si la valeur duŠ reste est ‚gale … z‚ro (ce qui est valable seulement pour le PGCD) *) RESULT := NEW Entier_long; WHILE NOT p2.pile_vide DO i := p2.depiler; IF i =/= 0 THEN b2 := TRUE; FI; CALL RESULT.empiler (i); OD; END transferer_pile; (* ------------------------------------------------------------------------ *) UNIT transferer_2_piles : PROCEDURE (p2 : Entier_long ; OUTPUT p3,p4 : Entier_long); (* Cette proc‚dure permet de d‚piler une pile pour empiler dans deux autres. *) VAR x : INTEGER; BEGIN p3 := NEW Entier_long; p4 := NEW Entier_long; WHILE NOT p2.pile_vide DO x := p2.depiler; CALL p3.empiler (x); CALL p4.empiler (x); OD; END transferer_2_piles; (* ------------------------------------------------------------------------ *) UNIT apparition : FUNCTION (p2 : Entier_long ; n : INTEGER) : Entier_long; (* Cette fonction permet de faire apparaŒtre une nouvelle pile en divisant celle qui existe en deux. n : repr‚sente le nombre de chiffres contenu dans la pile. Cette fonction n'est valable pour la multiplication. *) BEGIN RESULT := NEW Entier_long; n := n DIV 2; WHILE n =/= 0 DO CALL RESULT.empiler (p2.depiler); n := n - 1; OD; END apparition; (* ------------------------------------------------------------------------ *) UNIT max_de_2_piles : PROCEDURE (v1,v2 : INTEGER ; INOUT p2 : Entier_long ; OUTPUT max : INTEGER); (* Cette proc‚dure d‚termine quel nombre des piles est plus grand. Puisse qu'au d‚part il y a s‚lection dans la saisie (les z‚ros qui pr‚cŠ- dent un chiffre autre qu'un z‚ro) ; on fait la comparaison avec v1, v2 (le nombre de chiffres compris dans la pile). Si v1 et v2 sont ‚gaux (exemple 121 et 331) les valeurs sont ici 3 ; alors on compare deux … deux les chiffres pour d‚terminer la pile qui contient le nombre le plus grande. max resort 1 pour la pile1 et 2 pour la pile2.*) VAR x1, x2 : INTEGER, b : BOOLEAN, p3,p4,p5,p6 : Entier_long; BEGIN p3 := NEW Entier_long; p4 := NEW Entier_long; p5 := NEW Entier_long; p6 := NEW Entier_long; max := 0; b := TRUE; (* 1ø partie : Comparaison des valeurs v1 et v2. *) IF v1 > v2 THEN max := 1 ELSE IF v1 < v2 THEN max := 2 ELSE (* Si dans les deux piles le nombre de chiffres est ‚gale, on compare les chiffres entre eux pour con- naŒtre enfin la plus grande. *) CALL transferer_2_piles (p1,p3,p5); CALL transferer_2_piles (p2,p4,p6); (* Au cours de la comparaison dŠs que l'on a trouv‚ une diff‚rence entre les deux piles, on arrˆte la recher- che. *) WHILE NOT (p3.pile_vide) AND b DO x1 := p3.depiler; x2 := p4.depiler; IF (x1 > x2) THEN max := 1; b := FALSE ELSE IF (x1 < x2) THEN max := 2; b := FALSE; FI; FI; OD; p1 := transferer_pile (p5); p2 := transferer_pile (p6); FI; FI; END max_de_2_piles; (* ------------------------------------------------------------------------ *) UNIT ajouter_zero : PROCEDURE (n : INTEGER); (* Cette fonction permet d'ajouter des z‚ros … la suite d'une pile n : repr‚sente le nombre de 0 qui vont ˆtre empiler. Cette proc‚dure est valable seulement pour la multiplication. *) VAR emp : INTEGER; BEGIN FOR emp := 1 to n DO CALL empiler (0); OD; END ajouter_zero; (* ------------------------------------------------------------------------ *) UNIT saisir : FUNCTION (i, j : INTEGER ; OUTPUT n : INTEGER) : Entier_long; (* Cette fonction permet de saisir les chiffres pour les empiler. Par cette m‚thode de saisie, les z‚ros qui sont en d‚but de nom- bre ne sont pas saisies (ce qui permet d'avoir une id‚e rapide de la plus grande pile. i et j : deux variables qui repr‚sentent la position du curseur … l'‚cran. n : resort le nbre de chiffre empil‚s.*) VAR nnbre : CHAR, nbre : INTEGER, trouve : BOOLEAN; BEGIN RESULT := NEW Entier_long; trouve := FALSE; n := 0; DO CALL position (i,j); IF j = 80 THEN (* Passage … la ligne pour des entiers trŠs longs.*) i := i + 1; j := 1; FI; nnbre := chr (inchar); IF (ord (nnbre) < 48) OR (ord (nnbre) > 57) THEN EXIT; FI; nbre := entier (nnbre); CALL position (i,j); WRITELN (nnbre); IF (nbre =/= 0) THEN CALL RESULT.empiler (nbre); trouve := TRUE; (* On fait un barage aux premiers z‚ros saisie. *) n := n + 1 ELSE IF trouve (* Une fois un nbre diff‚rent de 0 est saisie 0 peut ˆtre bien-s–r saisie autant de fois que possible. *) THEN CALL RESULT.empiler (nbre); n := n + 1; FI; FI; j := j + 1; (* Mise … jour de la colonne de l'‚cran. *) OD; END saisir; (* ------------------------------------------------------------------------ *) UNIT afficher_resultat : PROCEDURE ; (* Cette proc‚dure permet d'afficher le r‚sultat du calcul effectu‚. Tant que la pile n'est pas vide, on d‚pile. On ‚vite d'afficher les premiers 0 (Ce qui trŠs important pour une soustraction). *) VAR b : BOOLEAN , i : INTEGER ; BEGIN b := FALSE; i := depiler; WHILE NOT pile_vide DO IF (i =/= 0) or (b) THEN b := TRUE; (* Une fois que le premier nombre est affich‚ et qu'il est diff‚rent de 0, on peut afficher autant de fois de 0. *) WRITE (i); FI; i := depiler; OD; WRITE (i); END afficher_resultat; END Entier_long; (* ------------------------------------------------------------------------ *) UNIT Inchar : IIUWgraph FUNCTION : INTEGER; (* Cette function permet de saisir une suite de caractŠres sans avoir … valider chaque fois. *) VAR i:integer; BEGIN DO i := INKEY; IF (i<>0) THEN EXIT; FI; OD; RESULT := i; END Inchar; (* ------------------------------------------------------------------------ *) UNIT entier : FUNCTION (c : CHAR) : INTEGER; (* Cette proc‚dure convertie un caractŠre en entier parce que la fonction inchar lit un entier qu'elle traduit en caractŠre. *) BEGIN CASE c WHEN '0' : RESULT := 0; WHEN '1' : RESULT := 1; WHEN '2' : RESULT := 2; WHEN '3' : RESULT := 3; WHEN '4' : RESULT := 4; WHEN '5' : RESULT := 5; WHEN '6' : RESULT := 6; WHEN '7' : RESULT := 7; WHEN '8' : RESULT := 8; WHEN '9' : RESULT := 9; ESAC; END entier; (* ------------------------------------------------------------------------ *) UNIT partition : FUNCTION (n : INTEGER):INTEGER; (* Cette fonction renvoit la valeur pour laquelle il faut partitionner les deux piles. La plus grande de leur deux valeurs (multilplier par 2 par la fonction grand) doit ˆtre un multiple de deux. (ce qui est seulement utile pour la multiplication).*) VAR n1 : INTEGER; BEGIN n1 := 2; WHILE n1 < n (* La partition de la multiplication se fait pour des valeurs qui correspondent … une suite g‚om‚trique de premier terme 2 et de raison 2. *) DO n1 := n1 * 2; OD; RESULT := n1; END partition; (* ------------------------------------------------------------------------ *) UNIT grand : FUNCTION (d1, d2, d3 : INTEGER) : INTEGER; (* Cette fonction renvoit le nbre d'‚lŠment qui a dans la plus grande pile. Le paramˆtre d3 accepte le max des deux piles. on rappelle que s'il vaut 2 alors il s'agit de la deuxiŠme pile qui a la grande valeur sinon la premiŠre et cette valeur est multiplier par 2 pour mieux partionner la pile. *) BEGIN IF (d3 = 2) THEN d2 := d2 * 2; RESULT := d2 ELSE d1 := d1 * 2; RESULT := d1; FI; END grand; (* ------------------------------------------------------------------------ *) UNIT position : PROCEDURE (lig, col : INTEGER); (* Cette proc‚dure permet de positionner sur l'‚cran qui devient une matrice. Les paramˆtres lig et col correspondent respectivement … l' abcisse x (ligne) et … l'abcisse y (colonne). *) VAR c, d, e, f : CHAR, i, j : INTEGER; BEGIN i := lig DIV 10; j := lig mod 10; c := chr (48+i); d := chr (48+j); i := col div 10; j := col mod 10; e := chr (48+i); f := chr (48+j); WRITE (chr (27), "[", c, d, ";", e, f, "H"); END position; (* ------------------------------------------------------------------------ *) UNIT tracer_ligne : PROCEDURE (lig1,col1,col : INTEGER); (* Cette proc‚dure permet de tracer les lignes du cadre. x, y repr‚- tentent les paramˆtres de POSITION c'est … dire position ligne, colon ne, et col est la limite de la ligne. *) VAR i : INTEGER; BEGIN CALL POSITION (col1,lig1); FOR i := 1 to col DO WRITE ('Ä'); OD; END tracer_ligne; (*------------------------------------------------------------------------- *) UNIT tracer_colonne : PROCEDURE (lig,lig1, col : INTEGER); (* Cette proc‚dure permet de tracer les colonnes du cadre. lig repr‚sente : lig2 - lig1, et col : la colonne courante ou l'or- donn‚e de POSITON. *) VAR i : INTEGER; BEGIN FOR i := 1 to lig DO CALL POSITION (lig1+i,col); WRITE ("³"); OD; END tracer_colonne; (* ------------------------------------------------------------------------ *) UNIT cadrer : PROCEDURE (lig1, lig2, col1,col2 : INTEGER); (* Cette proc‚dure dessine un cadre valable pour un ‚cran. D'abord dessins : des lignes, ensuite des colonnes enfin des coins. Les para- mˆtres sont respectivement ligne du haut et du bas et colonne de droi- te et de gauche. *) BEGIN CALL tracer_ligne (col1,lig1,col2-col1); CALL tracer_ligne (col1,lig2,col2-col1); CALL tracer_colonne (lig2-lig1,lig1,col1); CALL tracer_colonne (lig2-lig1,lig1,col2); CALL POSITION (lig1,col1); WRITE ("Ú"); CALL POSITION (lig2,col1); WRITE ("À"); CALL POSITION (lig1,col2); WRITE ("¿"); CALL POSITION (lig2,col2); WRITE ("Ù"); END cadrer; (* ------------------------------------------------------------------------ *) UNIT effacer_partie : PROCEDURE (lig, col, lig1, col1 : INTEGER); (* Cette proc‚dure permet d'effacer une partie de l'‚cran (o— on ‚crit un caractŠre blanc) les paramˆtres lig, col, lig1, col1 l'intervale de ligne, colonne et la position de la ligne1 et de la colonne1. *) VAR k,w : INTEGER; BEGIN FOR k := 1 to col DO FOR w := 1 to lig DO CALL POSITION (lig1+w,col1+k); WRITE (" "); OD; OD; END effacer_partie; (* ------------------------------------------------------------------------ *) UNIT prompt : PROCEDURE (i,j : INTEGER); (* Cette proc‚dure affiche le programme principal. *) VAR choix : CHAR ; BEGIN DO WRITELN; (* Cette commande permet de vider le buffer *) IF ecr (* Cette condition va permettre … cette fenˆtre de pas ser du plein ‚cran au petit menu du haut de l'‚cran. *) THEN CALL cadrer (8,16,2,80); ecr := FALSE ELSE i := 3 ; j := 6; CALL cadrer (2,4,2,80); FI; CALL position (i,j); WRITE ("1 : Aide - 2 : Calcul - 3 : Quitter -> Le choix : "); WRITELN; (* Cette commande permet de vider le buffer *) choix := chr(inchar); CALL position (3,77); WRITELN (choix); WRITE (chr(27), "[2J"); CASE choix WHEN '1' : CALL aide; WHEN '2' : CALL effacer_partie (3,80,1,1); CALL presentation; CALL cadrer (3,7,8,74); CALL fenetre_operation (4,14); WHEN '3' : EXIT; ESAC OD; END prompt; (* ------------------------------------------------------------------------ *) UNIT fenetre_operation : PROCEDURE (i,j : INTEGER); (* Cette proc‚dure affiche la liste des op‚rations possibles … r‚aliser et g‚re les signes des op‚rations saisies. Cf la documentation pour comprendre la gestion des signes. *) VAR choix : CHAR; BEGIN WRITELN; (* Cette commande permet de vider le buffer *) CALL position (i,j); WRITE ("1 : + ; 2 : - ; 3 : * ; 4 : ^2 ; 5 : DIV"); CALL position (i+2,j); WRITE ("6 : MOD ; 7 : PGCD ; 8 : PPCM -> Le choix : "); WRITELN; (* Cette commande permet de vider le buffer *) choix := chr(inchar); CALL position (i+2,j+54); WRITELN (choix); CALL effacer_partie (5,78,2,1); CALL position (i+4,50); (* Dans tous les cas signe1 et signe2 sont les valeurs des signes des piles 1 et 2. *) CASE choix WHEN '1' : WRITE ("La s‚lection est : "); WRITE ("+"); CALL cadrer (10,14,22,50); CALL fenetre_saisie (11,25); CALL cadrer (15,19,22,50); CALL fenetre_saisie (16,25); CALL p1.max_de_2_piles (n1,n2,p2,n3); CASE signe1 WHEN '-' : IF signe2 = '-' THEN p3 := p1.addition (p2); CALL position (19,15); WRITE ("-") ELSE IF (n3 = 1) (* cas o— la 1ø pile est > … la 2ø pile.*) THEN p3 := p1.soustraction (p2); CALL position (19,15); WRITE ("-") ELSE (* cas o— la 1ø pile est <= … la 2ø pile.*) p3 := p2.soustraction (p1); FI; FI; OTHERWISE IF signe2 =/= '-' THEN p3 := p1.addition (p2); ELSE IF (n3 = 1) (* cas o— la 1ø pile est > … la 2ø pile.*) THEN p3 := p1.soustraction (p2); ELSE (* cas o— la 1ø pile est <= … la 2ø pile.*) p3 := p2.soustraction (p1); IF (n3 =/= 0) THEN CALL position (19,15); WRITE ("-") FI; FI; FI; ESAC; WHEN '2': WRITE ("La s‚lection est : "); WRITE ("-"); CALL cadrer (10,14,22,50); CALL fenetre_saisie (11,25); CALL cadrer (15,19,22,50); CALL fenetre_saisie (16,25); CALL p1.max_de_2_piles (n1,n2,p2,n3); CASE signe1 WHEN '-' : IF signe2 =/= '-' THEN p3 := p1.addition (p2); CALL position (19,15); WRITE ("-") ELSE IF (n3 = 1) (* cas o— la 1ø pile est > … la 2ø pile. *) THEN p3 := p1.soustraction (p2); CALL position (19,15); WRITE ("-") ELSE (* cas o— la 1ø pile est <= … la 2ø pile. *) p3 := p2.soustraction (p1); FI; FI; OTHERWISE IF signe2 = '-' THEN p3 := p1.addition (p2); ELSE IF (n3 = 2) (* cas o— la 1ø pile est > … la 2ø pile.*) THEN p3 := p2.soustraction (p1); CALL position (19,15); WRITE ("-") ELSE (* cas o— la 1ø pile est <= … la 2ø pile. *) p3 := p1.soustraction (p2); FI; FI; ESAC; WHEN '3': WRITE ("La s‚lection est : "); WRITE ("*"); CALL cadrer (10,14,22,50); CALL fenetre_saisie (11,25); CALL cadrer (15,19,22,50); CALL fenetre_saisie (16,25); CALL p1.max_de_2_piles (n1,n2,p2,n3); CASE signe1 WHEN '-' : IF signe2 =/= '-' THEN CALL position (19,15); WRITE ("-"); FI; OTHERWISE IF signe2 = '-' THEN CALL position (19,15); WRITE ("-"); FI; ESAC ; p3 := p1.multiplication (p2,partition (grand(n1,n2,n3))); CALL effacer_partie (1,19,16,58); (* Permet d'effacer le message "Calcul en cours"*) WHEN '4': WRITE ("La s‚lection est : "); WRITE ("^2"); CALL effacer_partie (1,14,13,1); CALL cadrer (10,14,22,50); CALL fenetre_saisie (11,25); p3 := p1.carre (partition (n1)); WHEN '5': WRITE ("La s‚lection est : "); WRITE ("DIV"); CALL cadrer (10,14,22,50); CALL fenetre_saisie (11,25); CALL cadrer (15,19,22,50); CALL fenetre_saisie (16,25); IF p2.pile_vide (* Traitement de la division par z‚ro.*) THEN CALL position (17,45); WRITELN ("IMPOSSIBLE... Division par Z‚ro"); EXIT; FI; IF ( (signe2 = '-') AND (signe1 =/= '-') ) OR ( (signe2 =/= '-') AND (signe1 = '-') ) THEN CALL position (19,15); WRITE ("-"); FI; p3 := p1.division (p2); WHEN '6': WRITE ("La s‚lection est : "); WRITE ("MOD"); CALL cadrer (10,14,22,50); CALL fenetre_saisie (11,25); CALL cadrer (15,19,22,50); CALL fenetre_saisie (16,25); IF p2.pile_vide (* Traitement de la division par z‚ro.*) THEN CALL position (17,45); WRITELN ("IMPOSSIBLE... Division par Z‚ro"); EXIT; FI; IF ( (signe2 = '-') AND (signe1 =/= '-') ) OR ( (signe2 =/= '-') AND (signe1 = '-') ) THEN CALL position (19,15); WRITE ("-"); FI; p3 := p1.modulo (p2); WHEN '7': WRITE ("La s‚lection est : "); WRITE ("PGCD"); CALL cadrer (10,14,22,50); CALL fenetre_saisie (11,25); CALL cadrer (15,19,22,50); CALL fenetre_saisie (16,25); IF p2.pile_vide (* Traitement de la division par z‚ro.*) THEN CALL position (17,45); WRITELN ("IMPOSSIBLE... Division par Z‚ro"); EXIT; FI; IF ( (signe2 = '-') AND (signe1 =/= '-') ) OR ( (signe2 =/= '-') AND (signe1 = '-') ) THEN CALL position (19,15); WRITE ("-"); FI; p3 := p1.pgcd (p2) WHEN '8': WRITE ("La s‚lection est : "); WRITE ("PPCM"); CALL cadrer (10,14,22,50); CALL fenetre_saisie (11,25); CALL cadrer (15,19,22,50); CALL fenetre_saisie (16,25); IF p2.pile_vide (* Traitement de la division par z‚ro.*) THEN CALL position (17,45); WRITELN ("IMPOSSIBLE... Division par Z‚ro"); EXIT; FI; IF ( (signe2 = '-') AND (signe1 =/= '-') ) OR ( (signe2 =/= '-') AND (signe1 = '-') ) THEN CALL position (19,15); WRITE ("-"); FI; p3 := p1.ppcm (p2); OTHERWISE CALL effacer_partie (5,78,2,1); CALL cadrer (3,7,2,79); CALL fenetre_operation (i,j); ESAC; CALL position (19,17); CALL p3.afficher_resultat; END fenetre_operation; (* ------------------------------------------------------------------------ *) UNIT fenetre_saisie : PROCEDURE (i,j : INTEGER); (* Cette proc‚dure permet de r‚aliser le choix entre la saisie d'un entier court et long. Et permet d'effectuer la saisie du signe qui sera g‚rer dans la proc‚dure ci dessus. *) VAR choix : CHAR, nbre : INTEGER; BEGIN WRITELN; (* Cette commande permet de vider le buffer *) CALL position (i,j); WRITELN ("1 : Entier court"); CALL position (i+1,j); WRITELN ("2 : Entier long"); CALL position (i+2,j+2); WRITELN ("Entrer votre choix : "); WRITELN; (* Cette commande permet de vider le buffer *) choix := chr (inchar); CALL position (i+2,j+23); WRITELN (choix); WRITELN; (* Cette commande permet de vider le buffer *) (* La saisie d'un entier court n‚cessite une conversion et un empilement. Alors que la saisie d'un entier long se fait par empilement. *) CASE choix (* On gŠre le choix et le position de l'‚cran qui permet de savoir si on manipule p1 (pour i = 11) ou p2 (pour i = 22). *) WHEN '1' : IF i = 11 THEN CALL effacer_partie (5,29,9,21); WRITELN; (* Cette commande permet de vider le buffer *) CALL position (9,16); WRITE ("' '"); CALL position (9,17); WRITELN; (* Cette commande permet de vider le buffer *) signe1 := chr (inchar); CALL position (9,17); WRITE (signe1); CALL position (9,20); READ (nbre); p1 := p1.transferer_pile (p1.conversion (nbre,n1) ) ELSE CALL effacer_partie (5,29,14,21); WRITELN; (* Cette commande permet de vider le buffer *) CALL position (14,16); WRITE ("' '"); CALL position (14,17); WRITELN; (* Cette commande permet de vider le buffer *) signe2 := chr (inchar); CALL position (14,17); WRITE (signe2); CALL position (14,20); READ (nbre); p2 := p2.transferer_pile (p2.conversion (nbre,n2) ) FI; WHEN '2' : IF i = 11 THEN CALL effacer_partie (5,29,9,21); WRITELN; (* Cette commande permet de vider le buffer *) CALL position (9,16); WRITE ("' '"); CALL position (9,17); WRITELN; (* Cette commande permet de vider le buffer *) signe1 := chr (inchar); CALL position (9,17); WRITE (signe1); CALL position (9,20); WRITELN; (* Cette commande permet de vider le buffer *) p1 := p1.saisir (9,20,n1) ELSE CALL effacer_partie (5,29,14,21); WRITELN; (* Cette commande permet de vider le buffer *) CALL position (14,16); WRITE ("' '"); CALL position (14,17); WRITELN; (* Cette commande permet de vider le buffer *) signe2 := chr (inchar); CALL position (14,17); WRITE (signe2); CALL position (14,20); WRITELN; (* Cette commande permet de vider le buffer *) p2 := p2.saisir (14,20,n2); FI; OTHERWISE CALL fenetre_saisie (i,j); ESAC; END fenetre_saisie; (* ------------------------------------------------------------------------ *) UNIT presentation : PROCEDURE; (* Cette proc‚dure permet aprŠs le prompt d'afficher la maquette de saisie et de r‚sultat. *) BEGIN CALL position (10,3); WRITE ("Valeur nø1 : "); CALL position (15,3); WRITE ("Valeur nø2 : "); CALL position (20,3); WRITE ("R‚sultat : "); CALL position (25,76); WRITE ("D. V."); END presentation; (* ------------------------------------------------------------------------ *) UNIT aide : PROCEDURE; (* Cette proc‚dure permet d'afficher le texte de l'aide. *) BEGIN CALL position (5,3); WRITELN ("Le calcul consiste … :"); WRITELN (" - S‚lectionner l'op‚ration d‚sir‚e."); WRITELN (" - Choisir entre un entier court ou long."); WRITELN (" - Mettre le signe de l'op‚ration dans le ' '."); WRITELN (" - pour les valeur n‚gatives."); WRITELN (" + pour ou rien pour les valeurs positives."); WRITELN (" - Valider la saisie des valeurs "); WRITELN ; WRITELN (" Pour le carre, il n'a pas de deuxiŠme saisie."); WRITELN ; WRITELN (" Si le r‚sultat obtenu n'est pas visible … l'‚cran … cause d'un"); WRITELN ("trop grand nombre de chiffres, il faut quitter ce logiciel et"); WRITELN ("taper 'int projet > exemple' et reprendre l'application pr‚c‚dente."); WRITELN ; WRITELN (" Ceci est tap‚ n'est pas visible … l'‚cran. Pour visualiser la saisie"); WRITELN ("et le r‚sultat il faut taper 'type exemple | more' … partir du DOS."); WRITELN ; WRITELN ("Quitter : permet de revenir au SytŠme d'Exploitation"); END aide; VAR p1,p2,p3 : Entier_long, (* p1, p2 sont deux piles de saisie et p3 : une pile r‚sultat. *) n1, n2, n3 : INTEGER, (* n1, n2 correspondent au nombres de chiffres qui sont dans les piles n3 resort leur maximum ou leur ‚galit‚. *) b1, b2, ecr : BOOLEAN, (* Les deux premeirs repr‚sentent respectivement la l'obtention d'un r‚sultat n‚gatif pour la soustraction et le test comme quoi la valeur du reste est nulle pour le pgcd. ecr va permetre au sommaire de passer de la position de plein ‚cran … celle de petit ‚cran sur les trois premiŠres lignes.*) signe1, signe2 : CHAR; (* Ils repr‚sentent respectivement les valeurs des signe de la pile 1 et 2. *) BEGIN (* Intialisation des trois piles. *) p1 := new Entier_long; p2 := new Entier_long; p3 := new Entier_long; WRITE (chr(27), "[2J"); CALL position (4,19); WRITELN ("LA CALCULATRICE DES ENTIERS COURTS ET LONGS"); CALL position (19,76); WRITELN ("D. V."); ecr := TRUE; CALL prompt (12,6) ; END projet;