paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-28 06:23:48 +02:00
Code Issues Packages Projects Releases Wiki Activity
054f6bff3a
fpc/fv/gfvgraph.pas
peter 01dfac4a4e * old logs removed and tabs fixed
2002-09-07 15:06:34 +00:00

837 lines
32 KiB
ObjectPascal
Raw Blame History

{ $Id$ }
{********[ SOURCE FILE OF GRAPHICAL FREE VISION ]**********}
{ }
{ System independent GFV GRAPHICS UNIT }
{ }
{ Copyright (c) 1999, 2000 by Leon de Boer }
{ ldeboer@attglobal.net - primary e-mail address }
{ ldeboer@projectent.com.au - backup e-mail address }
{ }
{ This unit provides the interlink between the graphics }
{ used in GFV and the graphics API for the different }
{ operating systems. }
{ }
{****************[ THIS CODE IS FREEWARE ]*****************}
{ }
{ This sourcecode is released for the purpose to }
{ promote the pascal language on all platforms. You may }
{ redistribute it and/or modify with the following }
{ DISCLAIMER. }
{ }
{ This SOURCE CODE is distributed "AS IS" WITHOUT }
{ WARRANTIES AS TO PERFORMANCE OF MERCHANTABILITY OR }
{ ANY OTHER WARRANTIES WHETHER EXPRESSED OR IMPLIED. }
{ }
{*****************[ SUPPORTED PLATFORMS ]******************}
{ 16 and 32 Bit compilers }
{ WINDOWS - Turbo Pascal 7.0 + (16 Bit) }
{ - Delphi 1.0+ (16 Bit) }
{ WIN95/NT - Delphi 2.0+ (32 Bit) }
{ - Virtual Pascal 2.0+ (32 Bit) }
{ - Speedsoft Sybil 2.0+ (32 Bit) }
{ - FPC 0.9912+ (32 Bit) }
{ OS2 - Virtual Pascal 1.0+ (32 Bit) }
{ - Speed Pascal 1.0+ (32 Bit) }
{ }
{*****************[ REVISION HISTORY ]*********************}
{ Version Date Fix }
{ ------- --------- ---------------------------------- }
{ 1.00 26 Nov 99 Unit started from relocated code }
{ originally from views.pas }
{ 1.01 21 May 00 GetMaxX and GetMaxY added. }
{ 1.02 05 Dec 00 Fixed DOS/DPMI implementation. }
{**********************************************************}
UNIT GFVGraph;
{<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
INTERFACE
{<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
{====Include file to sort compiler platform out =====================}
{$I Platform.inc}
{====================================================================}
{==== Compiler directives ===========================================}
{$IFNDEF PPC_FPC} { FPC doesn't support these switches }
{$F-} { Near far calls are okay }
{$A+} { Word Align Data }
{$B-} { Allow short circuit boolean evaluations }
{$O+} { This unit may be overlaid }
{$G+} { 286 Code optimization - if you're on an 8088 get a real computer }
{$E+} { Emulation is on }
{$N-} { No 80x87 code generation }
{$ENDIF}
{$X+} { Extended syntax is ok }
{$R-} { Disable range checking }
{$S-} { Disable Stack Checking }
{$I-} { Disable IO Checking }
{$Q-} { Disable Overflow Checking }
{$V-} { Turn off strict VAR strings }
{====================================================================}
{$IFDEF GRAPH_API} { GRAPH CODE }
USES Graph; { Standard unit }
{$ENDIF}
{***************************************************************************}
{ PUBLIC CONSTANTS }
{***************************************************************************}
{---------------------------------------------------------------------------}
{ STANDARD COLOUR CONSTANTS }
{---------------------------------------------------------------------------}
CONST
Black = 0; { Black }
Blue = 1; { Blue }
Green = 2; { Green }
Cyan = 3; { Cyan }
Red = 4; { Red }
Magenta = 5; { Magenta }
Brown = 6; { Brown }
LightGray = 7; { Light grey }
DarkGray = 8; { Dark grey }
LightBlue = 9; { Light blue }
LightGreen = 10; { Light green }
LightCyan = 11; { Light cyan }
LightRed = 12; { Light red }
LightMagenta = 13; { Light magenta }
Yellow = 14; { Yellow }
White = 15; { White }
{---------------------------------------------------------------------------}
{ WRITE MODE CONSTANTS }
{---------------------------------------------------------------------------}
CONST
NormalPut = 0; { Normal overwrite }
CopyPut = 0; { Normal put image }
AndPut = 1; { AND colour write }
OrPut = 2; { OR colour write }
XorPut = 3; { XOR colour write }
NotPut = 4; { NOT colour write }
{---------------------------------------------------------------------------}
{ CLIP CONTROL CONSTANTS }
{---------------------------------------------------------------------------}
CONST
ClipOn = True; { Clipping on }
ClipOff = False; { Clipping off }
{---------------------------------------------------------------------------}
{ VIDEO CARD DETECTION CONSTANTS }
{---------------------------------------------------------------------------}
CONST
Detect = 0; { Detect video }
{$IFDEF GRAPH_API} { DOS CODE ONLY }
{---------------------------------------------------------------------------}
{ DOS GRAPHICS SOLID FILL BAR AREA CONSTANT }
{---------------------------------------------------------------------------}
CONST
SolidFill = Graph.SolidFill;
LowAscii : boolean = true;
type
textrainfo = array[0..0] of word;
pextrainfo = ^textrainfo;
TSpVideoBuf = array [0..0] of pextrainfo;
PSpVideoBuf = ^TSpVideoBuf;
const
SpVideoBuf : PSpVideoBuf = nil;
{$ELSE not GRAPH_API }
CONST
SolidFill = 0;
{$ENDIF not GRAPH_API}
{***************************************************************************}
{ PUBLIC TYPE DEFINITIONS }
{***************************************************************************}
{---------------------------------------------------------------------------}
{ ViewPortType RECORD DEFINITION }
{---------------------------------------------------------------------------}
TYPE
ViewPortType = PACKED RECORD
X1, Y1, X2, Y2: Integer; { Corners of viewport }
Clip : Boolean; { Clip status }
END;
{***************************************************************************}
{ INTERFACE ROUTINES }
{***************************************************************************}
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
{ GRAPHICS MODE CONTROL ROUTINES }
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
{-SetWriteMode-------------------------------------------------------
Sets the current write mode constant all subsequent draws etc. are
then via the set mode.
26Nov99 LdB
---------------------------------------------------------------------}
PROCEDURE SetWriteMode (Mode: Byte; TextMode: Boolean);
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
{ VIEWPORT CONTROL ROUTINES }
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
{-GetViewSettings----------------------------------------------------
Returns the current viewport and clip parameters in the variable.
26Nov99 LdB
---------------------------------------------------------------------}
PROCEDURE GetViewSettings (Var CurrentViewPort: ViewPortType; TextMode: Boolean);
{-SetViewPort--------------------------------------------------------
Set the current viewport and clip parameters to that requested.
26Nov99 LdB
---------------------------------------------------------------------}
PROCEDURE SetViewPort (X1, Y1, X2, Y2: Integer; Clip, TextMode: Boolean);
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
{ GRAPHICS DEVICE CAPACITY ROUTINES }
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
{-GetMaxX------------------------------------------------------------
Returns X coordinate of maximum value that can be entered in any
graphics routine, that is the actual screen width in pixels - 1.
21May2000 LdB
---------------------------------------------------------------------}
FUNCTION GetMaxX (TextMode: Boolean): Integer;
{-GetMaxY------------------------------------------------------------
Returns Y coordinate of maximum value that can be entered in any
graphics routine, that is the actual screen height in pixels - 1.
21May2000 LdB
---------------------------------------------------------------------}
FUNCTION GetMaxY (TextMode: Boolean): Integer;
PROCEDURE SetColor(Color: Word);
PROCEDURE SetFillStyle (Pattern: Word; Color: Word);
PROCEDURE Bar (X1, Y1, X2, Y2: Integer);
PROCEDURE Line(X1, Y1, X2, Y2: Integer);
PROCEDURE Rectangle(X1, Y1, X2, Y2: Integer);
PROCEDURE OutTextXY(X,Y: Integer; TextString: String);
{$IFDEF GRAPH_API}
procedure GraphUpdateScreen(Force: Boolean);
procedure SetExtraInfo(x,y,xi,yi : longint; color : word);
procedure SetupExtraInfo;
procedure FreeExtraInfo;
Const
{ Possible cursor types for video interface }
crHidden = 0;
crUnderLine = 1;
crBlock = 2;
crHalfBlock = 3;
EmptyVideoBufCell : pextrainfo = nil;
{ from video unit }
procedure SetCursorPos(NewCursorX, NewCursorY: Word);
{ Position the cursor to the given position }
function GetCursorType: Word;
{ Return the cursor type: Hidden, UnderLine or Block }
procedure SetCursorType(NewType: Word);
{ Set the cursor to the given type }
{$ENDIF GRAPH_API}
{***************************************************************************}
{ INITIALIZED PUBLIC VARIABLES }
{***************************************************************************}
{---------------------------------------------------------------------------}
{ INITIALIZED DOS/DPMI/WIN/NT/OS2 VARIABLES }
{---------------------------------------------------------------------------}
CONST
WriteMode : Byte = 0; { Current write mode }
SysScreenWidth : Integer = 640; { Default screen width }
SysScreenHeight: Integer = 480; { Default screen height}
{$ifdef USE_VIDEO_API}
SysFontWidth : Integer = 8; { System font width }
SysFontHeight : Integer = 16; { System font height }
TextScreenWidth : Integer = 80;
TextScreenHeight : Integer = 25;
{$endif USE_VIDEO_API}
{$ifdef DEBUG}
const
WriteDebugInfo : boolean = false;
{$endif DEBUG}
{<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
IMPLEMENTATION
{<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
{$ifdef USE_VIDEO_API}
USES video; { Standard unit }
{$ENDIF}
{***************************************************************************}
{ PRIVATE INITIALIZED VARIABLES }
{***************************************************************************}
{---------------------------------------------------------------------------}
{ DOS/DPMI/WIN/NT/OS2 INITIALIZED VARIABLES }
{---------------------------------------------------------------------------}
CONST
FillCol : Integer = 0;
Cxp : Integer = 0; { Current x position }
Cyp : Integer = 0; { Current y position }
ViewPort: ViewPortType = (X1:0; Y1:0; X2: 639;
Y2: 479; Clip: True); { Default viewport }
{***************************************************************************}
{ INTERFACE ROUTINES }
{***************************************************************************}
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
{ GRAPHICS MODE CONTROL ROUTINES }
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
{---------------------------------------------------------------------------}
{ SetWriteMode -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 05Dec2000 LdB }
{---------------------------------------------------------------------------}
PROCEDURE SetWriteMode (Mode: Byte; TextMode: Boolean);
BEGIN
{$IFDEF GRAPH_API} { GRAPH CODE }
If TextMode Then
WriteMode := Mode { Hold write mode }
Else Graph.SetWriteMode(Mode); { Call graph proc }
{$ELSE not GRAPH_API}
WriteMode := Mode; { Hold write mode }
{$ENDIF not GRAPH_API}
END;
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
{ VIEW PORT CONTROL ROUTINES }
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
{---------------------------------------------------------------------------}
{ GetViewSettings -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 05Dec2000 LdB }
{---------------------------------------------------------------------------}
PROCEDURE GetViewSettings (Var CurrentViewPort: ViewPortType; TextMode: Boolean);
{$IFDEF GRAPH_API}
VAR Ts: Graph.ViewPortType;
{$ENDIF GRAPH_API}
BEGIN
{$IFNDEF GRAPH_API}
CurrentViewPort := ViewPort; { Textmode viewport }
{$ELSE GRAPH_API}
If TextMode Then CurrentViewPort := ViewPort { Textmode viewport }
Else Begin
Graph.GetViewSettings(Ts); { Get graph settings }
CurrentViewPort.X1 := Ts.X1; { Transfer X1 }
CurrentViewPort.Y1 := Ts.Y1; { Transfer Y1 }
CurrentViewPort.X2 := Ts.X2; { Transfer X2 }
CurrentViewPort.Y2 := Ts.Y2; { Transfer Y2 }
CurrentViewPort.Clip := Ts.Clip; { Transfer clip mask }
End;
{$ENDIF GRAPH_API}
END;
{---------------------------------------------------------------------------}
{ SetViewPort -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 05Dec2000 LdB }
{---------------------------------------------------------------------------}
PROCEDURE SetViewPort (X1, Y1, X2, Y2: Integer; Clip, TextMode: Boolean);
BEGIN
{$IFDEF GRAPH_API}
If TextMode Then Begin { TEXT MODE GFV }
{$ENDIF GRAPH_API}
If (X1 < 0) Then X1 := 0; { X1 negative fix }
If (X1 >SysScreenWidth) Then
X1 := SysScreenWidth; { X1 off screen fix }
If (Y1 < 0) Then Y1 := 0; { Y1 negative fix }
If (Y1 > SysScreenHeight) Then
Y1 := SysScreenHeight; { Y1 off screen fix }
If (X2 < 0) Then X2 := 0; { X2 negative fix }
If (X2 > SysScreenWidth) Then
X2 := SysScreenWidth; { X2 off screen fix }
If (Y2 < 0) Then Y2 := 0; { Y2 negative fix }
If (Y2 > SysScreenHeight) Then
Y2 := SysScreenHeight; { Y2 off screen fix }
ViewPort.X1 := X1; { Set X1 port value }
ViewPort.Y1 := Y1; { Set Y1 port value }
ViewPort.X2 := X2; { Set X2 port value }
ViewPort.Y2 := Y2; { Set Y2 port value }
ViewPort.Clip := Clip; { Set port clip value }
{$ifdef DEBUG}
If WriteDebugInfo then
Writeln(stderr,'New ViewPort(',X1,',',Y1,',',X2,',',Y2,')');
{$endif DEBUG}
Cxp := X1; { Set current x pos }
Cyp := Y1; { Set current y pos }
{$IFDEF GRAPH_API}
End Else Begin { GRAPHICS MODE GFV }
Graph.SetViewPort(X1, Y1, X2, Y2, Clip); { Call graph proc }
X1:=X1 div SysFontWidth;
X2:=X2 div SysFontWidth;
Y1:=Y1 div SysFontHeight;
Y2:=Y2 div SysFontHeight;
If (X1 < 0) Then X1 := 0; { X1 negative fix }
If (X1 >SysScreenWidth) Then
X1 := SysScreenWidth; { X1 off screen fix }
If (Y1 < 0) Then Y1 := 0; { Y1 negative fix }
If (Y1 > SysScreenHeight) Then
Y1 := SysScreenHeight; { Y1 off screen fix }
If (X2 < 0) Then X2 := 0; { X2 negative fix }
If (X2 > SysScreenWidth) Then
X2 := SysScreenWidth; { X2 off screen fix }
If (Y2 < 0) Then Y2 := 0; { Y2 negative fix }
If (Y2 > SysScreenHeight) Then
Y2 := SysScreenHeight; { Y2 off screen fix }
ViewPort.X1 := X1; { Set X1 port value }
ViewPort.Y1 := Y1; { Set Y1 port value }
ViewPort.X2 := X2; { Set X2 port value }
ViewPort.Y2 := Y2; { Set Y2 port value }
ViewPort.Clip := Clip; { Set port clip value }
Cxp := X1; { Set current x pos }
Cyp := Y1; { Set current y pos }
End;
{$ENDIF GRAPH_API}
END;
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
{ GRAPHICS DEVICE CAPACITY ROUTINES }
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
{---------------------------------------------------------------------------}
{ GetMaxX - Platforms DOS/DPMI/WIN/NT/OS2 - Updated 05Dec2000 LdB }
{---------------------------------------------------------------------------}
FUNCTION GetMaxX (TextMode: Boolean): Integer;
BEGIN
{$IFDEF GRAPH_API}
If TextMode Then
{$ENDIF GRAPH_API}
GetMaxX := SysScreenWidth-1 { Screen width }
{$IFDEF GRAPH_API}
Else GetMaxX := Graph.GetMaxX; { Call graph func }
{$ENDIF GRAPH_API}
END;
{---------------------------------------------------------------------------}
{ GetMaxY - Platforms DOS/DPMI/WIN/NT/OS2 - Updated 05Dec2000 LdB }
{---------------------------------------------------------------------------}
FUNCTION GetMaxY (TextMode: Boolean): Integer;
BEGIN
{$IFDEF GRAPH_API}
If TextMode Then
{$ENDIF GRAPH_API}
GetMaxY := SysScreenHeight-1 { Screen height }
{$IFDEF GRAPH_API}
Else GetMaxY := Graph.GetMaxY; { Call graph func }
{$ENDIF GRAPH_API}
END;
PROCEDURE SetColor(Color: Word);
BEGIN
{$IFDEF GRAPH_API}
Graph.SetColor(Color); { Call graph proc }
{$ENDIF GRAPH_API}
END;
PROCEDURE SetFillStyle (Pattern: Word; Color: Word);
BEGIN
{$IFDEF GRAPH_API}
Graph.SetFillStyle(Pattern, Color); { Call graph proc }
{$ENDIF GRAPH_API}
END;
PROCEDURE Bar (X1, Y1, X2, Y2: Integer);
BEGIN
{$IFDEF GRAPH_API}
Graph.Bar(X1, Y1, X2, Y2); { Call graph proc }
{$ENDIF GRAPH_API}
END;
PROCEDURE Line(X1, Y1, X2, Y2: Integer);
BEGIN
{$IFDEF GRAPH_API}
Graph.Line(X1, Y1, X2, Y2); { Call graph proc }
{$ENDIF GRAPH_API}
END;
PROCEDURE Rectangle(X1, Y1, X2, Y2: Integer);
BEGIN
{$IFDEF GRAPH_API}
Graph.Rectangle(X1, Y1, X2, Y2); { Call graph proc }
{$ENDIF GRAPH_API}
END;
PROCEDURE OutTextXY(X,Y: Integer; TextString: string);
{$IFDEF GRAPH_API}
var
i,j,xi,yj,xs,ys : longint;
Ts: Graph.ViewPortType;
Txs : TextSettingsType;
tw, th : integer;
color : word;
{$ENDIF GRAPH_API}
BEGIN
{$IFDEF GRAPH_API}
Graph.OutTextXY(X, Y, TextString); { Call graph proc }
if true then
begin
Graph.GetViewSettings(Ts);
Graph.GetTextSettings(Txs);
tw:=TextWidth(TextString);
th:=TextHeight(TextString);
case Txs.Horiz of
centertext : Xs:=(tw shr 1);
lefttext : Xs:=0;
righttext : Xs:=tw;
end;
case txs.vert of
centertext : Ys:=-(th shr 1);
bottomtext : Ys:=-th;
toptext : Ys:=0;
end;
x:=x-xs;
y:=y+ys;
For j:=0 to tw-1 do
For i:=0 to th-1 do
begin
xi:=x+i+Ts.x1;
yj:=y+j+Ts.y1;
Color:=GetPixel(xi,yj);
SetExtraInfo(xi div SysFontWidth,yj div SysFontHeight,
xi mod SysFontWidth,yj mod SysFontHeight, Color);
end;
end;
{$ENDIF GRAPH_API}
END;
{$IFDEF GRAPH_API}
{ from video unit }
Const
CursorX : longint = -1;
CursorY : longint = -1;
CursorType : byte = crHidden;
CursorIsVisible : boolean = false;
LineReversed = true;
LineNormal = false;
TYPE
TCursorInfo = array[0..7] of boolean;
CONST
DefaultCursors: Array[crUnderline..crHalfBlock] of TCursorInfo =
(
(LineNormal, LineNormal, LineNormal, LineNormal, LineNormal, LineNormal, LineNormal, LineReversed),
(LineReversed, LineReversed, LineReversed, LineReversed, LineReversed, LineReversed, LineReversed, LineReversed),
(LineNormal, LineNormal, LineNormal, LineNormal, LineReversed, LineReversed, LineReversed, LineReversed)
);
Procedure XorPutCursor;
var
j,YSCale : longint;
Ts: Graph.ViewPortType;
StoreColor : longint;
begin
if CursorType=crHidden then
exit;
Yscale:=(SysFontHeight+1) div 8;
Graph.GetViewSettings(Ts);
graph.SetWriteMode(graph.XORPut);
StoreColor:=Graph.GetColor;
Graph.SetColor(White);
if (CursorX*SysFontWidth>=Ts.X1) and (CursorX*SysFontWidth<Ts.X2) and
(CursorY*SysFontHeight>=Ts.Y1) and (CursorY*SysFontHeight<Ts.Y2) then
for j:=0 to SysFontHeight-1 do
begin
if DefaultCursors[CursorType][(j*8) div SysFontHeight] then
begin
Graph.MoveTo(CursorX*SysFontWidth-Ts.X1,CursorY*SysFontHeight+j-Ts.Y1);
Graph.LineRel(SysFontWidth-1,0);
end;
end;
Graph.SetColor(StoreColor);
graph.SetWriteMode(graph.CopyPut);
end;
Procedure HideCursor;
begin
If CursorIsVisible then
begin
XorPutCursor;
CursorIsVisible:=false;
end;
end;
Procedure ShowCursor;
begin
If not CursorIsVisible then
begin
XorPutCursor;
CursorIsVisible:=true;
end;
end;
{ Position the cursor to the given position }
procedure SetCursorPos(NewCursorX, NewCursorY: Word);
begin
HideCursor;
CursorX:=NewCursorX;
CursorY:=NewCursorY;
ShowCursor;
end;
{ Return the cursor type: Hidden, UnderLine or Block }
function GetCursorType: Word;
begin
GetCursorType:=CursorType;
end;
{ Set the cursor to the given type }
procedure SetCursorType(NewType: Word);
begin
HideCursor;
CursorType:=NewType;
ShowCursor;
end;
const
SetExtraInfoCalled : boolean = false;
procedure SetExtraInfo(x,y,xi,yi : longint; color : word);
var
i,k,l : longint;
extrainfo : pextrainfo;
begin
i:=y*TextScreenWidth+x;
if not assigned(SpVideoBuf^[i]) or (SpVideoBuf^[i]=EmptyVideoBufCell) then
begin
GetMem(SpVideoBuf^[i],SysFontHeight*SysFontWidth*Sizeof(word));
FillChar(SpVideoBuf^[i]^,SysFontHeight*SysFontWidth*Sizeof(word),#255);
end;
extrainfo:=SpVideoBuf^[i];
l:=yi*SysFontWidth + xi;
if l>=SysFontHeight*SysFontWidth then
RunError(219);
extrainfo^[l]:=color;
SetExtraInfoCalled:=true;
end;
procedure SetupExtraInfo;
begin
if not assigned(EmptyVideoBufCell) then
begin
GetMem(EmptyVideoBufCell,SysFontHeight*SysFontWidth*Sizeof(word));
FillChar(EmptyVideoBufCell^,SysFontHeight*SysFontWidth*Sizeof(word),#255);
end;
end;
procedure FreeExtraInfo;
var
i : longint;
begin
HideCursor;
if assigned(SpVideoBuf) then
begin
for i:=0 to (TextScreenWidth+1)*(TextScreenHeight+1) - 1 do
if assigned(SpVideoBuf^[i]) and (SpVideoBuf^[i]<>EmptyVideoBufCell) then
FreeMem(SpVideoBuf^[i],SysFontHeight*SysFontWidth*Sizeof(word));
if assigned(EmptyVideoBufCell) then
FreeMem(EmptyVideoBufCell,SysFontHeight*SysFontWidth*Sizeof(word));
FreeMem(SpVideoBuf,sizeof(pextrainfo)*(TextScreenWidth+1)*(TextScreenHeight+1));
SpVideoBuf:=nil;
end;
end;
{define Use_ONLY_COLOR}
procedure GraphUpdateScreen(Force: Boolean);
var
smallforce : boolean;
i,x,y : longint;
xi,yi,k,l : longint;
ch : char;
attr : byte;
color : word;
SavedColor : longint;
{$ifndef Use_ONLY_COLOR}
SavedBkColor,CurBkColor : longint;
{$endif not Use_ONLY_COLOR}
CurColor : longint;
NextColor,NextBkColor : longint;
StoreFillSettings: FillSettingsType;
Ts: Graph.ViewPortType;
{$ifdef debug}
ChangedCount, SpecialCount : longint;
{$endif debug}
begin
{$ifdef USE_VIDEO_API}
if force or SetExtraInfoCalled then
smallforce:=true
else
begin
asm
movl VideoBuf,%esi
movl OldVideoBuf,%edi
movl VideoBufSize,%ecx
shrl $2,%ecx
repe
cmpsl
orl %ecx,%ecx
jz .Lno_update
movb $1,smallforce
.Lno_update:
end;
end;
if SmallForce then
begin
{$ifdef debug}
SpecialCount:=0;
ChangedCount:=0;
{$endif debug}
SetExtraInfoCalled:=false;
SavedColor:=Graph.GetColor;
{$ifndef Use_ONLY_COLOR}
SavedBkColor:=Graph.GetBkColor;
CurBkColor:=SavedBkColor;
{$endif not Use_ONLY_COLOR}
CurColor:=SavedColor;
Graph.GetViewSettings(Ts);
Graph.SetViewPort(0,0,Graph.GetMaxX,Graph.GetMaxY,false);
Graph.GetFillSettings(StoreFillSettings);
{$ifdef Use_ONLY_COLOR}
Graph.SetFillStyle(SolidFill,0);
{$else not Use_ONLY_COLOR}
Graph.SetFillStyle(EmptyFill,0);
{$endif not Use_ONLY_COLOR}
Graph.SetWriteMode(CopyPut);
Graph.SetTextJustify(LeftText,TopText);
for y := 0 to TextScreenHeight - 1 do
begin
for x := 0 to TextScreenWidth - 1 do
begin
i:=y*TextScreenWidth+x;
if (OldVideoBuf^[i]<>VideoBuf^[i]) or
(assigned(SpVideoBuf^[i]) and (SpVideoBuf^[i]<>EmptyVideoBufCell)) then
begin
ch:=chr(VideoBuf^[i] and $ff);
if ch<>#0 then
begin
{$ifdef debug}
Inc(ChangedCount);
{$endif debug}
if (SpVideoBuf^[i]=EmptyVideoBufCell) then
SpVideoBuf^[i]:=nil;
Attr:=VideoBuf^[i] shr 8;
NextColor:=Attr and $f;
NextBkColor:=(Attr and $70) shr 4;
{$ifndef Use_ONLY_COLOR}
if NextBkColor<>CurBkColor then
begin
Graph.SetBkColor(NextBkColor);
CurBkColor:=NextBkColor;
end;
{$else Use_ONLY_COLOR}
if NextBkColor<>CurColor then
begin
Graph.SetColor(NextBkColor);
CurColor:=NextBkColor;
end;
{$endif Use_ONLY_COLOR}
if (x=CursorX) and (y=CursorY) then
HideCursor;
Graph.Bar(x*SysFontWidth,y*SysFontHeight,(x+1)*SysFontWidth-1,(y+1)*SysFontHeight-1);
if assigned(SpVideoBuf^[i]) then
begin
{$ifdef debug}
Inc(SpecialCount);
{$endif debug}
For yi:=0 to SysFontHeight-1 do
For xi:=0 to SysFontWidth-1 do
begin
l:=yi*SysFontWidth + xi;
color:=SpVideoBuf^[i]^[l];
if color<>$ffff then
Graph.PutPixel(x*SysfontWidth+xi,y*SysFontHeight+yi,color);
end;
end;
if NextColor<>CurColor then
begin
Graph.SetColor(NextColor);
CurColor:=NextColor;
end;
{ SetBkColor does change the palette index 0 entry...
which leads to troubles if we want to write in dark }
(* if (CurColor=0) and (ch<>' ') and assigned(SpVideoBuf^[i]) then
begin
Graph.SetBkColor(0);
CurBkColor:=0;
end; *)
if ch<>' ' then
Graph.OutTextXY(x*SysFontWidth,y*SysFontHeight+2,ch);
if (x=CursorX) and (y=CursorY) then
ShowCursor;
end;
OldVideoBuf^[i]:=VideoBuf^[i];
if assigned(SpVideoBuf^[i]) then
begin
if (SpVideoBuf^[i]=EmptyVideoBufCell) then
SpVideoBuf^[i]:=nil
else
begin
FreeMem(SpVideoBuf^[i],SysFontHeight*SysFontWidth*sizeof(word));
SpVideoBuf^[i]:=EmptyVideoBufCell;
end;
end;
end;
end;
end;
Graph.SetFillStyle(StoreFillSettings.pattern,StoreFillSettings.color);
Graph.SetColor(SavedColor);
{$ifndef Use_ONLY_COLOR}
Graph.SetBkColor(SavedBkColor);
{$endif not Use_ONLY_COLOR}
Graph.SetViewPort(TS.X1,Ts.Y1,ts.X2,ts.Y2,ts.Clip);
end;
{$else not USE_VIDEO_API}
RunError(219);
{$endif USE_VIDEO_API}
end;
{$ENDIF GRAPH_API}
END.
{
$Log$
Revision 1.18 2002-09-07 15:06:36 peter
* old logs removed and tabs fixed
Revision 1.17 2002/08/22 13:40:49 pierre
* several graphic mode improovements
Revision 1.16 2002/06/06 06:41:14 pierre
+ Cursor functions for UseFixedFont case
Revision 1.15 2002/05/31 12:37:47 pierre
* try to enhance graph mode
Revision 1.14 2002/05/29 22:15:57 pierre
* fix build failure in non graph mode
Revision 1.13 2002/05/29 19:35:31 pierre
* fix GraphUpdateScreen procedure
Revision 1.12 2002/05/28 19:42:32 pierre
* fix non graphic mode compilation
Revision 1.11 2002/05/28 19:13:44 pierre
+ GraphUpdateScreen function
}
Reference in New Issue View Git Blame Copy Permalink