[Back to COMM SWAG index] [Back to Main SWAG index] [Original]

    {
    Since there has been a couple people asking for COMM routines here, I
    thought I would post my source code from my DOOR game GRUNT! They are
    FOSSIL routines that will work well with BNU.
    }
     (*
     ÚÄ¿ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
     ³*³³ÜÛÛÛÛÛÜ ÛÛÛÛÛÛÜ ÛÛ   ÛÛ ÜÛÛÛÛÛÜ ÛÛÛÛÛÛÛ                                  ³
     ³*³³ÛÛ  ÜÜÜ ÛÛ   ÛÛ ÛÛ   ÛÛ ÛÛ   ÛÛ   ÞÛÝ                                    ³
     ³*³³ÛÛ   ÛÛ ÛÛÛÛÛÛ  ÛÛ   ÛÛ ÛÛ   ÛÛ   ÞÛÝ                                    ³
     ³*³³ßÛÛÛÛÛß ÛÛ  ßÛÛ ßÛÛÛÛÛß ÛÛ   ÛÛ   ÞÛÝ                                    ³
     ÀÄÙÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
     ÚÄ¿ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
     ³*³³ (c)1995 by Michael S. Hoenie - All Rights Reserved.                     ³
     ÀÄÙÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
      *)

      unit fossil;

      {$S-,V-,R-}

      interface uses dos;

      type
       fossildatatype = record
                         strsize: word;
                         majver: byte;
                         minver: byte;
                         ident: pointer;
                         ibufr: word;
                         ifree: word;
                         obufr: word;
                         ofree: word;
                         swidth: byte;
                         sheight: byte;
                         baud: byte;
                        end;
      var
       port_num: integer;
       fossildata: fossildatatype;

      procedure fossil_send(ch: char);
      procedure fossil_send_string(S:STRING);
      function fossil_receive(var ch: char): boolean;
      function fossil_carrier_drop: boolean;
      function fossil_carrier_present: boolean;
      function fossil_buffer_check: boolean;
      function fossil_init_fossil: boolean;
      procedure fossil_deinit_fossil;
      procedure fossil_flush_output;
      procedure fossil_purge_output;
      procedure fossil_purge_input;
      procedure fossil_set_dtr(state: boolean);
      procedure fossil_watchdog_on;
      procedure fossil_watchdog_off;
      procedure fossil_warm_reboot;
      procedure fossil_cold_reboot;
      procedure fossil_Set_baud(n: integer);
      procedure fossil_set_flow(SoftTran,Hard,SoftRecv: boolean);
      procedure fossil_Buffer_Status(var Insize,Infree,OutSize,Outfree: word);

      implementation

      procedure fossil_send(ch: char);
      var
       regs: registers;
      begin;
       regs.al:=ord(ch);
       regs.dx:=port_num;
       regs.ah:=1;
       intr($14,regs);
      end;

      procedure fossil_send_string(S:STRING);
      var
       a: integer;
      begin;
       for a:=1 to length(s) do fossil_send(s[a]);
      end;

      function fossil_receive(var ch: char): boolean;
      var
       regs: registers;
      begin;
       ch:=#0;
       regs.ah:=3;
       regs.dx:=port_num;
       intr($14,regs);
       if (regs.ah and 1)=1 then begin;
        regs.ah:=2;
        regs.dx:=port_num;
        intr($14,regs);
        ch:=chr(regs.al);
        fossil_receive:=true;
       end else fossil_receive:=false;
      end;

      function fossil_carrier_drop: boolean;
      var
       regs: registers;
      begin;
       regs.ah:=3;
       regs.dx:=port_num;
       intr($14,regs);
       if (regs.al and $80)<>0 then
         fossil_carrier_drop:=false
           else fossil_carrier_drop:=true;
      end;

      function fossil_carrier_present: boolean;
      var
       regs: registers;
      begin;
       regs.ah:=3;
       regs.dx:=port_num;
       intr($14,regs);
       if (regs.al and $80)<>0 then
          fossil_carrier_present:=true else
            fossil_carrier_present:=false;
      end;

      function fossil_buffer_check: boolean;
      var
       regs: registers;
      begin;
       regs.ah:=3;
       regs.dx:=port_num;
       intr($14,regs);
       if (regs.ah and 1)=1 then fossil_buffer_check:=true else
         fossil_buffer_check:=false;
      end;

      function fossil_init_fossil: boolean;
      var
       regs: registers;
      begin;
       regs.ah:=4;
       regs.bx:=0;
       regs.dx:=port_num;
       intr($14,regs);
       if regs.ax=$1954 then fossil_init_fossil:=true else
         fossil_init_fossil:=false;
      end;

      procedure fossil_deinit_fossil;
      var
       regs: registers;
      begin;
       regs.ah:=5;
       regs.dx:=port_num;
       intr($14,regs);
      end;

      procedure fossil_set_dtr(state: boolean);
      var
       regs: registers;
      begin;
       regs.ah:=6;
       if state then regs.al:=1 else regs.al:=0;
       regs.dx:=port_num;
       intr($14,regs);
      end;

      procedure fossil_flush_output;
      var
       regs: registers;
      begin;
       regs.ah:=8;
       regs.dx:=port_num;
       intr($14,regs);
      end;

      procedure fossil_purge_output;
      var
       regs: registers;
      begin;
       regs.ah:=9;
       regs.dx:=port_num;
       intr($14,regs);
      end;

      procedure fossil_purge_input;
      var
       regs: registers;
      begin;
       regs.ah:=$0a;
       regs.dx:=port_num;
       intr($14,regs);
      end;

      procedure fossil_watchdog_on;
      var
       regs: registers;
      begin;
       regs.ah:=$14;
       regs.al:=01;
       regs.dx:=port_num;
       intr($14,regs);
      end;

      procedure fossil_watchdog_off;
      var
       regs: registers;
      begin;
       regs.ah:=$14;
       regs.al:=00;
       regs.dx:=port_num;
       intr($14,regs);
      end;

      procedure fossil_warm_reboot;
      var
       regs: registers;
      begin;
       regs.ah:=$17;
       regs.al:=01;
       intr($14,regs);
      end;

      procedure fossil_cold_reboot;
      var
       regs: registers;
      begin;
       regs.ah:=$17;
       regs.al:=00;
       intr($14,regs);
      end;

      procedure fossil_set_baud(n: integer);
      var
       regs: registers;
      begin;
       regs.ah:=00;
       regs.al:=3;
       regs.dx:=port_num;
       case n of
        300: regs.al:=regs.al or $40;
        1200: regs.al:=regs.al or $80;
        2400: regs.al:=regs.al or $A0;
        4800: regs.al:=regs.al or $C0;
        9600: regs.al:=regs.al or $E0;
        19200: regs.al:=regs.al or $00;
        else regs.al:=regs.al or $00;
       end;
       intr($14,regs);
      end;

      procedure fossil_set_flow(SoftTran,Hard,SoftRecv: boolean);
      var
       regs: registers;
      begin;
       regs.ah:=$0F;
       regs.al:=00;
       if softtran then regs.al:=regs.al or $01;
       if Hard then regs.al:=regs.al or $02;
       if SoftRecv then regs.al:=regs.al or $08;
       regs.al:=regs.al or $F0;
       Intr($14,regs);
      end;

      procedure fossil_get_fossil_data;
      var
       regs: registers;
      begin;
       regs.ah:=$1B;
       regs.cx:=sizeof(fossildata);
       regs.dx:=port_num;
       regs.es:=seg(fossildata);
       regs.di:=ofs(fossildata);
       intr($14,regs);
      end;

      procedure fossil_Buffer_Status(var Insize,Infree,OutSize,Outfree: word);
      begin;
       fossil_get_fossil_data;
       insize:=fossildata.ibufr;
       infree:=fossildata.ifree;
       outsize:=fossildata.obufr;
       outfree:=fossildata.ofree;
      end;

      end.

[Back to COMM SWAG index] [Back to Main SWAG index] [Original]