[Back to EGAVGA SWAG index] [Back to Main SWAG index] [Original]
{
Here is a unit for using a 640*400*256 color mode. The color mapping is exactly
the same as in the normal mode 13h, anyway procedures for setting the palette
are also included (in assembly).
The basic idea of working in this graphic mode is that for segments (pages) of
VGA screen are addressed through the one segment ($a0000..$affff). This can be
done by setting some of the vga ports.
Btw this mode can also be used for generating four 320*200 screens and
scrolling through them freely.
I recommend reading the asm parts with some kind of document about the vga
so u will be able to see which port do what.
Ziv.
------------------------------ Cut Here --------------------------------------
}
unit chained4;
interface
uses crt,dos;
type
dotptr=^dot;
dot=record
x,y:integer;
end;
color=record
red,green,blue:byte;
end;
point=record
x,y:integer;
color:byte;
end;
var
xsize:integer;
procedure init(mode:byte);
procedure init_chained;
procedure clear_chained;
procedure pixel(x,y:word; color:byte);
procedure line(x0,y0,x1,y1,color:integer);
procedure box(x1,y1,x2,y2,col:integer);
procedure draw_poly(start_point:dotptr; num,col:integer);
procedure circle(xcenter,ycenter,rad,color:integer);
procedure setpall(segm,off:word);
procedure getpall(segm,off:word);
implementation
procedure init(mode:byte); assembler;
asm
sti
mov ah,0
mov al,mode
int $10
end;
procedure init_chained; assembler;
asm
mov ax,5ch { Set normal mode 13H }
int 10h
mov dx,3CEh { Memory division }
mov al,5 { Disable bit 4 of }
out dx,al { graphic mode register }
inc dx { in graphics controller }
in al,dx
and al,11111011b
out dx,al
dec dx
mov al,6 { And change bit 1 }
out dx,al { in the miscellaneous }
inc dx { register }
in al,dx
and al,11111101b
out dx,al
mov dx,3C4h { Modify memory mode register in }
mov al,4 { sequencer controlller so no further }
out dx,al { address division follows in }
inc dx { bitplanes, and set the bitplane }
in al,dx { currently in the }
and al,11110111b { bit mask register }
or al,4
out dx,al
mov dx,3D4h { Set double word mode using bit 6 }
mov al,14h { in underline register of }
out dx,al { CRT controller }
inc dx
in al,dx
and al,10111111b
out dx,al
dec dx
mov al,17h { Using bit 6 in mode control reg. }
out dx,al { of CRT controller, change }
inc dx { from word mode to byte mode }
in al,dx
or al,01000000b
out dx,al
end;
procedure clear_chained; assembler;
asm
mov dx,03c4h { clear all 256k of video memory }
mov ax,020fh
out dx,ax
mov ax,0a000h
mov es,ax
xor di,di
xor ax,ax { zero all planes }
mov cx,32768
cld
rep stosw
end;
procedure pixel(x,y:word; color:byte); assembler;
asm
mov ax,y
xor bx,bx
mov bx,xsize
shl bx,1
mul bx
mov bx,ax
mov ax,x
mov cx,ax
shr ax,2
add bx,ax
and cl,00000011b
mov dx,03c4h
mov al,2
out dx,al
inc dx
mov al,1
shl al,cl
out dx,al
mov ax,0a000h
mov es,ax
mov al,color
mov es:[bx],al
end;
procedure line(x0,y0,x1,y1,color:integer);
var
px,py,x,y,dx,dy,d,ince,temp,incne:integer;
op,xminus,yminus:boolean;
begin
pixel(x0,y0,color);
dy:=y0-y1;
dx:=x1-x0;
xminus:=dx<0;
yminus:=dy<0;
dx:=abs(dx);
dy:=abs(dy);
op:=dx<dy;
if op then
begin
temp:=dy;
dy:=dx;
dx:=temp;
end;
d:=2*dy-dx;
ince:=2*dy;
incne:=2*(dy-dx);
x:=0;
y:=0;
while x<dx do
begin
if d<=0 then
begin
d:=d+ince;
x:=x+1;
end else
begin
d:=d+incne;
x:=x+1;
y:=y+1;
end;
px:=x;
py:=y;
if op then
begin
temp:=px;
px:=py;
py:=temp;
end;
if xminus then px:=x0-px else px:=x0+px;
if yminus then py:=y0+py else py:=y0-py;
pixel(px,py,color);
end;
end;
procedure box(x1,y1,x2,y2,col:integer);
begin
line(x1,y1,x2,y1,col);
line(x1,y2,x2,y2,col);
line(x1,y1,x1,y2,col);
line(x2,y1,x2,y2,col);
end;
procedure draw_poly(start_point:dotptr; num,col:integer);
var
count:integer;
first,next:dotptr;
begin
first:=start_point;
for count:=1 to num -1 do
begin
next:=ptr(seg(first^),ofs(first^)+4);
line(first^.x,first^.y,next^.x,next^.y,col);
first:=next;
end;
line(next^.x,next^.y,start_point^.x,start_point^.y,col);
end;
procedure circlepoints(xcenter,ycenter,x,y,color:integer);
var
count:integer;
begin
pixel(xcenter+x,ycenter+y,color);
pixel(xcenter+y,ycenter+x,color);
pixel(xcenter+y,ycenter-x,color);
pixel(xcenter+x,ycenter-y,color);
pixel(xcenter-x,ycenter-y,color);
pixel(xcenter-y,ycenter-x,color);
pixel(xcenter-y,ycenter+x,color);
pixel(xcenter-x,ycenter+y,color);
end;
procedure circle(xcenter,ycenter,rad,color:integer);
var
x,y:integer;
d:real;
begin
x:=0;
y:=rad;
d:=5/4-rad div 2;
circlepoints(xcenter,ycenter,x,y,color);
while x<=y do
begin
if d<0 then
begin
d:=d+2*x+3;
x:=x+1;
end else
begin
d:=d+2*(x-y)+5;
x:=x+1;
y:=y-1;
end;
circlepoints(xcenter,ycenter,x,y,color);
end;
end;
procedure setpall(segm,off:word);
begin
asm
push ds
push di
push ax
push cx
push dx
mov ds,segm
mov di,off
mov cx,768
mov dx,3c8h
xor al,al
out dx,al
mov dx,3c9h
@xx:
mov al,ds:[di]
out dx,al
inc di
loop @xx
pop dx
pop cx
pop ax
pop di
pop ds
end;
end;
procedure getpall(segm,off:word);
begin
asm
push ds
push di
push ax
push cx
push dx
mov ds,segm
mov di,off
mov cx,768
mov dx,3c7h
xor al,al
out dx,al
mov dx,3c9h
@xx:
in al,dx
mov ds:[di],al
inc di
loop @xx
pop dx
pop cx
pop ax
pop di
pop ds
end;
end;
begin
xsize:=80;
end.
[Back to EGAVGA SWAG index] [Back to Main SWAG index] [Original]