extra/tools/image-analyzer/utils/utils.factor

   1 USING: accessors alien alien.c-types alien.data arrays bit-arrays
   2 classes continuations destructors fry io io.streams.throwing kernel
   3 locals math math.bitwise namespaces sequences words ;
   4 IN: tools.image-analyzer.utils
   5
   6 : untag ( ptr -- ptr' )
   7     15 unmask ;
   8
   9 : class-heap-size ( instance -- n )
  10     class-of heap-size ;
  11
  12 : read-bytes>array ( nbytes type -- seq )
  13     [ read ] dip cast-array >array ;
  14
  15 : read-array ( count type -- seq )
  16     [ heap-size * ] keep read-bytes>array ;
  17
  18 : byte-array>bit-array ( byte-array -- bit-array )
  19     [ integer>bit-array 8 f pad-tail ] { } map-as concat ;
  20
  21 : word>byte-array ( word -- byte-array )
  22     word-code over - [ <alien> ] dip memory>byte-array ;
  23
  24 : until-eof-reader ( reader-quot -- reader-quot' )
  25     '[
  26         [ _ throw-on-eof ] [
  27             dup stream-exhausted? [ drop f ] [ throw ] if
  28         ] recover
  29     ] ; inline
  30
  31 : save-io-excursion ( quot -- )
  32     tell-input '[ _ seek-absolute seek-input ] finally ; inline
  33
  34 : consume-stream>sequence ( reader-quot: ( -- item )  -- seq )
  35     until-eof-reader '[ drop @ ] t swap follow rest ; inline
  36
  37 TUPLE: backwards-reader stream ;
  38
  39 M: backwards-reader dispose stream>> dispose ;
  40
  41 M: backwards-reader stream-element-type
  42     stream>> stream-element-type ;
  43
  44 M: backwards-reader stream-length
  45     stream>> stream-length ;
  46
  47 : backwards-seek ( ofs -- )
  48     dup 0 < [ seek-end ] [ seek-absolute ] if seek-input ;
  49
  50 M:: backwards-reader stream-read-unsafe ( n buf stream -- count )
  51     stream stream>> [
  52         tell-input n + :> pos-after
  53         pos-after neg backwards-seek
  54         n buf input-stream get stream-read-unsafe
  55         pos-after backwards-seek
  56     ] with-input-stream* ;
  57
  58 : <backwards-reader> ( stream -- stream' )
  59     backwards-reader boa ;