Keskustelu: Koodit: 8th: Kuvan skaalaus

: triangulate-rect
  nk:rect>pts4 4 a:close
  [0,1,2] a:@ nip ;   \ We need just the first half

: triangulate-image  \ image -- image a
  img:size 0 0 2swap 4 a:close \ img rect
  triangulate-rect ;

: map-x-before-y  \ a -- a
  ' a:open a:map >r 3 a:close r> a:+ ;

: calculate-transform  \ [[x11,y11],[x12,y12],[x13,y13]] [[x21,y21],[x22,y22],[x23,y23]] -- Tm
  map-x-before-y [1,1,1] dup >r a:+ [3,3] mat:new
  swap
  map-x-before-y r> a:+ [3,3] mat:new
  3 mat:ident mat:* mat:inv mat:* ;

: scale-image  \ img w h -- img
  2dup img:new >r                     \ src-img w h
  rot triangulate-image               \ w h src-img src-triangles
  r> triangulate-image                \ w h src-img src-triangle trgt-img trgt-triangle
  2 pick over                         \ w h src-img src-triangle trgt-img trgt-triangle src-triangle trgt-triangle
  calculate-transform mat:inv         \ w h src-img src-triangle trgt-img trgt-triangle inverse-transform
  nip rot drop                        \ w h src-img trgt-img inverse-transform

  ( >r
    ( r@ 2 a:close dup 2 pick mat:xform 4 pick swap a:open swap img:pix@ nip >r
      2 pick swap a:open swap r> img:pix! drop
    ) 0 6 pick n:1- loop rdrop
  ) 0 5 pick n:1- loop
  drop >r drop 2drop r> ;

: app:main
  "logo.png" img:new 194 194 scale-image "test.png" img:>file ;