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     COLOR_MAP_T = record
 241       data: array [0..PAL_SIZE - 1, 0..PAL_SIZE - 1] of cuchar;
 242     end;
 243     PCOLOR_MAP_T = ^COLOR_MAP_T;
 244
 245    KeyboardCallback = procedure (scancode: cint); LibraryLibAllegroDecl;
 246    AtExitCallback = procedure; LibraryLibAllegroDecl;
 247    AtExitFunction = function (func: AtExitCallback): cint; LibraryLibAllegroDecl;
 248    TimerIntCallback = procedure; LibraryLibAllegroDecl;
 249    QuitCallback = procedure; LibraryLibAllegroDecl;
 250    CreateTableCallback = procedure (pos: cint); LibraryLibAllegroDecl;
 251
 252   var
 253     allegro_id: array [0..ALLEGRO_ERROR_SIZE] of char; LibraryLibAllegroVar;
 254     allegro_error: array [0..ALLEGRO_ERROR_SIZE] of char; LibraryLibAllegroVar;
 255     keyboard_lowlevel_callback: KeyboardCallback; LibraryLibAllegroVar;
 256     screen: PBITMAP; LibraryLibAllegroVar;
 257     black_palette: PALETTE; LibraryLibAllegroVar;
 258     desktop_palette: PALETTE; LibraryLibAllegroVar;
 259     default_palette: PALETTE; LibraryLibAllegroVar;
 260     _current_palette: PALETTE; LibraryLibAllegroVar;
 261     key_shifts: cint; LibraryLibAllegroVar;
 262     color_map: PCOLOR_MAP_T; LibraryLibAllegroVar;
 263
 264   function get_desktop_resolution (width, height: Pcint): cint; LibraryLibAllegroImp;
 265   function get_gfx_mode_list (card: cint): PGFX_MODE_LIST; LibraryLibAllegroImp;
 266   procedure destroy_gfx_mode_list (gfx_mode_list: PGFX_MODE_LIST); LibraryLibAllegroImp;
 267   function set_gfx_mode (card, w, h, v_w, v_h: cint): cint; LibraryLibAllegroImp;
 268   procedure set_window_title (name: Pchar); LibraryLibAllegroImp;
 269   function create_video_bitmap (width, height: cint): PBITMAP; LibraryLibAllegroImp;
 270   procedure destroy_bitmap (bitmap: PBITMAP); LibraryLibAllegroImp;
 271   function show_video_bitmap (bitmap: PBITMAP): cint; LibraryLibAllegroImp;
 272   function poll_keyboard: cint; LibraryLibAllegroImp;
 273   function install_keyboard: cint; LibraryLibAllegroImp;
 274   procedure remove_keyboard; LibraryLibAllegroImp;
 275   function _install_allegro_version_check (system_id: cint; errno_ptr: Pcint; atexit_ptr: AtExitFunction; version: cint): cint; LibraryLibAllegroImp;
 276
 277   function install_timer: cint; LibraryLibAllegroImp;
 278   procedure remove_timer; LibraryLibAllegroImp;
 279   procedure set_keyboard_rate (delay, _repeat: cint); LibraryLibAllegroImp;
 280   function makeacol (r, g, b, a: cint): cint; LibraryLibAllegroImp;
 281   function makecol (r, g, b: cint): cint; LibraryLibAllegroImp;
 282   procedure clear_to_color (source: PBITMAP; color: cint); LibraryLibAllegroImp;
 283   procedure putpixel (bmp: PBITMAP; x, y, color: cint); LibraryLibAllegroImp;
 284   function getpixel (bmp: PBITMAP; x, y: cint): cint; LibraryLibAllegroImp;
 285   procedure fastline (bmp: PBITMAP; x1, y_1, x2, y2, color: cint); LibraryLibAllegroImp;
 286   procedure draw_sprite (bmp, sprite: PBITMAP; x, y: cint); LibraryLibAllegroImp;
 287   procedure draw_sprite_v_flip (bmp, sprite: PBITMAP; x, y: cint); LibraryLibAllegroImp;
 288   procedure draw_sprite_h_flip (bmp, sprite: PBITMAP; x, y: cint); LibraryLibAllegroImp;
 289   procedure draw_sprite_vh_flip (bmp, sprite: PBITMAP; x, y: cint); LibraryLibAllegroImp;
 290   procedure rect (bmp: PBITMAP; x1, y_1, x2, y2, color: cint); LibraryLibAllegroImp;
 291   procedure rectfill (bmp: PBITMAP; x1, y_1, x2, y2, color: cint); LibraryLibAllegroImp;
 292   function create_bitmap (width, height: cint): PBITMAP; LibraryLibAllegroImp;
 293   function create_system_bitmap (width, height: cint): PBITMAP; LibraryLibAllegroImp;
 294   procedure allegro_exit; LibraryLibAllegroImp;
 295
 296   procedure rest (time: cuint); LibraryLibAllegroImp;
 297   function install_int_ex (proc: TimerIntCallback; speed: clong): cint; LibraryLibAllegroImp;
 298   procedure blit (source, dest: PBITMAP; source_x, source_y, dest_x, dest_y, width, height: cint); LibraryLibAllegroImp;
 299   procedure masked_blit (source, dest: PBITMAP; source_x, source_y, dest_x, dest_y, width, height: cint); LibraryLibAllegroImp;
 300   procedure set_clip_rect (bitmap: PBITMAP; x1, y1, x2, y2: cint); LibraryLibAllegroImp;
 301   procedure get_clip_rect (bitmap: PBITMAP; var x1, y1, x2, y2: cint); LibraryLibAllegroImp;
 302
 303   procedure set_palette (const p: PALETTE); LibraryLibAllegroImp;
 304   procedure set_color_depth (depth: cint); LibraryLibAllegroImp;
 305   function set_close_button_callback (proc: QuitCallback): cint; LibraryLibAllegroImp;
 306
 307 //  function _install_allegro (system_id: cint; errno_prt: Pcint; AtExitFunction): cint; LibraryLibAllegroImp;
 308
 309   procedure acquire_bitmap (bmp: PBITMAP); LibraryLibAllegroImp;
 310   procedure release_bitmap (bmp: PBITMAP); LibraryLibAllegroImp;
 311   procedure acquire_screen; LibraryLibAllegroImp;
 312   procedure release_screen; LibraryLibAllegroImp;
 313
 314   procedure rotate_sprite (bmp, sprite: PBITMAP; x, y: cint; a: cint32); LibraryLibAllegroImp;
 315   procedure rotate_sprite_v_flip (bmp, sprite: PBITMAP; x, y: cint; a: cint32); LibraryLibAllegroImp;
 316
 317   function scancode_to_ascii (scancode: cint): cint; LibraryLibAllegroImp;
 318   function scancode_to_name (scancode: cint): PChar; LibraryLibAllegroImp;
 319
 320   procedure drawing_mode (mode: cint; pattern: PBITMAP; x_anchor, y_anchor: cint); LibraryLibAllegroImp;
 321
 322   procedure set_trans_blender (r, g, b, a: cint); LibraryLibAllegroImp;
 323   procedure set_alpha_blender; LibraryLibAllegroImp;
 324   procedure set_write_alpha_blender; LibraryLibAllegroImp;
 325   procedure set_add_blender (r, g, b, a: cint); LibraryLibAllegroImp;
 326   procedure set_burn_blender (r, g, b, a: cint); LibraryLibAllegroImp;
 327   procedure set_color_blender (r, g, b, a: cint); LibraryLibAllegroImp;
 328   procedure set_difference_blender (r, g, b, a: cint); LibraryLibAllegroImp;
 329   procedure set_dissolve_blender (r, g, b, a: cint); LibraryLibAllegroImp;
 330   procedure set_dodge_blender (r, g, b, a: cint); LibraryLibAllegroImp;
 331   procedure set_hue_blender (r, g, b, a: cint); LibraryLibAllegroImp;
 332   procedure set_invert_blender (r, g, b, a: cint); LibraryLibAllegroImp;
 333   procedure set_luminance_blender (r, g, b, a: cint); LibraryLibAllegroImp;
 334   procedure set_multiply_blender (r, g, b, a: cint); LibraryLibAllegroImp;
 335   procedure set_saturation_blender (r, g, b, a: cint); LibraryLibAllegroImp;
 336   procedure set_screen_blender (r, g, b, a: cint); LibraryLibAllegroImp;
 337
 338   function getr (col: cint): cint; LibraryLibAllegroImp;
 339   function getg (col: cint): cint; LibraryLibAllegroImp;
 340   function getb (col: cint): cint; LibraryLibAllegroImp;
 341   function geta (col: cint): cint; LibraryLibAllegroImp;
 342
 343   procedure create_light_table (table: PCOLOR_MAP_T; const pal: PALETTE; r, g, b: cint; callback: CreateTableCallback); LibraryLibAllegroImp;
 344   procedure create_trans_table (table: PCOLOR_MAP_T; const pal: PALETTE; r, g, b: cint; callback: CreateTableCallback); LibraryLibAllegroImp;
 345
 346   (* MACRO *)
 347   function install_allegro (system_id: cint; errno_ptr: Pcint; atexit_ptr: AtExitFunction): cint; inline;
 348   function allegro_init: cint; inline;
 349
 350   function TIMERS_PER_SECOND: clong; inline;
 351   function SECS_TO_TIMER (x: clong): clong; inline;
 352   function MSEC_TO_TIMER (x: clong): clong; inline;
 353   function BPS_TO_TIMER (x: clong): clong; inline;
 354   function BPM_TO_TIMER (x: clong): clong; inline;
 355
 356
 357 implementation
 358
 359   {$IF DEFINED(GO32V2)}
 360     function atexit (func: AtexitCallback): cint; cdecl; external;
 361   {$ELSEIF DEFINED(WINDOWS)}
 362     function atexit (func: AtexitCallback): cint; cdecl; external 'msvcrt.dll';
 363   {$ELSE}
 364     function atexit (func: AtexitCallback): cint; cdecl; external 'c';
 365   {$ENDIF}
 366
 367   function install_allegro (system_id: cint; errno_ptr: Pcint; atexit_ptr: AtExitFunction): cint; inline;
 368   begin
 369     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)
 370   end;
 371
 372   function allegro_init: cint; inline;
 373   begin
 374     (* original macros sets libc errno? *)
 375     allegro_init := _install_allegro_version_check(SYSTEM_AUTODETECT, nil, @atexit, (ALLEGRO_VERSION shl 16) OR (ALEGRO_SUB_VERSION shl 8) OR ALLEGRO_WIP_VERSION)
 376   end;
 377
 378   function TIMERS_PER_SECOND: clong; inline;
 379   begin
 380     TIMERS_PER_SECOND := 1193181
 381   end;
 382
 383   function SECS_TO_TIMER (x: clong): clong; inline;
 384   begin
 385     SECS_TO_TIMER := x * TIMERS_PER_SECOND
 386   end;
 387
 388   function MSEC_TO_TIMER (x: clong): clong; inline;
 389   begin
 390     MSEC_TO_TIMER := x * TIMERS_PER_SECOND div 1000
 391   end;
 392
 393   function BPS_TO_TIMER (x: clong): clong; inline;
 394   begin
 395     BPS_TO_TIMER := TIMERS_PER_SECOND div x
 396   end;
 397
 398   function BPM_TO_TIMER (x: clong): clong; inline;
 399   begin
 400     BPM_TO_TIMER := 60 * TIMERS_PER_SECOND div x
 401   end;
 402
 403 (*
 404   function acquire_bitmap (bmp: PBITMAP); inline;
 405   begin
 406     ASSERT(bmp <> nil);
 407     if bmp.vtable.acquire <> nil then
 408       bmp.vtable.acquire(bmp)
 409   end;
 410 *)
 411
 412 end.