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

{
 JK> Could anybody send me a routine that uses graphical mouse pointer
 JK> in 80x25 textmode? I don't want a block cursor which moves from
 JK> character to another (it's not very accurate). I would need a
 JK> arrow pointer which can be moved softly around the screen.

It aint perfect - it's a little shocky - but it works, and might give you a
clue on how to operate. A credit would be in place. ;-)

Check this:

>--- cut here
}
program txtmouse;
{ Graphics mouse cursor in textmode, by Bas van Gaalen,
  fido 2:285/213.8, internet bas.van.gaalen@schotman.nl, Holland, PD }
uses
  crt;
const
  setimg=0; getimg=1;
  vidseg:word=$b800;
  mscursor:array[0..7] of byte=(252,248,248,248,252,142,7,3);
type
  worktype=array[0..3,0..7] of byte;
var
  pdata:array[0..3] of byte;
  px,py:byte;

{ mouse routines ----------------------------------------------------------- }

function mouseinstalled:boolean; assembler; asm
  xor ax,ax; int 33h; cmp ax,-1; je @skip; xor al,al; @skip: end;

function getmousex:word; assembler; asm
  mov ax,3; int 33h; mov ax,cx end;

function getmousey:word; assembler; asm
  mov ax,3; int 33h; mov ax,dx end;

function leftpressed:boolean; assembler; asm
  mov ax,3; int 33h; and bx,1; mov ax,bx end;

function rightpressed:boolean; assembler; asm
  mov ax,3; int 33h; and bx,2; mov ax,bx end;

procedure mousesensetivity(x,y:word); assembler; asm
  mov ax,1ah; mov bx,x; mov cx,y; xor dx,dx; int 33h end;

procedure mousewindow(l,t,r,b:word); assembler; asm
  mov ax,7; mov cx,l; mov dx,r; int 33h; mov ax,8
  mov cx,t; mov dx,b; int 33h end;

function hardx:byte; begin hardx:=getmousex div 8; end;
function hardy:byte; begin hardy:=getmousey div 8; end;
function smoothx:word; begin smoothx:=getmousex mod 8; end;
function smoothy:word; begin smoothy:=getmousey mod 8; end;

{ -------------------------------------------------------------------------- }

procedure getsetimage(chr:byte; var data; getset:byte); assembler;
asm
  push ds
  mov al,32
  mul [chr]
  cmp getset,getimg
  je @goget
  mov di,ax
  mov ax,0a000h
  mov es,ax
  mov cx,8/2
  lds si,data
  jmp @start
 @goget:
  mov si,ax
  mov ax,0a000h
  mov ds,ax
  mov cx,8/2
  les di,data
 @start:
  cli
  mov dx,03c4h; mov ax,0402h; out dx,ax; mov ax,0704h; out dx,ax
  mov dx,03ceh; mov ax,0204h; out dx,ax; mov ax,0005h; out dx,ax; 
  mov ax,0006h; out dx,ax
  rep movsw
  mov dx,03c4h; mov ax,0302h; out dx,ax; mov ax,0304h; out dx,ax
  mov dx,03ceh; mov ax,0004h; out dx,ax; mov ax,1005h; out dx,ax; 
  mov ax,0e06h; out dx,ax
  sti
  pop ds
end;

{ -------------------------------------------------------------------------- }

procedure retrace; assembler; asm
  mov dx,03dah
  @vert1: in al,dx; test al,8; jnz @vert1
  @vert2: in al,dx; test al,8; jz @vert2
end;

{ save old characters to screen }
procedure saveold;
begin
  pdata[0]:=mem[vidseg:py*160+px*2];
  pdata[1]:=mem[vidseg:py*160+(px+1)*2];
  pdata[2]:=mem[vidseg:(py+1)*160+px*2];
  pdata[3]:=mem[vidseg:(py+1)*160+(px+1)*2];
end;

{ restore old characters to screen }
procedure restoreold;
begin
  mem[vidseg:py*160+px*2]:=pdata[0];
  mem[vidseg:py*160+(px+1)*2]:=pdata[1];
  mem[vidseg:(py+1)*160+px*2]:=pdata[2];
  mem[vidseg:(py+1)*160+(px+1)*2]:=pdata[3];
end;

{ clear 'data' }
procedure cleardata(var data:worktype); begin
  fillchar(data,sizeof(data),0); end;

{ get chars from screen and put font-data in 'data' }
procedure getscrdata(var data:worktype);
var ch,i,j,x,y:byte;
begin
  x:=hardx; y:=hardy;
  getsetimage(mem[vidseg:y*160+x*2],data[0],getimg);
  getsetimage(mem[vidseg:y*160+(x+1)*2],data[1],getimg);
  getsetimage(mem[vidseg:(y+1)*160+x*2],data[2],getimg);
  getsetimage(mem[vidseg:(y+1)*160+(x+1)*2],data[3],getimg);
end;

{ add info-font-data and mouse-arrow together }
procedure addata(var data:worktype);
var i:byte;
begin
  for i:=0 to 7-smoothy do data[0,i+smoothy]:=data[0,i+smoothy] or (mscursor[i]
shr smoothx);  for i:=0 to 7-smoothy do data[1,i+smoothy]:=data[1,i+smoothy] or
(mscursor[i] shl (8-smoothx));  for i:=0 to smoothy do data[2,i]:=data[2,i] or
(mscursor[8-smoothy+i] shr smoothx);  for i:=0 to smoothy do
data[3,i]:=data[3,i] or (mscursor[8-smoothy+i] shl (8-smoothx));end;

{ place graphicsmouse on textscreen }
procedure placemouse(data:worktype);
var i,x,y:byte;
begin
  for i:=0 to 3 do getsetimage(219+i,data[i],setimg);
  x:=hardx; y:=hardy; px:=x; py:=y; saveold;
  mem[vidseg:py*160+px*2]:=219;
  mem[vidseg:py*160+(px+1)*2]:=220;
  mem[vidseg:(py+1)*160+px*2]:=221;
  mem[vidseg:(py+1)*160+(px+1)*2]:=222;
end;

{ -------------------------------------------------------------------------- }

var
  ms:worktype;
  i,j,x,y:byte;
begin
  textmode(co80+font8x8);
  mem[$40:$49]:=6; { fool mouse to be in graphics-mode (needed for smooth) }
  if not mouseinstalled then begin writeln('need mouse.'); halt; end;
  mousesensetivity(20,20);
  mousewindow(0,0,639-8,399-8);
  for i:=10 to 69 do for j:=0 to 35 do memw[vidseg:4*160+j*160+i+i]:=((j*20+i)
mod 255)+7*256;  px:=hardx; py:=hardy; saveold;
  while not leftpressed do begin
    write(#13,hardx:2,',',hardy:2);
    retrace;
    restoreold;
    cleardata(ms);
    getscrdata(ms);
    addata(ms);
    placemouse(ms);
  end;
  textmode(lastmode);
end.

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