basis/help/tips/tips.factor

   1 ! Copyright (C) 2009 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors arrays colors.constants definitions help.markup
   4 help.stylesheet io io.styles kernel literals namespaces parser random
   5 sequences ;
   6 IN: help.tips
   7
   8 SYMBOL: tips
   9
  10 tips [ V{ } clone ] initialize
  11
  12 TUPLE: tip < identity-tuple content loc ;
  13
  14 M: tip forget* tips get remove-eq! drop ;
  15
  16 M: tip where loc>> ;
  17
  18 M: tip set-where loc<< ;
  19
  20 : <tip> ( content -- tip ) f tip boa ;
  21
  22 : add-tip ( tip -- ) tips get push ;
  23
  24 SYNTAX: TIP:
  25     parse-definition >array <tip>
  26     [ save-location ] [ add-tip ] bi ;
  27
  28 : a-tip ( -- tip ) tips get random ;
  29
  30 SYMBOL: tip-of-the-day-style
  31
  32 H{
  33     { page-color COLOR: lavender }
  34     { inset { 5 5 } }
  35     { wrap-margin $ wrap-margin-full }
  36 } tip-of-the-day-style set-global
  37
  38 : $tip-title ( tip -- )
  39     [
  40         heading-style get [
  41             [ "Tip of the day" ] dip write-object
  42         ] with-style
  43     ] ($block) ;
  44
  45 : $tip-of-the-day ( element -- )
  46     drop
  47     [
  48         tip-of-the-day-style get
  49         [
  50             last-element off
  51             a-tip [ $tip-title ] [ content>> print-element nl ] bi
  52             "— " print-element "all-tips-of-the-day" ($link)
  53         ]
  54         with-nesting
  55     ] ($heading) ;
  56
  57 : tip-of-the-day. ( -- ) { $tip-of-the-day } print-content nl ;
  58
  59 : $tips-of-the-day ( element -- )
  60     drop tips get [ nl nl ] [ content>> print-element ] interleave ;
  61
  62 INSTANCE: tip definition-mixin