Recent

Author Topic: My hobby project #2 (ASCII art)  (Read 512 times)

anyone

  • Guest
My hobby project #2 (ASCII art)
« on: October 06, 2020, 02:27:30 pm »
Hi all, again.

Further to my first Graphical hobby project two days ago, as promised, I have tweaked that "img2chr" program a little bit so that now it displays ASCII art from image file.

The concept behind it is to get 16 different intensity values from 24-bit color pixel.

As defined in MS docs for ToARGB():
Quote
The byte-ordering of the 32-bit ARGB value is AARRGGBB. The most significant byte (MSB), represented by AA, is the alpha component value. The second, third, and fourth bytes, represented by RR, GG, and BB, respectively, are the color components red, green, and blue, respectively

(I use back the trick in my original C# code to get the 16 different grey intensity values -- hopefully it is correct because I see it is working anyway)

Code: Pascal  [Select][+][-]
  1.              
  2.              pixel := img.Colors[x,y];
  3.              r := (pixel.Red shr 8) and $00ff;
  4.              g := (pixel.Green shr 8) and $00ff;
  5.              b := (pixel.Blue shr 8) and $00ff;
  6.              newPix := ((r shl 16) or (g shl 8) or (b)) and $00ffffff;


Then there is an array of 'pattern' to match the 16 different grey intensity value accordingly.

Code: Pascal  [Select][+][-]
  1. const
  2.   pattern:array [0..15] of char = ('#','#','@','@','%','%',';',';','*','*',',',',','.','.',' ',' ');
  3. ..
  4. ..
  5. ..
  6.              Write(pattern[(newPix div 1048576)]);

The logic in my code assumes the input image file is always 24-bit. (Alpha channel in ARGB is ignored)

Code: Pascal  [Select][+][-]
  1. {$mode objfpc}{$h+}
  2. uses fpreadgif, fpreadpng, fpreadbmp, fpreadjpeg, fpimage, classes, sysutils, Crt;
  3.  
  4. var img : TFPMemoryImage;
  5.     ReadFile : string;
  6.     pixel : TFPColor;
  7.     x, y:integer;
  8.     ratioX, ratioY:integer;
  9.  
  10.  
  11. procedure Init;
  12. begin
  13.   ReadFile := ParamStr(1);
  14.   img := TFPMemoryImage.Create(0,0);
  15. end;
  16.  
  17. procedure ReadImage;
  18. const
  19.   pattern:array [0..15] of char = ('#','#','@','@','%','%',';',';','*','*',',',',','.','.',' ',' ');
  20. var
  21.   r, g, b:byte;
  22.   newPix: integer;
  23.   readerClass: TFPCustomImageReaderClass;
  24.   reader: TFPCustomImageReader;
  25.   stream: TStream;
  26. begin
  27.    if FileExists(ReadFile) then
  28.    begin
  29.      stream := TFileStream.Create(ReadFile, fmOpenRead + fmShareDenyNone);
  30.      try
  31.        stream.Position := 0;
  32.        readerClass := TFPCustomImage.FindHandlerFromStream(stream).Reader;
  33.        if Assigned(readerClass) then begin
  34.          reader := readerClass.Create;
  35.          try
  36.            img.LoadFromStream(stream, reader);
  37.          finally
  38.            reader.Free;
  39.          end;
  40.  
  41.          ratioY := img.Height div 30;
  42.          ratioX := img.Width div 90;
  43.  
  44.          y:=0;
  45.          x:=0;
  46.  
  47.          while (y<img.Height) do
  48.          begin
  49.            while (x<img.Width) do
  50.            begin
  51.              pixel := img.Colors[x,y];
  52.              r := (pixel.Red shr 8) and $00ff;
  53.              g := (pixel.Green shr 8) and $00ff;
  54.              b := (pixel.Blue shr 8) and $00ff;
  55.              newPix := ((r shl 16) or (g shl 8) or (b)) and $00ffffff;
  56.  
  57.              Write(pattern[(newPix div 1048576)]);
  58.  
  59.              x:=x+ratioX;
  60.            end;
  61.  
  62.            WriteLn;
  63.            x:=0;
  64.            y:=y+ratioY;
  65.          end;
  66.        end else
  67.          WriteLn('Unknown image format.');
  68.      finally
  69.        stream.Free;
  70.      end;
  71.    end
  72.    else
  73.       WriteLn (ReadFile,' file not found.');
  74. end;
  75.  
  76. procedure Dipose;
  77. begin
  78.   Img.Free;
  79. end;
  80.  
  81. begin
  82.   if (ParamCount=0) then
  83.   begin
  84.     WriteLn('img2asc ,developed by bookhanming@outlook.my and Lazarus forum members');
  85.     WriteLn('Generate ASCII art from image file.');
  86.     WriteLn;
  87.     WriteLn('img2asc <image filename>');
  88.   end
  89.   else
  90.     try
  91.       Init;
  92.       ReadImage;
  93.       Dipose;
  94.     except
  95.       on e : exception do
  96.         writeln ('Error: ',e.message);
  97.     end;
  98.  
  99.   WriteLn('Press Enter to quit...');
  100.   ReadLn;
  101. end.
  102.  

The screen shot showing the output of this "img2asc.pp" program. Result might not be ideal. (You can change the pattern array to finetune the result):

Enjoy!

Handoko

  • Hero Member
  • *****
  • Posts: 3913
  • My goal: build my own game engine using Lazarus
Re: My hobby project #2 (ASCII art)
« Reply #1 on: October 06, 2020, 02:38:07 pm »
It looks good.
Thumbs up!

Lulu

  • Full Member
  • ***
  • Posts: 126
Re: My hobby project #2 (ASCII art)
« Reply #2 on: October 06, 2020, 03:50:02 pm »
Cool, thanks you to share ! :)
fpc 3.2.0 Lazarus 2.0.10  -  AMD A8-6600K  -  Windows 10  64bits

anyone

  • Guest
Re: My hobby project #2 (ASCII art)
« Reply #3 on: October 06, 2020, 03:59:00 pm »
Thank you, @Handoko and @Lulu.

We can even create ASCII art Video from MP4 (convert frame by frame) and use a frame delimiter (e.g. '$') to separate each frame in the .mp4.txt.

It is fun to watch the playback of ASCII art Video if each fixed-width character is small enough (e.g. 3-point Courier font).

I have done it in C# but I think I'll just stop here (for porting it to Free Pascal).

Ñuño_Martínez

  • Hero Member
  • *****
  • Posts: 1072
    • Burdjia
Re: My hobby project #2 (ASCII art)
« Reply #4 on: October 10, 2020, 12:06:08 pm »
Cool.  Remembers me a lot to AAlib.
Are you interested in game programming? Join the Pascal Game Development community!
Also visit the Game Development Portal

anyone

  • Guest
Re: My hobby project #2 (ASCII art)
« Reply #5 on: October 14, 2020, 01:33:56 pm »
Thanks @Ñuño_Martínez. Someone has already done the AAlib in 1997, much earlier than me....  :)

Now I have a website specially for these projects (img2chr and img2asc).
It is called http://asciiartonline.com (although it does not support image file uploading and instant ASCII art conversion, as its name implies.)

 

TinyPortal © 2005-2018