home *** CD-ROM | disk | FTP | other *** search
/ Power Programming / powerprogramming1994.iso / progtool / microcrn / issue_33.arc / SYSTEM.FIG < prev   
Text File  |  1986-11-20  |  7KB  |  211 lines
  1.  
  2. type
  3.   RegisterRecord = 
  4.     record case integer of
  5.       1:(AX,    BX,    CX,    DX,  BP,SI,DI,DS,ES,Flags: integer);
  6.       2:(AL,AH, BL,BH, CL,CH, DL,DH: byte);
  7.     
  8.  
  9. type
  10.   game = record
  11.     TeamName: string[30];
  12.     case sport: (baseball, football) of
  13.       baseball: (inning: integer;
  14.                  runs, hits, errors: integer;
  15.                  BaseballTactics: (bunt, slide, steal, 
  16.                                    badger, eject, homerun));
  17.       football: (quarter: integer;
  18.                  points: integer;
  19.                  penalties: integer;
  20.                  FootballTactics: (kill, maim, sack, charge,
  21.                                    trap, bomb, tackle, block));
  22.   end; { game }
  23.  
  24. {========}
  25.  
  26. FUNCTION DiskSpaceFree: integer;
  27. var
  28.   Registers : RegisterRecord;
  29.   Tracks, Sectors, BytesPerSector : integer;
  30. begin
  31.   with Registers do
  32.   begin
  33.     fillchar( Registers, sizeof( Registers ), 0 );       
  34.     AH:= $36;                             { function number }
  35.     DL:= 0;                               { choose LPT1 }
  36.     MSDOS( Registers );                   { make service call }
  37.     Tracks:= BX;
  38.     Sectors:= AX;
  39.     BytesPerSector:= CX;
  40.     if AX = $FFFF then DiskSpaceFree:= AX 
  41.       else DiskSpaceFree:= round( Sectors * BytesPerSector/1024.0 * Tracks );
  42.   end;
  43. end;  { DiskSpaceFree }
  44.  
  45. {========}
  46.  
  47. FUNCTION PrinterReady: boolean;
  48. var
  49.   Status : byte;
  50.   Registers : RegisterRecord;
  51. begin
  52.   fillchar( Registers, sizeof( Registers ), 0 );
  53.   with Registers do
  54.   begin
  55.     AH:= $01;                             { code to reset the printer }
  56.     DL:= $00;                             { printer number, 0 = LPT1 }
  57.     Intr( $17,Registers );                { call printer interrupt }
  58.     AH:= $02;                             { code for get the printer status }
  59.     DL:= $00;                             { printer number, 0 = LPT1 }
  60.     intr( $17,Registers );                { call printer interrupt }
  61.     Status:= AH;
  62.   end;
  63.   PrinterReady:= not Odd( Status shr 4 ); { test bit 4 }
  64. end;  { PrinterReady }
  65.  
  66. {========}
  67.  
  68. { Note that there is no check in the procedure below to insure that the text
  69.   of the line will not wrap around to the next line; it is assumed that the
  70.   line will fit.  Note also that the use of the Turbo whereX and whereY 
  71.   functions assumes that the entire screen is being used.  If you wish to use
  72.   this procedure with windows, it will be necessary to subtract the first
  73.   column number of the window from whereX and the first line number from  
  74.   whereY in order to calculate the offset. } 
  75.  
  76. type
  77.   string255 = string[255];
  78.  
  79. PROCEDURE SpeedWrite( Line : string255 );
  80. const
  81.   ScreenSegment = $B800;     { for color card, change to $B000 for monochrome }
  82. var
  83.   Offset, i : integer;
  84. begin
  85.   Offset:= pred( whereX )*2 + pred( whereY )*160;   { calculate mem. location }
  86.   for i:= 1 to length( Line ) do
  87.   begin
  88.     Mem[ ScreenSegment:Offset ]:= ord( Line[i] );        { set character byte }
  89.     Offset:= Offset + 2;                                { skip attribute byte }
  90.   end;
  91.   gotoXY( whereX + length( Line ), whereY );     { move cursor to end of line }
  92. end;  { SpeedWrite }
  93.  
  94. {========}
  95.  
  96. { This procedure swaps the colors of the character and the background at the
  97.   current cursor position, which effectively toggles reverse video on and off }
  98.  
  99. PROCEDURE InvertCharacter;
  100. var
  101.   Registers : RegisterRecord;
  102. begin
  103.   fillchar( Registers, sizeof( Registers ), 0 );
  104.   with Registers do
  105.   begin
  106.     AH:= 8;        { code for read character and attribute at cursor location }
  107.     BH:= 0;                     { video page number, 0 = normally active page }
  108.     intr( $10,Registers );                             { call video interrupt }
  109.     BL:= (AH shr 4) and $07 + (AH and $07) shl 4 + (AH and $08);  { do invert }
  110.     BH:= 0;                                     { video page number, as above }
  111.     AH:= 9;                          { code for write character and attribute }
  112.     CX:= 1;                                   { number of characters to write }
  113.     intr( $10,Registers );                             { call video interrupt }
  114.   end;
  115. end;  { InvertCharacter }
  116.  
  117. {========}
  118.  
  119. { The following procedure will set the DTA to the memory location 
  120. defined by the values Segment and Offset.  All subsequent disk 
  121. read and write data will be buffered at the new DTA, where you 
  122. can look at it and modify it if you like.  Remember that the DTA 
  123. must be at least as large as the size of one sector.  Default DTA 
  124. is located at 80h in the program segment prefix. } 
  125.  
  126. PROCEDURE SetDataTransferArea( Segment, Offset : integer );
  127. var
  128.   Registers : RegisterRecord;
  129. begin
  130.   fillchar( Registers, sizeof( Registers ), 0 );
  131.   with Registers do
  132.   begin
  133.     AH:= $1A;               { function code for set DTA }
  134.     DS:= Segment;           { segment portion of address }
  135.     DX:= Offset;            { offset portion of address }
  136.     MSDos( Registers );     { make service call }
  137.   end;
  138. end;  { SetDataTransferArea }
  139.  
  140. {========}
  141.  
  142. { The following function returns the disk type of the drive number passed to
  143.   it, where fixed disk = F8h, quad density = F9h, SS 9 sector = FCh,
  144.   DS 9 sector = FDh, SS 8 sector = FEh, and DS 8 sector = FFh. }
  145.  
  146. PROCEDURE DiskType( Drive : byte );
  147. var
  148.   Registers : RegisterRecord;
  149. begin
  150.   fillchar( Registers, sizeof( Registers ), 0 );
  151.   with Registers do
  152.   begin
  153.     AH:= $1C;                 { function code for get FAT information }
  154.     DL:= Drive;               { disk drive number, 0= Default, 1= A, etc. }
  155.     MsDos( Registers );       { make service call }
  156.     DiskType:= Mem[ DS:BX ];
  157.   end;
  158. end;  { DiskType }
  159.  
  160. {========}
  161.  
  162. { The function below returns the number of the currently logged drive, where
  163.   for consistency's sake (0 often refers to the default drive) 1 = A, 2 = B,
  164.   and so on. }
  165.  
  166. FUNCTION CurrentDrive : byte;
  167. var
  168.   Registers : RegisterRecord;
  169. begin
  170.   fillchar( Registers, sizeof( Registers ), 0 );
  171.   with Registers do
  172.   begin
  173.     AH:= $19;                    { function code for get current drive number }
  174.     MsDos( Registers );          { make service call }
  175.     CurrentDrive:= succ( AL );   { 1 = A, 2 = B, etc. }
  176.   end;
  177. end;  { CurrentDrive }
  178.  
  179. {========}
  180.  
  181. { The following procedure will turn the cursor on or off }
  182.  
  183. PROCEDURE TurnCursor( State : boolean );
  184. const
  185.   Visible = 0;
  186.   Invisible = 1;
  187.   StartLine : integer = $06;      { start and end lines should be changed }
  188.   EndLine : integer = $07;        { for monochrome cards }
  189.   CursorType : integer = $00;
  190. begin
  191.   fillchar( Registers, sizeof( Registers ), 0 );
  192.   with Registers do
  193.   begin
  194.     case State of
  195.       false : begin                                  { blanks cursor }
  196.                 CursorType:= Invisible;
  197.                 CH:= CursorType shl 5 + StartLine;
  198.                 CL:= EndLine;
  199.               end;
  200.       true  : begin                                  { sets cursor on }
  201.                 CursorType:= Visible;
  202.                 CH:= CursorType shl 5 + StartLine;
  203.                 CL:= EndLine;
  204.               end;
  205.     end;  { of case statement }
  206.     AH:= $01;                                        { code for set cursor }
  207.     intr( $10, Registers );                          { call video interrupt }
  208.   end;
  209. end;  { TurnCursor }
  210.  
  211.