{ Graphics viewer for Linux framebuffer

  Copyright 2004-2006 Frank Heckenbach <frank@pascal.gnu.de>

  This program is free software; you can redistribute it and/or
  modify it under the terms of the GNU General Public License as
  published by the Free Software Foundation, version 2.

  This program is distributed in the hope that it will be useful,
  but WITHOUT ANY WARRANTY; without even the implied warranty of
  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
  General Public License for more details.

  You should have received a copy of the GNU General Public License
  along with this program; see the file COPYING. If not, write to
  the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  Boston, MA 02111-1307, USA. }

program FGV;

uses GPC, CRT, PictureUtils, LinuxFB;

const
  MaxImgReadAheadPerSide = 10;
  MaxImgKeepReadAheadPerSide = 20;
  DefaultGamma = 1.0;
  DefaultBrightness = 1.0;

type
  TImgs (m: Integer) = array [1 .. m] of PImg;
  PFB8 = ^TFB8;
  TFB8 = array [0 .. MaxVarSize div SizeOf (Card8) - 1] of Card8;
  PFBRGB = ^TFBRGB;
  TFBRGB = array [0 .. MaxVarSize div (4 * SizeOf (Card8)) - 1] of record
    db, dg, dr, dt: Card8
  end;

var
  FillByte: Byte;
  BytesPerScreen, ScreenSizeX, ScreenSizeY, m, d, c, i, n, pn, ni, pni, x, y, ax, ay, px, py, ox, oy, pox, poy: Integer;
  Scale, White, HasRead, Depth8: Boolean;
  p8: PFB8;
  pRGB: PFBRGB absolute p8;
  Img: PImg;
  Imgs: ^TImgs;
  VSOld, VSNew: TFBVarScreenInfo;
  CMOld, CMNew: TFBColorMap;
  f: file;
  Gamma: Real = DefaultGamma;
  Brightness: Real = DefaultBrightness;
  FBDevice: TString = DefaultFBDevice;
  Tty: Text;

procedure Error (const Msg: String);
begin
  RestoreTerminal (True);
  WriteLn (StdErr, ParamStr (0), ': ', Msg);
  Halt (1)
end;

procedure ReadImage (n: Integer);
var
  w, h: Integer;
  s: TString;
begin
  s := ParamStr (n + FirstNonOption - 1);
  if Imgs^[n] = nil then
    begin
      if Scale and PictureSize (s, w, h) and ((w > ScreenSizeX) or (h > ScreenSizeY)) then
        Imgs^[n] := ReadImg (s, Integer2String (ScreenSizeX) + 'x' + Integer2String (ScreenSizeY), Error)
      else
        Imgs^[n] := ReadImg (s, '', Error);
      HasRead := True
    end
end;

procedure FreeImage (n: Integer);
var p, p2: PImg;
begin
  p := Imgs^[n];
  while p <> nil do
    begin
      p2 := p^.Next;
      Dispose (p);
      p := p2
    end;
  Imgs^[n] := nil
end;

procedure VTAcquire;
begin
  CRTPushReadKey (kbUser1)
end;

procedure CleanUp;
begin
  Discard (UnregisterRestoreTerminal (True, CleanUp));
  CleanupVT;
  FillChar (pRGB^, BytesPerScreen, 0);  { avoid leaving parts of the picture in the frame buffer -- they might show up later }
  Discard (SetFBColorMap (f, CMOld));
  Discard (SetFBScreenInfo (f, VSOld))
end;

procedure RandomPalette (Channel: Integer);
var c: Integer;
begin
  if not Depth8 then
    repeat
      c := Random (255) + 1;
      if Channel in [0, 1] then CMNew.r^[c] := Round ((Random (256) / 555) ** (1 / Gamma) * 65535 * Brightness) else CMNew.r^[c] := 0;
      if Channel in [0, 2] then CMNew.g^[c] := Round ((Random (256) / 555) ** (1 / Gamma) * 65535 * Brightness) else CMNew.g^[c] := 0;
      if Channel in [0, 3] then CMNew.b^[c] := Round ((Random (256) / 555) ** (1 / Gamma) * 65535 * Brightness) else CMNew.b^[c] := 0;
      if not SetFBColorMap (f, CMNew) then Error ('cannot set color map')
    until KeyPressed
end;

const
  LongOptions: array [1 .. 7] of OptionType =
    (('help',       NoArgument,       nil, 'h'),
     ('version',    NoArgument,       nil, 'v'),
     ('scale',      NoArgument,       nil, 's'),
     ('white',      NoArgument,       nil, 'w'),
     ('gamma',      RequiredArgument, nil, 'g'),
     ('brightness', RequiredArgument, nil, 'b'),
     ('device',     RequiredArgument, nil, 'd'));

procedure Usage (var t: Text);
begin
  WriteLn (t, 'Graphics viewer for Linux framebuffer
Usage: ', ParamStr (0), ' [options] filename...
Options:
  -h, --help                    Display this help and exit
  -v, --version                 Output version information and exit
  -s, --scale                   Scale large images to fit on screen
  -w, --white                   White background
  -g VALUE, --gamma=VALUE       Set gamma correction (default: ', DefaultGamma : 0 : 2, ')
  -b VALUE, --brightness=VALUE  Set brightness (default: ', DefaultBrightness : 0 : 2, ')
  -d NAME, --device=NAME        Set framebuffer device (default: ', DefaultFBDevice, ')')
end;

begin
  SeedRandom (42);
  Rewrite (Tty, TtyDeviceName);
  CRTSetTerminal (nil, Tty, Tty);
  Rewrite (Output, '');
  Scale := False;
  White := False;
  repeat
    case GetOptLong ('', LongOptions, Null, False) of
      UnknownOption: begin
                       WriteLn (StdErr);
                       Usage (StdErr);
                       Halt (1)
                     end;
      'h': begin
             Usage (Output);
             Halt
           end;
      'v': begin
             WriteLn ('Graphics viewer for Linux framebuffer

Copyright 2004-2006 by Frank Heckenbach.

Report bugs to <frank@pascal.gnu.de>.');
             Halt
           end;
      's': Scale := True;
      'w': White := True;
      'g': ReadStr (OptionArgument, Gamma);
      'b': ReadStr (OptionArgument, Brightness);
      'd': FBDevice := OptionArgument;
      EndOfOptions: Break;
    end
  until False;
  if ParamCount < FirstNonOption then
    begin
      Usage (StdErr);
      Halt (1)
    end;
  HasRead := False;
  m := ParamCount - FirstNonOption + 1;
  New (Imgs, m);
  for n := 1 to m do Imgs^[m] := nil;
  if not Scale then ReadImage (1);  { Read first image before changing screen mode. When Scaling, we need the screen size, though. }
  Rewrite (f, FBDevice, 1);
  WaitVTActive;
  if not GetFBScreenInfo (f, VSOld) then Error ('cannot get screen information');
  VSNew := VSOld;
  VSNew.BPP := 32;
  if not SetFBScreenInfo (f, VSNew) then Error ('cannot set screen information');
  Depth8 := VSNew.BPP = 8;
  ScreenSizeX := VSNew.XRes;
  ScreenSizeY := VSNew.YRes;
  with VSNew do BytesPerScreen := XRes * YRes * BPP div BitSizeOf (Byte);
  pRGB := MemoryMap (nil, BytesPerScreen, mm_Readable or mm_Writable, True, f, 0);
  if pRGB = nil then Error ('cannot memory-map frame-buffer');
  HideCursor;
  CRTUpdate;
  New (CMNew.r);
  New (CMNew.g);
  New (CMNew.b);
  CMNew.t := nil;
  if Depth8 then
    begin
      CMNew.Start := 40;
      CMNew.Length := 216;
      for n := 0 to 215 do
        begin
          CMNew.r^[n] := Round (((n div 36) / 5) ** (1 / Gamma) * 65535 * Brightness);
          CMNew.g^[n] := Round ((((n mod 36) div 6) / 5) ** (1 / Gamma) * 65535 * Brightness);
          CMNew.b^[n] := Round (((n mod 6) / 5) ** (1 / Gamma) * 65535 * Brightness)
        end
    end
  else
    begin
      CMNew.Start := 0;
      CMNew.Length := 256;
      for n := 0 to 255 do
        begin
          i := Round ((n / 255) ** (1 / Gamma) * 65535 * Brightness);
          CMNew.r^[n] := i;
          CMNew.g^[n] := i;
          CMNew.b^[n] := i
        end
    end;
  CMOld.Start := 0;
  CMOld.Length := 256;
  New (CMOld.r);
  New (CMOld.g);
  New (CMOld.b);
  New (CMOld.t);
  if not GetFBColorMap (f, CMOld) then Error ('cannot get color map');
  if not SetFBColorMap (f, CMNew) then Error ('cannot set color map');
  if White then
    FillByte := $ff
  else
    FillByte := 0;
  CatchVTChange (nil, VTAcquire, True);
  RegisterRestoreTerminal (True, CleanUp);
  px := ScreenSizeX - 1;
  py := ScreenSizeY - 1;
  pn := 0;
  n := 1;
  pni := 1;
  ni := 1;
  while n <= m do
    begin
      if n <> pn then
        begin
          for i := 1 to n - MaxImgKeepReadAheadPerSide - 1 do FreeImage (i);
          for i := n + MaxImgKeepReadAheadPerSide + 1 to m do FreeImage (i)
        end;
      if (n <> pn) or (ni <> pni) then
        begin
          pn := n;
          pni := ni;
          ReadImage (n);
          Img := Imgs^[n];
          for i := 2 to ni do Img := Img^.Next;
          oy := 0;
          ox := 0
        end;
      ax := Max (0, Min (Img^.x - ox, ScreenSizeX)) - 1;
      ay := Max (0, Min (Img^.y - oy, ScreenSizeY)) - 1;
      if Depth8 then
        begin
          for y := 0 to ay do
            begin
              for x := 0 to ax do
                with Img^.Img[y + oy, x + ox] do
                  p8^[y * ScreenSizeX + x] := ((r + 25) div 51) * 36 + ((g + 25) div 51) * 6 + ((b + 25) div 51) + 40;
              if ax < px then FillChar (p8^[y * ScreenSizeX + ax + 1], (px - ax) * SizeOf (p8^[0]), FillByte)
            end;
          if ay < py then FillChar (p8^[(ay + 1) * ScreenSizeX], (py - ay) * ScreenSizeX * SizeOf (p8^[0]), FillByte)
        end
      else
        begin
          for y := 0 to ay do
            begin
              for x := 0 to ax do
                with Img^.Img[y + oy, x + ox], pRGB^[y * ScreenSizeX + x] do
                  begin
                    dr := r;
                    dg := g;
                    db := b;
                    dt := 0
                  end;
              if ax < px then FillChar (pRGB^[y * ScreenSizeX + ax + 1], (px - ax) * SizeOf (pRGB^[0]), FillByte)
            end;
          if ay < py then FillChar (pRGB^[(ay + 1) * ScreenSizeX], (py - ay) * ScreenSizeX * SizeOf (pRGB^[0]), FillByte)
        end;
      px := ax;
      py := ay;
      pox := ox;
      poy := oy;
      repeat
        HasRead := False;
        while not KeyPressed do
          begin
            c := 0;
            for d := 1 to MaxImgReadAheadPerSide do
              if (n + d <= m) and (Imgs^[n + d] = nil) then
                begin
                  c := n + d;
                  Break
                end
              else if (n - d >= 1) and (Imgs^[n - d] = nil) then
                begin
                  c := n - d;
                  Break
                end;
            if c = 0 then Break;
            ReadImage (c)
          end;
        case LoCaseKey (ReadKeyWord) of
          kbEsc,
          Ord ('q'):   n := m + 1;
          kbEnter,
          kbLF,
          kbSpace,
          kbIns:       if (Imgs^[n] <> nil) and (ni < Imgs^[n]^.Count) then
                         Inc (ni)
                       else if n < m then
                         begin
                           Inc (n);
                           ni := 1
                         end;
          kbBkSp,
          kbDel:       if ni > 1 then
                         Dec (ni)
                       else if n > 1 then
                         begin
                           Dec (n);
                           if Imgs^[n] = nil then
                             ni := 1
                           else
                             ni := Imgs^[n]^.Count
                         end;
          kbLeft:      ox := Max (0, ox - (ScreenSizeX div 5));
          kbRight:     ox := Max (0, Min (Img^.x - ScreenSizeX, ox + ScreenSizeX div 5));
          kbCtrlLeft:  if ox < ScreenSizeX then ox := 0 else ox := Max (0, ox - 4 * ScreenSizeX div 5);
          kbCtrlRight: if ox > Img^.x - 2 * ScreenSizeX then ox := Max (0, Img^.x - ScreenSizeX) else ox := Max (0, Min (Img^.x - ScreenSizeX, ox + 4 * ScreenSizeX div 5));
          kbHome:      ox := 0;
          kbEnd:       ox := Max (0, Img^.x - ScreenSizeX);
          kbUp:        oy := Max (0, oy - (ScreenSizeY div 5));
          kbDown:      oy := Max (0, Min (Img^.y - ScreenSizeY, oy + ScreenSizeY div 5));
          kbCtrlUp:    if oy < ScreenSizeY then oy := 0 else oy := Max (0, oy - 4 * ScreenSizeY div 5);
          kbCtrlDown:  if oy > Img^.y - 2 * ScreenSizeY then oy := Max (0, Img^.y - ScreenSizeY) else oy := Max (0, Min (Img^.y - ScreenSizeY, oy + 4 * ScreenSizeY div 5));
          kbPgUp:      oy := 0;
          kbPgDn:      oy := Max (0, Img^.y - ScreenSizeY);
          kbUser1,
          kbCtrlL:     begin
                         px := ScreenSizeX - 1;
                         py := ScreenSizeY - 1;
                         pox := -1;
                         { Try to set the palette again in order to do a full redraw, but don't abort if it fails }
                         Discard (SetFBColorMap (f, CMNew))
                       end;
          kbCtrlX:     RandomPalette (0);
          kbCtrlR:     RandomPalette (1);
          kbCtrlG:     RandomPalette (2);
          kbCtrlB:     RandomPalette (3);
          kbCtrlY:     if not Depth8 then
                         begin
                           for c := 0 to 255 do
                             begin
                               i := Round ((c / 255) ** (1 / Gamma) * 65535 * Brightness);
                               CMNew.r^[c] := i;
                               CMNew.g^[c] := i;
                               CMNew.b^[c] := i
                             end;
                           if not SetFBColorMap (f, CMNew) then Error ('cannot set color map')
                         end;
        end
      until ((n <> pn) or (ni <> pni) or (ox <> pox) or (oy <> poy)) and (not KeyPressed or HasRead)
    end
end.