{$G+}
unit vgfx256;

interface

var
 ScreenSeg : word;
     vsptr : pointer;

procedure Graph320x200;
procedure Text80x25;
procedure Cls(color:integer);
procedure Pixel(x,y,color:integer);
procedure HorizLine(x,y,width,color:integer);
procedure VertLine(x,y,height,color:integer);
procedure Line(x1,y1,x2,y2,color:integer);
procedure Box(x,y,width,height,color:integer);
procedure Bar(x,y,width,height,color:integer);
procedure Rectangle(x,y,width,height,cborder,cfill:integer);
procedure SetRGB(reg,R,G,B:byte);
procedure GetRGB(reg:byte; var RGB);
procedure ShowImage(x,y,width,height:integer; var src);
procedure ShowImageTransparent(x,y,width,height:integer; var src);
procedure ShowAsSprite(x,y,width,height,flags:integer; var src);
procedure print(x,y,color:integer; const s:string);
procedure VirtualCharScreen(scrnOffs,chrsOffs:word);
procedure InitVirtualScreen;
procedure DoneVirtualScreen;
procedure ShowVirtualScreen;
procedure WaitRetraceStart;
procedure WaitRetraceEnd;
procedure WaitRetrace;

procedure SaveVGAScreen(const fname:string);


implementation

procedure Graph320x200; assembler; { turn on the graph mode }
asm
   mov  ax,0013h
   int  10h
end;

procedure Text80x25; assembler; { back to textmode }
asm
   mov  ax,0003h
   int  10h
end;

procedure Cls(color:integer); assembler;
asm
   mov  ax,color
   mov  ah,al
   cld
   mov  ES,ScreenSeg
   xor  di,di
   mov  cx,32000
   rep  stosw
end;

procedure Pixel(x,y,color:integer); assembler;
asm
   mov  ES,ScreenSeg
   mov  ax,320
   mul  y
   add  ax,x
   mov  bx,ax
   mov  al,color.byte
   mov  ES:[bx],al
end;

procedure HorizLine(x,y,width,color:integer); assembler;
asm
   mov  ES,ScreenSeg
   mov  ax,320
   mul  y
   add  ax,x
   mov  di,ax
   mov  al,color.byte
   mov  cx,width
   cld
   rep  stosb
end;


procedure VertLine(x,y,height,color:integer); assembler;
asm
   mov  ES,ScreenSeg
   mov  ax,320
   mul  y
   add  ax,x
   mov  di,ax
   mov  al,color.byte
   mov  cx,height
@l0:
   mov  ES:[di],al
   add  di,320
   loop @l0
end;

{ line steps for the 8 different directions }
const
   Ntab : array[0..11] of integer=(-321,-320,-319,000,
                                   -001, 000, 001,000,
                                    319, 320, 321,000);
var
   r1,r2,r3,r4,r5 : word; { some space to store temporary data }

procedure Line(x1,y1,x2,y2,color:integer); assembler;
asm
   mov  ES,ScreenSeg     { Screensegment }

   mov  ax,320         { Address calculation }
   mul  y1
   add  ax,x1
   mov  di,ax

   mov  al,Color.byte
   mov  ES:[di],al     { We show the first pixel }

   mov  bx,0101h       { sgn X (BL), sgn Y (BH), both +1 }

   mov  dx,X2
   sub  dx,X1          { DX = X2-X1 }
   jnc  @t1
   neg  dx             { DX = abs X  (where X=X2-X1) }
   mov  bl,255         { BL = sgn X }
@t1:
   mov  si,Y2
   sub  si,Y1          { SI = Y2-Y1 }
   jnc  @t2
   neg  si             { SI = abs Y  (where Y=Y2-Y1) }
   mov  bh,255         { BH = sgn Y }
@t2:
   mov  cx,si          { CX = abs Y }
   mov  r2,bx          { r2 = sgn X sgn Y, we store them }

   cmp  dx,si          { what's the main direction? (X/Y) }
   jnc  @x_ge_y
   mov  r1,dx          { r1 = abs X }
   xor  bl,bl          { sgn X = 0 , X incremental line }
   jmp  @t3

@x_ge_y:
   test dx,dx          { abs X=abs Y=0 (it's only a pixel ) }
   jz   @exit
   mov  r1,si          { r1 = abs Y }
   mov  cx,dx          { cx = abs X }
   xor  bh,bh          { sgn Y = 0 , Y incremental line }
@t3:
   mov  r3,cx          { CX: number of pixels to draw }

   mov  ax,cx
   shr  ax,1           { AX = INT(CX/2) }

   { this main loop draws the line }

@line_loop:
   add  ax,r1          { increment }
   jc   @diag          { diagonal step }
   cmp  ax,r3
   jc   @vhl           { vertical or horizontal step }

@diag:                 { diagonal step }
   sub  ax,r3
   mov  r4,ax          { save AX  }
   mov  ax,r2          { orignal sgn X, sgn Y }
   jmp  @nextplot      { go to draw }

@vhl:                  { vertical or horizontal step }
   mov  r4,ax          { save AX  }
   mov  ax,bx          { computed sgn X and sgn Y  }

@nextplot:             { draw the pixel }
   mov  r5,bx          { save BX  }

   inc  al
   shl  al,1           { AL = (sgn X+1)*2, can be 0,2 or 4  }
   inc  ah
   shl  ah,3           { AH = (sgn Y+1)*8, can be 0,8 or 16 }
   add  al,ah
   xor  ah,ah
   lea  bx,Ntab        { BX points to the right element of Ntab }
   add  bx,ax
   add  di,[bx]        { so we make one step to the given direction }
   mov  al,Color.byte
   mov  ES:[di],al     { put the pixel }

   mov  ax,r4          { saved values back }
   mov  bx,r5
   loop @line_loop     { do the next step }
@exit:
end;


procedure Box(x,y,width,height,color:integer);
begin
 HorizLine(x,y,width,color);
 HorizLine(x,y+height-1,width,color);
 VertLine(x,y,height,color);
 VertLine(x+width-1,y,height,color);
end;

procedure Bar(x,y,width,height,color:integer); assembler;
asm
   mov  ES,ScreenSeg      { Screen segment }
   mov  ax,320
   mul  y
   add  ax,x
   mov  bx,ax           { Address calculation, store the result in BX }
   mov  al,color.byte
   cld
   mov  dx,height       { height of the bar in the DX }
@l0:
   mov  cx,width
   mov  di,bx
   rep  stosb           { draw one horizontal line    }
   add  bx,320          { address for the next line   }
   dec  dx
   jnz  @l0             { loop draws all horiz. lines }
end;

procedure Rectangle(x,y,width,height,cborder,cfill:integer);
begin
   Bar(x,y,width,height,cfill);
   Box(x,y,width,height,cborder);
end;

procedure SetRGB(reg,R,G,B:byte);                            assembler;
asm
   mov  dx,03c8h       { RGB write register        }
   mov  al,reg
   out  dx,al          { Set the palette index     }
   inc  dx             { $03c9 RGB data register   }
   mov  al,R           { Red component             }
   out  dx,al
   mov  al,G           { Green component           }
   out  dx,al
   mov  al,B           { Blue component            }
   out  dx,al
end;

procedure GetRGB(reg:byte; var RGB);                         assembler;
asm
   cld
   les  di,RGB
   mov  dx,03c7h       { RGB read register       }
   mov  al,reg
   out  dx,al          { Set the palette index   }
   add  dl,2           { $03c9 RGB data register }
   in   al,dx
   stosb               { Red   }
   in   al,dx
   stosb               { Green }
   in   al,dx
   stosb               { Blue  }
end;

procedure ShowImage(x,y,width,height:integer; var src); assembler;
asm
   push DS
   mov  ES,ScreenSeg      { Screen segment }
   mov  ax,320
   mul  y
   add  ax,x
   mov  bx,ax           { Address calculation, store the result in BX }
   cld
   lds  si,src

   mov  dx,height
@l0:
   mov  cx,width
   mov  di,bx           { show one line from the source data }
   rep  movsb
   add  bx,320          { address for the next line }
   dec  dx
   jnz  @l0             { draw all lines }

   pop  DS
end;

procedure ShowImageTransparent(x,y,width,height:integer; var src); assembler;
asm
   push DS
   mov  ES,ScreenSeg      { Screen segment }
   mov  ax,320
   mul  y
   add  ax,x
   mov  bx,ax           { Address calculation, store the result in BX }
   cld
   lds  si,src

   mov  dx,height
@l0:
   mov  cx,width
   mov  di,bx

@l1:
   lodsb                { get the pixel from the source data }
   test al,al           { skip if the value is zero          }
   jz   @skip
   mov  ES:[di],al      { put the pixel                      }
@skip:
   inc  di              { next pixel position                }
   loop @l1             { draw all pixels in this line       }

   add  bx,320          { address for the next line          }
   dec  dx
   jnz  @l0             { draw all lines                     }

   pop  DS
end;


procedure ShowAsSprite(x,y,width,height,flags:integer; var src); assembler;
asm
   push DS
   mov  ES,ScreenSeg    { Screen segment }
   mov  ax,320
   imul y
   add  ax,x
   mov  di,ax           { Address calculation, store the result in DI }
   cld
   lds  si,src

   mov  dx,y

   mov  ch,height.byte
@l0:
   cmp  dx,0
   jl   @nextline
   cmp  dx,199
   jg   @nextline

   mov  bx,x
   mov  cl,width.byte
   push di

@l1:
   lodsb                { get the pixel from the source data }

   cmp  bx,0
   jl   @nextpixel
   cmp  bx,319
   jg   @nextpixel

   test al,al           { skip if the value is zero          }
   jz   @skip
   test flags,2         { background sprite?                 }
   jz   @show
   cmp  byte ptr ES:[di],0
   jnz  @skip
@show:
   mov  ES:[di],al      { put the pixel                      }
@skip:

@nextpixel:
   inc  di              { next pixel position                }
   inc  bx              { inc X }
   dec  cl
   jnz  @l1             { draw all pixels in this line       }

   pop  di

@nextline:
   add  di,320
   inc  dx              { inc Y }
   dec  ch
   jnz  @l0             { draw all lines                     }

   pop  DS
end;

  { character bitmaps - data stored in the code segment }

procedure chr6x7_dat; assembler;
asm
  db  $00,$00,$00,$00,$00,$00,$00,$00,$20,$20,$20,$20,$00,$20,$00,$50
  db  $50,$00,$00,$00,$00,$00,$50,$f8,$50,$50,$f8,$50,$00,$20,$f8,$a0
  db  $f8,$28,$f8,$00,$c8,$d0,$20,$20,$58,$98,$00,$40,$a0,$40,$a8,$90
  db  $68,$00,$20,$40,$00,$00,$00,$00,$00,$20,$40,$40,$40,$40,$20,$00
  db  $20,$10,$10,$10,$10,$20,$00,$50,$20,$f8,$20,$50,$00,$00,$20,$20
  db  $f8,$20,$20,$00,$00,$00,$00,$00,$60,$20,$40,$00,$00,$00,$f8,$00
  db  $00,$00,$00,$00,$00,$00,$00,$60,$60,$00,$00,$08,$10,$20,$40,$80
  db  $00,$70,$88,$98,$a8,$c8,$70,$00,$20,$60,$20,$20,$20,$70,$00,$70
  db  $88,$08,$70,$80,$f8,$00,$f8,$10,$30,$08,$88,$70,$00,$20,$40,$90
  db  $90,$f8,$10,$00,$f8,$80,$f0,$08,$88,$70,$00,$70,$80,$f0,$88,$88
  db  $70,$00,$f8,$08,$10,$20,$20,$20,$00,$70,$88,$70,$88,$88,$70,$00
  db  $70,$88,$88,$78,$08,$70,$00,$30,$30,$00,$00,$30,$30,$00,$30,$30
  db  $00,$30,$10,$20,$00,$00,$10,$20,$40,$20,$10,$00,$00,$f8,$00,$f8
  db  $00,$00,$00,$00,$20,$10,$08,$10,$20,$00,$70,$88,$10,$20,$00,$20
  db  $00,$70,$90,$a8,$b8,$80,$70,$00,$70,$88,$88,$f8,$88,$88,$00,$f0
  db  $88,$f0,$88,$88,$f0,$00,$70,$88,$80,$80,$88,$70,$00,$e0,$90,$88
  db  $88,$90,$e0,$00,$f8,$80,$f0,$80,$80,$f8,$00,$f8,$80,$f0,$80,$80
  db  $80,$00,$70,$88,$80,$98,$88,$70,$00,$88,$88,$f8,$88,$88,$88,$00
  db  $70,$20,$20,$20,$20,$70,$00,$10,$10,$10,$10,$90,$60,$00,$90,$a0
  db  $c0,$a0,$90,$88,$00,$80,$80,$80,$80,$80,$f8,$00,$88,$d8,$a8,$88
  db  $88,$88,$00,$88,$c8,$a8,$98,$88,$88,$00,$70,$88,$88,$88,$88,$70
  db  $00,$f0,$88,$88,$f0,$80,$80,$00,$70,$88,$88,$a8,$98,$70,$00,$f0
  db  $88,$88,$f0,$90,$88,$00,$70,$80,$70,$08,$88,$70,$00,$f8,$20,$20
  db  $20,$20,$20,$00,$88,$88,$88,$88,$88,$70,$00,$88,$88,$88,$88,$50
  db  $20,$00,$88,$88,$88,$a8,$a8,$50,$00,$88,$50,$20,$20,$50,$88,$00
  db  $88,$50,$20,$20,$20,$20,$00,$f8,$10,$20,$40,$80,$f8,$00,$60,$40
  db  $40,$40,$40,$60,$00,$00,$80,$40,$20,$10,$08,$00,$30,$10,$10,$10
  db  $10,$30,$00,$20,$50,$88,$00,$00,$00,$00,$00,$00,$00,$00,$00,$f8
  db  $00,$f8,$f8,$f8,$f8,$f8,$f8
end;

{ input: ES:di - points to the screen
            al - charcode
            dl - color }
procedure putchar; assembler;
asm
   push si              { save registers }
   push di
   push cx

   sub  al,32           { we don't have the 1st 32 ascii chars }
   mov  ah,7
   mul  ah              { character bitmap offset = 7*charcode }

   lea  si,chr6x7_dat
   add  si,ax           { DS:si points to the bitmap }

   mov  cl,7
@l0:
   segCS lodsb          { next byte from the bitmap }
   mov  ch,6
@l1:
   shl  al,1            { shift out 1 bit }
   jnc  @skip
   mov  ES:[di],dl      { show the pixel }
@skip:
   inc  di
   dec  ch              { all pixels in a line }
   jnz  @l1
   add  di,320-6        { next line }
   dec  cl
   jnz  @l0             { all lines }

   pop  cx              { load registers back from the stack }
   pop  di
   pop  si
   retn                 { near return }
end;

procedure print(x,y,color:integer; const s:string); assembler;
asm
   mov  ES,ScreenSeg      { Screen segment }
   mov  ax,320
   mul  y
   add  ax,x
   mov  di,ax           { Address calculation, store the result in DI }
   cld

   mov  dl,color.byte   { color to the DL }
   mov  bx,DS           { save DS         }
   lds  si,s            { source string   }
   lodsb
   mov  cl,al           { 1st byte : length }
   xor  ch,ch
   jcxz @quit           { quit if it's an empty string }

@chrloop:
   lodsb                { get next charcode }
   call near ptr putchar{ show the char - near procedure call }
   add  di,6            { next screen position }
   loop @chrloop        { show all chars  }

@quit:
   mov  DS,bx           { restore DS      }
end;

procedure VirtualCharScreen(scrnOffs,chrsOffs:word); assembler;
asm
   cld
   xor  di,di
   mov  ES,ScreenSeg
   mov  bx,scrnOffs

   mov  dx,25
@sloop:
   push di
   mov  ch,40
@cline:
   { character calculation }
   xor  ax,ax
   mov  al,[bx]
   inc  bx
   shl  ax,6
   mov  si,chrsOffs
   add  si,ax

   { 1 graphic char }
   mov  cl,8
@cloop:
   movsw
   movsw
   movsw
   movsw
   add  di,320-8
   dec  cl
   jnz  @cloop
   add  di,8-8*320
   dec  ch
   jnz  @cline
   pop  di
   add  di,8*320
   dec  dx
   jnz  @sloop

end;

procedure InitVirtualScreen;
begin
 if vsptr=nil then getmem(vsptr,64000);
 ScreenSeg:=seg(vsptr^);
end;

procedure DoneVirtualScreen;
begin
 if vsptr<>nil then freemem(vsptr,64000);
end;

procedure ShowVirtualScreen; assembler;
asm
   push DS
   cld
   mov  cx,32000
   xor  si,si
   xor  di,di
   mov  ES,SegA000
   mov  DS,ScreenSeg
   rep  movsw
   pop  DS
end;

procedure WaitRetraceStart;                                     assembler;
asm
   mov  dx,$03da
@wait:
   in   al,dx
   and  al,8
   jz   @wait
end;

procedure WaitRetraceEnd;                                       assembler;
asm
   mov  dx,$03da
@wait:
   in   al,dx
   and  al,8
   jnz  @wait
end;

procedure WaitRetrace;
begin
 WaitRetraceStart;
 WaitRetraceEnd;
end;



procedure bmpheader; assembler;
asm
 db $42,$4D,$36,$FE,$00,$00,$00,$00,$00,$00,$36,$04,$00,$00,$28,$00
 db $00,$00,$40,$01,$00,$00,$C8,$00,$00,$00,$01,$00,$08,$00,$00,$00
 db $00,$00,$00,$FA,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$01
 db $00,$00,$00,$01,$00,$00
end;

procedure SavePalette(var f:file);
var
   RGB : array[0..3] of byte;
     i : integer;
     t : byte;
begin
 for i:=0 to 255 do
  begin
   GetRGB(i,RGB);
   t:=RGB[0];
   RGB[0]:=RGB[2] shl 2;
   RGB[1]:=RGB[1] shl 2;
   RGB[2]:=t shl 2;
   RGB[3]:=0;

   blockwrite(f,RGB,4);
  end;
end;

procedure SaveScreen(var f:file);
var
   i : integer;
begin
 for i:=199 downto 0 do
  begin
   blockwrite(f,mem[ScreenSeg:i*320],320);
  end;
end;

procedure SaveVGAScreen(const fname:string);
var
   f : file;
   p : pointer;
begin
 assign(f,fname);
 rewrite(f,1);
 p:=@bmpheader;
 blockwrite(f,p^,54);
 SavePalette(f);
 SaveScreen(f);
 close(f);
end;

BEGIN
 ScreenSeg:=SegA000;
 vsptr:=nil;
END. { of unit gfx256 }