src/lib/allegro4/allegro.pas

   1 {$LONGSTRINGS ON}
   2 {$MACRO ON}
   3
   4 {$IF DEFINED(GO32V2)}
   5   {$LINKLIB liballeg.a}
   6   {$LINKLIB libc.a}
   7   {$LINKLIB libgcc.a}
   8   {$DEFINE LibraryLibAllegroDecl := cdecl}
   9   {$DEFINE LibraryLibAllegroImp := cdecl; external}
  10   {$DEFINE LibraryLibAllegroVar := cvar; external}
  11 {$ELSEIF DEFINED(WINDOWS)}
  12   {$DEFINE LibraryLibAllegroDecl := cdecl}
  13   {$DEFINE LibraryLibAllegroImp := cdecl; external 'alleg42.dll'}
  14   {$DEFINE LibraryLibAllegroVar := external 'alleg42.dll'}
  15 {$ELSE}
  16   {$DEFINE LibraryLibAllegroDecl := cdecl}
  17   {$DEFINE LibraryLibAllegroImp := cdecl; external 'alleg'}
  18   {$DEFINE LibraryLibAllegroVar := cvar; external 'alleg'}
  19 {$ENDIF}
  20
  21 unit allegro;
  22
  23 interface
  24
  25   uses ctypes;
  26
  27   const
  28 {$IF DEFINED(GO32V2) OR DEFINED(WINDOWS)}
  29     ALLEGRO_VERSION = 4;
  30     ALEGRO_SUB_VERSION = 2;
  31     ALLEGRO_WIP_VERSION = 3;
  32     ALLEGRO_VERSION_STR = '4.2.3';
  33 {$ELSE}
  34     ALLEGRO_VERSION = 4;
  35     ALEGRO_SUB_VERSION = 4;
  36     ALLEGRO_WIP_VERSION = 2;
  37     ALLEGRO_VERSION_STR = '4.4.2';
  38 {$ENDIF}
  39
  40     SYSTEM_AUTODETECT = 0;
  41     SYSTEM_NONE = $4e4f4e45;
  42
  43     GFX_TEXT = -1;
  44     GFX_AUTODETECT = 0;
  45     GFX_AUTODETECT_FULLSCREEN = 1;
  46     GFX_AUTODETECT_WINDOWED = 2;
  47     GFX_SAFE = $53414645;
  48
  49     DRAW_MODE_SOLID = 0;
  50     DRAW_MODE_XOR = 1;
  51     DRAW_MODE_COPY_PATTERN = 2;
  52     DRAW_MODE_SOLID_PATTERN = 3;
  53     DRAW_MODE_MASKED_PATTERN = 4;
  54     DRAW_MODE_TRANS = 5;
  55
  56     KEY_A = 1;
  57     KEY_B = 2;
  58     KEY_C = 3;
  59     KEY_D = 4;
  60     KEY_E = 5;
  61     KEY_F = 6;
  62     KEY_G = 7;
  63     KEY_H = 8;
  64     KEY_I = 9;
  65     KEY_J = 10;
  66     KEY_K = 11;
  67     KEY_L = 12;
  68     KEY_M = 13;
  69     KEY_N = 14;
  70     KEY_O = 15;
  71     KEY_P = 16;
  72     KEY_Q = 17;
  73     KEY_R = 18;
  74     KEY_S = 19;
  75     KEY_T = 20;
  76     KEY_U = 21;
  77     KEY_V = 22;
  78     KEY_W = 23;
  79     KEY_X = 24;
  80     KEY_Y = 25;
  81     KEY_Z = 26;
  82     KEY_0 = 27;
  83     KEY_1 = 28;
  84     KEY_2 = 29;
  85     KEY_3 = 30;
  86     KEY_4 = 31;
  87     KEY_5 = 32;
  88     KEY_6 = 33;
  89     KEY_7 = 34;
  90     KEY_8 = 35;
  91     KEY_9 = 36;
  92     KEY_0_PAD = 37;
  93     KEY_1_PAD = 38;
  94     KEY_2_PAD = 39;
  95     KEY_3_PAD = 40;
  96     KEY_4_PAD = 41;
  97     KEY_5_PAD = 42;
  98     KEY_6_PAD = 43;
  99     KEY_7_PAD = 44;
 100     KEY_8_PAD = 45;
 101     KEY_9_PAD = 46;
 102     KEY_F1 = 47;
 103     KEY_F2 = 48;
 104     KEY_F3 = 49;
 105     KEY_F4 = 50;
 106     KEY_F5 = 51;
 107     KEY_F6 = 52;
 108     KEY_F7 = 53;
 109     KEY_F8 = 54;
 110     KEY_F9 = 55;
 111     KEY_F10 = 56;
 112     KEY_F11 = 57;
 113     KEY_F12 = 58;
 114     KEY_ESC = 59;
 115     KEY_TILDE = 60;
 116     KEY_MINUS = 61;
 117     KEY_EQUALS = 62;
 118     KEY_BACKSPACE = 63;
 119     KEY_TAB = 64;
 120     KEY_OPENBRACE = 65;
 121     KEY_CLOSEBRACE = 66;
 122     KEY_ENTER = 67;
 123     KEY_COLON = 68;
 124     KEY_QUOTE = 69;
 125     KEY_BACKSLASH = 70;
 126     KEY_BACKSLASH2 = 71;
 127     KEY_COMMA = 72;
 128     KEY_STOP  = 73;
 129     KEY_SLASH = 74;
 130     KEY_SPACE = 75;
 131     KEY_INSERT = 76;
 132     KEY_DEL = 77;
 133     KEY_HOME = 78;
 134     KEY_END = 79;
 135     KEY_PGUP = 80;
 136     KEY_PGDN = 81;
 137     KEY_LEFT = 82;
 138     KEY_RIGHT = 83;
 139     KEY_UP = 84;
 140     KEY_DOWN = 85;
 141     KEY_SLASH_PAD = 86;
 142     KEY_ASTERISK = 87;
 143     KEY_MINUS_PAD = 88;
 144     KEY_PLUS_PAD = 89;
 145     KEY_DEL_PAD = 90;
 146     KEY_ENTER_PAD = 91;
 147     KEY_PRTSCR = 92;
 148     KEY_PAUSE = 93;
 149     KEY_ABNT_C1 = 94;
 150     KEY_YEN = 95;
 151     KEY_KANA = 96;
 152     KEY_CONVERT = 97;
 153     KEY_NOCONVERT = 98;
 154     KEY_AT = 99;
 155     KEY_CIRCUMFLEX = 100;
 156     KEY_COLON2 = 101;
 157     KEY_KANJI = 102;
 158     KEY_EQUALS_PAD = 103;
 159     KEY_BACKQUOTE = 104;
 160     KEY_SEMICOLON = 105;
 161     KEY_COMMAND = 106;
 162     KEY_UNKNOWN1 = 107;
 163     KEY_UNKNOWN2 = 108;
 164     KEY_UNKNOWN3 = 109;
 165     KEY_UNKNOWN4 = 110;
 166     KEY_UNKNOWN5 = 111;
 167     KEY_UNKNOWN6 = 112;
 168     KEY_UNKNOWN7 = 113;
 169     KEY_UNKNOWN8 = 114;
 170     KEY_MODIFIERS = 115;
 171     KEY_LSHIFT = 115;
 172     KEY_RSHIFT = 116;
 173     KEY_LCONTROL = 117;
 174     KEY_RCONTROL = 118;
 175     KEY_ALT = 119;
 176     KEY_ALTGR = 120;
 177     KEY_LWIN = 121;
 178     KEY_RWIN = 122;
 179     KEY_MENU = 123;
 180     KEY_SCRLOCK = 124;
 181     KEY_NUMLOCK = 125;
 182     KEY_CAPSLOCK = 126;
 183     KEY_MAX   = 127;
 184
 185     KB_SHIFT_FLAG = $0001;
 186     KB_CTRL_FLAG = $0002;
 187     KB_ALT_FLAG = $0004;
 188     KB_LWIN_FLAG = $0008;
 189     KB_RWIN_FLAG = $0010;
 190     KB_MENU_FLAG = $0020;
 191     KB_COMMAND_FLAG = $0040;
 192     KB_SCROLOCK_FLAG = $0100;
 193     KB_NUMLOCK_FLAG = $0200;
 194     KB_CAPSLOCK_FLAG = $0400;
 195     KB_INALTSEQ_FLAG = $0800;
 196     KB_ACCENT1_FLAG = $1000;
 197     KB_ACCENT2_FLAG = $2000;
 198     KB_ACCENT3_FLAG = $4000;
 199     KB_ACCENT4_FLAG = $8000;
 200
 201     ALLEGRO_ERROR_SIZE = 256;
 202     PAL_SIZE = 256;
 203
 204   type
 205     PBITMAP = ^BITMAP;
 206     BITMAP = record
 207       w, h: cint;
 208       clip: cint;
 209       cl, cr, ct, cb: cint;
 210       vtable: Pointer; {PGFX_VTABLE}
 211       write_bank: Pointer;
 212       read_bank: Pointer;
 213       dat: Pointer;
 214       id: culong;
 215       extra: Pointer;
 216       x_ofs: cint;
 217       y_ofs: cint;
 218       seg: cint;
 219       line: Pointer;
 220     end;
 221
 222     PGFX_MODE = ^GFX_MODE;
 223     GFX_MODE = record
 224       width, height, bpp: cint;
 225     end;
 226
 227     PGFX_MODE_LIST = ^GFX_MODE_LIST;
 228     GFX_MODE_LIST = record
 229       num_modes: cint;
 230       mode: PGFX_MODE;
 231     end;
 232
 233     RGB = record
 234       r, g, b, filler: cuchar;
 235     end;
 236
 237     PALETTE = array [0..PAL_SIZE - 1] of RGB;
 238     PPALETTE = ^PALETTE;
 239
 240    KeyboardCallback = procedure (scancode: cint); LibraryLibAllegroDecl;
 241    AtExitCallback = procedure; LibraryLibAllegroDecl;
 242    AtExitFunction = function (func: AtExitCallback): cint; LibraryLibAllegroDecl;
 243    TimerIntCallback = procedure; LibraryLibAllegroDecl;
 244    QuitCallback = procedure; LibraryLibAllegroDecl;
 245
 246   var
 247     allegro_id: array [0..ALLEGRO_ERROR_SIZE] of char; LibraryLibAllegroVar;
 248     allegro_error: array [0..ALLEGRO_ERROR_SIZE] of char; LibraryLibAllegroVar;
 249     keyboard_lowlevel_callback: KeyboardCallback; LibraryLibAllegroVar;
 250     screen: PBITMAP; LibraryLibAllegroVar;
 251     black_palette: PALETTE; LibraryLibAllegroVar;
 252     desktop_palette: PALETTE; LibraryLibAllegroVar;
 253     default_palette: PALETTE; LibraryLibAllegroVar;
 254     _current_palette: PALETTE; LibraryLibAllegroVar;
 255
 256   function get_desktop_resolution (width, height: Pcint): cint; LibraryLibAllegroImp;
 257   function get_gfx_mode_list (card: cint): PGFX_MODE_LIST; LibraryLibAllegroImp;
 258   procedure destroy_gfx_mode_list (gfx_mode_list: PGFX_MODE_LIST); LibraryLibAllegroImp;
 259   function set_gfx_mode (card, w, h, v_w, v_h: cint): cint; LibraryLibAllegroImp;
 260   procedure set_window_title (name: Pchar); LibraryLibAllegroImp;
 261   function create_video_bitmap (width, height: cint): PBITMAP; LibraryLibAllegroImp;
 262   procedure destroy_bitmap (bitmap: PBITMAP); LibraryLibAllegroImp;
 263   function show_video_bitmap (bitmap: PBITMAP): cint; LibraryLibAllegroImp;
 264   function poll_keyboard: cint; LibraryLibAllegroImp;
 265   function install_keyboard: cint; LibraryLibAllegroImp;
 266   procedure remove_keyboard; LibraryLibAllegroImp;
 267   function _install_allegro_version_check (system_id: cint; errno_ptr: Pcint; atexit_ptr: AtExitFunction; version: cint): cint; LibraryLibAllegroImp;
 268
 269   function install_timer: cint; LibraryLibAllegroImp;
 270   procedure remove_timer; LibraryLibAllegroImp;
 271   procedure set_keyboard_rate (delay, _repeat: cint); LibraryLibAllegroImp;
 272   function makeacol (r, g, b, a: cint): cint; LibraryLibAllegroImp;
 273   function makecol (r, g, b: cint): cint; LibraryLibAllegroImp;
 274   procedure clear_to_color (source: PBITMAP; color: cint); LibraryLibAllegroImp;
 275   procedure putpixel (bmp: PBITMAP; x, y, color: cint); LibraryLibAllegroImp;
 276   function getpixel (bmp: PBITMAP; x, y: cint): cint; LibraryLibAllegroImp;
 277   procedure fastline (bmp: PBITMAP; x1, y_1, x2, y2, color: cint); LibraryLibAllegroImp;
 278   procedure draw_sprite (bmp, sprite: PBITMAP; x, y: cint); LibraryLibAllegroImp;
 279   procedure draw_sprite_v_flip (bmp, sprite: PBITMAP; x, y: cint); LibraryLibAllegroImp;
 280   procedure draw_sprite_h_flip (bmp, sprite: PBITMAP; x, y: cint); LibraryLibAllegroImp;
 281   procedure draw_sprite_vh_flip (bmp, sprite: PBITMAP; x, y: cint); LibraryLibAllegroImp;
 282   procedure rect (bmp: PBITMAP; x1, y_1, x2, y2, color: cint); LibraryLibAllegroImp;
 283   procedure rectfill (bmp: PBITMAP; x1, y_1, x2, y2, color: cint); LibraryLibAllegroImp;
 284   function create_bitmap (width, height: cint): PBITMAP; LibraryLibAllegroImp;
 285   function create_system_bitmap (width, height: cint): PBITMAP; LibraryLibAllegroImp;
 286   procedure allegro_exit; LibraryLibAllegroImp;
 287
 288   procedure rest (time: cuint); LibraryLibAllegroImp;
 289   function install_int_ex (proc: TimerIntCallback; speed: clong): cint; LibraryLibAllegroImp;
 290   procedure blit (source, dest: PBITMAP; source_x, source_y, dest_x, dest_y, width, height: cint); LibraryLibAllegroImp;
 291   procedure masked_blit (source, dest: PBITMAP; source_x, source_y, dest_x, dest_y, width, height: cint); LibraryLibAllegroImp;
 292   procedure set_clip_rect (bitmap: PBITMAP; x1, y1, x2, y2: cint); LibraryLibAllegroImp;
 293   procedure get_clip_rect (bitmap: PBITMAP; var x1, y1, x2, y2: cint); LibraryLibAllegroImp;
 294
 295   procedure set_palette (const p: PALETTE); LibraryLibAllegroImp;
 296   procedure set_color_depth (depth: cint); LibraryLibAllegroImp;
 297   function set_close_button_callback (proc: QuitCallback): cint; LibraryLibAllegroImp;
 298
 299 //  function _install_allegro (system_id: cint; errno_prt: Pcint; AtExitFunction): cint; LibraryLibAllegroImp;
 300
 301   (* MACRO *)
 302   function install_allegro (system_id: cint; errno_ptr: Pcint; atexit_ptr: AtExitFunction): cint; inline;
 303   function allegro_init: cint; inline;
 304
 305   function TIMERS_PER_SECOND: clong; inline;
 306   function SECS_TO_TIMER (x: clong): clong; inline;
 307   function MSEC_TO_TIMER (x: clong): clong; inline;
 308   function BPS_TO_TIMER (x: clong): clong; inline;
 309   function BPM_TO_TIMER (x: clong): clong; inline;
 310
 311 (*
 312   function acquire_bitmap (bmp: PBITMAP); inline;
 313   function release_bitmap (bmp: PBITMAP); inline;
 314   function acquire_screen; inline;
 315   function release_screen; inline;
 316 *)
 317
 318   procedure acquire_bitmap (bmp: PBITMAP); LibraryLibAllegroImp;
 319   procedure release_bitmap (bmp: PBITMAP); LibraryLibAllegroImp;
 320   procedure acquire_screen; LibraryLibAllegroImp;
 321   procedure release_screen; LibraryLibAllegroImp;
 322
 323 implementation
 324
 325   {$IF DEFINED(GO32V2)}
 326     function atexit (func: AtexitCallback): cint; cdecl; external;
 327   {$ELSEIF DEFINED(WINDOWS)}
 328     function atexit (func: AtexitCallback): cint; cdecl; external 'msvcrt.dll';
 329   {$ELSE}
 330     function atexit (func: AtexitCallback): cint; cdecl; external 'c';
 331   {$ENDIF}
 332
 333   function install_allegro (system_id: cint; errno_ptr: Pcint; atexit_ptr: AtExitFunction): cint; inline;
 334   begin
 335     install_allegro := _install_allegro_version_check(system_id, errno_ptr, atexit_ptr, (ALLEGRO_VERSION shl 16) OR (ALEGRO_SUB_VERSION shl 8) OR ALLEGRO_WIP_VERSION)
 336   end;
 337
 338   function allegro_init: cint; inline;
 339   begin
 340     (* original macros sets libc errno? *)
 341     allegro_init := _install_allegro_version_check(SYSTEM_AUTODETECT, nil, @atexit, (ALLEGRO_VERSION shl 16) OR (ALEGRO_SUB_VERSION shl 8) OR ALLEGRO_WIP_VERSION)
 342   end;
 343
 344   function TIMERS_PER_SECOND: clong; inline;
 345   begin
 346     TIMERS_PER_SECOND := 1193181
 347   end;
 348
 349   function SECS_TO_TIMER (x: clong): clong; inline;
 350   begin
 351     SECS_TO_TIMER := x * TIMERS_PER_SECOND
 352   end;
 353
 354   function MSEC_TO_TIMER (x: clong): clong; inline;
 355   begin
 356     MSEC_TO_TIMER := x * TIMERS_PER_SECOND div 1000
 357   end;
 358
 359   function BPS_TO_TIMER (x: clong): clong; inline;
 360   begin
 361     BPS_TO_TIMER := TIMERS_PER_SECOND div x
 362   end;
 363
 364   function BPM_TO_TIMER (x: clong): clong; inline;
 365   begin
 366     BPM_TO_TIMER := 60 * TIMERS_PER_SECOND div x
 367   end;
 368
 369 (*
 370   function acquire_bitmap (bmp: PBITMAP); inline;
 371   begin
 372     ASSERT(bmp <> nil);
 373     if bmp.vtable.acquire <> nil then
 374       bmp.vtable.acquire(bmp)
 375   end;
 376 *)
 377
 378 end.