From a6dd2e6c8a2653da521088659a92d87f7c9f085f Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Fri, 1 Sep 2023 19:21:37 -0700 Subject: [PATCH] ui: some cleanup of old factor code --- extra/golden-section/golden-section.factor | 42 ++++++------------- .../combinators/templates/templates.factor | 6 ++- extra/persistency/persistency.factor | 32 ++++++++++---- extra/ui/gadgets/alerts/alerts.factor | 33 ++++++++------- 4 files changed, 58 insertions(+), 55 deletions(-) diff --git a/extra/golden-section/golden-section.factor b/extra/golden-section/golden-section.factor index 32f454f076..f8992f8ff0 100644 --- a/extra/golden-section/golden-section.factor +++ b/extra/golden-section/golden-section.factor @@ -1,23 +1,10 @@ -USING: kernel namespaces math math.constants math.functions math.order - arrays sequences - opengl opengl.gl opengl.glu ui ui.render ui.gadgets - ui.gadgets.cartesian colors accessors - processing.shapes ; +USING: accessors arrays colors kernel math math.constants +math.functions math.order namespaces opengl.gl processing.shapes +sequences ui ui.gadgets.cartesian ; IN: golden-section -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -! omega(i) = 2*pi*i*(phi-1) - -! x(i) = 0.5*i*cos(omega(i)) -! y(i) = 0.5*i*sin(omega(i)) - -! radius(i) = 10*sin((pi*i)/720) - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - : omega ( i -- omega ) phi 1 - * 2 * pi * ; : x ( i -- x ) [ omega cos ] [ 0.5 * ] bi * ; @@ -37,18 +24,13 @@ IN: golden-section : golden-section ( -- ) 720 [ dot ] each ; -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - : ( -- gadget ) - - { 600 600 } >>pdim - { -400 400 } x-range - { -400 400 } y-range - [ golden-section ] >>action ; - -: golden-section-window ( -- ) - [ "Golden Section" open-window ] with-ui ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -MAIN: golden-section-window + + { 600 600 } >>pdim + { -400 400 } x-range + { -400 400 } y-range + [ golden-section ] >>action ; + +MAIN-WINDOW: golden-section-window + { { title "Golden Section" } } + >>gadgets ; diff --git a/extra/models/combinators/templates/templates.factor b/extra/models/combinators/templates/templates.factor index 525ee8f144..ae757be7d5 100644 --- a/extra/models/combinators/templates/templates.factor +++ b/extra/models/combinators/templates/templates.factor @@ -13,11 +13,13 @@ w-2* DEFINES 2${W}* w-3* DEFINES 3${W}* w-4* DEFINES 4${W}* WHERE -MACRO: w-n ( int -- quot ) dup '[ [ _ narray ] dip [ _ firstn ] prepend W ] ; +MACRO: w-n ( int -- quot ) + dup '[ [ _ narray ] dip [ _ firstn ] prepend W ] ; : w-2 ( a b quot -- mapped ) 2 w-n ; inline : w-3 ( a b c quot -- mapped ) 3 w-n ; inline : w-4 ( a b c d quot -- mapped ) 4 w-n ; inline -MACRO: w-n* ( int -- quot ) dup '[ [ _ narray #1 ] dip [ _ firstn ] prepend W ] ; +MACRO: w-n* ( int -- quot ) + dup '[ [ _ narray #1 ] dip [ _ firstn ] prepend W ] ; : w-2* ( a b quot -- mapped ) 2 w-n* ; inline : w-3* ( a b c quot -- mapped ) 3 w-n* ; inline : w-4* ( a b c d quot -- mapped ) 4 w-n* ; inline diff --git a/extra/persistency/persistency.factor b/extra/persistency/persistency.factor index fd284e45c5..948c0b46de 100644 --- a/extra/persistency/persistency.factor +++ b/extra/persistency/persistency.factor @@ -6,25 +6,39 @@ IN: persistency TUPLE: persistent id ; -: add-types ( table -- table' ) [ dup array? [ [ first dup >upper ] [ second ] bi 3array ] - [ dup >upper FACTOR-BLOB 3array ] if +: add-types ( table -- table' ) + [ + dup array? [ + [ first dup >upper ] [ second ] bi 3array + ] [ + dup >upper FACTOR-BLOB 3array + ] if ] map { "id" "ID" +db-assigned-id+ } prefix ; -: remove-types ( table -- table' ) [ dup array? [ first ] when ] map ; +: remove-types ( table -- table' ) + [ dup array? [ first ] when ] map ; -SYNTAX: STORED-TUPLE: parse-tuple-definition [ drop persistent ] dip [ remove-types define-tuple-class ] - [ nip [ dup name>> >upper ] [ add-types ] bi* define-persistent ] 3bi ; +SYNTAX: STORED-TUPLE: + parse-tuple-definition [ drop persistent ] dip + [ remove-types define-tuple-class ] + [ nip [ dup name>> >upper ] [ add-types ] bi* define-persistent ] 3bi ; -: define-db ( database class -- ) swap [ [ ensure-table ] with-db ] [ "database" set-word-prop ] 2bi ; +: define-db ( database class -- ) + swap [ [ ensure-table ] with-db ] [ "database" set-word-prop ] 2bi ; + +: query>tuple ( tuple/query -- tuple ) + dup query? [ tuple>> ] when ; + +: w/db ( query quot -- ) + [ dup query>tuple class-of "database" word-prop ] dip with-db ; inline -: query>tuple ( tuple/query -- tuple ) dup query? [ tuple>> ] when ; -: w/db ( query quot -- ) [ dup query>tuple class-of "database" word-prop ] dip with-db ; inline : get-tuples ( query -- tuples ) [ select-tuples ] w/db ; : get-tuple ( query -- tuple ) [ select-tuple ] w/db ; : store-tuple ( tuple -- ) [ insert-tuple ] w/db ; : modify-tuple ( tuple -- ) [ update-tuple ] w/db ; : remove-tuples ( tuple -- ) [ delete-tuples ] w/db ; -TUPLE: pattern value ; C: pattern +TUPLE: pattern value ; +C: pattern SYNTAX: %" parse-string suffix! ; M: pattern where value>> over column-name>> 0% " LIKE " 0% bind# ; diff --git a/extra/ui/gadgets/alerts/alerts.factor b/extra/ui/gadgets/alerts/alerts.factor index 664ae7229c..d75e4d89a8 100644 --- a/extra/ui/gadgets/alerts/alerts.factor +++ b/extra/ui/gadgets/alerts/alerts.factor @@ -1,29 +1,34 @@ -USING: accessors fonts generalizations io.styles kernel locals -macros models models.combinators monads sequences -sequences.generalizations ui ui.gadgets ui.gadgets.buttons -ui.gadgets.controls ui.gadgets.editors ui.gadgets.labels +USING: accessors fonts kernel models.combinators monads +sequences sequences.generalizations ui ui.gadgets +ui.gadgets.buttons ui.gadgets.controls ui.gadgets.labels ui.gadgets.layout ui.gadgets.packs wrap.strings ; IN: ui.gadgets.alerts -:: alert ( quot string -- ) { 10 10 } >>gap 1 >>align - string 22 wrap-lines