PC Underground/UNDERGROUND.ISO/graphic/scal_tst.pas

Pascal/Delphi Source File | 1995-08-02 | 6KB | 140 lines

{$G+}
Uses Crt,Sprites,ModeXLib,Gif,Tools;


Procedure PutScalSprt(pg_ofs,x,y,scale_y:Integer;qsprite:spritetyp);
var planecount,                 {counter of copied planes}
    planemask:Byte;             {masks 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 line,}
    dty:Word;                   {height}
    source:Pointer;             {pointer to graphic data, if ds modified}

    ppp:Array[0..3] of Byte;    {number of pixels per plane}
    rel_y,                      {fractional portion of rel. y-position}
    add_y:Word;                 {fractional value of the addend}
    direction:Integer;          {direction of movement (+/- 80)}
    i:Word;                     {local loop counter}
Begin
  if (x + qsprite.dtx > 319)    {Clipping ? then cancel}
  or (x < 0)
  or (y + qsprite.dty*scale_y div 100 > 199) or (y < 0) then exit;
  add_y:=100-abs(scale_y);      {calculate addend}
  if scale_y < 0 then direction:=-80 else direction:=80;
                                {define direction}
  Source:=qsprite.addr;         {Pointer graphic data}
  dty:=qsprite.dty;             {load local Height variable}
  plane:=x mod 4;               {calculate start plane}
  ofs:=pg_ofs+80*y+(x div 4);   {and offset}
  Width:=0;                     {preinitialize Width and Skip}
  Skip:=0;

  i:=qsprite.dtx shr 2;         {number of even blocks of 4}
  ppp[0]:=i;ppp[1]:=i;          {equals the 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}
asm
  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 start 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 planecount,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 skip each time}
  mov ax,direction              {obtain difference direction width}
  sub ax,cx
  mov skip,ax                   {and write in skip}

  mov rel_y,0                   {start again with y=0,0}

  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 through TS - Register 2 (Write Plane Mask)}
  mov dx,3c4h                   {set}
  out dx,ax
  mov bx,dty                    {initialize y-counter}
@lcopy_y:                       {y-loop, run once per row}
@lcopy_x:                       {x-loop, run once per pixel}
  lodsb                         {get byte}
  or al,al                      {if 0, then skip}
  je @Value0
  stosb                         {else set}
@entry:
  loop @lcopy_x                 {and loop continues}

  mov ax,rel_y                  {addend to fractional portion}
  add ax,add_y
  cmp ax,100                    {integer place incremented ?}
  jb @noaddovfl                 {no, then continue}
  sub ax,100                    {else reset decimal place}
  sub di,direction              {and in next/previous line}
@noaddovfl:
  mov rel_y,ax                  {and rewrite in fractional portion}

  dec bx                        {continue y-counter}
  je @plane_finished            {y-counter = 0, then next plane}
  add di,skip                   {else skip to next line beginning}
  mov cx,Width                  {reinitialize x-counter,}
  jmp @lcopy_y                  {jump back to y-loop}
@value0:                        {sprite color 0:}
  inc di                        {skip destination byte}
  jmp @entry                    {and back to loop}
@plane_finished:                {y-loop ends here}

  rol planemask,1               {mask next plane}
  mov cl,planemask              {plane 0 selected ?}
  and cx,1                      {(Bit 1 set), then}
  add ofs,cx                    {increase destination offset by 1 (Bit 1 !)}
  inc plane                     {increment plane number (Index in ppp)}
  and plane,3                   {reduce to 0 to 3}
  dec planecount                {4 planes copied already ?, then end}
  jne @lplane
  pop ds                        {restore ds, and see you later}
End;{asm}
End;

Var Logo:SpriteTyp;
    Sine:Array[0..99] of Word;
    Height:Integer;
    i:Word;


Begin
  Init_ModeX;                   {enable Mode X}
  LoadGif('sprites');           {load image with logo}
  GetSprite(88+ 6*320,150,82,Logo);    {initialize logo}
  LoadGif('wallpape');          {load wallpaper}
  p13_2_ModeX(48000,16000);     {and copy to background page}
  Sin_Gen(Sine,100,100,0);      {precalculate sine}
  I:=0;                         {index in sine to 0}
  repeat
    Inc(i);                     {increment index}
    Height:=Integer(Sine[i mod 100]); {get height from sine}
    CopyScreen(vpage,48000);    {clear background}
    PutScalSprt(vpage,85,100-Height *84 div 200,Height,Logo);
                                {copy scaled sprite to current page}
    Switch;                     {switch to this page}
    WaitRetrace;                {and wait for retrace}
  Until KeyPressed;
  ReadLn;
  TextMode(3);                  {normal text mode on}
End.