UNIT T256;

INTERFACE
uses dos;

Type composante=record
                 r,v,b:0..63;
                end;

     couleur=array[0..255] of composante;

Var
 vmode:word;
 saute:word;

PROCEDURE ecrit_palette(pouet:couleur);
PROCEDURE change_couleur(numero:byte;compo:composante;var pouet:couleur);
PROCEDURE inc_composante(numero:byte;rvb:byte;var pouet:couleur);
PROCEDURE dec_composante(numero:byte;rvb:byte;var pouet:couleur);
PROCEDURE putpixeln(x,y:word;c:byte);
PROCEDURE putpixeln13(x,y:word;c:byte);
Function getpixeln13(x,y:word):byte; {assembler ;}
Procedure putpixels(x,y:word;c:byte);
FUNCTION getpixeln(x,y:word):byte;
PROCEDURE barn(maxx,maxy,x1,y1,x2,y2,couleur:integer);
PROCEDURE mode_vesa(mode:word);
PROCEDURE mode_texte;
PROCEDURE mode_graph(mode_g:byte);
PROCEDURE attente_syncro;
Procedure change(place:word);

Function linen(x1,y1,x2,y2:integer;coul:byte):boolean;
Procedure cleardevicen(coul:byte);

Procedure putn(x,y:longint;c:byte);  {640*480*256}
Function linen64(x1,y1,x2,y2:integer;coul:byte):boolean;
Procedure cleardevicen64(coul:byte);
Procedure putn64(x,y:longint;c:byte);




IMPLEMENTATION

Procedure putn64(x,y:longint;c:byte);
var segn,offn:word;
    g:longint;
Begin
 g:=x+y*640;
 {segn:=(g div 32768)*8;}
 segn:=(g shr 15);
 {offn:=g mod 32768;}
 offn:=g-(segn shl 15);
 segn:=segn shl 3;

 if saute<>segn then change(segn);
 mem[$a000:offn]:=c;
End;

PROCEDURE attente_syncro; assembler;
asm
 mov dx,3dah
@debl:
 in al,dx
 test al,8
 jne @debl
@debl2:
 in al,dx
 test al,8
 je @debl2
end;

PROCEDURE mode_texte; assembler;
asm
 mov ah,00
 mov al,03h
 int 10h
end;

PROCEDURE ecrit_palette(pouet:couleur);
var i:word;
    reg:registers;
Begin
 {with pouet[0] do
  begin
   r:=0;
   v:=0;
   b:=0;
  end;
  with pouet[1] do
  begin
   r:=63;
   v:=63;
   b:=63;
  end;}
 with reg do
  begin
   ax:=$1012;
   es:=seg(pouet);
   dx:=ofs(pouet);
   bx:=0;
   cx:=255;
   intr($10,reg);
  end;
End;

PROCEDURE change_couleur(numero:byte;compo:composante;var pouet:couleur);
begin
 pouet[numero]:=compo;
 ecrit_palette(pouet);
end;

PROCEDURE inc_composante(numero:byte;rvb:byte;var pouet:couleur);
begin
 case rvb of
  0:if pouet[numero].r<63 then inc(pouet[numero].r) ;
  1:if pouet[numero].v<63 then inc(pouet[numero].v) ;
  2:if pouet[numero].b<63 then inc(pouet[numero].b) ;
 end;
 ecrit_palette(pouet);
end;

PROCEDURE dec_composante(numero:byte;rvb:byte;var pouet:couleur);
begin
 case rvb of
  0:if pouet[numero].r>0 then dec(pouet[numero].r) ;
  1:if pouet[numero].v>0 then dec(pouet[numero].v) ;
  2:if pouet[numero].b>0 then dec(pouet[numero].b) ;
 end;
 ecrit_palette(pouet);
end;


Procedure change(place:word);
Begin
 asm
  mov ah,4fh
  mov al,05h
  mov bh,00h
  mov bl,0
  mov dx,place
  int 10h
 end;
 saute:=place;
End;

Procedure putpixels(x,y:word;c:byte);
var truc,dx2,site:word;
    ydiv53:byte;

Begin

 asm
  mov ax,y     {ydiv53:=(y div 53);}
  xor dx,dx
  mov cl,53
  div cx
  mov ydiv53,al

  mov al,ydiv53
  shl ax,3         {site:=(ydiv53 shl 3);}
  mov site,ax
  shl ax,4       {dx2:=(site shl 4);}
  mov dx2,ax
 end;
 if saute<>site then begin  change(site);  end;
 truc:=(x+(((y mod 53) shl 6) shl 1)*5-dx2);

 if (truc<32768) then mem[$a000:truc]:=c;
End;

PROCEDURE putpixeln(x,y:word;c:byte); assembler;
      asm
       mov ah,$0c
       mov al,c
       mov cx,x
       mov dx,y
       int 10h
      end;

PROCEDURE putpixeln13(x,y:word;c:byte); {assembler ;}
begin
 if (x>319) or (x<0) then exit; if (y>199) or (y<0) then exit;
asm
  mov ax,y
  mov bx,x
  mov cl,c
  xchg ah,al
  add bx,ax
  shr ax,1
  shr ax,1
  add bx,ax
  mov ax,0A000h
  mov es,ax
  mov es:[bx],cl
 end;
end;

Function getpixeln13(x,y:word):byte; {assembler ;}
var coul:byte;
begin
 if x>=320 then exit; if y>=200 then begin getpixeln13:=0; exit end;
asm
  mov ax,y
  mov bx,x
  xchg ah,al
  add bx,ax
  shr ax,1
  shr ax,1
  add bx,ax
  mov ax,0A000h
  mov es,ax
  mov cl,es:[bx]
  mov coul,cl
 end;
 getpixeln13:=coul;
end;

FUNCTION getpixeln(x,y:word):byte;
var co:byte;
Begin
      asm
       mov ah,0dh
       mov cx,x
       mov dx,y
       int 10h
       mov co,al
      end;
 getpixeln:=co;
end;


PROCEDURE barn(maxx,maxy,x1,y1,x2,y2,couleur:integer);
var x,y:integer;
Begin
 if x2>maxx then exit;
 if y2>maxy then exit;
 if (x1=x2) and (y1=y2) then begin
                              if vmode=$13 then putpixeln13(x1,y1,couleur)
                                           else putpixeln(x1,y1,couleur);
                              exit;
                             end;
 for y:=y1 to y2 do
 for x:=x1 to x2 do if vmode=$13 then putpixeln13(x,y,couleur)
                                 else putpixeln(x,y,couleur);
End;

PROCEDURE mode_vesa(mode:word);
begin
 vmode:=mode;
 {mode:=mode or 32768;}
 asm
  mov ah,4fh
  mov al,02h
  mov bx,mode
  int 10h
 end;
end;

PROCEDURE mode_graph(mode_g:byte);
begin
 vmode:=mode_g;
 asm
  mov ah,00
  mov al,mode_g
  int 10h
 end;
end;


Function linen(x1,y1,x2,y2:integer;coul:byte):boolean;
var ax,ay,bx,by:real;
    x,y:integer;
Begin
 if x1-x2<>0 then
 begin
  ax:=(y1-y2)/(x1-x2);
  bx:=y1-ax*x1;
  if x1<=x2 then
   for x:=x1 to x2 do putpixeln13(x,round(ax*x+bx),coul) else
   for x:=x2 to x1 do putpixeln13(x,round(ax*x+bx),coul);
 end;

 if y1-y2<>0 then
 begin
  ay:=(x1-x2)/(y1-y2);
  by:=x1-ay*y1;
  if Y1<=y2 then
   for y:=y1 to y2 do putpixeln13(round(ay*y+by),y,coul) else
   for y:=y2 to y1 do putpixeln13(round(ay*y+by),y,coul);
 end;
End;


Procedure cleardevicen(coul:byte);
Begin
 fillchar(mem[$a000:0],64000,coul);
End;

Procedure putn(x,y:longint;c:byte);
var segn,offn:word;
    g:longint;
Begin
 g:=x+y*640;
 {segn:=(g div 32768)*8;}
 segn:=(g shr 15);
 {offn:=g mod 32768;}
 offn:=g-(segn shl 15);
 segn:=segn shl 3;

 if saute<>segn then change(segn);
 mem[$a000:offn]:=c;
End;

Function linen64(x1,y1,x2,y2:integer;coul:byte):boolean;
var ax,ay,bx,by:real;
    x,y:integer;
Begin
 if x1-x2<>0 then
 begin
  ax:=(y1-y2)/(x1-x2);
  bx:=y1-ax*x1;
  if x1<=x2 then
   for x:=x1 to x2 do putn(x,round(ax*x+bx),coul) else
   for x:=x2 to x1 do putn(x,round(ax*x+bx),coul);
 end;

 if y1-y2<>0 then
 begin
  ay:=(x1-x2)/(y1-y2);
  by:=x1-ay*y1;
  if Y1<=y2 then
   for y:=y1 to y2 do putn(round(ay*y+by),y,coul) else
   for y:=y2 to y1 do putn(round(ay*y+by),y,coul);
 end;
End;

Procedure cleardevicen64(coul:byte);
var i:byte;
Begin
 i:=0;
 repeat
  fillchar(mem[$a000:0],32768,coul);
  change(i);
  inc(i,8);
 until i>80;
End;

const EV_STATC         = $3DA;       { Registre d'‚tat couleur EGA/VGA }
      EV_STATM         = $3BA;          { Registre d'‚tat mono EGA/VGA }
      EV_ATTR          = $3C0;         { Contr“leur d'attribut EGA/VGA }

procedure CLI; inline( $FA );                { Inhibe les interruptions}
procedure STI; inline( $FB );             { R‚tablit les interruptions }



BEGIN
END.