home *** CD-ROM | disk | FTP | other *** search
/ Zodiac Super OZ / MEDIADEPOT.ISO / FILES / 13 / COMMIO0B.ZIP / COMMIO.PAS < prev    next >
Pascal/Delphi Source File  |  1996-05-20  |  56KB  |  1,560 lines
  1. {$X+,A+,V-,R-,S-,O-,B-}
  2. unit commio;
  3. {
  4.                  This is the Main Communications unit (COMMIO)
  5.        Written by Jason Morriss aka. Lief O'Pardy;  (started on 7/26/95)
  6.  
  7.                    Copyright (C) 1995,1996 by Jason Morriss
  8.  
  9.   Some real documentation will be written at a later date, for now you'll
  10.   just have to look at the procedure/function headers to see what each
  11.   routine does.
  12.   I will try to describe how to use these routines to setup any type of door
  13.   program for use on a BBS (a better description will be given when the DOC's
  14.   are written):
  15.  
  16.   1)  Get any and all information that you need about the USER and BBS when
  17.       your door starts.  You need this information so you can setup the USER
  18.       and BBS variables.  For instance, You need to know if the user is using
  19.       ANSI or not, what node s/he is on, etc...  As for the BBS (this is most
  20.       important, without this step your door will probably not work at all
  21.       and will probably freeze the BBS), you need to find out what Comport
  22.       and the Baudrate the user is connected at, without this you cannot
  23.       communicate with the user at the remote end.
  24.       Either use a DROPFILE (the routines for this are not completed yet),
  25.       The command line, or an INI file...
  26.       Bare minimum get the Comport, Baudate, WhichIO (fossil, internal) and
  27.       MaxTimeAllowed!
  28.   2)  Once all the important info has been put into the "DOOR" record (look
  29.       below for the door record), Make a call to the InitComport function.
  30.       If that function returns true then all is alright and you can continue,
  31.       otherwise you should halt the door so the BBS can take control again.
  32.       Then call InstallAllTasks so that the Timing variables will be setup,
  33.       and then you can forget about them.  The user will be automatically
  34.       booted out if his/her time runs out.  You can also optionally call
  35.       ShowStatusBar.  This procedure displays a Statusbar at the bottom of
  36.       the screen.  With info on the user, connection, local env., and time
  37.       remaining (Pressing F2 while in the DOOR will show the status line too).
  38.   3)  You should now be able to do anything you want with your door.  enjoy.
  39.   4)  Most door libraries require you to call a certain procedure to DE-Init
  40.       the comport, etc...  You dont have to do a thing with this library!
  41.       Just let your program exit normally.  Look in the "_EXIT" unit for more
  42.       details.  Its all done automatically, it wont hurt if you do call the
  43.       Deinitcomport() though...
  44.  
  45. }
  46. interface
  47.  
  48. uses _exit, crt, dos, async, fosunit, mtask;
  49.  
  50.  
  51. type
  52.   Tscreen    = array[0..24,0..159] of byte;
  53.   TSystemEnv = (NoTasker{,DOS5},DDOS,DV,WIN,OS2,NetWare);
  54.   TWhichIO   = ({LocalIO,}FossilIO,InternalIO);
  55.   TCharAry   = array[0..0] of char;
  56.   string40   = string[40];
  57.   string12   = string[12];
  58.  
  59. {v- anything with an (R) in front of it, is READ ONLY; do not write to them
  60.     in your own door code.}
  61.   Tdoor = record (* Record for the more common "DOOR-System" variables *)
  62.     UserName    : string[40];{user's name; could be alias or real}
  63.     {------------------------}
  64.     ComPort     : byte;      {Which Comport the program is using; 0=local}
  65.     Baudrate    : longint;   {Baudrate for the comport}
  66.     WhichIO     : TWhichIO;  {Which IO routines to use; fossil or internal}
  67.     IOinstalled : boolean;   {comport IO routines installed?}
  68.     InBufSize   : word;      {Input buf size. (only for internal routines)}
  69.     OutBufSize  : word;      {Output buf size. (only for internal routines)}
  70.     IRQ         : byte;      {Which IRQ is being used}
  71.     WordSize    : byte;      {Wordsize (databits) for comport}
  72.     Parity      : char;      {parity for comport; 'N'=none 'E'=even 'O'=odd}
  73.     StopBits    : byte;      {stopbits for comport}
  74.     node        : byte;      {Which node the user is on (on BBS)}
  75.     {------------------------}
  76.     UseAnsi     : boolean;   {Is ansi used or not?}
  77.     {^ Even if in local mode, this must be true in order to use commands
  78.        that would use ANSI to the remote user. }
  79.     UseColor    : boolean;   {Is color used or not?}
  80.     UseAni      : boolean;   {Is animation used or not? (see putstr in doorio)}
  81.     SmartColor  : boolean;   {"Smart" mode ON/OFF for ansi color code sending}
  82.     LocalInputON: boolean;   {Enable/Disable local keyboard input}
  83.     UpdateLocal : boolean;   {Writes to the local screen are allowed or not?}
  84. {R} UpdateStatusBar:boolean; {update status bar? (even if updatelocal=false)}
  85. {R} UseVirtScr  : boolean;   {Use the virtual screen?}
  86.     StatusBarY  : byte;      {What line the status bar is displayed on}
  87.     LocalMaxY   : byte;      {# of lines (1-#) to update on local screen (usually 25)}
  88.     {------------------------}
  89. {R} CurTime     : DateTime;  {Current Time. Updated consistently; 24h format}
  90.     SecsLeft    : longint;   {Seconds left until user is booted back to BBS}
  91. {R} SecsOn      : longint;   {how long the user has been in the door}
  92.     KickOffIdle : integer;
  93.     {^# of secs the user can be idle before he gets booted back to the bbs.
  94.       This will "beep" the user once when the Idle Time is <= 30 seconds.
  95.       A value of -1 will disable the Auto-KickOff feature.  (this variable
  96.       does not get decremented "CurIdle" does).}
  97. {R} LocalKey    : boolean;   {Was the last key pressed local?}
  98.     OnLine      : boolean;   {Is user online/connected?}
  99.     PauseLine   : byte;      {# of lines to display before pausing output; 24=default}
  100.     {^ will probably be taken out.}
  101.     CurLine     : byte;      {Current line counter}
  102.     {^ will probably be taken out; use "virty" instead.}
  103.     {------------------------}
  104.   end;
  105.  
  106. const
  107.   CurIdle : integer = 0;              {Idle counter for auto-kickoff feature}
  108.   IdleStart : longint = 0;
  109.   MaxTimeAllowed : word = 24*60;   {Maximum time allowed in DOOR; in MINUTES}
  110.   {^ 2*60 = 2 hours.}
  111.  
  112. var
  113.   MacroStr    : string;              { Macro string; used in readkey funcs. }
  114.   door        : tdoor;               { "door-system" variables }
  115.   StartTime   : datetime;            { when user entered door }
  116.   SystemEnv   : tsystemenv;          { What OS is operating locally? }
  117.   KickedOut   : boolean;             { was user kicked out? (F6) }
  118.   Beeped      : boolean;
  119.  
  120. const {virtual screen variables}
  121.   VirtScr : ^tscreen = nil;          { Virtual Screen }
  122.   VirtX   : integer = 1;             { Virtual X screen position for cursor }
  123.   VirtY   : integer = 1;             { Virtual Y screen position for cursor }
  124.   {^ even if the virtual screen is not initialized, the VirtX/Y variables are
  125.      used to determine where the cursor is.
  126.      Anytime you want to know where the cursor is, use these variables.  Do
  127.      NOT use WhereX/Y... sometimes you'll get the wrong result.}
  128.  
  129. var
  130.   SkipReadkey : boolean;
  131.   {^ special variable. if true, and the sysop pushes a syskey then; the
  132.      sioreadkey function will call the syskey function and then exit the
  133.      sioreadkey function itself, returning a nul (#0) char, then continuing
  134.      with the program.  Its hard to explain.  I needed this for the file
  135.      displaying file routines.  you will never have to mess or even look at
  136.      this variable while programming (unless you really, really want too ;)}
  137.  
  138. {─--[headers]-──────────────────────────────────────────────────────────────}
  139. Function InitComport:boolean;
  140. {^ Initializes the comport for IO. This is normally the 2nd thing that is
  141.    called when your door starts (the 1st thing would either be reading a
  142.    DropFile, or INI file, or both).  This must be called before any of the
  143.    other comport IO routines are called! (any procs. that use the modem).  No
  144.    params are needed... because all the values needed are taken from the
  145.    "door" record (port,baud,parity), So the DOOR var must be setup first. }
  146. Procedure DeInitComport;
  147. {^ DeInitializes the comport.  You can call this at the end of your door, but
  148.    you don't have to.  It will be called automatically on its own at the end
  149.    of the program, its better if you don't call it.
  150.    (see also: AddToExitChain) }
  151. Procedure ChangeIRQ(comport,irq:byte);
  152. {^ Assigns the IRQ for the comport.  This is for comports that use non
  153.    standard IRQ's only, if its a standard IRQ, then you don't need to call
  154.    this.
  155.    If this needs to be called, it must be called before InitComport()!
  156.    (this only works for the InternalIO, i don't know how a Fossil does it)}
  157. Procedure ChangeFIFO(comport:byte; on:boolean);
  158. {^ Lets you toggle the use of the receive FIFO's on the modem.  By default,
  159.    the FIFO's will NOT be used.  That is to avoid the conficts with some
  160.    modems that have buggy FIFO's.  Chances are that, this can be turned on
  161.    without any problems, most modems (if not all) these days have "good" FIFO
  162.    buffers, but some older or "substandard" ones might not. }
  163. Function CarrierDetect:boolean;
  164. {^ Returns True if User is Connected, false if not.  If door.comport=0
  165.    (local mode) then this always returns true. }
  166.  
  167. Procedure ReleaseTimeSlice;
  168. {^ Gives up remaining CPU time to the rest of the OS.  This procedure is
  169.    setup in the sioreadkey function already, along with a few other procedures.
  170.    You can use it for your own needs as well. }
  171. Procedure BeginCritical;
  172. {^ Begins a "Critical" block.  After calling this under Multi-Tasking
  173.    systems, the majority of the CPU time will be given to your program,
  174.    until you call "EndCritical".  This should be called right before sections
  175.    of code that need your program to be as "smooth" as possible.  (If your
  176.    not under a MT system, than this does nothing) }
  177. Procedure EndCritical;
  178. {^ Ends a "Critical" block.  This should be called after a call has been
  179.    made to "BeginCritical" and your "Critical" section is done.  (it does
  180.    no harm if BeginCritical was not called before this), be sure to call this
  181.    at some point if you do call BeginCritical!  Otherwise you'll probably slow
  182.    down the rest of the system until your door exits. }
  183.  
  184. Procedure sioCursorUp(n:byte);
  185. Procedure sioCursorDown(n:byte);
  186. Procedure sioCursorLeft(n:byte);
  187. Procedure sioCursorRight(n:byte);
  188. {^ Move the cursor n times in a any direction.  If the cursor is already at
  189.    the maximum or minimum position in the direction its moving, it will not
  190.    move any further.
  191.    NOTE: This will only work if ANSI is enabled, otherwise any calls to this
  192.    procedure will be ignored. }
  193. Procedure sioClrscr;
  194. {^ Clears the screen with the current attribute.
  195.    NOTE: this works reguardless of ANSI being enabled. }
  196. Procedure sioClrAbove;
  197. {^ Clears everything above the cursor with the current attribute.
  198.    NOTE: This will only work if ANSI is enabled, otherwise any calls to this
  199.    procedure will be ignored. }
  200. Procedure sioClrBelow;
  201. {^ Clears everything below the cursor with the current attribute.
  202.    NOTE: This will only work if ANSI is enabled, otherwise any calls to this
  203.    procedure will be ignored. }
  204. Procedure sioClrEol;
  205. {^ Clears the current line starting from the current cursor position, to the
  206.    end of the line, w/o moving the cursor... This happens on the remote; and
  207.    local screen (according to updatelocal).
  208.    NOTE: This will only work if ANSI is enabled, otherwise any calls to this
  209.    procedure will be ignored. }
  210. Procedure sioGotoxy(x,y:byte);
  211. {^ Moves the cursor to the values in X,Y on the remote, and local screen
  212.    (according to updatelocal).  The valid ranges are: X=1..80; Y=1..NumLines,
  213.    if either value is over the max range, nothing will happen.
  214.    NOTE: This will only work if ANSI is enabled, otherwise any calls to this
  215.    procedure will be ignored. }
  216.  
  217. Procedure FlushOutput;
  218. {^ Flushes the output buffer.  This procedure does not return until all the
  219.    output in the buffer has been sent to the remote. }
  220. Procedure PurgeOutPut;
  221. {^ Purges all output in the Output buffer.  Anything in the buffer is not
  222.    displayed (or sent to remote). }
  223. Procedure PurgeInput;
  224. {^ Clears all input in the input buffer.  Anything in the buffer will not be
  225.    read by the input routines. }
  226.  
  227. Procedure sioWriteC(c:char);
  228. Procedure sioWritelnC(c:char);         {append CRLF after the char}
  229. {^ Writes a character to the comport, and the local screen (If updatelocal =
  230.    true). }
  231. Procedure sioWriteN(n:longint);
  232. Procedure sioWritelnN(n:longint);      {append CRLF after the number}
  233. {^ Writes any whole number to the comport, and the local screen (according to
  234.    updatelocal).  You can use shortint,byte,integer,word & longints with this.
  235.    These procedures are useless since you can use TP's Write/ln procs!
  236.    (ie: write(IO,'The Number is: ',mynumber);
  237.    See TEXTDEV.PAS for more detials.}
  238. Procedure sioWrite(s:string);
  239. Procedure sioWriteln(s:string);        {append CRLF after the string}
  240. {^ Writes a string to the comport, and the local screen (according to
  241.    updatelocal). }
  242. Function sioKeyPressed:Boolean;
  243. {^ Returns True if a local key has been pressed (if LocalInputON), or if a
  244.    key is waiting in the Input buffer (from remote), or if the MACRO string
  245.    is NOT empty.  This function will also call Switch_task once, and do a
  246.    Time Slice for you. }
  247. Function sioReadkey:char;
  248. {^ Reads either the first key in the INPUT buffer from the comport, or if a
  249.    local key was pressed, or if the MACROSTR is not empty then the next key
  250.    is taken from that.  The scan code returned is just like pascals' readkey.
  251.    (except Function keys (F1-F12, AltF1-AltF12)) }
  252.  
  253. Procedure SetFore(fore:byte);
  254. Procedure SetBack(back:byte);
  255. Procedure SetColor(fore,back:byte);
  256. {^ Sets the foreground and background colors to the values given.  These
  257.    Procedures WILL actually send the ansi codes needed to change the color to
  258.    the remote screen, and change textattr locally.
  259.    If DOOR.SMARTCOLOR=true then this will only send the ansi codes if NEEDED.
  260.    ie: if you set the color to: (15,1) and the current color is already equal
  261.    to (15,1) then nothing will be sent, or if the current color is equal
  262.    to (7,1) then only the "bold" attribute will be sent, etc... This will
  263.    speed up repetitive color codes...}
  264.  
  265. Procedure ShowStatusBar;
  266. {^ This redraws the Local Status Bar, but will not update the time variable
  267.    on the bar.  This sets a window() so that the 25th line will not be
  268.    disturbed by the normal IO routines.  If you want to write to the status
  269.    bar, then use the WriteStr() proc in the DOORIO unit.  This will set
  270.    UpdateStatusBar:=true. }
  271. Procedure HideStatusBar;
  272. {^ This hides the Local Status Bar.  This resets the window() so that the
  273.    25th line can be written to with the SIO routines.  This will set
  274.    UpdateStatusBar:=false. }
  275. Procedure RecordMacro(help:boolean);
  276. {^
  277.  ***This needs to be redone.
  278. Record a Macro.  Macros are limited to 255 chars.  The recorded macro
  279.    will be put into the "door.macrostr" variable.  Whenever the MACROSTR is
  280.    not empty, the input routines (sioreadkey) will keep returning chars from
  281.    the MACROSTR (the first char is used, then that 1st char is deleted to
  282.    get the next char ready.
  283.      help  = This procedure has its own little built in help screen, telling
  284.              the user how to input a macro, and showing the different control
  285.              codes used.  Set to TRUE if you want that screen to be shown,
  286.              set to FALSE otherwise.  (you can show your own screen if you
  287.              wish) }
  288. Procedure Wait(seconds:word);
  289. {^
  290.  ***This needs to be redone.
  291.  Wait a number of seconds.  Seconds is not just an approximation like TP's
  292.    Delay() procedure, this is near perfect (i think).  This also does Time
  293.    Slicing, & will Switch Tasks while "waiting".}
  294.  
  295. Procedure DisplayAnsiFile(fn:pathstr; lines:byte);
  296. {^
  297.  ***This needs to be redone.  Lines in the file that are over 235 characters
  298.     might not be pharsed correctly!
  299.  
  300.  Displays an ANSI file to the Remote and local screen.  If ANSI has been
  301.    disabled (or if UseColor=false) then all ansi esc codes will be ignored
  302.    in the file and only the normal text will be displayed.  This will also
  303.    pause the output.  If the <space bar> is pressed during the ouput at any
  304.    time (except when paused), the output will stop, and the procedure will
  305.    exit.  ANSI.SYS is NOT required locally for use of colors and movement.
  306.    If the <spacebar> is pressed, then the output will stop, and the procedure
  307.    will exit.
  308.    This proc. does not support the "Θ" codes, like the procedure below.
  309.      fn    = path\filename of the file to be displayed.  If the file is not
  310.              found, then an error message will be displayed instead. (locally
  311.              and remotely)
  312.      lines = number of lines to display before pausing the output.  A 0 will
  313.              disable the pausing, so it will run continuously until EOF (or
  314.              <spacebar> is pressed ).  The value can be anything from 0 to
  315.              255. }
  316. Procedure DisplayTextFile(fn:pathstr; lines:byte);
  317. {^ Same as the procedure above, except this does not support ANSI codes.
  318.    Actually, this does support ANSI, but only on the Remote side, Any ANSI
  319.    codes in the file will be written to the local screen as normal text.  The
  320.    advantage of this procedure is that, it supports the color/animate coding
  321.    just like the putstr() procedure.  And if ANSI is disabled then all color
  322.    and animation codes will be ignored, or if only color is disabled then no
  323.    colors will be changed.  The "fn" and "lines" are the same as the
  324.    procedure above. }
  325.  
  326. Procedure ANSIWrite(s:string);
  327. Procedure ANSIWriteln(s:string);
  328. {^ These procedures write an ANSI string (containing ansi esc codes) to the
  329.    remote & _local_ sides.  If ansion=false then ALL ansi esc codes will be
  330.    ignored, If usecolor=false then all color codes will be ignored, but other
  331.    ansi esc codes will be pharsed (like cursor movement).  These procedures
  332.    will not strip "putstr" animation codes. You do NOT need ANSI.SYS loaded.}
  333.  
  334. function InitVirtScr : boolean;
  335. {^ Sets up the virtual screen to be used and sets the door variable for it
  336.    also.  This virtual screen is maintained by all the output routines in
  337.    the COMMIO library.  Whenever something is displayed to the player it is
  338.    also written to the virtual screen.
  339.    When initializing the virtual screen, After you call this function you
  340.    should clear the screen (with a call to sioclrscr()).. to be sure that the
  341.    screens get "synchronized."
  342.    This feature can be useful for a couple of reasons:
  343.    1) This allows the user to "Refresh" his/her screen anywhere in the door,
  344.    if thier screen gets garbled from line noise or something. (this has
  345.    happened to just about everyone, right? ;)  2) If the door is running in
  346.    "Sysop Blockout Mode" (eg. nothing is being drawn to the local screen)
  347.    and at some point the door comes out of that mode, allowing the sysop to
  348.    see whats going on again... the door can update the local screen
  349.    immediately.  The only drawback to these routines is that they slow down
  350.    the normal output routines in this library, But it probably won't be
  351.    noticable to anyone. }
  352. procedure FreeVirtScr;
  353. {^ Frees the Virtual Screen, and sets the door variable to reflect it.
  354.    After a call to this the Virtual Screen is not used, and will be a NIL
  355.    pointer if you try to access it.
  356.    This is called automatically when the program exits, so you dont have to
  357.    call it, but it doesnt hurt to either. }
  358. procedure DrawScr(scr:pointer; x1,y1,x2,y2:byte);
  359. {^ Refreshes the remote and local screens using the virtual screen.  So that
  360.    must of been initialized first.
  361.    "scr" is a pointer to a buffer that holds the screen.  It must point to an
  362.    array of tscreen (or similar array).
  363.    x1,y1,x2,y2 is the rectangle to draw.
  364.    NOTE: the very last char in the bottom corner (80,25) will NEVER be drawn.
  365.          Otherwise the screen will scroll up. }
  366.  
  367. implementation
  368.  
  369.  
  370.  
  371. uses SysKeys,TextDev,Doorio;
  372. {^ These units must be delcared here, if you put them in the interface uses
  373.    statement, you will get a "circular unit reference" error. }
  374.  
  375.  
  376.  
  377. const
  378.   Bold : boolean = false;
  379.   CurColor : byte = 255;
  380.  
  381.   ColAry : array[0..7] of byte = (0,4,2,6,1,5,3,7);            {for setcolor}
  382.   OSStr : array[Tsystemenv] of string[17] = (
  383.           'DOS              ',
  384.           'Double-Dos       ',
  385.           'DesqView         ',
  386.           'Windows          ',
  387.           'OS/2             ',
  388.           'Network          ' );
  389.           {^ not sure network detect works, it doesnt detect mine (lantastic)
  390.              i think it only works for novell networks. }
  391.  
  392. {───────────────────────────────────────────────────────────────────────────}
  393. Function InitComport;
  394. var b:boolean;
  395. begin
  396.   InitComport:=false;
  397.   if door.IOinstalled then exit;
  398.   door.IOinstalled:=true;
  399.   b:=false;
  400.   with door do if comport>0 then begin
  401.     case WhichIO of
  402.       InternalIO : begin
  403.         b:=OpenCom(comport,InBufSize,OutBufSize);
  404.         if b<>false then begin
  405.           ComParams(comport,baudrate,wordsize,parity,stopbits)
  406.           {flow control is set by ComParams()}
  407. {          SoftHandshake(comport,true,C_StartChar[comport],C_StopChar[comport]);{}
  408. {          SetRTSmode(comport,true,C_RTSon[comport],C_RTSoff[comport]);{}
  409. {          SetCTSmode(comport,true);{}
  410.         end;
  411.       end;
  412.  
  413.       FossilIO : begin
  414.         b:=f_init(comport);
  415.         if b<>false then begin
  416.           f_parms(comport,baudrate,wordsize,parity,stopbits);{}
  417.           f_flow(comport,true); {enable RTS/CTS flow control (hardware)}
  418.         end;
  419.       end;
  420.     end; {of case}
  421.   end else b:=true; {local mode}
  422.   door.IOinstalled:=b;
  423.  
  424.   if (CarrierDetect=false)
  425.     then b:=false
  426.     else begin
  427.       PurgeOutput;
  428.       PurgeInput;
  429.     end;
  430.  
  431.   InitComport:=b;
  432.   door.online:=b;
  433. end;
  434. {───────────────────────────────────────────────────────────────────────────}
  435. Procedure DeInitComport;
  436. begin
  437.   if not door.IOinstalled then exit;
  438.   with door do if (comport>0) then
  439.     case WhichIO of
  440.       InternalIO : begin
  441.         SetRTSmode(comport,false,0,0);
  442.         SetCTSmode(comport,false);
  443.         CloseCom(comport);
  444.       end;
  445.       FossilIO   : begin
  446. {        f_flow(comport,false);{}
  447.         f_close(comport);
  448.       end;
  449.     end;
  450.   door.IOinstalled:=false;
  451.   door.online:=false;
  452. end;
  453. {───────────────────────────────────────────────────────────────────────────}
  454. Function CarrierDetect;
  455. begin
  456.   if door.comport>0 then begin
  457.     case door.whichio of
  458.       internalIO : CarrierDetect := DCDstat(door.comport);
  459.       fossilIO   : CarrierDetect := f_cd(door.comport);
  460.     end;
  461.   end else begin
  462.     CarrierDetect := true;  {If in local mode, always return true}
  463.   end;
  464. end;
  465. {───────────────────────────────────────────────────────────────────────────}
  466. Procedure ChangeIRQ;
  467. begin
  468.   C_PortInt[comport]:=irq;
  469. end;
  470. {───────────────────────────────────────────────────────────────────────────}
  471. Procedure ChangeFIFO;
  472. begin
  473.   C_FifoOK[comport]:=on;
  474. end;
  475. {───────────────────────────────────────────────────────────────────────────}
  476.  
  477.  
  478. {───────────────────────────────────────────────────────────────────────────}
  479. Procedure DetectOS; assembler;
  480. {CREDIT: Written by JON JASIUNAS; from his PD unit SHARE.PAS, i didn't feel
  481.          that this unit needed his entire unit, so i took his Time Slicing
  482.          routines only.  Thanks Jon.  I probably could of found this info
  483.          in R. Brown's INT listings, but was too lazy, and why should i
  484.          reinvent the wheel when its already made? ;> }
  485. {This procedure is not in the interface section, because theres no need for
  486.  the programmer to call it.  Its called once in this unit's init section.
  487.  (alllll the way at the bottom) }
  488. asm
  489. @CheckDV:
  490.     mov   AX, $2B01
  491.     mov   CX, $4445
  492.     mov   DX, $5351
  493.     int   $21
  494.     cmp   AL, $FF
  495.     je    @CheckDoubleDOS
  496.     mov   SystemEnv, DV
  497.     jmp   @Done
  498.  
  499. @CheckDoubleDOS:
  500.     mov   AX, $E400
  501.     int   $21
  502.     cmp   AL, $00
  503.     je    @CheckWindows
  504.     mov   SystemEnv, DDOS
  505.     jmp   @Done
  506.  
  507. @CheckWindows:
  508.     mov   AX, $1600
  509.     int   $2F
  510.     cmp   AL, $00
  511.     je    @CheckOS2
  512.     cmp   AL, $80
  513.     je    @CheckOS2
  514.     mov   SystemEnv, WIN
  515.     jmp   @Done
  516.  
  517. @CheckOS2:
  518.     mov   AX, $3001
  519.     int   $21
  520.     cmp   AL, $0A
  521.     je    @InOS2
  522.     cmp   AL, $14
  523.     jne   @CheckNetware
  524.   @InOS2:
  525.     mov   SystemEnv, OS2
  526.     jmp   @Done
  527.  
  528. @CheckNetware:
  529.     mov   AX,$7A00
  530.     int   $2F
  531.     cmp   AL,$FF
  532.     jne   @NoTasker
  533.     mov   SystemEnv, NetWare
  534.     jmp   @Done
  535.  
  536. @NoTasker:
  537.     mov   SystemEnv, NoTasker
  538.  
  539. @Done:
  540. end;
  541. {───────────────────────────────────────────────────────────────────────────}
  542. Procedure ReleaseTimeSlice;
  543. {CREDIT: "NetWare" time slice from JON JASIUNAS's SHARE.PAS, the rest i
  544.  found on my own. }
  545. Begin
  546.   Case SystemEnv Of
  547.     NoTasker{,
  548.     DOS5}    : asm int $28 end;
  549.     DDOS     : asm mov ax,$EE01; int $21 end;
  550.     DV       : asm mov ax,$1000; int $15 end;
  551.     WIN,OS2  : asm mov ax,$1680; int $2F end;
  552.     NetWare  : asm mov bx,$000A; int $7A end;
  553.   End;
  554. End;
  555. {───────────────────────────────────────────────────────────────────────────}
  556. procedure BeginCritical; assembler;
  557. {CREDIT: Written by JON JASIUNAS; from his PD unit SHARE.PAS}
  558. asm
  559.   cmp   SystemEnv, DV
  560.   je    @DVCrit
  561.   cmp   SystemEnv, DDOS
  562.   je    @DoubleDOSCrit
  563.   cmp   SystemEnv, WIN
  564.   je    @WinCrit
  565.   jmp   @EndCrit
  566.  
  567. @DVCrit:
  568.   mov   AX,$101B
  569.   int   $15
  570.   jmp   @EndCrit
  571.  
  572. @DoubleDOSCrit:
  573.   mov   AX,$EA00
  574.   int   $21
  575.   jmp   @EndCrit
  576.  
  577. @WinCrit:
  578.   mov   AX,$1681
  579.   int   $2F
  580.   jmp   @EndCrit
  581.  
  582. @EndCrit:
  583. end;
  584. {───────────────────────────────────────────────────────────────────────────}
  585. procedure EndCritical;  assembler;
  586. {CREDIT: Written by JON JASIUNAS; from his PD unit SHARE.PAS}
  587. asm
  588.   cmp   SystemEnv, DV
  589.   je    @DVCrit
  590.   cmp   SystemEnv, DDOS
  591.   je    @DoubleDOSCrit
  592.   cmp   SystemEnv, WIN
  593.   je    @WinCrit
  594.   jmp   @EndCrit
  595.  
  596. @DVCrit:
  597.   mov   AX,$101C
  598.   int   $15
  599.   jmp   @EndCrit
  600.  
  601. @DoubleDOSCrit:
  602.   mov   AX,$EB00
  603.   int   $21
  604.   jmp   @EndCrit
  605.  
  606. @WinCrit:
  607.   mov   AX,$1682
  608.   int   $2F
  609.   jmp   @EndCrit
  610.  
  611. @EndCrit:
  612. end;
  613. {───────────────────────────────────────────────────────────────────────────}
  614. Procedure FillWord(Var X; Count: Word; a:byte; c:char); Assembler;
  615. {just like fillchar, except you give it 2 bytes to use for the fill (this is
  616.  also a 16bit procedure, unlike the 8bit fillchar TP uses).  this is usefull
  617.  for filling in a text screen. }
  618. Asm
  619.   les   di,x
  620.   mov   cx,[count]
  621.   shr   cx,1
  622.   mov   al,[c]
  623.   mov   ah,[a]
  624.   rep   stosw
  625.   test  [count],1    {just incase you give it an odd count}
  626.   jz    @end
  627.   stosb
  628. @end:
  629. end;
  630. {───────────────────────────────────────────────────────────────────────────}
  631.  
  632. {───────────────────────────────────────────────────────────────────────────}
  633. Procedure SendStr(s:string); {used internally; by a few procedures}
  634. {send a string to the remote terminal}
  635. begin
  636.   if CarrierDetect then begin
  637.     if door.comport>0 then
  638.       case door.whichio of
  639.         internalIO : I_ComWrite(door.comport, s);
  640.         fossilIO   : f_Write(door.comport, s);
  641.       end;
  642.   end else begin
  643.     door.online:=false
  644.   end;
  645. end;
  646. {───────────────────────────────────────────────────────────────────────────}
  647. Procedure sioCursorUp;
  648. var s:string[3];
  649. begin
  650.   with door do if (UseAnsi)and(virty>1) then begin
  651.     if n>1 then str(n,s) else s:='';
  652.     SendStr(#27'['+s+'A');
  653.     dec(virty,n); if virty<1 then virty:=1;
  654.     if updatelocal then begin
  655.       gotoxy(virtX,wherey-n);
  656. {      if virty<>y then dec(curline) else break;}
  657.       if (virty<=door.localmaxy) then showcursor;
  658.     end {else for i := 1 to n do if CurLine>1 then dec(CurLine) else break;}
  659.   end;
  660. end;
  661. {───────────────────────────────────────────────────────────────────────────}
  662. Procedure sioCursorDown;
  663. var s:string[3];
  664. begin
  665.   with door do if (UseAnsi)and(virty<25) then begin
  666.     if n>1 then str(n,s) else s:='';
  667.     SendStr(#27'['+s+'B');
  668.     inc(virty,n); if virty>25 then virty:=25;
  669.     if updatelocal then begin
  670.       gotoxy(virtX,wherey+n);
  671. {      if virty<>y then inc(CurLine) else break;}
  672.       if (virty>door.localmaxy) then hidecursor;
  673.     end {else for i := 1 to n do if CurLine<50 then inc(CurLine) else break;}
  674.   end;
  675. end;
  676. {───────────────────────────────────────────────────────────────────────────}
  677. Procedure sioCursorRight;
  678. var s:string[3];
  679. begin
  680.   with door do if (UseAnsi)and(virtx<80) then begin
  681.     if n>1 then str(n,s) else s:='';
  682.     SendStr(#27'['+s+'C');
  683.     inc(virtx,n); if virtx>80 then virtx:=80;
  684.     if updatelocal then gotoxy(virtX,virtY);
  685.   end;
  686. end;
  687. {───────────────────────────────────────────────────────────────────────────}
  688. Procedure sioCursorLeft;
  689. var s:string[3]; i:byte;
  690. begin
  691.   with door do if (UseAnsi)and(virtx>1) then begin
  692.     if n>80 then n:=80;
  693.     if n>1 then str(n,s) else s:='';
  694.     SendStr(#27'['+s+'D');
  695.     dec(virtx,n); if virtx<1 then virtx:=1;
  696.     if updatelocal then gotoxy(virtX,virtY);
  697.   end;
  698. end;
  699. {───────────────────────────────────────────────────────────────────────────}
  700. Procedure sioClrScr;
  701. begin
  702.   with door do begin
  703.     if UseAnsi then SendStr(#27'[2J') else SendStr(#12);
  704.     if updatelocal then clrscr;
  705.     CurLine:=1;
  706.   end;
  707.   virtx:=1; virty:=1;
  708.   if door.usevirtscr then fillword(virtscr^,sizeof(virtscr^),textattr,' ');
  709. end;
  710. {───────────────────────────────────────────────────────────────────────────}
  711. Procedure sioClrAbove;
  712. begin
  713. { ... }
  714. end;
  715. {───────────────────────────────────────────────────────────────────────────}
  716. Procedure sioClrBelow;
  717. begin
  718. { ... }
  719. end;
  720. {───────────────────────────────────────────────────────────────────────────}
  721. Procedure sioClrEol;
  722. begin
  723.   with door do if UseAnsi then begin
  724.     SendStr(#27'[K');
  725.     if updatelocal then clreol;
  726.   end;
  727.   if door.usevirtscr then
  728.     fillword(virtscr^[virty-1,(virtx-1)*2],(80-virtx+1)*2,textattr,' ');
  729. end;
  730. {───────────────────────────────────────────────────────────────────────────}
  731. Procedure sioGotoxy;
  732. begin
  733.   with door do if UseAnsi then begin
  734.     SendStr(#27'['+istr(y,0)+';'+istr(x,0)+'H');
  735.     if updatelocal then begin
  736.       gotoxy(x,y);
  737.       if (y>door.localmaxY) then hidecursor else showcursor;
  738.     end;
  739. {    CurLine:=crt.WhereY;{}
  740.   end;
  741.   if (x>0)and(x<81) then virtx:=x;
  742.   if (y>0)and(y<26) then virty:=y;
  743. end;
  744. {───────────────────────────────────────────────────────────────────────────}
  745. Function sioKeyPressed;
  746. var b:boolean;
  747. begin
  748.   b:=false;
  749.   if CarrierDetect then begin
  750.     if door.comport>0 then
  751.       case door.whichio of
  752.         internalIO : b:=ComBufferLeft(door.comport, 'I')>0;
  753.         fossilIO   : b:=f_Avail(door.comport);
  754.       end;
  755.     if door.LocalInputON and (not b) then b:=keypressed;
  756.   end else begin
  757.     door.Online:=false;
  758.   end;
  759.   sioKeyPressed:=b;
  760.   if not b then begin
  761.     ReleaseTimeSlice;
  762.     switch_task;
  763.   end;
  764. end;
  765. {───────────────────────────────────────────────────────────────────────────}
  766. Procedure SetAttr(attr:byte);
  767. begin
  768.   SetColor(attr mod 16, attr shr 4);
  769. end;
  770. {───────────────────────────────────────────────────────────────────────────}
  771.  
  772. {───────────────────────────────────────────────────────────────────────────}
  773. Procedure FlushOutput;
  774. begin
  775.   if (Door.IOInstalled)and(CarrierDetect) then
  776.     case door.WhichIO of
  777.       InternalIO : ComWaitForClear(door.comport);
  778.       FossilIO   : f_flush(door.comport);
  779.     end;
  780. end;
  781. {───────────────────────────────────────────────────────────────────────────}
  782. Procedure PurgeOutput;
  783. begin
  784.   if (Door.IOInstalled) and (door.comport>0) then
  785.     case door.WhichIO of
  786.       InternalIO : ClearCom(door.comport,'O');
  787.       FossilIO   : f_kill_out(door.comport);
  788.     end;
  789. end;
  790. {───────────────────────────────────────────────────────────────────────────}
  791. Procedure PurgeInput;
  792. begin
  793.   if (Door.IOInstalled) and (door.comport>0) then
  794.     case door.WhichIO of
  795.       InternalIO : ClearCom(door.comport,'I');
  796.       FossilIO   : f_kill_in(door.comport);
  797.     end;
  798. end;
  799. {───────────────────────────────────────────────────────────────────────────}
  800. procedure dovirt(c:char; yinc:byte);
  801. {yinc should be ONLY 0 or 1!}
  802. var i:byte;
  803. begin
  804.   if not (c in [#07,#08,#10,#13]) then begin      {dont write control codes!}
  805.     if door.usevirtscr then begin
  806.       virtscr^[virty-1,(virtx-1)*2]:=byte(c);
  807.       virtscr^[virty-1,(virtx-1)*2+1]:=textattr;
  808.     end;
  809.     inc(virtx);
  810.   end else case c of
  811.    {#07 : cursor does not move}
  812.     #08 : if virtx>1 then dec(virtx);
  813.     #10 : inc(virty);
  814.     #13 : virtx:=1;
  815.   end;
  816.   if (virtx>80)or(virty>25)or(yinc>0) then begin
  817.     if (virtx>80) then virtx:=1;
  818.     if virty<25 then inc(virty) else begin
  819.       virty:=25;
  820.       if door.usevirtscr then begin
  821.         move(virtscr^[1],virtscr^[0],4000-160);       {scroll it up 1 line}
  822.         fillword(virtscr^[24],160,textattr,' ');      {clear the bottom line}
  823.       end;
  824.     end;
  825.   end;
  826.   if (door.updatelocal) then
  827.     if (virty<=door.localmaxy) then showcursor else hidecursor;
  828. end;
  829. {───────────────────────────────────────────────────────────────────────────}
  830. Procedure sioWriteC;
  831. const cnt:byte=0;
  832. begin
  833.   if CarrierDetect then begin
  834.     if door.comport>0 then begin
  835.       if CurColor<>TextAttr then SetAttr(CurColor);
  836.       case door.whichio of
  837.         internalIO : ComWriteChW(door.comport, c);
  838.         fossilIO   : f_SendChar(door.comport, c);
  839.       end;
  840.     end;
  841.   end else door.online:=false;
  842.   if (door.updatelocal){and not((virty>=door.localmaxy)and(c=#10))and(virty=wherey)}
  843.     then write(c);
  844.  
  845.   {draw to the virtual screen}
  846.   dovirt(c,0);
  847.  
  848. {  door.CurLine:=WhereY;{}
  849.  
  850.   inc(cnt); if cnt>=150 then begin cnt:=0; switch_task; end;{}
  851. { ^ every 150 calls to this procedure results in a switch_task.  It's
  852.     stupid to Switch_task's every character with this procedure. }
  853. end;
  854. {───────────────────────────────────────────────────────────────────────────}
  855. Procedure sioWritelnC;
  856. const cnt:byte=0;
  857. begin
  858.   if CarrierDetect then begin
  859.     if door.comport>0 then begin
  860.       if CurColor<>TextAttr then SetAttr(CurColor);
  861.       case door.whichio of
  862.         internalIO : I_ComWriteln(door.comport, c);
  863.         fossilIO   : f_Writeln(door.comport, c);
  864.       end;
  865.     end;
  866.   end else door.online:=false;
  867.   if (door.updatelocal)and not((virty>=door.localmaxy)and(c=#10)) and(virty=wherey)
  868.     then writeln(c);
  869.  
  870.   {draw to the virtual screen}
  871.   dovirt(c,1);
  872.  
  873.   inc(door.CurLine);
  874.  
  875.   inc(cnt); if cnt>=100 then begin cnt:=0; switch_task; end;{}
  876. { ^ every 100 calls to this procedure results in a switch_task.  It's
  877.     stupid to Switch_task's every character with this procedure. }
  878. end;
  879. {───────────────────────────────────────────────────────────────────────────}
  880. Procedure sioWriteN;
  881. {const cnt:byte=0;}
  882. var i:integer; s:string[12];
  883. begin
  884.   str(n,s);
  885.   for i := 1 to length(s) do siowritec(s[i]);
  886. (*  if CarrierDetect then begin
  887.     if door.comport>0 then begin
  888.       if CurColor<>TextAttr then SetAttr(CurColor);
  889.       case door.whichio of
  890.         internalIO : I_ComWrite(door.comport, s);
  891.         fossilIO   : f_Write(door.comport, s);
  892.       end;
  893.     end;
  894.   end else door.online:=false;
  895.   if door.updatelocal then write(s);
  896.   if door.UseVirtScr then begin
  897.     {draw to the virtual screen}
  898.   end;
  899.  
  900.   inc(cnt); if cnt>=25 then begin cnt:=0; switch_task; end;{}
  901. { ^ every 25 calls to this procedure results in a switch_task.
  902. }*)
  903. end;
  904. {───────────────────────────────────────────────────────────────────────────}
  905. Procedure sioWritelnN;
  906. {const cnt:byte=0;}
  907. var i:integer; s:string[12];
  908. begin
  909.   str(n,s);
  910.   for i := 1 to length(s)-1 do siowritec(s[i]);
  911.   siowritelnc(s[i+1]);
  912. (*  if CarrierDetect then begin
  913.     if door.comport>0 then begin
  914.       if CurColor<>TextAttr then SetAttr(CurColor);
  915.       case door.whichio of
  916.         internalIO : I_ComWriteln(door.comport, s);
  917.         fossilIO   : f_Writeln(door.comport, s);
  918.       end;
  919.     end;
  920.   end else door.online:=false;
  921.   if door.updatelocal then writeln(s);
  922.   if door.UseVirtScr then begin
  923.     {draw to the virtual screen}
  924.   end;
  925.   inc(door.CurLine);
  926.  
  927.   inc(cnt); if cnt>=15 then begin cnt:=0; switch_task; end;{}
  928. { ^ every 15 calls to this procedure results in a switch_task. }*)
  929. end;
  930. {───────────────────────────────────────────────────────────────────────────}
  931. Procedure sioWrite;
  932. var i:integer;
  933. begin
  934.   for i := 1 to length(s) do siowritec(s[i]);
  935. (*  if CarrierDetect then begin
  936.     if door.comport>0 then begin
  937.       if CurColor<>TextAttr then SetAttr(TextAttr);
  938.       case door.whichio of
  939.         internalIO : I_ComWrite(door.comport, s);
  940.         fossilIO   : f_Write(door.comport, s);
  941.       end;
  942.     end;
  943.   end else door.online:=false;
  944.   if door.updatelocal then write(s);
  945.   if door.UseVirtScr then begin
  946.     {draw to the virtual screen}
  947.   end;
  948.  
  949.   switch_task;*)
  950. end;
  951. {───────────────────────────────────────────────────────────────────────────}
  952. Procedure sioWriteln;
  953. var i:integer;
  954. begin
  955.   for i := 1 to length(s)-1 do siowritec(s[i]);
  956.   if i>length(s)
  957.     then writeln(SIO,'')
  958.     else writeln(SIO,s[i+1]);
  959. (*  if CarrierDetect then begin
  960.     if door.comport>0 then begin
  961.       if CurColor<>TextAttr then SetAttr(CurColor);
  962.       case door.whichio of
  963.         internalIO : I_ComWriteln(door.comport, s);
  964.         fossilIO   : f_Writeln(door.comport, s);
  965.       end;
  966.     end;
  967.   end else door.online:=false;
  968.   if door.UpdateLocal then writeln(s);
  969.   if door.UseVirtScr then begin
  970.     {draw to the virtual screen}
  971.   end;
  972.  
  973.   switch_task;*)
  974. end;
  975. {───────────────────────────────────────────────────────────────────────────}
  976. Function sioReadkey;
  977. var ch:char; found:boolean; cnt:byte;
  978. begin
  979.   with door do begin
  980.     CurIdle:=0;                  {reset auto-kickoff time with each keypress}
  981.     IdleStart:=SecsOn;
  982.     beeped:=false;               {so it only beeps once when <= 30 secs left}
  983.  
  984.     cnt:=0;
  985.     ch:=#0;
  986.     found:=false;
  987.     repeat
  988. {      if not CarrierDetect then begin door.online:=false; exit; end;{}
  989.  
  990.       if (LocalInputON)and(not found) then begin
  991.         if keypressed then begin
  992.           ch:=readkey;
  993.           found:=(ch<>#0);
  994.           if ch=#0 then begin
  995.             ch:=readkey;
  996.             if ch in [F1..F10,F11,F12, AltF1..AltF10,AltF11,AltF12] then begin
  997.               CallKey(ch);
  998.               if SkipReadKey then begin
  999.                 sioreadkey:=#1;
  1000.                 exit;
  1001.               end;{}
  1002.             end else begin
  1003.               found:=true;
  1004.               localkey:=true;
  1005.             end;
  1006.           end else LocalKey:=true;
  1007.         end;
  1008.       end;
  1009.  
  1010.       if (not found)and(comport>0) then begin
  1011.         case whichio of
  1012.           internalIO : begin
  1013.             found:=ComBufferLeft(comport, 'I')>0;
  1014.             if found then ch:=ComReadCh(comport);
  1015.             localkey:=not found;
  1016.           end;
  1017.           fossilIO : begin
  1018.             found:=true;
  1019.             if f_avail(comport)
  1020.               then ch:=f_ReadChar(comport)
  1021.               else found:=false;
  1022.             localkey:=not found;
  1023.           end;
  1024.         end;
  1025.       end;
  1026.  
  1027.       if (not found)and(MacroStr<>'') then begin
  1028.         found:=true;
  1029.         if MacroStr[1]='^' then begin  {pharse out control/extended codes}
  1030.           delete(MacroStr,1,1);
  1031.           if MacroStr<>'' then begin
  1032.             case MacroStr[1] of
  1033.               'M','m' : ch:=#13;     {carriage return}
  1034.               '['     : ch:=#27;     {esc key}
  1035.               '^'     : ch:='^';     {karet}
  1036.               '~'     : begin        {pause 1 second}
  1037.                 wait(1);
  1038.                 delete(MacroStr,1,1);
  1039.                 if MacroStr<>'' then ch:=MacroStr[1] else found:=false;
  1040.               end;
  1041.               else ch:=MacroStr[1];  {else: read as normal character}
  1042.             end;
  1043.             delete(MacroStr,1,1);
  1044.           end else found:=false;
  1045.         end else begin
  1046.           ch:=MacroStr[1];
  1047.           delete(MacroStr,1,1);
  1048.         end;
  1049.       end;
  1050.  
  1051.       if cnt>=100 then begin
  1052.         cnt:=25;
  1053.         ReleaseTimeSlice;
  1054.       end else inc(cnt);
  1055.  
  1056.       switch_task;
  1057.     until found;
  1058.     curline:=1;
  1059.     sioreadkey:=ch;
  1060.   end;
  1061. end;
  1062. {───────────────────────────────────────────────────────────────────────────}
  1063.  
  1064. {───────────────────────────────────────────────────────────────────────────}
  1065. Procedure SetFore;
  1066. begin
  1067.   setcolor(fore,textattr shr 4);
  1068. end;
  1069. {───────────────────────────────────────────────────────────────────────────}
  1070. Procedure SetBack;
  1071. begin
  1072.   setcolor(textattr mod 16, back);
  1073. end;
  1074. {───────────────────────────────────────────────────────────────────────────}
  1075. Procedure SetColor(fore,back:byte);
  1076. var
  1077.   b,oldb,Fcol,oldbold,bold,blnk:byte;
  1078.   s:string[15];
  1079. begin
  1080.   if (not door.UseAnsi)or(Fore+(Back shl 4)=textattr) then exit;
  1081.  
  1082.   if Back>7 then begin
  1083.     blnk:=5; b:=128; dec(back,8);
  1084.   end else begin
  1085.     blnk:=0; b:=0;
  1086.   end;
  1087.   Fcol:=(Fore and $07);
  1088.   bold:=(Fore and $08) shr 3;
  1089.   oldbold:=((curcolor mod 16) and $08) shr 3;
  1090.   oldb:=(curcolor and $80);
  1091.  
  1092.   if (door.smartcolor) then begin
  1093.     s:=#27'[';
  1094.     if (oldb<>b)                                            {blinking on/off}
  1095.       then s:=s+istr(blnk,0)+';';
  1096.     if (oldbold<>bold)or((oldb<>b)and(b=0)and(bold<>0))         {bold on/off}
  1097.       then s:=s+istr(bold,0)+';';
  1098.     if (fcol<>(curcolor and $07))                                {foreground}
  1099.       then s:=s+istr(colary[Fcol]+30,0)+';';
  1100.     if (back<>(curcolor and $70))                                {background}
  1101.       then s:=s+istr(colary[back]+30,0);
  1102.     if (s[length(s)]=';') then s[length(s)]:='m' else s:=s+'m';
  1103.   end else begin
  1104.     s:=#27'['+istr(blnk,0)+';'
  1105.              +istr(bold,0)+';'
  1106.              +istr(colary[Fcol]+30,0)+';'
  1107.              +istr(colary[Back]+40,0)+'m';
  1108.   end;
  1109.  
  1110.   if length(s)>3 then SendStr(s);
  1111.   TextAttr:=Fore+(Back shl 4)+b;
  1112.   CurColor:=TextAttr;
  1113. end;
  1114. {───────────────────────────────────────────────────────────────────────────}
  1115.  
  1116. {───────────────────────────────────────────────────────────────────────────}
  1117. Procedure ShowStatusBar;
  1118. var x,y:byte;
  1119. begin
  1120.   door.UpdateStatusBar:=true;
  1121.   door.localmaxy:=door.statusbary-1;
  1122.   x:=virtx; y:=virty;
  1123. {  x:=crt.wherex; y:=crt.wherey;}
  1124. {  while y>=door.StatusBarY do begin
  1125.     writeln; dec(y);
  1126.   end;{}
  1127.   window(1,1,80,door.StatusBarY-1);
  1128.   gotoxy(x,y); if (y>door.localmaxy) then hidecursor {else showcursor};
  1129.   with door do begin
  1130.     WriteStr(1,door.StatusBarY,'ΘbΘ8│ΘF∙∙Θ7:ΘF∙∙Θ7:ΘF∙∙Θ8│');
  1131.     if comport<>0
  1132.       then WriteStr(11,door.StatusBarY,'Θ7COMΘF'+istr(comport,0)+'Θ7,ΘF '+
  1133.                                        padEstr(istr(baudrate,0),' ',6) )
  1134.       else WriteStr(11,door.StatusBarY,'Θ7 Local Mode ');
  1135.     WriteStr(23,door.StatusBarY,'Θ8│ΘF'+padEstr(username,' ',25)+'Θ8│Θ7'+
  1136.              padEstr(OSStr[SystemEnv],' ',22)+'Θ8│Θ0F1Θ9:Θ0helpΘ8│');
  1137.   end;
  1138. end;
  1139. {───────────────────────────────────────────────────────────────────────────}
  1140. Procedure HideStatusBar;
  1141. var x,y,a:byte;
  1142. begin
  1143.   door.UpdateStatusBar:=false;
  1144.   door.localmaxy:=door.statusbarY;
  1145.   x:=virtx; y:=virty;
  1146.   window(1,1,80,door.StatusBarY);
  1147.   gotoxy(1,door.StatusBarY);
  1148.   a:=textattr; textattr:=7; clreol; textattr:=a;
  1149.   gotoxy(x,y); showcursor; {incase it needs to be "popped into view"}
  1150. end;
  1151. {───────────────────────────────────────────────────────────────────────────}
  1152. Procedure RecordMacro;
  1153. {■ This procedure will only record a macro up to 79 characters
  1154.    This is a very cheesy procedure, and needs to be updated.}
  1155. var s:string[79];c:char; os:string;
  1156. begin
  1157.   { Save the current screen }
  1158. (*  fillchar(TmpScreen^,sizeof(TmpScreen^),0);
  1159.   move(mem[$B800:0000],TmpScreen^,Sizeof(TmpScreen^));
  1160.   TextAttr:=7;
  1161.   sioclrscr;
  1162.   {help screen goes here}
  1163.   putstr('Θ>');
  1164.  
  1165.   os:=MacroStr;
  1166.   c:=Getstr(s,79,[#233]+charset);
  1167.   case c of
  1168.     #13 : MacroStr:=s;
  1169.     #27 : MacroStr:=os;
  1170.   end;*)
  1171. end;
  1172. {───────────────────────────────────────────────────────────────────────────}
  1173. Procedure Wait;
  1174. var
  1175.   u,chs,shs,CurSec,StartSec: Word;
  1176. begin
  1177.   GetTime(u,u,StartSec,shs);
  1178.   while Seconds>0 do begin
  1179.   {v- wait for 1 sec to go by; this isn't 100% correct, and should be changed}
  1180.     repeat
  1181.       GetTime(u,u,CurSec,chs);
  1182.       ReleaseTimeSlice;
  1183.       ReleaseTimeSlice;{}
  1184.     until (CurSec<>StartSec){and(chs<=shs)};
  1185.     StartSec:=CurSec;
  1186.     Dec(Seconds);
  1187.   end;
  1188. end;
  1189. {───────────────────────────────────────────────────────────────────────────}
  1190.  
  1191. {───────────────────────────────────────────────────────────────────────────}
  1192. Procedure DisplayAnsiFile;
  1193. label again;
  1194. var
  1195.   f:text;
  1196.   a:byte;{}
  1197.   x,y,ta,l:byte;
  1198.   ch:char;
  1199.   st1:string[235];
  1200.   st2:string;
  1201.   extra,tmp:string[20];{}
  1202. begin
  1203.   assign(f,fn);
  1204.   {$I-} reset(f); {$I+}
  1205.   if IOresult<>0 then begin
  1206.     siowriteln(#13#10'File "'+fn+'" not found!');
  1207.     wait(2);
  1208.     exit;
  1209.   end;
  1210.  
  1211.   SkipReadkey:=true;
  1212.   ch:=#13;
  1213.   extra:=''; st1:=''; st2:='';
  1214.   while not eof(f) do begin
  1215. {    read(f,st1);{}
  1216.     if not eoln(f) then begin
  1217. again:
  1218.       read(f,st1)
  1219.     end else begin
  1220.       readln(f,st1);
  1221.       siowriteln('');
  1222.       goto again;
  1223.     end;{}
  1224.     st2:=extra+st1;
  1225.     if length(st2)>=high(st1) then begin
  1226.       extra:=copy(st2,length(st2)-19,20);
  1227.       a:=20;
  1228.       while (extra[a]<>#27)and(a>=1) do dec(a);
  1229.       if a>=1 then begin
  1230.         delete(extra,1,a-1);
  1231.         delete(st2,length(st2)-(20-a),(20-a));
  1232.       end;
  1233.     end else extra:='';
  1234.  
  1235.     ANSIwrite(st2);
  1236.  
  1237.     if siokeypressed then if sioreadkey=#32 then begin {space bar stops output}
  1238.       PurgeOutput;
  1239. {      close(f);{}
  1240.       break;
  1241.     end;
  1242.  
  1243.     if (lines<>0)and(door.CurLine<lines) then inc(door.Curline)
  1244.       else if (lines<>0)and(ch<>'=') then begin
  1245. {        door.CurLine:=1;{}
  1246.         ta:=textattr;                     {save the current color}
  1247.         if door.UseAnsi then begin
  1248.           x:=virtx; y:=virty;
  1249.           sendstr(#27'[s');
  1250.         end else begin
  1251.           x:=1; y:=virty;
  1252.         end;
  1253. {        putstr(#13'ΘaΘFMΘ7ore Θ8∙ ΘFSΘ7top Θ8∙ ΘFNΘ7on-Stop Θ7[M,s,n]');{}
  1254.         putstr(#13'ΘaΘFMore? Θ7[ΘFYΘ7,ΘFnΘ7,ΘF=Θ7]: ');
  1255.         ch:=hotkey(['Y','N','=',#13]);
  1256.         putstr(#13'Θa                '#13);
  1257.         if door.UseAnsi then sendstr(#27'[u');
  1258.         gotoxy(x,y);
  1259.         textattr:=ta;
  1260.         if ch='N' then break;
  1261.       end;
  1262. {    switch_task;{}
  1263.   end;
  1264.   SkipReadkey:=false;
  1265.   siowriteln('');
  1266.   close(f);
  1267. end;
  1268. {───────────────────────────────────────────────────────────────────────────}
  1269. Procedure DisplayTextFile;
  1270. begin
  1271. end;
  1272. {───────────────────────────────────────────────────────────────────────────}
  1273. Procedure ANSIWrite;
  1274. {CREDIT: Written by Gayle Davis.  Modified by Lief O'Pardy, its a little
  1275.          faster, and more efficient. }
  1276. const
  1277.   savex : byte = 1;
  1278.   savey : byte = 1;
  1279. var
  1280.   MusicStr : string;
  1281.   MusicPos : integer;
  1282.   {-----------------------------------}
  1283.   Procedure ProcessEsc;
  1284.   var
  1285.     DeleteNum : integer;
  1286.     ts : string[5];
  1287.     Num : array[0..10] of shortint;
  1288.     Color : integer;
  1289.   Label
  1290.     loop;
  1291.   {-----------------------------------}
  1292.     Procedure GetNum(cx : byte);
  1293.     var
  1294.       code : integer;
  1295.     begin {getnum}
  1296.       ts := '';
  1297.       while (s[1] in ['0'..'9']) and (length(s) > 0) do begin
  1298.         ts := ts + s[1];
  1299.         Delete(s,1,1);
  1300.       end;
  1301.       val(ts,Num[cx],code)
  1302.     end;
  1303.   {-----------------------------------}
  1304.   begin {processesc}
  1305.     if s[2] <> '[' then exit;
  1306.     Delete(s,1,2);
  1307. (*    if (UpCase(s[1]) = 'M') and (UpCase(s[2]) in ['F','B',#32]) then begin
  1308.       Delete(s,1,2);
  1309.       MusicPos := pos(#14,s);
  1310. {      Play(copy(s,1,MusicPos-1));{}
  1311.       DeleteNum := MusicPos;
  1312.       Goto Loop;
  1313.     end;*)
  1314.     fillchar(Num,sizeof(Num),#0);
  1315.     GetNum(0);
  1316.     DeleteNum := 1;
  1317.     while (s[1] = ';') and (DeleteNum < 11) do begin
  1318.       Delete(s,1,1);
  1319.       GetNum(DeleteNum);
  1320.       inc(DeleteNum);
  1321.     end;
  1322.     case UpCase(s[1]) of
  1323.       'A' : begin {move up}
  1324.         if Num[0]=0 then Num[0]:=1;
  1325.         sioCursorUp(Num[0]);
  1326.         DeleteNum:=1;
  1327.       end;
  1328.       'B' : begin {move down}
  1329.         if Num[0]=0 then Num[0]:=1;
  1330.         sioCursorDown(num[0]);
  1331.         DeleteNum:=1;
  1332.       end;
  1333.       'C' : begin {move right}
  1334.         if Num[0]=0 then Num[0]:=1;
  1335.         sioCursorRight(num[0]);
  1336.         DeleteNum:=1;
  1337.       end;
  1338.       'D' : begin {move left}
  1339.         if Num[0]=0 then Num[0]:=1;
  1340.         sioCursorLeft(num[0]);
  1341.         DeleteNum:=1;
  1342.       END;
  1343.       'H','F' : begin {goto xy}
  1344.         if Num[0]=0 then Num[0]:=1;
  1345.         if Num[1]=0 then Num[1]:=1;
  1346.         sioGotoxy(Num[1],Num[0]);
  1347.         DeleteNum:=1;
  1348.       end;
  1349.       'S' : begin {save current position}
  1350.         SaveX := virtx;
  1351.         SaveY := virty;
  1352.         SendStr(#27'[s');
  1353.         DeleteNum:=1;
  1354.       end;
  1355.       'U' : begin {restore saved position}
  1356.         GotoXY(SaveX,SaveY);
  1357.         SendStr(#27'[u');
  1358.         DeleteNum:=1;
  1359.       end;
  1360.       'J' : begin {clear screen}
  1361.         case num[0] of
  1362.           0 : ;  {clear everything below cursor}
  1363.           1 : ;  {clear everything above cursor}
  1364.           2 : sioClrScr;
  1365.         end;
  1366.         DeleteNum:=1;
  1367.       end;
  1368.       'K' : begin {clear EOL}
  1369.         sioClrEol;
  1370.         DeleteNum:=1;
  1371.       end;
  1372.       'M' : begin
  1373.         DeleteNum:=0;
  1374.         while (Num[DeleteNum] <> 0) or (DeleteNum = 0) do begin
  1375.           case Num[DeleteNum] of
  1376.             0 : if door.USEcolor then begin
  1377.               textattr:=7;
  1378.               SendStr(#27'[0m');
  1379.               Bold:=false;
  1380.             end;
  1381.             1 : if door.USEcolor then begin
  1382.               Bold:=true;
  1383.               HighVideo;
  1384.             end;
  1385.             5 : if door.USEcolor then textattr:=textattr or blink;
  1386.             7 : if door.USEcolor then textattr:=((textattr and $07)shl 4)+((textattr and $70)shr 4);
  1387.             8 : if door.USEcolor then textattr:=0;
  1388.             30..37 : if door.USEcolor then begin
  1389.               color := ColAry[Num[DeleteNum]-30];
  1390.               if Bold then inc(color,8);
  1391.               textcolor((textattr and blink)+color);
  1392.             end;
  1393.             40..47 : if door.USEcolor then textbackground(ColAry[Num[DeleteNum]-40]);
  1394.           end; {of case}
  1395.           inc(DeleteNum);
  1396.         end; {while}
  1397.         DeleteNum:=1;
  1398.       end; {'M'}
  1399.       '?' : begin delete(s,1,3); deletenum:=0; end;
  1400.       {^- "thedraw" always puts this code at the beginning of any ansi
  1401.           files it creates... why? who knows...}
  1402.     end; {of case}
  1403. loop:
  1404.     Delete(s,1,DeleteNum);
  1405.   end;
  1406.   {-----------------------------------}
  1407. begin
  1408.   while length(s)>0 do begin
  1409.     if s[1]=#27 then begin
  1410.       ProcessEsc;
  1411.     end else begin
  1412.       sioWritec(s[1]);
  1413.       Delete(s,1,1);
  1414.     end;
  1415.   end;
  1416. end;
  1417. {───────────────────────────────────────────────────────────────────────────}
  1418. Procedure ANSIWriteLn;
  1419. begin
  1420.   ANSIWrite(s);
  1421.   sioWriteLn('');
  1422. end;
  1423. {───────────────────────────────────────────────────────────────────────────}
  1424.  
  1425. {───────────────────────────────────────────────────────────────────────────}
  1426. function InitVirtScr:boolean;
  1427. begin
  1428.   initvirtscr:=false;
  1429.   if not door.usevirtscr then begin
  1430.     if (VirtScr=nil) and (maxavail>sizeof(VirtScr^)) then begin
  1431.       getmem(VirtScr,sizeof(virtscr^));
  1432.       fillword(virtscr^,sizeof(virtscr^),7,' ');   {Clear the buffer}
  1433.       virtx:=1; virty:=1;
  1434.       door.UseVirtScr:=true;
  1435.     end else door.UseVirtScr:=false;
  1436.  
  1437.     InitVirtScr:=door.UseVirtScr;
  1438.   end;
  1439. end;
  1440. {───────────────────────────────────────────────────────────────────────────}
  1441. procedure FreeVirtScr;
  1442. begin
  1443.   if VirtScr<>nil then freemem(VirtScr,sizeof(virtscr^));
  1444.   virtscr:=nil; {freemem does'nt assign "nil" to a freed ptr}
  1445.   door.UseVirtScr:=false;
  1446. end;
  1447. {───────────────────────────────────────────────────────────────────────────}
  1448. procedure DrawScr(scr:pointer; x1,y1,x2,y2:byte);
  1449. {smart color should be ON for this procedure}
  1450. var x,y,vx,vy:byte;
  1451. begin
  1452.   vx:=virtx; vy:=virty;
  1453.   if scr=nil then begin
  1454.     sioclrscr;
  1455.   end else begin
  1456.     for y := y1-1 to y2-1 do begin
  1457.       siogotoxy(x1,y+1);
  1458.       for x := x1-1 to x2-1 do if (y<>25-1)or(x<>80-1) then begin
  1459.         textattr:=tscreen(scr^)[y,(x*2)+1];
  1460.         siowritec(char(tscreen(scr^)[y,(x*2)]));
  1461.       end;
  1462.     end;
  1463.     siogotoxy(vx,vy);  {restore the cursor position}
  1464.   end;
  1465. end;
  1466. {───────────────────────────────────────────────────────────────────────────}
  1467.  
  1468.  
  1469. {───────────────────────────────────────────────────────────────────────────}
  1470. Procedure CheckKickedOut; far;
  1471. {This doesn't get called directly.  It's put into the ExitChain.}
  1472. begin
  1473.   if KickedOut then begin
  1474.     textattr:=15;
  1475.     siowriteln(#13#10'» You have been kicked out of the DOOR; and are returning to the BBS! «'#13#10);
  1476.     textattr:=7;
  1477.   end;
  1478. {    putstr('Θ>Θ>Θ4ΘaΘ[»Θ] ΘCYou have been kicked out of the DOOR; and are returning to the BBS! Θ4Θ[«Θ]Θ>');}
  1479. end;
  1480. {───────────────────────────────────────────────────────────────────────────}
  1481. Procedure COMMIO_Done; far;
  1482. {This doesn't get called directly.  It's put into the ExitChain.}
  1483. begin
  1484.   FlushOutput;{}
  1485.   HideStatusBar;
  1486.   NormVideo; {textattr:=7;}
  1487.   FreeVirtScr;
  1488. {  writeln(#13#10'■ Shutting Comport down...');{}
  1489.   DeInitComport;
  1490. {  wait(1);{}
  1491. end;
  1492. {───────────────────────────────────────────────────────────────────────────}
  1493.  
  1494. var u:word; l:longint;
  1495.  
  1496. begin
  1497.   GetTime(starttime.hour,starttime.min,starttime.sec,u);
  1498.   GetDate(starttime.year,starttime.month,starttime.day,u);
  1499.   AddtoExitChain(COMMIO_Done);
  1500.   AddtoExitChain(CheckKickedOut);
  1501.  
  1502.   textattr:=7;
  1503. (*  textmode(co80{+font8x8});*)
  1504.   clrscr;
  1505.  
  1506.   textattr:=15;
  1507.   SystemEnv:=NoTasker;
  1508.   DetectOS;{}
  1509.   Case SystemEnv of
  1510.     NoTasker  : Writeln('■ No Multi-Tasker detected.');
  1511.     DDOS      : Writeln('■ Double-Dos detected.');
  1512.     DV        : Writeln('■ DesqView detected.');
  1513.     WIN       : Writeln('■ Windows detected.');
  1514.     OS2       : Writeln('■ OS/2 detected.');
  1515.     NetWare   : Writeln('■ Network detected.');
  1516.   end;
  1517. {  wait(1); {wait 1 second}
  1518.   textattr:=7;
  1519.  
  1520.   with door do begin
  1521.     UserName    := 'John Doe';
  1522.     ComPort     := 0;
  1523.     Baudrate    := 0;
  1524.     WhichIO     := InternalIO;
  1525.     IOinstalled := false;
  1526.     InBufSize   := 512;
  1527.     OutBufSize  := 1024;
  1528.     IRQ         := 4;
  1529.     WordSize    := 8;
  1530.     Parity      := 'N';
  1531.     StopBits    := 1;
  1532.     node        := 0;
  1533.     UseAnsi     := true;
  1534.     UseColor    := true;
  1535.     UseAni      := true;
  1536.     SmartColor  := true;
  1537.     LocalInputON:= true;
  1538.     UpdateLocal := true;
  1539.     UpdateStatusBar := true;
  1540.     UseVirtScr  := false;
  1541.     StatusBarY  := 25;
  1542.     LocalMaxY   := 25;
  1543.     GetTime(curtime.hour,curtime.min,curtime.sec,u);
  1544.     l:=MaxTimeAllowed div 60; {this must be done in two steps!  otherwise it}
  1545.     l:=l*60*60;               {overflows a word and gives the wrong result}
  1546.     SecsLeft    := l;
  1547.     SecsOn      := 1;
  1548.     KickoffIdle := 5*60;
  1549.     LocalKey    := true;
  1550.     OnLine      := true;
  1551.     PauseLine   := 24;
  1552.     CurLine     := 1;
  1553.   end;
  1554.  
  1555.   SkipReadkey:=false;
  1556.   Beeped:=false;
  1557.   KickedOut:=false;
  1558.   CurColor:=TextAttr;
  1559. {  ShowStatusBar;{}
  1560. end.                              I AM GOD!