1 {************************************************************************}
2 {*                     4-bit planar VGA mode routines                   *}
3 {************************************************************************}
4
5
6const
7
8  VideoOfs = 0;
9
10
11var
12
13  VidMem: PByteArray;
14  ScrWidth: SmallInt;
15
16
17procedure bytemove(var source, dest; count: SmallInt);
18var
19  s, d: PByte;
20begin
21  s := PByte(@source);
22  d := PByte(@dest);
23  while count > 0 do begin
24    d^ := s^;
25    Inc(d);
26    Inc(s);
27    Dec(count);
28  end;
29end;
30
31
32
33procedure PutPixel16(X,Y : SmallInt; Pixel: Word);
34var
35  offset: word;
36  dummy: byte;
37begin
38  Inc(x, StartXViewPort);
39  Inc(y, StartYViewPort);
40  { convert to absolute coordinates and then verify clipping...}
41  if ClipPixels then
42  begin
43    if (X < StartXViewPort) or (X > (StartXViewPort + ViewWidth)) then
44      exit;
45    if (Y < StartYViewPort) or (Y > (StartYViewPort + ViewHeight)) then
46      exit;
47  end;
48  offset := y * 80 + (x shr 3) + VideoOfs;
49  WritePortW($3ce, $0f01);       { Index 01 : Enable ops on all 4 planes }
50  WritePortW($3ce, (Pixel and $ff) shl 8); { Index 00 : Enable correct plane and write color }
51
52  WritePortW($3ce, 8 or ($8000 shr (x and $7)));{ Select correct bits to modify }
53  dummy := VidMem^[offset];     { Read data byte into VGA latch register }
54  VidMem^[offset] := dummy;     { Write the data into video memory }
55end;
56
57
58function GetPixel16(X,Y: SmallInt):word;
59var
60  dummy, offset: Word;
61  shift: byte;
62begin
63  Inc(x, StartXViewPort);
64  Inc(y, StartYViewPort);
65  offset := Y * 80 + (x shr 3) + VideoOfs;
66  WritePortW($3ce, 4);
67  shift := 7 - (X and 7);
68  dummy := (VidMem^[offset] shr shift) and 1;
69  WritePortB($3cf, 1);
70  dummy := dummy or (((VidMem^[offset] shr shift) and 1) shl 1);
71  WritePortB($3cf, 2);
72  dummy := dummy or (((VidMem^[offset] shr shift) and 1) shl 2);
73  WritePortB($3cf, 3);
74  dummy := dummy or (((VidMem^[offset] shr shift) and 1) shl 3);
75  GetPixel16 := dummy;
76end;
77
78
79procedure GetScanLine16(x1, x2, y: SmallInt; var data);
80var
81  dummylong: longint;
82  Offset, count, count2, amount, index: word;
83  plane: byte;
84begin
85  inc(x1,StartXViewPort);
86  inc(x2,StartXViewPort);
87{$ifdef logging}
88  LogLn('GetScanLine16 start, length to get: '+strf(x2-x1+1)+' at y = '+strf(y));
89{$Endif logging}
90  offset := (Y + StartYViewPort) * 80 + (x1 shr 3) + VideoOfs;
91{$ifdef logging}
92  LogLn('Offset: '+HexStr(offset,4)+' - ' + strf(offset));
93{$Endif logging}
94  { first get enough pixels so offset is 32bit aligned }
95  amount := 0;
96  index := 0;
97  If ((x1 and 31) <> 0) Or
98     ((x2-x1+1) < 32) Then
99    Begin
100      If ((x2-x1+1) >= 32+32-(x1 and 31)) Then
101        amount := 32-(x1 and 31)
102      Else amount := x2-x1+1;
103{$ifdef logging}
104      LogLn('amount to align to 32bits or to get all: ' + strf(amount));
105{$Endif logging}
106      For count := 0 to amount-1 do
107        WordArray(Data)[Count] := getpixel16(x1-StartXViewPort+Count,y);
108      index := amount;
109      Inc(Offset,(amount+7) shr 3);
110{$ifdef logging}
111      LogLn('offset now: '+HexStr(offset,4)+' - ' + strf(offset));
112      LogLn('index now: '+strf(index));
113{$Endif logging}
114    End;
115  amount := x2-x1+1 - amount;
116{$ifdef logging}
117  LogLn('amount left: ' + strf(amount));
118{$Endif logging}
119  If amount = 0 Then Exit;
120  WritePortB($3ce, 4);
121  { first get everything from plane 3 (4th plane) }
122  WritePortB($3cf, 3);
123  Count := 0;
124  For Count := 1 to (amount shr 5) Do
125    Begin
126      dummylong := PLongInt(@VidMem^[offset+(Count-1)*4])^;
127      dummylong :=
128        ((dummylong and $ff) shl 24) or
129        ((dummylong and $ff00) shl 8) or
130        ((dummylong and $ff0000) shr 8) or
131        ((dummylong and $ff000000) shr 24);
132      For Count2 := 31 downto 0 Do
133        Begin
134          WordArray(Data)[index+Count2] := DummyLong and 1;
135          DummyLong := DummyLong shr 1;
136        End;
137      Inc(Index, 32);
138    End;
139{ Now get the data from the 3 other planes }
140  plane := 3;
141  Repeat
142    Dec(Index,Count*32);
143    Dec(plane);
144    WritePortB($3cf, plane);
145    Count := 0;
146    For Count := 1 to (amount shr 5) Do
147      Begin
148        dummylong := PLongInt(@VidMem^[offset+(Count-1)*4])^;
149        dummylong :=
150          ((dummylong and $ff) shl 24) or
151          ((dummylong and $ff00) shl 8) or
152          ((dummylong and $ff0000) shr 8) or
153          ((dummylong and $ff000000) shr 24);
154        For Count2 := 31 downto 0 Do
155          Begin
156            WordArray(Data)[index+Count2] :=
157              (WordArray(Data)[index+Count2] shl 1) or (DummyLong and 1);
158            DummyLong := DummyLong shr 1;
159          End;
160        Inc(Index, 32);
161      End;
162  Until plane = 0;
163  amount := amount and 31;
164  Dec(index);
165{$ifdef Logging}
166  LogLn('Last array index written to: '+strf(index));
167  LogLn('amount left: '+strf(amount)+' starting at x = '+strf(index+1));
168{$Endif logging}
169  For Count := 1 to amount Do
170    WordArray(Data)[index+Count] := getpixel16(index+Count,y);
171{$ifdef logging}
172  LogLn('First 32 bytes gotten with getscanline16: ');
173  If x2-x1+1 >= 32 Then
174    Count2 := 32
175  Else Count2 := x2-x1+1;
176  For Count := 0 to Count2-1 Do
177    Log(strf(WordArray(Data)[Count])+' ');
178  LogLn('');
179  If x2-x1+1 >= 32 Then
180    Begin
181      LogLn('Last 32 bytes gotten with getscanline16: ');
182      For Count := 31 downto 0 Do
183      Log(strf(WordArray(Data)[x2-x1-Count])+' ');
184    End;
185  LogLn('');
186  GetScanLineDefault(x1-StartXViewPort,x2-StartXViewPort,y,Data);
187  LogLn('First 32 bytes gotten with getscanlinedef: ');
188  If x2-x1+1 >= 32 Then
189    Count2 := 32
190  Else Count2 := x2-x1+1;
191  For Count := 0 to Count2-1 Do
192    Log(strf(WordArray(Data)[Count])+' ');
193  LogLn('');
194  If x2-x1+1 >= 32 Then
195    Begin
196      LogLn('Last 32 bytes gotten with getscanlinedef: ');
197      For Count := 31 downto 0 Do
198      Log(strf(WordArray(Data)[x2-x1-Count])+' ');
199    End;
200  LogLn('');
201  LogLn('GetScanLine16 end');
202{$Endif logging}
203end;
204
205
206procedure DirectPutPixel16(X,Y : SmallInt);
207{ x,y -> must be in global coordinates. No clipping. }
208var
209  color: word;
210  offset: word;
211  dummy: byte;
212begin
213  case CurrentWriteMode of
214    XORPut:
215      begin
216        { getpixel wants local/relative coordinates }
217        Color := GetPixel(x - StartXViewPort, y - StartYViewPort);
218        Color := CurrentColor xor Color;
219      end;
220    OrPut:
221      begin
222        { getpixel wants local/relative coordinates }
223        Color := GetPixel(x - StartXViewPort, y - StartYViewPort);
224        Color := CurrentColor or Color;
225      end;
226    AndPut:
227      begin
228        { getpixel wants local/relative coordinates }
229        Color := GetPixel(x - StartXViewPort, y - StartYViewPort);
230        Color := CurrentColor and Color;
231      end;
232    NotPut:
233      Color := Not Color;
234    else
235      Color := CurrentColor;
236  end;
237  offset := Y * 80 + (X shr 3) + VideoOfs;
238  WritePortW($3ce, $f01);
239  WritePortW($3ce, Color shl 8);
240  WritePortW($3ce, 8 or $8000 shr (X and 7));
241  dummy := VidMem^[offset];
242  VidMem^[offset] := dummy;
243end;
244
245
246procedure HLine16(x, x2, y: SmallInt);
247var
248  xtmp: SmallInt;
249  ScrOfs, HLength: Word;
250  LMask, RMask: Byte;
251begin
252  { must we swap the values? }
253  if x > x2 then
254  begin
255    xtmp := x2;
256    x2 := x;
257    x:= xtmp;
258  end;
259  { First convert to global coordinates }
260  Inc(x, StartXViewPort);
261  Inc(x2, StartXViewPort);
262  Inc(y, StartYViewPort);
263  if ClipPixels and LineClipped(x,y,x2,y,StartXViewPort,StartYViewPort,
264    StartXViewPort+ViewWidth, StartYViewPort+ViewHeight) then
265    exit;
266
267  ScrOfs := y * ScrWidth + x div 8;
268  HLength := x2 div 8 - x div 8;
269  LMask := $ff shr (x and 7);
270{$push}
271{$r-}
272{$q-}
273  RMask:=$ff shl (7 - (x2 and 7));
274{$pop}
275  if HLength=0 then
276    LMask:=LMask and RMask;
277  WritePortB($3ce, 0);
278  if CurrentWriteMode <> NotPut Then
279    WritePortB($3cf, CurrentColor)
280  else
281    WritePortB($3cf, not CurrentColor);
282  WritePortW($3ce, $0f01);
283  WritePortB($3ce, 3);
284  case CurrentWriteMode of
285    XORPut:
286      WritePortB($3cf, 3 shl 3);
287    ANDPut:
288      WritePortB($3cf, 1 shl 3);
289    ORPut:
290      WritePortB($3cf, 2 shl 3);
291    NormalPut, NotPut:
292      WritePortB($3cf, 0)
293    else
294      WritePortB($3cf, 0)
295  end;
296
297  WritePortB($3ce, 8);
298  WritePortB($3cf, LMask);
299{$push}
300{$r-}
301{$q-}
302  VidMem^[ScrOfs] := VidMem^[ScrOfs] + 1;
303{$pop}
304  if HLength>0 then
305  begin
306    Dec(HLength);
307    Inc(ScrOfs);
308    if HLength>0 then
309    begin
310      WritePortW($3ce, $ff08);
311      bytemove(VidMem^[ScrOfs], VidMem^[ScrOfs], HLength);
312      Inc(ScrOfs, HLength);
313    end else
314      WritePortB($3ce, 8);
315    WritePortB($3cf, RMask);
316{$push}
317{$r-}
318{$q-}
319    VidMem^[ScrOfs] := VidMem^[ScrOfs] + 1;
320{$pop}
321  end;
322end;
323
324
325
326procedure VLine16(x,y,y2: SmallInt);
327var
328  ytmp: SmallInt;
329  ScrOfs,i: longint;
330  BitMask: byte;
331
332begin
333  { must we swap the values? }
334  if y > y2 then
335  begin
336    ytmp := y2;
337    y2 := y;
338    y:= ytmp;
339  end;
340  { First convert to global coordinates }
341  Inc(x, StartXViewPort);
342  Inc(y, StartYViewPort);
343  Inc(y2, StartYViewPort);
344  if ClipPixels and LineClipped(x,y,x,y2,StartXViewPort,StartYViewPort,
345    StartXViewPort+ViewWidth, StartYViewPort+ViewHeight) then
346    exit;
347  ScrOfs:=y*ScrWidth+x div 8;
348  BitMask:=$80 shr (x and 7);
349  WritePortB($3ce, 0);
350  if CurrentWriteMode <> NotPut then
351    WritePortB($3cf, CurrentColor)
352  else
353    WritePortB($3cf, not CurrentColor);
354  WritePortW($3ce, $0f01);
355  WritePortB($3ce, 8);
356  WritePortB($3cf, BitMask);
357  WritePortB($3ce, 3);
358  case CurrentWriteMode of
359    XORPut:
360      WritePortB($3cf, 3 shl 3);
361    ANDPut:
362      WritePortB($3cf, 1 shl 3);
363    ORPut:
364      WritePortB($3cf, 2 shl 3);
365    NormalPut, NotPut:
366      WritePortB($3cf, 0)
367    else
368      WritePortB($3cf, 0)
369  end;
370  for i:=y to y2 do
371  begin
372{$push}
373{$r-}
374{$q-}
375    VidMem^[ScrOfs]:=VidMem^[ScrOfs]+1;
376{$pop}
377    Inc(ScrOfs, ScrWidth);
378  end;
379end;
380
381