-! Copyright (C) 2010 Slava Pestov.\r
-USING: arrays accessors euler.b-rep fry gml gml.runtime gml.viewer\r
-gml.printer io.directories io.encodings.utf8 io.files\r
-io.pathnames io.streams.string kernel locals models namespaces\r
-sequences ui ui.gadgets ui.gadgets.buttons ui.gadgets.editors\r
-ui.gadgets.frames ui.gadgets.grids ui.gadgets.labels\r
-ui.gadgets.packs ui.gadgets.scrollers ui.gadgets.worlds\r
-ui.gadgets.tables ui.gadgets.labeled unicode.case ;\r
-FROM: gml => gml ;\r
-IN: gml.ui\r
-\r
-SINGLETON: stack-entry-renderer\r
-\r
-M: stack-entry-renderer row-columns\r
- drop [ write-gml ] with-string-writer 1array ;\r
-\r
-M: stack-entry-renderer row-value\r
- drop ;\r
-\r
-: <stack-table> ( model -- table )\r
- stack-entry-renderer <table>\r
- 10 >>min-rows\r
- 10 >>max-rows\r
- 40 >>min-cols\r
- 40 >>max-cols ;\r
-\r
-: <stack-display> ( model -- gadget )\r
- <stack-table> <scroller> "Operand stack" <labeled-gadget> ;\r
-\r
-TUPLE: gml-editor < frame editor gml stack-model b-rep b-rep-model ;\r
-\r
-: update-models ( gml-editor -- )\r
- [ [ b-rep>> dup finish-b-rep ] [ b-rep-model>> ] bi set-model ]\r
- [ [ gml>> operand-stack>> ] [ stack-model>> ] bi set-model ]\r
- bi ;\r
-\r
-: with-gml-editor ( gml-editor quot -- )\r
- '[\r
- [ [ gml>> gml set ] [ b-rep>> b-rep set ] bi @ ]\r
- [ update-models ]\r
- bi\r
- ] with-scope ; inline\r
-\r
-: find-gml-editor ( gadget -- gml-editor )\r
- [ gml-editor? ] find-parent ;\r
-\r
-: load-input ( file gml-editor -- )\r
- [ utf8 file-contents ] dip editor>> set-editor-string ;\r
-\r
-: update-viewer ( gml-editor -- )\r
- dup [ editor>> editor-string run-gml-string ] with-gml-editor ;\r
-\r
-: new-viewer ( gml-editor -- )\r
- [ update-viewer ]\r
- [ [ b-rep-model>> ] [ stack-model>> ] bi gml-viewer ]\r
- bi ;\r
-\r
-: reset-viewer ( gml-editor -- )\r
- [\r
- b-rep get clear-b-rep\r
- gml get operand-stack>> delete-all\r
- ] with-gml-editor ;\r
-\r
-: <new-button> ( -- button )\r
- "New viewer" [ find-gml-editor new-viewer ] <border-button> ;\r
-\r
-: <update-button> ( -- button )\r
- "Update viewer" [ find-gml-editor update-viewer ] <border-button> ;\r
-\r
-: <reset-button> ( -- button )\r
- "Reset viewer" [ find-gml-editor reset-viewer ] <border-button> ;\r
-\r
-: <control-buttons> ( -- gadget )\r
- <shelf> { 5 5 } >>gap\r
- <new-button> add-gadget\r
- <update-button> add-gadget\r
- <reset-button> add-gadget ;\r
-\r
-CONSTANT: example-dir "vocab:gml/examples/"\r
-\r
-: gml-files ( -- seq )\r
- example-dir directory-files\r
- [ file-extension >lower "gml" = ] filter ;\r
-\r
-: <example-button> ( file -- button )\r
- dup '[ example-dir _ append-path swap find-gml-editor load-input ]\r
- <border-button> ;\r
-\r
-: <example-buttons> ( -- gadget )\r
- gml-files\r
- <pile> { 5 5 } >>gap \r
- "Examples:" <label> add-gadget\r
- [ <example-button> add-gadget ] reduce ;\r
-\r
-: <editor-panel> ( editor -- gadget )\r
- 30 >>min-rows\r
- 30 >>max-rows\r
- 40 >>min-cols\r
- 40 >>max-cols\r
- <scroller> "Editor" <labeled-gadget> ;\r
-\r
-: <gml-editor> ( -- gadget )\r
- 2 3 gml-editor new-frame\r
- <gml> >>gml\r
- <b-rep> >>b-rep\r
- dup b-rep>> <model> >>b-rep-model\r
- dup gml>> operand-stack>> <model> >>stack-model\r
- { 20 20 } >>gap\r
- { 0 0 } >>filled-cell\r
- <source-editor> >>editor\r
- dup editor>> <editor-panel> { 0 0 } grid-add\r
- dup stack-model>> <stack-display> { 0 1 } grid-add\r
- <control-buttons> { 0 2 } grid-add\r
- <example-buttons> { 1 0 } grid-add ;\r
-\r
-M: gml-editor focusable-child* editor>> ;\r
-\r
-: gml-editor-window ( -- )\r
- <gml-editor> "Generative Modeling Language" open-window ;\r
-\r
-MAIN: gml-editor-window\r
+! Copyright (C) 2010 Slava Pestov.
+USING: arrays accessors euler.b-rep fry gml gml.runtime gml.viewer
+gml.printer io.directories io.encodings.utf8 io.files
+io.pathnames io.streams.string kernel locals models namespaces
+sequences ui ui.gadgets ui.gadgets.buttons ui.gadgets.editors
+ui.gadgets.frames ui.gadgets.grids ui.gadgets.labels
+ui.gadgets.packs ui.gadgets.scrollers ui.gadgets.worlds
+ui.gadgets.tables ui.gadgets.labeled unicode.case ;
+FROM: gml => gml ;
+IN: gml.ui
+
+SINGLETON: stack-entry-renderer
+
+M: stack-entry-renderer row-columns
+ drop [ write-gml ] with-string-writer 1array ;
+
+M: stack-entry-renderer row-value
+ drop ;
+
+: <stack-table> ( model -- table )
+ stack-entry-renderer <table>
+ 10 >>min-rows
+ 10 >>max-rows
+ 40 >>min-cols
+ 40 >>max-cols ;
+
+: <stack-display> ( model -- gadget )
+ <stack-table> <scroller> "Operand stack" <labeled-gadget> ;
+
+TUPLE: gml-editor < frame editor gml stack-model b-rep b-rep-model ;
+
+: update-models ( gml-editor -- )
+ [ [ b-rep>> dup finish-b-rep ] [ b-rep-model>> ] bi set-model ]
+ [ [ gml>> operand-stack>> ] [ stack-model>> ] bi set-model ]
+ bi ;
+
+: with-gml-editor ( gml-editor quot -- )
+ '[
+ [ [ gml>> gml set ] [ b-rep>> b-rep set ] bi @ ]
+ [ update-models ]
+ bi
+ ] with-scope ; inline
+
+: find-gml-editor ( gadget -- gml-editor )
+ [ gml-editor? ] find-parent ;
+
+: load-input ( file gml-editor -- )
+ [ utf8 file-contents ] dip editor>> set-editor-string ;
+
+: update-viewer ( gml-editor -- )
+ dup [ editor>> editor-string run-gml-string ] with-gml-editor ;
+
+: new-viewer ( gml-editor -- )
+ [ update-viewer ]
+ [ [ b-rep-model>> ] [ stack-model>> ] bi gml-viewer ]
+ bi ;
+
+: reset-viewer ( gml-editor -- )
+ [
+ b-rep get clear-b-rep
+ gml get operand-stack>> delete-all
+ ] with-gml-editor ;
+
+: <new-button> ( -- button )
+ "New viewer" [ find-gml-editor new-viewer ] <border-button> ;
+
+: <update-button> ( -- button )
+ "Update viewer" [ find-gml-editor update-viewer ] <border-button> ;
+
+: <reset-button> ( -- button )
+ "Reset viewer" [ find-gml-editor reset-viewer ] <border-button> ;
+
+: <control-buttons> ( -- gadget )
+ <shelf> { 5 5 } >>gap
+ <new-button> add-gadget
+ <update-button> add-gadget
+ <reset-button> add-gadget ;
+
+CONSTANT: example-dir "vocab:gml/examples/"
+
+: gml-files ( -- seq )
+ example-dir directory-files
+ [ file-extension >lower "gml" = ] filter ;
+
+: <example-button> ( file -- button )
+ dup '[ example-dir _ append-path swap find-gml-editor load-input ]
+ <border-button> ;
+
+: <example-buttons> ( -- gadget )
+ gml-files
+ <pile> { 5 5 } >>gap
+ "Examples:" <label> add-gadget
+ [ <example-button> add-gadget ] reduce ;
+
+: <editor-panel> ( editor -- gadget )
+ 30 >>min-rows
+ 30 >>max-rows
+ 40 >>min-cols
+ 40 >>max-cols
+ <scroller> "Editor" <labeled-gadget> ;
+
+: <gml-editor> ( -- gadget )
+ 2 3 gml-editor new-frame
+ <gml> >>gml
+ <b-rep> >>b-rep
+ dup b-rep>> <model> >>b-rep-model
+ dup gml>> operand-stack>> <model> >>stack-model
+ { 20 20 } >>gap
+ { 0 0 } >>filled-cell
+ <source-editor> >>editor
+ dup editor>> <editor-panel> { 0 0 } grid-add
+ dup stack-model>> <stack-display> { 0 1 } grid-add
+ <control-buttons> { 0 2 } grid-add
+ <example-buttons> { 1 0 } grid-add ;
+
+M: gml-editor focusable-child* editor>> ;
+
+: gml-editor-window ( -- )
+ <gml-editor> "Generative Modeling Language" open-window ;
+
+MAIN: gml-editor-window
projects / factor.git / blobdiff