home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 18 / CD_ASCQ_18_111294_W.iso / dos / prg / pas / pasgraph / sprite.pas < prev    next >
Pascal/Delphi Source File  |  1994-07-07  |  12KB  |  365 lines
  1. program SpriteGame;         {Verifies a VGA is present}
  2. {$G+,R-}
  3. (* jh  Syntax:  spritegame.exe  [number]
  4.   optional number is the total population of sprites.  Default is maxsprites.
  5. *)
  6. { Original Sprites program by Bas van Gaalen, Holland, PD }
  7. { Modified by Luis Mezquita Raya }
  8. { Modified by John Howard (jh) into a game }
  9. { 30-MAY-1994 jh Version 1.0
  10.   Now a game to see which sprite survives the longest.
  11.   Renamed tScrArray to Screen, and tSprArray to SpriteData.
  12.   Removed CRT unit & saved around 1616 bytes.  Added command line parameter.
  13.   Added timer and energy definitions to provide statistics.
  14.   21-JUN-1994 jh Version 1.1 = ~7.5k
  15.   Added OnlyVGA and SetMode procedures.  Added CharSet & CharType definitions.
  16.   Implemented characters as sprites.
  17.   29-JUN-1994 jh Version 1.2 = ~8.5k due to command line help
  18.   Places identification on each sprite by using HexDigits.  CharColor defaults
  19.   to sprite number (0..maxsprites) as a color index in the palette.  Fixed bug
  20.   in moire background screen limits.
  21. }
  22. const
  23.       maxsprites=128;                   { Number of sprites is [1..128] }
  24.       pxsize=320;                       { screen x-size }
  25.       pysize=200;                       { screen y-size }
  26.       xsize=32;                         { sprite x-size }
  27.       ysize=32;                         { sprite y-size }
  28.       CharRows=8;                       { Characters are 8 rows high }
  29.       HexDigits : ARRAY[0..15] OF Char = '0123456789ABCDEF';
  30.  
  31. type
  32.       Screen=array[0..pysize-1, 0..pxsize-1] of byte;
  33.       pScreen=^Screen;
  34.       SpriteData=array[0..ysize-1, 0..xsize-1] of byte;
  35.       pSpriteData=^SpriteData;
  36.       SprRec=record
  37.               x,y : word;              {Absolute location of sprite}
  38.               xspd,yspd : shortint;    {Velocity horizontal and vertical}
  39.               energy : shortint;       {Hide is neg., dead is 0, show is pos.}
  40.               buf : pSpriteData;       {Rectangle of sprite definition}
  41.              end;
  42.       CharType = array[1..CharRows] of Byte;
  43.  
  44. var
  45.       CharSet : array[0..255] of CharType absolute $F000:$FA6E;
  46.       sprite : array[1..maxsprites] of SprRec;
  47.       vidscr,virscr,bgscr : pScreen;   {video, virtual, background screens}
  48.       dead : byte;                     {Counts the dead sprites}
  49.       survivor : byte;                 {Identify the last dead sprite}
  50.       Population : word;               {Population from 1..128}
  51.       {CharColor : byte;}              {Character digit color 0..255}
  52.  
  53.       Timer : longint;                 {Stopwatch}
  54.       H, M, S, S100 : Word;
  55.       Startclock, Stopclock : Real;
  56.       mins, secs     : integer;
  57.       Code: integer;                     {temporary result of VAL conversion}
  58.  
  59. procedure GetTime(var Hr, Mn, Sec, S100 : word); assembler; {Avoids DOS unit}
  60. asm
  61.     mov ah,2ch
  62.     int 21h
  63.     xor ah,ah                 {fast register clearing instead of MOV AH,0}
  64.     mov al,dl
  65.     les di,S100
  66.     stosw
  67.     mov al,dh
  68.     les di,Sec
  69.     stosw
  70.     mov al,cl
  71.     les di,Mn
  72.     stosw
  73.     mov al,ch
  74.     les di,Hr
  75.     stosw
  76. end;
  77.  
  78. procedure StartTimer;
  79. begin
  80.   GetTime(H, M, S, S100);
  81.   StartClock := (H * 3600) + (M * 60) + S + (S100 / 100);
  82. end;
  83.  
  84. procedure StopTimer;
  85. begin
  86.   GetTime(H, M, S, S100);
  87.   StopClock := (H * 3600) + (M * 60) + S + (S100 / 100);
  88.   Timer := trunc(StopClock - StartClock);
  89.   secs := Timer mod 60;                             {Seconds remaining}
  90.   mins := Timer div 60;                             {Reduce into minutes}
  91. end;
  92. function KeyPressed : boolean; assembler;   {Avoids unit CRT.KeyPressed}
  93. asm
  94.     mov ah,01h;    int 16h;    jnz @0;    xor ax,ax;    jmp @1;
  95. @0: mov al,1
  96. @1:
  97. end;
  98.  
  99.  
  100. procedure SetMode(M:byte); assembler;
  101. asm
  102.     mov ah,0;        mov al,M;        int 10h;
  103. end;
  104. procedure SetPal(col,r,g,b:byte); assembler;      {256 color palette}
  105. asm
  106.     mov dx,03c8h
  107.     mov al,col             {color}
  108.     out dx,al
  109.     inc dx
  110.     mov al,r               {red component}
  111.     out dx,al
  112.     mov al,g               {green component}
  113.     out dx,al
  114.     mov al,b               {blue component}
  115.     out dx,al
  116. end;
  117. procedure flip(srcscr, destscr : pScreen); assembler;   {copy screen}
  118. asm
  119.     push ds
  120.     lds si,srcscr
  121.     les di,destscr
  122.     mov cx,pxsize*pysize/2
  123.     rep movsw
  124.     pop ds
  125. end;
  126. procedure cls(scr : pScreen); assembler;   {clear screen}
  127. asm
  128.     les di,scr;  xor ax,ax;  mov cx,pxsize*pysize/2;  rep stosw
  129. end;
  130. procedure retrace; assembler;
  131. asm
  132.         mov dx,03dah
  133. @vert1: in al,dx
  134.         test al,8
  135.         jnz @vert1
  136. @vert2: in al,dx
  137.         test al,8
  138.         jz @vert2
  139. end;
  140. procedure PutSprite(var sprite: SprRec; virseg: pScreen); assembler;
  141. asm
  142.         push ds
  143.         lds si,sprite                   { get sprite segment }
  144.         les di,virseg                   { get virtual screen segment }
  145.         mov ax,SprRec[ds:si].y
  146.         shl ax,6
  147.         mov di,ax
  148.         shl ax,2
  149.         add di,ax                       { y*pxsize }
  150.         add di,SprRec[ds:si].x          { y*pxsize+x }
  151.         mov dx,pxsize-xsize             { number of pixels left on line }
  152.         lds si,SprRec[ds:si].buf
  153.         mov bx,ysize
  154. @l1:    mov cx,xsize
  155. @l0:    lodsb
  156.         or al,al
  157.         jz @skip                        { check if transparent "Black" }
  158.         mov es:[di],al                  { draw it }
  159. @skip:  inc di
  160.         dec cx
  161.         jnz @l0
  162.         add di,dx
  163.         dec bx
  164.         jnz @l1
  165.         pop ds
  166. end;
  167. procedure OnlyVGA; assembler;
  168. asm
  169.   @CheckForVga: {push    es}
  170.                 mov     AH,1ah         {Get Display Combination Code}
  171.                 mov     AL,00h         {AX := $1A00;}
  172.                 int     10h            {Intr($10, Regs);}
  173.                 cmp     AL,1ah         {IsVGA:= (AL=$1A) AND((BL=7) OR(BL=8))}
  174.                 jne     @NoVGA
  175.                 cmp     BL,07h         {VGA w/ monochrome analog display}
  176.                 je      @VgaPresent
  177.                 cmp     BL,08h         {VGA w/ color analog display}
  178.                 je      @VgaPresent
  179.   @NoVGA:
  180.                 mov     ax,3           {text mode}
  181.                 int     10h
  182.                 push    cs
  183.                 pop     ds
  184.                 lea     dx,@message
  185.                 mov     ah,9
  186.                 int     21h            {print $ terminated string}
  187.                 mov     ax,4c00h
  188.                 int     21h            {terminate}
  189.   @message:     db      'Sorry, but you need a VGA to see this!',10,13,24h
  190.   @VgaPresent:  {pop     es}
  191.   {... After here is where your VGA code can execute}
  192. end;  {OnlyVGA}
  193.  
  194.  
  195.  
  196. VAR   n : byte;               {sprite number}
  197.       hx,hy,i,j,k,np : integer;
  198. BEGIN  {PROGRAM}
  199.  {Get text from command line and convert into a number}
  200.  Val(ParamStr(1), Population, Code);
  201.  if (Code <> 0)    {writeln('Bad number at position: ', Code);}
  202.    OR (Population <1) OR (Population > maxsprites) then
  203.    Population := maxsprites;    {default}
  204.  if ParamStr(1) = '?' then
  205.    begin
  206.     writeln('Howard International, P.O. Box 34633, NKC, MO 64116 USA');
  207.     writeln('1994 Freeware Sprite Game v1.2');
  208.     writeln('Syntax:  spritegame.exe  [number]');
  209.     writeln('         optional number is the total population of sprites (1 to 128)');
  210.     halt;
  211.    end;
  212.  
  213.  {CharColor := Population;}
  214.  OnlyVGA;
  215.  SetMode($13);                  {320x200x256x1 plane}
  216.  Randomize;
  217.  vidscr := Ptr($A000,0);
  218.  New(virscr); cls(virscr); New(bgscr); cls(bgscr);
  219.  np := 128 div Population;
  220.  for i := 0 to Population-1 do
  221.   begin  {Define moire background pattern}
  222.    case i mod 6 of
  223.     0:begin
  224.        hx := 23;       hy := i*np;       n := 0;
  225.       end;
  226.     1:begin
  227.        hx := i*np;     hy := 23;         n := 0;
  228.       end;
  229.     2:begin
  230.        hx := i*np;     hy := 0;          n := 23;
  231.       end;
  232.     3:begin
  233.        hx := 23;       hy := 0;          n := i*np;
  234.       end;
  235.     4:begin
  236.        hx := 0;        hy := 23;         n := i*np;
  237.       end;
  238.     5:begin
  239.        hx:= 0;         hy:= i*np;        n := 23;
  240.       end;
  241.    end;
  242.    for j := 0 to np-1 do
  243.     begin
  244.      k := j shr 1;
  245.      SetPal(np*i+j+1, k+hx, k+hy, k+n);
  246.     end;
  247.   end;
  248.  
  249.  for i := 1 to 127 do SetPal(127+i, i div 3, 20+i div 5, 20+i div 7);
  250.  for i := 0 to pxsize-1 do     {jh bug!  Reduce to legal screen limits}
  251.    for j := 0 to pysize-1 do
  252.      bgscr^[j,i] := 128+ ABS(i*i - j*j) and 127;
  253. (*
  254.  flip(bgscr, vidscr);               {copy background to video}
  255.  {SetPal(?,r,g,b)}                  {force a visible text palette entry}
  256.  writeln('Sprite Game v1.2 ');      {modify video}
  257.  flip(vidscr, bgscr);               {copy video to background}
  258. *)
  259.  hx := xsize shr 1;
  260.  hy := ysize shr 1;
  261.  for n := 1 to Population do
  262.   begin
  263.    with sprite[n] do
  264.     begin
  265.      x := 20+ random(280 - xsize);
  266.      y := 20+ random(160 - ysize);
  267.      xspd := random(6) - 3;
  268.      yspd := random(6) - 3;
  269.      energy := random(10);         {punishes liberals}
  270.      if xspd=0 then
  271.        begin
  272.         xspd := 1;
  273.         energy := random(20);      {average life expectancy}
  274.        end;
  275.      if yspd=0 then
  276.        begin
  277.         yspd := 1;
  278.         energy := random(40);      {rewards conservatives}
  279.        end;
  280.      New(buf);
  281.      for i := 0 to xsize-1 do
  282.       for j := 0 to ysize-1 do
  283.        begin
  284.         k := (i-hx) * (i-hx) + (j-hy) * (j-hy);
  285.         if (k< hx*hx) and (k> hx*hx div 16)
  286.         then buf^[j,i] := k mod np  + np * (n-1)
  287.         else buf^[j,i] := 0;       {CRT color "Black" is transparent}
  288.        end;
  289.     end; {with}
  290.   end; {for}
  291.  
  292.  
  293.  
  294.   {jh Can store your own bitmap image in any sprite[n].buf^[j,i] such as: }
  295.   for i := 0 to xsize-1 do
  296.     for j := 0 to ysize-1 do
  297.       begin
  298.         sprite[1].buf^[j,i] := j;           {first sprite.  Horizontal bars}
  299.         sprite[Population].buf^[j,i] := i;  {last sprite.  Vertical bars}
  300.       end;
  301.  
  302.   {jh Get characters from default font and attach to sprites}
  303.   for i := 1 to CharRows do
  304.     for j := 1 to CharRows do
  305.       begin
  306.         for n := 1 to Population do
  307.           begin
  308.             {first hex digit for current sprite}
  309.             if (CharSet[ord(HexDigits[n SHR 4]),i] shr (8-j) and 1 = 1) then
  310.               sprite[n].buf^[i,j] := n       {CharColor}
  311.             else
  312.               sprite[n].buf^[i,j] := 0;      {transparent}
  313.             {second hex digit for current sprite}
  314.             if (CharSet[ord(HexDigits[n AND $F]),i] shr (8-j) and 1 =1) then
  315.               sprite[n].buf^[i,j+CharRows] := n   {CharColor}
  316.             else
  317.               sprite[n].buf^[i,j+CharRows] := 0;  {transparent}
  318.           end;
  319. (* {mark last sprite 'Z'}
  320.    sprite[Population].buf^[i,j] := CharSet[ord('Z'),i] shr (8-j) and 1; *)
  321.       end;
  322.  
  323.   {jh Keep track of the last dead sprite and how old it was. }
  324.   StartTimer;
  325.   while not (KeyPressed or (dead=Population)) do
  326.   begin
  327.   flip(bgscr, virscr);
  328.   retrace;
  329.   dead := 0;                         {reset the sentinel}
  330.   for n := 1 to Population do
  331.     with sprite[n] do
  332.     begin
  333.       if energy > 0 then PutSprite(sprite[n], virscr)     {show(n)}
  334.       { else if energy < 0 then hide(n) }
  335.       else inc(dead);
  336.       inc(x,xspd);
  337.       if (x<10) or (x > (310 - xsize)) then
  338.       begin
  339.         xspd := -xspd;
  340.         energy := energy - 1;
  341.       end;
  342.       inc(y,yspd);
  343.       if (y<10) or (y > (190 - ysize)) then
  344.       begin
  345.         yspd := -yspd;
  346.         energy := energy - 1;
  347.       end;
  348.     end; {with}
  349.   flip(virscr, vidscr);
  350.   end; {while}
  351.  
  352.   StopTimer;
  353.   survivor := 0;
  354.   for n := 1 to Population do
  355.     begin                           {find last dead sprite with zero energy}
  356.       if sprite[n].energy = 0 then survivor := n;
  357.       Dispose(sprite[n].buf);
  358.     end;
  359.   Dispose(virscr);  Dispose(bgscr);
  360.   SetMode($3);      {resume text video mode 3h= 80x25x16 color}
  361.   writeln('Last dead sprite was # ', survivor, ' of ', Population);
  362.   writeln('Time of death was ', trunc(StopClock));
  363.   writeln('Life span was ', mins:2, ' Minute and ', secs:2, ' Seconds');
  364. END.   {PROGRAM}
  365.