104 lines
2.1 KiB
Factor
104 lines
2.1 KiB
Factor
! :sidekick.parser=none:
|
|
|
|
IN: graphics
|
|
|
|
USE: alien
|
|
USE: combinators
|
|
USE: errors
|
|
USE: kernel
|
|
USE: lists
|
|
USE: logic
|
|
USE: math
|
|
USE: namespaces
|
|
USE: sdl
|
|
USE: stack
|
|
USE: vectors
|
|
USE: oop
|
|
|
|
: black 0 0 0 255 rgba ;
|
|
: white 255 255 255 255 rgba ;
|
|
|
|
: clear-surface ( -- )
|
|
#! Crappy
|
|
surface get
|
|
NULL
|
|
surface get surface-format 255 255 255 SDL_MapRGB
|
|
SDL_FillRect drop ;
|
|
|
|
! These variables are set in shape objects.
|
|
SYMBOL: from ( complex number, x/y )
|
|
SYMBOL: to ( complex number, w/h )
|
|
SYMBOL: filled?
|
|
SYMBOL: color
|
|
SYMBOL: string ( text objects only )
|
|
|
|
! Draw an object.
|
|
GENERIC: draw ( obj -- )
|
|
|
|
! Return if the point is inside the object.
|
|
GENERIC: inside? ( #{ x y } obj -- ? )
|
|
|
|
! Scale factor for all rendering, can be set in object too
|
|
SYMBOL: scale
|
|
|
|
! Translation
|
|
SYMBOL: origin
|
|
|
|
: center ( -- #{ x y } )
|
|
width get 2 / height get 2 / rect> ;
|
|
|
|
: scene>screen ( #{ x y } -- #{ x y } )
|
|
origin get - scale get * center + ;
|
|
|
|
: screen>scene ( #{ x y } -- #{ x y } )
|
|
center - scale get / origin get + ;
|
|
|
|
: 2>irect >r >rect swap >fixnum swap >fixnum r> >rect swap >fixnum swap >fixnum ;
|
|
|
|
: (rect) ( -- surface x y w h color )
|
|
surface get
|
|
from get scene>screen
|
|
to get scene>screen
|
|
2>irect color get ;
|
|
|
|
: in-rect? ( #{ x y } #{ x1 y1 } #{ x2 y2 } -- ? )
|
|
#! Return if x/y is in the rectangle bounded by x1/y1, x2/y2
|
|
3dup
|
|
rot real rot real rot real between? >r
|
|
rot imaginary rot imaginary rot imaginary between? r> and ;
|
|
|
|
TRAITS: rectangle
|
|
M: rectangle draw ( -- )
|
|
(rect) filled? get [
|
|
boxColor
|
|
] [
|
|
rectangleColor
|
|
] ifte ;M
|
|
|
|
M: rectangle inside? ( #{ x y } -- ? )
|
|
from get to get in-rect? ;M
|
|
|
|
TRAITS: line
|
|
M: line draw ( -- )
|
|
(rect) lineColor ;M
|
|
|
|
M: line inside? ( #{ x y } -- ? )
|
|
from get to get in-rect? [
|
|
t
|
|
] [
|
|
f
|
|
] ifte ;M
|
|
|
|
TRAITS: text
|
|
M: text draw ( -- )
|
|
surface get from get >rect color get string get
|
|
stringColor ;M
|
|
|
|
: grab ( #{ x y } list -- shape )
|
|
#! Return shape containing x/y.
|
|
dup [
|
|
2dup car inside? [ nip car ] [ cdr grab ] ifte
|
|
] [
|
|
2drop f
|
|
] ifte ;
|