USING: accessors colors.constants continuations fry
io.directories io.encodings.ascii io.encodings.string
io.files.info io.files.types io.pathnames kernel math
math.parser models namespaces present prettyprint sequences
splitting ui ui.commands ui.gadgets ui.gadgets.buttons
ui.gadgets.frames ui.gadgets.grids ui.gadgets.packs
ui.gadgets.scrollers ui.gadgets.tables ui.gestures ;

! windows.kernel32 ;

IN: file-explorer

SYMBOL: curdir

! : ascii2char ( num -- letter )
!     B{ } 1sequence ascii decode ;

! returns list of accessible drives
! : list-drives ( -- seq )
!     32 iota
!     [ GetLogicalDrives swap bit? ] filter
!     [ 65 + ascii2char ":" append ] map
!     [ accessible? ] filter ;

: accessible? ( drive -- t/f )
    '[ _ (directory-entries) drop t ] [ drop f ] recover ;

SINGLETON: seq-renderer

! to be done in windows only ?
: normalize-path ( path -- path' )
    "\\" "/" replace ;

M: seq-renderer filled-column drop 0 ;
M: seq-renderer column-titles drop "Path : " curdir get-global append { } 1sequence ;
M: seq-renderer row-columns drop name>> present { } 1sequence ;
M: seq-renderer row-color drop dup directory?
    [ name>> curdir get-global "/" append swap append accessible? [ "blue" ] [ "red" ] if ]
    [ drop "black" ] if named-color ;

M: seq-renderer row-value drop ;

: subfolders? ( dir -- t/f )
    "/\\" split length 1 = not ;
    
: dotdot ( -- dir )
    ".." +directory+ directory-entry boa ;

: set-if-accessible ( path -- )
    dup accessible? [ curdir set-global ] [ drop  ] if ;

: inidir ( -- )
    current-directory get normalize-path dup accessible?
    [ curdir set-global ]
    [ drop home curdir set-global ] if ; ! ??

: dir-below ( dir -- dir )
    "/\\" split but-last "/" join ;

: update-dir ( dir1 -- )
    dup name>> ".." =
    [ drop curdir get-global dir-below set-if-accessible ]
    [ curdir get-global "/" append swap name>> append set-if-accessible ] if ;

: update-if-dir ( dir1 -- )
    dup directory? [ update-dir ] [ drop ] if ;

: curdir-contents ( -- seq )
    curdir get-global dup subfolders?
    [ directory-entries dotdot prefix ]
    [ directory-entries ] if ;

: row-hook ( gadget -- )
    dup selected-row
    [ update-if-dir curdir-contents  ] when swap set-control-value ;

: <file-explorer> ( -- table )
    inidir
    curdir-contents <model>
    seq-renderer
    <table>
        8 >>gap
        COLOR: dark-gray >>column-line-color
        { 500 400 } >>pref-dim
        [ row-hook ] >>hook ;

: select-action ( button -- )
    drop ;

: cancel-action ( button -- )
    close-window ;

: fe-buttons ( -- gadget )
    <shelf>
    "Select" [ select-action ] <border-button> add-gadget
    "Cancel" [ cancel-action ] <border-button> add-gadget ;

: file-explorer ( -- )
    [ 1 2 <frame> { 0 0 } >>filled-cell
      <file-explorer> <scroller>  { 0 0 } grid-add
      fe-buttons { 0 1 } grid-add
      "File Explorer" open-window ] with-ui ;
  
  MAIN: file-explorer