Paste: fain.factor

Author: xiackok
Mode: factor
Date: Fri, 28 Jan 2011 05:23:23
Plain Text |
! Copyright (C) 2011 Your name.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors colors.constants combinators.smart github json kernel
models models.arrow namespaces prettyprint.backend sequences strings
ui ui.gadgets ui.gadgets.borders ui.gadgets.buttons ui.gadgets.editors
ui.gadgets.labels ui.gadgets.line-support ui.gadgets.tables ui.gadgets.scrollers
ui.gadgets.tracks ui.pens.solid fain.utils tools.continuations arrays 
math present images.http images.jpeg images.viewer images.loader continuations 
threads ;

IN: fain

SYMBOL: github-info
SYMBOL: github-repositories
SYMBOL: username
SYMBOL: gravatar-image

"" <model> username set-global
f <model> github-info set-global
f <model> github-repositories set-global
"resource:work/fain/default.jpg" load-image <model> gravatar-image set-global

SINGLETON: github-renderer

M: github-renderer filled-column
    drop 0 ;

M: github-renderer column-titles
    drop { "" "" } ;

M: github-renderer row-columns
    drop
    [ first slotname>readable ]
    [ second dup number? [ present ] [ ] if ]
    bi 2array ;

M: github-renderer row-value
    drop second ;

SINGLETON: repository-renderer

M: repository-renderer filled-column
    drop 0 ;

M: repository-renderer column-titles
    drop { "Name" "Language" } ;

M: repository-renderer row-columns
    drop ;

M: repository-renderer row-value
    drop second ;

: user>assoc ( user-info -- assoc )
    tuple>assoc
    [
        second dup json-null = not
        [ dup string? [ empty? not ] [ drop t ] if ]
        [ drop f ]
        if
    ] filter ; 

: drop-unusual ( assoc -- assoc' )
    [
        first dup "gravatar_id" = not
        dupd swap "type" = not and
        dupd swap "created_at" = not and
        dupd swap "id" = not and
        dupd swap "login" = not and nip         
    ] filter ;

TUPLE: user-table < table ;

M: user-table visible?>>
    model>> value>> ;

: <user-table> ( -- user-table )
    github-info get [ [ user>assoc drop-unusual ] [ { } ] if*  ] <arrow>
    github-renderer
    user-table new-table 10 >>min-rows ;

: <repositories-table> ( -- user-table )
    github-repositories get
    [
        [ [ [ name>> ] [ language>> [ ] [ "" ] if* ] bi 2array ] map ]
        [ { } ] if*
    ] <arrow>
    repository-renderer
    user-table new-table 10 >>min-rows ;

: load-gravatar-image ( gravatar-id -- )
    [
        "http://gravatar.com/avatar/" ".jpg" surround
        load-http-image
    ]
    [
        drop drop
        "resource:work/fain/default.jpg"
        load-image
    ] recover
    gravatar-image get set-model ;

: <gravatar-image> ( -- gadget )
    gravatar-image get <image-control> ;
    
: <get-button> ( -- button )
    "Get"
    [
        drop
        [
            username get value>> dup
            user-info
            github-info get set-model
            repositories
            github-repositories get set-model
            github-info get value>> gravatar_id>>
            load-gravatar-image
        ] in-thread
    ] <border-button> ;

: <fain> ( -- fain )
    vertical <track> { 5 5 } >>gap
      "Enter github username for retrive info" <label> f track-add
      horizontal <track> { 5 5 } >>gap
        username get <model-field> 1 track-add
        <get-button> f track-add
      f track-add
      <gravatar-image> { 5 5 } <border> f track-add
      "User Information" <label> f track-add
      <user-table> { 5 5 } <border> { 0 0 } >>align  <scroller> 1 track-add
      "Repositories" <label> f track-add
      <repositories-table> { 5 5 } <border> { 0 0 } >>align <scroller> 1 track-add ;      

: run-fain ( -- )
    [
        <fain> { 10 10 } <border> { 1 1 } >>fill
        "Fain - Factor Github Client" open-window
    ] with-ui ;

MAIN: run-fain

New Annotation

Summary:
Author:
Mode:
Body: