Patch title: Release 96 bulk changes
Abstract:
File: /pliant/graphic/draw/displaylist.pli
Key:
    Removed line
    Added line
   
module "/pliant/language/compiler.pli"
module "/pliant/math/transform.pli"
module "prototype.pli"
module "misc.pli"
module "/pliant/graphic/image/packed.pli"
module "/pliant/graphic/image/clip.pli"
module "/pliant/graphic/draw/image.pli"
module "/pliant/graphic/misc/bytes.pli"


method d flat_play draw filter model options -> status
  oarg_rw DrawPrototype d draw filter ; arg Str model option
  var Link:ImagePrototype bd :> draw backdrop ""
  if not exists:bd
    return failure
  var ImagePrototype proto ; var Int tx ty
  var Link:ImagePrototype mask :> draw backdrop "clip_mask"
  if exists:mask
    # console "group mask" eol
    proto := image_prototype mask:x0 mask:y0 mask:x1 mask:y1
    tx := bd index_x mask:x0
    ty := bd index_y mask:y0
  else
    proto := bd
    tx := 0
    ty := 0
  var Float opacity := model option "opacity" Float 1
  # if opacity<>1
  #   console "group opacity " opacity eol
  var Str mixture := model option "mixture" Str
  # if mixture<>""
  #   console "grou mixture " mixture eol
module "/pliant/language/compiler.pli"
module "/pliant/math/transform.pli"
module "prototype.pli"
module "misc.pli"
module "/pliant/graphic/image/packed.pli"
module "/pliant/graphic/image/clip.pli"
module "/pliant/graphic/draw/image.pli"
module "/pliant/graphic/misc/bytes.pli"


method d flat_play draw filter model options -> status
  oarg_rw DrawPrototype d draw filter ; arg Str model option
  var Link:ImagePrototype bd :> draw backdrop ""
  if not exists:bd
    return failure
  var ImagePrototype proto ; var Int tx ty
  var Link:ImagePrototype mask :> draw backdrop "clip_mask"
  if exists:mask
    # console "group mask" eol
    proto := image_prototype mask:x0 mask:y0 mask:x1 mask:y1
    tx := bd index_x mask:x0
    ty := bd index_y mask:y0
  else
    proto := bd
    tx := 0
    ty := 0
  var Float opacity := model option "opacity" Float 1
  # if opacity<>1
  #   console "group opacity " opacity eol
  var Str mixture := model option "mixture" Str
  # if mixture<>""
  #   console "grou mixture " mixture eol
  if proto:gamut:model=color_gamut_substractive
    mixture := shunt mixture="Multiply" "Screen" mixture="Screen" "Multiply" mixture="Darken" "Lighten" mixture="Lighten" "Darken" mixture
  var Link:ImagePrototype backup :> entry_new:(entry_type ad
  backup setup proto ""
  var Int psize := bd pixel_size
  for (var Int y) 0 backup:size_y-1
    var Int offset := 0
    while offset<backup:size_x
      var Address bd1 := bd write_map offset+tx y+ty 1 backu
      var Address backup1 := backup write_map offset y 1 bac
      var Int count := min count1 count2
      memory_copy(bd1 translate Byte offset*psize) (backup1 
      if mixture="Screen"
        bytes_fill bd1 1 count*psize
      bd write_unmap offset+tx y+ty count1 bd1
      backup write_unmap offset y count2 backup1
      offset += count
  if exists:mask
    draw backdrop "clip_suspend"
  var Link:ImagePrototype backup :> entry_new:(entry_type ad
  backup setup proto ""
  var Int psize := bd pixel_size
  for (var Int y) 0 backup:size_y-1
    var Int offset := 0
    while offset<backup:size_x
      var Address bd1 := bd write_map offset+tx y+ty 1 backu
      var Address backup1 := backup write_map offset y 1 bac
      var Int count := min count1 count2
      memory_copy(bd1 translate Byte offset*psize) (backup1 
      if mixture="Screen"
        bytes_fill bd1 1 count*psize
      bd write_unmap offset+tx y+ty count1 bd1
      backup write_unmap offset y count2 backup1
      offset += count
  if exists:mask
    draw backdrop "clip_suspend"
    var Link:DrawPrototype m2 :> draw clip_open mask:x0 mask:y0 mask:x1 mask:y1
    var uInt8 byte255 := 255 ; m2 rectangle mask:x0 mask:y0 mask:x1 mask:y1 addressof:byte255
  d play filter options
  if exists:mask
  d play filter options
  if exists:mask
    draw clip_close
    draw backdrop "clip_restore"
  for (var Int y) 0 backup:size_y-1
    var Int offset := 0
    while offset<backup:size_x
      var Int count1
      if exists:mask
        var Address mask1 := mask read_map offset y 1 backup
      else
        count1 := backup size_x
      var Address backup1 := backup read_map offset y 1 back
      var Address bd1 := bd write_map offset+tx y+ty 1 backu
      var Int count := min (min count1 count2) count3
    draw backdrop "clip_restore"
  for (var Int y) 0 backup:size_y-1
    var Int offset := 0
    while offset<backup:size_x
      var Int count1
      if exists:mask
        var Address mask1 := mask read_map offset y 1 backup
      else
        count1 := backup size_x
      var Address backup1 := backup read_map offset y 1 back
      var Address bd1 := bd write_map offset+tx y+ty 1 backu
      var Int count := min (min count1 count2) count3
      if mixture="Screen"
      if mixture="Multiply"
        for (var Int i) 0 count*psize-1
          bd1 map uInt8 i := (bd1 map uInt8 i)*(backup1 map 
        for (var Int i) 0 count*psize-1
          bd1 map uInt8 i := (bd1 map uInt8 i)*(backup1 map 
      eif mixture="Screen"
        for (var Int i) 0 count*psize-1
          bd1 map uInt8 i := 255-(255-(bd1 map uInt8 i))*(255-(backup1 map uInt8 i))\255
      eif mixture="Darken"
        for (var Int i) 0 count*psize-1
          bd1 map uInt8 i := min (bd1 map uInt8 i) (backup1 map uInt8 i)
      eif mixture="Lighten"
        for (var Int i) 0 count*psize-1
          bd1 map uInt8 i := max (bd1 map uInt8 i) (backup1 map uInt8 i)
      if opacity<>1
        var Int t := cast opacity*255 Int
        for (var Int i) 0 count*psize-1
          bd1 map uInt8 i := (t*(bd1 map uInt8 i)+(255-t)*(b
      if exists:mask
        var Int i := 0
        while i<count
          var Int skip := bytes_count_0 (mask1 translate Byt
          if skip>0
            memory_copy (backup1 translate Byte i*psize) (bd
          i += skip
          var Int write := bytes_count_255 (mask1 translate 
          if write>0
            i += write
          var Int mid := bytes_count_mid (mask1 translate By
          if mid>0
            var Address mask2 := mask1 translate Byte i
            var Address backup2 := backup1 translate Byte i*
            var Address bd2 := bd1 translate Byte i*psize
            for (var Int j) 0 mid-1
              var Int t := mask2 map uInt8 j
              for (var Int k) 0 psize-1
                bd2 map uInt8 k := (t*(bd2 map uInt8 k)+(255
              backup2 := backup2 translate Byte psize
              bd2 := bd2 translate Byte psize
            i += mid
      if exists:mask
        mask read_unmap offset y count1 mask1
      backup read_unmap offset y count2 backup1
      bd write_unmap offset+tx y+ty count3 bd1
      offset += count
  status := success


method d play draw options
  oarg_rw DrawDisplayList d ; oarg_rw DrawPrototype draw ; a
  var ImagePrototype proto := draw image_prototype options
  var Float outline_minimum := options option "outline_minim
      if opacity<>1
        var Int t := cast opacity*255 Int
        for (var Int i) 0 count*psize-1
          bd1 map uInt8 i := (t*(bd1 map uInt8 i)+(255-t)*(b
      if exists:mask
        var Int i := 0
        while i<count
          var Int skip := bytes_count_0 (mask1 translate Byt
          if skip>0
            memory_copy (backup1 translate Byte i*psize) (bd
          i += skip
          var Int write := bytes_count_255 (mask1 translate 
          if write>0
            i += write
          var Int mid := bytes_count_mid (mask1 translate By
          if mid>0
            var Address mask2 := mask1 translate Byte i
            var Address backup2 := backup1 translate Byte i*
            var Address bd2 := bd1 translate Byte i*psize
            for (var Int j) 0 mid-1
              var Int t := mask2 map uInt8 j
              for (var Int k) 0 psize-1
                bd2 map uInt8 k := (t*(bd2 map uInt8 k)+(255
              backup2 := backup2 translate Byte psize
              bd2 := bd2 translate Byte psize
            i += mid
      if exists:mask
        mask read_unmap offset y count1 mask1
      backup read_unmap offset y count2 backup1
      bd write_unmap offset+tx y+ty count3 bd1
      offset += count
  status := success


method d play draw options
  oarg_rw DrawDisplayList d ; oarg_rw DrawPrototype draw ; a
  var ImagePrototype proto := draw image_prototype options
  var Float outline_minimum := options option "outline_minim
  var Link:DrawPrototype clipped
  var Link:DrawPrototype mask
  var Link:DrawPrototype target :> draw
  var Pointer:Arrow c :> d:list first
  while c<>null
    var Pointer:Type t :> entry_type c
    if t=DisplayListImage
      var Link:DisplayListImage di :> c map DisplayListImage
      if not clip_image or proto:x0=undefined or (di:x0<prot
        target image di:img di:t
    eif t=DisplayListRectangle
      var Link:DisplayListRectangle dr :> c map DisplayListR
      if not clip_rectangle or proto:x0=undefined or (dr:x0<
        target rectangle dr:x0 dr:y0 dr:x1 dr:y1 (addressof 
    eif t=DisplayListFill
      var Link:DisplayListFill df :> c map DisplayListFill
      if not clip_fill or proto:x0=undefined or (df:x0<proto
        part draw_outline
          if outline_minimum=defined
            var Point2 p0 := df:t (point df:x0 df:y0)   
            var Point2 p1 := df:t (point df:x1 df:y1)
            var Float d2 := (p1:x-p0:x)*(p1:x-p0:x)+(p1:y-p0
            if d2<outline_minimum*outline_minimum
              leave draw_outline
          target fill df:curves df:mode df:t (addressof df:c
    eif t=DisplayListText
      var Link:DisplayListText dt :> c map DisplayListText
      if not clip_text or proto:x0=undefined or (dt:x0<proto
        target text dt:txt dt:font dt:kerning:characters dt:
    eif t=DisplayListClipOpen
      var Link:DisplayListClipOpen dc :> c map DisplayListCl
      if not clip_clip or proto:x0=undefined or dc:x0=undefi
  var Link:DrawPrototype target :> draw
  var Pointer:Arrow c :> d:list first
  while c<>null
    var Pointer:Type t :> entry_type c
    if t=DisplayListImage
      var Link:DisplayListImage di :> c map DisplayListImage
      if not clip_image or proto:x0=undefined or (di:x0<prot
        target image di:img di:t
    eif t=DisplayListRectangle
      var Link:DisplayListRectangle dr :> c map DisplayListR
      if not clip_rectangle or proto:x0=undefined or (dr:x0<
        target rectangle dr:x0 dr:y0 dr:x1 dr:y1 (addressof 
    eif t=DisplayListFill
      var Link:DisplayListFill df :> c map DisplayListFill
      if not clip_fill or proto:x0=undefined or (df:x0<proto
        part draw_outline
          if outline_minimum=defined
            var Point2 p0 := df:t (point df:x0 df:y0)   
            var Point2 p1 := df:t (point df:x1 df:y1)
            var Float d2 := (p1:x-p0:x)*(p1:x-p0:x)+(p1:y-p0
            if d2<outline_minimum*outline_minimum
              leave draw_outline
          target fill df:curves df:mode df:t (addressof df:c
    eif t=DisplayListText
      var Link:DisplayListText dt :> c map DisplayListText
      if not clip_text or proto:x0=undefined or (dt:x0<proto
        target text dt:txt dt:font dt:kerning:characters dt:
    eif t=DisplayListClipOpen
      var Link:DisplayListClipOpen dc :> c map DisplayListCl
      if not clip_clip or proto:x0=undefined or dc:x0=undefi
        clipped :> draw clip_open dc:x0 dc:y0 dc:x1 dc:y1
        mask :> draw clip_open dc:x0 dc:y0 dc:x1 dc:y1
      else
        var Int level := 1
        while level>0 # and (d:list next c)<>null
          c :> d:list next c
          var Pointer:Type t :> entry_type c
          if t=DisplayListClipOpen
            level += 1
          eif t=DisplayListClipClose
            level -= 1
    eif t=DisplayListClipDrawOpen
      else
        var Int level := 1
        while level>0 # and (d:list next c)<>null
          c :> d:list next c
          var Pointer:Type t :> entry_type c
          if t=DisplayListClipOpen
            level += 1
          eif t=DisplayListClipClose
            level -= 1
    eif t=DisplayListClipDrawOpen
      target :> clipped
      target :> mask
    eif t=DisplayListClipDrawClose
      target :> draw
    eif t=DisplayListClipClose
      draw clip_close
    eif t=DisplayListInclude
      var Link:DisplayListInclude sub :> c map DisplayListIn
      var Link:DrawPrototype filter
      if (exists sub:filter)
        var Link:DrawPrototype filter :> (entry_new sub:filt
        filter bind draw sub:options
      else
        filter :> draw
      if (sub:options option "flat_transparency")
        if (sub:list flat_play draw filter sub:options optio
          console "flat transparency recovery" eol
          sub:list play filter options
      else
        sub:list play filter options
    c :> d:list next c



method d image_prototype options -> proto
  oarg DrawDisplayList d ; arg Str options ; arg ImageProtot
  proto := d proto
  if (options option "bbox")
    var BoundingBox b
    var Pointer:Arrow c :> d:list first
    while c<>null
      var Pointer:Type t :> entry_type c
      if t=DisplayListImage
        var Link:DisplayListImage di :> c map DisplayListIma
        if clip_image
          b apply di:x0 di:y0 di:x1 di:y1
        else
          b apply di:img:x0 di:img:y0 di:img:x1 di:img:y1 di
      eif t=DisplayListRectangle
        var Link:DisplayListRectangle dr :> c map DisplayLis
        b apply dr:x0 dr:y0 dr:x1 dr:y1
      eif t=DisplayListFill
        var Link:DisplayListFill df :> c map DisplayListFill
        if clip_fill
          b apply df:x0 df:y0 df:x1 df:y1
        else
          for (var Int i) 0 df:curves:size-1
            df:curves:i bbox (var Float xx0) (var Float yy0)
            b apply xx0 yy0 xx1 yy1 df:t
      eif t=DisplayListText
        var Link:DisplayListText dt :> c map DisplayListText
        if clip_text
          b apply dt:x0 dt:y0 dt:x1 dt:y1
        else
          dt:font bbox dt:txt dt:kerning:characters dt:lengt
          b apply xx0 yy0 xx1 yy1 dt:t
      eif t=DisplayListInclude
        var Link:DisplayListInclude sub :> c map DisplayList
        var ImagePrototype pr := sub:list image_prototype op
        var Transform2 tr
        var Str op := sub options
        if (op option "translate") or (op option "scale") or
          if not ((op (op option_position "translate" 0) op:
            tx := op option "translate" Float 0
            ty := tx
          if not ((op (op option_position "scale" 0) op:len)
            sx := op option "scale" Float 1
            sy := sx
          if not ((op (op option_position "rotate" 0) op:len
            rx := op option "rotate" Float 0
            ry := rx
          tr := transform tx ty sx sy rx ry
        else
          tr xx := op option "xx" Float 1
          tr xy := op option "xy" Float 0
          tr xt := op option "xt" Float 0
          tr yx := op option "yx" Float 0
          tr yy := op option "yy" Float 1
          tr yt := op option "yt" Float 0
          tr compute
        b apply pr:x0 pr:y0 pr:x1 pr:y1 tr
      c :> d:list next c
    proto x0 := b x0 ; proto y0 := b y0 ; proto x1 := b x1 ;
    eif t=DisplayListClipDrawClose
      target :> draw
    eif t=DisplayListClipClose
      draw clip_close
    eif t=DisplayListInclude
      var Link:DisplayListInclude sub :> c map DisplayListIn
      var Link:DrawPrototype filter
      if (exists sub:filter)
        var Link:DrawPrototype filter :> (entry_new sub:filt
        filter bind draw sub:options
      else
        filter :> draw
      if (sub:options option "flat_transparency")
        if (sub:list flat_play draw filter sub:options optio
          console "flat transparency recovery" eol
          sub:list play filter options
      else
        sub:list play filter options
    c :> d:list next c



method d image_prototype options -> proto
  oarg DrawDisplayList d ; arg Str options ; arg ImageProtot
  proto := d proto
  if (options option "bbox")
    var BoundingBox b
    var Pointer:Arrow c :> d:list first
    while c<>null
      var Pointer:Type t :> entry_type c
      if t=DisplayListImage
        var Link:DisplayListImage di :> c map DisplayListIma
        if clip_image
          b apply di:x0 di:y0 di:x1 di:y1
        else
          b apply di:img:x0 di:img:y0 di:img:x1 di:img:y1 di
      eif t=DisplayListRectangle
        var Link:DisplayListRectangle dr :> c map DisplayLis
        b apply dr:x0 dr:y0 dr:x1 dr:y1
      eif t=DisplayListFill
        var Link:DisplayListFill df :> c map DisplayListFill
        if clip_fill
          b apply df:x0 df:y0 df:x1 df:y1
        else
          for (var Int i) 0 df:curves:size-1
            df:curves:i bbox (var Float xx0) (var Float yy0)
            b apply xx0 yy0 xx1 yy1 df:t
      eif t=DisplayListText
        var Link:DisplayListText dt :> c map DisplayListText
        if clip_text
          b apply dt:x0 dt:y0 dt:x1 dt:y1
        else
          dt:font bbox dt:txt dt:kerning:characters dt:lengt
          b apply xx0 yy0 xx1 yy1 dt:t
      eif t=DisplayListInclude
        var Link:DisplayListInclude sub :> c map DisplayList
        var ImagePrototype pr := sub:list image_prototype op
        var Transform2 tr
        var Str op := sub options
        if (op option "translate") or (op option "scale") or
          if not ((op (op option_position "translate" 0) op:
            tx := op option "translate" Float 0
            ty := tx
          if not ((op (op option_position "scale" 0) op:len)
            sx := op option "scale" Float 1
            sy := sx
          if not ((op (op option_position "rotate" 0) op:len
            rx := op option "rotate" Float 0
            ry := rx
          tr := transform tx ty sx sy rx ry
        else
          tr xx := op option "xx" Float 1
          tr xy := op option "xy" Float 0
          tr xt := op option "xt" Float 0
          tr yx := op option "yx" Float 0
          tr yy := op option "yy" Float 1
          tr yt := op option "yt" Float 0
          tr compute
        b apply pr:x0 pr:y0 pr:x1 pr:y1 tr
      c :> d:list next c
    proto x0 := b x0 ; proto y0 := b y0 ; proto x1 := b x1 ;