{$mode objfpc}{$h+}
uses fpreadgif, fpreadpng, fpreadbmp, fpreadjpeg, fpimage, classes, sysutils, Crt;
var img : TFPMemoryImage;
ReadFile : string;
pixel : TFPColor;
x, y:integer;
ratioX, ratioY:integer;
function SimplifyColorComponent(Value:byte):byte;
begin
if Value>=52 then
SimplifyColorComponent:=63
else
if Value>=32 then
SimplifyColorComponent:=42
else
if Value>=12 then
SimplifyColorComponent:=21
else
SimplifyColorComponent:=0;
end;
function DecreaseColor256(Red,Green,Blue:byte):byte;
const
Palette16:array [0..15,1..3] of byte=((0,0,0),(0,0,42),(0,42,0),(0,42,42),
(42,0,0),(42,0,42),(42,42,0),(42,42,42),
(0,0,21),(0,0,63),(0,42,21),(0,42,63),
(42,0,21),(42,0,63),(42,42,21),(42,42,63));
var
Color,Component,Value:byte;
NewRed,NewGreen,NewBlue:byte;
begin
DecreaseColor256:=0;
Component:=1;
repeat
case Component of
1:Value:=SimplifyColorComponent(Red div 4);
2:Value:=SimplifyColorComponent(Green div 4);
3:Value:=SimplifyColorComponent(Blue div 4);
end;
Color:=0;
while Value<>Palette16[Color,Component] do
begin
Inc(Color);
if Color>15 then
begin
Dec(Value,21);
Color:=0;
end;
end;
case Component of
1:NewRed:=Value;
2:NewGreen:=Value;
3:NewBlue:=Value;
end;
Inc(Component);
until Component>3;
for Color:=0 to 15 do
if (Palette16[Color,1]=NewRed) and (Palette16[Color,2]=NewGreen)
and (Palette16[Color,3]=NewBlue) then
begin
DecreaseColor256:=Color;
Exit;
end;
end;
procedure Init;
begin
ReadFile := ParamStr(1);
img := TFPMemoryImage.Create(0,0);
end;
procedure ReadImage;
var
color16, r, g, b:byte;
readerClass: TFPCustomImageReaderClass;
reader: TFPCustomImageReader;
stream: TStream;
begin
if FileExists(ReadFile) then
begin
stream := TFileStream.Create(ReadFile, fmOpenRead + fmShareDenyNone);
try
stream.Position := 0;
readerClass := TFPCustomImage.FindHandlerFromStream(stream).Reader;
if Assigned(readerClass) then begin
reader := readerClass.Create;
try
img.LoadFromStream(stream, reader);
finally
reader.Free;
end;
ratioY := img.Height div 30;
ratioX := img.Width div 90;
y:=0;
x:=0;
while (y<img.Height) do
begin
while (x<img.Width) do
begin
pixel := img.Colors[x,y];
r := (pixel.Red shr 8) and $00ff;
g := (pixel.Green shr 8) and $00ff;
b := (pixel.Blue shr 8) and $00ff;
color16:=DecreaseColor256(r, g, b);
TextBackground(color16);
Write(' ');
x:=x+ratioX;
end;
WriteLn;
x:=0;
y:=y+ratioY;
end;
end else
WriteLn('Unknown image format.');
finally
stream.Free;
end;
end
else
WriteLn (ReadFile,' file not found.');
end;
procedure Dipose;
begin
Img.Free;
end;
begin
if (ParamCount=0) then
begin
WriteLn('img2chr ,developed by bookhanming@outlook.my');
WriteLn;
WriteLn('img2chr <image filename>');
end
else
try
Init;
ReadImage;
Dipose;
except
on e : exception do
writeln ('Error: ',e.message);
end;
ReadLn;
end.