home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / timer / ticker / ticker.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1990-05-17  |  12.6 KB  |  372 lines
  1. {$A-,B-,D-,E-,F-,I-,L-,N-,O-,R-,S-,V-}
  2. {$M 1536,0,655360}   {increased stack from 1024 to 1536; ver 1.01}
  3. program ticker;                   {ticker tape display of a 25 line text file}
  4.  
  5.   {*******************************************************}
  6.   {*                   Ticker.pas                        *}
  7.   {*                  Version 1.01                       *}
  8.   {*                                                     *}
  9.   {*                                                     *}
  10.   {*       TSR that will display up to 25 lines          *}
  11.   {*       of text in a continuous "Ticker-Tape"         *}
  12.   {*       stream. Ticker gets its input from a          *}
  13.   {*       disk based ascii text file and has the        *}
  14.   {*       ability to automatically update its           *}
  15.   {*       display with changed data. The display        *}
  16.   {*       stream can be sized and positioned any-       *}
  17.   {*       where on the screen through command line      *}
  18.   {*       switches. If the input file is deleted,       *}
  19.   {*       Ticker will stop displaying the stream        *}
  20.   {*       when it tries to check the file's time        *}
  21.   {*       stamp but will continue looking for the       *}
  22.   {*       file indefinitely.                            *}
  23.   {*                                                     *}
  24.   {*       This feature could be used as a message       *}
  25.   {*       passing utility in a network environment.     *}
  26.   {*                                                     *}
  27.   {*       The following command line switches           *}
  28.   {*       are available:                                *}
  29.   {*                                                     *}
  30.   {*   DEFAULT   RANGE    DESCRIPTION                    *}
  31.   {*                                                     *}
  32.   {*    /R1      1..25    Row                            *}
  33.   {*    /C1      1..79    Left column                    *}
  34.   {*    /W80     2..80    Width                          *}
  35.   {*    /S5      1..9     Display Speed                  *}
  36.   {*    /T7      1..255   Text Color                     *}
  37.   {*    /D60     1..999   File Check Delay in seconds    *}
  38.   {*                                                     *}
  39.   {*   Revision History                                  *}
  40.   {*   1.01     Increased stack size and put Ticker      *}
  41.   {*            to sleep when the text file is not       *}
  42.   {*            available at startup. Bob Aman           *}
  43.   {*                                                     *}
  44.   {*                                                     *}
  45.   {*                                                     *}
  46.   {*                                                     *}
  47.   {*******************************************************}
  48.  
  49.  
  50. uses
  51.   dos,
  52.   tpcrt,
  53.   tpint,
  54.   tptsr;
  55.  
  56. const
  57.   credits1 =
  58.   'Ticker        version 1.01  Copyright (c) by Bob Aman 1990,      CSI 72727,3245';
  59.   delimit        : string = '  '; {displayed line delimiter}
  60.   row            : integer = 1;   {display row; 1..25}
  61.   col            : integer = 1;   {display column; left edge; 1..79}
  62.   width          : integer = 80;  {display width; 1..80}
  63.   numofrows      : integer = 1;   {display size; 1}
  64.   speed          : integer = 5;   {display speed; 1..9}
  65.   attr           : integer = 7;   {Text color; 1..255}
  66.   fdelay         : integer = 60;  {check file delay; 1..999 seconds}
  67.   shutdown       : boolean = false; {disable if no input file}
  68.   ln             : byte = 1;      {file line number}
  69.   maxlines       = 26;            {max lines readin from a file}
  70.   fname          : string = '';   {input file name declaration}
  71.   pname          : string = 'ticker'; {program id; so tsr won't be loaded twice}
  72.   timerint       : byte = $1C;    {timer control interrupt}
  73.   busy           : boolean = false; {true if we are doing something}
  74.   int_handle     = $10;           {our handle; used for tsr management}
  75.   ctrlaltu       : word = $0C16;  {hot key to unload us; <CtrlAlt-U>}
  76.   altt           : word = $0814;  {hot key to ???; <Alt-T>}
  77.  
  78.  
  79. var
  80.   linebuff       : array[1..maxlines] of string[85]; {textfile line input}
  81.   displaybuff    : string;        {displayed text}
  82.   linelen        : array[1..maxlines] of byte; {textfile line length}
  83.   opspeed,                        {display speed}
  84.   ticks          : word;          {timer tick count}
  85.   i,                              {general purpose counter}
  86.   charcount,                      {number of chars to append in one display cycle}
  87.   count          : byte;          {current position in linebuff}
  88.   origint        : pointer;       {original interrupt address}
  89.   tickerpophandle : byte;         {handle for our display routine}
  90.   rowcol         : word;          {absolute coord. of cursor before we grab it}
  91.   saverow,                        {cursor row before we grab it}
  92.   savecol        : byte;          {cursor column before we grab it}
  93.   infile         : text;          {text file to display}
  94.   filetime,                       {used to get infile time stamp}
  95.   savetime       : longint;       {stores the time stamp of the file were showing}
  96.   linesread      : byte;          {number of lines read in}
  97.   timechanged    : boolean;       {true if filetime <> savetime}
  98.   fticks,                         {tick counter for checking time stamp}
  99.   checkftimedelay : longint;      {delay for checking time stamp in ticks}
  100.  
  101.  
  102.   procedure loaddata;
  103.   var
  104.     i              : word;
  105.     instr          : string;
  106.   begin
  107.     assign(infile, fname);
  108.     {$I-}
  109.     reset(infile);
  110.     {$I+}
  111.     if ioresult = 0 then
  112.     begin
  113.       fillchar(linebuff, sizeof(linebuff), #0);
  114.       getftime(infile, savetime);
  115.       linesread := 1;
  116.       instr := '';
  117.       displaybuff := '';          {clear the display line}
  118.       while (linesread < maxlines) and (not eof(infile)) do
  119.       begin
  120.         readln(infile, instr);
  121.         linebuff[linesread] := delimit + copy(instr, 1, 80);
  122.         inc(linesread);
  123.       end;
  124.       timechanged := false;
  125.       close(infile);
  126.       for i := 1 to linesread do
  127.         linelen[i] := length(linebuff[i]);
  128.       ln := 1;
  129.       count := 1;
  130.     end
  131.   end;
  132.  
  133.   procedure checkftime;
  134.   begin
  135.     assign(infile, fname);
  136.     {$I-}
  137.     reset(infile);
  138.     {$I+}
  139.     if ioresult = 0 then
  140.     begin
  141.       getftime(infile, filetime);
  142.       close(infile);
  143.       if savetime <> filetime then timechanged := true; {set reload flag}
  144.       if shutdown then timechanged := true;
  145.       fticks := 1;
  146.       shutdown := false;
  147.     end
  148.     else
  149.     begin
  150.       fticks := 1;                {reset check-file tick counter}
  151.       shutdown := true;           {turn us off}
  152.     end;
  153.   end;
  154.  
  155.  
  156.   function getone(var num : byte) : char;
  157.   begin
  158.     if num > linelen[ln] then
  159.     begin
  160.       num := 1;
  161.       if ln >= linesread then ln := 1
  162.       else
  163.         inc(ln);
  164.     end;
  165.     getone := linebuff[ln][num];
  166.   end;
  167.  
  168.   procedure showit;
  169.   var
  170.     i              : word;
  171.  
  172.   begin
  173.     rowcol := wherexy;
  174.     savecol := lo(rowcol);
  175.     saverow := hi(rowcol);
  176.     for i := 1 to charcount do
  177.     begin
  178.       if (displaybuff[0] < char(width)) then
  179.       begin
  180.         displaybuff := displaybuff + getone(count);
  181.       end
  182.       else
  183.         displaybuff := copy(displaybuff, 2, width) + getone(count);
  184.       fastwrite(displaybuff, row, (col + width) - byte(displaybuff[0]), attr);
  185.       inc(count);
  186.     end;
  187.     gotoxyabs(savecol, saverow);
  188.   end;
  189.  
  190.   {$F+}
  191.   procedure dispatcher(var regs : registers);
  192.   begin
  193.     busy := true;
  194.     if not shutdown then
  195.     begin
  196.       if timechanged then loaddata;
  197.       if fticks > checkftimedelay then checkftime;
  198.       reinitcrt;
  199.       if intextmode and (screenwidth = 80) then
  200.         showit;
  201.     end
  202.     else
  203.       if fticks > checkftimedelay then checkftime;
  204.     ticks := 0;
  205.     busy := false;
  206.   end;
  207.   {$F-}
  208.  
  209.   {$F+}
  210.   procedure clocktick(bp : word); interrupt;
  211.   var
  212.     regs           : intregisters absolute bp;
  213.  
  214.   begin
  215.     inc(ticks);
  216.     inc(fticks);
  217.     if not busy then
  218.       if ticks > opspeed then
  219.         setpopticker(tickerpophandle, 60);
  220.     chainint(regs, origint);
  221.   end;
  222.   {$F-}
  223.  
  224.  
  225.   {$F+}
  226.   procedure popupunload(var regs : registers);
  227.  
  228.   begin
  229.     busy := true;
  230.     popupsoff;
  231.     reinitcrt;
  232.     rowcol := wherexy;
  233.     savecol := lo(rowcol);
  234.     saverow := hi(rowcol);
  235.     if intextmode and (screenwidth = 80) then
  236.       if not disabletsr then
  237.         fastwrite('can`t disable', row, col, attr)
  238.       else
  239.         fastwrite('Ticker Tape Unloaded', row, col, attr);
  240.     gotoxyabs(savecol, saverow);
  241.     popupson;
  242.     busy := false;
  243.   end;
  244.   {$F-}
  245.  
  246.   procedure initint;
  247.   begin
  248.     if initvector(timerint, int_handle, @clocktick) then
  249.     begin
  250.       writeln('Ticker Tape installed');
  251.       origint := isr_array[int_handle].origaddr;
  252.     end
  253.     else
  254.       writeln('ERROR  Can`t grab the Timer Control interrupt, 1Ch...');
  255.   end;
  256.  
  257.   procedure init;
  258.   begin
  259.     count := 1;
  260.     charcount := 1;               {chars displayed in one cycle;could be used to increase speed}
  261.     ticks := 0;
  262.     fticks := 0;
  263.     checkftimedelay := fdelay * 18; {delay in ticks}
  264.     opspeed := 9 - speed;
  265.     displaybuff := '';
  266.     fillchar(linebuff, sizeof(linebuff), #0);
  267.     loaddata;
  268.   end;
  269.  
  270.   function str2int(s : string; var n : integer) : boolean;
  271.   var
  272.     code           : integer;
  273.   begin
  274.     str2int := false;
  275.     val(s, n, code);
  276.     if code = 0 then
  277.       str2int := true;
  278.   end;
  279.  
  280.   procedure getparams;
  281.   var
  282.     temp           : string;
  283.   begin
  284.     fname := paramstr(1);
  285.     assign(infile, fname);
  286.     {$I-}
  287.     reset(infile);
  288.     {$I+}
  289.     if ioresult <> 0 then
  290.     begin
  291.       writeln(fname + ' cannot be opened, continuing with installation...');
  292.       timechanged := true;
  293.       shutdown := true;    {go to sleep; ver 1.01}
  294.     end
  295.     else
  296.       close(infile);
  297.  
  298.     for i := 2 to paramcount do
  299.     begin
  300.       temp := paramstr(i);
  301.       case upcase(char(temp[2])) of
  302.         'R' : if not str2int(copy(temp, 3, 2), row) then halt;
  303.         'C' : if not str2int(copy(temp, 3, 2), col) then halt;
  304.         'W' : if not str2int(copy(temp, 3, 2), width) then halt;
  305.         'S' : if not str2int(copy(temp, 3, 1), speed) then halt;
  306.         'T' : if not str2int(copy(temp, 3, 3), attr) then halt;
  307.         'D' : if not str2int(copy(temp, 3, 3), fdelay) then halt;
  308.       end;
  309.     end;
  310.  
  311.     {check bounds}
  312.     if row < 1 then row := 1;
  313.     if row > 25 then row := 25;
  314.     if col < 1 then col := 1;
  315.     if col > 70 then col := 79;
  316.     if width < 2 then width := 2;
  317.     if width > 80 then width := 80;
  318.     if speed < 1 then speed := 1;
  319.     if attr < 1 then attr := 1;
  320.     if fdelay < 1 then fdelay := 1;
  321.  
  322.   end;
  323.  
  324.  
  325.  
  326. begin
  327.   if paramcount > 0 then
  328.   begin
  329.     getparams;
  330.     init;
  331.     if not moduleinstalled(pname) then
  332.     begin
  333.       installmodule(pname, nil);
  334.       if not definepopproc(tickerpophandle, @dispatcher,
  335.                            ptr(sseg, sptr)) then exit;
  336.       initint;
  337.       if definepop(ctrlaltu, @popupunload, ptr(sseg, sptr), true) then
  338.         writeln('Press <CTRLALT-U> to Unload...');
  339.       popupson;
  340.       if not terminateandstayresident(paragraphstokeep + 16, 0) then
  341.       begin
  342.         writeln('Ticker Tape not installed..');
  343.       end;
  344.     end
  345.     else
  346.       writeln('Ticker Tape already installed.');
  347.   end
  348.   else
  349.   begin
  350.     writeln(credits1);
  351.     writeln;
  352.     writeln('Ticker is a TSR that will display up to 25 lines of text in a continuous');
  353.     writeln('"Ticker Tape" type stream. Ticker gets its input from a disk based');
  354.     writeln('ascii text file and has the ability to automatically update its display with');
  355.     writeln('changed data. The display stream can be sized and displayed anywhere on the');
  356.     writeln('screen through command line switches. If the input file is erased Ticker will');
  357.     writeln('stop streaming text until the input file reappears. This feature has several');
  358.     writeln('applications in a networked environment, i.e. passive message services. ');
  359.     writeln('Control is available through the following command line parameters');
  360.     writeln;
  361.     writeln('       DEFAULT           RANGE      DESCRIPTION');
  362.     writeln('       /R1               1..25      Row');
  363.     writeln('       /C1               1..79      Left column');
  364.     writeln('       /W80              2..80      Width');
  365.     writeln('       /S5               1..9       Display Speed');
  366.     writeln('       /T7               1..255     Text Color');
  367.     writeln('       /D60              1..999     File Check Delay in seconds');
  368.     writeln;
  369.     writeln('              TICKER CompletePath+TextFile.Ext  [SWITCHES]');
  370.   end;
  371. end.
  372.