Listings for the GNAT's whisker article

Listing 1: Build files for building a typical GNAT project
1a - complete make file

key_test.exe: key_test.o dosmemor.o keyinput.o keyintr.o
	gnatbind -x key_test.ali
	gnatlink key_test.ali keyintr.o

dosmemor.o: dosmemor.adb dosmemor.ads
	gcc -c $<

keyinput.o: keyinput.adb keyinput.ads dosmemor.ads
	gcc -c $<

key_test.o: key_test.adb keyinput.ads
	gcc -c $<

keyintr.o: keyintr.s
	gcc -c $<
1b - simplified make file using gnatmake

key_test.exe: *.adb *.ads keyintr.o
	gnatmake key_test.ali -largs keyintr.o

keyintr.o: keyintr.s
	gcc -c $<
1c - simplified make file that works

key_test.exe: key_test.ali keyintr.o
	gnatbind -x key_test.ali
	gnatlink key_test.ali keyintr.o

key_test.ali: *.adb *.ads
	gnatmake -c key_test

keyintr.o: keyintr.s
	gcc -c $<
Listing 2 - Dos_Memory package specification

------------------------------------------------------------------------------
--
-- Interface to a subset of the DJGPP specific functions for accessing "DOS"
-- memory and DPMI functions. See the DJGPP documentation and C header files
-- for more information.
--
------------------------------------------------------------------------------

with System;
with Interfaces.C; use Interfaces.C;

package Dos_Memory is

  type Byte_Regs is
    record
      Di:       Unsigned_Short;
      Upper_Di: Unsigned_Short;
      Si:       Unsigned_Short;
      Upper_Si: Unsigned_Short;
      Bp:       Unsigned_Short;
      Upper_Bp: Unsigned_Short;
      Cflag:    Unsigned_Long;
      Bl:       Unsigned_Char;
      Bh:       Unsigned_Char;
      Upper_Bx: Unsigned_Short;
      Dl:       Unsigned_Char;
      Dh:       Unsigned_Char;
      Upper_Dx: Unsigned_Short;
      Cl:       Unsigned_Char;
      Ch:       Unsigned_Char;
      Upper_Cx: Unsigned_Short;
      Al:       Unsigned_Char;
      Ah:       Unsigned_Char;
      Upper_Ax: Unsigned_Short;
      Flags:    Unsigned_Short;
    end record;
  pragma Convention( C, Byte_Regs );

  type Dpmi_Regs is
    record
      Di:       Unsigned_Short;
      Upper_Di: Unsigned_Short;
      Si:       Unsigned_Short;
      Upper_Si: Unsigned_Short;
      Bp:       Unsigned_Short;
      Upper_Bp: Unsigned_Short;
      Cflag:    Unsigned_Long;
      Bl:       Unsigned_Char;
      Bh:       Unsigned_Char;
      Upper_Bx: Unsigned_Short;
      Dl:       Unsigned_Char;
      Dh:       Unsigned_Char;
      Upper_Dx: Unsigned_Short;
      Cl:       Unsigned_Char;
      Ch:       Unsigned_Char;
      Upper_Cx: Unsigned_Short;
      Al:       Unsigned_Char;
      Ah:       Unsigned_Char;
      Upper_Ax: Unsigned_Short;
      Flags:    Unsigned_Short;
      Es:       Unsigned_Short;
      Ds:       Unsigned_Short;
      Fs:       Unsigned_Short;
      Gs:       Unsigned_Short;
      Ip:       Unsigned_Short;
      Cs:       Unsigned_Short;
      Sp:       Unsigned_Short;
      Ss:       Unsigned_Short;
    end record;
  pragma Convention( C, Dpmi_Regs );

  type Dpmi_Mem_Info is
    record
      Handle:  Unsigned_Long;
      Size:    Unsigned_Long;
      Address: Unsigned_Long;
    end record;
  pragma Convention( C, Dpmi_Mem_Info );

  type Dpmi_Paddr is
    record
      Offset32: Unsigned_Long;
      Selector: Unsigned_Short;
    end record;
  pragma Convention( C, Dpmi_Paddr );

  type Go32_Info_Block is
    record
      Size_Of_This_Structure_In_Bytes:       Unsigned_Long;
      Linear_Address_Of_Primary_Screen:      Unsigned_Long;
      Linear_Address_Of_Secondary_Screen:    Unsigned_Long;
      Linear_Address_Of_Transfer_Buffer:     Unsigned_Long;
      Size_Of_Transfer_Buffer:               Unsigned_Long;
      Pid:                                   Unsigned_Long;
      Master_Interrupt_Controller_Base:      Unsigned_Char;
      Slave_Interrupt_Controller_Base:       Unsigned_Char;
      Selector_For_Linear_Memory:            Unsigned_Short;
      Linear_Address_Of_Stub_Info_Structure: Unsigned_Long;
      Linear_Address_Of_Original_Psp:        Unsigned_Long;
      Run_Mode:                              Unsigned_Short;
      Run_Mode_Info:                         Unsigned_Short;
    end record;
  pragma Convention( C, Go32_Info_Block );

  procedure Move_Data( Source_Sel: in Integer; Source_Offset: in System.Address;
                       Dest_Sel: in Integer; Dest_Offset: in Integer;
                       Size: in Integer );
  pragma Import( C, Move_Data, "movedata" );

  procedure Int86( Ivec: in Unsigned_Long;
                   Regs_In: in Byte_Regs;
                   Regs_Out: out Byte_Regs );
  pragma Import( C, Int86, "int86" );

  procedure Dpmi_Int( Vector: in Integer; Regs: in out Dpmi_Regs );
  pragma Import( C, Dpmi_Int, "__dpmi_int" );

  function Go32_Conventional_Mem_Selector return Unsigned_Short;
  pragma Import( C, Go32_Conventional_Mem_Selector, "_go32_conventional_mem_selector" );

  procedure Farsetsel( Selector: in Unsigned_Short );
  pragma Import( C, Farsetsel, "_farsetsel" );

  procedure Farnspokeb( Offset: in Unsigned_Long; Value: Unsigned_Char );
  pragma Import( C, Farnspokeb, "_farnspokeb" );

  function Dpmi_Lock_Linear_Region( Info: access Dpmi_Mem_Info ) return Integer;
  pragma Import( C, Dpmi_Lock_Linear_Region, "__dpmi_lock_linear_region" );

  function Dpmi_Unlock_Linear_Region( Info: access Dpmi_Mem_Info ) return Integer;
  pragma Import( C, Dpmi_Unlock_Linear_Region, "__dpmi_unlock_linear_region" );

  function Dpmi_Set_Protected_Mode_Interrupt_Vector( Vector: in Integer;
                                                     Address: access Dpmi_Paddr )
    return Integer;
  pragma Import( C, Dpmi_Set_Protected_Mode_Interrupt_Vector,
                 "__dpmi_set_protected_mode_interrupt_vector" );

  function Dpmi_Get_Protected_Mode_Interrupt_Vector( Vector: in Integer;
                                                     Address: access Dpmi_Paddr )
    return Integer;
  pragma Import( C, Dpmi_Get_Protected_Mode_Interrupt_Vector,
                 "__dpmi_get_protected_mode_interrupt_vector" );

  procedure Dpmi_Get_Segment_Base_Address( Selector: in Unsigned_Short;
                                           Address: out Unsigned_Long );
  pragma Import( C, Dpmi_Get_Segment_Base_Address,
                 "__dpmi_get_segment_base_address" );

  function My_Cs return Unsigned_Short;
  pragma Import( C, My_Cs, "_my_cs" );

  function My_Ds return Unsigned_Short;
  pragma Import( C, My_Ds, "_my_ds" );

  procedure Out_Port_B( Port: in Unsigned_Short; Data: in Unsigned_Char );
  pragma Import( C, Out_Port_B, "outportb" );

  -- This is a new routine - sets the far selector to the one I most
  -- often want, the conventional DOS area.
  procedure Set_Dos_Selector;
  pragma Inline( Set_Dos_Selector );

end Dos_Memory;
Listing 3 - Ada sprite drawing routine

-- Plot a shape using only Ada (and a few imported C functions)

with Interfaces.C; use Interfaces.C;
with Dos_Memory;   use Dos_Memory;

package body Sprite is

  procedure Plot( X, Y: in Coord; Sp: in Sprite_Data ) is
    Offset, Local_Offset: Unsigned_Long;
  begin
    Offset := Unsigned_Long( 16#A0000# + Y * 320 + X );
    Set_Dos_Selector;
    for Row in Sp'Range
    loop
      Local_Offset := Offset;
      for Col in Sp'Range( 2 )
      loop
        Farnspokeb( Local_Offset, Unsigned_Char( Sp( Row, Col ) ) );
        Local_Offset := Local_Offset + 1;
      end loop;
      Offset := Offset + 320;
    end loop;
  end Plot;

end Sprite;
Listing 4 - Keyboard interrupt routine

/*****************************************************************************


  Simple keyboard interrupt handler.

  This defines a vector of 128 entries: keys[ 1 ] to keys[ 127 ] contain
  a boolean value indicating if the key with that key code is currently
  down (NB: does not handle extended keys at all well since these are
  aliased to normal key codes via this mechanism, but that's not worth
  worrying about most of the time). The first entry, keys[ 0 ] contains
  the scan code of the last key pressed.

*****************************************************************************/

/* Because DJGPP is a virtual memory environment, all interrupt
   routines MUST be locked in memory (or paging disabled). An easy
   way to lock is to create extra symbols for the beginning and end
   of the areas of interest - typically just two are required, code &
   data - and lock everything between the beginning and end. The
   following four symbols are for just that... */

                     .global _start_of_locked_data,_end_of_locked_data
                     .global _start_of_locked_code,_end_of_locked_code

/* The following are the two symbols of interest to the caller -
   the externally visible key press vector and the interrupt routine */
                     .global _keys,_keyHandler

_start_of_locked_data:
_keys:               .fill  128,1,0
extended:            .byte  0
_end_of_locked_data:

                     .extern ___djgpp_ds_alias

                     .align 4
_start_of_locked_code:
_keyHandler:         push   %eax
                     push   %ds
                     movw   %cs:___djgpp_ds_alias,%ds

                     inb    $0x60,%al

/*                   If start of extended sequence, just set flag */
                     cmpb   $0xE0,%al
                     jnz    notExtended
                     movb   $1,extended
                     jmp    continue

/*                   If not long extended sequence, process it */
notExtended:         testb  $1,extended
                     jz     process
                     cmpb   $0x2A,%al
                     jz     keyDone

/*                   Top bit set = key up */
process:             testb  %al,%al
                     jge    keyDown

/*                   So store 0 in key location */
                     andl   $127,%eax
                     movb   $0,_keys(%eax)
                     jmp    keyDone

/*                   Store non-0 in key location and code in key[0] */
keyDown:             movzbl %al,%eax
                     movb   %al,_keys(%eax)
                     movb   %al,_keys

keyDone:             movb   $0,extended
continue:            inb    $0x61,%al
                     orb    $0x80,%al
                     outb   %al,$0x61
                     andb   $0x7F,%al
                     outb   %al,$0x61
                     movb   $0x20,%al
                     outb   %al,$0x20

                     pop    %ds
                     pop    %eax
                     sti
                     iret
_end_of_locked_code:
Listing 5 - Sprite plotting package, with added rendezvous task

-- Plot a shape using only Ada (and a few imported C functions)

with Interfaces.C; use Interfaces.C;
with Machine_Code; use Machine_Code;
with Dos_Memory;   use Dos_Memory;

package body Sprite is

  procedure Do_Plot( X, Y: in Coord; Sp: in Sprite_Data ) is
    Offset, Local_Offset: Unsigned_Long;
  begin
    Offset := Unsigned_Long( 16#A0000# + Y * 320 + X );
    Set_Dos_Selector;
    for Row in Sp'Range
    loop
      Local_Offset := Offset;
      for Col in Sp'Range( 2 )
      loop
        Asm( "movb %b1,%%fs:(%k0)",
             No_Output_Operands,
             ( Unsigned_Long'Asm_Input( "qi", Local_Offset ),
               Pixel'Asm_Input( "r", Sp( Row, Col ) ) ) );
        Local_Offset := Local_Offset + 1;
      end loop;
      Offset := Offset + 320;
    end loop;
  end Do_Plot;

  task body Plotter is
  begin
    loop
      select
        accept Plot( X, Y: in Coord; Sp: in Sprite_Data )
        do
          Do_Plot( X, Y, Sp );
        end Plot;
      or
        terminate;
      end select;
    end loop;
  end Plotter;

end Sprite;
Listing 6 - Main code for multi-tasking sprite drawing code

-- Run a few sprites as independent tasks, along with a keyboard
-- controlled one

with Ada.Numerics.Discrete_Random;
with Video;
with Sprite;
with Key_Input;    use type Key_Input.Scan_Code;

procedure Sprites is

  subtype Coord_Delta is Integer range -1..+1;
  package Coord_Delta_Rand is new Ada.Numerics.Discrete_Random( Coord_Delta );
  Coord_Delta_Generator: Coord_Delta_Rand.Generator;
  function Rand_Delta return Coord_Delta is
  begin
    return Coord_Delta_Rand.Random( Coord_Delta_Generator );
  end Rand_Delta;

  Test_Sprite: constant Sprite.Sprite_Data( 0..20, 0..32 ) :=
   ( ( 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 ),
     ( 0, 0, 0, 0, 0, 0, 7, 7, 7, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 ),
     ( 0, 0, 0, 0, 0, 7, 4, 4, 4, 7, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 ),
     ( 0, 0, 0, 0, 7, 7, 7, 4, 4, 7, 7, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 ),
     ( 0, 0, 0, 7, 4, 7, 4, 7, 4, 7, 4, 7, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 ),
     ( 0, 7, 7, 4, 4, 4, 4, 7, 7, 4, 4, 7, 7, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 7, 7, 7, 0 ),
     ( 0, 7, 4, 4, 4, 4, 4, 4, 4, 4, 7, 7, 4, 7, 7, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 7, 7, 4, 4, 7, 0 ),
     ( 0, 7, 4, 4, 4, 7, 7, 7, 4, 7, 7, 4, 4, 4, 4, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 4, 4, 7, 7, 0, 0 ),
     ( 0, 0, 7, 7, 7, 0, 0, 7, 7, 7, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 7, 0, 0, 0 ),
     ( 0, 0, 0, 0, 0, 0, 0, 0, 7, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 7, 0, 0, 0 ),
     ( 0, 0, 0, 0, 0, 0, 0, 0, 7, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 7, 0, 0, 0 ),
     ( 0, 0, 0, 0, 0, 0, 0, 0, 7, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 7, 0, 0, 0 ),
     ( 0, 0, 0, 0, 0, 0, 0, 0, 7, 4, 4, 4, 4, 4, 4, 4, 4, 4, 7, 7, 7, 4, 4, 4, 4, 4, 4, 4, 4, 7, 0, 0, 0 ),
     ( 0, 0, 0, 0, 0, 0, 0, 0, 7, 4, 4, 7, 4, 4, 7, 7, 7, 7, 0, 0, 0, 7, 7, 4, 4, 4, 4, 4, 7, 0, 0, 0, 0 ),
     ( 0, 0, 0, 0, 0, 0, 0, 0, 7, 4, 4, 7, 4, 4, 7, 0, 0, 0, 0, 0, 0, 0, 7, 4, 4, 4, 4, 4, 7, 0, 0, 0, 0 ),
     ( 0, 0, 0, 0, 0, 0, 0, 0, 7, 4, 4, 7, 4, 4, 7, 0, 0, 0, 0, 0, 0, 0, 0, 7, 4, 4, 4, 7, 7, 7, 0, 0, 0 ),
     ( 0, 0, 0, 0, 0, 0, 0, 0, 7, 4, 7, 7, 4, 4, 7, 0, 0, 0, 0, 0, 0, 0, 0, 7, 4, 4, 7, 7, 4, 7, 0, 0, 0 ),
     ( 0, 0, 0, 0, 0, 0, 0, 7, 4, 4, 7, 4, 4, 4, 7, 0, 0, 0, 0, 0, 0, 0, 0, 7, 4, 4, 7, 7, 4, 7, 0, 0, 0 ),
     ( 0, 0, 0, 0, 0, 0, 7, 4, 4, 7, 4, 4, 4, 7, 0, 0, 0, 0, 0, 0, 0, 0, 7, 4, 4, 7, 7, 4, 7, 7, 0, 0, 0 ),
     ( 0, 0, 0, 0, 0, 0, 7, 7, 7, 7, 7, 7, 7, 0, 0, 0, 0, 0, 0, 0, 0, 0, 7, 7, 7, 0, 7, 7, 7, 0, 0, 0, 0 ),
     ( 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 ) );

  Alive: Boolean := True;
  pragma Volatile( Alive );

  task type Random_Sprite is
    entry Start_Drawing( Start_X, Start_Y: Sprite.Coord );
  end Random_Sprite;

  task body Random_Sprite is
    X: Sprite.Coord;
    Y: Sprite.Coord;
  begin
    accept Start_Drawing( Start_X, Start_Y: Sprite.Coord )
    do
      X := Start_X;
      Y := Start_Y;
    end Start_Drawing;

    while Alive
    loop
      X := X + Rand_Delta;
      Y := Y + Rand_Delta;
      if X < 5
      then
        X := 5;
      end if;
      if X > 150
      then
        X := 150;
      end if;
      if Y < 5
      then
        Y := 5;
      end if;
      if Y > 100
      then
        Y := 100;
      end if;
      Sprite.Plotter.Plot( X, Y, Test_Sprite );
    end loop;
  end Random_Sprite;

  Sprite_Tasks: array( 1..5 ) of Random_Sprite;

  X: Sprite.Coord := 100;
  Y: Sprite.Coord := 100;

begin
  Video.Set_Mode;
  Key_Input.Install;

  for I in Sprite_Tasks'Range
  loop
    Sprite_Tasks( I ).Start_Drawing( Sprite.Coord( I * 20 ),
                                     Sprite.Coord( I * 10 ) );
  end loop;

  while Key_Input.Last_Key_Pressed /= Key_Input.K_Esc
  loop
    if Key_Input.Is_Pressed( Key_Input.K_Up ) and then Y > 0
    then
      Y := Y - 1;
    end if;
    if Key_Input.Is_Pressed( Key_Input.K_Down ) and then Y < 150
    then
      Y := Y + 1;
    end if;
    if Key_Input.Is_Pressed( Key_Input.K_Left ) and then X > 0
    then
      X := X - 1;
    end if;
    if Key_Input.Is_Pressed( Key_Input.K_Right ) and then X < 250
    then
      X := X + 1;
    end if;

    Sprite.Plotter.Plot( X, Y, Test_Sprite );

    delay 0.1;
  end loop;

  Alive := False;

  Key_Input.Remove;
  Video.Restore_Mode;
end Sprites;

Main article | Gavin's home page | BeesKnees home page

Last modified on 9th April 2000