* Moved from Linux dir. now start of generic unix dir, from which the

    really exotic features should be moved to the target specific dirs.

rtl/unix/initc.pp

@@ -0,0 +1,32 @@
+{
+    $Id$
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 1999-2000 by Michael Van Canneyt and Peter Vreman,
+    members of the Free Pascal development team
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program 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.
+
+ **********************************************************************}
+unit initc;
+interface
+{$linklib c}
+implementation
+end.
+{
+  $Log$
+  Revision 1.1.2.1  2000-09-14 13:38:25  marco
+   * Moved from Linux dir. now start of generic unix dir, from which the
+      really exotic features should be moved to the target specific dirs.
+
+  Revision 1.1  2000/07/13 06:30:53  michael
+  + Initial import
+
+  Revision 1.1  2000/02/05 21:53:46  peter
+    * added initc unit dummy
+
+}

rtl/unix/vgagraph16.inc

@@ -0,0 +1,427 @@
+ {************************************************************************}
+ {*                     4-bit planar VGA mode routines                   *}
+ {************************************************************************}
+
+
+const
+
+  VideoOfs = 0;
+
+
+var
+
+  VidMem: PByteArray;
+  ScrWidth: Integer;
+
+
+procedure bytemove(var source, dest; count: Integer);
+var
+  s, d: PByte;
+begin
+  s := PByte(@source);
+  d := PByte(@dest);
+  while count > 0 do begin
+    d^ := s^;
+    Inc(d);
+    Inc(s);
+    Dec(count);
+  end;
+end;
+
+
+
+procedure PutPixel16(X,Y : Integer; Pixel: Word);
+var
+  offset: word;
+  dummy: byte;
+begin
+  Inc(x, StartXViewPort);
+  Inc(y, StartYViewPort);
+  { convert to absolute coordinates and then verify clipping...}
+  if ClipPixels then
+  begin
+    if (X < StartXViewPort) or (X > (StartXViewPort + ViewWidth)) then
+      exit;
+    if (Y < StartYViewPort) or (Y > (StartYViewPort + ViewHeight)) then
+      exit;
+  end;
+  offset := y * 80 + (x shr 3) + VideoOfs;
+  WritePortW($3ce, $0f01);       { Index 01 : Enable ops on all 4 planes }
+  WritePortW($3ce, (Pixel and $ff) shl 8); { Index 00 : Enable correct plane and write color }
+
+  WritePortW($3ce, 8 or ($8000 shr (x and $7)));{ Select correct bits to modify }
+  dummy := VidMem^[offset];     { Read data byte into VGA latch register }
+  VidMem^[offset] := dummy;     { Write the data into video memory }
+end;
+
+
+function GetPixel16(X,Y: Integer):word;
+var
+  dummy, offset: Word;
+  shift: byte;
+begin
+  Inc(x, StartXViewPort);
+  Inc(y, StartYViewPort);
+  offset := Y * 80 + (x shr 3) + VideoOfs;
+  WritePortW($3ce, 4);
+  shift := 7 - (X and 7);
+  dummy := (VidMem^[offset] shr shift) and 1;
+  WritePortB($3cf, 1);
+  dummy := dummy or (((VidMem^[offset] shr shift) and 1) shl 1);
+  WritePortB($3cf, 2);
+  dummy := dummy or (((VidMem^[offset] shr shift) and 1) shl 2);
+  WritePortB($3cf, 3);
+  dummy := dummy or (((VidMem^[offset] shr shift) and 1) shl 3);
+  GetPixel16 := dummy;
+end;
+
+
+procedure GetScanLine16(x1, x2, y: integer; var data);
+var
+  dummylong: longint;
+  Offset, count, count2, amount, index: word;
+  plane: byte;
+begin
+  inc(x1,StartXViewPort);
+  inc(x2,StartXViewPort);
+{$ifdef logging}
+  LogLn('GetScanLine16 start, length to get: '+strf(x2-x1+1)+' at y = '+strf(y));
+{$Endif logging}
+  offset := (Y + StartYViewPort) * 80 + (x1 shr 3) + VideoOfs;
+{$ifdef logging}
+  LogLn('Offset: '+HexStr(offset,4)+' - ' + strf(offset));
+{$Endif logging}
+  { first get enough pixels so offset is 32bit aligned }
+  amount := 0;
+  index := 0;
+  If ((x1 and 31) <> 0) Or
+     ((x2-x1+1) < 32) Then
+    Begin
+      If ((x2-x1+1) >= 32+32-(x1 and 31)) Then
+        amount := 32-(x1 and 31)
+      Else amount := x2-x1+1;
+{$ifdef logging}
+      LogLn('amount to align to 32bits or to get all: ' + strf(amount));
+{$Endif logging}
+      For count := 0 to amount-1 do
+        WordArray(Data)[Count] := getpixel16(x1-StartXViewPort+Count,y);
+      index := amount;
+      Inc(Offset,(amount+7) shr 3);
+{$ifdef logging}
+      LogLn('offset now: '+HexStr(offset,4)+' - ' + strf(offset));
+      LogLn('index now: '+strf(index));
+{$Endif logging}
+    End;
+  amount := x2-x1+1 - amount;
+{$ifdef logging}
+  LogLn('amount left: ' + strf(amount));
+{$Endif logging}
+  If amount = 0 Then Exit;
+  WritePortB($3ce, 4);
+  { first get everything from plane 3 (4th plane) }
+  WritePortB($3cf, 3);
+  Count := 0;
+  For Count := 1 to (amount shr 5) Do
+    Begin
+      dummylong := PLongInt(@VidMem^[offset+(Count-1)*4])^;
+      dummylong :=
+        ((dummylong and $ff) shl 24) or
+        ((dummylong and $ff00) shl 8) or
+        ((dummylong and $ff0000) shr 8) or
+        ((dummylong and $ff000000) shr 24);
+      For Count2 := 31 downto 0 Do
+        Begin
+          WordArray(Data)[index+Count2] := DummyLong and 1;
+          DummyLong := DummyLong shr 1;
+        End;
+      Inc(Index, 32);
+    End;
+{ Now get the data from the 3 other planes }
+  plane := 3;
+  Repeat
+    Dec(Index,Count*32);
+    Dec(plane);
+    WritePortB($3cf, plane);
+    Count := 0;
+    For Count := 1 to (amount shr 5) Do
+      Begin
+        dummylong := PLongInt(@VidMem^[offset+(Count-1)*4])^;
+        dummylong :=
+          ((dummylong and $ff) shl 24) or
+          ((dummylong and $ff00) shl 8) or
+          ((dummylong and $ff0000) shr 8) or
+          ((dummylong and $ff000000) shr 24);
+        For Count2 := 31 downto 0 Do
+          Begin
+            WordArray(Data)[index+Count2] :=
+              (WordArray(Data)[index+Count2] shl 1) or (DummyLong and 1);
+            DummyLong := DummyLong shr 1;
+          End;
+        Inc(Index, 32);
+      End;
+  Until plane = 0;
+  amount := amount and 31;
+  Dec(index);
+{$ifdef Logging}
+  LogLn('Last array index written to: '+strf(index));
+  LogLn('amount left: '+strf(amount)+' starting at x = '+strf(index+1));
+{$Endif logging}
+  For Count := 1 to amount Do
+    WordArray(Data)[index+Count] := getpixel16(index+Count,y);
+{$ifdef logging}
+  LogLn('First 32 bytes gotten with getscanline16: ');
+  If x2-x1+1 >= 32 Then
+    Count2 := 32
+  Else Count2 := x2-x1+1;
+  For Count := 0 to Count2-1 Do
+    Log(strf(WordArray(Data)[Count])+' ');
+  LogLn('');
+  If x2-x1+1 >= 32 Then
+    Begin
+      LogLn('Last 32 bytes gotten with getscanline16: ');
+      For Count := 31 downto 0 Do
+      Log(strf(WordArray(Data)[x2-x1-Count])+' ');
+    End;
+  LogLn('');
+  GetScanLineDefault(x1-StartXViewPort,x2-StartXViewPort,y,Data);
+  LogLn('First 32 bytes gotten with getscanlinedef: ');
+  If x2-x1+1 >= 32 Then
+    Count2 := 32
+  Else Count2 := x2-x1+1;
+  For Count := 0 to Count2-1 Do
+    Log(strf(WordArray(Data)[Count])+' ');
+  LogLn('');
+  If x2-x1+1 >= 32 Then
+    Begin
+      LogLn('Last 32 bytes gotten with getscanlinedef: ');
+      For Count := 31 downto 0 Do
+      Log(strf(WordArray(Data)[x2-x1-Count])+' ');
+    End;
+  LogLn('');
+  LogLn('GetScanLine16 end');
+{$Endif logging}
+end;
+
+
+procedure DirectPutPixel16(X,Y : Integer);
+{ x,y -> must be in global coordinates. No clipping. }
+var
+  color: word;
+  offset: word;
+  dummy: byte;
+begin
+  case CurrentWriteMode of
+    XORPut:
+      begin
+        { getpixel wants local/relative coordinates }
+        Color := GetPixel(x - StartXViewPort, y - StartYViewPort);
+        Color := CurrentColor xor Color;
+      end;
+    OrPut:
+      begin
+        { getpixel wants local/relative coordinates }
+        Color := GetPixel(x - StartXViewPort, y - StartYViewPort);
+        Color := CurrentColor or Color;
+      end;
+    AndPut:
+      begin
+        { getpixel wants local/relative coordinates }
+        Color := GetPixel(x - StartXViewPort, y - StartYViewPort);
+        Color := CurrentColor and Color;
+      end;
+    NotPut:
+      Color := Not Color;
+    else
+      Color := CurrentColor;
+  end;
+  offset := Y * 80 + (X shr 3) + VideoOfs;
+  WritePortW($3ce, $f01);
+  WritePortW($3ce, Color shl 8);
+  WritePortW($3ce, 8 or $8000 shr (X and 7));
+  dummy := VidMem^[offset];
+  VidMem^[offset] := dummy;
+end;
+
+
+procedure HLine16(x, x2, y: Integer);
+var
+  xtmp: Integer;
+  ScrOfs, HLength: Word;
+  LMask, RMask: Byte;
+begin
+  { must we swap the values? }
+  if x > x2 then
+  begin
+    xtmp := x2;
+    x2 := x;
+    x:= xtmp;
+  end;
+  { First convert to global coordinates }
+  Inc(x, StartXViewPort);
+  Inc(x2, StartXViewPort);
+  Inc(y, StartYViewPort);
+  if ClipPixels and LineClipped(x,y,x2,y,StartXViewPort,StartYViewPort,
+    StartXViewPort+ViewWidth, StartYViewPort+ViewHeight) then
+    exit;
+
+  ScrOfs := y * ScrWidth + x div 8;
+  HLength := x2 div 8 - x div 8;
+  LMask := $ff shr (x and 7);
+{$ifopt r+}
+{$define rangeOn}
+{$r-}
+{$endif}
+{$ifopt q+}
+{$define overflowOn}
+{$q-}
+{$endif}
+  RMask:=$ff shl (7 - (x2 and 7));
+{$ifdef rangeOn}
+{$undef rangeOn}
+{$r+}
+{$endif}
+{$ifdef overflowOn}
+{$undef overflowOn}
+{$q+}
+{$endif}
+  if HLength=0 then
+    LMask:=LMask and RMask;
+  WritePortB($3ce, 0);
+  if CurrentWriteMode <> NotPut Then
+    WritePortB($3cf, CurrentColor)
+  else
+    WritePortB($3cf, not CurrentColor);
+  WritePortW($3ce, $0f01);
+  WritePortB($3ce, 3);
+  case CurrentWriteMode of
+    XORPut:
+      WritePortB($3cf, 3 shl 3);
+    ANDPut:
+      WritePortB($3cf, 1 shl 3);
+    ORPut:
+      WritePortB($3cf, 2 shl 3);
+    NormalPut, NotPut:
+      WritePortB($3cf, 0)
+    else
+      WritePortB($3cf, 0)
+  end;
+
+  WritePortB($3ce, 8);
+  WritePortB($3cf, LMask);
+{$ifopt r+}
+{$define rangeOn}
+{$r-}
+{$endif}
+{$ifopt q+}
+{$define overflowOn}
+{$q-}
+{$endif}
+  VidMem^[ScrOfs] := VidMem^[ScrOfs] + 1;
+{$ifdef rangeOn}
+{$undef rangeOn}
+{$r+}
+{$endif}
+{$ifdef overflowOn}
+{$undef overflowOn}
+{$q+}
+{$endif}
+  if HLength>0 then
+  begin
+    Dec(HLength);
+    Inc(ScrOfs);
+    if HLength>0 then
+    begin
+      WritePortW($3ce, $ff08);
+      bytemove(VidMem^[ScrOfs], VidMem^[ScrOfs], HLength);
+      Inc(ScrOfs, HLength);
+    end else
+      WritePortB($3ce, 8);
+    WritePortB($3cf, RMask);
+{$ifopt r+}
+{$define rangeOn}
+{$r-}
+{$endif}
+{$ifopt q+}
+{$define overflowOn}
+{$q-}
+{$endif}
+    VidMem^[ScrOfs] := VidMem^[ScrOfs] + 1;
+{$ifdef rangeOn}
+{$undef rangeOn}
+{$r+}
+{$endif}
+{$ifdef overflowOn}
+{$undef overflowOn}
+{$q+}
+{$endif}
+  end;
+end;
+
+
+
+procedure VLine16(x,y,y2: integer);
+var
+  ytmp: integer;
+  ScrOfs,i: longint;
+  BitMask: byte;
+
+begin
+  { must we swap the values? }
+  if y > y2 then
+  begin
+    ytmp := y2;
+    y2 := y;
+    y:= ytmp;
+  end;
+  { First convert to global coordinates }
+  Inc(x, StartXViewPort);
+  Inc(y, StartYViewPort);
+  Inc(y2, StartYViewPort);
+  if ClipPixels and LineClipped(x,y,x,y2,StartXViewPort,StartYViewPort,
+    StartXViewPort+ViewWidth, StartYViewPort+ViewHeight) then
+    exit;
+  ScrOfs:=y*ScrWidth+x div 8;
+  BitMask:=$80 shr (x and 7);
+  WritePortB($3ce, 0);
+  if CurrentWriteMode <> NotPut then
+    WritePortB($3cf, CurrentColor)
+  else
+    WritePortB($3cf, not CurrentColor);
+  WritePortW($3ce, $0f01);
+  WritePortB($3ce, 8);
+  WritePortB($3cf, BitMask);
+  WritePortB($3ce, 3);
+  case CurrentWriteMode of
+    XORPut:
+      WritePortB($3cf, 3 shl 3);
+    ANDPut:
+      WritePortB($3cf, 1 shl 3);
+    ORPut:
+      WritePortB($3cf, 2 shl 3);
+    NormalPut, NotPut:
+      WritePortB($3cf, 0)
+    else
+      WritePortB($3cf, 0)
+  end;
+  for i:=y to y2 do
+  begin
+{$ifopt r+}
+{$define rangeOn}
+{$r-}
+{$endif}
+{$ifopt q+}
+{$define overflowOn}
+{$q-}
+{$endif}
+    VidMem^[ScrOfs]:=VidMem^[ScrOfs]+1;
+{$ifdef rangeOn}
+{$undef rangeOn}
+{$r+}
+{$endif}
+{$ifdef overflowOn}
+{$undef overflowOn}
+{$q+}
+{$endif}
+    Inc(ScrOfs, ScrWidth);
+  end;
+end;