basis/help/tips/tips.factor

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