Hra pexeso naprogramovaná v pascale

Kategória: Programy v Pascale

Program: Pexeso.pas
Súbor exe: Pexeso.exe
Potrebné: Menu.mnu, Menu.tpu, Mys2.pas, Egavga.bgi
Super program v ktorom sa dá hrať obdoba pexesa. Je v grafickom prevedení. Obsahuje rutiny na obsluhu myši, výber z menu, miešanie kariet, kontrolu správnosti a iné potrebné k pexesu. Niesom pôvodným autorom, len som to "trochu" upravil.
{ MYS2.PAS                  Copyright (c) TrSek alias Zdeno Sekerak }
{ Unit pre mys.pas                                                  }
{                                                                   }
{ Datum:08.06.1996                             http://www.trsek.com }
 
unit mys2;
interface
uses dos;
type  g_kurzor = array [ 0 .. 1, 0 .. 15 ] of word; {graficky mysi kurzor}
const int_mysky = 51;
const leve_tlacitko = 0;
      prave_tlacitko = 1;
      prostredni_tlacitko = 2;
 
var r:registers;
 
 
procedure reset_mys;
procedure show_mys;
procedure cancel_mys;
procedure window_mys(x1,y1,x2,y2:integer);
procedure where_is_mys(var x,y:integer);
procedure set_mys(x,y:integer);
function right:boolean;
function left:boolean;
function middle:boolean;
procedure graphical_mys ( hsx, hsy : integer; var c );
procedure set_arrow;
procedure set_clock;
procedure set_reverse_clock;
procedure set_cross;
procedure set_reverse_cross;
procedure set_otaznik;
procedure relative_position_mys ( var x, y : integer );
procedure mickey_mouse ( x, y : word );
procedure hide_mys_in ( x1, x2, y1, y2 : word );
procedure cli;
inline($fa);
procedure sti;
inline($fb);
procedure double_speed_mys ( k : word );
procedure reset_stisku;
 
implementation
 
 
const k_sipka : g_kurzor = ( ( $3fff, $1fff, $0fff, $07ff,
                               $03ff, $01ff, $00ff, $007f,
                               $003f, $001f, $001f, $00ff,
                               $30ff, $f87f, $f87f, $fc7f ),
 
                             ( $0000, $4000, $6000, $7000,
                               $7800, $7c00, $7e00, $7f00,
                               $7f80, $7fc0, $7c00, $4600,
                               $0600, $0300, $0300, $0000 ) );
      x_sipka = 0; y_sipka = 0; { 'hot spot' }
 
{*************************}
{***        kriz       ***}
{*************************}
 
const k_kriz : g_kurzor = ( ( $ffff, $ffff, $ffff, $ffff,
                              $ffff, $ffff, $ffff, $ffff,
                              $ffff, $ffff, $ffff, $ffff,
                              $ffff, $ffff, $ffff, $ffff ),
 
                            ( $0100, $0100, $0100, $0100,
                              $0100, $0000, $0000, $f93e,
                              $0000, $0000, $0100, $0100,
                              $0100, $0100, $0100, $0000 ) );
      x_kriz = 7; y_kriz = 7; { 'hot spot' }
 
{*************************}
{***      x-kriz       ***}
{*************************}
 
const k_xkriz : g_kurzor = ( ( $ffff, $ffff, $ffff, $ffff,
                               $ffff, $ffff, $ffff, $ffff,
                               $ffff, $ffff, $ffff, $ffff,
                               $ffff, $ffff, $ffff, $ffff ),
 
                             ( $0000, $4004, $2008, $1010,
                               $0820, $0000, $0000, $0100,
                               $0000, $0000, $0820, $1010,
                               $2008, $4004, $0000, $0000 ) );
      x_xkriz = 7; y_xkriz = 7; { 'hot spot' }
 
{*************************}
{***      hodinky      ***}
{*************************}
 
const k_hodinky : g_kurzor = ( ( $f839, $e008, $c004, $8003,
                                 $8003, $0001, $0001, $0001,
                                 $0001, $0001, $8003, $8003,
                                 $c007, $e00f, $f83f, $ffff ),
 
                               ( $07c6, $1ff7, $383b, $600c,
                                 $600c, $c006, $c006, $df06,
                                 $c106, $c106, $610c, $610c,
                                 $3838, $1ff0, $07c0, $0000 ) );
      x_hodinky = 8; y_hodinky = 8; { 'hot spot' }
 
{*********************************}
{***     inverzni hodinky      ***}
{*********************************}
 
const k_ihodinky : g_kurzor = ( ( $f839, $e008, $c004, $8003,
                                  $8003, $0001, $0001, $0001,
                                  $0001, $0001, $8003, $8003,
                                  $c007, $e00f, $f83f, $ffff ),
 
                                ( $0000, $0000, $07c0, $1ff0,
                                  $1ff0, $3ff8, $3ff8, $20f8,
                                  $3ef8, $3ef8, $1ef0, $1ef0,
                                  $07c0, $0000, $0000, $0000 ) );
 
{************************}
{***     otaznĄk      ***}
{************************}
 
const k_otaznik : g_kurzor =  ( ( $ffff, $c0ff, $807f, $987f,
                                  $fc7f, $f87f, $e0ff, $c3ff,
                                  $c7ff, $c7ff, $c7ff, $ffff,
                                  $c7ff, $c7ff, $c7ff, $ffff ),
 
                                ( $0000, $3e00, $6700, $0300,
                                  $0300, $0600, $1800, $3000,
                                  $3000, $3000, $0000, $0000,
                                  $3000, $3000, $0000, $0000 ) );
      x_otaznik = 5; y_otaznik = 5; { 'hot spot' }
 
 
procedure reset_mys;
begin
r.ax:=$0000;
intr($33,r);
end;
 
procedure show_mys;
begin
r.ax:=$0001;
intr($33,r);
end;
 
procedure cancel_mys;
begin
r.ax:=$0002;
intr($33,r);
end;
 
procedure window_mys(x1,y1,x2,y2:integer);
begin
r.ax:=$0007;
r.cx:=x1;
r.dx:=x2;
intr($33,r);
r.ax:=$0008;
r.cx:=y1;
r.dx:=y2;
intr($33,r);
end;
 
procedure where_is_mys(var x,y:integer);
begin
r.ax:=$0003;
intr($33,r);
x:=r.cx;
y:=r.dx;
end;
 
procedure set_mys(x,y:integer);
begin
r.ax:=$0004;
r.cx:=x;
r.dx:=y;
intr($33,r);
end;
 
function left:boolean;
begin
r.ax:=$0005;
r.bx:=0;
intr($33,r);
if (r.ax and 1)=1 then begin left:=true; r.bx:=3; end
                       else  left:=false;
end;
 
function right:boolean;
begin
r.ax:=$0005;
r.bx:=1;
intr($33,r);
if (r.ax and 2)=2 then begin right:=true; r.bx:=3; end
                       else  right:=false;
end;
 
function middle:boolean;
begin
r.ax:=$0005;
r.bx:=2;
intr($33,r);
if (r.ax and 4)=4 then middle:=true
                       else  middle:=false;
end;
 
procedure graphical_mys ( hsx, hsy : integer; var c );
var r : registers;
begin
 r.ax:=9; r.bx:=word(hsx);
 r.cx:=word(hsy); r.dx:=ofs(c); r.es:=seg(c);
 intr(int_mysky,r);
end; { nastav_g_kurzor }
 
procedure set_arrow;
begin
 graphical_mys(x_sipka,y_sipka,k_sipka);
end; { nastav_sipku }
 
procedure set_clock;
begin
 graphical_mys(x_hodinky,y_hodinky,k_hodinky);
end; { nastav_hodinky }
 
procedure set_reverse_clock;
begin
 graphical_mys(x_hodinky,y_hodinky,k_ihodinky);
end; { nastav_ihodinky }
 
procedure set_cross;
begin
 graphical_mys(x_kriz,y_kriz,k_kriz);
end; { nastav_kriz }
 
procedure set_reverse_cross;
begin
 graphical_mys(x_xkriz,y_xkriz,k_xkriz);
end; { nastav_kriz }
 
procedure set_otaznik;
begin
 graphical_mys(x_otaznik,y_otaznik,k_otaznik);
end; { nastav_otaznik }
 
{*****************************************}
{***      relativni pozice mysky       ***}
{*****************************************}
procedure volani_mysky ( sluzba : byte; var par1, par2, par3, par4 : word );
var  r : registers;
begin
 r.ax:=sluzba; r.bx:=par2;
 r.cx:=par3; r.dx:=par4;
 intr(int_mysky,r);
 par1:=r.ax; par2:=r.bx;
 par3:=r.cx; par4:=r.dx;
end; { volani_mysky }
 
 
procedure relative_position_mys ( var x, y : integer );
var d : word;
    xx : word absolute x;
    yy : word absolute y;
begin
 volani_mysky(11,d,d,xx,yy);
end; { relativni_pozice_mysky }
 
{*****************************************}
{***           mickey/mouse            ***}
{*****************************************}
 
procedure mickey_mouse ( x, y : word );
var d : word;
begin
 volani_mysky(15,d,d,x,y);
end; { mickey_mouse }
 
{*************************************************}
{***       skryti mysky v zadane oblasti       ***}
{*************************************************}
 
procedure hide_mys_in ( x1, x2, y1, y2 : word );
var r : registers;
begin
 r.ax:=16;
 r.cx:=x1; r.si:=x2;
 r.dx:=y1; r.di:=y2;
 intr(int_mysky,r);
end; { schovej_mysku_v }
 
{*******************************************}
{***      dvojnasobna rychlost mysky     ***}
{*******************************************}
 
procedure double_speed_mys ( k : word );
var d : word;
begin
 volani_mysky(19,d,d,d,k);
end; { dvoj_rychlost_mysky }
 
 
procedure reset_stisku;
var d : word;
procedure stisk_mysky ( co : word; var kolik, x, y : word );
var tl : word;
begin
 kolik:=co;
 volani_mysky(5,tl,kolik,x,y);
end; { stisk_mysky }
procedure pusteni_mysky ( co : word; var kolik, x, y : word );
var tl : word;
begin
 kolik:=co;
 volani_mysky(6,tl,kolik,x,y);
end; { pusteni_mysky }
 
begin
 stisk_mysky(leve_tlacitko,d,d,d);
 pusteni_mysky(leve_tlacitko,d,d,d);
 stisk_mysky(prave_tlacitko,d,d,d);
 pusteni_mysky(prave_tlacitko,d,d,d);
end; { reset_stisku }
 
 
begin
end.
Hra pexeso naprogramovaná v pascale

Navigační menu

Osobní nástroje

Hledat

Pascal programy

Pascal Wiki

Bonus

Kontakty

V iných jazykoch
