home *** CD-ROM | disk | FTP | other *** search
/ C!T ROM 5 / ctrom5b.zip / ctrom5b / PROGRAM / PASCAL / PAVT199 / DHOOKS.NEW < prev    next >
Text File  |  1992-04-09  |  6KB  |  233 lines
  1. { Include file for the demo programs in PAvatar. }
  2. { These are the video and user hook routines     }
  3. { if the compiler directive AVT0 is set then it  }
  4. { will compile to be compatible with the PAvt0   }
  5. { unit.  Otherwise PAvt1 is assumed.             }
  6.  
  7. type
  8.   ScreenWord = record
  9.                  chr  : char;
  10.                  attr : byte;
  11.                end;
  12.   ScreenPtr = ^Screen;
  13.   Screen = Array[1..25,1..80] of ScreenWord;
  14.  
  15. var
  16.   ScrPtr : ScreenPtr; { for direct screen writes }
  17.  
  18. {$IFDEF VER55}
  19. Function DV_Get_Video_Buffer(vseg:word): word;
  20. begin
  21.   if DESQview_version = 0 then DV_Get_Video_Buffer := vseg
  22.    else
  23.     InLine(
  24.       $b4/$fe/    {  MOV    AH,0FEH          DV's get video buffer function }
  25.       $cd/$10/    {  INT    10H              Returns ES:DI of alt buffer }
  26.       $8c/$c0);   {  MOV    AX,ES            Return video buffer }
  27. end; { DV_Get_Video_Buffer }
  28. {$ELSE}
  29. Function DV_Get_Video_Buffer(vseg:word): word; assembler;
  30. asm                       { Modified by Scott Samet April 1st, 1992 }
  31.   CALL   DESQview_version { Returns AX=0 if not in DV }
  32.   MOV    ES,vseg          { Put current segment into ES }
  33.   TEST   AX,AX            { In DV? }
  34.   JZ     @DVGVB_X         { Jump if not }
  35.   MOV    AH,0FEH          { DV's get video buffer function }
  36.   INT    10H              { Returns ES:DI of alt buffer }
  37. @DVGVB_X:
  38.   MOV    AX,ES            { Return video buffer }
  39. end; { DV_Get_Video_Buffer }
  40. {$ENDIF}
  41.  
  42. Procedure SetScrPtr;
  43. var
  44.   sg : word;
  45. begin
  46.   if LastMode = 7 then sg := $B000
  47.    else sg := $B800;
  48.   sg := DV_Get_Video_Buffer(sg);
  49.   ScrPtr := Ptr(sg,$0000);
  50. end;
  51.  
  52. (* Hooks *)
  53.  
  54. procedure FillWord(var x; count:integer; w:word);
  55. begin
  56.   Inline(
  57.   $c4/$be/x/
  58.   $8b/$86/w/
  59.   $8b/$8e/count/
  60.   $fc/
  61.   $f2/$ab);
  62. (*  LES  DI,x              { load target address }
  63.   MOV  AX,w              { load word to fill in }
  64.   MOV  CX,count          { number of words to move }
  65.   CLD                    { clear direction flag }
  66.   REPNZ STOSW            { copy the data } *)
  67. end;
  68.  
  69. procedure MoveW(var Source, Dest; count:integer); assembler;
  70. asm
  71.   MOV  DX,DS           { Save DS }
  72.   LES  DI,Dest         { Load destination ptr }
  73.   LDS  SI,Source       { load source ptr }
  74.   MOV  CX,Count        { load # of words to move }
  75.   CLD
  76.   CMP  SI,DI           { are they overlapping? }
  77.   JNB  @move           { no, do foward }
  78.   MOV  BX,CX           { yes, do backward }
  79.   SHL  BX,1            { count to bytes }
  80.   DEC  BX              { prep for addition }
  81.   DEC  BX
  82.   ADD  SI,BX           { set them to end of area to move }
  83.   ADD  DI,BX
  84.   STD                  { other direction }
  85. @move:
  86.   REP  MOVSW           { move 'em }
  87.   MOV  DS,DX           { restore DS }
  88. end;
  89.  
  90. procedure GetXY(var x,y:byte);
  91. begin
  92.   x := WhereX;
  93.   y := WhereY;
  94. end;
  95.  
  96. {$F+}
  97. procedure SetXY(x,y:byte);
  98. begin
  99.   GotoXY(x,y);
  100. end;
  101.  
  102. procedure WriteAT(x,y,a:byte;ch:char);
  103. begin
  104.   with ScrPtr^[y,x] do
  105.    begin
  106.      attr := a;
  107.      chr := ch;
  108.    end;
  109. end;
  110.  
  111. procedure FillArea(x1,y1,x2,y2,a:byte;ch:char);
  112. var
  113.   sw : screenword;
  114.   w : byte;
  115. begin
  116.   if x1 > x2 then x1 := x2;
  117.   if y1 > y2 then y1 := y2;
  118.   sw.chr := ch;
  119.   sw.attr := a;
  120.   w := succ(x2-x1);
  121.   for y1 := y1 to y2 do
  122.    FillWord(ScrPtr^[y1,x1],w,word(sw));
  123. end;
  124.  
  125. procedure Scroll(dir,x1,y1,x2,y2,n,a:byte);
  126. var
  127.   t : byte;
  128. begin
  129.   if x1 > x2 then x1 := x2;
  130.   if y1 > y2 then y1 := y2;
  131.   if n = 0 then
  132.    begin
  133.      FillArea(x1,y1,x2,y2,a,' ');
  134.      exit;
  135.    end;
  136.   case dir of
  137.     1 : begin { up }
  138.           if n > succ(y2-y1) then n := succ(y2-y1);
  139.           for t := y1+n to y2 do
  140.            MoveW(ScrPtr^[t,x1], ScrPtr^[t-n,x1], succ(x2-x1)); { move a line }
  141.           FillArea(x1,succ(y2-n),x2,y2,a,' ');
  142.         end;
  143.     2 : begin { down }
  144.           if n > succ(y2-y1) then n := succ(y2-y1);
  145.           for t := y2-n downto y1 do
  146.            MoveW(ScrPtr^[t,x1], ScrPtr^[t+n,x1], succ(x2-x1)); { move a line }
  147.           FillArea(x1,y1,x2,pred(y1+n),a,' ');
  148.         end;
  149.     3 : begin { left }
  150.           if n > succ(x2-x1) then n := succ(x2-x1);
  151.           for t := y1 to y2 do
  152.            MoveW(ScrPtr^[t,x1+n], ScrPtr^[t,x1], succ(x2-(x1+n)));
  153.           FillArea(succ(x2-n),y1,x2,y2,a,' ');
  154.         end;
  155.     4 : begin { right }
  156.           if n > succ(x2-x1) then n := succ(x2-x1);
  157.           for t := y1 to y2 do
  158.            MoveW(ScrPtr^[t,x1], ScrPtr^[t,x1+n], succ(x2-(x1+n)));
  159.           FillArea(x1,y1,pred(x1+n),y2,a,' ');
  160.         end;
  161.   end; { case dir }
  162. end;
  163.  
  164. procedure GetScrChar(x,y:byte;var a:byte;var c:char);
  165. begin
  166.   with ScrPtr^[y,x] do
  167.    begin
  168.      a := attr;
  169.      c := chr;
  170.    end;
  171. end;
  172.  
  173. procedure HighArea(x1,y1,x2,y2,a:byte);
  174. var
  175.   i,j,m : byte;
  176.   c : char;
  177. begin
  178.   if x1 > x2 then x1 := x2;
  179.   if y1 > y2 then y1 := y2;
  180.   for i := x1 to x2 do
  181.    for j := y1 to y2 do
  182.     begin
  183.       GetScrChar(i,j,m,c);
  184.       WriteAT(i,j,a,c);
  185.     end;
  186. end;
  187.  
  188. procedure Pause(tens:word);
  189. begin
  190.   for tens := tens downto 1 do
  191.    begin
  192.      delay(100); { note that delay usually isn't accurate }
  193.      if KeyPressed then tens := 1; { abort the pause }
  194.    end;
  195. end;
  196.  
  197. Procedure ShapeCursor(typ:byte);
  198.  
  199.  procedure SetCursor(shape:word);
  200.  begin
  201.    Inline($b4/$01/        { MOV  AH, 01    }
  202.           $8b/$8e/shape/  { MOV  CX, shape }
  203.           $cd/$10);       { INT  10h       }
  204.  end;
  205.  
  206. begin
  207.   case typ of
  208.     NormCursor   : SetCursor(Def_Cursor);
  209.     BigCursor    : if lo(Def_Cursor) > 7 then SetCursor($000e)
  210.                     else SetCursor($0007);
  211.     HiddenCursor : SetCursor($0100);
  212.   end;
  213. end;
  214.  
  215. {$F-}
  216.  
  217. (* End Hook Definitions *)
  218.  
  219. procedure SetHooks;
  220. begin
  221. { Query_Hook := <defualt null hook for this application> }
  222.   Pauseh := Pause;
  223.   HighAreah := HighArea;
  224.   GetATh := GetScrChar;
  225.   FillAreah := FillArea;
  226.   Scrollh := Scroll;
  227.   GotoXYh := SetXY;
  228.   WriteATh := WriteAT;
  229. { FlushInputh := <Defualt Zero keyboard buffer hook is fine> }
  230.   Cursorh := ShapeCursor;
  231. end;
  232.  
  233.