DECLARE SUB draw.cursor (mx%, my%)
DECLARE SUB load.cursor ()
DECLARE SUB restore.font ()
DECLARE SUB set.font.char (index%)
DECLARE SUB get.mouse (x%, y%, b%)
DECLARE FUNCTION init.mouse% ()
DECLARE SUB memcopy (destseg%, destoff%, srcseg%, srcoff%, numbytes%)
DECLARE SUB get.font.table ()
'$INCLUDE: 'qb.bi'
DEFINT A-Z
CLS
TYPE frame
x1 AS INTEGER
y1 AS INTEGER
x2 AS INTEGER
y2 AS INTEGER
END TYPE
IF NOT init.mouse THEN
PRINT "No mouse driver"
END
END IF
DIM SHARED font.table(2048) AS INTEGER
DIM SHARED font.table.backup(2048) AS INTEGER
get.font.table
DIM SHARED cursor(8, 16) AS INTEGER
DIM SHARED background(2, 2) AS INTEGER
DIM SHARED omx, omy
load.cursor
first.frame = -1
'show.mouse
PRINT
PRINT
PRINT
PRINT "Smooth mouse cursor v1.0"
PRINT " by moi :)"
PRINT
PRINT "This shows how font manipulation can be used"
PRINT "to create a smooth scrolling mouse cursor in"
PRINT "text mode. It uses four characters from 240-"
PRINT "243 to draw the cursor on top of the letters"
PRINT "and write it to the font table, creating the"
PRINT "image you see as the cursor. There's still a"
PRINT "bug I haven't removed: one of the bits isn't"
PRINT "written to the font table, causing a line to"
PRINT "be drawn every 8th bit on the screen. It's a"
PRINT "simple thing to solve, probably, but I don't"
PRINT "want to waste more time on it right now."
PRINT
PRINT "Have fun :)"
DO
get.mouse mx, my, mb
IF mx <> omx OR my <> omy OR first.frame THEN
IF first.frame THEN
'omx = mx
'omy = my
first.frame = 0
END IF
LOCATE 1, 1
PRINT mx; my; mb
PRINT mx \ 8; my \ 8
draw.cursor mx, my
omx = mx
omy = my
END IF
LOOP WHILE INKEY$ = ""
restore.font
DATA 2,2,0,0,0,0,0,0
DATA 2,1,2,0,0,0,0,0
DATA 2,1,1,2,0,0,0,0
DATA 2,1,1,1,2,0,0,0
DATA 2,1,1,1,1,2,0,0
DATA 2,1,1,1,1,1,2,0
DATA 2,1,1,1,1,1,1,2
DATA 2,2,2,1,1,2,2,2
DATA 0,0,0,2,1,1,2,0
DATA 0,0,0,2,1,1,2,0
DATA 0,0,0,0,2,1,1,2
DATA 0,0,0,0,2,2,2,2
DATA 0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0
SUB draw.cursor (mx, my)
IF omx \ 8 <> mx \ 8 OR omy \ 8 <> my \ 8 THEN
FOR y = 0 TO 1
FOR x = 0 TO 1
yy = omy \ 8 + y + 1
xx = omx \ 8 + x + 1
IF xx > 0 AND yy > 0 AND xx <= 80 AND yy <= 25 THEN
LOCATE yy, xx
COLOR 7, 0
IF background(x, y) = 0 THEN background(x, y) = 32
PRINT CHR$(background(x, y));
END IF
NEXT x
NEXT y
END IF
'use chars 240-243 to draw the cursor
mmx = mx \ 8
mmy = my \ 8
IF omx \ 8 <> mx \ 8 OR omy \ 8 <> my \ 8 THEN
FOR y = 0 TO 1
FOR x = 0 TO 1
yy = 1 + mmy + y
xx = 1 + mmx + x
IF xx > 0 AND yy > 0 AND xx <= 80 AND yy <= 25 THEN
background(x, y) = SCREEN(yy, xx)
END IF
NEXT x
NEXT y
END IF
dx = mx AND 7
dy = (my AND 7) * 2
index = 240
s = VARSEG(font.table(0))
o = VARPTR(font.table(0))
FOR y = 0 TO 1
FOR x = 0 TO 1
memcopy s, o + index * 16, s, o + background(x, y) * 16, 16
index = index + 1
NEXT x
NEXT y
DEF SEG = s
i = 240
FOR y = 0 TO 1
FOR x = 0 TO 1
oo = o + i * 16
FOR yy = 0 TO 15
row = PEEK(oo)
FOR xx = 0 TO 7
IF xx + x * 8 - dx >= 0 AND xx + x * 8 - dx < 8 AND yy + y * 16 - dy >= 0 AND yy + y * 16 - dy < 16 THEN
IF cursor(xx + x * 8 - dx, yy + y * 16 - dy) = 1 THEN
row = row OR (2 ^ (7 - xx))
ELSEIF cursor(xx + x * 8 - dx, yy + y * 16 - dy) = 2 THEN
row = row AND (255 XOR (2 ^ (7 - xx)))
END IF
END IF
NEXT xx
POKE oo, row
oo = oo + 1
NEXT yy
set.font.char i
yy = 1 + mmy + y
xx = 1 + mmx + x
IF xx > 0 AND yy > 0 AND xx <= 80 AND yy <= 25 THEN
LOCATE yy, xx
PRINT CHR$(i);
COLOR 7, 0
END IF
i = i + 1
NEXT x
NEXT y
END SUB
SUB get.font.table
DIM r AS RegTypeX
r.ax = &H1130
r.bx = &H600
CALL interruptx(&H10, r, r)
bpc = r.cx 'bytes per char
rows = (r.dx AND 255) + 1
fseg = r.es
foff = r.bp
DIM r AS regtype
r.ax = 3
CALL interrupt(&H33, r, r)
x = r.cx
y = r.dx
b = r.bx
END SUB
SUB hide.mouse
DIM r AS regtype
r.ax = 2
CALL interrupt(&H33, r, r)
END SUB
FUNCTION init.mouse
DIM r AS regtype
r.ax = 0
CALL interrupt(&H33, r, r)
init.mouse = (r.ax <> 0)
END FUNCTION
SUB load.cursor
FOR y = 0 TO 15
FOR x = 0 TO 7
READ cursor(x, y)
NEXT x
NEXT y
END SUB
SUB memcopy (destseg, destoff, srcseg, srcoff, numbytes)
FOR i = 0 TO numbytes - 1
DEF SEG = srcseg
byte = PEEK(srcoff + i)
DEF SEG = destseg
POKE destoff + i, byte
NEXT i
DEF SEG
END SUB
SUB restore.font
memcopy VARSEG(font.table(0)), VARPTR(font.table(0)), VARSEG(font.table.backup(0)), VARPTR(font.table.backup(0)), 2048
FOR i = 0 TO 255
set.font.char i
NEXT i
END SUB
SUB set.font.char (index)
DIM r AS RegTypeX
r.ax = &H1100
r.bx = &H1000
r.cx = 1
r.dx = index
r.es = VARSEG(font.table(0))
r.bp = VARPTR(font.table(0)) + 16 * index
CALL interruptx(&H10, r, r)
END SUB
SUB show.mouse
DIM r AS regtype
r.ax = 1
CALL interrupt(&H33, r, r)
Getting a mouse pointer in full-screen mode was something I've been interested in seeing coded for awhile. Atari Basic used to make it a lot easier to manipulate characters, it's a shame that QB did not "borrow" from that. Wait, QB is Micro$oft... Press F3... Replace "Borrow" with "Steal." There, all is right with the world again.
One problem with it though, switching to a window in XP causes the 4-characters to be displayed instead of the mouse pointer. I don't see a way around that problem. Still, a really great example of font/character manipulation in a mouse routine.
Since SCREEN 0 is a text mode 8 X 8 character, despite the mouse being able to move in the graphics coordinates, the screen may not allow it in fullscreen. Would be interesting to find a way around that however.
Anyhow, it looks pretty good!
Ted
PS: In XP the windowed arrow is just the characters. It also is slower to react and Window's arrow will work anyway.
Re: I think the line is caused by the text boundaries
May 20 2008, 8:27 PM
The characters are 8x16 pixels. The characters above chr$(127) don't have the blank line; only the first 128 characters have it. Maybe I should try a different font table. This was designed specifically for full-screen mode.