steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

ui.gadgets.tables: reduce generic dispatch.

db4
John Benediktsson 2012-09-20 17:49:58 -07:00
parent ba2cf19e5a
commit 37b27b7fbe
1 changed files with 9 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
basis/ui/gadgets/tables/tables.factor
View File

@ -66,24 +66,18 @@ rows ;
<PRIVATE <PRIVATE
GENERIC: cell-width ( font cell -- x ) GENERIC: cell-dim ( font cell -- width height padding )
GENERIC: cell-height ( font cell -- y )
GENERIC: cell-padding ( cell -- y )
GENERIC: draw-cell ( font cell -- ) GENERIC: draw-cell ( font cell -- )
: single-line ( str -- str' ) : single-line ( str -- str' )
dup [ "\r\n" member? ] any? [ string-lines " " join ] when ; dup [ "\r\n" member? ] any? [ string-lines " " join ] when ;
M: string cell-width single-line text-width ; M: string cell-dim single-line text-dim first2 ceiling 0 ;
M: string cell-height single-line text-height ceiling ;
M: string cell-padding drop 0 ;
M: string draw-cell single-line draw-text ; M: string draw-cell single-line draw-text ;
CONSTANT: image-padding 2 CONSTANT: image-padding 2
M: image-name cell-width nip image-dim first ; M: image-name cell-dim nip image-dim first2 image-padding ;
M: image-name cell-height nip image-dim second ;
M: image-name cell-padding drop image-padding ;
M: image-name draw-cell nip draw-image ; M: image-name draw-cell nip draw-image ;
: table-rows ( table -- rows ) : table-rows ( table -- rows )
@ -107,7 +101,7 @@ CONSTANT: column-title-background COLOR: light-gray
if ; if ;
: row-column-widths ( table row -- widths ) : row-column-widths ( table row -- widths )
[ font>> ] dip [ [ cell-width ] [ cell-padding ] bi + ] with map ; [ font>> ] dip [ cell-dim nip + ] with map ;
: compute-total-width ( gap widths -- total ) : compute-total-width ( gap widths -- total )
swap [ column-offsets drop ] keep - ; swap [ column-offsets drop ] keep - ;
@ -178,8 +172,10 @@ M: table layout*
] bi ; ] bi ;
:: column-loc ( font column width align -- loc ) :: column-loc ( font column width align -- loc )
font column cell-width width swap - align * column cell-padding 2 / 1 align - * + font column cell-dim :> ( cell-width cell-height cell-padding )
font column cell-height \ line-height get swap - 2 / cell-width width swap - align *
cell-padding 2 / 1 align - * +
cell-height \ line-height get swap - 2 /
[ >integer ] bi@ 2array ; [ >integer ] bi@ 2array ;
: translate-column ( width gap -- ) : translate-column ( width gap -- )
@ -233,8 +229,7 @@ M: table draw-gadget*
M: table line-height* ( table -- y ) M: table line-height* ( table -- y )
[ font>> ] [ renderer>> prototype-row ] bi [ font>> ] [ renderer>> prototype-row ] bi
[ [ cell-height ] [ cell-padding ] bi + ] with [ cell-dim + nip ] with [ max ] map-reduce ;
[ max ] map-reduce ;
M: table pref-dim* M: table pref-dim*
[ compute-column-widths drop ] keep [ compute-column-widths drop ] keep