home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 18 / CD_ASCQ_18_111294_W.iso / dos / prg / pas / gfxfx / minigam2.pas < prev    next >
Pascal/Delphi Source File  |  1994-06-22  |  11KB  |  382 lines
  1.  
  2. {$g+}
  3. program small_game; { shoot-em-up }
  4. { Small shoot'm'up game (right button=exit!), by Bas van Gaalen, Holland, PD }
  5. uses crt; { for 'delay' }
  6. const
  7.   vidseg:word=$a000;
  8.   playerbullits=50; pbacc=5; pbmaxtime=2;
  9.   compbullits=50; cbmaxtime=20; cbspd=3;
  10.   compspd=2;
  11. type
  12.   posrec=record x,y:integer; end;
  13.   realposrec=record x,y:real; end;
  14. var
  15.   pbs:array[0..playerbullits] of posrec;
  16.   pbspd:array[0..playerbullits] of byte;
  17.   cbs,cbdir:array[0..compbullits] of realposrec;
  18.   virscr:pointer;
  19.   score:longint;
  20.   fofs,fseg,virseg,px,py,ppx,ppy:word;
  21.   pbtimer,cbtimer,cenergy,penergy,range,cx,cy,pcx,pcy:integer;
  22.   cxd,cyd:shortint;
  23.  
  24. { mouse routines ----------------------------------------------------------- }
  25.  
  26. function mouseinstalled:boolean; assembler; asm
  27.   xor ax,ax; int 33h; cmp ax,-1; je @skip; xor al,al; @skip: end;
  28.  
  29. function getmousex:word; assembler; asm
  30.   mov ax,3; int 33h; mov ax,cx end;
  31.  
  32. function getmousey:word; assembler; asm
  33.   mov ax,3; int 33h; mov ax,dx end;
  34.  
  35. function leftpressed:boolean; assembler; asm
  36.   mov ax,3; int 33h; and bx,1; mov ax,bx end;
  37.  
  38. function rightpressed:boolean; assembler; asm
  39.   mov ax,3; int 33h; and bx,2; mov ax,bx end;
  40.  
  41. procedure mousesensetivity(x,y:word); assembler; asm
  42.   mov ax,1ah; mov bx,x; mov cx,y; xor dx,dx; int 33h end;
  43.  
  44. { video related routines --------------------------------------------------- }
  45.  
  46. procedure setpal(c,r,g,b:byte); assembler; asm
  47.   mov dx,3c8h; mov al,[c]; out dx,al; inc dx; mov al,[r]
  48.   out dx,al; mov al,[g]; out dx,al; mov al,[b]; out dx,al; end;
  49.  
  50. procedure getfont; assembler; asm
  51.   mov ax,1130h; mov bh,1; int 10h; mov fseg,es; mov fofs,bp; end;
  52.  
  53. procedure cls(lvseg:word); assembler; asm
  54.   mov es,[lvseg]; xor di,di; xor ax,ax; mov cx,320*200/2; rep stosw; end;
  55.  
  56. procedure flip(src,dst:word); assembler; asm
  57.   push ds; mov ds,[src]; xor si,si; mov es,[dst]
  58.   xor di,di; mov cx,320*200/2; rep movsw; pop ds; end;
  59.  
  60. procedure putpixel(x,y:word; c:byte; lvseg:word); assembler; asm
  61.   mov es,[lvseg]; mov ax,[y]; shl ax,6; mov di,ax; shl ax,2
  62.   add di,ax; add di,[x]; mov al,[c]; mov [es:di],al; end;
  63.  
  64. { move routines ------------------------------------------------------------ }
  65.  
  66. procedure moveplayer;
  67. var i:word;
  68. begin
  69.   ppx:=px; ppy:=py;
  70.   px:=getmousex shr 1; py:=getmousey;
  71.   if px<4 then px:=4 else if px>316 then px:=316;
  72.   if py<4 then py:=4 else if py>196 then py:=196;
  73.   if leftpressed then begin
  74.     dec(pbtimer);
  75.     if pbtimer<0 then begin
  76.       pbtimer:=pbmaxtime;
  77.       i:=0;
  78.       while (i<playerbullits) and (pbs[i].x>0) do inc(i);
  79.       if i<playerbullits then begin
  80.         pbs[i].x:=px;
  81.         pbs[i].y:=py;
  82.         pbspd[i]:=1;
  83.       end;
  84.     end;
  85.   end else pbtimer:=0;
  86. end;
  87.  
  88. procedure movecomputer;
  89. var i:word; rx,ry,difx,dify,big:integer;
  90. begin
  91.   pcx:=cx; pcy:=cy;
  92.   dec(range);
  93.   if range<0 then begin
  94.     range:=random(100);
  95.     case random(8) of
  96.       0:begin cxd:=-1; cyd:=-1; end;
  97.       1:begin cxd:=0; cyd:=-1; end;
  98.       2:begin cxd:=1; cyd:=-1; end;
  99.       3:begin cxd:=1; cyd:=0; end;
  100.       4:begin cxd:=1; cyd:=1; end;
  101.       5:begin cxd:=0; cyd:=1; end;
  102.       6:begin cxd:=-1; cyd:=1; end;
  103.       7:begin cxd:=-1; cyd:=0; end;
  104.     end;
  105.   end;
  106.   inc(cx,cxd*compspd);
  107.   inc(cy,cyd*compspd);
  108.   if cx<4 then begin cx:=4; range:=0; end
  109.   else if cx>316 then begin cx:=316; range:=0; end;
  110.   if cy<4 then begin cy:=4; range:=0; end
  111.   else if cy>196 then begin cy:=196; range:=0; end;
  112.   dec(cbtimer);
  113.   if cbtimer<0 then begin
  114.     cbtimer:=random(cbmaxtime);
  115.     i:=0;
  116.     while (i<compbullits) and (cbs[i].x>0) do inc(i);
  117.     if i<compbullits then begin
  118.       rx:=random(10)-5; ry:=random(10)-5;
  119.       cbs[i].x:=cx;
  120.       cbs[i].y:=cy;
  121.       if cx>(px+rx) then difx:=cx-(px+rx) else difx:=(px+rx)-cx;
  122.       if cy>(py+ry) then dify:=cy-(py+ry) else dify:=(py+ry)-cy;
  123.       if difx>dify then big:=difx else big:=dify;
  124.       if big<>0 then begin
  125.         cbdir[i].x:=cbspd*(difx/big);
  126.         cbdir[i].y:=cbspd*(dify/big);
  127.         if cx>(px+rx) then cbdir[i].x:=-cbdir[i].x;
  128.         if cy>(py+ry) then cbdir[i].y:=-cbdir[i].y;
  129.       end;
  130.     end;
  131.   end;
  132. end;
  133.  
  134. procedure moveplayerbullits;
  135. var i:word;
  136. begin
  137.   for i:=0 to playerbullits do
  138.     if pbs[i].x>0 then begin
  139.       dec(pbs[i].y,pbspd[i]);
  140.       if (pbs[i].y mod pbacc)=0 then inc(pbspd[i]);
  141.       if pbs[i].y<0 then begin
  142.         pbs[i].x:=0; pbs[i].y:=0; pbspd[i]:=0;
  143.       end;
  144.     end;
  145. end;
  146.  
  147. procedure movecompbullits;
  148. var i:word;
  149. begin
  150.   for i:=0 to compbullits do
  151.     if cbs[i].x>0 then begin
  152.       cbs[i].x:=cbs[i].x+cbdir[i].x;
  153.       cbs[i].y:=cbs[i].y+cbdir[i].y;
  154.       if (cbs[i].x<4) or (cbs[i].x>316) or
  155.          (cbs[i].y<4) or (cbs[i].y>196) then begin
  156.         cbs[i].x:=0; cbs[i].y:=0;
  157.         cbdir[i].x:=0; cbdir[i].y:=0;
  158.       end;
  159.     end;
  160. end;
  161.  
  162. { -------------------------------------------------------------------------- }
  163.  
  164. procedure writetxt(x,y:word; txt:string; lvseg:word);
  165. var i,j,k:byte;
  166. begin
  167.   for i:=1 to length(txt) do for j:=0 to 7 do for k:=0 to 7 do
  168.     if ((mem[fseg:fofs+ord(txt[i])*8+j] shl k) and 128) <> 0 then
  169.       mem[lvseg:(y+j)*320+(i*8)+x+k]:=15;
  170. end;
  171.  
  172. { check collisions --------------------------------------------------------- }
  173.  
  174. procedure checkall;
  175. var i:word; dx,dy:integer;
  176. begin
  177.   i:=0; { player bullits hit computer }
  178.   while (i<playerbullits) and (pbs[i].x>0) do begin
  179.     dx:=(cx-pbs[i].x)+3;
  180.     dy:=(cy-pbs[i].y)+3;
  181.     if (dx>=0) and (dx<=6) and
  182.        (dy>=0) and (dy<=6) then begin
  183.       inc(score);
  184.       dec(cenergy);
  185.       if cenergy<0 then begin
  186.         writetxt(130,96,'YOU WON',vidseg);
  187.         delay(1000);
  188.         repeat until leftpressed;
  189.         { correct? }
  190.         fillchar(pbs,sizeof(pbs),0);
  191.         fillchar(pbspd,sizeof(pbspd),0);
  192.         fillchar(cbs,sizeof(cbs),0);
  193.         fillchar(cbdir,sizeof(cbdir),0);
  194.         pbtimer:=pbmaxtime; cbtimer:=random(cbmaxtime);
  195.         cx:=4+random(312); cy:=4+random(192);
  196.         range:=0;
  197.         score:=0;
  198.         cenergy:=100;
  199.         penergy:=100;
  200.       end;
  201.     end;
  202.     inc(i);
  203.   end;
  204.   i:=0; { computer bullits hit player }
  205.   while (i<compbullits) and (cbs[i].x>0) do begin
  206.     dx:=(px-round(cbs[i].x))+3;
  207.     dy:=(py-round(cbs[i].y))+3;
  208.     if (dx>=0) and (dx<=6) and
  209.        (dy>=0) and (dy<=6) then begin
  210.       dec(penergy);
  211.       if penergy<0 then begin
  212.         writetxt(120,96,'GAME OVER!',vidseg);
  213.         delay(1000);
  214.         repeat until leftpressed;
  215.         fillchar(pbs,sizeof(pbs),0);
  216.         fillchar(pbspd,sizeof(pbspd),0);
  217.         fillchar(cbs,sizeof(cbs),0);
  218.         fillchar(cbdir,sizeof(cbdir),0);
  219.         pbtimer:=pbmaxtime; cbtimer:=random(cbmaxtime);
  220.         cx:=4+random(312); cy:=4+random(192);
  221.         range:=0;
  222.         score:=0;
  223.         cenergy:=100;
  224.         penergy:=100;
  225.       end;
  226.     end;
  227.     inc(i);
  228.   end;
  229. end;
  230.  
  231. { draw all stuff to screen ------------------------------------------------- }
  232.  
  233. procedure drawall;
  234. var scorestr:string; lcbx,lcby,i:word;
  235. begin
  236.   { player }
  237.   putpixel(px,py,15,virseg);
  238.   putpixel(px-1,py+1,7,virseg);
  239.   putpixel(px+1,py+1,7,virseg);
  240.   putpixel(px-2,py+2,8,virseg);
  241.   putpixel(px+2,py+2,8,virseg);
  242.   { computer }
  243.   putpixel(cx-1,cy-1,8,virseg);
  244.   putpixel(cx,cy-1,3,virseg);
  245.   putpixel(cx+1,cy-1,8,virseg);
  246.   putpixel(cx-1,cy,3,virseg);
  247.   putpixel(cx+1,cy,3,virseg);
  248.   putpixel(cx-1,cy+1,8,virseg);
  249.   putpixel(cx,cy+1,3,virseg);
  250.   putpixel(cx+1,cy+1,8,virseg);
  251.   { player bullits }
  252.   for i:=0 to playerbullits do
  253.     if pbs[i].x>0 then begin
  254.       putpixel(pbs[i].x,pbs[i].y-2,15,virseg);
  255.       putpixel(pbs[i].x,pbs[i].y-1,9,virseg);
  256.       putpixel(pbs[i].x,pbs[i].y,1,virseg);
  257.     end;
  258.   { computer bullits }
  259.   for i:=0 to compbullits do
  260.     if cbs[i].x>0 then begin
  261.       lcbx:=round(cbs[i].x); lcby:=round(cbs[i].y);
  262.       putpixel(lcbx,lcby,15,virseg);
  263.       putpixel(lcbx,lcby+1,4,virseg);
  264.       putpixel(lcbx,lcby-1,4,virseg);
  265.       putpixel(lcbx+1,lcby,4,virseg);
  266.       putpixel(lcbx-1,lcby,4,virseg);
  267.     end;
  268.   { score }
  269.   str(score,scorestr);
  270.   writetxt(10,190,scorestr,virseg);
  271.   { penergy-bar }
  272.   for i:=199 downto (199-penergy) do begin
  273.     putpixel(1,i,8,virseg);
  274.     putpixel(2,i,15,virseg);
  275.     putpixel(3,i,8,virseg);
  276.   end;
  277.   { cenergy-bar }
  278.   for i:=199 downto (199-cenergy) do begin
  279.     putpixel(316,i,3,virseg);
  280.     putpixel(317,i,15,virseg);
  281.     putpixel(318,i,3,virseg);
  282.   end;
  283.   while (port[$3da] and 8) <> 0 do;
  284.   while (port[$3da] and 8) = 0 do;
  285.   flip(virseg,vidseg);
  286. end;
  287.  
  288. procedure clearall;
  289. var lcbx,lcby,i,j:word;
  290. begin
  291.   { player }
  292.   putpixel(px,py,0,virseg);
  293.   putpixel(px-1,py+1,0,virseg);
  294.   putpixel(px+1,py+1,0,virseg);
  295.   putpixel(px-2,py+2,0,virseg);
  296.   putpixel(px+2,py+2,0,virseg);
  297.   { computer }
  298.   putpixel(cx-1,cy-1,0,virseg);
  299.   putpixel(cx,cy-1,0,virseg);
  300.   putpixel(cx+1,cy-1,0,virseg);
  301.   putpixel(cx-1,cy,0,virseg);
  302.   putpixel(cx+1,cy,0,virseg);
  303.   putpixel(cx-1,cy+1,0,virseg);
  304.   putpixel(cx,cy+1,0,virseg);
  305.   putpixel(cx+1,cy+1,0,virseg);
  306.   { player bullits }
  307.   for i:=0 to playerbullits do
  308.     if pbs[i].x>0 then begin
  309.       putpixel(pbs[i].x,pbs[i].y-2,0,virseg);
  310.       putpixel(pbs[i].x,pbs[i].y-1,0,virseg);
  311.       putpixel(pbs[i].x,pbs[i].y,0,virseg);
  312.     end;
  313.   { computer bullits }
  314.   for i:=0 to compbullits do
  315.     if cbs[i].x>0 then begin
  316.       lcbx:=round(cbs[i].x); lcby:=round(cbs[i].y);
  317.       putpixel(lcbx,lcby,0,virseg);
  318.       putpixel(lcbx,lcby+1,0,virseg);
  319.       putpixel(lcbx,lcby-1,0,virseg);
  320.       putpixel(lcbx+1,lcby,0,virseg);
  321.       putpixel(lcbx-1,lcby,0,virseg);
  322.     end;
  323.   { score }
  324.   for i:=0 to 7 do for j:=0 to 23 do putpixel(10+j,190+i,0,virseg);
  325.   { penergy-bar }
  326.   for i:=199 downto 99 do begin
  327.     putpixel(1,i,0,virseg);
  328.     putpixel(2,i,0,virseg);
  329.     putpixel(3,i,0,virseg);
  330.   end;
  331.   { cenergy-bar }
  332.   for i:=199 downto 99 do begin
  333.     putpixel(316,i,0,virseg);
  334.     putpixel(317,i,0,virseg);
  335.     putpixel(318,i,0,virseg);
  336.   end;
  337. end;
  338.  
  339. { main --------------------------------------------------------------------- }
  340.  
  341. var i,j:word;
  342. begin
  343.   if not mouseinstalled then begin writeln('Needs mouse!'); halt; end;
  344.   mousesensetivity(20,20);
  345.   getfont;
  346.   asm mov ax,13h; int 10h; end;
  347.   getmem(virscr,64000); virseg:=seg(virscr^); cls(virseg);
  348.   for i:=16 to 255 do setpal(i,i div 4,i div 5,i div 6);
  349.   fillchar(pbs,sizeof(pbs),0);
  350.   fillchar(pbspd,sizeof(pbspd),0);
  351.   fillchar(cbs,sizeof(cbs),0);
  352.   fillchar(cbdir,sizeof(cbdir),0);
  353.   range:=0;
  354.   score:=0;
  355.   penergy:=100;
  356.   cenergy:=100;
  357.   px:=0; py:=0; cx:=4+random(312); cy:=4+random(192);
  358.   randomize;
  359.   pbtimer:=pbmaxtime; cbtimer:=random(cbmaxtime);
  360.   repeat
  361.     moveplayer;
  362.     movecomputer;
  363.     moveplayerbullits;
  364.     movecompbullits;
  365.     checkall;
  366.     drawall;
  367.     clearall;
  368.   until rightpressed;
  369.   freemem(virscr,64000);
  370.   asm mov ax,3; int 10h; end;
  371. end.
  372.  
  373. {
  374.   'features':
  375.   - players autofire is slower than a trigger-happy manual-fire.
  376.   - for computer-player:
  377.     the higher number of bullits and the lower the maxtime, the harder it
  378.     gets for the person-player, and vice-versa, if you know what I mean.
  379.   - You can make it al realy impossible for yourself, it you set:
  380.     compbullits=50, cbmaxtime=5, cbspd=3, for instance.
  381. }
  382.