SPACE 2/SPACE - Library 2 - Volume 1.iso/program/167/pascal/mvesprt.pas

Pascal/Delphi Source File | 1987-08-19 | 9.9 KB | 338 lines

PROGRAM MOVE_SPRITE; { Christopher Reed  7/16/87 }
(* This program demonstrates the movement of a sprite-like object under control
   of the mouse.  Its important feature is that it does not use any bizarre
   type coercion.  (At least at the Pascal level).

   To run this program you need two aditional files in Degas Low-rez,
   uncompressed, format,   ...PI1.
   The first provides a background (Field_Screen). The second provides the
   Sprite.  The upper-left square, 32 pixels on a side, is currently firm-coded
   as the sprite shape.  See CONST sprite_w & sprite_h.  XYWH = 0,0,32,32.

   I have to admit that I started with the demos in 'The ST Sprite Factory'.
   Its unfortunate that Mike Hollenbeck's JOYSTICK sample program is so complex
   Its complexity will scare off most programers.  This program shows that
   this complexity is not necessary. *)

(* TO DO:
   Implement a MASK building function that can be used for transparent
      (foreground) sprite movement.
   Re-define the sprite file.  There is no need to carry full screen
      image files around (32000 bytes).
*)

(* problems:  There is stuff in the input file so I can't use keypress,
    as a progress control.  Where did it come from?
   I'm not happy with the movement, the sprite seems to show up twice.
 *)

 CONST
  (*$I gemconst.pas *)
  sprite_w = 32 ;
  sprite_h = 32 ;

TYPE
   scr_def_ptr  = ^Screendata ;
   Screendata   =  PACKED ARRAY[0..32511] OF byte;
   ptr_screen   = ^scrn_memory;   { pointer to the screen array }
   scrn_memory  =  packed array [ 0..31999 ] of BYTE;

   c_pallet = array[0..15] of integer;

   degas_pic = record
      rez : integer;
      pal : c_pallet;
      scr : scrn_memory;
   end;
   degas_file = file of degas_pic;

   mfdb = record
      addr    : ptr_screen ;
      wid_pix : integer ;
      ht_pix  : integer ;
      wid_wds : integer ;
      flag    : integer ;
      num_planes : integer ;
      rfe3, rfe2, rfe1 : integer ;
   end ;
   mfdb_ptr = ^mfdb;

   Ctrl_Parms = record
      c6, c5, c4, c3, c2, c1, c0 : integer ; { PPascal puts them 'right' }
      source_addr : mfdb_ptr ;
      dest_addr   : mfdb_ptr ;
   end ;
   Int_In_Parms    = ARRAY [ 0..15 ] OF integer ;
   Int_Out_Parms   = ARRAY [ 0..45 ] OF integer ;
   Pts_In_Parms    = ARRAY [ 0..11 ] OF integer ;
   Pts_Out_Parms   = ARRAY [ 0..11 ] OF integer ;

 (*$I gemtype.pas *)

 VAR
   dummy : integer;

   copy_screen   : ptr_screen;
   sprite_screen : ptr_screen ;
   field_screen  : ptr_screen ;

   field_mfdb,
   build_mfdb,
   sprite_mfdb   : MFDB_ptr;

   Visible_Screen : ptr_screen ;
   Build_Screen   : ptr_screen ;

   orig_phy_screen,
   orig_log_screen : ptr_screen ;
   orig_pallet   : c_pallet ;
   intro_pallet  : c_pallet ;

   (*$I gemsubs.pas *)      (* Include all GEM subroutines *)

function physbase : ptr_screen;
   Xbios( 2 );

function logbase : ptr_screen;
   Xbios(3);

function Getrez : integer;
   Xbios(4);

procedure Setscreen(Logloc, Phyloc : ptr_screen; Rez : integer);
   Xbios(5);

procedure set_colors ( var c : c_pallet ) ;
   Xbios(6);

function get_colr( reg,col : integer ) : integer;
   Xbios(7);

procedure set_colr( reg,col : integer ) ;
   Xbios(7);

procedure wait_vsync;
   xbios (37);

procedure init_mfdb(var form : MFDB_ptr; raster_addr : ptr_screen);
begin
        { and initialize all fields of the MFDB }
   new ( form );
   with form^ do
    begin
      addr       := raster_addr;
        { some low rez assumptions here }
      wid_pix    := 320;     { low rez }
      ht_pix     := 200;     { low rez }
      wid_wds    := 20;      { (wid.pix + 15) div 16 }
      flag       := 0;       { device dependent }
      num_planes := 4;       { again, low rez }
    end ;
end;

PROCEDURE copy_rect(source, dest : mfdb_ptr ;
                    from_x, from_y,
                    to_x,   to_y,  width, height, mode : integer);
    { using gem raster copy function }
 VAR
   control : Ctrl_Parms ;
   int_in  : Int_In_Parms ;
   int_out : Int_Out_Parms ;
   pts_in  : Pts_In_Parms ;
   pts_out : Pts_Out_Parms ;

   PROCEDURE VDI_Call( cmd, sub_cmd : integer ; nints, npts : integer ;
                      VAR ctrl : Ctrl_Parms ;
                      VAR int_in : Int_In_Parms ; VAR int_out : Int_Out_Parms ;
                      VAR pts_in : Pts_In_Parms ; VAR pts_out : Pts_Out_Parms ;
                      translate : boolean ) ;
      EXTERNAL ;
begin
       { put source MFDB address in control array }
   control.source_addr := source ;
       { and same for destination MFDB }
   control.dest_addr   := dest ;

   int_in[0] := mode;      { mode }

        { set the points for src and dest }
   pts_in[0] := from_x ;
   pts_in[1] := from_y ;
   pts_in[2] := from_x + width  -1 ;
   pts_in[3] := from_y + height -1 ;

   pts_in[4] := to_x ;
   pts_in[5] := to_y ;
   pts_in[6] := to_x + width  -1 ;
   pts_in[7] := to_y + height -1 ;

   VDI_Call( 109, 0, 1, 8, control, int_in, int_out, pts_in, pts_out, false);

end;

Procedure flip_screens ;
 var
   tempscreen : ptr_screen;
 begin
    Tempscreen     := Visible_Screen;
    Visible_Screen := Build_Screen;
    Build_Screen   := Tempscreen;
    init_mfdb ( build_mfdb, build_screen ) ;
    Setscreen ( Build_Screen, Visible_Screen, -1 );
 end;

function alloc_Screen : ptr_screen;
VAR
  Scr_junk  :
    RECORD
    CASE integer OF
      0 : (scr_i   : long_integer ) ;
      1 : (scr_big : scr_def_ptr ) ;
      2 : (scr_adr : ptr_screen ) ;
  end;
begin
   WITH Scr_junk DO
    begin
     NEW(Scr_big);                { allocates 32512 bytes }
     IF Scr_i MOD 256 <> 0 THEN   { adjust its address to be on a 256 boundry }
        scr_i := scr_i + (256 - (scr_i MOD 256)); {to become a screen address }
    end;
   alloc_Screen := scr_junk.scr_adr;  { return it as a pointer }
end;

Function Load_Screen ( def_path : path_name;
                       var  screen_mem : ptr_screen;
                       var colors : c_pallet) :boolean;
 var
   f : degas_file;
   x : integer;
   filename : path_name;
   t : boolean;
begin
   filename := '';
   t := get_in_file(def_path,filename);
   set_mouse(M_Bee);
   reset( f, filename );
   with f^ do
    begin
      colors := pal ;
      screen_mem^ := scr;
    end;
   load_screen := true;
   set_mouse(M_Arrow);
end;

function limit ( position, size, edge : integer ): integer;
begin
   if position > ( edge - size ) then
      position := ( edge - size ) ;
   limit := position;
end;

Procedure event_loop;
 var
   dummy     : integer ;
   quit_flag : boolean;
   prior_x, prior_y,
   mouse_x, mouse_y,
   event     : integer;
   msg       : message_buffer;
begin
 prior_x := -1;
 prior_y := -1;
 repeat
    event := Get_Event(E_Button|E_Timer,
                     1,1,1,             (* left button down      *)
                     0,                 (* timer *)
                     False,0,0,0,0,
                     False,0,0,0,0,
                     msg,
                     dummy,             (* Key pressed           *)
                     dummy,dummy,       (* Not used              *)
                     mouse_x,mouse_y,
                     dummy
                     );
    mouse_x := limit ( mouse_x, sprite_w, 320 );
    mouse_y := limit ( mouse_y, sprite_h, 200 );
    if ( mouse_x <> prior_x ) or ( mouse_y <> prior_y ) then
    begin
       { The sequence of events is
         1) position sprite; 2) flip_screens; 3) clean_up (new) build_screen
         A wait for vertical sync is necessary between 2) & 3) so that
         the (new) build_screen is not visible before we clean it up. }

       { 1). copy the sprite to the build screen not touching visible screen}
       copy_rect ( sprite_mfdb, build_mfdb, 0, 0, mouse_x, mouse_y,
                  sprite_w, sprite_h, 3 );
       { 2). }
       flip_screens;

       wait_vsync;     { see commentry }

       { 3). clean up prior screen }
       { put the original screen ( now hidden ) back together }
       if prior_x <> -1 then
          copy_rect ( field_mfdb, build_mfdb, prior_x, prior_y,
                    prior_x, prior_y,
                    sprite_w, sprite_h, 3 ) ;

       { rotate the sprite locations }
       prior_x := mouse_x;
       prior_y := mouse_y ;
    end;
    quit_flag := (event & E_Button) <> 0 ;
 until Quit_flag ;
end;

begin
 if Init_gem >= 0 then
 begin
    if getrez <> 0 then
       dummy := do_alert('[3][ | LOW REZ ONLY ][ OK ]',1)
    else
    begin
       { save the original screen loactions }
       orig_phy_screen := physbase ;
       orig_log_screen := logbase ;

       init_mouse ;
       set_mouse ( M_Bee );

       {fill a screen with a degas picture }
       field_screen := alloc_screen;
       init_mfdb ( field_mfdb, field_screen ) ;
       if load_screen ('A:\*.PI1', field_screen, Intro_pallet ) then ;

       {copy it to a changing copy }
       copy_screen := alloc_screen ;
       copy_screen^ := field_screen^;  {should this be a blit move?}

       {once more to the working screen}
       build_screen := alloc_screen;
       init_mfdb ( build_mfdb, build_screen ) ;
       build_screen^ := field_screen^;

       sprite_screen := alloc_screen ;
       init_mfdb ( sprite_mfdb, sprite_screen ) ;
       if load_screen ('A:\*.SPT', sprite_screen, orig_pallet ) then ;

       {set up for swapping}
       hide_mouse;
       set_colors ( intro_pallet ) ;
       visible_screen := copy_screen;
     { build_screen := build_screen ;  }
       flip_screens;
       draw_string ( 30,60,'screen 0');    { DDT }
       flip_screens;                       { DDT }
       draw_string ( 30,60,'SCREEN 1');    { DDT }

       event_loop;

       { put screens back }
       show_mouse ;
       setscreen (orig_log_screen, orig_phy_screen, -1 ) ;
    end  ;
    exit_gem;
 end;
end.