{$G+}
Unit Sprites;
Interface
Type SpriteTyp=Record           {structure of a sprite data block}
  Addr:Pointer;                 {pointer to graphic data}
  dtx,dty:Word;                 {width and height in pixels}
  px,py,                        {current position, optional *}
  sx,sy:Integer;                {current speed, optional *}
End;
{*: optional means that the sprite routines GetSprite and PutSprite
 don't use these specifications, the variables only serve to make
 control easier forthe main program}

Procedure GetSprite(Ofs,dtx,dty:Word;var zSprite:SpriteTyp);
{read a sprite from vscreen-Offset ofs, with dtx width and dty height,
 zsprite is the sprite record in which the sprite is to be saved}

Procedure PutSprite(pg_ofs,x,y:Integer;qsprite:spritetyp);
{copies sprite from RAM (position and size taken from qsprite)
 to video RAM page pg at position (x/y)}

Implementation
Uses ModeXLib;
Var i:Word;

Procedure GetSprite;
Var ppp:Array[0..3] of Byte;    {table with number of pixels to copy}
                                {per plane}
    Skip:word;                  {number of bytes to skip}
    Plane_Count:Word;           {counter of copied planes}
Begin
  GetMem(zsprite.addr,dtx*dty); {allocate RAM}
  zsprite.dtx:=dtx;             {note width and height in sprite record}
  zsprite.dty:=dty;

  i:=dtx shr 2;                 {number of smooth blocks of 4}
  ppp[0]:=i;ppp[1]:=i;          {equals minimum number of bytes to copy}
  ppp[2]:=i;ppp[3]:=i;
  For i:=1 to dtx and 3 do      {note "excess" pixels in ppp}
    Inc(ppp[(i-1) and 3]);      {add pixels beginning with Startplane}
  Plane_Count:=4;               {copy 4 planes}
asm
  push ds
  mov di,word ptr zsprite       {first load pointer to data block}
  les di,[di]                   {load pointer to graphic data in es:di}
  lea bx,ppp                    {bx points to ppp array}

  lds si,vscreen                {load pointer to image}
   add Ofs,si                   {offset of actual sprite data in addition}
@lcopy_plane:                   {will be performed once per plane}
  mov si,ofs                    {load si with start address of sprite data}
  mov dx,dty                    {load y-counter with row number}

  xor ah,ah                     {clear ah}
  mov al,ss:[bx]                {load al with current ppp entry}
  shl ax,2                      {blocks of 4 get moved}
  sub ax,320                    {obtain difference to 320}
  neg ax                        {make 320-ax out of ax-320}
  mov skip,ax                   {store value in skip}

@lcopy_y:                       {perform once per row}
  mov cl,ss:[bx]                {load width from ppp-array}
@lcopy_x:                       {perform once per pixel}
  movsb                         {copy byte}
  add si,3                      {to next pixel of this plane}
  dec cl                        {copy all the pixels of this row}
  jne @lcopy_x

  add si,skip                   {after that, at beginning of next row}
  dec dx                        {copy all rows}
  jne @lcopy_y

  inc bx                        {position at next ppp entry}
  inc ofs                       {position at new plane start}
  dec plane_count               {copy all planes}
  jne @lcopy_plane
  pop ds
End;
End;

Procedure PutSprite;
var plane_count,                {counter of copied planes}
    planemask:Byte;             {masked Write-Plane in TS-Register 2}
    Skip,                       {number of bytes to skip}
    ofs,                        {current offset in video RAM}
    plane,                      {number of current plane}
    Width,                      {width of bytes to be copied in a row,}
    dty:Word;                   {height}
    source:Pointer;             {pointer to graphic data, if ds modified}
    clip_lt, clip_rt:integer;   {number of excess PIXELS left and right}
    clipact_lt,                 {with current plane active number}
    clipact_rt,                 {excess BYTES}
    clip_dn,clip_up:Word;       {number of excess ROWS above and below}

    ppp:Array[0..3] of Byte;    {number of pixels per plane}
    cpp:Array[0..3] of Byte;    {excess BYTES per plane}

Begin
  if (x > 319) or               {Display unnecessary, }
  (x+qsprite.dtx < 0) or        {because it's not even in the picture ?}
  (y > 199) or
  (y+qsprite.dty < 0) then exit;
  clip_rt:=0;                   {no clipping normally}
  clip_lt:=0;                   {-> all clipping variables to 0}
  clip_dn:=0;
  clip_up:=0;
  clipact_rt:=0;
  clipact_lt:=0;
   with qsprite do begin
    if y+dty > 200 then begin   {first clipping case: down}
      clip_dn:=(y+dty-200);     {note excess rows}
      dty:=200-y;               {and reduce sprite height}
    End;
    if y<0 then begin           {second clipping case: up}
      clip_up:=-y;              {note excess rows}
      dty:=dty+y;               {and reduce sprite height}
      y:=0;                     {Start-y is 0, because upper screen border}
    End;
    if x+dtx > 320 then begin   {third clipping case: right}
      clip_rt:=x+dtx-320;       {note excess pixels}
      dtx:=320-x;               {reduce width}
    End;
    if x<0 then begin           {fourth clipping case: left}
      clip_lt:=-x;              {note excess pixels}
      plane:=4-(clip_lt mod 4); {calculate new start plane for column 0}
      plane:=plane and 3;       {reduce this to 0..3}
      ofs:=pg_ofs+80*y+((x+1) div 4) - 1;  {set Ofs to correct block of 4}
      x:=0;                     {begin display in column}
    End Else Begin              {no clipping to the right ?}
      plane:=x mod 4;           {then conventional calculation of plane}
      ofs:=pg_ofs+80*y+(x div 4); {and offset}
    End;
  End;
  Source:=qsprite.addr;         {pointer graphic data}
  dty:=qsprite.dty;             {and save height in local variables}
  Width:=0;                     {preinitialize width and skip}
  Skip:=0;

  i:=qsprite.dtx shr 2;         {even number blocks of 4}
  ppp[0]:=i;ppp[1]:=i;          {equals minimum number of bytes to be copied}
  ppp[2]:=i;ppp[3]:=i;
  For i:=1 to qsprite.dtx and 3 do{note "excess" pixels in ppp}
    Inc(ppp[(plane+i - 1) and 3]);{add pixels beginning with StartPlane}

  i:=(clip_lt+clip_rt) shr 2;
  cpp[0]:=i;cpp[1]:=i;          {Clipping default : all pages 0}
  cpp[2]:=i;cpp[3]:=i;
  For i:=1 to clip_rt and 3 do  {if right clipping, enter corresponding number}
    Inc(cpp[i-1]);              {in planes}
  For i:=1 to clip_lt and 3 do  {if left clipping, enter corresponding number}
    Inc(cpp[4-i]);              {in planes}

asm
  mov dx,3ceh                   {GDC Register 5 (GDC Mode)}
  mov ax,4005h                  {set to Write Mode 0}
  out dx,ax
  push ds                       {save ds}
  mov ax,0a000h                 {load destination segment (VGA)}
  mov es,ax

  lds si,source                 {source (pointer to graphic data) to ds:si}
  mov cx,plane                  {create starting plane mask}
  mov ax,1                      {move Bit 0 left by plane}
  shl ax,cl
  mov planemask,al              {save mask}
  shl al,4                      {enter in upper nibble also}
  or planemask,al
  mov plane_count,4             {4 planes to copy}
@lplane:                        {will run once per plane}
  mov cl,byte ptr plane         {load current plane}
  mov di,cx                     {in di}
  mov cl,byte ptr ppp[di]       {load cx with matching ppp number}
  mov byte ptr Width,cl         {recalculate step size}
  mov ax,80                     {difference from 80}
  sub al,cl
  mov byte ptr skip,al          {and copy to skip}

  mov al,byte ptr cpp[di]       {load plane specific clipping width}
  cmp clip_lt,0                 {if left no clipping, continue with right}
  je @right
  mov clipact_lt,ax             {save in clip_act_lt}
  sub Width,ax                  {reduce width of bytes to be copied}
  jmp @clip_rdy                 {no clipping right}
@right:                         {if left no clipping}
  mov clipact_rt,ax             {clipping for all planes, in clip_act}
@clip_rdy:
  mov ax,Width                  {calculate total width in bytes}
  add ax,clipact_rt
  add ax,clipact_lt
  mul clip_up                   {multiply by number of rows at top clipping}
  add si,ax                     {these bytes are not displayed}
  mov cx,Width                  {load cx with width}
  or cl,cl                      {width 0, then plane finished}
  je @plane_finished
  mov di,ofs                    {destination offset in video RAM to di}
  mov ah,planemask              {reduce plane mask to bit [0..3]}
  and ah,0fh
  mov al,02h                    {and via TS - Register 2 (Write Plane Mask)}
  mov dx,3c4h                   {set}
  out dx,ax
  mov bx,dty                    {initialize y-counter}
@lcopy_y:                       {y-loop,perform once per row}
  add si,clipact_lt             {add source pointer for left clipping}
  add di,clipact_lt             {destination pointer also}
@lcopy:                         {x-loop, perform once per pixel}
  lodsb                         {get byte}
  or al,al                      {if 0, then skip}
  je @Value0
  stosb                         {else set}
@entry:
  loop @lcopy                   {and continue loop}
  add si,clipact_rt             {after complete row right clipping}
  dec bx                        {continue y-counter}
  je @plane_finished            {y-counter = 0, then next plane}
  add di,skip                   {else skip to beginning of next row}
  mov cx,Width                  {reinitialize x-counter,}
  jmp @lcopy_y                  {jump back to y-loop}
@value0:                        {sprite color 0:}
  inc di                        {skip to destination byte}
  jmp @entry                    {and back to loop }
@plane_finished:                {y-loop ends here}
  mov ax,Width                  {calculate total width in bytes}
  add ax,clipact_rt
  add ax,clipact_lt
  mul clip_dn                   {multiply times number at bottom clipping}
  add si,ax                     {these bytes won't be displayed}
  rol planemask,1               {select next plane}
  mov cl,planemask              {plane 0 selected ?}
  and cx,1                      {(Bit 1 set), then}
  add ofs,cx                    {increase destination offset by 1 (cx Bit 1 !)}
  inc plane                     {increment plane number (Index in ppp)}
  and plane,3                   {reduce to 0 to 3}
  dec plane_count               {4 planes already copied ?, then end}
  jne @lplane
  pop ds                        {restore ds, and see you later}
End;{asm}
End;
Begin
End.
