Bac2012 (Nombre Circulaire)

Program PremCirc;
Uses Wincrt;
Type
  tab = Array [1..5] Of Integer;
Var
  f: Text;
  p,q: Integer;

Procedure creation (Var f:Text);
Begin
  Assign (f,'C:\bac\Circul.txt');
End;
Procedure saisie (Var p,q:Integer);
Begin
  Repeat
    Writeln ('Saisir p : ');
    Readln (p);
    Writeln('Saisir q: ');
    Readln (q);
  Until (10<p) And (p<q) And (q<20000);
End;
Function circu (x:Integer): Integer;
Var
  i,j,e: Integer;
  ch: String;
  t: Array [1..6] Of Char;
Begin
  Str(x,ch);
  j := 0;
  For i:=2 To Length(ch)+1 Do
    Begin
      j := j+1;
      t[i] := ch[j];
    End;
  t[1] := t[Length(ch)+1];
  For i:=1 To Length(ch) Do
    ch[i] := t[i];
  Val (ch,x,e);
  circu := x;
End;
Procedure circutab (Var t:tab;x:Integer);
Var
  i: Integer;
  ch: String;
Begin
  t[1] := x;
  Str (x,ch);
  For i:=2 To Length(ch) Do
    t[i] := circu(t[i-1]);
End;
Function premier (x:Integer): Boolean;
Var
  i,r: Integer;
Begin
  r := 0;
  For i:=1 To x Do
    If x Mod i = 0 Then r := r+1;
  If r=2 Then premier := True
  Else premier := False
End;
Function primtab (t:tab): Boolean;
Var
  test: Boolean;
  i: Integer;
  ch: String;
Begin
  test := True;
  i := 1;
  Str (t[i],ch);
  While (test) And (i<=Length(ch)) Do
    Begin
      test := premier(t[i]);
      i := i+1;
    End;
  primtab := test;
End;
Procedure traitement (Var f:Text;p,q:Integer);
Var
  i: Integer;
  t: tab;
Begin
  Rewrite (f);
  For i:=p To q Do
    Begin
      circutab(t,i);
      If primtab(t) Then
        Writeln (f,i);
    End;
  Close(f);
End;

Procedure affiche (Var f:Text);
Var
  ch: String;
Begin
    reset (f);
    While Not (Eof(f)) Do
    Begin
      Readln (f,ch);
      Writeln (ch);
    End;
        close (f);
End;
Begin
  creation (f);
  saisie (p,q);
  traitement (f,p,q);
  affiche (f);
End.