home *** CD-ROM | disk | FTP | other *** search
/ SPACE 2 / SPACE - Library 2 - Volume 1.iso / program / 140 / demos / ballplr3.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1987-05-14  |  7.2 KB  |  310 lines
  1. {$P-} { turn pointer checking off.. }
  2. PROGRAM ballplr3;
  3.      CONST
  4.  
  5.         (*$I gemconst.pas *)              (* Include all the GEM constants *)
  6.  
  7.      TYPE
  8.         Screendef =   ^Screendata;
  9.         Screendata =  PACKED ARRAY[0..32511] OF byte;
  10.         scrn_memory = packed array [ 0..31999 ] of BYTE;
  11.         degas_pic = record
  12.           rez : integer;
  13.           pal : array [0..15] of integer;
  14.           scr : scrn_memory;
  15.         end;
  16.         degas_file = file of degas_pic;
  17.         ptr_screen = ^scrn_memory;   { pointer to the screen array }
  18.         c_pallet = array[0..15] of integer;
  19.         pallet = record
  20.          pal0 : c_pallet;
  21.         end;
  22.         p_file = file of pallet;
  23.  
  24.    mfdb_fields = (addr1,addr2,wid_pix,ht_pix,wid_wds,flag,num_planes,r1,r2,r3);
  25.    mfdb = array[mfdb_fields] of integer;
  26.    grid = array[0..31] of array[0..31] of integer;
  27.    p_name = packed array[0..63] of char;
  28.  
  29.         (*$I gemtype.pas *)
  30.  
  31.   VAR   c: char;
  32.         s_ptr : ptr_screen;     { a pointer to a packed array of bytes... }
  33.         sc1   : ptr_screen;     { a pointer to a packed array of bytes... }
  34.         sc2   : ptr_screen;     { a pointer to a packed array of bytes... }
  35.         dummy,x,y : integer;
  36.         scr1 : scrn_memory;
  37.         scr2 : scrn_memory;
  38.         scr3 : scrn_memory;
  39.         rez1 : integer;
  40.         pal1 : c_pallet;
  41.         pal2 : c_pallet;
  42.         pal6 : c_pallet;
  43.         current_pallet : c_pallet;
  44.         pic : degas_pic;
  45.         screen,backup,unscreen,sprite,csprite,bsprite    : MFDB;
  46.         direction,
  47.         current_x,current_y,
  48.         last_x,last_y : integer;
  49.         frame_loc      : array[0..59] of array[1..2] of integer;
  50.         frame,last_frame : integer;
  51.         ssp,vbladr,nvbls,vblque_adr,address,vblsem: long_integer;
  52.         vbl_flag,ok_flag : boolean;
  53.  
  54.         Curlogbase:   Screendef;
  55.         Curphybase:   Screendef;
  56.  
  57.         Visible_Screen:Screendef;
  58.         Build_Screen: Screendef;
  59.  
  60.         Screen1:      Screendef;
  61.         Screen2:      Screendef;
  62.  
  63.         {$I \PASCAL\SOURCE\PEEKPOKE.PAS }
  64.  
  65.         (*$I gemsubs.pas *)      (* Include all GEM subroutines *)
  66.  
  67. FUNCTION Getphybase : Screendef;
  68. Xbios(2);
  69.  
  70. FUNCTION Getlogbase : Screendef;
  71. Xbios(3);
  72.  
  73. FUNCTION logbase : ptr_screen;
  74. Xbios(3);
  75.  
  76. PROCEDURE Setscreen(Logloc,Phyloc : Screendef;
  77.                     Rez : INTEGER);
  78. Xbios(5);
  79.  
  80. FUNCTION Getrez : integer;
  81. Xbios(4);
  82.  
  83. Procedure wvbl;
  84. Xbios( 37 );
  85.  
  86. Procedure swap;
  87.  
  88.  var tempscreen : screendef;
  89.  
  90.  begin
  91.   Tempscreen := Visible_Screen;
  92.   Visible_Screen := Build_Screen;
  93.   Build_Screen := Tempscreen;
  94.   Setscreen(Build_Screen,Visible_Screen,-1);
  95.  end;
  96.  
  97. FUNCTION Alloc_Screen : Screendef;
  98.  
  99. CONST
  100.   Scraddrresolution = 256;
  101.  
  102. VAR
  103.   Scrjunk:      RECORD
  104.     CASE Byte OF
  105.       0 : (Sali:       Long_Integer);
  106.       1 : (Sa:         Screendef);
  107.   END;
  108.  
  109. BEGIN
  110.  
  111.   WITH Scrjunk DO BEGIN
  112.     NEW(Sa);
  113.     IF Sali MOD Scraddrresolution <> 0
  114.       THEN Sali := Sali + (Scraddrresolution - (Sali MOD Scraddrresolution));
  115.   END;
  116.  
  117.   Alloc_Screen := Scrjunk.Sa;
  118.  
  119. END;
  120.  
  121. Procedure init_form(var form :mfdb; var addr : scrn_memory );
  122.   EXTERNAL;
  123.  
  124. Procedure copy_rect( var s,d : mfdb;
  125.                      from_x,from_y,
  126.                      to_x,to_y,
  127.                      wid,ht,mode : integer);
  128.   EXTERNAL;
  129.  
  130.  
  131. FUNCTION physbase : ptr_screen;
  132.    XBIOS( 2 );
  133.  
  134. function set_colr( reg,col : integer ) : integer;
  135.    xbios(7);
  136.  
  137. PROCEDURE SRestore( name : STRING );
  138.  
  139. VAR
  140.  
  141.    f : degas_file;     { a file containing a screenful of bytes.. }
  142.    x : integer;
  143.  
  144.    BEGIN
  145.  
  146.         reset( f, name );
  147.         pic := f^;
  148.         with pic do
  149.          begin
  150.           rez1 := pic.rez;
  151.           pal1 := pic.pal;
  152.           scr1 := pic.scr;
  153.          end;
  154.         for x := 0 to 15 do
  155.          dummy := set_colr(x,pal1[x]);
  156.         current_pallet := pal1;
  157.  
  158.         { reset automatically fills file buffer with data from first record }
  159.  
  160.  
  161.         { file is automatically closed when we leave this procedure. }
  162.    END;
  163.  
  164. PROCEDURE Load_sprite( name : STRING );
  165.  
  166. VAR
  167.  
  168.    f : degas_file;     { a file containing a screenful of bytes.. }
  169.    x : integer;
  170.  
  171.    BEGIN
  172.     reset( f, name );
  173.     pic := f^;
  174.     with pic do
  175.      begin
  176.       scr3 := pic.scr;
  177.      end;
  178.    END;
  179.  
  180. Procedure build_scrn;
  181.  
  182. VAR Y,X : INTEGER;
  183.  
  184. begin
  185.  s_ptr^ := scr1;          { and assign file buffer to screen }
  186. end;
  187.  
  188.   FUNCTION Proc_addr( PROCEDURE p ) : Long_Integer;
  189.      EXTERNAL;
  190.  
  191.   FUNCTION super( sp: long_integer ): long_integer;
  192.     GEMDOS( $20 );
  193.  
  194. Procedure rt_rtn;
  195.  begin
  196.     frame := frame + 1;
  197.     if frame > 9 then frame := 0;
  198.     current_x := current_x +3;
  199.     if current_x >= 287 then
  200.      begin
  201.       current_x := 287;
  202.       direction := 1;
  203.       frame := 10;
  204.      end;
  205.  end;
  206.  
  207. Procedure lft_rtn;
  208.  begin
  209.     frame := frame + 1;
  210.     if frame >19 then frame := 10;
  211.     current_x := current_x -3;
  212.     if current_x < 0 then
  213.      begin
  214.       current_x := 0;
  215.       direction := 0;
  216.       frame := 0;
  217.      end;
  218.  end;
  219.  
  220. Procedure set_sprite_table;
  221.  
  222.  var x,y,tx,ty,bx,by,num : integer;
  223.  
  224.  begin
  225.   tx := 0;
  226.   ty := 0;
  227.   for y := 0 to 5 do
  228.    begin
  229.     for x := 0 to 9 do
  230.      begin
  231.       num := x+(y*10);
  232.       frame_loc[num,1] := tx;
  233.       frame_loc[num,2] := ty;
  234.       tx := tx + 32;
  235.      end;
  236.     ty := ty + 32;
  237.     tx := 0;
  238.    end;
  239.  end;
  240.  
  241. Procedure go_loop;
  242.  var mode : integer;
  243.  begin
  244.     mode := 0;
  245.     REPEAT
  246.        case direction of
  247.         0 : rt_rtn;
  248.         1 : lft_rtn;
  249.        end;
  250.        sc1 := logbase;
  251.        sc1^ := scr1;          { and assign file buffer to screen }
  252.        copy_rect(sprite,screen,
  253.                  frame_loc[frame,1],frame_loc[frame,2],
  254.                  current_x,current_y,32,32,3);
  255.        swap;
  256.        wvbl;
  257.        wvbl;
  258.        wvbl;
  259.     UNTIL KEYPRESS = TRUE;
  260.  end;
  261.  
  262.   BEGIN
  263.    if Init_gem >= 0 then
  264.     begin
  265.     if getrez = 0 then
  266.      begin
  267.       init_mouse;
  268.       hide_mouse;
  269.       for x := 0 to 15 do
  270.        pal2[x] := set_colr(x,-1);
  271.       pal6 := pal2;
  272.       SRestore( 'BALLPLR3.PI1' ); { read screen data from file... }
  273.       Curlogbase := Getlogbase;
  274.       Curphybase := Getphybase;
  275.       Screen1 := Alloc_Screen;
  276.       Screen2 := Alloc_Screen;
  277.       Setscreen(Screen1,Curphybase,-1);
  278.       sc1 := logbase;
  279.       sc1^ := scr1;          { and assign file buffer to screen }
  280.       Setscreen(Screen2,Curphybase,-1);
  281.       sc2 := logbase;
  282.       sc2^ := scr1;          { and assign file buffer to screen }
  283.       Visible_Screen := Screen2;
  284.       Build_Screen := Screen1;
  285.       Setscreen(Build_Screen,Visible_Screen,-1);
  286.       screen[addr1] := 0;
  287.       screen[addr2] := 0;
  288.       init_form(backup,scr1);
  289.       init_form(unscreen,scr2);
  290.       init_form(sprite,scr3);
  291.       set_sprite_table;
  292.       load_sprite( 'BALLPLR2.SPT' ); { read SPRITE data from file... }
  293.       frame := 0;
  294.       current_x := 0;
  295.       current_y := 0;
  296.       vbl_flag := true;
  297.       direction := 0;
  298.       go_loop;
  299.       for x := 0 to 15 do
  300.        dummy := set_colr(x,pal2[x]);
  301.       Setscreen(Curlogbase,Curphybase,-1);
  302.       show_mouse;
  303.      end
  304.       else dummy := do_alert('[3][LOW REZ ONLY][ OK ]',1);
  305.     exit_gem;
  306.    end;
  307.   END.
  308.  
  309. {  End of file:  JOYTEST.PAS }
  310.