[Overview][Constants][Types][Procedures and functions][Variables][Index] | Reference for unit 'go32' (#rtl)

# get_rm_callback

Return real mode callback

## Declaration

Source position: go32.pp line 142

`function get_rm_callback(`
`pm_func: pointer;`
`const reg: trealregs;`
`var rmcb: tseginfo`
`):Boolean;`

## Description

Returns a unique real mode segment:offset address, known as a "real mode callback," that will transfer control from real mode to a protected mode procedure.

Parameters:

pm_func
  pointer to the protected mode callback function.
reg
  supplied registers structure.
rmcb
  buffer to real mode address of callback function.

Return values: True if successful, otherwise False.

Remark:

Callback addresses obtained with this function can be passed by a protected mode program for example to an interrupt handler, device driver, or TSR, so that the real mode program can call procedures within the protected mode program or notify the protected mode program of an event. The contents of the supplied regs structure is not valid after function call, but only at the time of the actual callback.

## Errors

Check the int31error variable.

## See also

free_rm_callback |  | Release real mode callback.

## Example

    { This program tries to give an example how to install a callback
    procedure with the help of the GO32 unit.

    It installs a callback which is supplied by any Microsoft compatible
    mouse driver; at a specified mouse action this routine is called.
    This callback must provide the services explained in the docs. The
    main callback has to be in assembly, because it isn't possible to do
    these services with pascal alone. But is written as general as
    possible to provide maximum re-usability for other applications and
    hence it simply calls a normal pascal user procedure in addition to
    some initialization and callback service code, so you don't need to
    hassle around with it too much.

    Notes to this user procedure :
    *) it should not last too long to execute it
    *) ALL data and code touched in this proc MUST be locked BEFORE it is
    called the first time

    Used software interrupt calls (rough descriptions, only what's used):

    Int 33h 0000h - Microsoft Mouse driver : Reset mouse
    Input : AX = 0000h
    Return : AX = FFFFh if successful
             BX = number of buttons (if FFFFh then mouse has 2 buttons)

    Int 33h 0001h - Microsoft Mouse driver : Show mouse cursor
    Input : AX = 0001h
    Return : Mouse cursor shown on screen

    Int 33h 0002h - Microsoft mouse driver : Hide mouse cursor
    Input : AX = 0002h
    Return : Hides mouse cursor again

     Int 33h 000Ch - Microsoft mouse driver : Install user callback
    Input : AX = 000Ch
            CX = bit mask which tells the mouse driver at which actions
            the callback should be called, i.e. if button pressed, mouse
            moved etc.
            (In this example it's set to 7Fh so that the callback is
            called on every action)
            ES:EDX = pointer to callback procedure to call
     Note : The registers structure supplied to the callback contains
            valid mouse data when the handler is called.
      BX = button state information
      CX = mouse X coordinates
      DX = mouse Y coordinates
    For more detailed information consult any mouse reference or
    interrupt list.
    }
    {$CALLING REGISTER}
    {$ASMMODE ATT}
    {$MODE FPC}

    uses
            crt,
            go32;

    const
            { the mouse interrupt number }
            mouseint = $33;

    var
            { supplied register structure to the callback }
            mouse_regs    : trealregs; external name '___v2prt0_rmcb_regs';
            { real mode 48 bit pointer to the callback }
            mouse_seginfo : tseginfo;

    var
            { number of mouse buttons }
            mouse_numbuttons : longint;

            { bit mask for the action which triggered the callback }
            mouse_action : word;
            { current mouse x and y coordinates }
            mouse_x, mouse_y : Word;
            { button state }
            mouse_b : Word;

            { is an additional user procedure installed }
            userproc_installed : Longbool;
            { length of additional user procedure }
            userproc_length : Longint;
            { pointer to user proc }
            userproc_proc : pointer;

    { callback control handler, calls a user procedure if installed }

    { callback control handler, calls a user procedure if installed }
    procedure callback_handler; assembler;
    asm
       pushw %ds
       pushl %eax
       movw %es, %ax
       movw %ax, %ds

       { give control to user procedure if installed }
       cmpl $0, USERPROC_INSTALLED
       je .LNoCallback
       pushal
       movw DOSmemSELECTOR, %ax
       movw %ax, %fs  { set fs for FPC }
       call *USERPROC_PROC
       popal
    .LNoCallback:

       popl %eax
       popw %ds

       pushl %eax
       movl (%esi), %eax
       movl %eax, %es: 42(%edi) { adjust stack }
       addw $4, %es:46(%edi)
       popl %eax
       iret
    end;
    { This dummy is used to obtain the length of the callback control
    function. It has to be right after the callback_handler() function.
    }
    procedure mouse_dummy; begin end;

    { This is the supplied user procedure. In this case we simply
    transform the virtual 640x200 mouse coordinate system to a 80x25
    text mode coordinate system }
    procedure textuserproc;
    begin
            { the mouse_regs record contains the real mode registers now }
            mouse_b := mouse_regs.bx;
            mouse_x := (mouse_regs.cx shr 3) + 1;
            mouse_y := (mouse_regs.dx shr 3) + 1;
    end;

    { Description : Installs the mouse callback control handler and
    handles all necessary mouse related initialization.
      Input : userproc - pointer to a user procedure, nil if none
              userproclen - length of user procedure
    }
    procedure install_mouse(userproc : pointer; userproclen : longint);
    var r : trealregs;
    begin
            { mouse driver reset }
            r.eax := $0; realintr(mouseint, r);
            if (r.eax <> $FFFF) then begin
                    Writeln('No Microsoft compatible mouse found');
                    Writeln('A Microsoft compatible mouse driver is necessary ',
                            'to run this example');
                    halt;
            end;
            { obtain number of mouse buttons }
            if (r.bx = $ffff) then mouse_numbuttons := 2
            else mouse_numbuttons := r.bx;
            Writeln(mouse_numbuttons, ' button Microsoft compatible mouse ',
                    ' found.');
            { check for additional user procedure, and install it if
            available }
            if (userproc <> nil) then begin
                    userproc_proc := userproc;
                    userproc_installed := true;
                    userproc_length := userproclen;
                    { lock code for user procedure }
                    lock_code(userproc_proc, userproc_length);
            end else begin
                    { clear variables }
                    userproc_proc := nil;
                    userproc_length := 0;
                    userproc_installed := false;
            end;
            { lock code & data which is touched in the callback handler }
            lock_data(mouse_x, sizeof(mouse_x));
            lock_data(mouse_y, sizeof(mouse_y));
            lock_data(mouse_b, sizeof(mouse_b));
            lock_data(mouse_action, sizeof(mouse_action));

            lock_data(userproc_installed, sizeof(userproc_installed));
            lock_data(userproc_proc, sizeof(userproc_proc));

            lock_data(mouse_regs, sizeof(mouse_regs));
            lock_data(mouse_seginfo, sizeof(mouse_seginfo));
            lock_code(@callback_handler,
                    longint(@mouse_dummy)-longint(@callback_handler));
            { allocate callback (supply registers structure) }
            get_rm_callback(@callback_handler, mouse_regs, mouse_seginfo);
            { install callback }
            r.eax := $0c; r.ecx := $7f;
            r.edx := longint(mouse_seginfo.offset);
            r.es := mouse_seginfo.segment;
            realintr(mouseint, r);
            { show mouse cursor }
            r.eax := $01;
            realintr(mouseint, r);
    end;

    procedure remove_mouse;
    var
            r : trealregs;
    begin
            { hide mouse cursor }
            r.eax := $02; realintr(mouseint, r);
            { remove callback handler }
            r.eax := $0c; r.ecx := 0; r.edx := 0; r.es := 0;
            realintr(mouseint, r);
            { free callback }
            free_rm_callback(mouse_seginfo);
            { check if additional userproc is installed, and clean up if
            needed }
            if (userproc_installed) then begin
                    unlock_code(userproc_proc, userproc_length);
                    userproc_proc := nil;
                    userproc_length := 0;
                    userproc_installed := false;
            end;
            { unlock used code & data }
            unlock_data(mouse_x, sizeof(mouse_x));
            unlock_data(mouse_y, sizeof(mouse_y));
            unlock_data(mouse_b, sizeof(mouse_b));
            unlock_data(mouse_action, sizeof(mouse_action));

            unlock_data(userproc_proc, sizeof(userproc_proc));
            unlock_data(userproc_installed, sizeof(userproc_installed));

            unlock_data(mouse_regs, sizeof(mouse_regs));
            unlock_data(mouse_seginfo, sizeof(mouse_seginfo));
            unlock_code(@callback_handler,
                    longint(@mouse_dummy)-longint(@callback_handler));
            fillchar(mouse_seginfo, sizeof(mouse_seginfo), 0);
    end;

    begin
            install_mouse(@textuserproc, 400);
            Writeln('Press any key to exit...');
            while (not keypressed) do begin
                    { write mouse state info }
                    gotoxy(1, wherey);
                    write('MouseX : ', mouse_x:2, ' MouseY : ', mouse_y:2,
                            ' Buttons : ', mouse_b:2);
            end;
            remove_mouse;
    end.