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

View File

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