unmaintained/geom/rect/rect.factor

   1
   2 USING: kernel namespaces arrays sequences math.vectors
   3        mortar slot-accessors geom.pos geom.dim ;
   4
   5 IN: geom.rect
   6
   7 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
   8
   9 USE: math
  10
  11 : v+y ( pos y -- pos ) 0 swap 2array v+ ;
  12
  13 : v-y ( pos y -- pos ) 0 swap 2array v- ;
  14
  15 : v+x ( pos x -- pos ) 0 2array v+ ;
  16
  17 : v-x ( pos x -- pos ) 0 2array v- ;
  18
  19 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  20
  21 SYMBOL: <rect>
  22
  23 <rect>
  24   <pos> class-slots <dim> class-slots append
  25   <pos> class-methods <dim> class-methods append { H{ } } append
  26   { H{ } }
  27 4array <rect> set-global
  28
  29 ! { 0 0 } { 0 0 } <rect> new
  30
  31 <rect> {
  32
  33 "top-left" !( rect -- point ) [ $pos ]
  34
  35 "top-right" !( rect -- point ) [ dup $pos swap <- width 1- v+x ]
  36
  37 "bottom-left" !( rect -- point ) [ dup $pos swap <- height 1- v+y ]
  38
  39 "bottom-right" !( rect -- point ) [ dup $pos swap $dim { 1 1 } v- v+ ]
  40
  41 } add-methods