Turbo pascal

unit KX;

interface

implementation

uses dos;

////////////////////////////////////////////////////////////////////////////////
// Cette partie de l'unité modifie les caractères lisibles de la console
// Il y aura alors adéquation entre le clavier français et l'affichage à l'écran
////////////////////////////////////////////////////////////////////////////////

type Table=array[0..255] of char;
     Driver=procedure(var t:TextRec);

var RawInput,RawOutput:Driver;
    InTable,OutTable:Table;

procedure Assoc(i,c: integer);
begin
   InTable[c]:=chr(i);
   OutTable[i]:=chr(c);
end;

procedure InitTables;
var i:integer;
begin
   for i:=0 to 127 do
   begin
      InTable[i]:=chr(i);
      OutTable[i]:=chr(i);
   end;
   for i:=128 to 255 do
   begin
      InTable[i]:=chr(128);
      OutTable[i]:=chr(177);
   end;
   Assoc(160,255); //  
   Assoc(161,173); // ¡
   Assoc(162,189); // ¢
   Assoc(163,156); // £
   Assoc(164,207); // ¤
   Assoc(165,190); // ¥
   Assoc(166,221); // ¦
   Assoc(167,245); // §
   Assoc(168,249); // ¨
   Assoc(169,184); // ©
   Assoc(170,166); // ª
   Assoc(171,174); // «
   Assoc(172,170); // ¬
   Assoc(173,240); // ­
   Assoc(174,169); // ®
   Assoc(175,238); // ¯
   Assoc(176,248); // °
   Assoc(177,241); // ±
   Assoc(178,253); // ²
   Assoc(179,252); // ³
   Assoc(180,239); // ´
   Assoc(181,230); // µ
   Assoc(182,244); // ¶
   Assoc(183,250); // ·
   Assoc(184,247); // ¸
   Assoc(185,251); // ¹
   Assoc(186,167); // º
   Assoc(187,175); // »
   Assoc(188,172); // ¼
   Assoc(189,171); // ½
   Assoc(190,243); // ¾
   Assoc(191,168); // ¿
   Assoc(192,183); // À
   Assoc(193,181); // Á
   Assoc(194,182); // Â
   Assoc(195,199); // Ã
   Assoc(196,142); // Ä
   Assoc(197,143); // Å
   Assoc(198,146); // Æ
   Assoc(199,128); // Ç
   Assoc(200,212); // È
   Assoc(201,144); // É
   Assoc(202,210); // Ê
   Assoc(203,211); // Ë
   Assoc(204,222); // Ì
   Assoc(205,214); // Í
   Assoc(206,215); // Î
   Assoc(207,216); // Ï
   Assoc(208,209); // Ð
   Assoc(209,165); // Ñ
   Assoc(210,227); // Ò
   Assoc(211,224); // Ó
   Assoc(212,226); // Ô
   Assoc(213,229); // Õ
   Assoc(214,153); // Ö
   Assoc(215,158); // ×
   Assoc(216,157); // Ø
   Assoc(217,235); // Ù
   Assoc(218,233); // Ú
   Assoc(219,234); // Û
   Assoc(220,154); // Ü
   Assoc(221,237); // Ý
   Assoc(222,232); // Þ
   Assoc(223,225); // ß
   Assoc(224,133); // à
   Assoc(225,160); // á
   Assoc(226,131); // â
   Assoc(227,198); // ã
   Assoc(228,132); // ä
   Assoc(229,134); // å
   Assoc(230,145); // æ
   Assoc(231,135); // ç
   Assoc(232,138); // è
   Assoc(233,130); // é
   Assoc(234,136); // ê
   Assoc(235,137); // ë
   Assoc(236,141); // ì
   Assoc(237,161); // í
   Assoc(238,140); // î
   Assoc(239,139); // ï
   Assoc(240,208); // ð
   Assoc(241,164); // ñ
   Assoc(242,149); // ò
   Assoc(243,162); // ó
   Assoc(244,147); // ô
   Assoc(245,228); // õ
   Assoc(246,148); // ö
   Assoc(247,246); // ÷
   Assoc(248,155); // ø
   Assoc(249,151); // ù
   Assoc(250,163); // ú
   Assoc(251,150); // û
   Assoc(252,129); // ü
   Assoc(253,236); // ý
   Assoc(254,231); // þ
   Assoc(255,152); // ÿ
end;

procedure CookedOutput(var f:textrec);
var i:integer;
begin
   for i:=0 to f.bufpos-1 do
      f.buffer[i]:=OutTable[ord(f.buffer[i])];
   RawOutput(f);
end;

procedure CookedInput(var f:textrec); [IOCheck];
var i: integer;
begin
   RawInput(f);
   for i:=0 to f.bufend-1 do
      f.buffer[i]:=InTable[ord(f.buffer[i])];
end;

procedure RedirectIO(var InText,OutText:text);
begin
   RawInput:=Driver(TextRec(InText).InOutFunc);
   TextRec(InText).InOutFunc:=@CookedInput;
   RawOutput:=Driver(TextRec(OutText).InOutFunc);
   TextRec(OutText).InOutFunc:=@CookedOutput;
   TextRec(OutText).FlushFunc:=@CookedOutput;
end;

procedure Install_Screen;
begin
   InitTables;
   RedirectIO(input,output)
end;

////////////////////////////////////////////////////////////////////////////////
// Cette partie de l'unité affiche (à la fin) le temps d'exécution du programme
// En cas d'erreur lors de l'exécution, le numéro d'erreur est également affiché
////////////////////////////////////////////////////////////////////////////////

type ProcType=procedure;

var OldProc:ProcType;
    r1:real;

function RealOfGetTime:real;
var h,m,s,c:word;
begin
   GetTime(h,m,s,c);
   result:=h*3600+m*60+s+real(c)/100;
end;

procedure ToDoAtExit;
var r,r2:real;
begin
   Exitproc:=OldProc;
   r2:=RealOfGetTime;
   r:=r2-r1;
   if r<0 then r:=r+24*3600;
   writeln;
   if ErrorAddr=nil then write('Fin du programme')
                    else write('Erreur ',ExitCode);
   write('. Temps d''exécution : ',r:0:2,' secondes');
   readln;
end;

procedure Install_Time;
begin
   OldProc:=ProcType(ExitProc);
   ExitProc:=@ToDoAtExit;
end;

begin
   r1:=RealOfGetTime;
   Install_Screen;
   Install_Time;
end.

program Accents; uses KX;

begin
writeln('àâä éèêë ìîï òôö ùûü ÿ');
end.