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