Patch title: Release 85 bulk changes
Abstract:
File: /pliant/graphic/image/prototype.pli
Key:
    Removed line
    Added line
abstract
  ['ImagePrototype' is defining the API to deal with pixels in a Pliant image.]

# Copyright  Hubert Tonneau  hubert.tonneau@pliant.cx
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License version 2
# as published by the Free Software Foundation.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# version 2 along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.

module "/pliant/language/unsafe.pli"
module "/pliant/graphic/color/gamut.pli"

constant optimize true


public


type ImagePrototype
  field Int size_x size_y pixel_size
  field Link:ColorGamut gamut
  field Float x0 y0 x1 y1
  field Str options


method p setup proto options -> status
  oarg_rw ImagePrototype p ; arg ImagePrototype proto ; arg Str options ; arg ExtendedStatus status
  generic
  status := failure "unsupported"

method p read x y count adr
  oarg_rw ImagePrototype p ; arg Int x y count ; arg Address adr
  generic
  error error_id_missing "Not implemented"

method p write x y count adr
  oarg_rw ImagePrototype p ; arg Int x y count ; arg Address adr
  generic
  error error_id_missing "Not implemented"

method p read_map x y mini maxi count -> adr
  oarg_rw ImagePrototype p ; arg Int x y mini maxi ; arg_w Int count ; arg Address adr
  generic
  count := 0 ; adr := null

method p read_unmap x y count adr
  oarg_rw ImagePrototype p ; arg Int x y count ; arg Address adr
  generic

method p write_map x y mini maxi count -> adr
  oarg_rw ImagePrototype p ; arg Int x y mini maxi ; arg_w Int count ; arg Address adr
  generic
  count := 0 ; adr := null

method p write_unmap x y count adr
  oarg_rw ImagePrototype p ; arg Int x y count ; arg Address adr
  generic

method p fill x y count pixel
  oarg_rw ImagePrototype p ; arg Int x y count ; arg Address pixel
  generic
  check count>0 and x>=0 and x+count<=p:size_x and y>=0 and y<p:size_y
  function fill buf count psize pixel
    arg Address buf ; arg Int count psize ; arg Address pixel
    if optimize and psize>=2 and psize<=4
      var uInt color := pixel map uInt32
      var Address dest := buf ; var Address stop := dest translate Byte (count-1)*psize
      while dest<>stop
        dest map uInt32 := color
        dest := dest translate Byte psize
      memory_copy pixel dest 3
    else
      var Address dest := buf ; var Address stop := dest translate Byte count*psize
      while dest<>stop
        memory_copy pixel dest psize
        dest := dest translate Byte psize
  var Int done := 0
  while done<count
    var Address start := p write_map x+done y 1 count-done (var Int step)
    if start<>null
      fill start step p:pixel_size pixel
      p write_unmap x+done y step start
      done += step
    else
      var Address buf := memory_allocate (count-done)*p:pixel_size null
      fill buf count-done p:pixel_size pixel
      p write x+done y count-done start
      memory_free start
      done := count

method p fill x y size_x size_y pixel
  oarg_rw ImagePrototype p ; arg Int x y size_x size_y ; arg Address pixel
  check size_x>0 and size_y>0 and x>=0 and x+p:size_x<=size_x and y>=0 and y+size_y<=p:size_y
  for (var Int i) y y+size_y-1
    p fill x i size_x pixel
if false
  method p fill x y size_x size_y pixel
    oarg_rw ImagePrototype p ; arg Int x y size_x size_y ; arg Address pixel
    check size_x>0 and size_y>0 and x>=0 and x+p:size_x<=size_x and y>=0 and y+size_y<=p:size_y
    for (var Int i) y y+size_y-1
      p fill x i size_x pixel

method p line_size -> ls
  arg ImagePrototype p ; arg Int ls
  ls := p:pixel_size*p:size_x


method p complete
  arg_rw ImagePrototype p
  p pixel_size := p:gamut pixel_size

function image_prototype x0 y0 x1 y1 size_x size_y gamut -> p
  arg Float x0 y0 x1 y1 ; arg Int size_x size_y ; oarg ColorGamut gamut ; arg ImagePrototype p
  check exists:gamut
  p size_x := size_x
  p size_y := size_y
  p gamut :> gamut
  p x0 := x0
  p y0 := y0
  p x1 := x1
  p y1 := y1
  p options := ""
  p complete

constant image_adjust_extend 1001
constant image_adjust_reduce 1002
constant image_adjust_resolution 1003

function image_prototype x0 y0 x1 y1 rx ry aa_x aa_y adjust gamut -> p
  arg Float x0 y0 x1 y1 rx ry ; arg Int aa_x aa_y adjust ; oarg ColorGamut gamut ; arg ImagePrototype p
  check adjust>=image_adjust_extend and adjust<=image_adjust_resolution
  var Int size_x := (max (cast (abs x1-x0)*(rx/25.4)+(shunt adjust=image_adjust_extend 0.5 adjust=image_adjust_reduce -0.5 0) Int)\aa_x 1)*aa_x
  var Int size_y := (max (cast (abs y1-y0)*(ry/25.4)+(shunt adjust=image_adjust_extend 0.5 adjust=image_adjust_reduce -0.5 0) Int)\aa_y 1)*aa_y
  p := image_prototype x0 y0 x0+size_x/(rx/25.4)*((x1-x0)/(abs x1-x0)) y0+size_y/(ry/25.4)*((y1-y0)/(abs y1-y0)) size_x size_y gamut

method p index_x x -> i
  arg ImagePrototype p ; arg Float x ; arg Int i
  i := cast (x-p:x0)/(p:x1-p:x0)*p:size_x Int

method p index_y y -> i
  arg ImagePrototype p ; arg Float y ; arg Int i
  i := cast (y-p:y0)/(p:y1-p:y0)*p:size_y Int