Skip to content

Instantly share code, notes, and snippets.

@ktakashi
Created June 14, 2023 07:28
Show Gist options
  • Save ktakashi/651717e9ec97e83e23f4fdf062de92c2 to your computer and use it in GitHub Desktop.
Save ktakashi/651717e9ec97e83e23f4fdf062de92c2 to your computer and use it in GitHub Desktop.
Random urban dictionary word card
┌─────────────────────────────────────────────────────────────────────────────┐
│ i am disappoint │
│ a 4chan meme. it is a series of badly drawn comics in which the son does │
│ an act the father disapproves of, and the father says: son, i am disappoint │
│ │
│ Example(s) │
│ fap fap fap- son, i am disappoint │
│ │
│ did you see the latest i am disappoint? it was hilarious │
└─────────────────────────────────────────────────────────────────────────────┘
┌─────────────────────────────────────────────────────────────────────────────┐
│ Qunt │
│ A cunt who believes in, pushes, or supports those who follow the QAnon │
│ conspiracy theory and overturning democracy. Usually also a Trump supporter │
│ who watches Fox News, OAN, or Newsmax. │
│ │
│ Example(s) │
│ Marjorie Taylor Greene is a massive qunt who doesn't believe in democracy. │
│ │
│ See also: Kelly Loeffler, Laura Ingraham, Kayleigh McEnany │
└─────────────────────────────────────────────────────────────────────────────┘
(import (rnrs)
(getopt)
(net http-client)
(rfc uri-template)
(sagittarius combinators)
(srfi :1)
(srfi :13)
(srfi :18)
(text json)
(text json jmespath)
(util concurrent)
(util port))
(define pool-config
(http-pooling-connection-config-builder
(connection-timeout 1000)
(max-connection-per-route 20)
(read-timeout 3000)
(dns-timeout 1000)
(time-to-live 120)))
(define http-client
(http:client-builder
(connection-manager (make-http-pooling-connection-manager pool-config))))
(define (http-get uri callback)
(define request (http:request-builder (uri uri)))
(future-map callback (http:client-send-async http-client request)))
(define (string->json s) (json-read (open-string-input-port s)))
(define (urban/random)
(http-get "https://api.urbandictionary.com/v0/random"
($. http:response-body utf8->string string->json)))
(define urban/term
(let ((template
(parse-uri-template
(open-string-input-port
"https://api.urbandictionary.com/v0/define?term={term}"))))
(lambda (term)
(http-get (expand-uri-template template `#(("term", term)))
($. http:response-body utf8->string string->json)))))
(define word (jmespath "[word, definition, example]"))
(define word-list (jmespath "list[].word"))
(define max-thumb-up (jmespath "max_by(list, &thumbs_up).[word, definition, example]"))
(define (describe-word l line)
(define delta 5)
(define (format-line wl)
(define (upper-bound? l) (>= l (+ line delta)))
(let loop ((wl wl) (l 0) (t '()) (r '()))
(cond ((null? wl) (reverse! (cons (string-join (reverse! t) " ") r)))
((upper-bound? (+ l 1 (string-length (car wl))))
(loop wl 0 '() (cons (string-join (reverse! t) " ") r)))
(else
(loop (cdr wl)
(+ l 1 (string-length (car wl))) (cons (car wl) t) r)))))
(define (format-lines s)
(let ((l* (map string-tokenize
(port->string-list (open-string-input-port s)))))
(append-map format-line l*)))
(define (count s)
(length (filter (lambda (c) (not (memv c '(#\[ #\])))) (string->list s))))
(define (check l1* l2*)
(let ((m1 (if (null? l1*) line (apply max (map count l1*))))
(m2 (if (null? l2*) line (apply max (map count l2*)))))
(max m1 m2)))
(define (replace-square-blacket w)
(let-values (((o e) (open-string-output-port)))
(string-for-each (lambda (c)
(case c
((#\[) (put-string o "\x1b;[34m"))
((#\]) (put-string o "\x1b;[0m"))
(else (put-char o c)))) w)
(e)))
(define (draw-line n s e)
(display "\x1b;(0")
(display s)
(do ((i 0 (+ i 1)))
((= i n) (display e) (print "\x1b;(B"))
(display "\x71;")))
(define (pad m w)
(define len (max 0 (- m (count w))))
(do ((i 0 (+ i 1)))
((= i len))
(display " ")))
(define vl "\x1b;(0\x78;\x1b;(B")
(define (bu o)
(display "\x1b;[1m\x1b;[4m")
(display o)
(display "\x1b;[0m"))
(define (b o)
(display "\x1b;[1m")
(display o)
(display "\x1b;[0m"))
(define d display)
(define p print)
(define ((draw-sentence max-length) l)
(let ((v (replace-square-blacket l)))
(d " ") (d vl) (d " ") (d v) (pad max-length l) (p " " vl)))
(let* ((word (car l))
(def (format-lines (cadr l)))
(ex (format-lines (caddr l)))
(max-length (check def ex)))
(d " ") (draw-line (+ max-length 2) "\x6c;" "\x6b;")
(d " ") (d vl) (d " ") (bu word) (pad max-length word) (p " " vl)
(for-each (draw-sentence max-length) def)
(d " ") (d vl) (d " ") (pad max-length "") (p " " vl)
(let ((ex "Example(s)"))
(d " ") (d vl) (d " ") (b ex) (pad max-length ex) (p " " vl))
(for-each (draw-sentence max-length) ex)
(d " ") (draw-line (+ max-length 2) "\x6d;" "\x6a;")))
(define (load-words) (future-get (future-map word-list (urban/random))))
(define (main args)
(with-args (cdr args)
((period (#\p "period") #t "60")
(width (#\w "width") #t "74")
. ignore)
(let loop ((words (load-words)))
(if (null? words)
(loop (load-words))
(let ((word (car words)))
(describe-word
(future-get (future-map max-thumb-up (urban/term word)))
(string->number width))
(thread-sleep! (string->number period))
(loop (cdr words)))))))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment