[SERVEUR TELETEL] Rien que pour le fun

[irios]

Pour avoir plusieurs com sur un seul numéro la solution pro est d'avoir un trunk sip, en gros plusieurs T0, connecté sur un autocommutateur (pabx/ipbx). Mais là ce n'est pas la solution.
L'autre solution qui pourrait être envisageable, sous réserve que les providers l'autorisent, c'est d'utiliser le protocole X25.

[__sam__]

Ok. Je présume que 8x10 est découpé quatres macro-pixels de 4x3 et deux de 4x4.

Et l'ensemble de l'écran a quel ratio: 4:3 ou 16:10 ?

[Papy.G]

Pour le X25, c'est mort, il faudrait (re)mettre en service des points d'accès, et pas derrière des box, mais chez les providers direct, ça n'a, de plus, aucun intérêt, en faisant une passerelle vers ip, on pourrait faire un serveur plus facilement.

Non, on est en 2x2 dans 8x10, je regarde ce soir pour le ratio.

[jvernet]

Pour avoir plusieurs connexions simultanées, il faut plusieurs lignes RTC... Et donc plusieurs modems.
Pour avoir un seul TO8 qui serve toutes ces lignes, avec un seul port série, il vous faut un MUX. Ce mux possède plusieurs ports série d'entrée sur lequel brancher les modems, et un port de sortie pour aller au TO8.
Et sur le TO8, un logiciel qui gère plusieurs clients... Ça c'est la partie la plus compliquée !

Pour gérer plusieurs lignes, il faut un PABX avec des cartes T0 ou T2, et des cartes analogiques RTC à brancher sur les modems. Le PABX repartira les appels sur les modems libres.

Il existait des cartes pour PC qui faisaient tout ça d'un coup (plusieurs entrée T0 ou RTC, multiplexage, etc) associée à un logiciel serveur adéquat.

[6502man]

@sam: le serveur sur TO8 ne reconnais pas les DRCS, il reconnais que le semi-graphique 2X3 (LargeurxHauteur).
Si tu nous fait quelques images je les rajouterais en tant que service "SLIDESHOW"

Plusieurs connexions simultanées pour faire du Minitel, Orange doit bien rigoler dans son coin

Alors y a t'il des candidats pour cette expérience ?

[__sam__]

Ok. Le DRCS avait l'air bien sur papier:

Dommage que ca ne marche pas partout.

Sinon, j'ai trouvé cette image

Où l'on se rend compte qu'effectivement les caractère font 8x10 (largeur x hauteur), ce qui basé sur un écran 40x25, mais dont la première ligne de statut semble être inutilisable fait une surface exploitable de 40x8=320 par 24x10=240. Or 320:240 nous donne exactement 4:3. Il semblerait donc que sur thomson avec son affichage 16:10, les pages soient aplaties.

On voit en outre que les macros pixels sont batis comme suit

Code : Tout sélectionner

####     
#### 4x3
####
    ####
4x4 ####
    ####
    ####
####
#### 4x3
####

Par ailleurs sur: http://www.troude.com/Pinky/ je vois de très beaux dégradés de gris:

Est-ce que ca pourrait être la transcription couleur->intensité qui donne ca ?

Ca rend super bien, et du coup certains ont fait des images stupéfiantes:



Même la Samantha du début y est passée

Franchement un slidehow N&B le ferait vraiment bien (à voir plus plus tard, surtout que Carl avait fait quelques expérimentations dans ce mode: http://forum.system-cfg.com/viewtopic.php?f=25&t=3966)

[6502man]

Concernant les couleurs et niveaux de gris, on à 8 couleurs de base disponibles (EF-9345) mais le Minitel à la base à un écran monochrome donc les couleurs sont converti par le tube du minitel en dégradés de gris, on à aucun contrôle au niveaux de la page videotext pour choisir une quelconque palette couleur ou de gris.

En faite tu fait ton slideshow en couleurs et selon le matériel côté client tu auras des couleurs ou un dégradé de gris

Pour bénéficier des 2 modes j'ai une solution : sous Windows: TIMTEL 56K tu choisi l'affichage Couleur ou N&B
Seule contrainte il faut un modem analogique TAPI
mais je fourni une version compatible de TIMTEL 56K (pas celle dispo sur le net qui ne fonctionne pas sur toutes les configs).

[Papy.G]

Jvernet> Il me semble avoir vu un PABX sur LBC.

6502man> Ben, oui, je suis candidat, mais peut-être pas ce soir.

Sam> T'enflamme pas, tu peux pas refaire tout l'écran en DRCS, t'as un nombre limité de caractères, mais tu peux mixer Mosaïque pleine, Mosaïque pointillée, DRCS, texte tout à la fois. Le DRCS est beaucoup trop lent, il semblerait. ceci dit, les caractères DRCS ont eux aussi droit à la couleur, mais deux couleurs parmi 8 sur une dalle de 8x10.

On peut écrire, je crois, les seize premiers caractères de la ligne de statut, mais je ne me souviens plus des contraintes ni de comment faire.

Pour le dégradé de gris, relis ma réponse où je donnais le lien vers mille vaches, il y a des correspondances pour chaque couleur avec un dégradé de gris, c'est normalisé, mais pas vraiment linéaire, du moins sur Minitel.

Tu n'as pas relevé que l'on peut aussi faire de la double hauteur et/ou double largeur.

6502man> Si, on peut demander au minitel de quel modèle il est, c'est pour optimiser la transmission en fonction de la compatibilité, mais on peut en déduire si l'écran est couleur ou non, sauf pour les malins sortant le signal couleur d'un Minitel à écran interne monochrome.

[6502man]

Le premier test devrais commencer demain soir après 20H.

Les candidats peuvent m'envoyer la demande du numéro à 6502man.minitel@gmail.com

[__sam__]

Sam> (...)Pour le dégradé de gris, relis ma réponse où je donnais le lien vers mille vaches, il y a des correspondances pour chaque couleur avec un dégradé de gris, c'est normalisé, mais pas vraiment linéaire, du moins sur Minitel.

?!? j'ai rien trouvé là bas. Je suis miro ???

Mais bon, si c'est basé sur le rendu gris d'images couleurs (0.2989 * R + 0.5870 * G + 0.1140 * B), l'ordre doit être le même que sur ZX spectrum: Couleur(intensité) = bleu(0.1140), rouge(0.2989), violet(0.4129), vert(0.5870), cyan(0.7010), jaune(0.8859), blanc(0.9999)

Mais bon on verra le gris plus tard. Ce soir j'ai adapté le script aux images 320x240 avec des dalles 8x10. Demain je fais la conversion en code teletels optimisés.

[6502man]

Salut les gas un contre temps m'a fait rentré beaucoup plus tard, mais je viens quand même de brancher le serveur au cas ou certains veulent faire le test.

Demain soir je mettrais aussi le serveur en fonctionnement entre 20H et 23H.

[Papy.G]

Bon, alors, j'ai mesuré, en 40 colonnes, hors ligne d'état, on est à 165x112, on est proche d'un 3/2, idéal pour les photos!

J'ai ressorti mon minitel pour essayer le serveur de Phil, du coup, je me suis plongé dans ce qui est écrit dans le lien que je t'ai filé, et je crois effectivement que tu es miro:

Essai dégradés sur M1b Telic/Alcatel

MiroSam.jpg (61.55 Kio) Consulté 4139 fois

Ceci dit, c'est comme t'as dit, à peu de choses près, si l'on veut chipoter.

Trop balaise le serveur, mais j'ai des mauvais contacts dans ma prise, c'est une horreur dès que je touche le câble.
Bon, bah, ça a l'air de marcher, mais il était temps, j'allais me coucher!
C'est pas très réactif, par moments, tu stockes les pages sur disquette?

[6502man]

Oui comme je suis rentré très tard je n'ai pas eu le temps de stocker les pages en RAM DISK donc les accès sont sur disquettes, mais la différence ne doit pas être énorme, demain soir si tu veux on refait le test et je mettrais les pages en RAM DISk, par contre il faut que je me trouve un commande pour copier d'un coup tous les fichiers d'une face en RAM DISK !!!

[Papy.G]

Pas de soucis, t'inquiètes pas, c'est ce qui fait le charme du Minitel.
Par contre, j'ai l'impression que le logiciel serveur n'optimise pas les envois, comme dans le logo d'accueil, il ne semble pas se servir du caractère de répétition, je me trompe?
En RamDisk, ce sera bien mieux, car vraiment, quand on tape une touche, la réponse est longue à venir, ensuite, pour le débit, je pense que ça ne doit pas poser de problème même sur disquette.
Tu n'as pas fait d'essai en local?

C'est curieux, en double hauteur, la ligne du bas n'est pas doublée, mais une ligne vide est rajoutée en haut (voir le g de Rouge dans ma capture d'écran, post précédent.

J'ai libéré le serveur, tu peux débrancher, à moins que tu n'aies un autre client.

[__sam__]

Miro, c'est entendu.

Joan-Miro.png (1.82 Kio) Consulté 4131 fois

mais je n'ai pas trouvé les correspondance couleur<->intensité. C'est sur quelle page précise de http://millevaches.hydraule.org/info/minitel/specs/ que tu as trouvé cela ?

Cependant j'ai pu mettre à a jour mon script pour produire des fichiers texte(extension ".tel") contenant les codes pour afficher l'image:

Code : Tout sélectionner

#/bin/perl
#
# Conversion d'image true-color vers teletel
#
# (c) Samuel Devulder, Fevrier,Mars,Avril 2015
#

#use Graphics::Magick;
use Image::Magick;

$GRAY   = $ENV{'GRAY'}; # ou 0 pour la couleur
$DITHER = ("none", "2x2", "2x3", "3x3", "4x4", "stucki")[defined($ENV{'DITHER'})?$ENV{'DITHER'}:4];
$RESIZE = ("solid","liquid")[1];
$SATURA = ("auto", "100", "200", "250")[1];

@glb_files = @ARGV;
if(!@glb_files) {
   print "No file found, reading from STDIN...";
   while(<STDIN>) {
      chomp;
      y%\\%/%;
      s%^([\S]):%/cygdrive/$1%;
      push(@glb_files, $_);
   }
   print "done\n";
}


# creation dossier de sortie
$dir = $GRAY ? "gray-$DITHER" : "rgb-$DITHER";
mkdir($dir) || die "$dir: $!" unless -d "$dir";
for my $i (0..$#glb_files) {
   my $file = $glb_files[$i];

   # filtrage des fichiers qu'on ne veut pas
   next if $file =~ /rgb/;
   next if $file =~ /\.gif$/i && (-s $file)>1024*1024;
   my $out = $file;
   next if $out =~ /\.(txt|htm.*|ps|pdf)$/i;
   next unless $out =~ /\.(gif|jpg|jpeg|bmp|pnm|png)$/i;
   
   # suspression chemin repertoire
   $out =~ s/.*[\\\/]//;
   
   # affichage
   print 1+$i,"/",1+$#glb_files," ",$file,"\033]0;$out\007\n";
   
   # determination du nom des fichiers de sortie
   $out =~ s/[\.][^\.]*//;
   $tel = "$dir/$out.tel";
   $out = "$dir/$out.png";
   
   # on passe au suivant si l'image est déjà présente
   next if -f $out;
   
   # conversion
   my ($conv, $txt) = &convert($file);
   next unless $conv; # pas dde sauvegare si echec
   
   # sauvegarde
   open(OUT, ">$tel"); print OUT $txt; close(OUT);
   my($o) = $out; $o =~ s/\.png$/_col.png/;
   $conv->Write($o) if $GRAY;
   $conv->Set(type=>"grayscale") if $GRAY;
   $conv->Set(colorspace=>"sRGB") if $GRAY;
   $conv->Write($out);
   
   # ne pas faire trop mouliner le CPU
   sleep(2);
}

sub convert {
   my($file) = @_;

   # read image
   my $img = Image::Magick->new();
   my $x=$img->ReadImage($file); 
   if($x) {print STDERR $x; return undef;}

   my($W,$H,$BW,$BH,$b1,$b2) = (40,24,8,10,3,4);

   $img->Trim();
   $img->Set(depth=>16);

   if($RESIZE eq "liquid") {
      my $cache = $file; $cache =~ s/.*\///; $cache = ".cache/$cache";
      mkdir(".cache") || die ".cache: $!" unless -d ".cache";
      if(-e $cache) {
         $img = Image::Magick->new();
         $img->ReadImage($cache);
      } else {
         $img = &liqrz($img, $W*$BW, $H*$BH);   
         $img->WriteImage($cache);
      }
   } else {
      my $geo = ($W*$BW)."x".($H*$BH)."!";
      $img->Resize(geometry=>$geo);
   }
   
   $img->Set(depth=>16);
   $img->AutoLevel();
   $img->Normalize();
   $img->Set(colorspace=>"RGB");
   #$img->Gamma(gamma=>1.3);
   $img->Gamma(gamma=>1.1);
   $img = &auto_saturate($img)         if     $SATURA eq "auto";
   $img->Modulate(saturation=>$SATURA) unless $SATURA eq "auto";
   $img->Blur(sigma=>($GRAY?0.2:1));
   $img->Set(type=>"grayscale") if $GRAY;

   #sleep(15);

   # creation image 80x75
   my @orig = $img->GetPixels(map=>"RGB", height=>$H*$BH, width=>$W*$BW, normalize=>"True");
   my @px;
   for(my $y=0; $y<$H*$BH;) {
      my $h = ($y%$BH)==$b1?$b2:$b1;
      
      for(my $x=0; $x<960; $x+=12) {
         my($r,$g,$b) = (0,0,0);
         for (my $i=$x; $i<$x+12; $i+=3) {
            for my $j ($y..$y+$h-1) {
               $r += $orig[$j*960+$i+0];
               $g += $orig[$j*960+$i+1];
               $b += $orig[$j*960+$i+2];
            }
         }
         push(@px, $r/(4*$h), $g/(4*$h), $b/(4*$h));
      }
      
      $y+=$h;
   }
   
   # matrice de dither
   my @dither = ([1]); # "none"
   @dither = ([1,3], [4,2]) if $DITHER eq "2x2";
   @dither = ([7,9,5], [2,1,4], [6,3,8]) if $DITHER eq "3x3";
   @dither = ( [ 1,   9,   3,  11],
          [13,   5,  15,   7],
          [ 4,  12,   2,  10],
                    [16,   8,  14,   6]) if $DITHER eq "4x4";
   @dither = ( [1,5],
               [3,4],
          [6,2] ) if $DITHER eq "2x3";
   my($dw, $dh, $dm) = (1+$#{$dither[0]}, 1+$#dither, 0);
   for my $d (@dither) {for my $dd (@$d) {$dm = $dd if $dd>$dm;}}
   for my $d (@dither) {for my $dd (@$d) {$dd /= (1+$dm);;}}

   # ajout du dither
   if($DITHER eq "stucki") {
      @px = &stucki($W,$H,@px);
   } else {
      for my $y (0..3*$H-1) {
         for my $x (0..2*$W-1) {
            my $d = $dither[$y % $dh][$x % $dw]-0.5;         
            my $p = ($x+$y*2*$W)*3;
            
            $d *= 0.12 if $GRAY;
            
            $px[$p+0] += $d;
            $px[$p+1] += $d;
            $px[$p+2] += $d;
         }
      }
   }

   # conversion
   my @conv = (0)x(3*2*$H*$W);
   for my $y (0..$H-1) {
      for my $x (0..$W-1) {
         my(@bloc);
         for my $j ($y*3..$y*3+2) {for my $i ($x*2..$x*2+1) {
            my $p = ($i + $j*2*$W)*3;
            push(@bloc, @px[$p..$p+2]);
         }}
         my($c1, $c2) = &find(\@bloc);
         for my $j ($y*3..$y*3+2) {for my $i ($x*2..$x*2+1) {
            my $p = ($i + $j*2*$W);
            my($d, $c) = &match($c1, $c2, \@px, $p*3);
            $conv[$p] = $c;
         }}
      }
   }

   # generation fichier texte
   my $tel = &gen_tel($W,$H,@conv);
   $tel = chr(0x1E).chr(20).chr(14).$tel.chr(15).chr(0x1E); # passage en mode semi gfx etc
   
   # generation image sortie
   my @out;
   for my $y (0..3*$H-1) {
      my @l;
      for my $x (0..2*$W-1) {
         my $p = $conv[$x + $y*2*$W];
         push(@l, (($p & 1)?255:0, ($p & 2)?255:0, ($p & 4)?255:0) x 4);
      }
      
      push(@out, (@l) x ($y%3==1?$b2:$b1));
   }
   $img = &px2img($W*$BW,$H*$BH,@out);
   
   return ($img, $tel);
}

# dithering de stucki
sub stucki {
   my($W,$H,@px) = @_;
   
   my $best_match = sub {
      my($v) = @_;
      return $v>0.5 ? 1 : 0 unless $GRAY;
      my $t = 0;
      if($v>=0.5870) {$t += 2; $v -= 0.5870;}
      if($v>=0.2989) {$t += 1; $v -= 0.2989;}
      if($v>=0.1141) {$t += 4; $v -= 0.1141;}
      return ($t&1?0.2989:0)+($t&2?0.5870:0)+($t&4?0.1141:0);
   };
   my ($p,$att,$half, $w)=(0, 0.190476, 0.5, 6*$W);
   for my $y (0..3*$H-1) {
      my $y_lt_H  = $y<3*$H-1;
      my $y_lt_H1 = $y<3*$H-2;
      for my $x (0..2*$W-1) {
         my(@t) = ($best_match->($px[$p+0]), $best_match->($px[$p+1]), $best_match->($px[$p+2]));
         my @e = splice(@px, $p, 3, @t);
         $e[0] = ($e[0]-shift(@t))*$att;
         $e[1] = ($e[1]-shift(@t))*$att;
         $e[2] = ($e[2]-shift(@t))*$att;
         
         my $x_lt_W  = $x<2*$W-1;
         my $x_gt_0  = $x>0;
         my $x_lt_W1 = $x<2*$W-2;
         my $x_gt_1  = $x>1;
         
         my ($t, @o) = $p;
         push(@o, $t+3)  if $x_lt_W;
         push(@o, $t+$w) if $y_lt_H;
         push(@o, -1);
         push(@o, $t+6)  if $x_lt_W1;
         if($y_lt_H) {
            $t += 2*$w;
            push(@o, $t+3)  if $x_lt_W;
            push(@o, $t-3)  if $x_gt_0;
            push(@o, $t+$w) if $y_lt_H1;
            push(@o, -1);
            push(@o, $t+6)  if $x_lt_W1;
            push(@o, $t-6)  if $x_gt_1 ;
            if($y_lt_H1) {
               $t += $w;
               push(@o, $t+3)  if $x_lt_W ;
               push(@o, $t-3)  if $x_gt_0 ;
               push(@o, -1);
               push(@o, $t+6)  if $x_lt_W1;
               push(@o, $t-6)  if $x_gt_1 ;
            }
         }
         for my $o (@o) {
            if($o<0) {$e[0]*=$half;$e[1]*=$half;$e[2]*=$half;}
            else {
               if(($t=($px[  $o] += $e[0]))<=.0) {$px[$o]=0;} elsif($t>1.0) {$px[$o]=1;}
               if(($t=($px[++$o] += $e[1]))<=.0) {$px[$o]=0;} elsif($t>1.0) {$px[$o]=1;}
               if(($t=($px[++$o] += $e[2]))<=.0) {$px[$o]=0;} elsif($t>1.0) {$px[$o]=1;}
            }
         }
         $p+=3;
      }
   }
   return @px;
}

# conversion en code semi-graphique teletel
sub gen_tel {
   my($W,$H, @conv) = @_;
   my($tel,@out)=("",-1);
   
   for my $p (0..$W*$H-1) {
      my $x = ($p % $W)*2;
      my $y = int($p / $W)*3;
      my ($c0,$c1,$c2) = (0,-1,-1); 
      for my $j ($y..$y+2) {
         for my $i ($x..$x+1) {
            my $c = $conv[$j*$W*2 + $i];
            $c1 = $c if $c1<0;
            $c2 = $c if $c2<0 && $c!=$c1;
            $c0>>=1;
            $c0 |= $c==$c1 ? 32 : 0;
         }
      }
      my $d = ($out[$#out]>>8)&255;
      $c2 = $d if $c2<0;
      if($c1!=$d && $c2==$d) {
         my $t = $c2;
         $c2 = $c1; 
         $c1 = $t;
         $c0 ^= 63;
      }
      
      $c0 = (($c0<<1)&0x40) | ($c0&0x1F) | 0x20;
      push(@out, ($c2<<16)|($c1<<8)|$c0);
   }
   for(my $i=1; $i<=$#out;) {
      my($c1,$c2, $d1,$d2);
      # couleur forme
      $c1 = ($out[$i-1]>>8)&255;
      $c2 = ($out[$i-0]>>8)&255;
      $tel .= chr(27).chr(0x40+$c2) if $c2<8 && $c1!=$c2;
      # couleur fond
      $d1 = ($out[$i-1]>>16)&255;
      $d2 = ($out[$i-0]>>16)&255;
      $tel .= chr(27).chr(0x50+$d2) if $d2<8 && $d1!=$d2;
      # compte nb char & couleurs identiques
      my $l = 1;
      while($l<64 && $i+$l<=$#out && $out[$i]==$out[$i+$l]) {++$l;}
      
      #0..$l-1 == identiques
      if(($out[$i]&255)!=($out[$i-1]&255)) {
         $tel .= chr($out[$i]&255);
         if($l>=4) {
            $tel .= chr(18).chr($l+64-1);
            $i += $l;
         } else {
            $i += 1;
         }
      } elsif($l>=3 && $l<=63) {
         $tel .= chr(18).chr($l+64);
         $i += $l;
      } else {
         $tel .= chr($out[$i]&255);
         $i += 1;
      }
   }
   return $tel;
}   

sub find {
   my($px) = @_;
   
   my($bd,@c) = (1e38,0,0);
   for my $c1 (0..6) {for my $c2 ($c1+1..7) {
      my $d = &dist($c1, $c2, $px);
      if($d<$bd) {$bd = $d; @c = ($c1, $c2);}
   }}
   
   #print join(',', @c), "\n";
   
   return @c;
}

sub dist {
   my($c1, $c2, $px) = @_;
   
   my $d = 0;
   for(my $i=0; $i<6*3; $i+=3) {
      my ($t, $ignore) = &match($c1, $c2, $px, $i);
      $d += $t;
   }
   return $d;
}

sub match {
   my($c1, $c2, $px, $o) = @_;
   
   
   my($e) = $GRAY?1:2;
   my($a,$b,$c) = (0.2989, 0.5870, 0.1141);
   my $d1=abs(($a*($px->[$o+0]-($c1&1?1:0)))**$e + ($b*($px->[$o+1]-($c1&2?1:0)))**$e + ($c*($px->[$o+2]-($c1&4?1:0)))**$e);
   my $d2=abs(($a*($px->[$o+0]-($c2&1?1:0)))**$e + ($b*($px->[$o+1]-($c2&2?1:0)))**$e + ($c*($px->[$o+2]-($c2&4?1:0)))**$e);
   
   #my $d1 = &rgb_dist($px->[$o],$px->[$o+1],$px->[$o+2], $c1&1?1:0,$c1&2?1:0,$c1&4?1:0);
   #my $d2 = &rgb_dist($px->[$o],$px->[$o+1],$px->[$o+2], $c2&1?1:0,$c2&2?1:0,$c2&4?1:0);
   
   #print $px->[$o]," 1:$d1=$c1 2:$d2=$c2\n";
   
   return $d1<$d2 ? ($d1, $c1) : ($d2, $c2);
}

sub rgb_dist {
   my($r1,$g1,$b1, $r2,$g2,$b2) = @_;
   
   $r1 -= $r2; $g1 -= $g2; $b1 -= $b2;
   #return $r1*$r1 + $g1*$g1 + $b1*$b1;
   
   my($l) = abs($r1)*.299 + abs($g1)*.587 + abs($b1)*.114;
   
   return ($r1*$r1*.299 + $g1*$g1*.587 + $b1*$b1*.114)*.75 + $l*$l;
}

sub liqrz {
   my($img, $t_width, $t_height) = @_;
   
   my $width  = $img->Get('width');
   my $height = $img->Get('height');

   my $rotate = 0;
   if(int($t_width * $height / $width+.5)>$t_height) {
      $rotate = 1;
      ($width, $height)     = ($height, $width);
      ($t_width, $t_height) = ($t_height, $t_width);
      $img->Rotate(degrees=>90);
   }
   
   $img->AdaptiveResize(geometry=>int($t_height * $width / $height+.5)."x".($t_height), filter=>"lanczos", blur=>1.5);

   #$img->Write('rgb/zzzzzzzzzz.png');

   $width  = $img->Get('width');
   $height = $img->Get('height');
   
   local(@img, @gry, @nrj);
   for my $y (0..$height-1) {
      push(@img, [$img->GetPixels(map=>"RGB", height=>1, width=>$width, x=>0, y=>$y, normalize=>"True")]);
      push(@gry, [$img->GetPixels(map=>"I", height=>1, width=>$width, x=>0, y=>$y, normalize=>"True")]);
      push(@nrj, [(0) x $width]);
   }
   
   # fonction energie
   my $sobel = sub {
      my($x, $y) = @_;
      
      my $py = $y-1;
      my $ny = $y+1;
      my $cy = $y;
      $py = 0         if $py<0;
      $ny = $height-1 if $ny >= $height;
      
      my $px = $x-1;
      my $nx = $x+1;
      my $cx = $x;
      $px = 0        if $px<0;
      $nx = $width-1 if $nx>=$width;
         
      my $ipp = $gry[$py]->[$px];
      my $icp = $gry[$py]->[$cx];
      my $inp = $gry[$py]->[$nx];
      
      my $ipc = $gry[$cy]->[$px];
      my $inc = $gry[$cy]->[$nx];
         
      my $ipn = $gry[$ny]->[$px];
      my $icn = $gry[$ny]->[$cx];
      my $inn = $gry[$ny]->[$nx];
      
      my ($c1, $c2, $c3, $c4) = (2,1, 2,1);
      my $gx = ($inc-$ipc)*$c1+(($inp-$ipp)+($inn-$ipn))*$c2;
      my $gy = ($icn-$icp)*$c3+(($ipn-$ipp)+($inn-$inp))*$c4;
         
      return sqrt($gx*$gx + $gy*$gy);
   };
   my $gradient = sub {
      my($x, $y) = @_;
      
      my $py = $y-1;
      my $ny = $y+1;
      $py = 0         if $py<0;
      $ny = $height-1 if $ny >= $height;
      
      my $px = $x-1;
      my $nx = $x+1;
      $px = 0        if $px<0;
      $nx = $width-1 if $nx>=$width;
         
      return sqrt(($gry[$py]->[$x]-$gry[$ny]->[$x])**2 + ($gry[$y]->[$px]-$gry[$y]->[$nx])**2);
   };
   my $gradient_x = sub {
      my($x, $y) = @_;
      
      my $px = $x-1;
      my $nx = $x+1;
      $px = 0        if $px<0;
      $nx = $width-1 if $nx>=$width;
         
      return abs($gry[$y]->[$px]-$gry[$y]->[$nx]);
   };
   my $energy = $gradient_x;

   for my $y (0..$height-1) {for my $x (0..$width-1) {
      $nrj[$y]->[$x] = $energy->($x,$y);
   }}
   
   if(1) {
   my @px; my $max;
   for my $r (@nrj) {for my $e (@$r) {$max = $e if $e>$max;}}   
   for my $r (@nrj) {for my $e (@$r) {push(@px, (int($e*256/($max+1)))x3);}}
   
   my $img2 = &px2img($width, $height, @px);
   #$img2->Write('rgb/zzzzzzzzz.png');
   }

   while($width > $t_width) {
      if(0) {
         my @px; my $max;
         for my $r (@nrj) {for my $e (@$r) {$max = $e if $e>$max;}}   
         for my $r (@nrj) {for my $e (@$r) {push(@px, (int($e*256/($max+1)))x3);}}
         my $img2 = &px2img($width, $height, @px);
         #$img2->Write('rgb/zzzzzzzzz.png');
      }
      print STDERR "$width    \r";
      # Dijkstra
      my (@dir, @nrj2);
      for my $y (0..$height-1) {push(@dir, [(0)x$width]);}
      my (@min) = @{$nrj[0]};
      my($nrj2) = 0;
      push(@nrj2, [@min]) if $nrj2;
      for my $y (1..$height-1) {
         my(@m1n, $dir, $min);
         for my $x (0..$width-1) {
            my(@p) = ($x);
            push(@p, $x-1) if $x>0;
            push(@p, $x+1) if $x<$width-1;
            #push(@p, $x-2) if $x>1;
            #push(@p, $x+2) if $x<$width-2;
            
            $min = $min[$dir = pop(@p)];
            for my $q (@p) {if($min[$q]<$min) {$min = $min[$dir=$q];}}
      
            $dir[$y]->[$x] = $dir;
            push(@m1n, $min + $nrj[$y]->[$x]);
         }
         @min = @m1n;
         push(@nrj2, [@min]) if $nrj2;
      }
      
      if($nrj2) {
         my($max, @px) = 1;
         for my $r (@nrj2) {for my $e (@{$r}) {$max = $e if $e>$max;}}   
         for my $r (@nrj2) {for my $e (@{$r}) {push(@px, (int($e*256/($max+1)))x3);}}
         my $img2 = &px2img($width, $height, @px);
         #$img2->Write('rgb/zzzzzzzzz__.png');
      }
      
      #for my $m (@min) {print STDERR " ", int($m*100)/100;}print STDERR "\n";

      # find minima
      my ($min, $pos) = 1e38;
      for my $x (0..$width-1) {$min = $min[$pos = $x] if $min[$x]<$min;}
      last if $min>=1e38;
      #print STDERR "POS=$pos ($min)     ";
   
      # delete pixel
      my($smooth) = 0;
      for(my ($y,$p)=($height, $pos); --$y>=0; $p = $dir[$y]->[$p]) {
         my (@t) = splice($img[$y], $p*3, 3);
         if($smooth && $p>0) {
            for my $i (0..2) {
               $img[$y]->[3*$p+$i-3] = ($img[$y]->[3*$p+$i-3]+$t[$i])/2;
            }
         }
         if($smooth && $p<$width-1) {
            for my $i (0..2) {
               $img[$y]->[3*$p+$i] = ($img[$y]->[3*$p+$i]+$t[$i])/2;
            }
         }
         
         my ($t) = splice($gry[$y], $p, 1);
         if($smooth && $p>0) {
            $gry[$y]->[$p-1] = ($gry[$y]->[$p-1]+$t)/2;
         }
         if($smooth && $p<$width-1) {
            $gry[$y]->[$p] = ($gry[$y]->[$p]+$t)/2;
         }         
         splice($nrj[$y], $p, 1);
      }   
      
      --$width;
      # rebuild NRJ
      for(my ($y,$p)=($height, $pos); --$y>=0; $p = $dir[$y]->[$p]) {
         $nrj[$y]->[$p-1] = $energy->($p-1, $y) if $p>0;
         $nrj[$y]->[$p]   = $energy->($p  , $y) if $p<$width;
         
         $nrj[$y]->[$p-2] = $energy->($p-2, $y) if $smooth && $p>1;
         $nrj[$y]->[$p+1] = $energy->($p+1, $y) if $smooth && $p+1<$width;
      }
   }

   my @px;
   for my $r (@img) {for my $e (@$r) {push(@px, int($e*255));}}
   $img2 = &px2img($width, $height, @px);
   #$img2->Write('rgb/zzzzzzzzzzz.png');

   if($rotate) {
      $img->Rotate(degrees=>-90);
      $img2->Rotate(degrees=>-90);
   }
   
   $img2->Set(depth=>16);
   
   #print "i>", $img->Get('colorspace'),"\n";
   #print "o>", $img2->Get('colorspace'),"\n";
   
   return $img2;
}

sub auto_saturate {
   my($img) = @_;
   
   my($glb_width, $glb_height) = ($img->Get("width"), $img->get("height"));
   my(@px) = $img->GetPixels(map=>"RGB", height=>$glb_height, normalize=>"True");
   my($o, $c, $s, @p) = 1;
   my $t = 3*$glb_width*$glb_height*.07;
   #my ($cr, $cg, $cb) = (.299, .587, .114);
   my ($cr, $cg, $cb) = (1/3)x3;
   do {
      $s = 1e38;
      for(my $i=0; $i<$#px; $i+=3) {
         my($m) = $px[$i]*$cr + $px[$i+1]*$cg + $px[$i+2]*$cb;

         for my $j ($i..$i+2) {
            next if $px[$j]==$m;
            my $a = (($px[$j]>$m?1+$o:-$o)-$m)/($px[$j]-$m);
            $s = $a if $a<$s;
         }
      }
      #print "sat=$s o=$o ";
      $c = 0;   for my $px (@px) {--$c if $px == 1 || $px==0;}
      for(my $i=0; $i<$#px && $c<=$t; $i+=3) {
         my($m) = $px[$i]*$cr + $px[$i+1]*$cg + $px[$i+2]*$cb;

         for my $j ($i..$i+2) {
            $p[$j] = ($px[$j]-$m)*$s + $m;
            ++$c if $p[$j]<0 || $p[$j]>1;
            $p[$j] = 0 if $p[$j]<0;
            $p[$j] = 1 if $p[$j]>1;
            $p[$j] = int(255*$p[$j]);
         }
      }   
      #print "c=",$c/(1+$#px),"\n";
      $o *= .8;
   } while($o > 0.001 && ($c > $t && $s>1.01 || $s>3));
   
   if($s>1.1 && $s<10) {
      $img = &px2img($glb_width,$glb_height,@p);
      my $t = $img->Clone();
      #$t->Write("rgb/clean.png");
   }

   return $img;
}

sub px2img {
   my($width,$height,@px) = @_;
   open(OUT,">/tmp/.toto2.pnm");print OUT "P6\n$width $height\n255\n",pack('C*', @px),"\n";close(OUT);my $img2 = Image::Magick->new(colorspace=>"RGB");
   $img2->ReadImage("/tmp/.toto2.pnm");
        unlink "/tmp/.toto2.pnm";
   return $img2;
}

Je ne sais pas trop s'il marche bien (l'algo optimise la sortie), ce que j'ai pu constater c'est que le TO8 affiche bien l'image quand je recopie le contenu du fichier TEL à l'écran avec le programme basic suivant

Code : Tout sélectionner

10 OPEN "I",1,"fichier.tel"
20 A$=INPUT$(1,1): ? A$; : IF NOT EOF(1) THEN 20
30 CLOSE 1

Si vous pouviez tester avec cette image:

Miro_Comp2_JM_1957.png (1.39 Kio) Consulté 4131 fois

Le fichier tel est dans ce zip:

miro.zip

(7.86 Kio) Téléchargé 119 fois

Si ca marche, et si vous ne savez pas utiliser le script envoyez moi vos fichier, je ferais le traitement par lot. Nota: Toutes les images ne ressortent pas bien, il y a parfois (..souvent) des déceptions.

[EDIT] modif du script pour supporter le gris.
[EDIT2] ajout du support pour la diffusion d'erreur "stucki".
[EDIT3] meilleur calcul des distances entre couleur qui marche indifféremment en couleur et en gris. Utilisation par défaut du tramage 4x4 avec une saturation inchangée car ca donne de bon résultat avec la nouvelle distance entre couleurs.