paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-17 04:39:34 +02:00
Code Issues Packages Projects Releases Wiki Activity

rtl-console/amicommon/video: instead of disabling it for AROS, decide runtime based on the allocated bitmap's attributes, which rendering mode to use

Browse Source 
git-svn-id: trunk@31143 -
This commit is contained in:
Károly Balogh 2015-06-22 00:37:54 +00:00
parent 5f5b1ed607
commit 37af6b227d
1 changed files with 29 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

49
packages/rtl-console/src/amicommon/video.pp
View File

@ -96,9 +96,7 @@ var
WindowForReqSave: PWindow; WindowForReqSave: PWindow;
Process: PProcess; Process: PProcess;
{$IFNDEF AROS}
FontBitmap: PBitmap; FontBitmap: PBitmap;
{$ENDIF}
(* (*
GetScreen: pScreen; GetScreen: pScreen;
@ -227,6 +225,7 @@ var
Counter, Counter,
Counter2: LongInt; Counter2: LongInt;
P: PWord; P: PWord;
flags: DWord;
begin begin
{$IFDEF MORPHOS} {$IFDEF MORPHOS}
InitGraphicsLibrary; InitGraphicsLibrary;
@ -293,26 +292,39 @@ begin
{$endif} {$endif}
end; end;
{$IFNDEF AROS}
{ Obtain Friend bitmap for font blitting } { Obtain Friend bitmap for font blitting }
FontBitmap:=AllocBitMap(16,16*256,1,0,VideoWindow^.RPort^.Bitmap); FontBitmap:=AllocBitMap(16,16*256,1,0,VideoWindow^.RPort^.Bitmap);
{ We need to make the data word wide, otherwise the blit will fail if (FontBitmap <> nil) then
miserably on classics (tested on 3.1 + AGA) }
if FontBitmap <> nil then
begin begin
{ Locking the bitmap would be better, but that requires CGFX/P96/etc specific calls } flags:=GetBitmapAttr(FontBitmap,BMA_FLAGS);
Forbid(); if (Flags and BMF_STANDARD) > 0 then
p:=PWord(FontBitmap^.Planes[0]); begin
for counter:=0 to 255 do {$ifdef VIDEODEBUG}
for counter2:=0 to 15 do writeln('Using fontbitmap mode.');
{$endif}
{ Locking the bitmap would be better, but that requires CGFX/P96/etc specific calls }
Forbid();
{ We need to make the data word wide, otherwise the blit will fail
miserably on classics (tested on 3.1 + AGA) }
p:=PWord(FontBitmap^.Planes[0]);
for counter:=0 to 255 do
for counter2:=0 to 15 do
begin begin
p^:=vgafont[counter,counter2] shl 8; p^:=vgafont[counter,counter2] shl 8;
inc(p); inc(p);
end; end;
Permit(); Permit();
end
else
begin
{$ifdef VIDEODEBUG}
writeln('Using direct-from-fontdata mode.');
{$endif}
FreeBitmap(FontBitmap);
FontBitmap:=nil;
end;
end; end;
{$ENDIF}
CursorX := 0; CursorX := 0;
CursorY := 0; CursorY := 0;
@ -356,9 +368,7 @@ begin
VideoWindow := nil; VideoWindow := nil;
end; end;
{$IFNDEF AROS}
FreeBitMap(FontBitmap); FreeBitMap(FontBitmap);
{$ENDIF}
{$ifdef WITHBUFFERING} {$ifdef WITHBUFFERING}
FreeBitmap(BufRp^.Bitmap); FreeBitmap(BufRp^.Bitmap);
@ -439,11 +449,10 @@ begin
SetABPenDrMd(rp, VideoPens[tmpBGColor], VideoPens[tmpFGColor], JAM2); SetABPenDrMd(rp, VideoPens[tmpBGColor], VideoPens[tmpFGColor], JAM2);
end; end;
{$IFNDEF AROS} if FontBitmap <> nil then
BltTemplate(@(PWord(FontBitmap^.Planes[0])[tmpChar * 16]), 0, 2, rp, sX, sY, 8, 16); BltTemplate(@(PWord(FontBitmap^.Planes[0])[tmpChar * 16]), 0, 2, rp, sX, sY, 8, 16)
{$ELSE} else
BltTemplate(@Vgafont[tmpChar, 0], 0, 1, rp, sX, sY, 8, 16); BltTemplate(@Vgafont[tmpChar, 0], 0, 1, rp, sX, sY, 8, 16);
{$ENDIF}
if crType = crUnderLine then if crType = crUnderLine then
begin begin