home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / PASCAL / IOSTUFF.ZIP / IOSTUFF.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1985-12-28  |  7.2 KB  |  300 lines
  1. {$INCLUDE:'IOSTUFF.INC'}
  2. IMPLEMENTATION OF IOSTUFF;
  3. PROCEDURE INTRPT(NUMBER:BYTE; VAR AX,BX,CX,DX: WORD); EXTERN;
  4.  
  5. VAR    AXR,BXR,CXR,DXR: word;
  6.     Mode: Modes;
  7.     line: Lines;
  8.     column: Columns;
  9.  
  10. PROCEDURE GetMode;   {Read the CRT mode status}
  11.  
  12. BEGIN
  13.     AXR:=Byword(15,0);
  14.     INTRPT(#10,AXR,BXR,CXR,DXR);
  15.     Mode:=ord(lobyte(AXR));
  16. END;
  17.  
  18. PROCEDURE SetMode;  {Set CRT mode status:
  19.              0 = 40x25 B & W      1 = 40x25 Color
  20.              2 = 80x25 B & W      3 = 80x25 Color
  21.              4 = 320x200 Color      5 = 320x200 B & W
  22.              6 = 640x200 B & W      7 = Monochrome    }
  23. BEGIN
  24.     AXR:=Byword(0,Mode);
  25.     INTRPT(#10,AXR,BXR,CXR,DXR);
  26. END;
  27.  
  28. PROCEDURE CursorSize;       {Set cursor size.  Lines are 0-13 in Monochrome}
  29.                {mode and 0-7 in Color mode.           }
  30. VAR    maxlines: integer;
  31.  
  32. BEGIN
  33.     GetMode(Mode);
  34.     if (mode=7) then
  35.       maxlines:=13
  36.     else
  37.       maxlines:=7;
  38.     if top <= maxlines then
  39.     begin
  40.       bottom:=maxlines-bottom;
  41.       top:=maxlines-top;
  42.       AXR:=byword(1,0);
  43.       CXR:=byword(top,bottom);
  44.       INTRPT(#10,AXR,BXR,CXR,DXR);
  45.     end
  46. END;
  47.  
  48. PROCEDURE CursorOff;        {Turn cursor off completely}
  49.                 {by setting bit 6 in CH.   }
  50. BEGIN
  51.     AXR := byword(1,0);
  52.     CXR := byword(32,0);
  53.     INTRPT(#10,AXR,BXR,CXR,DXR);
  54. END;
  55.  
  56. PROCEDURE PutCursor;    {Place cursor on the screen at Line, Column.}
  57.  
  58. BEGIN
  59.     AXR:=BYWORD(2,0);
  60.     BXR:=BYWORD(0,0);
  61.     DXR:=BYWORD(Line-1,Column-1);
  62.     INTRPT(#10,AXR,BXR,CXR,DXR);
  63. END;
  64.  
  65. PROCEDURE FindCursor;         {Find Line, Column of current cursor position.}
  66.  
  67. BEGIN
  68.     AXR:=ByWord(3,0);
  69.     BXR:=Byword(0,0);
  70.     INTRPT(#10,AXR,BXR,CXR,DXR);
  71.     Line:=ord(HiByte(DXR))+1;
  72.     Column:=ord(LoByte(DXR))+1;
  73. END;
  74.  
  75. PROCEDURE ClearScreen;          {Clear the whole screen to blanks.}
  76.  
  77. BEGIN
  78.     AXR:=BYWORD(6,0);
  79.     BXR:=BYWORD(7,0);
  80.     CXR:=BYWORD(0,0);
  81.     DXR:=BYWORD(24,79);
  82.     INTRPT(#10,AXR,BXR,CXR,DXR);
  83. END;
  84.  
  85. PROCEDURE ClearLine;        {Clear out one line to blanks.  Given the }
  86.                 {line number, cursor position not changed.}
  87. const  blank = '                                                                                 ';
  88. var  xline: lines;
  89.      xcol : columns;
  90.  
  91. BEGIN
  92.     Findcursor(xLine,xCol);
  93.     PutCursor(Line,1);
  94.     write(blank);
  95.     PutCursor(xLine,xCol);
  96. END;
  97.  
  98. PROCEDURE ClearEOL;       {Clear to end of current line.}
  99.  
  100. VAR   J,I: INTEGER;
  101.  
  102. BEGIN
  103.     FindCursor(Line,Column);
  104.     J:=Column+1;
  105.     For i:= j to 81 do
  106.     write(' ');
  107.     PutCursor(Line,Column);
  108. END;
  109.  
  110. PROCEDURE ClearEOP;       {Clear everything after current line}
  111.                {with blanks, to bottom of screen.  }
  112. BEGIN
  113.     FindCursor(Line,Column);
  114.     AXR:=BYWORD(6,0);
  115.     BXR:=BYWORD(7,0);
  116.     CXR:=BYWORD(Line,0);
  117.     DXR:=BYWORD(24,79);
  118.     INTRPT(#10,AXR,BXR,CXR,DXR);
  119. END;
  120.  
  121. PROCEDURE ClearField;         {Clear a designated field with blanks.}
  122.                  {Parameters are Line, Column of upper-}
  123. var  xLine: Lines;         {left corner of field, Width of field }
  124.      xCol : Columns;         {and depth of field in lines.       }
  125.      rCol : Columns;
  126.      bLine: Lines;
  127.  
  128. BEGIN
  129.     Findcursor(xLine,xCol);
  130.     AXR:=BYWORD(6,0);
  131.     BXR:=BYWORD(07,0);
  132.     CXR:=BYWORD(Line-1,Column-1);
  133.     rCol:=Column+Width-1;
  134.     if rCol>80 then rCol:=80;
  135.     bLine:=Line+Height-1;
  136.     if bLine>25 then bline:=25;
  137.     DXR:=BYWORD(bLine,rCol);
  138.     INTRPT(#10,AXR,BXR,CXR,DXR);
  139.     PutCursor(xLine,xCol);
  140.  
  141. END;
  142.  
  143. PROCEDURE ScrollUp;       {Scroll entire screen up one line}
  144.                {filling bottom line with blanks.}
  145. BEGIN
  146.  
  147.     AXR:=BYWORD(6,1);
  148.     BXR:=BYWORD(7,0);
  149.     CXR:=BYWORD(0,0);
  150.     DXR:=BYWORD(24,79);
  151.     INTRPT(#10,AXR,BXR,CXR,DXR);
  152.  
  153. END;
  154.  
  155. PROCEDURE ScrollDn;       {Scroll entire screen down one line}
  156.                {filling top line with blanks.     }
  157. BEGIN
  158.  
  159.     AXR:=BYWORD(7,1);
  160.     BXR:=BYWORD(7,0);
  161.     CXR:=BYWORD(0,0);
  162.     DXR:=BYWORD(24,79);
  163.     INTRPT(#10,AXR,BXR,CXR,DXR);
  164.  
  165. END;
  166.  
  167. PROCEDURE ScrollField;          {Scroll a designated window of the}
  168.                   {screen up or down a given number }
  169. var    bLine: Lines;          {of lines.            }
  170.     rCol : Columns;
  171.  
  172. BEGIN
  173.  
  174.     AXR:=BYWORD(Direction+5,Number);
  175.     BXR:=BYWORD(7,0);
  176.     CXR:=BYWORD(Line-1,Column-1);
  177.     rCol:=Column+width-1;
  178.     bLine:=Line+height-1;
  179.     DXR:=BYWORD(bLine-1,rCol-1);
  180.     INTRPT(#10,AXR,BXR,CXR,DXR);
  181.  
  182. END;
  183.  
  184. PROCEDURE SetAttr;      {Set the attribute byte for an area on the}
  185.               {screen.  Parameters are Attribute type,  }
  186. VAR    ch : byte;      {Blink type, Underline type and length.   }
  187.     attribute,count,AB : integer;
  188.  
  189. BEGIN
  190.   count:=0;
  191.   case attr of
  192.     Normal: attribute := #07;
  193.     Reverse: attribute := #70;
  194.     HiLite: attribute := #0F;
  195.     NoDisp: attribute := #00;
  196.   end;
  197.   if aul = ULine then
  198.     attribute := #01;
  199.   if ABlink = Blink then
  200.     AB := #80
  201.   else
  202.     ab := #00;
  203.   attribute := attribute or AB;
  204.   for count := 1 to len do
  205.     begin
  206.       putcursor(line,column);
  207.       AXR:=byword(8,0);
  208.       BXR:=byword(0,0);
  209.       intrpt(#10,AXR,BXR,CXR,DXR);
  210.       ch:=lobyte(AXR);
  211.       AXR:=byword(9,ch);
  212.       BXR:=byword(0,attribute);
  213.       CXR:=byword(0,1);
  214.       intrpt(#10,AXR,BXR,CXR,DXR);
  215.       if column = 80 then
  216.     begin
  217.       line:=line+1;
  218.       column:=1;
  219.     end
  220.       else
  221.     column:=column+1;
  222.     end;
  223. end;
  224.  
  225. PROCEDURE WriteLine;        {Write a string of characters sequentially    }
  226.                 {on the screen.  Can be any length up to    }
  227. BEGIN                {the end of the screen.  Length not checked.}
  228.     Putcursor(Line,Column);
  229.     AXR := byword(9,0);
  230.     Concat(txt,'$');
  231.     DXR := wrd(adr txt[1]);
  232.     INTRPT(#21,AXR,BXR,CXR,DXR);
  233. END;
  234.  
  235. PROCEDURE GetStatus;        {Get the current diskette drive status.}
  236.                 {Returns Drive, Side, Track and Sector }
  237. BEGIN                {of last read performed by system.       }
  238.     AXR := byword(1,0);
  239.     INTRPT(#13,AXR,BXR,CXR,DXR);
  240.     Drv := ord(lobyte(DXR));
  241.     Side := ord(hibyte(DXR));
  242.     Trk := ord(hibyte(CXR));
  243.     Sect := ord(lobyte(CXR));
  244. END;
  245.  
  246.  
  247. PROCEDURE GetDefault;         {Returns the default drive of the system}
  248.  
  249. BEGIN
  250.     AXR := byword(25,0);
  251.     INTRPT(#21,AXR,BXR,CXR,DXR);
  252.     Default := ord(lobyte(AXR));
  253. END;
  254.  
  255.  
  256. PROCEDURE ReadSector;         {Read the sector desired, given Drive,}
  257.                  {Side, Track and Sector and given the }
  258. BEGIN                 {pointer to a buffer in which to store}
  259.     AXR := byword(2,1);  {the requested sector.           }
  260.     BXR := wrd(BufPtr);
  261.     CXR := byword(trk,sect);
  262.     DXR := byword(side,drv);
  263.     INTRPT(#13,AXR,BXR,CXR,DXR);
  264. END;
  265.  
  266. PROCEDURE WriteSector;          {Write the sector desired to disk, given}
  267.                   {Drive, Side, Track and sector and the  }
  268. BEGIN                  {pointer to the buffer containing the   }
  269.     AXR := byword(3,1);   {data to be written to the sector.      }
  270.     BXR := wrd(BufPtr);
  271.     CXR := byword(trk,sect);
  272.     DXR := byword(side,drv);
  273.     INTRPT(#13,AXR,BXR,CXR,DXR);
  274. END;
  275.  
  276. PROCEDURE GetKey;     {Get the next keypress from the buffer}
  277.  
  278. BEGIN
  279.     AXR := byword(0,0);
  280.     INTRPT(#16,AXR,BXR,CXR,DXR);
  281.     Key := lobyte(AXR);
  282.     Scan := hibyte(AXR);
  283. END;
  284.  
  285. PROCEDURE GetShift;    {Return the current shift status of the keyboard}
  286.          {Insert active = 80H | Alt-Shift    = 08H | Insert-Shift  = 80H}
  287.          {Caps lock     = 40H | Ctl-Shift    = 04H | Caps-Shift    = 40H}
  288.          {Numlock        = 20H | Left Shift    = 02H | Num-Shift     = 20H}
  289.          {Scroll Lock   = 10H | Right Shift = 01H | Scroll-Shift  = 10H}
  290.          {              | Hold State    = 08H |            }
  291.          {See Technical Ref Manual for further explanations of states  }
  292. BEGIN
  293.    AXR := byword(2,0);
  294.    INTRPT(#16,AXR,BXR,CXR,DXR);
  295.    Shift := lobyte(AXR);
  296. END;
  297.  
  298. END.
  299.  
  300.