math.vectors: new word v>integer = [ >integer ] map

db4
Björn Lindqvist 2014-10-13 23:31:04 +02:00 committed by John Benediktsson
parent 45ef36e42c
commit 001acde590
7 changed files with 22 additions and 22 deletions

View File

@ -199,7 +199,7 @@ GENERIC: v= ( u v -- w )
M: object v= [ = ] 2map ; inline
GENERIC: v? ( mask true false -- result )
M: object v?
M: object v?
[ vand ] [ vandn ] bi-curry* bi vor ; inline
: vif ( mask true-quot: ( -- vector ) false-quot: ( -- vector ) -- result )
@ -209,6 +209,7 @@ M: object v?
[ [ call ] dip call v? ]
} cond ; inline
: v>integer ( u -- v ) [ >integer ] map ;
: vfloor ( u -- v ) [ floor ] map ;
: vceiling ( u -- v ) [ ceiling ] map ;
: vtruncate ( u -- v ) [ truncate ] map ;

View File

@ -29,7 +29,7 @@ C: <separator-pen> separator-pen
M: separator-pen draw-interior
color>> gl-color
dim>> [ { 0 0.5 } v* ] [ { 1 0.5 } v* ] bi
[ [ >integer ] map ] bi@ gl-line ;
[ v>integer ] bi@ gl-line ;
: <menu-items> ( items -- gadget )
[ <filled-pile> ] dip add-gadgets

View File

@ -24,7 +24,7 @@ M: viewport focusable-child*
gadget-child ;
: scroll-position ( scroller -- loc )
model>> range-value [ >integer ] map ;
model>> range-value v>integer ;
M: viewport model-changed
nip

View File

@ -182,7 +182,7 @@ SINGLETON: pango-renderer
M: pango-renderer string-dim
[ " " string-dim { 0 1 } v* ]
[ cached-layout logical-rect>> dim>> [ >integer ] map ] if-empty ;
[ cached-layout logical-rect>> dim>> v>integer ] if-empty ;
M: pango-renderer flush-layout-cache
cached-layouts get-global purge-cache ;
@ -210,4 +210,3 @@ M: pango-renderer line-metrics ( font string -- metrics )
] "ui.text.pango" add-startup-hook
pango-renderer font-renderer set-global

View File

@ -1,8 +1,8 @@
! Copyright (C) 2006, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors colors formatting kernel math math.functions
models models.arrow models.product models.range sequences ui
ui.gadgets ui.gadgets.labels ui.gadgets.packs ui.gadgets.sliders
math.vectors models models.arrow models.product models.range sequences
ui ui.gadgets ui.gadgets.labels ui.gadgets.packs ui.gadgets.sliders
ui.gadgets.tracks ui.pens.solid ;
IN: color-picker
@ -39,7 +39,7 @@ M: color-preview model-changed
[ <color-model> <color-preview> 1 track-add ]
[
[
[ truncate >integer ] map
[ truncate ] map v>integer
first3 3dup "%d %d %d #%02x%02x%02x" sprintf
] <arrow> <label-control>
f track-add

View File

@ -38,7 +38,7 @@ CONSTANT: pov-polygons
indicator-polygon <polygon-gadget> ;
: (>loc) ( axisloc -- windowloc )
0.5 v*n { 0.5 0.5 } v+ SIZE v* [ >integer ] map
0.5 v*n { 0.5 0.5 } v+ SIZE v* v>integer
INDICATOR-SIZE 2 v/n v- ;
: (xy>loc) ( x y -- xyloc )

View File

@ -130,17 +130,17 @@ terrain-world H{
[ key-5 keys nth 10000 f ? ]
} 0|| player reverse-time<<
key-w keys nth [ player walk-forward ] when
key-s keys nth [ player walk-backward ] when
key-a keys nth [ player walk-leftward ] when
key-d keys nth [ player walk-rightward ] when
key-q keys nth [ player -1 look-horizontally ] when
key-e keys nth [ player 1 look-horizontally ] when
key-left-arrow keys nth [ player -1 look-horizontally ] when
key-right-arrow keys nth [ player 1 look-horizontally ] when
key-down-arrow keys nth [ player 1 look-vertically ] when
key-up-arrow keys nth [ player -1 look-vertically ] when
key-space keys nth [ player jump ] when
key-w keys nth [ player walk-forward ] when
key-s keys nth [ player walk-backward ] when
key-a keys nth [ player walk-leftward ] when
key-d keys nth [ player walk-rightward ] when
key-q keys nth [ player -1 look-horizontally ] when
key-e keys nth [ player 1 look-horizontally ] when
key-left-arrow keys nth [ player -1 look-horizontally ] when
key-right-arrow keys nth [ player 1 look-horizontally ] when
key-down-arrow keys nth [ player 1 look-vertically ] when
key-up-arrow keys nth [ player -1 look-vertically ] when
key-space keys nth [ player jump ] when
key-escape keys nth [ world close-window ] when
player read-mouse rotate-with-mouse
reset-mouse ;
@ -155,7 +155,7 @@ terrain-world H{
[ { 0 0 } vmax ] dip { 2 2 } v- vmin ;
:: pixel-indices ( coords dim -- indices )
coords vfloor [ >integer ] map dim clamp-coords :> floor-coords
coords vfloor v>integer dim clamp-coords :> floor-coords
floor-coords first2 dim first * + :> base-index
base-index dim first + :> next-row-index
@ -170,7 +170,7 @@ terrain-world H{
pixel dup vfloor v- :> pixel-mantissa
segment bitmap>> 4 <groups> :> pixels
pixel dim pixel-indices :> indices
indices [ pixels nth COMPONENT-SCALE v. 255.0 / ] map
first4 pixel-mantissa bilerp ;