! I wrote this when I was very tired and I just wanted to get it done
! as a result, it's extremely horrible...

USING: arrays combinators io.encodings.utf8 io.files kernel math
math.order namespaces sequences sets ;
IN: aoc.8

SYMBOL: width
SYMBOL: height
: I ( -- input ) "~/factor/aoc/8/8.in" utf8 file-lines
    dup [ length height namespaces:set ] [ first length width namespaces:set ] bi ;

: flip-all-on-y ( xs -- xs ) [ width  namespaces:get swap - 1 - ] map ;
: flip-all-on-x ( ys -- ys ) [ height namespaces:get swap - 1 - ] map ;
: indices ( items seq -- indices ) [ dup length ] dip <repetition> [ index ] 2map ;
: visible-indices ( str -- indices ) [ 0 [ max ] accumulate* members >array ] keep indices ;
: attach-other-axis ( {axis} other-axis -- coords ) [ [ 2array ] curry map ] 2map ;
: with-other-axis ( fn: ( indices -- axis ) -- indices ) [ length <iota> ] bi attach-other-axis concat ; inline
: swap-coords ( {x,y}s -- {y,x}s ) [ reverse ] map ;

: visible-from-left   ( trees -- indices ) [ [ visible-indices ] map ] with-other-axis ;
: visible-from-right  ( trees -- indices ) [ [ reverse visible-indices flip-all-on-y ] map ] with-other-axis ;
: visible-from-top    ( trees -- indices ) [ flip [ visible-indices ] map ] with-other-axis swap-coords ;
: visible-from-bottom ( trees -- indices ) [ flip [ reverse visible-indices flip-all-on-x ] map ] with-other-axis swap-coords ;

: part1 ( -- n ) I { [ visible-from-left ] [ visible-from-right ] [ visible-from-top ] [ visible-from-bottom ] } cleave 4array
    concat members length ;

:: scenic-line ( line -- n ) line unclip [ >= ] curry find drop dup [ ] [ drop line length 2 - ] if 1 + ;
: get-lines ( matrix {x,y} -- {xs,ys} ) [ first swap flip nth ] [ second swap nth ] 2bi 2array ;
: scenic-axis ( place lin -- n ) swap [ 1 + head ] [ tail ] 2bi [ reverse ] dip [ scenic-line ] bi@ * ;
: scenic ( matrix {x,y} -- n ) [ get-lines ] keep reverse swap [ scenic-axis ] 2map product ;
: part2 ( -- n ) I width namespaces:get <iota> height namespaces:get <iota> cartesian-product concat
    [ length ] keep [ swap <repetition> ] dip [ scenic ] 2map 0 [ max ] reduce ;

: solve ( -- ) part1 . part2 . ;