Patch title: Release 91 bulk changes
Abstract:
File: /graphic/draw/displaylist.pli
Key:
    Removed line
    Added line
   
module "/pliant/language/compiler.pli"
module "prototype.pli"
module "/pliant/language/compiler.pli"
module "prototype.pli"
module "transform.pli"


constant clip_image false
constant clip_fill false
constant clip_image true
constant clip_fill true


type DrawDisplayList
  field List list


type DrawDisplayList
  field List list
  field Link:ColorGamut g
  field Link:ImagePrototype image_prototype
  field Str options
  field CBool clip_draw_flag <- false
  field List:Str warnings


  field CBool clip_draw_flag <- false
  field List:Str warnings


type DisplayListSetup
  field ImagePrototype proto
  field Str options

method d setup proto options -> status
  oarg_rw DrawDisplayList d ; arg ImagePrototype proto ; arg
method d setup proto options -> status
  oarg_rw DrawDisplayList d ; arg ImagePrototype proto ; arg
  var Link:DisplayListSetup ds :> new DisplayListSetup
  ds proto := proto
  ds options := options
  d:list append addressof:ds
  d g :> proto gamut
  d image_prototype :> new ImagePrototype
  d image_prototype := proto
  d options := options




method d gamut -> g
  oarg_rw DrawDisplayList d ; oarg_R ColorGamut g
  g :> d g


type DisplayListImage
  if clip_image
    field Float x0 y0 x1 y1
  field Link:ImagePrototype img
  field Transform2 t


type DrawDisplayListClip
  field Link:DrawDisplayList main
type DisplayListImage
  if clip_image
    field Float x0 y0 x1 y1
  field Link:ImagePrototype img
  field Transform2 t


type DrawDisplayListClip
  field Link:DrawDisplayList main
  field Link:ColorGamut g




method d gamut -> g
  oarg_rw DrawDisplayListClip d ; oarg_R ColorGamut g
  g :> d g

method d image img t
  oarg_rw DrawDisplayListClip d ; oarg_rw ImagePrototype img
  d:main clip_draw_open
  d:main image1 img t


method d clip_open x0 y0 x1 y1 -> dc
  oarg_rw DrawDisplayList d ; arg Float x0 y0 x1 y1 ; arg Li
  d clip_draw_close
  var Link:DisplayListClipOpen dco :> new DisplayListClipOpe
  dco x0 := x0 ; dco y0 := y0 ; dco x1 := x1 ; dco y1 := y1
  d:list append addressof:dco
  var Link:DrawDisplayListClip dlc :> new DrawDisplayListCli
  dlc main :> d
method d image img t
  oarg_rw DrawDisplayListClip d ; oarg_rw ImagePrototype img
  d:main clip_draw_open
  d:main image1 img t


method d clip_open x0 y0 x1 y1 -> dc
  oarg_rw DrawDisplayList d ; arg Float x0 y0 x1 y1 ; arg Li
  d clip_draw_close
  var Link:DisplayListClipOpen dco :> new DisplayListClipOpe
  dco x0 := x0 ; dco y0 := y0 ; dco x1 := x1 ; dco y1 := y1
  d:list append addressof:dco
  var Link:DrawDisplayListClip dlc :> new DrawDisplayListCli
  dlc main :> d
  dlc g :> color_gamut "grey"
  dc :> dlc



  dc :> dlc



method d replay draw clip_x0 clip_y0 clip_x1 clip_y1
  oarg_rw DrawDisplayList d ; oarg_rw DrawPrototype draw ; a
  var Array:CBool concerned
type DisplayListInclude
  field Link:DrawDisplayList list
  field Transform2 t

method d include list t
  oarg_rw DrawDisplayList d ; arg DrawDisplayList list ; arg Transform2 t
  var Link:DisplayListInclude di :> new DisplayListInclude
  di list :> list
  di t := t
  d:list append addressof:di


function replay draw list proto clip
  oarg_rw DrawPrototype draw ; arg List list ; arg ImagePrototype proto ; arg CBool clip
  var Link:DrawPrototype clipped
  var Link:DrawPrototype target :> draw
  var Link:DrawPrototype clipped
  var Link:DrawPrototype target :> draw
  var Int count := 0
  var Pointer:Arrow c :> d:list first
  var Pointer:Arrow c :> list first
  while c<>null
  while c<>null
    count += 1
    c :> d:list next c
  var Pointer:Arrow c :> d:list first ; var Int n := 0
  while c<>null
    # console n "/" count " " memory_current_used\2^20 " MB 
    var Pointer:Type t :> entry_type c
    var Pointer:Type t :> entry_type c
    # console t:name eol
    if t=DisplayListSetup
      var Link:DisplayListSetup ds :> c map DisplayListSetup
      draw setup ds:proto ds:options
    eif t=DisplayListImage
    if t=DisplayListImage
      var Link:DisplayListImage di :> c map DisplayListImage
      var Link:DisplayListImage di :> c map DisplayListImage
      if not clip_image or (di:x0<clip_x1 and di:y0<clip_y1 
      if not clip_image or not clip or (di:x0<proto:x1 and di:y0<proto:y1 and di:x1>proto:x0 and di:y1>proto:y0)
        target image di:img di:t
    eif t=DisplayListRectangle
      var Link:DisplayListRectangle dr :> c map DisplayListR
      target rectangle dr:x0 dr:y0 dr:x1 dr:y1 (addressof dr
    eif t=DisplayListFill
      var Link:DisplayListFill df :> c map DisplayListFill
        target image di:img di:t
    eif t=DisplayListRectangle
      var Link:DisplayListRectangle dr :> c map DisplayListR
      target rectangle dr:x0 dr:y0 dr:x1 dr:y1 (addressof dr
    eif t=DisplayListFill
      var Link:DisplayListFill df :> c map DisplayListFill
      if not clip_fill or (df:x0<clip_x1 and df:y0<clip_y1 a
      if not clip_fill or not clip or (df:x0<proto:x1 and df:y0<proto:y1 and df:x1>proto:x0 and df:y1>proto:y0)
        target fill df:curves df:mode df:t (addressof df:col
    eif t=DisplayListText
      var Link:DisplayListText dt :> c map DisplayListText
      target text dt:txt dt:font dt:kerning:characters dt:le
    eif t=DisplayListClipOpen
      var Link:DisplayListClipOpen dc :> c map DisplayListCl
        target fill df:curves df:mode df:t (addressof df:col
    eif t=DisplayListText
      var Link:DisplayListText dt :> c map DisplayListText
      target text dt:txt dt:font dt:kerning:characters dt:le
    eif t=DisplayListClipOpen
      var Link:DisplayListClipOpen dc :> c map DisplayListCl
      if clip_x0=undefined or dc:x0=undefined or (dc:x0<clip
      if not clip or dc:x0=undefined or (dc:x0<proto:x1 and dc:y0<proto:y1 and dc:x1>proto:x0 and dc:y1>proto:y0)
        clipped :> draw clip_open dc:x0 dc:y0 dc:x1 dc:y1
      else
        var Int level := 1
        while level>0
        clipped :> draw clip_open dc:x0 dc:y0 dc:x1 dc:y1
      else
        var Int level := 1
        while level>0
          c :> d:list next c
          c :> 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
    eif t=DisplayListClipDrawClose
      target :> draw
    eif t=DisplayListClipClose
      draw clip_close
          var Pointer:Type t :> entry_type c
          if t=DisplayListClipOpen
            level += 1
          eif t=DisplayListClipClose
            level -= 1
    eif t=DisplayListClipDrawOpen
      target :> clipped
    eif t=DisplayListClipDrawClose
      target :> draw
    eif t=DisplayListClipClose
      draw clip_close
    c :> d:list next c ; n += 1
    eif t=DisplayListInclude
      var Link:DisplayListInclude sub :> c map DisplayListInclude
      if sub:t:level=transform_identity
        replay draw sub:list:list proto clip
      else
        var Link:DrawTransform trans :> new DrawTransform
        trans bind draw sub:t
        replay trans sub:list:list proto false
    c :> list next c


method d replay draw
  oarg_rw DrawDisplayList d ; oarg_rw DrawPrototype draw
  d replay draw undefined undefined undefined undefined
method d replay draw options
  oarg_rw DrawDisplayList d ; oarg_rw DrawPrototype draw ; arg Str options
  draw setup d:image_prototype options+" "+d:options
  replay draw d:list (image_prototype d:image_prototype options+" "+d:options) not (options option "no_clip")






export DrawDisplayList '. replay' '. reset' '. warnings'
export DrawDisplayList '. replay' '. reset' '. include'
export '. image_prototype' '. options' '. warnings'


#----------------------------------------------------------------------------


type BoundingBox
  field Float x0 <- undefined
  field Float y0 <- undefined
  field Float x1 <- undefined
  field Float y1 <- undefined

method b apply p
  arg_rw BoundingBox b ; arg Point2 p
  if p:x=undefined or p:y=undefined
    void
  eif b:x0=undefined
    b x0 := p x
    b y0 := p y
    b x1 := p x
    b y1 := p y
  else
    b x0 := min b:x0 p:x
    b y0 := min b:y0 p:y
    b x1 := max b:x1 p:x
    b y1 := max b:y1 p:y

method b apply x0 y0 x1 y1
  arg_rw BoundingBox b ; arg Float x0 y0 x1 y1
  b apply (point x0 y0)
  b apply (point x1 y1)

method b apply x0 y0 x1 y1 t
  arg_rw BoundingBox b ; arg Float x0 y0 x1 y1 ; arg Transform2 t
  b apply t:(point x0 y0)
  b apply t:(point x1 y0)
  b apply t:(point x1 y1)
  b apply t:(point x0 y1)

method d bbox x0 y0 x1 y1
  oarg_rw DrawDisplayList d ; arg_w Float x0 y0 x1 y1
  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 DisplayListImage
      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:t
    eif t=DisplayListRectangle
      var Link:DisplayListRectangle dr :> c map DisplayListRectangle
      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) (var Float xx1) (var Float yy1)
          b apply xx0 yy0 xx1 yy1 df:t
    eif t=DisplayListText
      var Link:DisplayListText dt :> c map DisplayListText
      dt:font bbox dt:txt dt:kerning:characters (var Float xx0) (var Float yy0) (var Float xx1) (var Float yy1)
      b apply xx0 yy0 xx1 yy1 dt:t
    eif t=DisplayListInclude
      var Link:DisplayListInclude sub :> c map DisplayListInclude
      sub:list bbox (var Float xx0) (var Float yy0) (var Float xx1) (var Float yy1) 
      b apply xx0 yy0 xx1 yy1 sub:t 
    c :> d:list next c
  x0 := b x0 ; y0 := b y0 ; x1 := b x1 ; y1 := b y1

export '. bbox'