extra/x/pen/pen.factor

   1
   2 USING: kernel arrays math.vectors mortar x.gc slot-accessors geom.pos ;
   3
   4 IN: x.pen
   5
   6 SYMBOL: <pen>
   7
   8 <pen> <pos> { "window" "gc" } accessors define-simple-class
   9
  10 <pen> "create" !( window <pen> -- pen )
  11 [ new-empty swap >>window <gc> new* >>gc 0 0 2array >>pos ]
  12 add-class-method
  13
  14 <pen> {
  15
  16 "line-to" ! ( pen point -- pen )
  17   [ 2dup >r dup $window swap dup $gc swap $pos r> <---- draw-line >>pos ]
  18
  19 "line-by" ! ( pen offset -- pen )
  20   [ 2dup >r dup $window swap dup $gc swap $pos dup r> v+ <---- draw-line
  21     <-- move-by ]
  22
  23 "draw-string" ! ( pen string -- pen )
  24   [ >r dup dup $window swap dup $gc swap $pos r> <---- draw-string ]
  25
  26 } add-methods