Mouse & Vesa routines: shows mouse without flicker

Post your FreeBASIC tips and tricks here. Please don’t post your code without including an explanation.
lassar
Posts: 300
Joined: Jan 17, 2006 1:35
Contact:

Mouse & Vesa routines: shows mouse without flicker

Postby lassar » Jul 19, 2013 19:05

Here are some dos Mouse and Vesa routines.

My Thanks to monochromator for his help.

I also used some vesa code in the forum from yetifoot.

Use a modified form of the mouse isr from the freebasic souce code.

The mouse cursor is flicker free.

Enjoy!

Code: Select all


'===========================================================================
'                         Mouse Routines in Vesa Mode Ver 1.1                                     
'                                By Randall L Glass
'                                   Public domain
'
'===========================================================================
'
' Example of using GFX_NULL vesa mode, direct hardware keyboard handler, and
' flickerless mosue routine
'
' Uses inline assembly for the most speed
'
'===========================================================================





#include once "fbgfx.bi"
#include "vbcompat.bi"

#define _BORLAND_DOS_REGS 1  // djgpp specific switch

#lang "fblite"

#include "dos/pc.bi"
#include "dos/dos.bi"
#include "dos/dpmi.bi"
#include "dos/go32.bi"
#include "dos/sys/farptr.bi"

CONST black   = 0
CONST blue    = 1
CONST green   = 2
CONST cyan    = 3
CONST red     = 4
CONST magenta = 5
CONST brown   = 6
CONST white   = 7
CONST gray    = 8
CONST yellow  = 9
CONST LightWhite = 10
CONST BrightWhite  = 11

DEFINT A-Z
'$Dynamic

Type SVGA_dos_vbe_vgainfo Field = 1
    VESASignature(0 To 3) As Byte ' /* VESA 4-byte signature              */
    VESAVersion As uShort         ' /* VBE version number                 */
    OEMStringPtr As uInteger      ' /* Pointer to OEM string              */
    Capabilities(0 To 3) As uByte ' /* Capabilities of video card         */
    VideoModePtr As uInteger      ' /* Pointer to supported modes         */
    TotalMemory As uShort         ' /* Number of 64kb memory blocks       */
    OEMSoftwareRev As uShort      ' /* VBE software revision              */
    OEMVendorNamePtr As uInteger  ' /* Pointer to vendor name string      */
    OEMProductNamePtr As uInteger ' /* Pointer to product name string     */
    OEMProductRevPtr As uInteger  ' /* Pointer to product revision string */
    Reserved(0 To 221) As Byte    ' /* Reserved as working space          */
    OEMData(0 To 255) As Byte     ' /* Data area for OEM strings          */
End Type

Type SVGA_dos_vbe_modeinfo Field = 1
    ModeAttributes As Short         '/* Mode attributes                  */
    WinAAttributes As Byte          '/* Window A attributes              */
    WinBAttributes As Byte          '/* Window B attributes              */
    WinGranularity As Short         '/* Window granularity in k          */
    WinSize As Short                '/* Window size in k                 */
    WinASegment As Short            '/* Window A segment                 */
    WinBSegment As Short            '/* Window B segment                 */
    WinFuncPtr As Any ptr           '/* Pointer to window function       */
    BytesPerScanLine As Short       '/* Bytes per scanline               */
    XResolution As Short            '/* Horizontal resolution            */
    YResolution As Short            '/* Vertical resolution              */
    XCharSize As Byte               '/* Character cell width             */
    YCharSize As Byte               '/* Character cell height            */
    NumberOfPlanes As Byte          '/* Number of memory planes          */
    BitsPerPixel As Byte            '/* Bits per pixel                   */
    NumberOfBanks As Byte           '/* Number of CGA style banks        */
    MemoryModel As Byte             '/* Memory model type                */
    BankSize As Byte                '/* Size of CGA style banks          */
    NumberOfImagePages As Byte      '/* Number of images pages           */
    res1 As Byte                    '/* Reserved                         */
    RedMaskSize As Byte             '/* Size of direct color red mask    */
    RedFieldPosition As Byte        '/* Bit posn of lsb of red mask      */
    GreenMaskSize As Byte           '/* Size of direct color green mask  */
    GreenFieldPosition As Byte      '/* Bit posn of lsb of green mask    */
    BlueMaskSize As Byte            '/* Size of direct color blue mask   */
    BlueFieldPosition As Byte       '/* Bit posn of lsb of blue mask     */
    RsvdMaskSize As Byte            '/* Size of direct color res mask    */
    RsvdFieldPosition As Byte       '/* Bit posn of lsb of res mask      */
    DirectColorModeInfo As Byte     '/* Direct color mode attributes     */
    ' VESA 2.0 variables
    PhysBasePtr As UINTEGER         '/* physical address for flat frame buffer */
    OffScreenMemOffset As UINTEGER  '/* pointer to start of off screen memory */
    OffScreenMemSize As UShort      '/* amount of off screen memory in 1k units */
    res2(0 To 205) As Byte          '/* Pad to 256 byte block size       */
End Type


Declare Sub __djgpp_nearptr_disable cdecl Alias "__djgpp_nearptr_disable" ()   ' Enables protection
extern __djgpp_selector_limit Alias "__djgpp_selector_" As Integer   ' Limit on CS and on DS if prot
extern __djgpp_base_address Alias "__djgpp_base_address" As Integer   ' Used in calculation below

DECLARE Function SVGA_DOSDetectVBE%(vbeinfo As SVGA_dos_vbe_vgainfo ptr)
DECLARE Function GetVBEModeInfo%(modeinfo As SVGA_dos_vbe_modeinfo)
DECLARE SUB MapMemory(VideoMemoryBlocks AS USHORT,PhysicalMemoryPtr AS UINTEGER)
DECLARE Sub Screen18()
DECLARE Sub Screen3()
DECLARE Sub VesaEnd()
DECLARE SUB ChangeWindow(BYVAL Page%)
DECLARE SUB CCLS(BYVAL COLOUR%)

DECLARE SUB AnyKey()
DECLARE Sub VerticalSync()
DECLARE FUNCTION PreciseTimer#()

DIM SHARED VesaDosInfo AS SVGA_dos_vbe_vgainfo
DIM SHARED VesaInfo AS SVGA_dos_vbe_modeinfo
DIM SHARED mapping as __dpmi_meminfo
DIM SHARED regs As __dpmi_regs
DIM SHARED MouseCallBack AS __dpmi_raddr

DIM SHARED BufferPtr AS UBYTE PTR
DIM SHARED VideoPtr AS UBYTE PTR
DIM SHARED ScreenPage%

IF SVGA_DOSDetectVBE%(@VesaDosInfo) THEN
    IF GetVBEModeInfo%(VesaInfo) THEN
        MapMemory VesaDosInfo.TotalMemory, VesaInfo.PhysBasePtr
    END IF
ELSE
    PRINT "No Vesa Linear Frame Buffer Mode"
    Getkey
    END
END IF

VideoMemory% = VesaDosInfo.TotalMemory shl 16
VideoPages% = VideoMemory% \ 307200

DIM Shared VideoArrayPtr(1 TO VideoPages%) AS UBYTE PTR

FOR I% = 1 TO VideoPages%
    VideoArrayPtr(I%) = VideoPtr + (I%-1) * 307200
NEXT I%

BufferPtr = VideoPtr

DIM FrameBuffer(307200) AS UBYTE
DIM SHARED FrameBufferPtr AS UBYTE PTR
FrameBufferPtr = VARPTR(FrameBuffer(0))

DECLARE SUB InitKeyBoard()
DECLARE SUB RemoveKeyboard()
DECLARE SUB KeyBoardIsr()
DECLARE SUB DummKeyBoard NAKED()
DECLARE FUNCTION FgetKey() AS USHORT

DIM SHARED NewKeyboard AS _go32_dpmi_seginfo
DIM SHARED OldKeyboard AS _go32_dpmi_seginfo

DIM SHARED PressedKey AS USHORT
'$STATIC
DIM SHARED KeyMap(255) AS UBYTE = {0,27,49,50,51,52,53,54,55,56,57,48,45,61,8,9,113,119,101,114,116,121,117,105,111,112,91,93,13,0,97,115,100,102,103,104,106,107,108,59,39,96,0,92,122,120,99,118,98,110,109,44,46,47,0,42,0,32,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,45,0,0,0,43,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,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,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,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,13,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}
'$Dynamic
DIM SHARED KeyMapPtr AS UBYTE PTR

KeyMapPtr = VARPTR(KeyMap(0))


SCREEN 18,,,GFX_NULL
Screen18
InitKeyboard          ' Inkey$ does not work in GFX_NULL mode, need our own keyboard handler
ScreenPage% = 1
BufferPtr = VideoArrayPtr(ScreenPage%)
ChangeWindow ScreenPage%       ' can change video pages with this
CCLS 2
SETMOUSE 0,0,0                 ' don't waste cpu time trying to show a mouse cursor

DECLARE SUB CopyCurArea2Fb(BYVAL X%, BYVAL Y%)
DECLARE SUB CopyFb2Video(BYVAL X%, BYVAL Y%)

DECLARE SUB GetMouseArea (BYVAL X1%, BYVAL Y1%,BYVAL SpritePtr AS ANY PTR)
DECLARE SUB PutMouseArea(BYVAL X%, BYVAL Y%,BYVAL SpritePtr AS ANY PTR)
DECLARE SUB PutMousePset(BYVAL X%, BYVAL Y%,BYVAL SpritePtr AS ANY PTR)

DECLARE SUB GetFbMouseArea (BYVAL X1%, BYVAL Y1%,BYVAL SpritePtr AS ANY PTR)
DECLARE SUB PutFbMouseArea(BYVAL X%, BYVAL Y%,BYVAL SpritePtr AS ANY PTR)
DECLARE SUB PutFbMousePset(BYVAL X%, BYVAL Y%,BYVAL SpritePtr AS ANY PTR)
DECLARE SUB StartMouse()
DECLARE SUB EndMouse()

DECLARE SUB Initilize.Mouse
DECLARE SUB CloseMouseHandler()

DECLARE SUB PositionMouse(X%,Y%)
DECLARE SUB SHOWMOUSE
DECLARE SUB HIDEMOUSE
DECLARE SUB PutCursor()
DECLARE SUB GetMouseInfo NAKED ()
DECLARE SUB EndMouseInfo NAKED ()

DECLARE SUB GET.CLICKED()

DIM SHARED Cursor(256) AS UBYTE
DIM SHARED CursorPtr AS ANY PTR
DIM SHARED CursorArea(256) AS UBYTE
DIM SHARED CursorAreaPtr AS ANY PTR

CursorPtr = VARPTR(Cursor(0))
CursorAreaPtr = VARPTR(CursorArea(0))

DIM SHARED MouseHorz%, MouseVert%, Buttons%,OldMouseHorz%,OldMouseVert%,OldMouseButtons%
DIM SHARED MouseX%,MouseY%
DIM SHARED MouseWait%

DIM SHARED MOUSEEXIST%

DIM SHARED Ky AS USHORT

DECLARE SUB VideoCopy (BYVAL Source AS UINTEGER,BYVAL Destination AS UINTEGER)


DIM SHARED VideoScreen(1 TO 5,0 TO 76799) AS UINTEGER = ANY
DIM SHARED VideoScreenPtr(5) AS ANY PTR
DIM SHARED VideoPage%

FOR I% = 1 TO 5
    VideoScreenPtr(I%) = @VideoScreen(I%,0)
NEXT I%

' Mouse Cursor Data

DATA 16,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 16,16,16,16,0,0,0,0,0,0,0,0,0,0,0,0
DATA 16,15,15,15,16,16,16,0,0,0,0,0,0,0,0,0
DATA 0,16,15,15,15,15,15,16,16,16,0,0,0,0,0,0
DATA 0,16,15,15,15,15,15,15,15,15,16,16,16,0,0,0
DATA 0,0,16,15,15,15,15,15,15,15,15,15,15,16,16,16
DATA 0,0,16,15,15,15,15,15,15,15,15,15,15,15,16,0
DATA 0,0,16,15,15,15,15,15,15,15,15,15,15,16,0,0
DATA 0,0,0,16,15,15,15,15,15,15,15,15,16,0,0,0
DATA 0,0,0,16,15,15,15,15,15,15,15,16,0,0,0,0
DATA 0,0,0,16,15,15,15,15,15,15,15,15,16,0,0,0
DATA 0,0,0,0,16,15,15,15,15,16,15,15,15,16,0,0
DATA 0,0,0,0,16,15,15,15,16,0,16,15,15,15,16,0
DATA 0,0,0,0,16,15,15,16,0,0,0,16,15,15,15,16
DATA 0,0,0,0,0,16,16,0,0,0,0,0,16,15,15,16
DATA 0,0,0,0,0,16,0,0,0,0,0,0,0,16,16,0

'Read in the mouse cursor

FOR I% = 0 TO 255
    READ Cursor(I%)
NEXT I%   


InitKeyboard
Initilize.Mouse

AnyKey
CloseMouseHandler
RemoveKeyboard
SCREEN 0
PALETTE
END

SUB CCLS(BYVAL COLOUR%)
   
    #IF 1
    VerticalSync
    ASM
        CLD
        MOV     EDI,[BufferPtr]
        Mov     ECX, 76800
        MOV     AL, [COLOUR%]
        MOV     AH,AL
        BSWAP   EAX
        MOV     AL, [COLOUR%]
        MOV     AH,AL       
        rep     stosd
    END ASM
   
   
    #EndIf
END SUB



SUB CopyCurArea2Fb(BYVAL X%, BYVAL Y%)
    X2% = X% + 15
    Y2% = Y% + 15
   
    IF X2% > 639 THEN X2% = 639
    IF Y% > 479 THEN Y2% = 479
   
    XWidth% = X2% - X% + 1
    YHeigth% = Y2% - Y% + 1
   
    XWidthAddon% = 16 -XWidth%
   
   
    ASM
        CLD
        MOV     EAX,0
        MOV     EBX,0
        MOV     ESI,[BufferPtr]        ' put video offset into ESI
        MOV     EDI,[FrameBufferPtr]   ' put FrameBuffer offset into EDI
       
        IMUL    EAX, DWORD PTR [Y%],640 ' multiply Y% by screen width 640 and add X%
        ADD     EAX,[X%]
       
        ADD     EDI,EAX
        ADD     ESI,EAX
       
        mov     EBX,[YHeigth%]
        MOV     EAX,624        ' Addon value = screen width - width of cursor sprite
        DrawTheRows13:
        MOV ECX,[XWidth%]
        REP     MOVSB
        ADD     ESI,[XWidthAddon%]
        ADD     EDI,[XWidthAddon%]
        ADD     EDI,EAX
        ADD     ESI,EAX
        DEC     EBX
        JNE     DrawTheRows13
    END ASM
   
END SUB

SUB CopyFb2Video(BYVAL X%, BYVAL Y%)
   
    X2% = X% + 15
    Y2% = Y% + 15
   
    IF X2% > 639 THEN X2% = 639
    IF Y% > 479 THEN Y2% = 479
   
    XWidth% = X2% - X% + 1
    YHeigth% = Y2% - Y% + 1
   
    XWidthAddon% = 16 -XWidth%
   
   
    VerticalSync
    ASM
        CLD
        MOV     EAX,0
        MOV     EBX,0
        MOV     EDI,[BufferPtr]          ' put video offset into EDI
        MOV     ESI,[FrameBufferPtr]     ' put FrameBuffer offset into ESI
       
        IMUL    EAX, DWORD PTR [Y%],640 ' multiply Y% by screen width 640 and add X%
        ADD     EAX,[X%]
       
        ADD     EDI,EAX
        ADD     ESI,EAX
       
        mov     EBX,[YHeigth%]
        MOV     EAX,624           ' Addon value = screen width - width of cursor sprite
        DrawTheRows15:
        MOV ECX,[XWidth%]
        REP     MOVSB
        ADD     ESI,[XWidthAddon%]
        ADD     EDI,[XWidthAddon%]
        ADD     EDI,EAX
        ADD     ESI,EAX
        DEC     EBX
        JNE     DrawTheRows15
    END ASM
   
END SUB

SUB GetFbMouseArea(BYVAL X%, BYVAL Y%,BYVAL SpritePtr AS ANY PTR)
    X2% = X% + 15
    Y2% = Y% + 15
   
    IF X2% > 639 THEN X2% = 639
    IF Y% > 479 THEN Y2% = 479
   
    XWidth% = X2% - X% + 1
    YHeigth% = Y2% - Y% + 1
   
    XWidthAddon% = 16 -XWidth%
   
   
    ASM
        CLD
        MOV     EAX,0
        MOV     EBX,0
        MOV     EDI,[SpritePtr]        ' put video offset into EDI
        MOV     ESI,[FrameBufferPtr]   ' put FrameBuffer offset into ESI
       
        IMUL    EAX, DWORD PTR [Y%],640  ' multiply Y% by screen width 640 and add X%
        ADD     ESI,EAX
        ADD     ESI,[X%]
       
        mov     EBX,[YHeigth%]
        MOV     EAX,624             ' Addon value = screen width - width of cursor sprite
        DrawTheRows2:
        MOV ECX,[XWidth%]
        REP     MOVSB
        ADD     ESI,[XWidthAddon%]
        ADD     EDI,[XWidthAddon%]
        ADD     ESI,EAX
        DEC     EBX
        JNE     DrawTheRows2
    END ASM
   
END SUB

SUB PutFbMouseArea(BYVAL X%, BYVAL Y%,BYVAL SpritePtr AS ANY PTR)
    X2% = X% + 15
    Y2% = Y% + 15
   
    IF X2% > 639 THEN X2% = 639
    IF Y% > 479 THEN Y2% = 479
   
    XWidth% = X2% - X% + 1
    YHeigth% = Y2% - Y% + 1
   
    XWidthAddon% = 16 -XWidth%
   
   
    ASM
        CLD
        MOV     EAX,0
        MOV     EBX,0
        MOV     EDI,[FrameBufferPtr]   ' put FrameBuffer offset into EDI
        MOV     ESI,[SpritePtr]        ' put sprite offset into ESI
       
        IMUL    EAX, DWORD PTR [Y%],640 ' multiply Y% by screen width 640 and add X%
        ADD     EDI,EAX
        ADD     EDI,[X%]
       
        mov     EBX,[YHeigth%]
        MOV     EAX,624          ' Addon value = screen width - width of cursor sprite
        DrawTheRows5:
        MOV ECX,[XWidth%]
        REP     MOVSB
        ADD     ESI,[XWidthAddon%]
        ADD     EDI,[XWidthAddon%]
        ADD     EDI,EAX
        DEC     EBX
        JNE     DrawTheRows5
    END ASM
   
END SUB

SUB PutFbMousePset(BYVAL X%, BYVAL Y%,BYVAL SpritePtr AS ANY PTR)
    X2% = X% + 15
    Y2% = Y% + 15
   
    IF X2% > 639 THEN X2% = 639
    IF Y% > 479 THEN Y2% = 479
   
    XWidth% = X2% - X% + 1
    YHeigth% = Y2% - Y% + 1
   
    XWidthAddon% = 16 -XWidth%
   
   
   
    ASM
        CLD
        MOV     EAX,0
        MOV     EBX,0
        MOV     EDI,[FrameBufferPtr]   ' put FrameBuffer offset into EDI
        MOV     ESI,[SpritePtr]        ' put sprite offset into ESI       
       
        IMUL    EAX, DWORD PTR [Y%],640 ' multiply Y% by screen width 640 and add X%
        ADD     EDI,EAX
        ADD     EDI,[X%]
       
        mov     EBX,[YHeigth%]
        MOV     EAX,624           ' Addon value = screen width - width of cursor sprite
        DrawTheRows7:
        MOV ECX,[XWidth%]
        NextPixel2:
        MOV     DL,[ESI]
        CMP     DL,0
        JE      SkipPixel5
        MOV     [EDI],DL
        SkipPixel5:
        INC     ESI
        INC     EDI
    LOOP NextPixel2
    ADD     ESI,[XWidthAddon%]
    ADD     EDI,[XWidthAddon%]
    ADD     EDI,EAX
    DEC     EBX
    JNE     DrawTheRows7
END ASM

END SUB

SUB GetMouseArea(BYVAL X%, BYVAL Y%,BYVAL SpritePtr AS ANY PTR)
    X2% = X% + 15
    Y2% = Y% + 15
   
    IF X2% > 639 THEN X2% = 639
    IF Y% > 479 THEN Y2% = 479
   
    XWidth% = X2% - X% + 1
    YHeigth% = Y2% - Y% + 1
   
    XWidthAddon% = 16 -XWidth%
   
   
    VerticalSync
    ASM
        CLD
        MOV     EAX,0
        MOV     EBX,0
        MOV     EDI,[SpritePtr]   ' put Sprite offset into EDI
        MOV     ESI,[BufferPtr]   ' put Video offset into ESI
       
        IMUL    EAX, DWORD PTR [Y%],640 ' multiply Y% by screen width 640 and add X%
        ADD     ESI,EAX
        ADD     ESI,[X%]
       
        mov     EBX,[YHeigth%]
        MOV     EAX,624            ' Addon value = screen width - width of cursor sprite
        DrawTheRows21:
        MOV ECX,[XWidth%]
        REP     MOVSB
        ADD     ESI,[XWidthAddon%]
        ADD     EDI,[XWidthAddon%]
        ADD     ESI,EAX
        DEC     EBX
        JNE     DrawTheRows21
    END ASM
   
END SUB

SUB PutMouseArea(BYVAL X%, BYVAL Y%,BYVAL SpritePtr AS ANY PTR)
    X2% = X% + 15
    Y2% = Y% + 15
   
    IF X2% > 639 THEN X2% = 639
    IF Y% > 479 THEN Y2% = 479
   
    XWidth% = X2% - X% + 1
    YHeigth% = Y2% - Y% + 1
   
    XWidthAddon% = 16 -XWidth%
   
    VerticalSync
   
    ASM
        CLD
        MOV     EAX,0
        MOV     EBX,0
        MOV     EDI,[BufferPtr]   ' put video offset into EDI
        MOV     ESI,[SpritePtr]   ' put sprite offset into ESI
       
        IMUL    EAX, DWORD PTR [Y%],640  ' multiply Y% by screen width 640 and add X%
        ADD     EDI,EAX
        ADD     EDI,[X%]
       
        mov     EBX,[YHeigth%]
        MOV     EAX,624           ' Addon value = screen width - width of cursor sprite
        DrawTheRows25:
        MOV ECX,[XWidth%]
        REP     MOVSB
        ADD     ESI,[XWidthAddon%]
        ADD     EDI,[XWidthAddon%]
        ADD     EDI,EAX
        DEC     EBX
        JNE     DrawTheRows25
    END ASM
   
END SUB

SUB PutMousePset(BYVAL X%, BYVAL Y%,BYVAL SpritePtr AS ANY PTR)
    X2% = X% + 15
    Y2% = Y% + 15
   
    IF X2% > 639 THEN X2% = 639
    IF Y% > 479 THEN Y2% = 479
   
    XWidth% = X2% - X% + 1
    YHeigth% = Y2% - Y% + 1
   
    XWidthAddon% = 16 -XWidth%
   
   
    VerticalSync
   
    ASM
        CLD
        MOV     EAX,0
        MOV     EBX,0
        MOV     EDI,[BufferPtr]   ' put video offset into EDI
        MOV     ESI,[SpritePtr]   ' put sprite offset into ESI       
       
        IMUL    EAX, DWORD PTR [Y%],640  ' multiply Y% by screen width 640 and add X%
        ADD     EDI,EAX
        ADD     EDI,[X%]
       
        mov     EBX,[YHeigth%]
        MOV     EAX,624          ' Addon value = screen width - width of cursor sprite
        DrawTheRows27:
        MOV ECX,[XWidth%]
        NextPixel22:
        MOV     DL,[ESI]
        CMP     DL,0
        JE      SkipPixe25
        MOV     [EDI],DL
        SkipPixe25:
        INC     ESI
        INC     EDI
    LOOP NextPixel22
    ADD     ESI,[XWidthAddon%]
    ADD     EDI,[XWidthAddon%]
    ADD     EDI,EAX
    DEC     EBX
    JNE     DrawTheRows27
END ASM

END SUB


SUB Initilize.Mouse
    regs.x.ax = 0
    __dpmi_int(&H33, @regs)
    MouseExist% = regs.x.ax
   
    ' set horizontal range
    regs.x.ax = 7
    regs.x.cx = 0
    regs.x.dx = 639
    __dpmi_int(&H33, @regs)
   
    ' set vertical range
    regs.x.ax = 8
    regs.x.cx = 0
    regs.x.dx = 479
    __dpmi_int(&H33, @regs)
   
    ' ensure that the mouse isn't drawn by the mouse driver
    regs.x.ax = 2
   
    __dpmi_int(&H33, @regs)     
   
    'Position mouse by row and col
    regs.x.ax = 4
    regs.x.cx = 320
    regs.x.dx = 240
    __dpmi_int(&H33, @regs)
   
    MouseHorz% = 320
    MouseVert% = 240
    OldMouseHorz% = 320
    OldMouseVert% = 240
    OldMouseButtons% = 0   
   
    DIM MouseCodeSize AS UINTEGER
    EndMouseStart% = @EndMouseInfo
    GetMouseInfoStart% = @GetMouseInfo
    MouseCodeSize% = EndMouseStart% -EndMouseStart%
   
    _go32_dpmi_lock_code(@GetMouseInfo,MouseCodeSize%)
    _go32_dpmi_lock_data(@MouseHorz%, 4)
    _go32_dpmi_lock_data(@MouseVert%, 4)
    _go32_dpmi_lock_data(@Buttons%, 4)
    _go32_dpmi_lock_data(@MouseLock%, 4)   
   
    __dpmi_allocate_real_mode_callback @GetMouseInfo, @regs, @MouseCallBack
   
    ' set user interrupt routine
   
    regs.x.ax = &H0C
    regs.x.cx = &H7F
    regs.x.es = MouseCallBack.segment
    regs.x.dx = MouseCallBack.offset16
    __dpmi_int(&H33, @regs)
   
END SUB

SUB CloseMouseHandler()
    ' set user interrupt routine
    #IF 1   
    regs.x.ax = &H0C
    regs.x.cx = 0
    regs.x.es = 0
    regs.x.dx = 0
    __dpmi_int(&H33, @regs)
   
    #ENDIF
   
    regs.x.ax = &H01F
    __dpmi_int(&H33, @regs)
   
    '_go32_dpmi_set_protected_mode_interrupt_vector(0x33, &old_mouse_handler)
    __dpmi_free_real_mode_callback @MouseCallBack
   
END SUB   


SUB GetMouseInfo NAKED ()
   
   ASM
        ' set up real mode return address (simulate real-mode retf)
        push    eax
       
        mov eax, [esi]
        mov es:[edi + 42], eax
        add word ptr es:[edi + 46], 4
       
        ' store mouse location and status
       
        push ds
        mov ax, cs:[___djgpp_app_DS]
        mov ds, ax   
       
       
        MOV EAX,[MouseWait%]
        CMP EAX,1
        JE  SkipAssign
        mov ax, es:[edi + 0x18]
        mov [MouseHorz], ax
       
        mov ax, es:[edi + 0x14]
        mov [MouseVert], ax
       
        mov ax, es:[edi + 0x10]
        mov [Buttons], al
        SkipAssign:   
        pop     ds
        pop      eax
        sti
        iret
    END ASM
END SUB

SUB EndMouseInfo NAKED ()
END SUB

SUB PositionMouse(X%,Y%)   
    regs.x.ax = 4
    regs.x.cx = X%
    regs.x.dx = Y%
    __dpmi_int(&H33, @regs)
END SUB   

SUB ShowMouse
    regs.x.ax = 1
    __dpmi_int(&H33, @regs)
END SUB

SUB HideMouse
    regs.x.ax = 2
    __dpmi_int(&H33, @regs)
END SUB

SUB DisableMouse()
    regs.x.ax = &H001F
    __dpmi_int(&H33, @regs)
END SUB

SUB PutCursor()
    ' LOCATE 5,5
    ' PRINT "MouseHorz% = ";MouseHorz%
    ' LOCATE 7,5
    ' PRINT "MouseVert% = ";MouseVert%
    IF PreciseTimer# - MouseTimer# < .033 THEN EXIT SUB
   
    ' IF cursor does not move, don't redraw it
   
    IF MouseHorz% <> OldMouseHorz% OR MouseVert% <> OldMouseVert% THEN
        MouseTimer# = PreciseTimer#
        MouseWait% = 1
       
        Xdiff% = ABS(MouseHorz% -OldMouseHorz%) + 1
        Ydiff% = ABS(MouseVert% -OldMouseVert%) + 1
       
       
        IF Xdiff% > 15 AND Ydiff% > 15 THEN
           
            ' If new cursor position does not overlap old position the draw the cursor
           
            ' Put Mouse Area at OldMouseHorz%, OldMouseVert%   
           
            PutMouseArea OldMouseHorz%,OldMouseVert%,CursorAreaPtr
           
            ' Get mouse area at MouseHorz%, MouseVert%, and put cursor
            GetMouseArea MouseHorz%,MouseVert%,CursorAreaPtr
            PutMousePset MouseHorz%,MouseVert%,CursorPtr
           
        ELSE           
            ' IF cursor overlaps copy to our own framebuffer and draw it
           
            CopyCurArea2Fb MouseHorz%,MouseVert%     ' Copy New Cursor Background to FrameBuffer
           
            PutFbMouseArea OldMouseHorz%,OldMouseVert%,CursorAreaPtr  ' Put old background to FrameBuffer
            GetFbMouseArea MouseHorz%,MouseVert%,CursorAreaPtr        ' Get Cursor background
            PutFbMousePset MouseHorz%,MouseVert%,CursorPtr      ' Put Cursor on FrameBuffer
           
            CopyFb2Video OldMouseHorz%,OldMouseVert%    ' Copy old cursor area to video
            CopyFb2Video MouseHorz%,MouseVert%          ' Copy new cursor area to video
        END IF
        OldMouseHorz% = MouseHorz%
        OldMouseVert% = MouseVert%
        MouseWait% = 0
    END IF
END SUB

SUB StartMouse()
    MouseWait% = 1
    GetMouseArea MouseHorz%,MouseVert%,CursorAreaPtr
    PutMousePset MouseHorz%,MouseVert%,CursorPtr
    OldMouseHorz% = MouseHorz%
    OldMouseVert% = MouseVert%
    MouseWait% = 0
END SUB

SUB EndMouse()
    PutMouseArea OldMouseHorz%,OldMouseVert%,CursorAreaPtr
END SUB

SUB Get.Clicked ()
    IF MouseExist% = 0 THEN Buttons% = 0:EXIT SUB
    OldButtons% = 0
   
    IF Buttons% > 0 THEN
        OldButtons% = Buttons%
        TimerStart# = PreciseTimer#
        DO
            IF Buttons% = 3 and OldButtons% <> 3 THEN
                OldButtons% = 3
                TimerStart# = PreciseTimer#
            END IF
        LOOP UNTIL Buttons% = 0
        TimerEnd# = PreciseTimer#
        MouseTime# = TimerEnd# - TimerStart#
        IF MouseTime# < 5 THEN
            Buttons% = OldButtons%
        END IF
    END IF
END SUB

SUB AnyKey
    DIM Key AS USHORT
    StartMouse              ' needed to show cursor
    DO
        Key = FGetKey
        Get.Clicked
        PutCursor           ' puts cursor on screen
    LOOP UNTIL Key > 0 OR Buttons% > 0
    IF buttons% = 3 THEN Ky = Escape
    EndMouse    ' need to get rid fo cursor
END SUB

SUB VideoCopy (BYVAL Source AS UINTEGER,BYVAL Destination AS UINTEGER)
   
    ASM
        MOV     ESI,[Source]
        MOV     EDI,[Destination]
        MOV     ECX,76800                         'Number of doublewords to copy
        CLD
        REP     MOVSD
    END ASM   
   
END SUB

#IF 1
FUNCTION PreciseTimer#
    DIM AS UINTEGER BIOSTimer, PITValue
    DIM AS UBYTE LowBytePIT, HighBytePIT
    'Function returns current time in seconds.
    DOSMEMGET &H46C, 4, @BIOSTimer 'read BIOS timer counter
    OUT &H43, 0 'latch PIT counter for zero channel
    LowBytePIT = INP(&H40) 'low byte of PIT counter
    HighBytePIT = INP(&H40) 'high byte of PIT counter
    PITValue = (HighBytePIT SHL 8) + LowBytePIT 'calculate PIT counter
    'PIT work frequency is 1193180 Hertz
    FUNCTION = (BIOSTimer * 65536 + PITValue) / 1193180
END FUNCTION
#EndIF

DEFINT A-Z

Function SVGA_DOSDetectVBE%(vbeinfo As SVGA_dos_vbe_vgainfo ptr)
    Dim sig As String
   
    vbeinfo->VESASignature(0) = Asc("V")
    vbeinfo->VESASignature(1) = Asc("B")
    vbeinfo->VESASignature(2) = Asc("E")
    vbeinfo->VESASignature(3) = Asc("2")
   
    regs.x.ax = &H4F00
    regs.x.di = __tb AND &H0F
    regs.x.es = (__tb shr 4) AND &HFFFF
   
    dosmemput(vbeinfo, sizeof(SVGA_dos_vbe_vgainfo), __tb)
    __dpmi_int(&H10, @regs)
    dosmemget(__tb, sizeof(SVGA_dos_vbe_vgainfo), vbeinfo)
   
    sig += chr(vbeinfo->VESASignature(0))
    sig += chr(vbeinfo->VESASignature(1))
    sig += chr(vbeinfo->VESASignature(2))
    sig += chr(vbeinfo->VESASignature(3))
   
    IF sig <> "VESA" THEN
        'PRINT "Could not find VESA Signature"
        'AnyKey
        EXIT FUNCTION   
    END IF
   
    'PRINT "Vesa version = ";Hex$(VesaInfo.VESAVersion)
   
    IF VesaDosInfo.VESAVersion < &H200 THEN
        'PRINT "Not Vesa 2.0"       
        'AnyKey
        'EXIT FUNCTION
    END IF   
   
    IF regs.h.ah = 0 THEN FUNCTION = 1
End Function

Function GetVBEModeInfo%(modeinfo As SVGA_dos_vbe_modeinfo)
    Dim Mode AS USHORT
   
    Mode = BitSet(&H101, 14)
   
    regs.x.ax = &H4F01
    regs.x.cx = mode
    regs.x.di= __tb AND &H0F
    regs.x.es = (__tb shr 4) AND &HFFFF
    __dpmi_int(&H10, @regs)
    dosmemget(__tb, sizeof(SVGA_dos_vbe_modeinfo), @modeinfo)
    Result% = regs.h.ah
    IF Result% = 0 THEN FUNCTION = 1
End Function


SUB MapMemory(VideoMemoryBlocks AS USHORT,PhysicalMemoryPtr AS UINTEGER)
   
    ' map into linear memory
    mapping.address = PhysicalMemoryPtr
   
    mapping.size = VideoMemoryBlocks SHL 16
    IF __dpmi_physical_address_mapping(@mapping) <> 0 THEN
        EXIT SUB
    END IF     
   
    DSSelector% = 0
   
    ASM mov word ptr [DSSelector], ds
    IF __dpmi_set_segment_limit(DSSelector%, &HFFFFFFFF) <> 0 THEN
        EXIT SUB
    END IF
    IF __dpmi_get_segment_base_address(DSSelector%, @DSAddr) <> 0 THEN
        EXIT SUB
    END IF
   
    IF mapping.address < DSAddr THEN
        IF __dpmi_set_segment_base_address(DSSelector%, mapping.address - 2) <> 0 THEN
            ERR = 251: EXIT SUB
        END IF
        DSAddr = mapping.address - 2
    END IF
    VideoPtr = CAST(UBYTE PTR, mapping.address - DSAddr)
END SUB


Sub Screen18()
    DIM Mode AS USHORT
    Mode = BitSet(&H101, 14)
    'Mode = &H101 'OR &B0100000000000000
    Dim regs As REGS
    regs.x.eax = &H4f02
    regs.x.ebx = Mode
    int86(&H10,@regs,@regs)
End Sub

Sub VesaEnd()
    regs.x.ax = 3
    __dpmi_int(&H10, @regs)
    __dpmi_free_physical_address_mapping(@mapping)
End Sub

Sub Screen3()
    regs.x.ax = 3
    __dpmi_int(&H10, @regs)
End Sub

Sub VerticalSync()
    ASM
        MOV      DX,&H3DA
        WaitFor1:
        in       al,dx               ' wait for current retrace to end
        test     al,&B00001000
        jnz      WaitFor1
        WaitFor0:
        in       al,dx               ' wait for current retrace to end
        test     al,&B00001000
        jz       WaitFor0
    END ASM
END SUB

SUB ChangeWindow(BYVAL Page%)   
    Dim regs As __dpmi_regs
    Y% = (Page% -1) * 480
   
    regs.x.ax = &H4F07
    regs.x.bx = 0
    regs.x.cx = 0
    regs.x.dx = Y%
   
    VerticalSync
    __dpmi_int(&H10, @regs)
    Result% = regs.h.ah
    'IF Result% = 0 THEN FUNCTION = 1
End Sub


SUB KeyBoardIsr NAKED()
   
    asm
        push    ds
        pushad
        mov     ax, cs:[___djgpp_app_DS]
        mov     ds, ax   
       
        in      al,&H60             'get value of keyboard control lines
        test    al,128
        jne     SkipAssign2
        mov     ah,al
        mov     EBX,[KeyMapPtr]
        XLAT
        CMP     al,0
        JNE     AsciiCode
        mov     al,255
        mov     [PressedKey],ax
        JMP     SkipAssign2
        AsciiCode:
        mov     ah,0
        mov     [PressedKey],ax
        SkipAssign2:
       
        'Tell to the controller that the key code is readed
       
        in      al,&H61             'get value of keyboard control lines
        mov     ah,al              ' save it
        or      al,&H80             'set the "enable kbd" bit
        out     &H61,al             ' and write it out the control port
        xchg    ah,al              'fetch the original control port value
        out     &H61,al             ' and write it back
       
        mov     al,&H20             'send End-Of-Interrupt signal
        out     &H20,al             ' to the 8259 Interrupt Controller
        popad
        pop     ds
        sti
        iret
    END ASM
   
END SUB

SUB DummKeyBoard NAKED()
END SUB

SUB InitKeyBoard()
    DIM KeyBoardCodeSize AS UINTEGER
    KeyboardStart% = @KeyBoardIsr
    KeyboardEnd% = @DummKeyBoard
    KeyboardCodeSize% = KeyboardEnd% -KeyboardStart%
   
    _go32_dpmi_lock_code(@GetKeyboardInfo,KeyboardCodeSize%)
    _go32_dpmi_lock_data(@KeyMapPtr, 4)
    _go32_dpmi_lock_data(@PressedKey, 2)
    _go32_dpmi_lock_data(@KeyMap(0), 256)
   
   
    NewKeyboard.pm_offset = @KeyBoardIsr
    NewKeyboard.pm_selector = _go32_my_cs
    _go32_dpmi_get_protected_mode_interrupt_vector(9, @OldKeyboard)
    _go32_dpmi_set_protected_mode_interrupt_vector(9, @NewKeyboard)
    _go32_dpmi_allocate_iret_wrapper(@NewKeyboard)
END SUB

SUB RemoveKeyboard()
    _go32_dpmi_set_protected_mode_interrupt_vector(9, @OldKeyboard)
    _go32_dpmi_free_iret_wrapper(@NewKeyboard)
END SUB

FUNCTION FgetKey() AS USHORT
    FUNCTION = PressedKey
    PressedKey = 0
END FUNCTION

Last edited by lassar on Jul 23, 2013 15:41, edited 1 time in total.
AGS
Posts: 1284
Joined: Sep 25, 2007 0:26
Location: the Netherlands

Re: Mouse & Vesa routines: shows mouse without flicker

Postby AGS » Jul 23, 2013 8:10

"Public domain" is not something you see a lot on this forum.
I like public domain. Anyway, I have not seen that many
large examples of BASIC programs that use inline assembler.

I am unsure what the procedure is for getting your code
into the examples directory of the fb distribution. But it
seems to me that such a sizeable example as this one
should be part of the official fb distribution.

In the almost-current distribution (version 0.90) there
are some small examples of mixing assembler and BASIC
but nothing as sizeable as your code.

Could you post your code at sourceforge.net and ask the devs
to put it in the fb distro? Perhaps as a patch?

I really think this example belongs in the fb distro.
lassar
Posts: 300
Joined: Jan 17, 2006 1:35
Contact:

Re: Mouse & Vesa routines: shows mouse without flicker

Postby lassar » Jul 23, 2013 16:34

I just put in a feature request for it to be put into the dos examples section of freebasic.
counting_pine
Site Admin
Posts: 6169
Joined: Jul 05, 2005 17:32
Location: Manchester, Lancs

Re: Mouse & Vesa routines: shows mouse without flicker

Postby counting_pine » Jul 24, 2013 5:06

Looks interesting.
I can't say whether it will end up in examples, but if it does I'd like to see a version that compiles in lang fb, any variable typos fixed ("heigth"), explicit lower bounds on all arrays, and consistent keyword capitalisation.
TJF
Posts: 3473
Joined: Dec 06, 2009 22:27
Location: N47°, E15°
Contact:

Re: Mouse & Vesa routines: shows mouse without flicker

Postby TJF » Jul 24, 2013 5:43

@lassar;

counting_pine wrote:..., and consistent keyword capitalisation.

Have a look at FBeauty.bas (Geany Filter).
lassar
Posts: 300
Joined: Jan 17, 2006 1:35
Contact:

Re: Mouse & Vesa routines: shows mouse without flicker

Postby lassar » Jul 24, 2013 16:02

Okay here's the 6th revised version.

Added Multikey function

Fixed the 5 compiler warnings on pointers

Fixed CodeSize

Code: Select all


'=============================================================================
'                         Mouse Routines in Vesa Mode Ver 2.1
'                                By Randall L Glass
'                                   Public domain
'
'=============================================================================
'
' Example of using GFX_NULL vesa mode, direct hardware keyboard handler, and
' flickerless mosue routine
'
' Uses inline assembly for the most speed
'
'=============================================================================


#include once "fbgfx.bi"
#include "vbcompat.bi"

#define _BORLAND_DOS_REGS 1  // djgpp specific switch

#lang "fb"

#include "dos/pc.bi"
#include "dos/dos.bi"
#include "dos/dpmi.bi"
#include "dos/go32.bi"
#include "dos/sys/farptr.bi"

const black   = 0
const blue    = 1
const green   = 2
const cyan    = 3
const red     = 4
const magenta = 5
const brown   = 6
const white   = 7
const gray    = 8
const yellow  = 9
const LightWhite = 10
const BrightWhite  = 11

const GFX_NULL as integer = -1

#DEFINE Escape 27
#UNDEF MULTIKEY

type SVGA_dos_vbe_vgainfo field = 1
    VESASignature(0 to 3) as byte ' /* VESA 4-byte signature              */
    VESAVersion as ushort         ' /* VBE version number                 */
    OEMStringPtr as uinteger      ' /* Pointer to OEM string              */
    Capabilities(0 to 3) as ubyte ' /* Capabilities of video card         */
    VideoModePtr as uinteger      ' /* Pointer to supported modes         */
    TotalMemory as ushort         ' /* Number of 64kb memory blocks       */
    OEMSoftwareRev as ushort      ' /* VBE software revision              */
    OEMVendorNamePtr as uinteger  ' /* Pointer to vendor name string      */
    OEMProductNamePtr as uinteger ' /* Pointer to product name string     */
    OEMProductRevPtr as uinteger  ' /* Pointer to product revision string */
    Reserved(0 to 221) as byte    ' /* Reserved as working space          */
    OEMData(0 to 255) as byte     ' /* Data area for OEM strings          */
end type

type SVGA_dos_vbe_modeinfo field = 1
    ModeAttributes as short         '/* Mode attributes                  */
    WinAAttributes as byte          '/* Window A attributes              */
    WinBAttributes as byte          '/* Window B attributes              */
    WinGranularity as short         '/* Window granularity in k          */
    WinSize as short                '/* Window size in k                 */
    WinASegment as short            '/* Window A segment                 */
    WinBSegment as short            '/* Window B segment                 */
    WinFuncPtr as any ptr           '/* Pointer to window function       */
    BytesPerScanLine as short       '/* Bytes per scanline               */
    XResolution as short            '/* Horizontal resolution            */
    YResolution as short            '/* Vertical resolution              */
    XCharSize as byte               '/* Character cell width             */
    YCharSize as byte               '/* Character cell height            */
    NumberOfPlanes as byte          '/* Number of memory planes          */
    BitsPerPixel as byte            '/* Bits per pixel                   */
    NumberOfBanks as byte           '/* Number of CGA style banks        */
    MemoryModel as byte             '/* Memory model type                */
    BankSize as byte                '/* Size of CGA style banks          */
    NumberOfImagePages as byte      '/* Number of images pages           */
    res1 as byte                    '/* Reserved                         */
    RedMaskSize as byte             '/* Size of direct color red mask    */
    RedFieldPosition as byte        '/* Bit posn of lsb of red mask      */
    GreenMaskSize as byte           '/* Size of direct color green mask  */
    GreenFieldPosition as byte      '/* Bit posn of lsb of green mask    */
    BlueMaskSize as byte            '/* Size of direct color blue mask   */
    BlueFieldPosition as byte       '/* Bit posn of lsb of blue mask     */
    RsvdMaskSize as byte            '/* Size of direct color res mask    */
    RsvdFieldPosition as byte       '/* Bit posn of lsb of res mask      */
    DirectColorModeInfo as byte     '/* Direct color mode attributes     */
    ' VESA 2.0 variables
    PhysBasePtr as uinteger         '/* physical address for flat frame buffer */
    OffScreenMemOffset as uinteger  '/* pointer to start of off screen memory */
    OffScreenMemSize as ushort      '/* amount of off screen memory in 1k units */
    res2(0 to 205) as byte          '/* Pad to 256 byte block size       */
end type


declare sub __djgpp_nearptr_disable cdecl alias "__djgpp_nearptr_disable" ()   ' Enables protection
extern __djgpp_selector_limit alias "__djgpp_selector_" as integer   ' Limit on CS and on DS if prot
extern __djgpp_base_address alias "__djgpp_base_address" as integer   ' Used in calculation below

declare function SVGA_DOSDetectVBE(vbeinfo as SVGA_dos_vbe_vgainfo ptr) as integer
declare function GetVBEModeInfo(modeinfo as SVGA_dos_vbe_modeinfo)  as integer
declare sub MapMemory(VideoMemoryBlocks as ushort, PhysicalMemoryPtr as uinteger)
declare sub Screen18()
declare sub Screen3()
declare sub VesaEnd()
declare sub ChangeWindow(byval Page as integer)
declare sub CCLS(byval COLOUR as integer)

declare sub AnyKey()
declare sub VerticalSync()
declare function PreciseTimer() as double

declare sub CopyCurArea2Fb(byval X as integer, byval Y as integer)
declare sub CopyFb2Video(byval X as integer, byval Y as integer)

declare sub GetMouseArea (byval X1 as integer, byval Y1 as integer, byval SpritePtr as any ptr)
declare sub PutMouseArea(byval X as integer, byval Y as integer, byval SpritePtr as any ptr)
declare sub PutMousePset(byval X as integer, byval Y as integer, byval SpritePtr as any ptr)

declare sub GetFbMouseArea (byval X1 as integer, byval Y1 as integer, byval SpritePtr as any ptr)
declare sub PutFbMouseArea(byval X as integer, byval Y as integer, byval SpritePtr as any ptr)
declare sub PutFbMousePset(byval X as integer, byval Y as integer, byval SpritePtr as any ptr)
declare sub StartMouse()
declare sub EndMouse()

declare sub InitilizeMouse
declare sub CloseMouseHandler()

declare sub PositionMouse(X as integer, Y as integer)
declare sub ShowMouse
declare sub HideMouse
declare sub PutCursor()
declare sub GetMouseInfo naked ()
declare sub EndMouseInfo naked ()

declare sub GetClicked()

declare sub InitKeyBoard()
declare sub RemoveKeyboard()
declare sub KeyBoardIsr()
declare sub DummKeyBoard naked()
declare function FgetKey() as ushort

dim shared VesaDosInfo as SVGA_dos_vbe_vgainfo
dim shared VesaInfo as SVGA_dos_vbe_modeinfo
dim shared mapping as __dpmi_meminfo
dim shared regs as __dpmi_regs
dim shared MouseCallBack as __dpmi_raddr

dim shared BufferPtr as ubyte ptr
dim shared VideoPtr as ubyte ptr
dim shared ScreenPage as integer

if SVGA_DOSDetectVBE(@VesaDosInfo) then
    if GetVBEModeInfo(VesaInfo) then
        MapMemory VesaDosInfo.TotalMemory, VesaInfo.PhysBasePtr
    end if
else
    print "No Vesa Linear Frame Buffer Mode"
    getkey
    end
end if

dim VideoMemory as integer, VideoPages as integer
dim I as integer

VideoMemory = VesaDosInfo.TotalMemory shl 16
VideoPages = VideoMemory \ 307200

dim shared VideoArrayPtr(1 to VideoPages) as ubyte ptr

for I = 1 to VideoPages
    VideoArrayPtr(I) = VideoPtr + (I-1) * 307200
next I

BufferPtr = VideoPtr

dim FrameBuffer(0 to 307199) as ubyte
dim shared FrameBufferPtr as ubyte ptr
FrameBufferPtr = varptr(FrameBuffer(0))


dim shared NewKeyboard as _go32_dpmi_seginfo
dim shared OldKeyboard as _go32_dpmi_seginfo

dim shared PressedKey as ushort

dim shared multikey(0 to 255) as integer
dim shared MultikeyPtr as integer ptr
MultikeyPtr = varptr(multikey(0))

dim shared KeyMap(0 to 255) as ubyte = {0,27,49,50,51,52,53,54,55,56,57,48,45,61,8,9,113,119,101,114,116,121,117,105,111,112,91,93,13,0,97,115,100,102,103,104,106,107,108,59,39,96,0,92,122,120, _
99,118,98,110,109,44,46,47,0,42,0,32,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,45,0,0,0,43,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,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,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,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,13,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}

dim shared KeyMapPtr as ubyte ptr

KeyMapPtr = varptr(KeyMap(0))

' SCREEN 18, , , GFX_NULL must be at this position in file
' Makes no sense why this must be here
' Otherwise messes up mouse cursor on the bottom of screen
' Maybe Freebasic uses the same names ?

screen 18, , , GFX_NULL       

dim shared Cursor(0 to 255) as ubyte
dim shared CursorPtr as any ptr


dim shared CursorArea(0 to 255) as ubyte
dim shared CursorAreaPtr as any ptr



CursorPtr = varptr(Cursor(0))
CursorAreaPtr = varptr(CursorArea(0))



dim shared MouseHorz as integer, MouseVert as integer, Buttons as integer, OldMouseHorz as integer, OldMouseVert as integer, OldMouseButtons as integer
dim shared MouseX as integer, MouseY as integer
dim shared MouseWait as integer

dim shared MOUSEEXIST as integer, MouseTimer as double

dim shared Ky as ushort


' Mouse Cursor Data

data 16,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
data 16,16,16,16,0,0,0,0,0,0,0,0,0,0,0,0
data 16,15,15,15,16,16,16,0,0,0,0,0,0,0,0,0
data 0,16,15,15,15,15,15,16,16,16,0,0,0,0,0,0
data 0,16,15,15,15,15,15,15,15,15,16,16,16,0,0,0
data 0,0,16,15,15,15,15,15,15,15,15,15,15,16,16,16
data 0,0,16,15,15,15,15,15,15,15,15,15,15,15,16,0
data 0,0,16,15,15,15,15,15,15,15,15,15,15,16,0,0
data 0,0,0,16,15,15,15,15,15,15,15,15,16,0,0,0
data 0,0,0,16,15,15,15,15,15,15,15,16,0,0,0,0
data 0,0,0,16,15,15,15,15,15,15,15,15,16,0,0,0
data 0,0,0,0,16,15,15,15,15,16,15,15,15,16,0,0
data 0,0,0,0,16,15,15,15,16,0,16,15,15,15,16,0
data 0,0,0,0,16,15,15,16,0,0,0,16,15,15,15,16
data 0,0,0,0,0,16,16,0,0,0,0,0,16,15,15,16
data 0,0,0,0,0,16,0,0,0,0,0,0,0,16,16,0

'Read in the mouse cursor

for I = 0 to 255
    read Cursor(I)
next I   

Screen18
InitKeyboard          ' Inkey$ does not work in GFX_NULL mode, need our own keyboard handler
CCLS 2
setmouse 0, 0, 0                 ' don't waste cpu time trying to show a mouse cursor
InitilizeMouse

AnyKey
CloseMouseHandler
RemoveKeyboard
screen 0
palette
end

sub CCLS(byval COLOUR as integer)
   
    VerticalSync
    asm
        cld
        mov     edi, [BufferPtr]
        Mov     ecx, 76800
        mov     al, [COLOUR]
        mov     ah, al
        bswap   eax
        mov     al, [COLOUR]
        mov     ah, al       
        rep     stosd
    end asm
   
end sub

sub CopyCurArea2Fb(byval X as integer, byval Y as integer)
    dim X2 as integer, Y2 as integer
    dim XWidth as integer, YHeight as integer, XWidthAddon as integer
   
    X2 = X + 15
    Y2 = Y + 15
   
    if X2 > 639 then X2 = 639
    if Y > 479 then Y2 = 479
   
    XWidth = X2 - X + 1
    YHeight = Y2 - Y + 1
   
    XWidthAddon = 16 -XWidth
   
   
    asm
        cld
        mov     eax, 0
        mov     ebx, 0
        mov     esi, [BufferPtr]        ' put video offset into esi
        mov     edi, [FrameBufferPtr]   ' put FrameBuffer offset into edi
       
        imul    eax, dword ptr [Y], 640 ' multiply Y by screen width 640 and add X
        add     eax, [X]
       
        add     edi, eax
        add     esi, eax
       
        mov     ebx, [YHeight]
        mov     eax, 624        ' Addon value = screen width - width of cursor sprite
        DrawTheRows13:
        mov     ecx, [XWidth]
        rep     movsb
        add     esi, [XWidthAddon]
        add     edi, [XWidthAddon]
        add     edi, eax
        add     esi, eax
        dec     ebx
        jne     DrawTheRows13
    end asm
   
end sub

sub CopyFb2Video(byval X as integer, byval Y as integer)
    dim X2 as integer, Y2 as integer
    dim XWidth as integer, YHeight as integer, XWidthAddon as integer
   
    X2 = X + 15
    Y2 = Y + 15
   
    if X2 > 639 then X2 = 639
    if Y > 479 then Y2 = 479
   
    XWidth = X2 - X + 1
    YHeight = Y2 - Y + 1
   
    XWidthAddon = 16 -XWidth
   
   
    VerticalSync
    asm
        cld
        mov     eax, 0
        mov     ebx, 0
        mov     edi, [BufferPtr]          ' put video offset into edi
        mov     esi, [FrameBufferPtr]     ' put FrameBuffer offset into esi
       
        imul    eax, dword ptr [Y], 640 ' multiply Y by screen width 640 and add X
        add     eax, [X]
       
        add     edi, eax
        add     esi, eax
       
        mov     ebx, [YHeight]
        mov     eax, 624           ' Addon value = screen width - width of cursor sprite
        DrawTheRows15:
        mov     ecx, [XWidth]
        rep     movsb
        add     esi, [XWidthAddon]
        add     edi, [XWidthAddon]
        add     edi, eax
        add     esi, eax
        dec     ebx
        jne     DrawTheRows15
    end asm
   
end sub

sub GetFbMouseArea(byval X as integer, byval Y as integer, byval SpritePtr as any ptr)
    dim X2 as integer, Y2 as integer
    dim XWidth as integer, YHeight as integer, XWidthAddon as integer
    X2 = X + 15
    Y2 = Y + 15
   
    if X2 > 639 then X2 = 639
    if Y > 479 then Y2 = 479
   
    XWidth = X2 - X + 1
    YHeight = Y2 - Y + 1
   
    XWidthAddon = 16 -XWidth
   
   
    asm
        cld
        mov     eax, 0
        mov     ebx, 0
        mov     edi, [SpritePtr]        ' put video offset into edi
        mov     esi, [FrameBufferPtr]   ' put FrameBuffer offset into esi
       
        imul    eax, dword ptr [Y], 640  ' multiply Y by screen width 640 and add X
        add     esi, eax
        add     esi, [X]
       
        mov     ebx, [YHeight]
        mov     eax, 624             ' Addon value = screen width - width of cursor sprite
        DrawTheRows2:
        mov     ecx, [XWidth]
        rep     movsb
        add     esi, [XWidthAddon]
        add     edi, [XWidthAddon]
        add     esi, eax
        dec     ebx
        jne     DrawTheRows2
    end asm
   
end sub

sub PutFbMouseArea(byval X as integer, byval Y as integer, byval SpritePtr as any ptr)
    dim X2 as integer, Y2 as integer
    dim XWidth as integer, YHeight as integer, XWidthAddon as integer
    X2 = X + 15
    Y2 = Y + 15
   
    if X2 > 639 then X2 = 639
    if Y > 479 then Y2 = 479
   
    XWidth = X2 - X + 1
    YHeight = Y2 - Y + 1
   
    XWidthAddon = 16 -XWidth
   
   
    asm
        cld
        mov     eax, 0
        mov     ebx, 0
        mov     edi, [FrameBufferPtr]   ' put FrameBuffer offset into edi
        mov     esi, [SpritePtr]        ' put sprite offset into esi
       
        imul    eax, dword ptr [Y], 640 ' multiply Y by screen width 640 and add X
        add     edi, eax
        add     edi, [X]
       
        mov     ebx, [YHeight]
        mov     eax, 624          ' Addon value = screen width - width of cursor sprite
        DrawTheRows5:
        mov     ecx, [XWidth]
        rep     movsb
        add     esi, [XWidthAddon]
        add     edi, [XWidthAddon]
        add     edi, eax
        dec     ebx
        jne     DrawTheRows5
    end asm
   
end sub

sub PutFbMousePset(byval X as integer, byval Y as integer, byval SpritePtr as any ptr)
    dim X2 as integer, Y2 as integer
    dim XWidth as integer, YHeight as integer, XWidthAddon as integer
    X2 = X + 15
    Y2 = Y + 15
   
    if X2 > 639 then X2 = 639
    if Y > 479 then Y2 = 479
   
    XWidth = X2 - X + 1
    YHeight = Y2 - Y + 1
   
    XWidthAddon = 16 -XWidth
   
   
   
    asm
        cld
        mov     eax, 0
        mov     ebx, 0
        mov     edi, [FrameBufferPtr]   ' put FrameBuffer offset into edi
        mov     esi, [SpritePtr]        ' put sprite offset into esi       
       
        imul    eax, dword ptr [Y], 640 ' multiply Y by screen width 640 and add X
        add     edi, eax
        add     edi, [X]
       
        mov     ebx, [YHeight]
        mov     eax, 624           ' Addon value = screen width - width of cursor sprite
        DrawTheRows7:
        mov     ecx, [XWidth]
        NextPixel2:
        mov     DL, [esi]
        cmp     DL, 0
        je      SkipPixel5
        mov     [edi], DL
        SkipPixel5:
        inc     esi
        inc     edi
    loop NextPixel2
    add     esi, [XWidthAddon]
    add     edi, [XWidthAddon]
    add     edi, eax
    dec     ebx
    jne     DrawTheRows7
end asm

end sub

sub GetMouseArea(byval X as integer, byval Y as integer, byval SpritePtr as any ptr)
    dim X2 as integer, Y2 as integer
    dim XWidth as integer, YHeight as integer, XWidthAddon as integer
    X2 = X + 15
    Y2 = Y + 15
   
    if X2 > 639 then X2 = 639
    if Y > 479 then Y2 = 479
   
    XWidth = X2 - X + 1
    YHeight = Y2 - Y + 1
   
    XWidthAddon = 16 -XWidth
   
   
    VerticalSync
    asm
        cld
        mov     eax, 0
        mov     ebx, 0
        mov     edi, [SpritePtr]   ' put Sprite offset into edi
        mov     esi, [BufferPtr]   ' put Video offset into esi
       
        imul    eax, dword ptr [Y], 640 ' multiply Y by screen width 640 and add X
        add     esi, eax
        add     esi, [X]
       
        mov     ebx, [YHeight]
        mov     eax, 624            ' Addon value = screen width - width of cursor sprite
        DrawTheRows21:
        mov     ecx, [XWidth]
        rep     movsb
        add     esi, [XWidthAddon]
        add     edi, [XWidthAddon]
        add     esi, eax
        dec     ebx
        jne     DrawTheRows21
    end asm
   
end sub

sub PutMouseArea(byval X as integer, byval Y as integer, byval SpritePtr as any ptr)
    dim X2 as integer, Y2 as integer
    dim XWidth as integer, YHeight as integer, XWidthAddon as integer
    X2 = X + 15
    Y2 = Y + 15
   
    if X2 > 639 then X2 = 639
    if Y > 479 then Y2 = 479
   
    XWidth = X2 - X + 1
    YHeight = Y2 - Y + 1
   
    XWidthAddon = 16 -XWidth
   
    VerticalSync
   
    asm
        cld
        mov     eax, 0
        mov     ebx, 0
        mov     edi, [BufferPtr]   ' put video offset into edi
        mov     esi, [SpritePtr]   ' put sprite offset into esi
       
        imul    eax, dword ptr [Y], 640  ' multiply Y by screen width 640 and add X
        add     edi, eax
        add     edi, [X]
       
        mov     ebx, [YHeight]
        mov     eax, 624           ' Addon value = screen width - width of cursor sprite
        DrawTheRows25:
        mov     ecx, [XWidth]
        rep     movsb
        add     esi, [XWidthAddon]
        add     edi, [XWidthAddon]
        add     edi, eax
        dec     ebx
        jne     DrawTheRows25
    end asm
   
end sub

sub PutMousePset(byval X as integer, byval Y as integer, byval SpritePtr as any ptr)
    dim X2 as integer, Y2 as integer
    dim XWidth as integer, YHeight as integer, XWidthAddon as integer
    X2 = X + 15
    Y2 = Y + 15
   
    if X2 > 639 then X2 = 639
    if Y > 479 then Y2 = 479
   
    XWidth = X2 - X + 1
    YHeight = Y2 - Y + 1
   
    XWidthAddon = 16 -XWidth
   
   
    VerticalSync
   
    asm
        cld
        mov     eax, 0
        mov     ebx, 0
        mov     edi, [BufferPtr]   ' put video offset into edi
        mov     esi, [SpritePtr]   ' put sprite offset into esi       
       
        imul    eax, dword ptr [Y], 640  ' multiply Y by screen width 640 and add X
        add     edi, eax
        add     edi, [X]
       
        mov     ebx, [YHeight]
        mov     eax, 624          ' Addon value = screen width - width of cursor sprite
        DrawTheRows27:
        mov     ecx, [XWidth]
        NextPixel22:
        mov     DL, [esi]
        cmp     DL, 0
        je      SkipPixe25
        mov     [edi], DL
        SkipPixe25:
        inc     esi
        inc     edi
    loop NextPixel22
    add     esi, [XWidthAddon]
    add     edi, [XWidthAddon]
    add     edi, eax
    dec     ebx
    jne     DrawTheRows27
end asm

end sub


sub InitilizeMouse
    regs.x.ax = 0
    __dpmi_int(&H33, @regs)
    MouseExist = regs.x.ax
   
    ' set horizontal range
    regs.x.ax = 7
    regs.x.cx = 0
    regs.x.dx = 639
    __dpmi_int(&H33, @regs)
   
    ' set vertical range
    regs.x.ax = 8
    regs.x.cx = 0
    regs.x.dx = 479
    __dpmi_int(&H33, @regs)
   
    ' ensure that the mouse isn't drawn by the mouse driver
    regs.x.ax = 2
   
    __dpmi_int(&H33, @regs)     
   
    'Position mouse by row and col
    regs.x.ax = 4
    regs.x.cx = 320
    regs.x.dx = 240
    __dpmi_int(&H33, @regs)
   
    MouseHorz = 320
    MouseVert = 240
    OldMouseHorz = 320
    OldMouseVert = 240
    OldMouseButtons = 0   
   
    dim MouseCodeSize as uinteger
    dim MouseStart as any ptr, MouseEnd as any ptr
   
    MouseStart = @GetMouseInfo
    MouseEnd = @EndMouseInfo
    MouseCodeSize = MouseEnd -MouseStart
   
    _go32_dpmi_lock_code(@GetMouseInfo, MouseCodeSize)
    _go32_dpmi_lock_data(@MouseHorz, 4)
    _go32_dpmi_lock_data(@MouseVert, 4)
    _go32_dpmi_lock_data(@Buttons, 4)
    _go32_dpmi_lock_data(@MouseWait, 4)   
   
    __dpmi_allocate_real_mode_callback @GetMouseInfo, @regs, @MouseCallBack
   
    ' set user interrupt routine
   
    regs.x.ax = &H0C
    regs.x.cx = &H7F
    regs.x.es = MouseCallBack.segment
    regs.x.dx = MouseCallBack.offset16
    __dpmi_int(&H33, @regs)
   
end sub

sub CloseMouseHandler()
    ' set user interrupt routine
   
    regs.x.ax = &H0C
    regs.x.cx = 0
    regs.x.es = 0
    regs.x.dx = 0
    __dpmi_int(&H33, @regs)   
   
    regs.x.ax = &H01F
    __dpmi_int(&H33, @regs)
   
    '_go32_dpmi_set_protected_mode_interrupt_vector(0x33, &old_mouse_handler)
    __dpmi_free_real_mode_callback @MouseCallBack
   
end sub   


sub GetMouseInfo naked ()
   
    asm
        ' set up real mode return address (simulate real-mode retf)
        push    eax
       
        mov eax, [esi]
        mov es:[edi + 42], eax
        add word ptr es:[edi + 46], 4
       
        ' store mouse location and status
       
        push ds
        mov ax, cs:[___djgpp_app_DS]
        mov ds, ax   
       
       
        mov eax, [MouseWait]
        cmp eax, 1
        je  SkipAssign
        mov ax, es:[edi + 0x18]
        mov [MouseHorz], ax
       
        mov ax, es:[edi + 0x14]
        mov [MouseVert], ax
       
        mov ax, es:[edi + 0x10]
        mov [Buttons], al
        SkipAssign:   
        pop     ds
        pop     eax
        sti
        iret
    end asm
end sub

sub EndMouseInfo naked ()
end sub

sub PositionMouse(X as integer, Y as integer)   
    regs.x.ax = 4
    regs.x.cx = X
    regs.x.dx = Y
    __dpmi_int(&H33, @regs)
end sub   

sub ShowMouse
    regs.x.ax = 1
    __dpmi_int(&H33, @regs)
end sub

sub HideMouse
    regs.x.ax = 2
    __dpmi_int(&H33, @regs)
end sub

sub DisableMouse()
    regs.x.ax = &H001F
    __dpmi_int(&H33, @regs)
end sub

sub PutCursor()
    dim Xdiff as integer, Ydiff as integer
   
    if PreciseTimer - MouseTimer < .033 then exit sub
   
    ' IF cursor does not move, don't redraw it
   
    if MouseHorz <> OldMouseHorz or MouseVert <> OldMouseVert then
        MouseTimer = PreciseTimer
        MouseWait = 1
       
        Xdiff = abs(MouseHorz -OldMouseHorz) + 1
        Ydiff = abs(MouseVert -OldMouseVert) + 1
       
       
        if Xdiff > 15 and Ydiff > 15 then
           
            ' If new cursor position does not overlap old position the draw the cursor
           
            ' Put Mouse Area at OldMouseHorz, OldMouseVert   
           
            PutMouseArea OldMouseHorz, OldMouseVert, CursorAreaPtr
           
            ' Get mouse area at MouseHorz, MouseVert, and put cursor
            GetMouseArea MouseHorz, MouseVert, CursorAreaPtr
            PutMousePset MouseHorz, MouseVert, CursorPtr
           
        else           
            ' IF cursor overlaps copy to our own framebuffer and draw it
           
            CopyCurArea2Fb MouseHorz, MouseVert     ' Copy New Cursor Background to FrameBuffer
           
            PutFbMouseArea OldMouseHorz, OldMouseVert, CursorAreaPtr  ' Put old background to FrameBuffer
            GetFbMouseArea MouseHorz, MouseVert, CursorAreaPtr        ' Get Cursor background
            PutFbMousePset MouseHorz, MouseVert, CursorPtr      ' Put Cursor on FrameBuffer
           
            CopyFb2Video OldMouseHorz, OldMouseVert    ' Copy old cursor area to video
            CopyFb2Video MouseHorz, MouseVert          ' Copy new cursor area to video
        end if
        OldMouseHorz = MouseHorz
        OldMouseVert = MouseVert
        MouseWait = 0
    end if
end sub

sub StartMouse()
    MouseWait = 1
    GetMouseArea MouseHorz, MouseVert, CursorAreaPtr
    PutMousePset MouseHorz, MouseVert, CursorPtr
    OldMouseHorz = MouseHorz
    OldMouseVert = MouseVert
    MouseWait = 0
end sub

sub EndMouse()
    PutMouseArea OldMouseHorz, OldMouseVert, CursorAreaPtr
end sub

sub GetClicked ()
    dim TimerStart as double, TimerEnd as double
    dim MouseTime as double, OldButtons as integer
    if MouseExist = 0 then Buttons = 0:exit sub
    OldButtons = 0
   
    if Buttons > 0 then
        OldButtons = Buttons
        TimerStart = PreciseTimer
        do
            if Buttons = 3 and OldButtons <> 3 then
                OldButtons = 3
                TimerStart = PreciseTimer
            end if
        loop until Buttons = 0
        TimerEnd = PreciseTimer
        MouseTime = TimerEnd - TimerStart
        if MouseTime < 5 then
            Buttons = OldButtons
        end if
    end if
end sub

sub AnyKey
    dim Key as ushort
    StartMouse              ' needed to show cursor
    do
        Key = FGetKey
        GetClicked
        PutCursor           ' puts cursor on screen
    loop until Key > 0 or Buttons > 0
    if buttons = 3 then Ky = escape
    EndMouse    ' need to get rid fo cursor
end sub

function PreciseTimer as double
    dim as uinteger BIOSTimer, PITValue
    dim as ubyte LowBytePIT, HighBytePIT
    'Function returns current time in seconds.
    DOSMEMGET &H46C, 4, @BIOSTimer 'read BIOS timer counter
    out &H43, 0 'latch PIT counter for zero channel
    LowBytePIT = inp(&H40) 'low byte of PIT counter
    HighBytePIT = inp(&H40) 'high byte of PIT counter
    PITValue = (HighBytePIT shl 8) + LowBytePIT 'calculate PIT counter
    'PIT work frequency is 1193180 Hertz
    function = (BIOSTimer * 65536 + PITValue) / 1193180
end function


function SVGA_DOSDetectVBE(vbeinfo as SVGA_dos_vbe_vgainfo ptr) as integer
    dim sig as string
   
    vbeinfo->VESASignature(0) = asc("V")
    vbeinfo->VESASignature(1) = asc("B")
    vbeinfo->VESASignature(2) = asc("E")
    vbeinfo->VESASignature(3) = asc("2")
   
    regs.x.ax = &H4F00
    regs.x.di = __tb and &H0F
    regs.x.es = (__tb shr 4) and &HFFFF
   
    dosmemput(vbeinfo, sizeof(SVGA_dos_vbe_vgainfo), __tb)
    __dpmi_int(&H10, @regs)
    dosmemget(__tb, sizeof(SVGA_dos_vbe_vgainfo), vbeinfo)
   
    sig += chr(vbeinfo->VESASignature(0))
    sig += chr(vbeinfo->VESASignature(1))
    sig += chr(vbeinfo->VESASignature(2))
    sig += chr(vbeinfo->VESASignature(3))
   
    if sig <> "VESA" then
        'PRINT "Could not find VESA Signature"
        'AnyKey
        exit function   
    end if
   
    'PRINT "Vesa version = ";Hex$(VesaInfo.VESAVersion)
   
    if VesaDosInfo.VESAVersion < &H200 then
        'PRINT "Not Vesa 2.0"       
        'AnyKey
        'EXIT FUNCTION
    end if   
   
    if regs.h.ah = 0 then function = 1
end function

function GetVBEModeInfo(modeinfo as SVGA_dos_vbe_modeinfo) as integer
    dim Mode as ushort
    dim Result as integer
   
    Mode = bitset(&H101, 14)
   
    regs.x.ax = &H4F01
    regs.x.cx = mode
    regs.x.di= __tb and &H0F
    regs.x.es = (__tb shr 4) and &HFFFF
    __dpmi_int(&H10, @regs)
    dosmemget(__tb, sizeof(SVGA_dos_vbe_modeinfo), @modeinfo)
    Result = regs.h.ah
    if Result = 0 then function = 1
end function


sub MapMemory(VideoMemoryBlocks as ushort, PhysicalMemoryPtr as uinteger)
    dim DSSelector as uinteger, DSAddr as uinteger
    ' map into linear memory
    mapping.address = PhysicalMemoryPtr
   
    mapping.size = VideoMemoryBlocks shl 16
    if __dpmi_physical_address_mapping(@mapping) <> 0 then
        exit sub
    end if     
   
    DSSelector = 0
   
    asm mov word ptr [DSSelector], ds
    if __dpmi_set_segment_limit(DSSelector, &HFFFFFFFF) <> 0 then
        exit sub
    end if
    if __dpmi_get_segment_base_address(DSSelector, @DSAddr) <> 0 then
        exit sub
    end if
   
    if mapping.address < DSAddr then
        if __dpmi_set_segment_base_address(DSSelector, mapping.address - 2) <> 0 then
            err = 251: exit sub
        end if
        DSAddr = mapping.address - 2
    end if
    VideoPtr = cast(ubyte ptr, mapping.address - DSAddr)
end sub


sub Screen18()
    dim Mode as ushort
    Mode = bitset(&H101, 14)
    'Mode = &H101 'OR &B0100000000000000
    dim regs as REGS
    regs.x.eax = &H4f02
    regs.x.ebx = Mode
    int86(&H10, @regs, @regs)
end sub

sub VesaEnd()
    regs.x.ax = 3
    __dpmi_int(&H10, @regs)
    __dpmi_free_physical_address_mapping(@mapping)
end sub

sub Screen3()
    regs.x.ax = 3
    __dpmi_int(&H10, @regs)
end sub

sub VerticalSync()
    asm
        mov      dx, &H3DA
        WaitFor1:
        in       al, dx               ' wait for current retrace to end
        test     al, &B00001000
        jnz      WaitFor1
        WaitFor0:
        in       al, dx               ' wait for current retrace to end
        test     al, &B00001000
        JZ       WaitFor0
    end asm
end sub

sub ChangeWindow(byval Page as integer)   
    dim regs as __dpmi_regs
    dim y as integer
    Y = (Page -1) * 480
   
    regs.x.ax = &H4F07
    regs.x.bx = 0
    regs.x.cx = 0
    regs.x.dx = Y
   
    VerticalSync
    __dpmi_int(&H10, @regs)
    'Result = regs.h.ah
    'IF Result = 0 THEN FUNCTION = 1
end sub


sub KeyBoardIsr naked()
   
    asm
        push    ds
        pushad
        mov     ax, cs:[___djgpp_app_DS]
        mov     ds, ax   
        mov     edi, [MultikeyPtr]
        mov     ecx, 0
        in      al, &H60             'get value of keyboard control lines
        mov     cl, al
        test    al, 128
        jne     SkipAssign2
        shl     ecx, 2
        mov     dword ptr[edi + ecx], -1
        mov     ah, al
        mov     ebx, [KeyMapPtr]
        XLAT
        cmp     al, 0
        jne     AsciiCode
        mov     al, 255
        mov     [PressedKey], ax
        jmp     EndKeyIsr
        AsciiCode:
        mov     ah, 0
        mov     [PressedKey], ax
        jmp     EndKeyIsr
        SkipAssign2:
        and     cl, 127
        shl     ecx, 2
        mov     dword ptr[edi + ecx], -0
       
        'Tell to the controller that the key code is readed
       
        EndKeyIsr:
        in      al, &H61             'get value of keyboard control lines
        mov     ah, al               ' save it
        or      al, &H80             'set the "enable kbd" bit
        out     &H61, al             ' and write it out the control port
        xchg    ah, al               'fetch the original control port value
        out     &H61, al             ' and write it back
       
        mov     al, &H20             'send End-Of-Interrupt signal
        out     &H20, al             ' to the 8259 Interrupt Controller
        popad
        pop     ds
        sti
        iret
    end asm
   
end sub

sub DummKeyBoard naked()
end sub

sub InitKeyBoard()
    dim KeyBoardCodeSize as uinteger
    dim KeyboardStart as any ptr, KeyboardEnd as any ptr
    KeyboardStart = @KeyBoardIsr
    KeyboardEnd = @DummKeyBoard
    KeyboardCodeSize = KeyboardEnd -KeyboardStart
   
    _go32_dpmi_lock_code(@KeyBoardIsr, KeyboardCodeSize)
    _go32_dpmi_lock_data(@KeyMapPtr, 4)
    _go32_dpmi_lock_data(@PressedKey, 2)
    _go32_dpmi_lock_data(@KeyMap(0), 256)
    _go32_dpmi_lock_data(@Multikey(0), 1024)
    _go32_dpmi_lock_data(@MultikeyPtr, 4)
   
   
    'NewKeyboard.pm_offset = @KeyBoardIsr
    NewKeyboard.pm_offset = cast(uinteger, @KeyBoardIsr)
    NewKeyboard.pm_selector = _go32_my_cs
    _go32_dpmi_get_protected_mode_interrupt_vector(9, @OldKeyboard)
    _go32_dpmi_set_protected_mode_interrupt_vector(9, @NewKeyboard)
    _go32_dpmi_allocate_iret_wrapper(@NewKeyboard)
end sub

sub RemoveKeyboard()
    _go32_dpmi_set_protected_mode_interrupt_vector(9, @OldKeyboard)
    _go32_dpmi_free_iret_wrapper(@NewKeyboard)
end sub

function FgetKey() as ushort
    function = PressedKey
    PressedKey = 0
    end function

Last edited by lassar on Jul 29, 2013 0:08, edited 9 times in total.
counting_pine
Site Admin
Posts: 6169
Joined: Jul 05, 2005 17:32
Location: Manchester, Lancs

Re: Mouse & Vesa routines: shows mouse without flicker

Postby counting_pine » Jul 24, 2013 16:27

It looks like the misspelling has been fixed, but the other points haven't been (fully) addressed..
All things considered, I think lower-case will probably be more consistent with existing examples.
lassar
Posts: 300
Joined: Jan 17, 2006 1:35
Contact:

Re: Mouse & Vesa routines: shows mouse without flicker

Postby lassar » Jul 24, 2013 23:41

counting_pine wrote:It looks like the misspelling has been fixed, but the other points haven't been (fully) addressed..
All things considered, I think lower-case will probably be more consistent with existing examples.


All in all, I think I have addressed all of your concerns.

Changed it from fblite to fb. Fixed the spelling. Changed freebasic command to lowercase. Add lower bounds in arrays.
counting_pine
Site Admin
Posts: 6169
Joined: Jul 05, 2005 17:32
Location: Manchester, Lancs

Re: Mouse & Vesa routines: shows mouse without flicker

Postby counting_pine » Jul 25, 2013 3:08

That's looking quite a bit better now. Just a few stray pieces of capitalisation. Possibly the indentation could be more rigorously checked, and I think spaces are needed after commas, particularly on the one really long line.
lassar
Posts: 300
Joined: Jan 17, 2006 1:35
Contact:

Re: Mouse & Vesa routines: shows mouse without flicker

Postby lassar » Jul 26, 2013 15:27

Added space after commas.

Broke up that long line.

I am using FBIDE format for identation.
Last edited by lassar on Jul 27, 2013 1:03, edited 1 time in total.
fxm
Posts: 9021
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: Mouse & Vesa routines: shows mouse without flicker

Postby fxm » Jul 26, 2013 16:19

Extracts of your code:

Code: Select all

#include "dos/dpmi.bi"
'.....
declare sub GetMouseInfo naked ()
declare sub EndMouseInfo naked ()
'.....
declare sub KeyBoardIsr()
declare sub DummKeyBoard naked()
'.....
dim shared NewKeyboard as _go32_dpmi_seginfo
'.....

' In sub InitilizeMouse
    '.....
    dim MouseCodeSize as uinteger
    dim GetMouseInfoStart as uinteger, EndMouseStart as uinteger
    EndMouseStart = @EndMouseInfo
    GetMouseInfoStart = @GetMouseInfo
    MouseCodeSize = EndMouseStart -EndMouseStart
   
    _go32_dpmi_lock_code(@GetMouseInfo, MouseCodeSize)
    '.....

' In sub InitKeyBoard()
    '.....
    dim KeyBoardCodeSize as uinteger
    DIM KeyboardStart as integer, KeyboardEnd as integer
    KeyboardStart = @KeyBoardIsr
    KeyboardEnd = @DummKeyBoard
    KeyboardCodeSize = KeyboardEnd -KeyboardStart
   
    _go32_dpmi_lock_code(@KeyBoardIsr, KeyboardCodeSize)
    '.....
    NewKeyboard.pm_offset = @KeyBoardIsr
    '.....

- Weird line:
"MouseCodeSize = EndMouseStart -EndMouseStart" (always 0!)
"GetMouseInfoStart = @GetMouseInfo" (GetMouseInfoStart is not used!)

- Compiler warning 5(0): Implicit conversion:
"EndMouseStart"
"GetMouseInfoStart"
"KeyboardStart"
"KeyboardEnd"
"NewKeyboard.pm_offset"
lassar
Posts: 300
Joined: Jan 17, 2006 1:35
Contact:

Re: Mouse & Vesa routines: shows mouse without flicker

Postby lassar » Jul 27, 2013 1:01

fxm wrote:- Weird line:
"MouseCodeSize = EndMouseStart -EndMouseStart" (always 0!)
"GetMouseInfoStart = @GetMouseInfo" (GetMouseInfoStart is not used!)




Thanks for finding the error.

I just revised the version to include the fix to this.


Code: Select all


  dim MouseCodeSize as uinteger
  dim MouseStart as uinteger, MouseEnd as uinteger
   
  MouseStart = @GetMouseInfo
  MouseEnd = @EndMouseInfo
  MouseCodeSize = MouseEnd -MouseStart

fxm
Posts: 9021
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: Mouse & Vesa routines: shows mouse without flicker

Postby fxm » Jul 27, 2013 5:26

If you want to remove the 5 compiler warnings on pointers:

Code: Select all

'.....
dim MouseStart as any ptr, MouseEnd as any ptr
'.....
dim KeyboardStart as any ptr, KeyboardEnd as any ptr
'.....
NewKeyboard.pm_offset = cast(uinteger, @KeyBoardIsr)
'.....
lassar
Posts: 300
Joined: Jan 17, 2006 1:35
Contact:

Re: Mouse & Vesa routines: shows mouse without flicker

Postby lassar » Jul 28, 2013 22:44

Added Multikey function to this code.

Return to “Tips and Tricks”

Who is online

Users browsing this forum: No registered users and 3 guests