Paste: stabby

! Copyright © 2020 atax1a.
! See http://factorcode.org/license.txt for BSD license.

! No, I'm not using Factor to track who i've stabbed. My girlfriend has to
! occasionally inject medication, and this is designed to keep her from
! forgetting which leg she injected herself in.
!
! I cribbed the spirit of this code from various internet sources, but only the
! spirit. The details are all mine, and I'm sure it shows — this is definitely
! not the cleanest Factor code out there.

USING: accessors arrays assocs calendar calendar.format db db.sqlite db.tuples
db.types fonts fry kernel listener models models.arrow namespaces
sequences ui ui.gadgets ui.gadgets.buttons ui.gadgets.labels ui.gadgets.packs ;
FROM: models => change-model ;
IN: stabby

SYMBOLS: last-stabbing  ;
SINGLETONS: left right left-belly right-belly ;
UNION: leg left right left-belly right-belly ;
TUPLE: stabbing id when leg notes ;

stabbing "stabbing" {
    { "id" "id" +db-assigned-id+ }
    { "when" "_when" TIMESTAMP +not-null+ }
    { "leg" "leg" FACTOR-BLOB +not-null+ }
    { "notes" "notes" TEXT }
} define-persistent

<PRIVATE
: (last-stabbing) ( -- stabbing ) last-stabbing get-global ;
: (set-stabbing-model) ( stabbing -- ) (last-stabbing) set-model ; inline
: (stabby-db) ( -- db ) "~/.stabby.db" <sqlite-db> ; inline
! for use in the listener, of course.
: stabby-db-listener ( -- )
    (stabby-db) [ listener ] with-db ;
PRIVATE>

: with-stabby-db ( quot -- )
    '[ (stabby-db) _ with-db ] call ; inline

: new-leg-stabbing ( leg -- stabbing )
    stabbing new swap >>leg ;
: ensure-stabbing ( ? -- stabbing )
    [ f now leg "" stabbing boa ] unless* ;
: most-recent-stabbing ( -- stabbing )
    T{ stabbing } >query
        "_when desc" >>order
        1 >>limit select-tuple
    ensure-stabbing ;

: change-stabbing-model ( quot -- )
    [ (set-stabbing-model) ] bi ; inline

: record-stabbing ( leg -- )
    new-leg-stabbing
    now >>when
    [ "" or ] change-notes
    [
        [ insert-tuple ] change-stabbing-model
    ] with-stabby-db ;

: <24-point-label-control> ( model -- gadget )
    <label-control> sans-serif-font 24 >>size >>font ;

: <leg-model> ( stabbing -- model )
    [ leg>> name>> "Last stabbing: " prepend ] <arrow> ;
: <last-time-model> ( stabbing -- model )
    [ when>> >local-time timestamp>string ] <arrow> ;

: delete-last-stabbing ( -- )
    "delete from stabbing where id = ?"
    (last-stabbing) value>> id>> 1array
    { } <prepared-statement>
    execute-statement ;

: (stab-button) ( button leg -- )
    record-stabbing drop ;
: (stabbing-buttons) ( -- gadget )
    <shelf>
        { 5 0 } >>gap
    { { "Left leg" [ left (stab-button) ] }
      { "Right leg" [ right (stab-button) ] }
      { "Left belly" [ left-belly (stab-button) ] }
      { "Right belly" [ right-belly (stab-button) ] }
    }
    [ <border-button> add-gadget ] assoc-each ;

: (stabbing-view) ( stabbing -- x y )
    [ <leg-model> ] keep <last-time-model> ;

: stabbing-view ( stabbing -- pile )
    (stabbing-view) 2array
      [ <24-point-label-control> ] map
    (stabbing-buttons) suffix
    <pile> swap add-gadgets ;

: make-ui ( model -- gadget )
    <pile>
        "Stabby Tracker" <label> sans-serif-font 36 >>size >>font add-gadget
        swap stabbing-view add-gadget ;

MAIN-WINDOW: stabby { { title "Stabby Medicine Tracker" }
                      { pref-dim { 384 128 } } }
  [
      stabbing ensure-table
      most-recent-stabbing <model>
  ] with-stabby-db
  [ last-stabbing set-global ]
  [ make-ui ] bi
  >>gadgets ;