unit mem_vid;
(**************) INTERFACE (******************)
type
tipo_monitor=(b_n,col);
procedure fissa_col(x,y,fg,bg:byte);
procedure fissa_col_tb(x,y,tb:byte);
procedure fissa_car(x,y:byte;ch:char);
function leggi_car(x,y:byte):char;
(*legge carattere nella posizione x,y in memoria video*)
function leggi_str(x,y,lunghezza:byte):string;
(*legge stringa in memoria video*)
procedure fissa_car_col(x,y:byte;ch:char;fg,bg:byte);
(*fissa carattere,colore testo e colore sfondo in una word della memoria
video *)
procedure str_vid(x,y:byte;str:string;fg,bg:byte);
(*fissa una stringa con colore testo e sfondo direttamente in
memoria video*)
procedure str_vid_car(x,y:byte;str:string);
(*fissa una stringa direttamente in memoria video*)
procedure str_vid_att(x,y,lunghezza,fg,bg:byte);
(*fissa colore testo e sfondo partendo da x,y in memoria video*)
procedure pulisci(x1,y1,x2,y2,fg,bg:byte);
(*riempie una finestra con spazi ' ' in memoria video, fissando i colori
di testo e sfondo*)
procedure pulisci_car(x1,y1,x2,y2:byte);
(*riempie una finestra con spazi ' ' in memoria video*)
procedure pulisci_att(x1,y1,x2,y2,fg,bg:byte);
(*fissa i colori di testo e sfondo di una finestra in memoria video*)
var
seg_vid:word;
t_mon:tipo_monitor;
(************) IMPLEMENTATION (*******************)
procedure fissa_car_col(x,y:byte;ch:char;fg,bg:byte);
var
w:word;
attrib:word;
begin
w:=((y-1)*80+(x-1))*2;
attrib:=(bg shl 4)+ fg;
memW[seg_vid:W]:=(attrib shl 8)+ ord(ch);
end;
{***************}
procedure str_vid(x,y:byte;str:string;fg,bg:byte);
var
i:byte;
begin
if str='' then exit;
for i:=1 to (length(str)) do fissa_car_col(x+i-1,y,str[i],fg,bg);
end;
{***************}
procedure pulisci(x1,y1,x2,y2,fg,bg:byte);
var
i,j:byte;
begin
for i:=y1 to y2
do for j:=x1 to x2
do fissa_car_col(j,i,' ',fg,bg);
end;
{*******************}
procedure fissa_car(x,y:byte;ch:char);
var
w:integer;
begin
if ch='' then exit;
w:=((y-1)*80+(x-1))*2;
memW[seg_vid:w]:=((memW[seg_vid:w] shr 8) shl 8) + ord(ch);
end;
{***************}
function leggi_car(x,y:byte):char;
var
w:word;
begin
w:=((y-1)*80+(x-1))*2;
leggi_car:=char((memW[seg_vid:w] shl 8) shr 8);
end;
(********************)
function leggi_str(x,y,lunghezza:byte):string;
var
i:byte; s:string; ch:char;
begin
s:='';
for i:=0 to lunghezza-1 do
begin
ch:=leggi_Car(x+i,y);
if ch=' ' then break;
s:=s+ch
end;
leggi_str:=s;
end;
(***********************)
procedure fissa_col(x,y,fg,bg:byte);
var
w:integer;
k:byte;
begin
w:=((y-1)*80+(x-1))*2;
k:=(bg shl 4) + fg;
memW[seg_vid:w]:=(k shl 8) + ((memW[seg_vid:w] shl 8) shr 8);
end;
{*******************}
procedure fissa_col_tb(x,y,tb:byte);
var
w:integer; k:byte;
begin
w:=((y-1)*80+(x-1))*2;
k:=(tb shl 4) + ((memW[seg_vid:w] shl 4) shr 12) ;
memW[seg_vid:w]:=(k shl 8) + ((memW[seg_vid:w] shl 8) shr 8);
end;
(***********************)
procedure str_vid_car(x,y:byte;str:string);
var
i:byte;
begin
if str='' then exit;
for i:=0 to length(str)-1
do fissa_car(x+i,y,str[i+1]);
end;
{*******************}
procedure str_vid_att(x,y,lunghezza,fg,bg:byte);
var
i:byte;
begin
for i:=0 to lunghezza
do fissa_col(x+i,y,fg,bg);
end;
{*******************}
procedure pulisci_car(x1,y1,x2,y2:byte);
var
i,j:byte;
begin
for i:=y1 to y2
do for j:=x1 to x2
do fissa_car(j,i,' ');
end;
{*******************}
procedure pulisci_att(x1,y1,x2,y2,fg,bg:byte);
var
i,j:byte;
begin
for i:=y1 to y2
do for j:=x1 to x2
do fissa_col(j,i,fg,bg);
end;
begin
if mem[$0000:$0449]=7 then
begin
seg_vid:=$B000;
t_mon:=b_n;
end else
begin
seg_vid:=$B800;
t_mon:=col;
end;
end.
