[Back to MOUSE SWAG index] [Back to Main SWAG index] [Original]

    UNIT  uMCursor;                               { (c) 1994 by NEBULA-Soft. }
          { Mausroutinen f�r Textmodus          } { Olaf Bartelt & Oliver Carow }
    { ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ } INTERFACE { ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ }
    USES  DOS, video;                             { Einbinden der Units         }

    { The unit VIDEO is also included in the SWAG distribution in the CRT.SWG   }

    { Ä Konstantendeklarationen ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ }
    CONST cLinke_taste                 = 1;       { linke Maustaste             }
          cRechte_taste                = 2;       { rechte Maustaste            }
          cMittlere_taste              = 4;       { mittlere Maustaste (bei 3)  }

          cursor_location_changed      = 1;
          left_button_pressed          = 2;
          left_button_released         = 4;
          right_button_pressed         = 8;
          right_button_released        = 16;
          middle_button_pressed        = 32;
          middle_button_released       = 64;

          lastmask                     : WORD    = 0;
          lasthandler                  : POINTER = NIL;

          click_repeat                 = 10;
          mousetextscale               = 8;
          vgatextgraphiccursor         : BOOLEAN = FALSE;

    { Ä Typendeklarationen ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ }
    TYPE  mousetype                    = (twobutton, threebutton, another);
          buttonstate                  = (buttondown, buttonup);
          direction                    = (moveright, moveleft, moveup, movedown,
    nomove);

    { Ä Variablendeklarationen ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ }
    VAR   mouse_present                : BOOLEAN;
          mouse_buttons                : mousetype;
          eventx, eventy, eventbuttons : WORD;
          eventhappened                : BOOLEAN;
          xmotions, ymotions           : WORD;
          mousecursorlevel             : INTEGER;
          fontpoints                   : BYTE;

          maxmousex             : INTEGER;
          maxmousey                    : INTEGER;

    { Ä exportierte Prozeduren und Funktionen ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ }
    PROCEDURE set_graphic_mouse_cursor;        { graphischen Mousecursor setzen }
    PROCEDURE showmousecursor;

    { ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ } IMPLEMENTATION { ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ }
    {$IFDEF VER60}                                { in TP 6.0 gibt es SEGxxxx   }
    CONST SEG0040 = $0040;                        { noch nicht! => definieren!  }
          SEGB800 = $B800;
          SEGA000 = $A000;
    {$ENDIF}

    { Ä Typendeklarationen ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ }
    TYPE  pTextgraphikcursor = ^tTextgraphikcursor;  { Zeiger auf Array         }
          tTextgraphikcursor = ARRAY[0..31] OF LONGINT;

          box                = RECORD
                                 left, top, right, bottom : WORD;
                               END;
          pChardefs          = ^tChardefs;
          tChardefs          = ARRAY[0..(32*8)] OF BYTE;

    { Ä Konstantendeklarationen ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ }
    CONST pfeil                  : tTextgraphikcursor =
    { Maske:  } ($3FFFFFFF, $1FFFFFFF, $0FFFFFFF, $07FFFFFF, $03FFFFFF, $01FFFFFF,
                 $00FFFFFF, $007FFFFF, $003FFFFF, $007FFFFF, $01FFFFFF, $10FFFFFF,
                 $B0FFFFFF, $F87FFFFF, $F87FFFFF, $FcFFFFFF,
    { Cursor: }  $00000000, $40000000, $60000000, $70000000, $78000000, $7C000000,
                 $7E000000, $7F000000, $7F800000, $7F000000, $7C000000, $46000000,
                 $06000000, $03000000, $03000000, $00000000);

          sanduhr : tTextgraphikcursor =        ($0001FFFF,  { 0000000000000001 }
                    { Cursorform:      }         $0001FFFF,  { 0000000000000001 }
                                                 $8003FFFF,  { 1000000000000011 }
                                                 $C7C7FFFF,  { 1100011111000111 }
                                                 $E38FFFFF,  { 1110001110001111 }
                                                 $F11FFFFF,  { 1111000100011111 }
                                                 $F83FFFFF,  { 1111100000111111 }
                                                 $FC7FFFFF,  { 1111110001111111 }
                                                 $F83FFFFF,  { 1111100000111111 }
                                                 $F11FFFFF,  { 1111000100011111 }
                                                 $E38FFFFF,  { 1110001110001111 }
                                                 $C7C7FFFF,  { 1100011111000111 }
                                                 $8003FFFF,  { 1000000000000011 }
                                                 $0001FFFF,  { 0000000000000001 }
                                                 $0001FFFF,  { 0000000000000001 }
                                                 $0000FFFF,  { 0000000000000000 }
                                                    { ^^^^ immer! (Textmodus)   }
                    { Bildschirmmaske: }         $00000000,  { 0000000000000000 }
                                                 $7FFC0000,  { 0111111111111100 }
                                                 $20080000,  { 0010000000001000 }
                                                 $10100000,  { 0001000000010000 }
                                                 $08200000,  { 0000100000100000 }
                                                 $04400000,  { 0000010001000000 }
                                                 $02800000,  { 0000001010000000 }
                                                 $01000000,  { 0000000100000000 }
                                                 $02800000,  { 0000001010000000 }
                                                 $04400000,  { 0000010001000000 }
                                                 $08200000,  { 0000100000100000 }
                                                 $10100000,  { 0001000000010000 }
                                                 $20080000,  { 0010000000001000 }
                                                 $7FFC0000,  { 0111111111111100 }
                                                 $00000000,  { 0000000000000000 }
                                                 $00000000); { 0000000000000000 }
                                                    { ^^^^ immer! (Textmodus)   }

          vgatextgraphicptr      : pTextgraphikcursor = @pfeil;
                                                      { @sanduhr                }
    { Ä Variablendeklarationen ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ }
    VAR   hidebox                : box;
          regs                   : REGISTERS;
          vgastoredarray         : ARRAY[1..3, 1..3] OF BYTE;
          lasteventx, lasteventy : WORD;
          hasstoredarray         : BOOLEAN;
          oldexitproc            : POINTER;

    CONST chardefs               : pChardefs = NIL;
          charheight             = 16;
          defchar                = $D0;

    { Ä exportierte Prozeduren und Funktionen ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ }
    procedure swap(var a,b : word);
    var c : word;
    begin
     c := a;
     a := b;
     b := c; {swap a and b}
    end; {swap}

    procedure setMouseCursor(x,y : word);
    begin
     with regs do begin
      ax := 4;
      cx := x;
      dx := y; {prepare parameters}
      INTR($33, regs);
     end; {with}
    end; {setMouseCursor}

    FUNCTION x : WORD;
    BEGIN
      regs.AX := 3;
      INTR($33, regs);
      x := regs.CX;
    END;

    FUNCTION y : WORD;
    BEGIN
      regs.AX := 3;
      INTR($33, regs);
      y := regs.DX;
    END;

    procedure mouseBox(left,top,right,bottom : word);
    begin
     if (left > right) then swap(left,right);
     if (top > bottom) then swap(top,bottom); {make sure they are ordered}
     regs.ax := 7;
     regs.cx := left;
     regs.dx := right;
     INTR($33, regs); {set x range}
     regs.ax := 8;
     regs.cx := top;
     regs.dx := bottom;
     INTR($33, regs); {set y range}
    end; {mouseBox}

    PROCEDURE initmouse;
    VAR overridedriver : BOOLEAN;                 { wegen Hercules-Karten       }
        tempvideomode  : BYTE;                    { Zwischenspeicher f�r Modus  }
    BEGIN
      overridedriver := FALSE;                    { erstmal nicht override!     }

      IF (FALSE AND (MEM[SEG0040:$0049] = 7)) THEN  { doch overriden?           }
      BEGIN
        MEM[SEG0040:$0049] := 6;                  { Ja: Videomodus vort�uschen  }
        overridedriver := TRUE;                   {     und override setzen!    }
      END;

      IF vgatextgraphiccursor = TRUE THEN         { Graphikcursor im Textmodus? }
      BEGIN
        tempvideomode := MEM[SEG0040:$0049];      { Videomodus zwischenspeichern}
        MEM[SEG0040:$0049] := 6;                  { anderen Modus vort�uschen   }
      END;

      WITH regs DO                                { Maustyp ermitteln           }
      BEGIN                                       { und Anzahl der Tasten auch  }
        AX := 0; BX := 0;                         { Maus initialisieren (00h)   }
        INTR($33, regs);                          { Mausinterrupt aufrufen      }

        mouse_present := (AX <> 0);               { �berhaupt Maus vorhanden?   }
        IF (BX AND 2) <> 0 THEN mouse_buttons := twobutton  { Maustasten ermitt.}
                           ELSE IF (BX AND 3) > 0 THEN mouse_buttons := threebutton
                                                  ELSE mouse_buttons := another;
      END;

      IF overridedriver = TRUE THEN MEM[SEG0040:$0049] := 7;  { override?       }
      IF vgatextgraphiccursor = TRUE THEN         { Graphikcursor im Textmodus? }
        MEM[SEG0040:$0049] := tempvideomode;      { Ja: Modus restaurieren!     }

      IF (NOT vgatextgraphiccursor) THEN fontpoints := mousetextscale
                                    ELSE fontpoints := MEM[SEG0040:$0085];
      maxmousex := maxx * mousetextscale;         { Mausgrenzen ausrechnen      }
      maxmousey := maxy * fontpoints;

      mousebox(0, 0, (visiblex * mousetextscale)-1, (visibley * fontpoints)-1);
      eventbuttons := 0; eventhappened := FALSE;  { noch kein Event gewesen!    }

      xmotions := 8; ymotions := 16; mousecursorlevel := 0;  { Cursor nicht s.  }
      hasstoredarray := FALSE;                    { noch keine Daten im Array   }

      setmousecursor(visiblex * mousetextscale DIV 2, visibley * fontpoints DIV 2);
      eventx := x; eventy := y; lasteventx := eventx; lasteventy := eventy;
    END;

    PROCEDURE vgascreen2array(newposition, s2a, defaultrange : BOOLEAN);
    VAR x, y : WORD;
        w, h : WORD;
        o, l : WORD;
        i, j : BYTE;
    BEGIN
      IF (newposition = TRUE) THEN
      BEGIN
        x := eventx DIV mousetextscale;
        y := eventy DIV fontpoints;
      END
      ELSE
      BEGIN
        x := lasteventx DIV mousetextscale;
        y := lasteventy DIV fontpoints;
      END;

      w := visiblex - x; IF (w > 3) THEN w := 3;
      h := visibley - y; IF (h > 3) THEN h := 3;
      o := 2 * x + 2 * visiblex * y;
      l := 2 * visiblex - 2 * w;

      IF (defaultrange = TRUE) THEN
      BEGIN
        FOR i := 0 TO h - 1 DO
        BEGIN
          FOR j := 0 TO w - 1 DO
          BEGIN
            MEM[SEGB800:o] := defchar + i * 3 + j;
            INC(o, 2);
          END;
          INC(o, l);
        END;
      END
      ELSE
        IF (s2a = TRUE) THEN
        BEGIN
          FOR i := 1 TO h DO
          BEGIN
            FOR j := 1 TO w DO
            BEGIN
              vgastoredarray[i, j] := MEM[SEGB800:o];
              INC(o, 2)
            END;
            INC(o, l);
          END;
        END
        ELSE
        BEGIN
          FOR i := 1 TO h DO
          BEGIN
            FOR j := 1 TO w DO
            BEGIN
              MEM[SEGB800:o] := vgastoredarray[i, j];
              INC(o, 2);
            END;
            INC(o, l);
          END;
        END;
    END;

    PROCEDURE drawvgatextgraphiccursor;
    TYPE  lp = ^LONGINT;
    CONST sequencerport     = $3C4;
          sequenceraddrmode = $704;
          sequenceraddrnrml = $302;
          vgacontrolerport  = $3CE;
          cpureadmap2       = $204;
          cpuwritemap2      = $402;
          mapstartaddrA000  = $406;
          mapstartaddrB800  = $E06;
          oddevenaddr       = $304;
    VAR   o, s              : WORD;
          i, j              : INTEGER;
          s1, s2, s3        : WORD;
          a                 : LONGINT;
          d, mc, ms         : lp;

    BEGIN
      ASM
        PUSHF
        CLI
        MOV DX, sequencerport
        MOV AX, sequenceraddrmode
        OUT DX, AX
        MOV DX, vgacontrolerport
        MOV AX, cpureadmap2
        OUT DX, AX
        MOV AX, 5
        OUT DX, AX
        MOV AX, mapstartaddrA000
        OUT DX, AX
        POPF
      END;

       o := 0;
       FOR i := 1 TO 3 DO
       BEGIN
         s1 := vgastoredarray[i, 1] * 32;
         s2 := vgastoredarray[i, 2] * 32;
         s3 := vgastoredarray[i, 3] * 32;

         FOR j := 1 TO fontpoints DO
         BEGIN
           INC(o); chardefs^[o] := MEM[SEGA000:s3];
           INC(o); chardefs^[o] := MEM[SEGA000:s2];
           INC(o); chardefs^[o] := MEM[SEGA000:s1];
           INC(o); INC(s1); INC(s2); INC(s3);
         END;
       END;

       s := eventx MOD mousetextscale;
       a := $FF000000 SHL (mousetextscale - s);

       d  := @chardefs^[(eventy MOD fontpoints) * SIZEOF(LONGINT)];
       ms := @vgatextgraphicptr^;
       mc := @vgatextgraphicptr^[charheight];

       FOR i := 1 TO charheight DO
       BEGIN
         d^ := (d^ and ((ms^ shr s) or a)) or (mc^ shr s);
         INC(WORD(d), SIZEOF(LONGINT));
         INC(WORD(mc), SIZEOF(LONGINT));
         INC(WORD(ms), SIZEOF(LONGINT));
       END;

       ASM
         MOV DX, sequencerport
         MOV AX, cpuwritemap2
         OUT DX, AX
       END;

       o := 0;
       for i := 0 to 2 do begin
          s1 := (defChar + 3 * i    ) * 32;
          s2 := (defChar + 3 * i + 1) * 32;
          s3 := (defChar + 3 * i + 2) * 32;
          for j := 1 to fontPoints do begin
             inc(o); { skip 4th byte }
             mem[segA000:s3] := charDefs^[o];
                { this code is changed to minimize DS variable space ! - RL }
             inc(o);
             mem[segA000:s2] := charDefs^[o];
             inc(o);
             mem[segA000:s1] := charDefs^[o];
             inc(o);
             inc(s1);
             inc(s2);
             inc(s3);
          end; { for j }
       end; { for i }

       (* now we will return the graphic adapter back to normal *)

       asm
          pushf;
          cli; { disable intr .. }
          mov dx, sequencerPort;
          mov ax, sequencerAddrNrml;
          out dx, ax;
          mov ax, oddEvenAddr;
          out dx, ax;

          mov dx, vgaControlerPort;
          mov ax, 4; { map 0 for cpu reads }
          out dx, ax;
          mov ax, $1005;
          out dx, ax;
          mov ax, mapStartAddrB800;
          out dx, ax
          popf;
       end; { asm }

       vgaScreen2Array(true, false, true); { go ahead and paint it .. }

    end; {drawVGATextGraphicCursor}

    (******************************************************************************
    *                               showMouseCursor                               *
    ******************************************************************************)
    procedure showMouseCursor;

    begin
     inc(mouseCursorLevel);
       if (not vgaTextGraphicCursor) then begin
        regs.ax:=1; {enable cursor display}
        INTR($33, regs);
       end else if ((mouseCursorLevel = 1) and mouse_present) then begin
          vgaScreen2Array(true, true, false);
          hasStoredArray := true;
          drawVGATextGraphicCursor;
       end;
    end; {showMouseCursor}

    (******************************************************************************
    *                               hideMouseCursor                               *
    ******************************************************************************)
    procedure hideMouseCursor;

    begin
     dec(mouseCursorLevel);
       if (not vgaTextGraphicCursor) then begin
        regs.ax:=2; {disable cursor display}
        INTR($33, regs);
       end else if ((mouseCursorLevel = 0) and (hasStoredArray)) then begin
          vgaScreen2Array(false, false, false);
          hasStoredArray := false;
       end;
    end; {hideMouseCursor}

    (******************************************************************************
    *                                  getButton                                  *
    ******************************************************************************)
    function getButton(Button : Byte) : buttonState;

    begin
            regs.ax := 3;
            INTR($33, regs);
            if ((regs.bx and Button) <> 0) then
                    getButton := buttonDown
                    {bit 0 = left, 1 = right, 2 = middle}
            else getButton := buttonUp;
    end; {getButton}

    (******************************************************************************
    *                                buttonPressed                                *
    ******************************************************************************)
    function buttonPressed : boolean;

    begin
            regs.ax := 3;
            INTR($33, regs);
            if ((regs.bx and 7) <> 0) then
                    buttonPressed := True
            else buttonPressed := False;
    end; {buttonPressed}

    (******************************************************************************
    *                                 lastXPress                                  *
    ******************************************************************************)
    function lastXPress(Button : Byte) : word;

    begin
            regs.ax := 5;
            regs.bx := Button;
            INTR($33, regs);
            lastXPress := regs.cx;
    end; {lastXpress}

    (******************************************************************************
    *                                 lastYPress                                  *
    ******************************************************************************)
    function lastYPress(Button : Byte) : word;

    begin
            regs.ax := 5;
            regs.bx := Button;
            INTR($33, regs);
            lastYPress := regs.dx;
    end; {lastYpress}

    (******************************************************************************
    *                                buttonPresses                                *
    ******************************************************************************)
    function buttonPresses(Button : Byte) : word; {from last check}

    begin
            regs.ax := 5;
            regs.bx := Button;
            INTR($33, regs);
            buttonPresses := regs.bx;
    end; {buttonPresses}

    (******************************************************************************
    *                                lastXRelease                                 *
    ******************************************************************************)
    function lastXRelease(Button : Byte) : word;

    begin
            regs.ax := 6;
            regs.bx := Button;
            INTR($33, regs);
            lastXRelease := regs.cx;
    end; {lastXRelease}

    (******************************************************************************
    *                                lastYRelease                                 *
    ******************************************************************************)
    function lastYRelease(Button : Byte) : word;

    begin
            regs.ax := 6;
            regs.bx := Button;
            INTR($33, regs);
            lastYRelease := regs.dx;
    end; {lastYRelease}

    (******************************************************************************
    *                               buttonReleases                                *
    ******************************************************************************)
    function buttonReleases(Button : Byte) : word; {from last check}

    begin
            regs.ax := 6;
            regs.bx := Button;
            INTR($33, regs);
            buttonReleases := regs.bx;
    end; {buttonReleases}

    (******************************************************************************
    *                             HardwareTextCursor                              *
    ******************************************************************************)
    procedure HardwareTextCursor(fromLine,toLine : byte);

    {set text cursor to text, using the scan lines from..to,
            same as intr 10 cursor set in bios :
            color scan lines 0..7, monochrome 0..13 }

    begin
            regs.ax := 10;
            regs.bx := 1; {hardware text}
            regs.cx := fromLine;
            regs.dx := toLine;
            INTR($33, regs);
    end; {hardwareTextCursor}

    (******************************************************************************
    *                             softwareTextCursor                              *
    ******************************************************************************)
    procedure softwareTextCursor(screenMask,cursorMask : word);

    { when in this mode the cursor will be achived by ANDing the screen word
            with the screen mask (Attr,Char in high,low order) and
            XORing the cursor mask, ussually used by putting the screen attr
            we want preserved in screen mask (and 0 into screen mask character
            byte), and character + attributes we want to set into cursor mask}

    begin
            regs.ax := 10;
            regs.bx := 0;        {software cursor}
            regs.cx := screenMask;
            regs.dx := cursorMask;
            INTR($33, regs);
    end; {softwareMouseCursor}

    (******************************************************************************
    *                               recentXmovement                               *
    ******************************************************************************)
    function recentXmovement : direction;

    {from recent call to which direction did we move ?}

    var d : integer;

    begin
            regs.ax := 11;
            INTR($33, regs);
            d := regs.cx;
            if (d > 0)
                    then recentXmovement := moveRight
            else if (d < 0)
                    then recentXmovement := moveLeft
            else recentXmovement := noMove;
    end; {recentXmovement}

    (******************************************************************************
    *                               recentYmovement                               *
    ******************************************************************************)
    function recentYmovement : direction;

    {from recent call to which direction did we move ?}

    var
       d : integer;
    begin
            regs.ax := 11;
            INTR($33, regs);
            d := regs.dx;
            if (d > 0)
                    then recentYmovement := moveDown
            else if (d < 0)
                    then recentYmovement := moveUp
            else recentYmovement := noMove;
    end; {recentYmovement}

    (******************************************************************************
    *                               setEventHandler                               *
    ******************************************************************************)
    procedure setEventHandler(mask : word; handler        : pointer);

    {handler must be a far interrupt routine }

    begin
            regs.ax := 12; {set event handler function in mouse driver}
            regs.cx := mask;
            regs.es := seg(handler^);
            regs.dx := ofs(handler^);
            INTR($33, regs);
            lastMask := mask;
            lastHandler := handler;
    end; {set event Handler}

    (******************************************************************************
    *                               defaultHandler                                *
    ******************************************************************************)
    {$F+} procedure defaultHandler; assembler; {$F-}
    asm
       push ds; { save TP mouse driver }
       mov ax, SEG @data;
       mov ds, ax; { ds = TP:ds, not the driver's ds }
       mov eventX, cx; { where in the x region did it occur }
       mov eventY, dx;
       mov eventButtons, bx;
       mov eventHappened, 1; { eventHapppened := true }
       pop ds; { restore driver's ds }
       ret;
    end;

    {   this is the default event handler , it simulates :

          begin
                   eventX := cx;
                   eventY := dx;
                   eventButtons := bx;
                   eventhappened := True;
          end;

    }

    (******************************************************************************
    *                                doPascalStuff                                *
    * this is the pascal stuff that is called when vgaTextGraphicCursor mode has  *
    * to update the screen.                                                       *
    ******************************************************************************)
    procedure doPascalStuff; far;
    begin
       if (mouseCursorLevel > 0) then begin
          if (hasStoredArray) then begin
             VGAscreen2Array(false, false, false); { move old array to screen -
    restore }
             hasStoredArray := false;
          end;
          if (mouseCursorLevel > 0) then begin
             VGAscreen2Array(true, true, false); { move new - from screen to array
    }
             hasStoredArray := true; { now we have a stored array }
             drawVGATextGraphicCursor; { do the low level stuff here }
             lastEventX := eventX;
             lastEventY := eventY; { this is the old location }
          end; { go ahead and draw it ... }
       end; { cursorLevel > 0 }
    end; {doPascalStuff}

    (******************************************************************************
    *                            vgaTextGraphicHandler                            *
    * this is the same as default handler, only we do the mouse location movement *
    * ourself. Notice - if you use another handler, for mouse movement with       *
    * VGA text graphic cursor - do the same !!!                                   *
    ******************************************************************************)
    procedure vgaTextGraphicHandler; far; assembler;
    label
       noCursorMove;
    asm
       push ds; { save TP mouse driver }
       push ax;
       mov ax, SEG @data;
       mov ds, ax; { ds = TP:ds, not the driver's ds }
       pop ax; { ax has the reason .. }
       mov eventX, cx; { where in the x region did it occur }
       mov eventY, dx;
       mov eventButtons, bx;
       mov eventHappened, 1; { eventHapppened := true }
       and ax, CURSOR_LOCATION_CHANGED; { o.k., do we need to handle mouse movement? }
       jz noCursorMove;
       call doPascalStuff;
       mov eventHappened, 0;
       { NOTICE - no movement events are detected in the out world ! - this is a
         wintext consideration - It might be needed to track mouse movements,
         and then it should be changed ! - but this is MY default handler ! }
    noCursorMove: { no need for cursor movement handling }
       pop ds; { restore driver's ds }
    end; {vgaTextGraphicHandler}

    (******************************************************************************
    *                                GetLastEvent                                 *
    ******************************************************************************)
    function GetLastEvent(var x,y : word;
            var left_button,right_button,middle_button : buttonState) : boolean;

    begin
            getLastEvent := eventhappened; {indicate if any event happened}
            eventhappened := False; {clear to next read/event}
            x := eventX;
            y := eventY;
            if ((eventButtons and cLinke_taste) <> 0) then
                    left_button := buttonDown
            else left_button := buttonUp;
            if ((eventButtons and cRechte_taste) <> 0) then
                    right_button := buttonDown
            else right_button := buttonUp;
            if ((eventButtons and cMittlere_taste) <> 0) then
                    middle_button := buttonDown
            else middle_button := buttonUp;
    end; {getLastEvent}

    (******************************************************************************
    *                              setDefaultHandler                              *
    ******************************************************************************)
    procedure setDefaultHandler(mask : WORD);

    {get only event mask, and set event handler to defaultHandler}

    begin
       if (vgaTextGraphicCursor) then begin
          mask := mask or CURSOR_LOCATION_CHANGED; { we MUST detect cursor movement
    }
               setEventHandler(mask,@vgaTextGraphicHandler);
       end else
               setEventHandler(mask,@defaultHandler);
    end; {setDefaultHandler}

    (******************************************************************************
    *                              defineSensetivity                              *
    ******************************************************************************)
    procedure defineSensetivity(x,y : word);

    begin
            regs.ax := 15;
            regs.cx := x; {# of mouse motions to horizontal 8 pixels}
            regs.dx := y; {# of mouse motions to vertical 8 pixels}
            INTR($33, regs);
            XMotions := x;
            YMotions := y; {update global unit variables}
    end; {defineSensetivity}

    (******************************************************************************
    *                              setHideCursorBox                               *
    ******************************************************************************)
    procedure setHideCursorBox(left,top,right,bottom : word);

    begin
            regs.ax := 16;
            regs.es := seg(HideBox);
            regs.dx := ofs(HideBox);
            HideBox.left := left;
            HideBox.right := right;
            HideBox.top := top;
            HideBox.bottom := bottom;
            INTR($33, regs);
    end; {setHideCursorBox}

    (******************************************************************************
    *                               waitForRelease                                *
    * Wait until button is release, or timeOut 1/100 seconds pass. (might miss a  *
    * tenth (1/10) of a second.                                                                                                                     *
    ******************************************************************************)
    procedure waitForRelease(timeout : WORD);
    var
        sHour, sMinute, sSecond, sSec100 : word;        { Time at start }
        cHour, cMinute, cSecond, cSec100 : word;        { Current time        }
        stopSec                             : longInt;
        currentSec                          : longInt;
        Delta                             : longInt;
    begin
        getTime(sHour, sMinute, sSecond, sSec100);
        stopSec := (sHour*36000 + sMinute*600 + sSecond*10 + sSec100 + timeOut) mod
                        (24*360000);
        repeat
               getTime(cHour, cMinute, cSecond, cSec100);
               currentSec := (cHour*36000 + cMinute*600 + cSecond*10 + cSec100);
               Delta := currentSec - stopSec;
        until (not ButtonPressed) or (Delta >=0) and (Delta < 36000);
    end; {waitForRelease}

    (******************************************************************************
    *                              swapEventHandler                               *
    * handler is a far routine.                                                   *
    ******************************************************************************)
    procedure swapEventHandler(mask : WORD; handler : POINTER);
    begin
       regs.ax := $14;
       regs.cx := mask;
            regs.es := seg(handler^);
            regs.dx := ofs(handler^);
            INTR($33, regs);
       lastMask := regs.cx;
       lastHandler := ptr(regs.es,regs.dx);
    end; {swapEventHandler}

    (******************************************************************************
    *                            getMouseSaveStateSize                            *
    ******************************************************************************)
    function getMouseSaveStateSize : WORD;
    begin
       regs.ax := $15;
       INTR($33, regs);
       getMouseSaveStateSize := regs.bx;
    end; {getMouseSaveStateSize}

    (******************************************************************************
    *                           setVgaTextGraphicCursor                           *
    ******************************************************************************)
    procedure setVgaTextGraphicCursor;
    begin
       vgaTextGraphicCursor := false; { assume we can not .. }
       if (queryAdapterType <> vgaColor) then
          exit;
       vgaTextGraphicCursor := true;
    end; {setVgaTextGraphicCursor}

    (******************************************************************************
    *                          resetVgaTextGraphicCursor                          *
    ******************************************************************************)
    PROCEDURE resetvgatextgraphiccursor;
    BEGIN
      vgatextgraphiccursor := FALSE;
    END;

    PROCEDURE myexitproc; FAR;
    BEGIN
      EXITPROC := oldexitproc;
      IF (vgatextgraphiccursor AND hasstoredarray) THEN
        vgascreen2array(FALSE, FALSE, FALSE);
      DISPOSE(chardefs);
      resetvgatextgraphiccursor;
      initmouse;
    END;

    PROCEDURE set_graphic_mouse_cursor;         { graphischen Mauscursor setzen }
    BEGIN
      setvgatextgraphiccursor; initmouse; setdefaulthandler(left_button_pressed);
    END;

    { Ä Hauptprogramm der Unit ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ }
    BEGIN
       eventx := 0; eventy := 0; eventhappened := FALSE;
       NEW(chardefs); initmouse;
       oldexitproc := EXITPROC;
       EXITPROC    := @myexitproc;
    END.

[Back to MOUSE SWAG index] [Back to Main SWAG index] [Original]