diff --git a/extra/gopher-ui/authors.txt b/extra/gopher-ui/authors.txt new file mode 100644 index 0000000000..e091bb8164 --- /dev/null +++ b/extra/gopher-ui/authors.txt @@ -0,0 +1 @@ +John Benediktsson diff --git a/extra/gopher-ui/gopher-ui.factor b/extra/gopher-ui/gopher-ui.factor new file mode 100644 index 0000000000..3d96207c96 --- /dev/null +++ b/extra/gopher-ui/gopher-ui.factor @@ -0,0 +1,85 @@ +! Copyright (C) 2014 John Benediktsson +! See http://factorcode.org/license.txt for BSD license + +USING: accessors debugger fry gopher gopher.private kernel +models present ui ui.commands ui.gadgets ui.gadgets.borders +ui.gadgets.buttons ui.gadgets.editors ui.gadgets.panes +ui.gadgets.scrollers ui.gadgets.status-bar ui.gadgets.tracks +ui.gestures ui.operations ui.tools.browser +ui.tools.browser.history ui.tools.common urls ; + +IN: gopher-ui + +TUPLE: gopher-gadget < tool history output url-field ; + +{ 600 600 } gopher-gadget set-tool-dim + +M: gopher-gadget history-value + control-value ; + +M: gopher-gadget set-history-value + set-control-value ; + +M: gopher-gadget model-changed + [ value>> present ] + [ url-field>> editor>> set-editor-string ] bi* ; + +: show-gopher ( url gopher-gadget -- ) + [ [ >url ] [ f ] if* ] dip + [ + 2dup control-value = + [ 2drop ] [ nip history>> add-history ] if + ] + [ set-control-value ] + 2bi ; + +: ( gopher-gadget -- field ) + '[ >url _ show-gopher ] ; + +: ( gopher-gadget -- gadget ) + model>> [ '[ _ [ gopher. ] when* ] try ] ; + +: ( browser -- toolbar ) + horizontal + 0 >>fill + 1/2 >>align + { 5 5 } >>gap + over f track-add + swap url-field>> 1 track-add ; + +: ( -- gadget ) + vertical gopher-gadget new-track + f >>model + dup >>history + dup >>url-field + dup { 3 3 } { 1 0 } >>fill f track-add + dup { 3 3 } { 1 1 } >>fill + 1 track-add ; + +: open-gopher-window ( url -- ) + + [ "Gopher" open-status-window ] + [ show-gopher ] bi ; + +: com-clear ( gopher -- ) + f swap set-control-value ; + +: com-gopher ( url -- ) + [ gopher-gadget? ] find-window + [ [ raise-window ] [ gadget-child show-gopher ] bi ] + [ open-gopher-window ] if* ; + +gopher-gadget "toolbar" f { + { f com-back } + { f com-forward } + { f com-clear } +} define-command-map + +gopher-gadget "scrolling" f { + { T{ key-down f f "UP" } com-scroll-up } + { T{ key-down f f "DOWN" } com-scroll-down } + { T{ key-down f f "PAGE_UP" } com-page-up } + { T{ key-down f f "PAGE_DOWN" } com-page-down } +} define-command-map + +[ gopher-link? ] \ com-gopher H{ { +primary+ t } } define-operation diff --git a/extra/gopher/gopher.factor b/extra/gopher/gopher.factor index 88dae14b2a..0238db6254 100644 --- a/extra/gopher/gopher.factor +++ b/extra/gopher/gopher.factor @@ -117,3 +117,5 @@ ERROR: not-a-gopher-url url ; ] each ] } cond ; + +"gopher-ui" require