/pliant/graphic/image/lazy.pli
 
 1  module "/pliant/language/compiler.pli" 
 2  module "/pliant/language/stream.pli" 
 3  module "/pliant/graphic/color/gamut.pli" 
 4  submodule "prototype.pli" 
 5  module "/pliant/language/compiler/type/inherit.pli" 
 6  module "/pliant/graphic/filter/prototype.pli" 
 7  module "/pliant/graphic/filter/all.pli" 
 8   
 9   
 10  type ImageLazy 
 11    inherit ImagePrototype 
 12    field Link:Stream stream 
 13    field Link:ImageReadFilter filter 
 14    field Int current 
 15    field Array:Address buffers 
 16    field CBool crashed 
 17    field Sem sem 
 18   
 19  ImagePrototype maybe ImageLazy 
 20   
 21  function destroy p 
 22    arg_w ImageLazy p 
 23    if (exists p:filter) 
 24      p:filter close 
 25    for (var Int i) p:buffers:size-1 
 26      memory_free p:buffers:i 
 27       
 28   
 29  method p bind filename options -> status 
 30    oarg_rw ImageLazy p ; arg Str filename options ; arg ExtendedStatus status 
 31    if (exists p:filter) 
 32      p:filter close 
 33    p:buffers size := 0 
 34    filter :> image_read_filter (shunt (options option "filter") (options option "filter" Str) filename) 
 35    if not (exists p:filter) 
 36      return (failure "There is no filter for '"+filename+"' image") 
 37    crashed := true 
 38    stream :> new Stream 
 39    p:stream open filename options in+safe 
 40    if p:stream=failure 
 41      filter :> null map ImageReadFilter 
 42      return (failure "Failed to open "+filename) 
 43    status := p:filter open p:stream options (var ImagePrototype h) 
 44    if status=failure 
 45      filter :> null map ImageReadFilter 
 46      return 
 47    addressof:map ImagePrototype := h 
 48    if status=success 
 49      p:buffers size := 1+(options option "backward" Int 0) 
 50      for (var Int i) p:buffers:size-1 
 51        p:buffers := memory_allocate h:line_size addressof:p 
 52      crashed := false 
 53    current := -1 
 54   
 55  method p bind stream options -> status 
 56    oarg_rw ImageLazy p ; arg_rw Stream stream ; arg Str options ; arg ExtendedStatus status 
 57    if (exists p:filter) 
 58      p:filter close 
 59    for (var Int i) p:buffers:size-1 
 60      memory_free p:buffers:i 
 61    p:buffers size := 0 
 62    crashed := true 
 63    filter :> image_read_filter (options option "filter" Str) 
 64    if not (exists p:filter) 
 65      return (failure "There is no filter for '"+(options option "filter" Str)+"' image") 
 66    stream :> stream 
 67    status := p:filter open p:stream options (var ImagePrototype h) 
 68    if status=failure 
 69      filter :> null map ImageReadFilter 
 70      return 
 71    addressof:map ImagePrototype := h 
 72    if status=success 
 73      p:buffers size := 1+(options option "backward" Int 0) 
 74      for (var Int i) p:buffers:size-1 
 75        p:buffers := memory_allocate h:line_size addressof:p 
 76      crashed := false 
 77    current := -1 
 78   
 79  method p setup image options -> status 
 80    oarg_rw ImageLazy p ; arg ImagePrototype image ; arg Str options ; arg ExtendedStatus status 
 81    var Str file := options option "file" Str 
 82    if file="" 
 83      return failure:"File name not specified" 
 84    status := bind file options 
 85   
 86   
 87  method p read x y count adr 
 88    arg_rw ImageLazy p ; arg Int count ; arg Address adr 
 89    check x>=and count>=and x+count<=p:size_x and y>=and y<p:size_y 
 90    p:sem request 
 91    while p:current<and not p:crashed 
 92      current += 1 
 93      if (p:filter readline p:buffers:(p:current%p:buffers:size))=success 
 94        if p:current=p:size_y-1 
 95          p:filter close 
 96          filter :> null map ImageReadFilter 
 97      else 
 98        crashed := true 
 99    p:sem release 
 100    if p:crashed 
 101      memory_clear adr count*p:gamut:pixel_size 
 102    eif y>p:current-p:buffers:size and y<=p:current 
 103      memory_copy (p:buffers:(y%p:buffers:size) translate Byte x*p:gamut:pixel_size) adr count*p:gamut:pixel_size 
 104    else 
 105      error error_id_unexpected "Wrong line "+string:y+" (cursor was at "+(string p:current)+" and there is a "+(string p:buffers:size)+" lines buffer) requested from lazy image" 
 106   
 107   
 108  function 'cast Status' p -> status 
 109    arg ImageLazy p ; arg Status status 
 110    extension 
 111    status := shunt p:buffers:size<>0 success failure 
 112   
 113   
 114  export ImageLazy '. bind' 'cast Status' 
 115   
 116