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

* pieslice and sector work now !!

Browse Source 
* bugs in text writing removed
  + scaling for defaultfont added
  + VertDir for default font added
  * RestoreCRTMode corrected
This commit is contained in:
pierre 1998-11-23 10:04:16 +00:00
parent 6b79dfe801
commit ae4500f112
4 changed files with 95 additions and 29 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

45
rtl/dos/graph.pp
View File

@ -262,6 +262,11 @@ var { X/Y Verhaeltnis des Bildschirm }
aktscreen : ViewPortType;
{ der Graphikmodus, der beim Start gesetzt war }
startmode : byte;
{ mode before RestoreCRTMode was called
used by getGraphMode PM }
oldCRTMode : integer;
InTempCRTMode : boolean;
{ Position des Graphikcursors }
curx,cury : longint;
{ true, wenn die Routinen des Graphikpaketes verwendet werden d<>rfen }
@ -381,18 +386,19 @@ begin
asm
cli
movw $0x03Da,%dx
WaitNotHSyncLoop:
.LWaitNotHSyncLoop:
inb %dx,%al
testb $0x8,%al
jnz WaitNotHSyncLoop
WaitHSyncLoop:
jnz .LWaitNotHSyncLoop
.LWaitHSyncLoop:
inb %dx,%al
testb $0x8,%al
jz WaitHSyncLoop
jz .LWaitHSyncLoop
sti
end;
end;
(* Unused, commented 20/11/98 PM
procedure getmem(var p : pointer;size : longint);
begin
asm
@ -411,7 +417,7 @@ begin
movl _GRAPHFREEMEMPTR,%eax
call %eax
end;
end;
end; *)
{$I COLORS.PPI}
@ -432,8 +438,8 @@ procedure graphdefaults;
{ std colors }
setstdcolors;
{ Zeichenfarbe }
aktcolor:=convert(white);
aktbackcolor:=convert(black);
setcolor(white);
setbkcolor(black);
{ F<>llmuster }
setfillstyle(solidfill,white);
@ -505,6 +511,11 @@ end;
function GetGraphMode:Integer;
begin
if InTempCRTMode then
begin
GetGraphMode:=oldCRTMode;
exit;
end;
if not isgraphmode then
begin
_graphresult:=grNoInitGraph;
@ -700,7 +711,7 @@ begin
InstallUserFont('EURO');
InstallUserFont('BOLD');
GetVESAInfo(GraphMode);
GetVESAInfo(GraphMode);
{$IFDEF DEBUG}
{$I VESADEB.PPI}
{$ENDIF}
@ -718,6 +729,8 @@ begin
for index:=0 to VESAInfo.YResolution do Y_Array[index]:=index * BytesPerLine;
SetGraphBufSize(bufferstandardsize);
graphdefaults;
InTempCRTMode:=false;
exit;
end;
dec(i);
@ -731,7 +744,7 @@ procedure SetGraphMode(GraphMode:Integer);
var index:Integer;
begin
_graphresult:=grOk;
if not isgraphmode then
if not isgraphmode and not InTempCRTMode then
begin
_graphresult:=grNoInitGraph;
Exit;
@ -748,6 +761,7 @@ begin
for index:=0 to VESAInfo.YResolution do
Y_Array[index]:=index * BytesPerLine;
graphdefaults;
InTempCRTMode:=false;
exit;
end;
end;
@ -905,6 +919,8 @@ begin
_graphresult:=grNoInitGraph;
Exit;
end;
OldCRTMode:=GetGraphMode;
InTempCRTMode:=true;
SetVESAMode(startmode);
isgraphmode:=false;
end;
@ -915,7 +931,7 @@ procedure GraphExit;
begin
ExitProc:=PrevExitProc;
CloseGraph;
DoneVesa; { frees the ldt descriptos seg_read and seg_write !! }
DoneVesa; { frees the ldt descriptors seg_read and seg_write !! }
end;
begin
@ -940,7 +956,14 @@ end.
{
$Log$
Revision 1.11 1998-11-20 18:42:04 pierre
Revision 1.12 1998-11-23 10:04:16 pierre
* pieslice and sector work now !!
* bugs in text writing removed
+ scaling for defaultfont added
+ VertDir for default font added
* RestoreCRTMode corrected
Revision 1.11 1998/11/20 18:42:04 pierre
* many bugs related to floodfill and ellipse fixed
Revision 1.10 1998/11/20 10:16:01 pierre

11
rtl/dos/ppi/arc.ppi
View File

@ -56,7 +56,7 @@
repeat
if (((xp=xe[0]) or (xp=xe[1]) or (xp=xe[2])) and
((yp=ye[0]) or (yp=ye[1]) or (yp=ye[2]))) and
(ofs=endofs) then
((ofs mod 4)=endofs) then
begin
putpixeli(xp,yp,aktcolor);
ready:=true;
@ -156,7 +156,14 @@
{
$Log$
Revision 1.5 1998-11-20 18:42:05 pierre
Revision 1.6 1998-11-23 10:04:17 pierre
* pieslice and sector work now !!
* bugs in text writing removed
+ scaling for defaultfont added
+ VertDir for default font added
* RestoreCRTMode corrected
Revision 1.5 1998/11/20 18:42:05 pierre
* many bugs related to floodfill and ellipse fixed
Revision 1.4 1998/11/19 15:09:35 pierre

11
rtl/dos/ppi/ellipse.ppi
View File

@ -165,7 +165,7 @@
repeat
if (((xp=xe[0]) or (xp=xe[1]) or (xp=xe[2])) and
((yp=ye[0]) or (yp=ye[1]) or (yp=ye[2]))) and
(ofs=endofs) then
((ofs mod 4)=endofs) then
begin
putpixeli(xp,yp,aktcolor);
ready:=true;
@ -280,7 +280,14 @@
{
$Log$
Revision 1.5 1998-11-20 18:42:06 pierre
Revision 1.6 1998-11-23 10:04:18 pierre
* pieslice and sector work now !!
* bugs in text writing removed
+ scaling for defaultfont added
+ VertDir for default font added
* RestoreCRTMode corrected
Revision 1.5 1998/11/20 18:42:06 pierre
* many bugs related to floodfill and ellipse fixed
Revision 1.4 1998/11/19 15:09:36 pierre

57
rtl/dos/ppi/text.ppi
View File

@ -200,7 +200,7 @@
var
b1,b2 : shortint;
c,instr,mask : byte;
i,j,k : longint;
i,j,jj,k,l : longint;
oldvalues : linesettingstype;
nextpos : word;
xpos,ypos,offs: longint;
@ -239,24 +239,46 @@
toptext : YPos:=textwidth(textstring);
end;
end;
X:=X-XPos; Y:=Y+YPos;
X:=X-XPos;
Y:=Y+YPos;
XPos:=X; YPos:=Y;
if akttextinfo.font=DefaultFont then begin
y:=y-6;
c:=textwidth(textstring) div 8 - 1; { Charcounter }
FontPtr:=@defaultfontdata;
for i:=0 to c do begin
offs:=ord(textString[i+1]) shl 3; { Offset des Chars in Data }
if akttextinfo.direction=horizdir then
ypos:=ypos-6*akttextinfo.charsize
{else
xpos:=xpos-6*akttextinfo.charsize};
(* c:=textwidth(textstring) div 8 - 1; { Charcounter }
gave wrong values if charsize<>1 PM *)
c:=length(textstring); { Charcounter }
FontPtr:=@defaultfontdata;
for i:=1 to c do begin
offs:=ord(textString[i]) shl 3; { Offset des Chars in Data }
for j:=0 to 7 do begin
mask:=$80;
b1:=defaultfontdata[offs+j]; { Offset der Charzeile }
xpos:=i shl 3+x;
for k:=0 to 7 do begin
if (b1 and mask) <> 0 then putpixeli(xpos+k,j+y,aktcolor)
b1:=defaultfontdata[offs+j]; { Offset der Charzeile }
jj:=j*akttextinfo.charsize;
if akttextinfo.direction=horizdir then
xpos:=x+((i-1) shl 3)*akttextinfo.charsize
else
ypos:=y-((i-1) shl 3)*akttextinfo.charsize;
for k:=0 to {7}8*akttextinfo.charsize-1 do
begin
if (b1 and mask) <> 0 then
for l:=0 to akttextinfo.charsize-1 do
if akttextinfo.direction=horizdir then
putpixeli(xpos+k,jj+ypos+l,aktcolor)
else
putpixeli(xpos+jj+l,ypos-k,aktcolor)
else if ClearText then
putpixeli(xpos+k,j+y,aktbackcolor);
mask:=mask shr 1;
for l:=0 to akttextinfo.charsize-1 do
if akttextinfo.direction=horizdir then
putpixeli(xpos+k,jj+ypos+l,aktbackcolor)
else
putpixeli(xpos+jj+l,ypos-k,aktbackcolor);
if (k mod akttextinfo.charsize) = akttextinfo.charsize-1 then
mask:=mask shr 1;
end;
end;
end;
@ -461,7 +483,14 @@
{
$Log$
Revision 1.2 1998-11-18 09:31:42 pierre
Revision 1.3 1998-11-23 10:04:19 pierre
* pieslice and sector work now !!
* bugs in text writing removed
+ scaling for defaultfont added
+ VertDir for default font added
* RestoreCRTMode corrected
Revision 1.2 1998/11/18 09:31:42 pierre
* changed color scheme
all colors are in RGB format if more than 256 colors
+ added 24 and 32 bits per pixel mode