Bitmap zu Ascii , schnelle Routiene gesucht.

[turboPASCAL]

Hi,

ich suche eine Routine, die schnell Bitmap zu Ascii-Zeichencode wandeln kann.

[Medium]

Meinst du damit eine darstellbare Binärcodierung wie Base64, oder willst du ASCII-Art automatisch erzeugen? Bei letzterem gibt's 3 zu unterscheidende Varianten, die sich im Aufwand teils erheblich voneinander unterscheiden:
1) Farbbitmap zu beliebigen Zeichen (z.B. Zufallstext), so dass ein Zeichen nur in entsprechnder Farbe sein muss
2) S/W Bitmaps, bei denen die Formen auf Sub-Character-Ebene genau nachgebildet werden sollen
3) Kombi aus 1 und 2

Du müsstest also schon etwas genauer werden ;)

[turboPASCAL]

Wie man ein Bitmap in Ascii-Zeichen übertragen kann ist für mich kein Problem.

Image Matrix FX ASCII Art
Delphi für Win32 Bitmap to ASCII - blinkende Zeichen (Problemchen)

Nur sind die meine eigenen Routinen für meine Zwecke, also eine schnelle Abfolge von Bildern anscheinend etwas zu langsam.
Das auslesen der Farbwerte des Bitmaps wird direkt über den Pointer erledigt, also nix mit Canvas.Pixels[].
Zu dem ich auch keinen TCanvas habe. ;)

[turboPASCAL]

Also das mit dem Umwandeln der Zeichen und dann noch passend Farbe dazu ist nicht so einfach.
Ich könnte ein wenig Hilfe gebrauchen.

[Medium]

Am besten wäre es wohl, wenn du den konkreten Source posten würdest den es zu optimieren gilt.

[Valle]

Mal so am Rande angemerkt...

Ich habe mal vor einiger Zeit mehr oder weniger aus Versehen den VLC Player (oder wars der MPlayer?) in der Konsole mit einem Video gestartet. Dabei hat der Player das Video in Echtzeit (!) in ASCII-Art gewandelt. Das heißt also, dass es möglich sein muss, es schneller zu machen. :mrgreen:

Liebe Grüße,
Valle

[Namenloser]

Ich hab da mal was gebastelt - multithreaded :o

Leider hast du ja kein Testvideo o.ä. beigelegt, weshalb ich etwas improvisieren musste. (Meine Improvisation ist wahnsinnig kreativ, so viel sei verraten :stupid: )

Das Programm benötigt leider die Graphics32, weil diese komfortablen Zugriff auf die Bildrohdaten liefert, und ich zu faul war, das ganze mit dem normalen TBitmap zu machen - bzw. eigentlich hab ich's versucht, aber das Programm ist dann eingefroren - wahrscheinlich ist TBitmap.Scanline nicht Threadsafe. :wall:

Der Code ist teilweise etwas hässlich und für Nicht-Eingeweihte möglicherweise auch etwas unverständlich. Falls das der Fall sein sollte, kannst du mich gerne dazu befragen.

[edit]
Achja, es fehlt auch noch eine gescheite Fehlerbehandlung. Derzeit dürfte es z.B. ziemlich sicher krachen, wenn die Höhe des Bildes niedriger ist als die Anzahl der Threads.

Btw: Routine schreibt man ohne ie.
[/edit]

[turboPASCAL]

Erst einmal schonen Dank.

Das mit der Geschwindigkeit passt nun. Was noch zu knacken wäre ist die Sache mit der verflixten Farbe.

[Namenloser]

Zitat:

Zitat von turboPASCAL

Das mit der Geschwindigkeit passt nun. Was noch zu knacken wäre ist die Sache mit der verflixten Farbe.

Für die Farbe würde ich das Bild erst mal in HSL umrechnen. Als Farbe nimmst du dann den Hue (H), und die Helligkeit (L) stellst du über den Zeichencode dar. Für die Farbe würde sich evtl. ein weiteres Array anbieten (kann man wieder schön in den Threads befüllen), wie du das ganze dann ausgibst hängt natürlich von deiner Ausgabemethode ab - Konsole? Canvas? ...?

[himitsu]

Selbst wenn TBitmap.Scanline nicht threadsave ist, könnte man sich die Scanline-Pointer vorher holen und an die Threads abgeben.

[Namenloser]

Zitat:

Zitat von himitsu

Selbst wenn TBitmap.Scanline nicht threadsave ist, könnte man sich die Scanline-Pointer vorher holen und an die Threads abgeben.

Jo, könnte man, muss man aber nicht :stupid:

[turboPASCAL]

Ja, nun klappt es mit der Farbe. Leider noch nicht zu 100% da ich schwierigkeiten habe mit
dem erstellen der "Dos"- Farbpallette.

[Namenloser]

Nett :thumb: Source Code?
Allerdings solltest du für die Textausgabe (Lauftext) Cleartype ausschalten.

[igel457]

Da es sich um das Konsolenfenster handelt, schätze ich kaum, dass man dort Kontrolle über ClearType hat ;-)

[Namenloser]

Zitat:

Zitat von igel457

Da es sich um das Konsolenfenster handelt, schätze ich kaum, dass man dort Kontrolle über ClearType hat ;-)

Ich meine nicht die ausgegebenen ASCII-Zeichen. Ich meine den Lauftext. Der ist an manchen Stellen z.B. rot, wegen Cleartype, nehme ich an.

[turboPASCAL]

Zitat:

Zitat von NamenLozer

Nett :thumb:

THX.

Zitat:

Zitat von NamenLozer

Source Code?

Klar, hier:

Delphi-Quellcode:

type
  TvColors = array [0..7, 0..1] of byte;

const
  RGBData: array[0..7] of TvColors = (
    (($B1, $4F), ($B1, $6F), ($B1, $7E), ($B1, $2F), ($B1, $3F), ($B1, $1F), ($B1, $5F), ($B1, $4F)),
    (($B2, $7C), ($B1, $76), ($B1, $7E), ($B2, $7A), ($B2, $7B), ($B1, $79), ($B2, $7D), ($B2, $7C)),
    (($B1, $4C), ($B2, $76), ($B2, $7E), ($B1, $2A), ($B1, $3B), ($B1, $09), ($B1, $5D), ($B1, $4C)),
    (($B0, $4C), ($B2, $76), ($B2, $7E), ($B0, $2A), ($B0, $3B), ($B0, $19), ($B0, $5D), ($B0, $4C)),
    (($B0, $44), ($B0, $66), ({DB}$B0, $0E), ($B2, $22), ($B2, $33), ($B2, $11), ($B2, $55), ($B2, $44)),
    (($B2, $04), ($B2, $06), ($B2, $0E), ($B2, $02), ($B2, $03), ($B2, $01), ($B2, $05), ($B2, $04)),
    (($B1, $04), ($B1, $06), ($B1, $0E), ($B1, $02), ($B1, $03), ($B1, $01), ($B1, $05), ($B1, $04)),
    (($B0, $04), ($B0, $06), ($B0, $0E), ($B0, $02), ($B0, $03), ($B0, $01), ($B0, $05), ($B0, $04)));

procedure TDosASCIIText.RGBtoHSL(Color: COLORREF; out H, S, L: Single);
var
  Delta: Single;
  CMax, CMin: Single;
  Red, Green, Blue : Single;
begin
  Red := GetRValue(Color) / 255;
  Green := GetGValue(Color) / 255;
  Blue := GetBValue(Color) / 255;

  CMax := Max(Red, Max(Green, Blue));
  CMin := Min(Red, Min(Green, Blue));
  L := (CMax + CMin) / 2;
  if CMax = CMin then
  begin
    S := 0;
    H := 0;
  end else
  begin
    if L < 0.5
      then S := (CMax - CMin) / (CMax + CMin)
      else S := (cmax - cmin) / (2 - cmax - cmin);

    delta := CMax - CMin;

    if Red = CMax then H := (Green - Blue) / Delta
    else
      if Green = CMax then H := 2 + (Blue - Red) / Delta
      else H := 4.0 + (Red - Green) / Delta;

    H := H / 6;

    if H < 0 then H := H + 1;
  end;

  H := (H * 360);  // 0.0 .. 360.0
  S := (S * 100);  // 0.0 .. 100.0
  L := (L * 100);  // 0.0 .. 100.0
end;

procedure TDosASCIIText.RGBToHSL_AsInteger(const Color: COLORREF; out Huge, Saturation, Luminance: integer);
var _Huge, _Saturation, _Luminance: single;
begin
  RGBToHSL(Color, _Huge, _Saturation, _Luminance);
  Huge := round(_Huge );
  Saturation := round(_Saturation);
  Luminance := round(_Luminance);
end;


procedure TDosASCIIText.BitmapToArray(var conBuffer: TConBuffer);
type
  TRGBA = packed record
    B, G, R, A: Byte;
  end;
  PRGBA = ^TRGBA;
var
  xx,yy: integer;
  rgba: prgba;

  C: Byte;
  Ch: Char;

  H, S, L, p, p2,p3: integer;

  function _SetTextColor(FColor, BColor: Byte): Byte;
  begin
    Result := FColor or (BColor shl 4);
  end;

begin
  for yy := 0 to BmpH - 1 do
  begin
    for xx := 0 to BmpW - 1 do
    begin
      rgba := pRGBA(DWORD(pBmpBits) + DWORD(xx + yy * BmpW) * 4);
      RGBToHSL_AsInteger(RGB(rgba.R, rgba.G, rgba.B), H, S, L);

      c := 0;
      ch := #0;
      
      if (H = 0) and (S = 0) then  // black & white gedöns
      begin
        case L of
           0.. 25: C := 0;
          26.. 50: C := 8;
          51.. 75: C := 7;
          76..100: C := 15;
        end;
        case L of
           0.. 19: Ch := ' ';
          20.. 39: Ch := '°';
          40.. 59: Ch := '±';
          60.. 79: Ch := '²';
          80..100: Ch := 'Û';
        end;
      end else
      begin                        // Farbe
        p := round( (H / 360) * 100     );
        p := round( (7 / 100) * p       );

        // sättigung & hälligkeit zusammen packen ???
        p2:= round( (7 / 100) * l       );
        p3:= round( (7 / 100) * s       );

        p2 := (p2 + p3) div 2;  

        C  := RGBData[7-p2,p,1];  //?farben im array vertauscht ?
        Ch := chr( RGBData[p2,p,0] );
      end;

      conBuffer[xx + yy * BmpW].AsciiChar := Ch;
      conBuffer[xx + yy * BmpW].Attributes := C;
    end;
  end;
end;

;)

Zitat:

Zitat von NamenLozer

Allerdings solltest du für die Textausgabe (Lauftext) Cleartype ausschalten.

Cleartype ham' 'wer ned.

//Edit:
kleines Update in Post #12 wegen einem Fehler