Patch title: Release 84 bulk changes
Abstract:
File: /pliant/graphic/vector/font.pli
Key:
    Removed line
    Added line
   
abstract
  [Loading and rendering a PostScript Type 1 font]


  method f rasterize ch rsize -> buf
    arg Font f ; arg FontChar ch ; arg Int rsize ; arg Addre
    var Float res := rsize/(f:y1-f:y0)
    var Link:ImagePixmap pixmap :> new ImagePixmap
    pixmap setup (image_prototype f:x0 f:y0 f:x1 f:y1 (cast 
    var Link:ImageAntiAliasing final :> new ImageAntiAliasin
abstract
  [Loading and rendering a PostScript Type 1 font]


  method f rasterize ch rsize -> buf
    arg Font f ; arg FontChar ch ; arg Int rsize ; arg Addre
    var Float res := rsize/(f:y1-f:y0)
    var Link:ImagePixmap pixmap :> new ImagePixmap
    pixmap setup (image_prototype f:x0 f:y0 f:x1 f:y1 (cast 
    var Link:ImageAntiAliasing final :> new ImageAntiAliasin
    final bind pixmap raster_anti_aliasing
    final bind pixmap raster_anti_aliasing raster_anti_aliasing
    var Address linebuf := memory_allocate final:line_size n
    var uInt8 color := 0
    for (var Int y) 0 pixmap:size_y-1
      pixmap fill 0 y pixmap:size_x addressof:color
    var uInt8 color := 255
    f draw ch pixmap 0 0 1 addressof:color
    var Int reserved := 2*rsize*3+uInt:size ; var Int used :
    buf := memory_allocate reserved null
    var Int cx := (cast -(f:x0)*res Int) ; var Int cy := (ca
    for (var Int y) 0 final:size_y-1
      final read 0 y final:size_x linebuf
      var Int x0 := 0
      part segment
        while x0<final:size_x and (linebuf map uInt8 x0)=0
          x0 += 1
        if x0=final:size_x
          leave segment
        var Int x1 := x0
        while x1<final:size_x and (linebuf map uInt8 x1)<>0
          x1 += 1
        while used+3+(x1-x0)+uInt:size>reserved
          reserved *= 2
          buf := memory_resize buf reserved addressof:f
        var Int limit := 127
        var Int dx := x0-cx
        var Int dy := y-cy
        if dx<>(bound dx -limit limit)
          dx := bound dx -limit limit ; x1 := x0
        if dy<>(bound dy -limit limit)
          dy := bound dy -limit limit ; x1 := x0
        (buf translate Byte used) map Int8 := dx ; used += 1
        (buf translate Byte used) map Int8 := dy ; used += 1
        (buf translate Byte used) map uInt8 := x1-x0 ; used 
        for (var Int x) x0 x1-1
          (buf translate Byte used) map uInt8 := linebuf map
        cx += dx ; cy += dy
        x0 := x1
        restart segment
    memory_free linebuf
    (buf translate Byte used) map uInt := 0 ; used += uInt s
    buf := memory_resize buf used addressof:f
    
  function rdraw buf img ix iy color
    arg Address buf ; oarg_rw ImagePrototype img ; arg Int i
    var Address c := buf ; var Int x := ix ; var Int y := iy
    var Int psize := img pixel_size
    while (c map uInt)<>0
      x += c map Int8 ; c := c translate Int8 1
      y += c map Int8 ; c := c translate Int8 1
      var Int n := c map uInt8 ; c := c translate uInt8 1
      if y>=0 and y<img:size_y
        var Int x0 := max x 0
        var Int x1 := min x+n img:size_x
        if x1>x0
          # img fill x0 y x1-x0 color
          var Address adr := img write_map x0 y x1-x0 x1-x0 
          if adr<>null
            var Address pixel := adr ; var Address stop := p
            var Address opacity := c translate uInt8 x0-x
            while pixel<>stop
              pixel_mixte pixel color psize (opacity map uIn
              pixel := pixel translate Byte psize
              opacity := opacity translate uInt8 1
            img write_unmap x0 y count adr
      c := c translate uInt8 n


    var Address linebuf := memory_allocate final:line_size n
    var uInt8 color := 0
    for (var Int y) 0 pixmap:size_y-1
      pixmap fill 0 y pixmap:size_x addressof:color
    var uInt8 color := 255
    f draw ch pixmap 0 0 1 addressof:color
    var Int reserved := 2*rsize*3+uInt:size ; var Int used :
    buf := memory_allocate reserved null
    var Int cx := (cast -(f:x0)*res Int) ; var Int cy := (ca
    for (var Int y) 0 final:size_y-1
      final read 0 y final:size_x linebuf
      var Int x0 := 0
      part segment
        while x0<final:size_x and (linebuf map uInt8 x0)=0
          x0 += 1
        if x0=final:size_x
          leave segment
        var Int x1 := x0
        while x1<final:size_x and (linebuf map uInt8 x1)<>0
          x1 += 1
        while used+3+(x1-x0)+uInt:size>reserved
          reserved *= 2
          buf := memory_resize buf reserved addressof:f
        var Int limit := 127
        var Int dx := x0-cx
        var Int dy := y-cy
        if dx<>(bound dx -limit limit)
          dx := bound dx -limit limit ; x1 := x0
        if dy<>(bound dy -limit limit)
          dy := bound dy -limit limit ; x1 := x0
        (buf translate Byte used) map Int8 := dx ; used += 1
        (buf translate Byte used) map Int8 := dy ; used += 1
        (buf translate Byte used) map uInt8 := x1-x0 ; used 
        for (var Int x) x0 x1-1
          (buf translate Byte used) map uInt8 := linebuf map
        cx += dx ; cy += dy
        x0 := x1
        restart segment
    memory_free linebuf
    (buf translate Byte used) map uInt := 0 ; used += uInt s
    buf := memory_resize buf used addressof:f
    
  function rdraw buf img ix iy color
    arg Address buf ; oarg_rw ImagePrototype img ; arg Int i
    var Address c := buf ; var Int x := ix ; var Int y := iy
    var Int psize := img pixel_size
    while (c map uInt)<>0
      x += c map Int8 ; c := c translate Int8 1
      y += c map Int8 ; c := c translate Int8 1
      var Int n := c map uInt8 ; c := c translate uInt8 1
      if y>=0 and y<img:size_y
        var Int x0 := max x 0
        var Int x1 := min x+n img:size_x
        if x1>x0
          # img fill x0 y x1-x0 color
          var Address adr := img write_map x0 y x1-x0 x1-x0 
          if adr<>null
            var Address pixel := adr ; var Address stop := p
            var Address opacity := c translate uInt8 x0-x
            while pixel<>stop
              pixel_mixte pixel color psize (opacity map uIn
              pixel := pixel translate Byte psize
              opacity := opacity translate uInt8 1
            img write_unmap x0 y count adr
      c := c translate uInt8 n