7bb8426 · vty · git.iko.soy

24import qualified Data.ByteString as B

25import qualified Data.ByteString.Internal as BInt

26import qualified Data.Foldable as Foldable

27+import Data.List

27import Data.Word

28import Data.Word

28import qualified Data.ByteString.UTF8 as BSUTF8

29import qualified Data.ByteString.UTF8 as BSUTF8

29import qualified Data.String.UTF8 as UTF8

30import qualified Data.String.UTF8 as UTF8

110 -- The ops builder recursively descends the image and outputs span ops that would

111 -- The ops builder recursively descends the image and outputs span ops that would

111 -- display that image. The number of columns remaining in this row before exceeding the

112 -- display that image. The number of columns remaining in this row before exceeding the

112 -- bounds is also provided. This is used to clip the span ops produced.

113 -- bounds is also provided. This is used to clip the span ops produced.

113− ops_for_row mrow_ops (pic_background pic) region (pic_image pic) 0 (region_width region)

114+ ops_for_row mrow_ops (pic_background pic) region (pic_image pic) 0 0 0 (region_width region)

114 -- Fill in any unspecified columns with the background pattern.

115 -- Fill in any unspecified columns with the background pattern.

115 forM_ [0 .. region_height region - 1] $ \row -> do

116 forM_ [0 .. region_height region - 1] $ \row -> do

116 end_x <- readSTArray mrow_ops row >>= return . span_ops_effected_columns

117 end_x <- readSTArray mrow_ops row >>= return . span_ops_effected_columns

122

123

123type MRowOps s = STArray s Word SpanOps

124type MRowOps s = STArray s Word SpanOps

124

125

125−ops_for_row :: MRowOps s -> Background -> DisplayRegion -> Image -> Word -> Word -> ST s ()

126+ops_for_row :: MRowOps s -> Background -> DisplayRegion -> Image -> Word -> Word -> Word -> Word -> ST s ()

126−ops_for_row mrow_ops bg region image y remaining_columns

127+ops_for_row mrow_ops bg region image skip_row skip_col y remaining_columns

127 | remaining_columns == 0 = return ()

128 | remaining_columns == 0 = return ()

128 | y >= region_height region = return ()

129 | y >= region_height region = return ()

129 | otherwise = case image of

130 | otherwise = case image of

131 -- The width provided is the number of columns this text span will occupy when displayed.

132 -- The width provided is the number of columns this text span will occupy when displayed.

132 -- if this is greater than the number of remaining columsn the output has to be produced a

133 -- if this is greater than the number of remaining columsn the output has to be produced a

133 -- character at a time.

134 -- character at a time.

134− HorizText a text_str ow cw -> do

135+ HorizText a text_str _ _ -> do

136+ if y < skip_row

137+ then return ()

135− snoc_text_span a text_str ow cw mrow_ops y remaining_columns

138+ else snoc_text_span a text_str mrow_ops skip_col y remaining_columns

136 VertJoin t b _ _ -> do

139 VertJoin t b _ _ -> do

137− ops_for_row mrow_ops bg region t y remaining_columns

140+ ops_for_row mrow_ops bg region t skip_row skip_col y remaining_columns

138− ops_for_row mrow_ops bg region b (y + image_height t) remaining_columns

141+ ops_for_row mrow_ops bg region b skip_row skip_col (y + image_height t) remaining_columns

139 HorizJoin l r _ _ -> do

142 HorizJoin l r _ _ -> do

140− ops_for_row mrow_ops bg region l y remaining_columns

143+ ops_for_row mrow_ops bg region l skip_row skip_col y remaining_columns

141 -- Don't output the right part unless there is at least a single column left after

144 -- Don't output the right part unless there is at least a single column left after

142 -- outputting the left part.

145 -- outputting the left part.

143 if image_width l < remaining_columns

146 if image_width l < remaining_columns

144− then ops_for_row mrow_ops bg region r y (remaining_columns - image_width l)

147+ then ops_for_row mrow_ops bg region r skip_row skip_col y (remaining_columns - image_width l)

145 else return ()

148 else return ()

146 BGFill width height -> do

149 BGFill width height -> do

147 let actual_height = if y + height > region_height region

150 let actual_height = if y + height > region_height region

150 actual_width = if width > remaining_columns

153 actual_width = if width > remaining_columns

151 then remaining_columns

154 then remaining_columns

152 else width

155 else width

156+ -- XXX: Do we need to notify this of skip_rows or skip_cols?

153 forM_ [y .. y + actual_height - 1] $ \y' -> snoc_bg_fill mrow_ops bg actual_width y'

157 forM_ [y .. y + actual_height - 1] $ \y' -> snoc_bg_fill mrow_ops bg actual_width y'

158+ Translation (dx,dy) i ->

159+ if dx < 0

160+ -- Translation left

161+ -- Extract the delta and add it to skip_col.

154− Translation _offset i -> ops_for_row mrow_ops bg region i y remaining_columns

162+ then ops_for_row mrow_ops bg region (translate (0, dy) i) skip_row (skip_col + dw) y remaining_columns

163+ -- Translation right

164+ else if dy < 0

165+ -- Translation up

166+ -- Extract the delta and add it to skip_row.

167+ then ops_for_row mrow_ops bg region (translate (dx, 0) i) (skip_row + dh) skip_col y remaining_columns

168+ -- Translation down

169+ -- Pad the start of lines and above the image with a

170+ -- background_fill image.

171+ else ops_for_row mrow_ops bg region (background_fill ow dh <-> (background_fill dw ih <|> i)) skip_row skip_col y remaining_columns

172+ where

173+ dw = toEnum $ abs dx

174+ dh = toEnum $ abs dy

175+ ow = image_width image

176+ ih = image_height i

155

177

156snoc_text_span :: (Foldable.Foldable t)

178snoc_text_span :: (Foldable.Foldable t)

157 => Attr

179 => Attr

158 -> t Char

180 -> t Char

159− -> Word -- width of text span in output display columns

160− -> Word -- width of text span in characters

161 -> MRowOps s

181 -> MRowOps s

162 -> Word

182 -> Word

163 -> Word

183 -> Word

184+ -> Word

164 -> ST s ()

185 -> ST s ()

165−snoc_text_span a text_str ow cw mrow_ops y remaining_columns = do

186+snoc_text_span a text_str mrow_ops skip_col y remaining_columns = do

166− if ow > remaining_columns

167− then do

168− snoc_op mrow_ops y $ AttributeChange a

187+ snoc_op mrow_ops y $ AttributeChange a

169− let (ow', cw', txt) = Foldable.foldl'

188+ let (ow', _, cw', txt) = Foldable.foldl'

170− build_cropped_txt

189+ build_cropped_txt

171− ( 0, 0, B.empty )

190+ ( 0, 0, 0, B.empty )

172− text_str

191+ text_str

173− snoc_op mrow_ops y $ TextSpan ow' cw' (UTF8.fromRep txt)

192+ snoc_op mrow_ops y $ TextSpan ow' cw' (UTF8.fromRep txt)

174− else do

175− snoc_op mrow_ops y $ AttributeChange a

176− let utf8_bs = ({-# SCC "BSUTF8.fromString" #-} BSUTF8.fromString) $ Foldable.foldMap (\c -> [c]) text_str

177− snoc_op mrow_ops y $ TextSpan ow cw (UTF8.fromRep utf8_bs)

178 where

193 where

179− build_cropped_txt (ow', char_count', b0) c = {-# SCC "build_cropped_txt" #-}

194+ build_cropped_txt (ow', dw', char_count', b0) c = {-# SCC "build_cropped_txt" #-}

180 let w = wcwidth c

195 let w = wcwidth c

181 -- Characters with unknown widths occupy 1 column.

196 -- Characters with unknown widths occupy 1 column.

182 --

197 --

185 -- the character. If so then this replacement process may need to be implemented

200 -- the character. If so then this replacement process may need to be implemented

186 -- manually for consistent behavior across terminals.

201 -- manually for consistent behavior across terminals.

187 w' = toEnum $ if w < 0 then 1 else w

202 w' = toEnum $ if w < 0 then 1 else w

203+ in if dw' == skip_col

204+ then if ow' == remaining_columns

205+ then ( ow', dw', char_count', b0 )

188− in if (w' + ow') > remaining_columns

206+ else if (w' + ow') > remaining_columns

189− then ( ow', char_count', b0 )

207+ then ( remaining_columns, dw', char_count' + ooverflow, B.append b0 $ B.pack $ encode $ genericReplicate ooverflow '…' )

190− else ( ow' + w', char_count' + 1, B.append b0 $ B.pack $ encode [c] )

208+ else ( ow' + w', dw', char_count' + 1, B.append b0 $ B.pack $ encode [c] )

209+ else if (w' + dw') > skip_col

210+ then ( doverflow, skip_col, doverflow, B.append b0 $ B.pack $ encode $ genericReplicate doverflow '…' )

211+ else ( ow', w' + dw', char_count', b0 )

212+ where

213+ doverflow = skip_col - dw'

214+ ooverflow = remaining_columns - ow'

191

215

192snoc_bg_fill :: MRowOps s -> Background -> Word -> Word -> ST s ()

216snoc_bg_fill :: MRowOps s -> Background -> Word -> Word -> ST s ()

193snoc_bg_fill _row_ops _bg 0 _row

217snoc_bg_fill _row_ops _bg 0 _row