/usr/src/castle-game-engine-6.4/base/castleprogressconsole.pas is in castle-game-engine-src 6.4+dfsg1-2.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 | {
Copyright 2002-2017 Michalis Kamburelis.
This file is part of "Castle Game Engine".
"Castle Game Engine" is free software; see the file COPYING.txt,
included in this distribution, for details about the copyright.
"Castle Game Engine" 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.
----------------------------------------------------------------------------
}
{ @abstract(Progress bar displayed on console (actually, on StdErr).)
You can assign ProgressConsoleInterface to Progress.UserInterface,
like
@longCode(# Progress.UserInterface := ProgressConsoleInterface;#)
and then all progress bars will be displayed on console.
This displays a title surrounded by [] characters and the progress
is indicated by displaying dots. This way we visualize progress
incrementing from 0 to 100%, and at the same time we use only
normal streaming I/O on StdErr. Totally no console/terminal specific
operations, no special codes, no Crt / Curses unit's used etc.
So this unit doesn't create any terminal compatibility problems,
doesn't mess standard input/output/error streams etc.
The only restriction is that you should not output anything
(on stdout and stderr) to not mess the displayed progress bar.
Of course, the worse that will happen is that the progress bar
will stop looking good for user, nothing more.
If you really want a progress bar that uses your terminal capabilities
see ProgressVideo unit, that displays progress on terminal by FPC's
Video unit.
}
unit CastleProgressConsole;
{$I castleconf.inc}
interface
uses CastleProgress;
type
{ }
TProgressConsoleInterface = class(TProgressUserInterface)
private
{ This will grow from 0 to ConsoleWidth. }
DotsWritten: Integer;
public
procedure Init(Progress: TProgress); override;
procedure Update(Progress: TProgress); override;
procedure Fini(Progress: TProgress); override;
end;
var
{ Assign this to Progress.UserInterface to use console progress bar.
This instance is created in initialization, freed in finalization. }
ProgressConsoleInterface: TProgressConsoleInterface;
implementation
uses
SysUtils, CastleUtils;
const
{ This is the width of the console that we can write without automatically
moving to the next line.
Of course, this shouldn't be a constant,
but actually there is no way here to do anything better.
I can't use here any console/video/terminal functions,
because this unit is supposed to work only with bare StdErr. }
ConsoleWidth = 60;
procedure Write(const s: string);
begin System.Write(ErrOutput, s); end;
procedure Writeln(const s: string);
begin System.Writeln(ErrOutput, s); end;
{ TProgressConsoleInterface -------------------------------------------------- }
procedure TProgressConsoleInterface.Init(Progress: TProgress);
var
LeftSpace, RightSpace: integer;
begin
if Length(Progress.Title) > ConsoleWidth-2 then
begin
Writeln(Progress.Title);
Writeln('[' +StringOfChar(' ', ConsoleWidth-2) +']');
end else
begin
{ since Length(Progress.Title) > ConsoleWidth-2 then
2 <= ConsoleWidth-Length(Progress.Title) so
0 <= (ConsoleWidth-Length(Progress.Title)) div 2 - 1. }
LeftSpace := (ConsoleWidth-Length(Progress.Title)) div 2 - 1;
RightSpace := ConsoleWidth - LeftSpace - Length(Progress.Title) - 2;
Writeln('[' +StringOfChar(' ', LeftSpace) +Progress.Title +
StringOfChar(' ', RightSpace) +']');
end;
DotsWritten := 0;
end;
procedure TProgressConsoleInterface.Update(Progress: TProgress);
var
DotsNow: integer;
begin
DotsNow := Progress.Position * ConsoleWidth div Progress.Max;
if DotsNow > DotsWritten then
begin
Write(StringOfChar('.', DotsNow - DotsWritten));
DotsWritten := DotsNow;
end;
end;
procedure TProgressConsoleInterface.Fini(Progress: TProgress);
begin
Writeln('');
end;
initialization
ProgressConsoleInterface := TProgressConsoleInterface.Create;
finalization
FreeAndNil(ProgressConsoleInterface);
end.
|