Newsgroup: it.comp.lang.pascal
Titolo: Unit per la scrittura diretta della memoria video

unit videomem;
{E' una unit per la scrittura diretta nella memoria video
in moadalita' testo!
Parte di questo codice e' preso da un post di dreadnaut
i colori di sfondo vanno da 0 a 7
i colori di primo piano vanno da 0 a 15
}
INTERFACE
procedure gotoyx(y,x:byte);
procedure fwrite(y,x:byte; s:string);
procedure cls;
function get_color(y,x:byte):byte;
function get_bg(y,x:byte):byte ;
procedure change_bg(y,x:byte; bg:byte );
procedure change_color(y,x:byte;color:byte);
function make_at(bg,color:byte):byte;
function get_at(y,x:byte):byte;
function get_char(y,x:byte):char;
procedure put_char(y,x:byte; c:char);
Procedure FWriteEx(y,x:byte; s:string; a:byte);
Procedure change_at(y,x:byte;at:byte);
type CrtCell = record Ch,At: byte; end; {questa pu• stare su
implementation,
                                         a me serviva fuori}
IMPLEMENTATION
type
   CrtMap  = array [1..50,1..80] of CrtCell;
 const
  CRTPtr : pointer = Ptr($b800,$0000);
  Text25  =   3;
  Text50  = 259;
var
  CrtMem : CrtMap absolute $B800:$0000;
Function CellPtr(y,x: byte): pointer;
  begin
   CellPtr := Ptr($B800,y - 1 + 10 * (x-1) shl 4);
  end;
 Procedure FWrite(y,x:byte; s:string);
  var
   n : byte;
  begin
   for n := 0 to length(s)-1 do
    CrtMem[y,x+n].Ch := ord(s[n+1]);
  end;
Procedure FWriteEx(y,x:byte; s:string; a:byte);
  var
   n : byte;
  begin
   for n := 0 to length(s)-1 do
    CrtMem[y,x+n].Ch := ord(s[n+1]);
   for n := 0 to length(s)-1 do
    CrtMem[y,x+n].At := a;
  end;
function get_char(y,x:byte):char ;
begin
get_char:= chr(CrtMem[y,x].ch);
end;
function get_color(y,x:byte):byte ;
begin
get_color:= (CrtMem[y,x].at - ((CrtMem[y,x].at DIV 16)*16));
end;
function get_bg(y,x:byte):byte ;
begin
get_bg:= (CrtMem[y,x].at DIV 16);
end;
procedure CLS;
var n,k:byte;
begin
for n:=1 to 50 do
    for k:=1 to 80 do begin
        CrtMem[n,k].ch := ord(' ');
        CrtMem[n,k].at :=7;
    end;
end;
function make_at(bg,color:byte):byte;
begin
if bg > 7 then bg:= bg-7;
make_at :=(bg*16)+color;
end;
Procedure ScrollUp(x1,y1,x2,y2,s:byte); assembler;
  asm
   MOV   ah,$06
   mov   bh,0
   mov   al,byte ptr s
   mov   cl,byte ptr x1
   mov   ch,byte ptr y1
   mov   dl,byte ptr x2
   mov   dh,byte ptr y2
   dec   cl
   dec   ch
   dec   dl
   dec   dh
   INT   $10
 end;
{i parametri indicano gli estremi della zona da scrollare (alto-sx
basso-dx) e il numero di righe}
Procedure ScrollDown(x1,y1,x2,y2,s:byte); assembler;
  asm
   MOV   ah,$07
   mov   bh,0
   mov   al,byte ptr s
   mov   cl,byte ptr x1
   mov   ch,byte ptr y1
   mov   dl,byte ptr x2
   mov   dh,byte ptr y2
   dec   cl
   dec   ch
   dec   dl
   dec   dh
   INT   $10
 end;
procedure gotoyx(y,x:byte);
begin
y:=y-1;
x:=x-1;
asm
   mov AH,02h
   mov BH,00h
   mov DH,y
   mov DL,x
   int (10h)
   end;
end;
procedure change_bg(y,x:byte;bg:byte);
begin
CrtMem[y,x].at:=make_at(bg,get_color(y,x));
end;
procedure change_color(y,x:byte;color:byte);
begin
CrtMem[y,x].at:=make_at(get_bg(y,x),color);
end;
function get_at(y,x:byte):byte;
begin
get_at:=CrtMem[y,x].at
end;
procedure put_char(y,x:byte; c:char);
begin
CrtMem[y,x].ch:=ord(c);
end;
Procedure change_at(y,x:byte;at:byte);
begin
CrtMem[y,x].at:=at;
end;
BEGIN
END.

mancano le due procedure in asm per determinare la posizione del
cursore.
NM

ho dato un'occhiata alla Ralf Brown's, e ho tirato fuori un altro
paio di procedure: due per settare/conoscere il colore del bordo
dello schermo, l'altra per eliminare il lampeggiamento e permettere
di utilizzare 16 colori anche per lo sfondo
 procedure setBorderColor(c: byte); assembler;
  asm
   mov ax, $1001
   mov bh, c
   int $10
  end;
 function getBorderColor: byte; assembler;
  asm
   mov ax, $1008
   int $10
   mov al, bh { * }
  end;
{ * nell'asm del tp funzioni che restituiscono byte/int
  devono copiare il risultato in al/ax }
 procedure setBlinking(state: boolean); assembler;
  asm
   mov ax, $1003
   mov bl, state
   xor bh, bh
   int $10
  end;
per il cursore beh ... :-)
-- snip da Ralf Brown's Interrupt List - inter61a.zip - interrup.a --
INT 10 - VIDEO - GET CURSOR POSITION AND SIZE
 AH = 03h
 BH = page number  (*)
     0-3 in modes 2&3
     0-7 in modes 0&1
     0 in graphics modes
Return: AX = 0000h (Phoenix BIOS)
 CH = start scan line
 CL = end scan line
 DH = row (00h is top)
 DL = column (00h is left)
Notes: a separate cursor is maintained for each of up to 8 display pages
(*) stavo provando anche le pagine di visualizzazione, ma per ora riesco
a cambiare ma non a scriverci dentro.... boh...
--
Dreadnaut
(Life would be easier if I had the source code)

 cursore.
mannaggia!!
Cereal

paio di procedure: due per settare/conoscere il colore del bordo
cos'è il colore di bordo dello schermo?

> cos'è il colore di bordo dello schermo?
E' il colore del bordo dello schermo... prova le procedure e vedrai.
Inoltre invece delle chiamate txt ho messo quelle vga, che funzionano
lo stesso ma permettono 64 colori. I primi 16 sono i soliti, poi
partono tinte strane...
saluti,
un Dreadnaut che fra dieci min ha lezione ?!  ops...

> Inoltre invece delle chiamate txt ho messo quelle vga, che funzionano
ehm... era `ega' :-)
ops,
Dreadnaut