home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / BEEHIVE / UTILITYS / PUDD.ARC / GENTOOLS.PAS < prev    next >
Pascal/Delphi Source File  |  1991-08-11  |  4KB  |  102 lines
  1.  
  2. {**************************************************************************
  3.  * setbitB(bit, byte) - set bit #bit in byte
  4.  *
  5.  * input -> (char), (integer)
  6.  *
  7.  * Results -> The 'bit'th bit in `byte` is set.  Bits are numbered as laid
  8.  *            out below:
  9.  *                        7 6 5 4 3 2 1 0
  10.  *************************************************************************}
  11. procedure setbitB(bit : integer; var subject : byte);
  12. var       tmp  : integer;
  13.           i    : integer;
  14.           temp : byte;
  15. begin
  16.     temp := subject;
  17.     tmp := 1;
  18.     for i := 1 to bit do
  19.        tmp := tmp * 2;
  20.     inline($3A/temp/      { ld   A,(nn)   ;get the byte     }
  21.            $21/tmp/       { ld   HL,nn    ;get the mask adr }
  22.            $56/           { ld   D,(HL)   ;get the mask     }
  23.            $B2/           { or   D        ;use it           }
  24.            $32/temp);     { ld   (nn),A   :put it back      }
  25.     subject := temp;
  26. end; { setbitB }
  27.  
  28.  
  29.  
  30. {**************************************************************************
  31.  * clrbitB(bit, byte) - clear bit #bit in byte
  32.  *
  33.  * input -> (char), (integer)
  34.  *
  35.  * Results -> The 'bit'th bit in `byte` is cleared.  Bits are numbered as
  36.  *            laid out below:
  37.  *                        7 6 5 4 3 2 1 0
  38.  *************************************************************************}
  39. procedure clrbitB(bit : integer; var subject :byte);
  40. var       tmp  : integer;
  41.           i    : integer;
  42.           temp : byte;
  43. begin
  44.     temp := subject;
  45.     tmp := 1;
  46.     for i := 1 to bit do
  47.        tmp := tmp * 2;
  48.     inline($21/tmp/       { ld   HL,nn    ;get the mask adr }
  49.            $7E/           { ld   A,(HL)   ;get the mask     }
  50.            $2F/           { cpl           ;compliment       }
  51.            $21/temp/      { ld   HL,nn    ;get the byte adr }
  52.            $56/           { ld   D,(HL)   ;get the byte     }
  53.            $A2/           { and  D        ;mask it          }
  54.            $32/temp);     { ld   (nn),A   :put it back      }
  55.     subject := temp;
  56. end; { clrbitB }
  57.  
  58.  
  59. {**************************************************************************}
  60. {*   ReadByte will return a charactor string with the correct a series    *}
  61. {*  1's and 0's in an 8 charactor string to represent the actual bits     *}
  62. {*  in the byte.                                                          *}
  63. {**************************************************************************}
  64. procedure ReadByte(sample:byte; var Bitlist:Blist);
  65. var  ListLocal  :Blist;
  66.      ByteLocal  :byte;
  67. begin
  68.  ListLocal := '00000000';
  69.  ByteLocal := sample;
  70.      inline($3A/ByteLocal/   { LD A,(ByteLocal)   }
  71.             $21/ListLocal/   { LD HL,ListLocal    }
  72.             $06/$30/         { LD  B,0            }
  73.             $0E/$31/         { LD  C,1            }
  74.             $16/$08/         { LD  D,8            }
  75.             $23/             { INC HL      :top   }
  76.             $CB/$47/         { BIT 1,A            }
  77.             $20/$03/         { JR  NZ,one         }
  78.             $70/             { LD  (HL),B         }
  79.             $18/$01/         { JR  done           }
  80.             $71/             { LD  (HL),C  :one   }
  81.             $CB/$1F/         { RR  A       :done  }
  82.             $15/             { DEC D              }
  83.             $20/$F2 );       { JR  NZ,top         }
  84.  Bitlist := ListLocal;
  85. end; {........................      ......ReadByte}
  86. {**************************************************************************}
  87.  
  88.  
  89.  
  90. procedure FlipList(var BitList:Blist);
  91. var i,j   :integer;
  92.     temp  :Blist;
  93. begin
  94.  temp := '';
  95.  for i := 8 downto 1 do
  96.   begin
  97.    temp := temp + copy(BitList,i,1);
  98.   end;
  99.  BitList := temp;
  100. end;
  101.  
  102.