| 
									
										
										
										
											2009-03-24 05:11:08 -04:00
										 |  |  | ! Copyright (C) 2009 Slava Pestov. | 
					
						
							|  |  |  | ! See http://factorcode.org/license.txt for BSD license. | 
					
						
							| 
									
										
										
										
											2015-05-12 13:46:37 -04:00
										 |  |  | USING: accessors arrays colors.constants definitions help.markup | 
					
						
							|  |  |  | help.stylesheet io io.styles kernel namespaces parser random | 
					
						
							|  |  |  | sequences ;
 | 
					
						
							| 
									
										
										
										
											2009-03-24 05:11:08 -04:00
										 |  |  | IN: help.tips | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | SYMBOL: tips | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | tips [ V{ } clone ] initialize
 | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2009-03-26 14:02:28 -04:00
										 |  |  | TUPLE: tip < identity-tuple content loc ;
 | 
					
						
							| 
									
										
										
										
											2009-03-24 05:11:08 -04:00
										 |  |  | 
 | 
					
						
							| 
									
										
										
										
											2009-10-28 01:23:08 -04:00
										 |  |  | M: tip forget* tips get remove-eq! drop ;
 | 
					
						
							| 
									
										
										
										
											2009-03-26 14:02:28 -04:00
										 |  |  | 
 | 
					
						
							|  |  |  | M: tip where loc>> ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2010-05-05 16:52:54 -04:00
										 |  |  | M: tip set-where loc<< ;
 | 
					
						
							| 
									
										
										
										
											2009-03-26 14:02:28 -04:00
										 |  |  | 
 | 
					
						
							|  |  |  | : <tip> ( content -- tip ) f tip boa ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | : add-tip ( tip -- ) tips get push ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | SYNTAX: TIP: | 
					
						
							|  |  |  |     parse-definition >array <tip> | 
					
						
							|  |  |  |     [ save-location ] [ add-tip ] bi ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2009-03-26 22:28:09 -04:00
										 |  |  | : a-tip ( -- tip ) tips get random ;
 | 
					
						
							| 
									
										
										
										
											2009-03-24 05:11:08 -04:00
										 |  |  | 
 | 
					
						
							|  |  |  | SYMBOL: tip-of-the-day-style | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | H{ | 
					
						
							|  |  |  |     { page-color COLOR: lavender } | 
					
						
							| 
									
										
										
										
											2009-09-09 15:50:25 -04:00
										 |  |  |     { inset { 5 5 } } | 
					
						
							| 
									
										
										
										
											2009-03-24 05:11:08 -04:00
										 |  |  |     { wrap-margin 500 } | 
					
						
							|  |  |  | } tip-of-the-day-style set-global
 | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2009-03-26 22:28:09 -04:00
										 |  |  | : $tip-title ( tip -- )
 | 
					
						
							|  |  |  |     [ | 
					
						
							|  |  |  |         heading-style get [ | 
					
						
							|  |  |  |             [ "Tip of the day" ] dip write-object | 
					
						
							|  |  |  |         ] with-style | 
					
						
							|  |  |  |     ] ($block) ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2009-03-24 05:11:08 -04:00
										 |  |  | : $tip-of-the-day ( element -- )
 | 
					
						
							|  |  |  |     drop
 | 
					
						
							|  |  |  |     [ | 
					
						
							|  |  |  |         tip-of-the-day-style get
 | 
					
						
							|  |  |  |         [ | 
					
						
							|  |  |  |             last-element off
 | 
					
						
							| 
									
										
										
										
											2009-03-26 22:28:09 -04:00
										 |  |  |             a-tip [ $tip-title ] [ content>> print-element nl ] bi
 | 
					
						
							| 
									
										
										
										
											2009-03-24 05:11:08 -04:00
										 |  |  |             "— " print-element "all-tips-of-the-day" ($link) | 
					
						
							|  |  |  |         ] | 
					
						
							|  |  |  |         with-nesting | 
					
						
							|  |  |  |     ] ($heading) ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | : tip-of-the-day. ( -- ) { $tip-of-the-day } print-content nl ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | : $tips-of-the-day ( element -- )
 | 
					
						
							| 
									
										
										
										
											2009-03-26 22:28:09 -04:00
										 |  |  |     drop tips get [ nl nl ] [ content>> print-element ] interleave ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2013-03-23 19:34:33 -04:00
										 |  |  | INSTANCE: tip definition-mixin |