home *** CD-ROM | disk | FTP | other *** search
/ BURKS 2 / BURKS_AUG97.ISO / BURKS / SOFTWARE / LIBS / TESS110.ZIP / TSDAYTIM.PAS (.txt) < prev    next >
Pascal/Delphi Source File  |  1988-07-03  |  18KB  |  512 lines
  1. {****************************************************************************
  2.  * TSDAYTIM.PAS -- Turbo Pascal 4.0 demonstration program
  3.  ***************************************************************************
  4.  SUBTTL    TesSeRact Revision Level 1
  5.  ;--------------------------------------------------------------------------
  6.  ;   TesSeRact(tm) -- A Library of Routines for Creating Ram-Resident (TSR)
  7.  ;                    programs for the IBM PC and compatible Personal
  8.  ;                    Computers.
  9.  ;
  10.  ;The software, documentation and source code are: 
  11.  ; 
  12.  ;    Copyright (C) 1986, 1987, 1988 Tesseract Development Team
  13.  ;    All Rights Reserved 
  14.  ; 
  15.  ;    c/o Chip Rabinowitz
  16.  ;    Innovative Data Concepts
  17.  ;    2084 Woodlawn Avenue
  18.  ;    Glenside, PA 19038
  19.  ;    1-215-884-3373
  20.  ;
  21.  ;--------------------------------------------------------------------------
  22.  ;   This product supports the TesSeRact Standard for Ram-Resident Program 
  23.  ;   Communication.  For information about TesSeRact, contact the TesSeRact 
  24.  ;   Development Team at:
  25.  ;       Compuserve:    70731,20
  26.  ;       MCIMAIL:       315-5415
  27.  ;   This MCIMAIL Account has been provided to the TesSeRact Development
  28.  ;   Team by Borland International, Inc.  The TesSeRact Development Team
  29.  ;   is in no way associated with Borland International, Inc.
  30.  ;--------------------------------------------------------------------------}
  31.  
  32. PROGRAM TSDayTim;      { Copyright 1988 TesSeRact Development Team      }
  33. {$R-,S-,I-,D+,T+,F-,V-,B-,N-,L+ }
  34. {$M 1024,0,0 }          { this line needed to reduce stack and heap!      }
  35. Uses DOS, CRT, TESSTP;      { program redone 02-24-88, Jim Kyle, for RDT      }
  36. {*************************************************************************
  37.  *  This program is a VERY simple-minded TSR that merely displays the     *
  38.  *  time and date in the top RH corner, and which can also pop up and     *
  39.  *  remove itself from memory.    All of the fancy frills (snow-free write *
  40.  *  to CGA screens, full compatibility with EGA/VGA modes, file I/O, and *
  41.  *  the like) have been left out, to concentrate on those actions which  *
  42.  *  are REQUIRED to interface TesSeRact with Turbo Pascal 4 programs.     *
  43.  *************************************************************************}
  44.  
  45.               { first we declare constants and such.......      }
  46. CONST
  47.   MAXVIDSIZE =     2000 ;         { TP4 version only uses 80x25      }
  48.   MONONORM =     $07 ;
  49.   MONOREV =     $70 ;
  50.  
  51. VAR
  52.  savescreen : array [1..MAXVIDSIZE] of word ;
  53.                     { buffer to save screen image      }
  54.  NormAtt,                { Default Normal Attribute      }
  55.  RevAtt,                { Default Reverse Attribute      }
  56.  curmode,                { Current video mode          }
  57.  oldcur,                { Old Cursor shape          }
  58.  oldpos : word;             { Old Cursor position          }
  59.  biosvid : pointer;            { Pointer to video buffer      }
  60.  BackStack : array [0..1023] of char;    { Stack area for BackGround      }
  61.  buffer : array [0..17] of byte ;    { work buffer for date/time format}
  62.  BackFlag : word;            { Background flag to signal      }
  63.                     {   additional processing      }
  64.  idnum,                 { TSR Identification Number      }
  65.  hours,                 { Current hour of day          }
  66.  mins,                    { Current minute of hour      }
  67.  secs,                    { Current seconds of minute      }
  68.  yr,                    { for date report          }
  69.  mon,
  70.  day,
  71.  ticks : word;                { Timer-tick counter          }
  72.  regs  : registers;            { workspace for INTR interfaces   }
  73.  
  74. {***********************************************************
  75.  *  Video Support Routines                   *
  76.  *********************************************************CR}
  77.  
  78. PROCEDURE c_str( row : integer; str : string );
  79.                     { Print a string, centered      }
  80.   VAR
  81.     wid : integer;            { temporary width variable      }
  82.   BEGIN
  83.     wid := (80 - length(str)) SHR 1;    { calculate cursor position      }
  84.     gotoxy(wid, row);            { go there              }
  85.     write(str);             { display the string          }
  86.   END;
  87.  
  88. PROCEDURE getscrn;            { very primitive screen saver      }
  89.   BEGIN                 { WILL snow with CGA...       }
  90.     move( biosvid^, savescreen, sizeof(savescreen) );
  91.   END;
  92.  
  93. PROCEDURE putscrn;            { very primitive screen restore   }
  94.   BEGIN                 { WILL snow with CGA...       }
  95.     move( savescreen, biosvid^, sizeof(savescreen) );
  96.   END;
  97.  
  98. PROCEDURE SaveCursor;            { save current cursor size and      }
  99.   BEGIN                 {   position              }
  100.     Regs.AH := 3;            { Get Cursor Position          }
  101.     Regs.BH := 0;
  102.     Intr( $10, Regs );
  103.     oldpos := Regs.DX;            { Save return values          }
  104.     oldcur := Regs.CX;
  105.                     { known bug on some monochrome      }
  106.                     {   adapters reports the wrong      }
  107.                     {   cursor shape when both color  }
  108.                     {   and monochrome systems are      }
  109.                     {   installed.              }
  110.     IF( (curmode = MONO) AND  (oldcur = $0607) ) THEN
  111.     oldcur := $0c0d;
  112.     Regs.AH := 1;
  113.     Regs.CX := $ffff;
  114.     Intr( $10, Regs );
  115.   END;
  116.  
  117. PROCEDURE RestoreCursor;        { restore saved cursor position   }
  118.   BEGIN                 {   and size              }
  119.     Regs.AH := 2;            { restore saved position      }
  120.     Regs.BH := 0;
  121.     Regs.DX := oldpos;
  122.     Intr( $10, Regs );
  123.     Regs.AH := 1;            { restore saved cursor type      }
  124.     Regs.BH := 0;
  125.     Regs.CX := oldcur;
  126.     Intr( $10, Regs );
  127.   END;
  128.  
  129. {****************************< FixRows         >******************************
  130. *                                        *
  131. *          Determine current video mode and set it up            *
  132. *          ------------------------------------------            *
  133. *                                        *
  134. *   This function determines the current video mode at popup time, and        *
  135. *    if it is one of the four text modes sets to 80 columns, the        *
  136. *    default color scheme, and initializes the video RAM pointer.        *
  137. *   Note that this program does NOT restore to 40-column mode after popping *
  138. *    up; that, like de-snowing the video, is left for you to program.    *
  139. *                                        *
  140. *   Parameters:                                 *
  141. *    None                                    *
  142. *                                        *
  143. *   Returns:                                    *
  144. *    None                                    *
  145. *                                        *
  146. *************************************************************************CR}
  147.  
  148. PROCEDURE fixrows;            { Re-initialize current video      }
  149.   BEGIN                 {   information for new instance  }
  150.                     {   of video usage          }
  151.     curmode := word( mem[$40:$49] );    { Get current mode at popup      }
  152.     CASE (curmode) OF            { deal with text modes          }
  153.       BW40:
  154.     BEGIN
  155.       textmode(BW80);        { we need 80 columns          }
  156.       NormAtt := MONONORM;        { use Monochrome Attributes      }
  157.       RevAtt := MONOREV;
  158.     END;
  159.       BW80, MONO:
  160.     BEGIN
  161.       NormAtt := MONONORM;        { use Monochrome Attributes      }
  162.       RevAtt := MONOREV;
  163.     END;
  164.       C40:
  165.     BEGIN
  166.       textmode(C80);        { we need 80 columns          }
  167.                     { use Color attributes          }
  168.       NormAtt := (YELLOW + (BLUE SHL  4)) ;
  169.       RevAtt := (WHITE + (RED SHL  4)) ;
  170.     END;
  171.       C80:
  172.     BEGIN                { use Color attributes          }
  173.       NormAtt := (YELLOW + (BLUE SHL  4)) ;
  174.       RevAtt := (WHITE + (RED SHL  4)) ;
  175.     END;
  176.       END;
  177.  
  178.     IF(curmode = MONO) THEN        { If monochrome ....          }
  179.       biosvid := ptr($b000,124)     { ... set pointer          }
  180.     else                { That means color ....       }
  181.       biosvid := ptr($b800,124);    { ... so set pointer          }
  182.   END;
  183.  
  184. {****************************< SizeOfCode    >******************************
  185. *                                        *
  186. *          Determine size of program to keep resident            *
  187. *          ------------------------------------------            *
  188. *                                        *
  189. *   This function is an example of a function that can be used to determine *
  190. *    the size of the TSR that is to remain resident.  For use with TP4,  *
  191. *    no parameters are supplied and the value is like that for ALLHEAP   *
  192. *    with MSC 5.0 or Turbo C 1.5; the stack is below the heap and the    *
  193. *    entire heap and stack are counted in the value.             *
  194. *                                        *
  195. *   Parameters:                                 *
  196. *    None                                    *
  197. *                                        *
  198. *   Returns:                                    *
  199. *    Number of 16-byte paragraphs of memory to keep when going resident. *
  200. *                                        *
  201. *************************************************************************CR}
  202.  
  203. FUNCTION SizeOfCode : word;
  204.   VAR
  205.     used : word;
  206.   BEGIN
  207.   used := Seg(HeapPtr^) - PrefixSeg;    { these are built-ins for TP4..   }
  208.   SizeOfCode := used;            { return number of paragraphs      }
  209. END;
  210.  
  211. {****************************< do_cpyrt      >******************************
  212. *                                        *
  213. *            Display Copyr