/pliant/graphic/image/rotate.pli
 
 1  module "/pliant/language/compiler.pli" 
 2  submodule "prototype.pli" 
 3  module "/pliant/language/compiler/type/inherit.pli" 
 4  module "pixmap.pli" 
 5   
 6  type ImageRotate 
 7    inherit ImagePrototype 
 8    field Link:ImagePixmap image 
 9    field CBool left right r180 
 10   
 11  method r bind image options -> status 
 12    arg_rw ImageRotate r ; oarg ImagePrototype image ; arg Str options ; arg ExtendedStatus status 
 13    var Float x0 := image x0  
 14    var Float y0 := image y0   
 15    var Float x1 := image x1   
 16    var Float y1 := image y1 
 17    var Int sx := image size_x 
 18    var Int sy := image size_y 
 19    left := false ; right := false ; r180 := false 
 20    if (options option "rotate_left") 
 21      left := true ; swap x0 y0 ; swap x1 y1 ; swap y0 y1 ; swap sx sy 
 22    eif (options option "rotate_right") 
 23      right := true ; swap x0 y0 ; swap x1 y1 ; swap x0 x1 ; swap sx sy 
 24    eif (options option "rotate_180") 
 25      r180 := true ; swap x0 x1 ; swap y0 y1 
 26    else 
 27      return failure:"Unsupported rotation" 
 28    addressof:map ImagePrototype := image_prototype x0 y0 x1 y1 sx sy image:gamut 
 29    image :> addressof:image map ImagePixmap 
 30    if (entry_type addressof:image)<>ImagePixmap 
 31      return failure:"Only pixmap images can be rotated" 
 32    status=success 
 33   
 34  method r read x0 y0 count adr 
 35    arg_rw ImageRotate r ; arg Int x0 y0 count ; arg Address adr 
 36    var Int psize := pixel_size 
 37    var Address dest := adr 
 38    var Address stop := adr translate Byte count*psize 
 39    if r:left 
 40      var Int := r:size_y-1-y0 ; var Int := x0 
 41      while dest<>stop 
 42        memory_copy (r:image pixel y) dest psize 
 43        dest := dest translate Byte psize 
 44        += 1 
 45    eif r:right 
 46      var Int := y0 ; var Int := r:size_x-1-x0 
 47      while dest<>stop 
 48        memory_copy (r:image pixel y) dest psize 
 49        dest := dest translate Byte psize 
 50        -= 1 
 51    eif r:r180 
 52      var Address src := r:image pixel r:size_x-1-x0 r:size_y-1-y0 
 53      while dest<>stop 
 54        memory_copy src dest psize 
 55        src := src translate Byte -psize 
 56        dest := dest translate Byte psize 
 57    else 
 58      r:image read x0 y0 count adr 
 59         
 60  export ImageRotate '. bind'