home *** CD-ROM | disk | FTP | other *** search
/ Collection of Hack-Phreak Scene Programs / cleanhpvac.zip / cleanhpvac / GFXFX2.ZIP / TXTMOUSE.PAS < prev    next >
Pascal/Delphi Source File  |  1995-02-14  |  5KB  |  163 lines
  1.  
  2. program txtmouse;
  3. uses
  4.   crt;
  5. const
  6.   setimg=0; getimg=1;
  7.   vidseg:word=$b800;
  8.   mscursor:array[0..7] of byte=(252,248,248,248,252,142,7,3);
  9. type
  10.   worktype=array[0..3,0..7] of byte;
  11. var
  12.   pdata:array[0..3] of byte;
  13.   px,py:byte;
  14.  
  15. { mouse routines ----------------------------------------------------------- }
  16.  
  17. function mouseinstalled:boolean; assembler; asm
  18.   xor ax,ax; int 33h; cmp ax,-1; je @skip; xor al,al; @skip: end;
  19.  
  20. function getmousex:word; assembler; asm
  21.   mov ax,3; int 33h; mov ax,cx end;
  22.  
  23. function getmousey:word; assembler; asm
  24.   mov ax,3; int 33h; mov ax,dx end;
  25.  
  26. function leftpressed:boolean; assembler; asm
  27.   mov ax,3; int 33h; and bx,1; mov ax,bx end;
  28.  
  29. function rightpressed:boolean; assembler; asm
  30.   mov ax,3; int 33h; and bx,2; mov ax,bx end;
  31.  
  32. procedure mousesensetivity(x,y:word); assembler; asm
  33.   mov ax,1ah; mov bx,x; mov cx,y; xor dx,dx; int 33h end;
  34.  
  35. procedure mousewindow(l,t,r,b:word); assembler; asm
  36.   mov ax,7; mov cx,l; mov dx,r; int 33h; mov ax,8
  37.   mov cx,t; mov dx,b; int 33h end;
  38.  
  39. function hardx:byte; begin hardx:=getmousex div 8; end;
  40. function hardy:byte; begin hardy:=getmousey div 8; end;
  41. function smoothx:word; begin smoothx:=getmousex mod 8; end;
  42. function smoothy:word; begin smoothy:=getmousey mod 8; end;
  43.  
  44. { -------------------------------------------------------------------------- }
  45.  
  46. procedure getsetimage(chr:byte; var data; getset:byte); assembler;
  47. asm
  48.   push ds
  49.   mov al,32
  50.   mul [chr]
  51.   cmp getset,getimg
  52.   je @goget
  53.   mov di,ax
  54.   mov ax,0a000h
  55.   mov es,ax
  56.   mov cx,8/2
  57.   lds si,data
  58.   jmp @start
  59.  @goget:
  60.   mov si,ax
  61.   mov ax,0a000h
  62.   mov ds,ax
  63.   mov cx,8/2
  64.   les di,data
  65.  @start:
  66.   cli
  67.   mov dx,03c4h; mov ax,0402h; out dx,ax; mov ax,0704h; out dx,ax
  68.   mov dx,03ceh; mov ax,0204h; out dx,ax; mov ax,0005h; out dx,ax; mov ax,0006h; out dx,ax
  69.   rep movsw
  70.   mov dx,03c4h; mov ax,0302h; out dx,ax; mov ax,0304h; out dx,ax
  71.   mov dx,03ceh; mov ax,0004h; out dx,ax; mov ax,1005h; out dx,ax; mov ax,0e06h; out dx,ax
  72.   sti
  73.   pop ds
  74. end;
  75.  
  76. { -------------------------------------------------------------------------- }
  77.  
  78. procedure retrace; assembler; asm
  79.   mov dx,03dah
  80.   @vert1: in al,dx; test al,8; jnz @vert1
  81.   @vert2: in al,dx; test al,8; jz @vert2
  82. end;
  83.  
  84. { save old characters to screen }
  85. procedure saveold;
  86. begin
  87.   pdata[0]:=mem[vidseg:py*160+px*2];
  88.   pdata[1]:=mem[vidseg:py*160+(px+1)*2];
  89.   pdata[2]:=mem[vidseg:(py+1)*160+px*2];
  90.   pdata[3]:=mem[vidseg:(py+1)*160+(px+1)*2];
  91. end;
  92.  
  93. { restore old characters to screen }
  94. procedure restoreold;
  95. begin
  96.   mem[vidseg:py*160+px*2]:=pdata[0];
  97.   mem[vidseg:py*160+(px+1)*2]:=pdata[1];
  98.   mem[vidseg:(py+1)*160+px*2]:=pdata[2];
  99.   mem[vidseg:(py+1)*160+(px+1)*2]:=pdata[3];
  100. end;
  101.  
  102. { clear 'data' }
  103. procedure cleardata(var data:worktype); begin
  104.   fillchar(data,sizeof(data),0); end;
  105.  
  106. { get chars from screen and put font-data in 'data' }
  107. procedure getscrdata(var data:worktype);
  108. var ch,i,j,x,y:byte;
  109. begin
  110.   x:=hardx; y:=hardy;
  111.   getsetimage(mem[vidseg:y*160+x*2],data[0],getimg);
  112.   getsetimage(mem[vidseg:y*160+(x+1)*2],data[1],getimg);
  113.   getsetimage(mem[vidseg:(y+1)*160+x*2],data[2],getimg);
  114.   getsetimage(mem[vidseg:(y+1)*160+(x+1)*2],data[3],getimg);
  115. end;
  116.  
  117. { add info-font-data and mouse-arrow together }
  118. procedure addata(var data:worktype);
  119. var i:byte;
  120. begin
  121.   for i:=0 to 7-smoothy do data[0,i+smoothy]:=data[0,i+smoothy] or (mscursor[i] shr smoothx);
  122.   for i:=0 to 7-smoothy do data[1,i+smoothy]:=data[1,i+smoothy] or (mscursor[i] shl (8-smoothx));
  123.   for i:=0 to smoothy do data[2,i]:=data[2,i] or (mscursor[8-smoothy+i] shr smoothx);
  124.   for i:=0 to smoothy do data[3,i]:=data[3,i] or (mscursor[8-smoothy+i] shl (8-smoothx));
  125. end;
  126.  
  127. { place graphicsmouse on textscreen }
  128. procedure placemouse(data:worktype);
  129. var i,x,y:byte;
  130. begin
  131.   for i:=0 to 3 do getsetimage(219+i,data[i],setimg);
  132.   x:=hardx; y:=hardy; px:=x; py:=y; saveold;
  133.   mem[vidseg:py*160+px*2]:=219;
  134.   mem[vidseg:py*160+(px+1)*2]:=220;
  135.   mem[vidseg:(py+1)*160+px*2]:=221;
  136.   mem[vidseg:(py+1)*160+(px+1)*2]:=222;
  137. end;
  138.  
  139. { -------------------------------------------------------------------------- }
  140.  
  141. var
  142.   ms:worktype;
  143.   i,j,x,y:byte;
  144. begin
  145.   textmode(co80+font8x8);
  146.   mem[$40:$49]:=6; { fool mouse to be in graphics-mode (needed for smooth) }
  147.   if not mouseinstalled then begin writeln('need mouse.'); halt; end;
  148.   mousesensetivity(20,20);
  149.   mousewindow(0,0,639-8,399-8);
  150.   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;
  151.   px:=hardx; py:=hardy; saveold;
  152.   while not leftpressed do begin
  153.     write(#13,hardx:2,',',hardy:2);
  154.     retrace;
  155.     restoreold;
  156.     cleardata(ms);
  157.     getscrdata(ms);
  158.     addata(ms);
  159.     placemouse(ms);
  160.   end;
  161.   textmode(lastmode);
  162. end.
  163.