paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-18 20:49:19 +02:00
Code Issues Packages Projects Releases Wiki Activity

* implemented SetBkColor and GetBkColor for CGA

Browse Source 
git-svn-id: trunk@15987 -
This commit is contained in:
nickysn 2010-09-14 23:02:20 +00:00
parent 4f754e4a68
commit 239cf4cea4
1 changed files with 57 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

58
packages/graph/src/go32v2/graph.pp
View File

@ -532,6 +532,8 @@ end;
{************************************************************************} {************************************************************************}
{* 320x200x4 CGA mode routines *} {* 320x200x4 CGA mode routines *}
{************************************************************************} {************************************************************************}
var
CurrentCGABorder: Word;
procedure SetCGAPalette(CGAPaletteID: Byte); assembler; procedure SetCGAPalette(CGAPaletteID: Byte); assembler;
asm asm
@ -556,7 +558,7 @@ asm
{$endif fpc} {$endif fpc}
end; end;
procedure SetCGABorder(CGAPaletteID: Byte); assembler; procedure SetCGABorder(CGABorder: Byte); assembler;
asm asm
{$IFNDEF REGCALL} {$IFNDEF REGCALL}
mov ax,val_ax mov ax,val_ax
@ -579,6 +581,19 @@ asm
{$endif fpc} {$endif fpc}
end; end;
procedure SetBkColorCGA320(ColorNum: Word);
begin
if ColorNum > 15 then
exit;
CurrentCGABorder := (CurrentCGABorder and 16) or ColorNum;
SetCGABorder(CurrentCGABorder);
end;
function GetBkColorCGA320: Word;
begin
GetBkColorCGA320 := CurrentCGABorder and 15;
end;
procedure InitCGA320C0; procedure InitCGA320C0;
begin begin
if DontClearGraphMemory then if DontClearGraphMemory then
@ -587,6 +602,7 @@ begin
CallInt10($04); CallInt10($04);
SetCGAPalette(0); SetCGAPalette(0);
SetCGABorder(16); SetCGABorder(16);
CurrentCGABorder := 16;
end; end;
procedure InitCGA320C1; procedure InitCGA320C1;
@ -597,6 +613,7 @@ begin
CallInt10($04); CallInt10($04);
SetCGAPalette(1); SetCGAPalette(1);
SetCGABorder(16); SetCGABorder(16);
CurrentCGABorder := 16;
end; end;
procedure InitCGA320C2; procedure InitCGA320C2;
@ -607,6 +624,7 @@ begin
CallInt10($04); CallInt10($04);
SetCGAPalette(2); SetCGAPalette(2);
SetCGABorder(0); SetCGABorder(0);
CurrentCGABorder := 0;
end; end;
procedure InitCGA320C3; procedure InitCGA320C3;
@ -617,6 +635,7 @@ begin
CallInt10($04); CallInt10($04);
SetCGAPalette(3); SetCGAPalette(3);
SetCGABorder(0); SetCGABorder(0);
CurrentCGABorder := 0;
end; end;
procedure PutPixelCGA320(X, Y: SmallInt; Pixel: Word); {$ifndef fpc}far;{$endif fpc} procedure PutPixelCGA320(X, Y: SmallInt; Pixel: Word); {$ifndef fpc}far;{$endif fpc}
@ -910,6 +929,23 @@ begin
CallInt10($86) CallInt10($86)
else else
CallInt10($06); CallInt10($06);
CurrentCGABorder := 0; {yes, TP7 CGA.BGI behaves *exactly* like that}
end;
{yes, TP7 CGA.BGI behaves *exactly* like that}
procedure SetBkColorCGA640(ColorNum: Word);
begin
if ColorNum > 15 then
exit;
CurrentCGABorder := ColorNum;
if ColorNum = 0 then
exit;
SetCGABorder(CurrentCGABorder);
end;
function GetBkColorCGA640: Word;
begin
GetBkColorCGA640 := CurrentCGABorder and 15;
end; end;
procedure PutPixelCGA640(X, Y: SmallInt; Pixel: Word); {$ifndef fpc}far;{$endif fpc} procedure PutPixelCGA640(X, Y: SmallInt; Pixel: Word); {$ifndef fpc}far;{$endif fpc}
@ -3583,6 +3619,8 @@ const CrtAddress: word = 0;
mode.SetActivePage := {$ifdef fpc}@{$endif}SetActive320; mode.SetActivePage := {$ifdef fpc}@{$endif}SetActive320;
mode.InitMode := {$ifdef fpc}@{$endif}InitCGA320C0; mode.InitMode := {$ifdef fpc}@{$endif}InitCGA320C0;
mode.HLine := {$ifdef fpc}@{$endif}HLineCGA320; mode.HLine := {$ifdef fpc}@{$endif}HLineCGA320;
mode.SetBkColor := {$ifdef fpc}@{$endif}SetBkColorCGA320;
mode.GetBkColor := {$ifdef fpc}@{$endif}GetBkColorCGA320;
mode.XAspect := 8333; mode.XAspect := 8333;
mode.YAspect := 10000; mode.YAspect := 10000;
AddMode(mode); AddMode(mode);
@ -3607,6 +3645,8 @@ const CrtAddress: word = 0;
mode.SetActivePage := {$ifdef fpc}@{$endif}SetActive320; mode.SetActivePage := {$ifdef fpc}@{$endif}SetActive320;
mode.InitMode := {$ifdef fpc}@{$endif}InitCGA320C1; mode.InitMode := {$ifdef fpc}@{$endif}InitCGA320C1;
mode.HLine := {$ifdef fpc}@{$endif}HLineCGA320; mode.HLine := {$ifdef fpc}@{$endif}HLineCGA320;
mode.SetBkColor := {$ifdef fpc}@{$endif}SetBkColorCGA320;
mode.GetBkColor := {$ifdef fpc}@{$endif}GetBkColorCGA320;
mode.XAspect := 8333; mode.XAspect := 8333;
mode.YAspect := 10000; mode.YAspect := 10000;
AddMode(mode); AddMode(mode);
@ -3631,6 +3671,8 @@ const CrtAddress: word = 0;
mode.SetActivePage := {$ifdef fpc}@{$endif}SetActive320; mode.SetActivePage := {$ifdef fpc}@{$endif}SetActive320;
mode.InitMode := {$ifdef fpc}@{$endif}InitCGA320C2; mode.InitMode := {$ifdef fpc}@{$endif}InitCGA320C2;
mode.HLine := {$ifdef fpc}@{$endif}HLineCGA320; mode.HLine := {$ifdef fpc}@{$endif}HLineCGA320;
mode.SetBkColor := {$ifdef fpc}@{$endif}SetBkColorCGA320;
mode.GetBkColor := {$ifdef fpc}@{$endif}GetBkColorCGA320;
mode.XAspect := 8333; mode.XAspect := 8333;
mode.YAspect := 10000; mode.YAspect := 10000;
AddMode(mode); AddMode(mode);
@ -3655,6 +3697,8 @@ const CrtAddress: word = 0;
mode.SetActivePage := {$ifdef fpc}@{$endif}SetActive320; mode.SetActivePage := {$ifdef fpc}@{$endif}SetActive320;
mode.InitMode := {$ifdef fpc}@{$endif}InitCGA320C3; mode.InitMode := {$ifdef fpc}@{$endif}InitCGA320C3;
mode.HLine := {$ifdef fpc}@{$endif}HLineCGA320; mode.HLine := {$ifdef fpc}@{$endif}HLineCGA320;
mode.SetBkColor := {$ifdef fpc}@{$endif}SetBkColorCGA320;
mode.GetBkColor := {$ifdef fpc}@{$endif}GetBkColorCGA320;
mode.XAspect := 8333; mode.XAspect := 8333;
mode.YAspect := 10000; mode.YAspect := 10000;
AddMode(mode); AddMode(mode);
@ -3679,6 +3723,8 @@ const CrtAddress: word = 0;
mode.SetActivePage := {$ifdef fpc}@{$endif}SetActive320; mode.SetActivePage := {$ifdef fpc}@{$endif}SetActive320;
mode.InitMode := {$ifdef fpc}@{$endif}InitCGA640; mode.InitMode := {$ifdef fpc}@{$endif}InitCGA640;
mode.HLine := {$ifdef fpc}@{$endif}HLineCGA640; mode.HLine := {$ifdef fpc}@{$endif}HLineCGA640;
mode.SetBkColor := {$ifdef fpc}@{$endif}SetBkColorCGA640;
mode.GetBkColor := {$ifdef fpc}@{$endif}GetBkColorCGA640;
mode.XAspect := 4167; mode.XAspect := 4167;
mode.YAspect := 10000; mode.YAspect := 10000;
AddMode(mode); AddMode(mode);
@ -3782,6 +3828,8 @@ const CrtAddress: word = 0;
mode.SetActivePage := {$ifdef fpc}@{$endif}SetActive320; mode.SetActivePage := {$ifdef fpc}@{$endif}SetActive320;
mode.InitMode := {$ifdef fpc}@{$endif}InitCGA320C0; mode.InitMode := {$ifdef fpc}@{$endif}InitCGA320C0;
mode.HLine := {$ifdef fpc}@{$endif}HLineCGA320; mode.HLine := {$ifdef fpc}@{$endif}HLineCGA320;
mode.SetBkColor := {$ifdef fpc}@{$endif}SetBkColorCGA320;
mode.GetBkColor := {$ifdef fpc}@{$endif}GetBkColorCGA320;
mode.XAspect := 8333; mode.XAspect := 8333;
mode.YAspect := 10000; mode.YAspect := 10000;
AddMode(mode); AddMode(mode);
@ -3806,6 +3854,8 @@ const CrtAddress: word = 0;
mode.SetActivePage := {$ifdef fpc}@{$endif}SetActive320; mode.SetActivePage := {$ifdef fpc}@{$endif}SetActive320;
mode.InitMode := {$ifdef fpc}@{$endif}InitCGA320C1; mode.InitMode := {$ifdef fpc}@{$endif}InitCGA320C1;
mode.HLine := {$ifdef fpc}@{$endif}HLineCGA320; mode.HLine := {$ifdef fpc}@{$endif}HLineCGA320;
mode.SetBkColor := {$ifdef fpc}@{$endif}SetBkColorCGA320;
mode.GetBkColor := {$ifdef fpc}@{$endif}GetBkColorCGA320;
mode.XAspect := 8333; mode.XAspect := 8333;
mode.YAspect := 10000; mode.YAspect := 10000;
AddMode(mode); AddMode(mode);
@ -3830,6 +3880,8 @@ const CrtAddress: word = 0;
mode.SetActivePage := {$ifdef fpc}@{$endif}SetActive320; mode.SetActivePage := {$ifdef fpc}@{$endif}SetActive320;
mode.InitMode := {$ifdef fpc}@{$endif}InitCGA320C2; mode.InitMode := {$ifdef fpc}@{$endif}InitCGA320C2;
mode.HLine := {$ifdef fpc}@{$endif}HLineCGA320; mode.HLine := {$ifdef fpc}@{$endif}HLineCGA320;
mode.SetBkColor := {$ifdef fpc}@{$endif}SetBkColorCGA320;
mode.GetBkColor := {$ifdef fpc}@{$endif}GetBkColorCGA320;
mode.XAspect := 8333; mode.XAspect := 8333;
mode.YAspect := 10000; mode.YAspect := 10000;
AddMode(mode); AddMode(mode);
@ -3854,6 +3906,8 @@ const CrtAddress: word = 0;
mode.SetActivePage := {$ifdef fpc}@{$endif}SetActive320; mode.SetActivePage := {$ifdef fpc}@{$endif}SetActive320;
mode.InitMode := {$ifdef fpc}@{$endif}InitCGA320C3; mode.InitMode := {$ifdef fpc}@{$endif}InitCGA320C3;
mode.HLine := {$ifdef fpc}@{$endif}HLineCGA320; mode.HLine := {$ifdef fpc}@{$endif}HLineCGA320;
mode.SetBkColor := {$ifdef fpc}@{$endif}SetBkColorCGA320;
mode.GetBkColor := {$ifdef fpc}@{$endif}GetBkColorCGA320;
mode.XAspect := 8333; mode.XAspect := 8333;
mode.YAspect := 10000; mode.YAspect := 10000;
AddMode(mode); AddMode(mode);
@ -3878,6 +3932,8 @@ const CrtAddress: word = 0;
mode.SetActivePage := {$ifdef fpc}@{$endif}SetActive320; mode.SetActivePage := {$ifdef fpc}@{$endif}SetActive320;
mode.InitMode := {$ifdef fpc}@{$endif}InitCGA640; mode.InitMode := {$ifdef fpc}@{$endif}InitCGA640;
mode.HLine := {$ifdef fpc}@{$endif}HLineCGA640; mode.HLine := {$ifdef fpc}@{$endif}HLineCGA640;
mode.SetBkColor := {$ifdef fpc}@{$endif}SetBkColorCGA640;
mode.GetBkColor := {$ifdef fpc}@{$endif}GetBkColorCGA640;
mode.XAspect := 4167; mode.XAspect := 4167;
mode.YAspect := 10000; mode.YAspect := 10000;
AddMode(mode); AddMode(mode);