27
28:-module(did_you_know,
29 [ did_you_know_script//1,
30 did_you_know//0
31 ]). 32
38
39:- use_module(library(http/html_write)). 40:- use_module(library(http/http_dispatch)). 41:- use_module(library(random)). 42:- use_module(library(debug)). 43:- use_module(news). 44:- use_module(holidays). 45:- use_module(page). 46:- use_module(library(http/js_write)). 47
48:- http_handler(root(dyk), did_you_know, []). 49
53
54did_you_know(_Request) :-
55 disable_client_cache,
56 reply_html_page(plain,
57 title('SWI-Prolog Did You Know'),
58 \did_you_know).
59
60disable_client_cache :-
61 format('Cache-Control: private, no-store\r\n').
62
66
67did_you_know_script(Id) -->
68 html('Did you know ... '),
69 { http_link_to_id(did_you_know, [], HREF) },
70 js_script({|javascript(Id, HREF)||
71 $(function() {
72 $.ajax({ url: HREF,
73 success: function(data) {
74 console.log(data);
75 $("#"+Id).html(data);
76 }
77 });
78 });
79 |}).
80
81
85
86did_you_know -->
87 { maybe(0.2) },
88 !,
89 html([ span(class('dyk-sponsor'), 'We need you to '),
90 \github_actions([sponsor]),
91 span(class('dyk-sponsor'), ' to keep SWI-Prolog sustainable')
92 ]).
93did_you_know -->
94 { maybe(0.5) },
95 random_news, !.
96did_you_know -->
97 { todays_holiday(april_fools_day),
98 maybe(0.1)
99 },
100 random_silly_hint.
101did_you_know -->
102 random_hint.
103
104random_silly_hint -->
105 { predicate_property(afdyk(_,_), number_of_clauses(N)),
106 ( debugging(dyk(Id)),
107 integer(Id)
108 -> true
109 ; random_between(1, N, Id)
110 ),
111 afdyk(Id, Saying)
112 },
113 say_af_saying(Saying).
114
115say_af_saying(Text-Link) -->
116 { link(Link, HREF) },
117 html([ span(class(lbl), 'Did you know?'),
118 ' ',
119 span(id(dyknow), a(href(HREF), Text))
120 ]).
121say_af_saying(news(Text-Link)) -->
122 { link(Link, HREF) },
123 html([ span(class(lbl), 'News:'),
124 ' ',
125 span(id(dyknow), a(href(HREF), Text))
126 ]).
127say_af_saying(news(Text)) -->
128 html([ span(class(lbl), 'News:'),
129 ' ',
130 span(id(dyknow), Text)
131 ]).
132say_af_saying(Text) -->
133 html([ span(class(lbl), 'Did you know?'),
134 ' ',
135 span(id(dyknow), Text)
136 ]).
137
138random_hint -->
139 { predicate_property(dyk(_,_), number_of_clauses(N)),
140 ( debugging(dyk(Id)),
141 integer(Id)
142 -> true
143 ; random_between(1, N, Id)
144 ),
145 dyk(Id, Saying),
146 ( Saying = (Text-Link)
147 -> link(Link, HREF),
148 Info = a(href(HREF), Text)
149 ; Info = Saying
150 )
151 },
152 html([ span(class(lbl), 'Did you know?'),
153 ' ',
154 span(id(dyknow), Info)
155 ]).
156
157link(section(Id), HREF) :- !,
158 http_link_to_id(pldoc_man, [section=Id], HREF).
159link(object(Obj), HREF) :-
160 format(string(SObj), '~w', Obj),
161 http_link_to_id(pldoc_doc_for, [object=SObj], HREF).
162link(package(Name), HREF) :- !,
163 format(atom(HREF), '/pldoc/package/~w', [Name]).
164link(pack(Name), HREF) :- !,
165 http_link_to_id(pack_list, [p(Name)], HREF).
166link(library(Name), HREF) :- !,
167 format(atom(HREF), '/pldoc/doc/_SWI_/library/~w.pl', [Name]).
168link(HREF, HREF).
169
170
179:- multifile term_expansion/2. 180
181:- nb_setval(dyk_id, 1). 182term_expansion(dyk(Saying), dyk(Id, Saying)) :-
183 nb_getval(dyk_id, Id),
184 Id2 is Id+1,
185 nb_setval(dyk_id, Id2).
186
187dyk(['SWI-Prolog is ', Years, ' years old']) :-
188 get_time(Now),
189 Years is floor((Now-536454000)/(365*24*3600)).
190dyk(['the ', b('Profiler'), ' can speed up your code']-section('profiling-predicates')).
191dyk('You can hot-swap code'-library(hotfix)).
192dyk('M-/ does autocomplete in pceEmacs').
193dyk('C-c C-c CamelCasesWords in pceEmacs').
194dyk('C-c C-- underscores_words_in_pce_emacs').
195dyk('C-+ and C-- changes font size in pceEmacs').
196dyk('Quasi Quoting allows embedding e.g. html, javascript, etc.'-section('quasiquotations')).
197dyk('You can configure your environment'-section('initfile')).
198dyk(['SWI-Prolog supports the ', b('Snowball'), ' stemmer']-section('snowball')).
199dyk(['SWI-Prolog supports ', b(tabling), ' (SLG resolution)']-section('tabling')).
200dyk('SWI-Prolog has an RDF Semantic Web Server'-'http://cliopatria.swi-prolog.org/home').
201dyk('You can interface C++ to SWI-Prolog'-package('pl2cpp')).
202dyk('SWI-Prolog can work with many archive files'-package('archive')).
203dyk('This website is written entirely in SWI-Prolog'-package('http')).
204dyk(['about the full featured ', b('web framework')]-package('http')).
205dyk(['SWI-Prolog can act as an ', b('http client')]-section('http-clients')).
206dyk('SWI-Prolog supports PDT, the Prolog Development Tools'-package('pdt')).
207dyk('You can get Javadoc style documentation automatically'-package('pldoc')).
208dyk(['SWI-Prolog has a ', b('unit test framework')]-package('plunit')).
209dyk(['SWI-Prolog has a ', b('Natural Language Processing (NLP)'), ' library']-package('nlp')).
210dyk(['SWI-Prolog supports ', b('Google Protocol Buffers')]-package('protobufs')).
211dyk('SWI-Prolog talks to R'-package('R')).
212dyk(['SWI-Prolog has ', b('powerful Semantic Web tools')]-package('semweb')).
213dyk(['SWI-Prolog can ', b('parse HTML/SGML/XML')]-package('sgml')).
214dyk(['SWI-Prolog has extensive ', b('GIS Support')]-package('space')).
215dyk(['SWI-Prolog has support for ', b('large, static tables')]-package('table')).
216dyk(['SWI-Prolog supports ', b('TIPC')]-package('tipc')).
217dyk(['You can read/write ', b('.zip'), ' files']-package('zlib')).
218dyk(['SWI-Prolog can talk to many other languages']-'/contrib/').
219dyk(['You can control ', b('MIDI'), ' on Mac with SWI-Prolog']-'/contrib/SamerAbdallah/index.html').
220dyk(['SWI-Prolog has ', b('an OpenGL Interface')]-'/contrib/OpenGL.html').
221dyk(['SWI-Prolog is highly ', b('cross platform')]-'/build/').
222dyk('SWI-Prolog has multiple high quality random number generators'-'/contrib/SamerAbdallah/index.html').
223dyk('The SWI-Prolog manual is available in printed form'-
224 'http://books.google.nl/books/about/SWI_Prolog_Reference_Manual_6_2_2.html?id=q6R3Q3B-VC4C&redir_esc=y').
225dyk(['ETALIS ', b('Event Processing'), ' runs on SWI-Prolog']-'http://code.google.com/p/etalis/').
226dyk('This website\'s code is available'-'https://github.com/SWI-Prolog/plweb').
227dyk(['SWI-Prolog can talk to ', b('Matlab')]-'/contrib/SamerAbdallah/index.html').
228dyk(['SWI-Prolog has an active ', b('Discourse forum')]-'https://swi-prolog.discourse.group/').
229dyk(['Jan loves it when you ', b('Report Bugs')]-'https://github.com/SWI-Prolog/issues/issues').
230dyk(['You can get ', span(class=colored, 'COLORED'), ' text on the command line']-'/FAQ/ColorConsole.html').
231dyk(['SWI-Prolog has a ', b('Nifty IDE')]-'/IDE.html').
232dyk(['SWI-Prolog has a ', b('Graphic Debugger')]-'/gtrace.html').
233dyk(['Try C-c C-n in pceEmacs']-'/navigator.html').
234dyk('Try gxref. from the top level with a large project open'-'/gxref.html').
235dyk('Your proprietary application can use SWI-Prolog'-'/license.html').
236dyk(['SWI-Prolog has an interface to FANN, a foss ', b('Neural Net'), ' library']-'http://leenissen.dk/fann/wp/').
237dyk('SWI-Prolog has lots of useful Packages'-'/pack/list').
238dyk(['SWI-Prolog can ', b('track open source licenses')]-section(softlicense)).
239dyk(['SWI-Prolog has a pack to access ', b('Pubmed Data')]-pack(pubmed)).
240dyk(['SWI-Prolog has ', b('Multi-Thread support')]-section(threads)).
241dyk(['SWI-Prolog provides ', b('general DCG primitives')]-'/pldoc/doc/swi/library/dcg/basics.pl').
242dyk('SWI-Prolog can handle Unix signals'-section(signal)).
243dyk('SWI-Prolog can lazily parse a file'-section(pureinput)).
244dyk('You can add menus to the swipl-win.exe console in windows'-section(plwin)).
245dyk(['SWI-Prolog has a ', b('Profiler')]-section(profile)).
246dyk('SWI-Prolog supports DDE on Windows'-section('DDE')).
247dyk(['You can create ', b('stand alone exe files'), ' from SWI-Prolog code']-section(runtime)).
248dyk('SWI-Prolog supports arbitrarily large integers').
249dyk('SWI-Prolog supports rational numbers (\u211A)').
251dyk(['There\'s an API to interact with ', b('Amazon')]-pack(amazon_api)).
252dyk('Nifty call graphs'-pack(callgraph)).
253dyk('condition is an alternative to exceptions'-pack(condition)).
254dyk('You can train markov chains with BIMS'-pack(bims)).
255dyk('anything in single quotes is an atom').
256dyk('Logtalk is now a pack'-pack(logtalk)).
257dyk('SWI-Prolog has probabilistic logic'-pack(cplint)).
258dyk(['DCG help at lib ',
259 a(href='/pldoc/doc/swi/library/dcg/basics.pl', 'dcg/basics'),
260 ' & packs dcg_util & dcg_utils']).
261dyk('automatic UML->Prolog translation'-pack(dia)).
262dyk('docstore is a document oriented DB in SWI-Prolog'-pack(docstore)).
263dyk('you can deploy to dotcloud'-pack(dotcloud)).
264dyk('CQL makes dealing with SQL easier'-section('/packages/cql.html')).
265dyk('you can turn ugraphs into graphml'-pack(graphml)).
266dyk('you can turn terms into graphviz (.dot) files'-pack(gvterm)).
267dyk('about nifty JoCaml style multithreading'-pack(jolog)).
268dyk('the first Prolog interpreter was in Algol-W by Philippe Roussel (1972)').
269dyk('julian pack offers match based dates'-pack(julian)).
270dyk('you can parse markdown').
271dyk('don\'t use format/2 to print debug messages'-section(debug)).
272dyk('don\'t use format/2 to print errors'-object(print_message/2)).
273dyk('there\'s a simplex library'-section(simplex)).
274dyk('use mavis for type checking'-pack(mavis)).
275dyk('you can read ODF spreadsheets'-pack(odf_sheet)).
276dyk('how to submit a patch'-'/howto/SubmitPatch.html').
277dyk('add language:prolog in github search').
278dyk('there is an official Docker library for SWI-Prolog'-'/Docker.html').
279dyk('there is a Docker image SWISH'-'/Docker.html').
280dyk('SWI-Prolog runs on Android Termux'-'/build/Termux.html').
281dyk('SWI-Prolog can be compiled to WASM to run in your browser'-'https://wasm.swi-prolog.org/wasm/shell').
282dyk('SWI-Prolog for WASM is an npm package'-'https://www.npmjs.com/package/swipl-wasm').
283dyk(['Janus provides a rich and fast bi-directional interface to ', b('Python')]-package(swipy)).
284dyk(['Janus-swi lets you embed SWI-Prolog in ', b('Python')]-'https://pypi.org/project/janus-swi/').
285dyk('Sweep provides a rich Prolog mode for GNU-Emacs'-'https://eshelyaron.com/sweep.html').
286dyk('SWI-Prolog supports the full Unicode character set \U0001F600'-section(widechars)).
287dyk(['SWI-Prolog provides ', b(engines), ' for coroutinging']-section(engines)).
288dyk('print_term/2 can print large terms in readable format'-object(print_term/2)).
289dyk([i('Blobs'), ' provide access to typed and garbage collected foreign data']-section(blob)).
290dyk(['The ', b(libssh), ' pack provides secure login to Prolog server processes']-pack(libssh)).
291dyk(['SWI-Prolog tabling provides ', i('Well Founded Semantics')]-section('WFS')).
292dyk(['SWI-Prolog tabling provides ', i('incremental tabling')]-section('tabling-incremental')).
293dyk(['SWI-Prolog tables can be ', i('shared'), ' between threads']-section('tabling-shared')).
294dyk(['s(CASP) implements top-down answer set programming (ASP)']-pack('scasp')).
295dyk(['s(CASP) add explanations to ASP']-pack('scasp')).
296dyk(['s(CASP) implements ASP ', i('without grounding')]-pack('scasp')).
297
309
310term_expansion(afdyk(Saying), afdyk(Id, Saying)) :-
311 ( predicate_property(afdyk(_,_), number_of_clauses(N))
312 -> Id is N+1
313 ; Id = 1
314 ).
315
316afdyk('SWI-Prolog complies with ISO JTC1/SC22/WG4'-'http://cobolstandard.info/wg4/wg4.html').
317afdyk('C-c C-q automatically corrects syntax errors'-'/AprilFools.html').
318afdyk('SWI-Prolog defaults to EBCDIC'-'/AprilFools.html').
319afdyk(news('SWI-Prolog is now available on 9-track tape'-'/AprilFools.html')).
320afdyk('pack_install(agi) installs Skynet'-'/AprilFools.html').
321afdyk(['SWI-Prolog powers ', a(href='http://java.com' , 'this popular site')]).
322afdyk('http_get is (?, ?, +)').
323afdyk(news('A SWI-Prolog program beat the world champion in box hockey'-'/AprilFools.html')).
324afdyk('8cD'-'https://github.com/Anniepoo/prolog-examples/blob/master/emoticons.pl').
325afdyk(news('Bill Joy admits he\'s wrong, urges Prolog'-'/AprilFools.html')).
326afdyk(['Prolog actually ', b('IS'), ' good for torturing undergrads']-'/AprilFools.html').
327afdyk(news('Colmerauer admits Prolog isn\'t logical at all'-'/AprilFools.html')).
328afdyk('about pack(antigravity)'-'/AprilFools.html').
329afdyk('SWI-Prolog 7.1.29 requires OSGi and qPID'-'/AprilFools.html').
330afdyk('this website powered by windmills'-'/dogfood.html').
331afdyk('Nou breekt mijn klomp. Prolog is beter!'-'/AprilFools.html').
332afdyk('about pack(klomp)'-'/AprilFools.html').
333afdyk('about pack(cheese)'-'/AprilFools.html').
334afdyk('about pack(chocolate)'-'/AprilFools.html').
335afdyk('about pack(evil)'-pack(evil)).
336afdyk('Use Appendix B for clear code'-section(hack)).
337afdyk('Early Prologs ended clauses with AMEN'-
338 'http://web.archive.org/web/20070703003934/www.lim.univ-mrs.fr/~colmer/ArchivesPublications/HistoireProlog/19november92.pdf').
339afdyk('test'-pack(abdcsd))