QB / QB64 Discussion Forum      Other Subforums, Links and Downloads
 

 Return to Index  

smooth text mode mouse cursor

May 15 2008 at 7:34 AM
moi  (no login)

 
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

memcopy VARSEG(font.table(0)), VARPTR(font.table(0)), fseg, foff, 4096
memcopy VARSEG(font.table.backup(0)), VARPTR(font.table.backup(0)), fseg, foff, 4096

END SUB

SUB get.mouse (x, y, b)

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)

END SUB


 
 Respond to this message   
Responses

 Copyright © 1999-2014 Network54. All rights reserved.   Terms of Use   Privacy Statement  

Newbies usually go to www.qbasic.com and click on The QBasic Forum
Forum regulars have their own ways, which include The QBasic Community Forums