Initial.
commit
1adff7d035
@ -0,0 +1,198 @@
|
|||||||
|
(import chicken scheme srfi-1)
|
||||||
|
(use awful
|
||||||
|
(only waffle waffle-sxml->html add-widget get-widget widgets widget-rules)
|
||||||
|
numbers scss spiffy-request-vars format)
|
||||||
|
|
||||||
|
;; Widgets are like composable HTML templates but with SXML
|
||||||
|
(include "widgets") ; common web app widgets
|
||||||
|
|
||||||
|
;; Needed for interactive development because widgets are thread local
|
||||||
|
(define (waffle-sxml->html* sxml)
|
||||||
|
(parameterize ((widgets *widgets*) (widget-rules *widget-rules*))
|
||||||
|
(waffle-sxml->html sxml)))
|
||||||
|
|
||||||
|
;; Standardize all pages
|
||||||
|
(define (defpage path thunk)
|
||||||
|
(define-page path (lambda ()
|
||||||
|
(with-output-to-string
|
||||||
|
(lambda ()
|
||||||
|
(waffle-sxml->html* (thunk)))))
|
||||||
|
headers: (with-output-to-string
|
||||||
|
(lambda ()
|
||||||
|
(waffle-sxml->html*
|
||||||
|
`((stylesheet (@ (path "normalize.css")))
|
||||||
|
(stylesheet (@ (path "foundation.min.css")))
|
||||||
|
(stylesheet (@ (path "app.css")))
|
||||||
|
))))
|
||||||
|
no-session: #t))
|
||||||
|
|
||||||
|
(widget
|
||||||
|
'menu
|
||||||
|
``(group-box (@ (title ,title))
|
||||||
|
,@(map (lambda (n)
|
||||||
|
`((a (@ (href ,(conc "/?type=" type "&n=" n))) ,n)
|
||||||
|
(br) (br)))
|
||||||
|
(iota len)))
|
||||||
|
'((title "") (type "none") (len 0)))
|
||||||
|
|
||||||
|
(widget
|
||||||
|
'menu-bar
|
||||||
|
``(div
|
||||||
|
(menu (@ (title "Investors") (type i) (len ,len-i)))
|
||||||
|
(menu (@ (title "Companies") (type c) (len ,len-c))))
|
||||||
|
'((len-i 0) (len-c 0)))
|
||||||
|
|
||||||
|
(widget
|
||||||
|
'schedule-table
|
||||||
|
``(group-box
|
||||||
|
(@ (title ,title))
|
||||||
|
(cols (div
|
||||||
|
(h5 "Schedule")
|
||||||
|
(table (@ (class "schedule"))
|
||||||
|
(tr (th "Time") (th "Meeting with"))
|
||||||
|
,@contents))))
|
||||||
|
'((title "")))
|
||||||
|
|
||||||
|
(widget
|
||||||
|
'shuffle-bar
|
||||||
|
``(cols (center
|
||||||
|
(form (@ (action "/shuffle"))
|
||||||
|
(button (@ (type "submit") (class "small")) "Shuffle"))))
|
||||||
|
'())
|
||||||
|
|
||||||
|
;; add support for defaults to request variables
|
||||||
|
(define ((as-number/default default) var vars/vals)
|
||||||
|
(or (as-number var vars/vals) default))
|
||||||
|
(define ((as-symbol/default default) var vars/vals)
|
||||||
|
(or (as-symbol var vars/vals) default))
|
||||||
|
|
||||||
|
;;;;;; PAGES ;;;;;;
|
||||||
|
|
||||||
|
;; NOTE: company and investor relations are stored in a-lists where
|
||||||
|
;; the symbol 'i references an investor, 'c a company, and 's a score.
|
||||||
|
(defpage "/"
|
||||||
|
(lambda ()
|
||||||
|
(define (time t)
|
||||||
|
(let* ((rem (remainder t 60))
|
||||||
|
(hr (/ (- t rem) 60)))
|
||||||
|
(format "~2D:~2,'0D" hr rem)))
|
||||||
|
(define (schedule-for type n)
|
||||||
|
(map (lambda (round) (find (lambda (x) (eq? (alist-ref type x) n)) round)) *schedule*))
|
||||||
|
(define (slot type meeting t)
|
||||||
|
`(tr (td ,(time t)) (td ,(if meeting (alist-ref type meeting) '-))))
|
||||||
|
(define (type-title t) (if (eq? t 'c) "Company" "Investor"))
|
||||||
|
|
||||||
|
(with-request-vars ((n (as-number/default 0)) (type (as-symbol/default 'c)))
|
||||||
|
(let ((start-time (* 9 60)))
|
||||||
|
`((row
|
||||||
|
(col (@ (width 3))
|
||||||
|
(menu-bar (@ (len-i ,(length *investors*))
|
||||||
|
(len-c ,(length *companies*))))
|
||||||
|
(shuffle-bar))
|
||||||
|
(col (@ (width 9))
|
||||||
|
(schedule-table
|
||||||
|
(@ (title ,(conc (type-title type) " " n)))
|
||||||
|
,@(let ((schedules (schedule-for type n)))
|
||||||
|
(map (lambda (schedule t)
|
||||||
|
(slot (if (eq? type 'c) 'i 'c) schedule t))
|
||||||
|
schedules
|
||||||
|
(iota (length schedules) start-time 20)))))))))))
|
||||||
|
|
||||||
|
(define-page "/shuffle"
|
||||||
|
(lambda ()
|
||||||
|
(regen-schedule)
|
||||||
|
(redirect-to "/?type=c&n=0"))
|
||||||
|
no-session: #t)
|
||||||
|
|
||||||
|
(define (run-awful) ; for emacs interactive development
|
||||||
|
(thread-start!
|
||||||
|
(lambda ()
|
||||||
|
(awful-start (lambda () (void)) port: 8080))))
|
||||||
|
|
||||||
|
;;;;;; CSS ;;;;;;
|
||||||
|
(define (scss->file path scss)
|
||||||
|
(with-output-to-file path
|
||||||
|
(lambda () (write-css scss))))
|
||||||
|
|
||||||
|
(scss->file
|
||||||
|
"res/css/app.css"
|
||||||
|
'(css+
|
||||||
|
((.schedule li) (white-space pre))))
|
||||||
|
|
||||||
|
|
||||||
|
;;;;;; Scheduling ;;;;;;
|
||||||
|
(define (shuffle! v)
|
||||||
|
(do ((n (vector-length v) (- n 1)))
|
||||||
|
((zero? n) v)
|
||||||
|
(let* ((r (random n)) (t (vector-ref v r)))
|
||||||
|
(vector-set! v r (vector-ref v (- n 1)))
|
||||||
|
(vector-set! v (- n 1) t))))
|
||||||
|
|
||||||
|
(define (gen-ranks n)
|
||||||
|
(vector->list (shuffle! (list->vector n))))
|
||||||
|
|
||||||
|
;; randomly generate lists of rankings
|
||||||
|
(define (gen-ranks-list n)
|
||||||
|
(map (lambda (i) (gen-ranks (iota n))) (iota n)))
|
||||||
|
|
||||||
|
;; map ranking lists to companies and investors
|
||||||
|
;; score the combination by adding ranks together
|
||||||
|
;; higher is better.
|
||||||
|
;; As noted earlier: 'i == investor and 'c == company,
|
||||||
|
;; 's == score.
|
||||||
|
(define (score companies investors)
|
||||||
|
(map (lambda (c i)
|
||||||
|
(map (lambda (j)
|
||||||
|
`((c . ,i)
|
||||||
|
(i . ,j)
|
||||||
|
(s .
|
||||||
|
,(+ (list-ref (list-ref investors j) i)
|
||||||
|
(list-ref c j)))))
|
||||||
|
(iota (length companies))))
|
||||||
|
companies (iota (length investors))))
|
||||||
|
|
||||||
|
(define (sort-scores companies investors)
|
||||||
|
(map
|
||||||
|
(lambda (company)
|
||||||
|
(sort
|
||||||
|
company
|
||||||
|
(lambda (x1 x2)
|
||||||
|
(> (alist-ref 's x1) (alist-ref 's x2)))))
|
||||||
|
(score companies investors)))
|
||||||
|
|
||||||
|
;; find best match and return unmatched combinations
|
||||||
|
(define (match/remainder taken ranks)
|
||||||
|
(let ((mtch (find (lambda (x) (not (memq (alist-ref 'i x) taken))) ranks)))
|
||||||
|
(receive (head tail) (span (lambda (x) (not (eq? x mtch))) ranks)
|
||||||
|
(if (null? tail)
|
||||||
|
(values #f head)
|
||||||
|
(values (car tail) (append head (cdr tail)))))))
|
||||||
|
|
||||||
|
(define (allocate-round ranks)
|
||||||
|
(let loop ((taken '()) (matches '()) (ranks ranks) (left '()))
|
||||||
|
(if (null? ranks)
|
||||||
|
(values (reverse matches) (reverse left))
|
||||||
|
(receive (mtch rem) (match/remainder taken (car ranks))
|
||||||
|
(if mtch
|
||||||
|
(loop (cons (alist-ref 'i mtch) taken)
|
||||||
|
(cons mtch matches) (cdr ranks) (cons rem left))
|
||||||
|
(loop taken matches (cdr ranks) (cons rem left)))))))
|
||||||
|
|
||||||
|
(define (make-schedule ranks)
|
||||||
|
(let loop ((ranks ranks) (matches '()))
|
||||||
|
(if (null? ranks)
|
||||||
|
(reverse matches)
|
||||||
|
(receive (mtchs new-ranks) (allocate-round ranks)
|
||||||
|
(if (null? mtchs)
|
||||||
|
(reverse matches)
|
||||||
|
(loop new-ranks (cons mtchs matches)))))))
|
||||||
|
|
||||||
|
(define *schedule* '())
|
||||||
|
(define *companies* '())
|
||||||
|
(define *investors* '())
|
||||||
|
|
||||||
|
(define (regen-schedule)
|
||||||
|
(set! *companies* (gen-ranks-list 10))
|
||||||
|
(set! *investors* (gen-ranks-list 10))
|
||||||
|
(set! *schedule* (make-schedule (sort-scores *companies* *investors*))))
|
||||||
|
(regen-schedule)
|
||||||
@ -0,0 +1 @@
|
|||||||
|
.schedule, li { white-space: pre }
|
||||||
File diff suppressed because one or more lines are too long
@ -0,0 +1,423 @@
|
|||||||
|
/*! normalize.css v3.0.0 | MIT License | git.io/normalize */
|
||||||
|
|
||||||
|
/**
|
||||||
|
* 1. Set default font family to sans-serif.
|
||||||
|
* 2. Prevent iOS text size adjust after orientation change, without disabling
|
||||||
|
* user zoom.
|
||||||
|
*/
|
||||||
|
|
||||||
|
html {
|
||||||
|
font-family: sans-serif; /* 1 */
|
||||||
|
-ms-text-size-adjust: 100%; /* 2 */
|
||||||
|
-webkit-text-size-adjust: 100%; /* 2 */
|
||||||
|
}
|
||||||
|
|
||||||
|
/**
|
||||||
|
* Remove default margin.
|
||||||
|
*/
|
||||||
|
|
||||||
|
body {
|
||||||
|
margin: 0;
|
||||||
|
}
|
||||||
|
|
||||||
|
/* HTML5 display definitions
|
||||||
|
========================================================================== */
|
||||||
|
|
||||||
|
/**
|
||||||
|
* Correct `block` display not defined in IE 8/9.
|
||||||
|
*/
|
||||||
|
|
||||||
|
article,
|
||||||
|
aside,
|
||||||
|
details,
|
||||||
|
figcaption,
|
||||||
|
figure,
|
||||||
|
footer,
|
||||||
|
header,
|
||||||
|
hgroup,
|
||||||
|
main,
|
||||||
|
nav,
|
||||||
|
section,
|
||||||
|
summary {
|
||||||
|
display: block;
|
||||||
|
}
|
||||||
|
|
||||||
|
/**
|
||||||
|
* 1. Correct `inline-block` display not defined in IE 8/9.
|
||||||
|
* 2. Normalize vertical alignment of `progress` in Chrome, Firefox, and Opera.
|
||||||
|
*/
|
||||||
|
|
||||||
|
audio,
|
||||||
|
canvas,
|
||||||
|
progress,
|
||||||
|
video {
|
||||||
|
display: inline-block; /* 1 */
|
||||||
|
vertical-align: baseline; /* 2 */
|
||||||
|
}
|
||||||
|
|
||||||
|
/**
|
||||||
|
* Prevent modern browsers from displaying `audio` without controls.
|
||||||
|
* Remove excess height in iOS 5 devices.
|
||||||
|
*/
|
||||||
|
|
||||||
|
audio:not([controls]) {
|
||||||
|
display: none;
|
||||||
|
height: 0;
|
||||||
|
}
|
||||||
|
|
||||||
|
/**
|
||||||
|
* Address `[hidden]` styling not present in IE 8/9.
|
||||||
|
* Hide the `template` element in IE, Safari, and Firefox < 22.
|
||||||
|
*/
|
||||||
|
|
||||||
|
[hidden],
|
||||||
|
template {
|
||||||
|
display: none;
|
||||||
|
}
|
||||||
|
|
||||||
|
/* Links
|
||||||
|
========================================================================== */
|
||||||
|
|
||||||
|
/**
|
||||||
|
* Remove the gray background color from active links in IE 10.
|
||||||
|
*/
|
||||||
|
|
||||||
|
a {
|
||||||
|
background: transparent;
|
||||||
|
}
|
||||||
|
|
||||||
|
/**
|
||||||
|
* Improve readability when focused and also mouse hovered in all browsers.
|
||||||
|
*/
|
||||||
|
|
||||||
|
a:active,
|
||||||
|
a:hover {
|
||||||
|
outline: 0;
|
||||||
|
}
|
||||||
|
|
||||||
|
/* Text-level semantics
|
||||||
|
========================================================================== */
|
||||||
|
|
||||||
|
/**
|
||||||
|
* Address styling not present in IE 8/9, Safari 5, and Chrome.
|
||||||
|
*/
|
||||||
|
|
||||||
|
abbr[title] {
|
||||||
|
border-bottom: 1px dotted;
|
||||||
|
}
|
||||||
|
|
||||||
|
/**
|
||||||
|
* Address style set to `bolder` in Firefox 4+, Safari 5, and Chrome.
|
||||||
|
*/
|
||||||
|
|
||||||
|
b,
|
||||||
|
strong {
|
||||||
|
font-weight: bold;
|
||||||
|
}
|
||||||
|
|
||||||
|
/**
|
||||||
|
* Address styling not present in Safari 5 and Chrome.
|
||||||
|
*/
|
||||||
|
|
||||||
|
dfn {
|
||||||
|
font-style: italic;
|
||||||
|
}
|
||||||
|
|
||||||
|
/**
|
||||||
|
* Address variable `h1` font-size and margin within `section` and `article`
|
||||||
|
* contexts in Firefox 4+, Safari 5, and Chrome.
|
||||||
|
*/
|
||||||
|
|
||||||
|
h1 {
|
||||||
|
font-size: 2em;
|
||||||
|
margin: 0.67em 0;
|
||||||
|
}
|
||||||
|
|
||||||
|
/**
|
||||||
|
* Address styling not present in IE 8/9.
|
||||||
|
*/
|
||||||
|
|
||||||
|
mark {
|
||||||
|
background: #ff0;
|
||||||
|
color: #000;
|
||||||
|
}
|
||||||
|
|
||||||
|
/**
|
||||||
|
* Address inconsistent and variable font size in all browsers.
|
||||||
|
*/
|
||||||
|
|
||||||
|
small {
|
||||||
|
font-size: 80%;
|
||||||
|
}
|
||||||
|
|
||||||
|
/**
|
||||||
|
* Prevent `sub` and `sup` affecting `line-height` in all browsers.
|
||||||
|
*/
|
||||||
|
|
||||||
|
sub,
|
||||||
|
sup {
|
||||||
|
font-size: 75%;
|
||||||
|
line-height: 0;
|
||||||
|
position: relative;
|
||||||
|
vertical-align: baseline;
|
||||||
|
}
|
||||||
|
|
||||||
|
sup {
|
||||||
|
top: -0.5em;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub {
|
||||||
|
bottom: -0.25em;
|
||||||
|
}
|
||||||
|
|
||||||
|
/* Embedded content
|
||||||
|
========================================================================== */
|
||||||
|
|
||||||
|
/**
|
||||||
|
* Remove border when inside `a` element in IE 8/9.
|
||||||
|
*/
|
||||||
|
|
||||||
|
img {
|
||||||
|
border: 0;
|
||||||
|
}
|
||||||
|
|
||||||
|
/**
|
||||||
|
* Correct overflow displayed oddly in IE 9.
|
||||||
|
*/
|
||||||
|
|
||||||
|
svg:not(:root) {
|
||||||
|
overflow: hidden;
|
||||||
|
}
|
||||||
|
|
||||||
|
/* Grouping content
|
||||||
|
========================================================================== */
|
||||||
|
|
||||||
|
/**
|
||||||
|
* Address margin not present in IE 8/9 and Safari 5.
|
||||||
|
*/
|
||||||
|
|
||||||
|
figure {
|
||||||
|
margin: 1em 40px;
|
||||||
|
}
|
||||||
|
|
||||||
|
/**
|
||||||
|
* Address differences between Firefox and other browsers.
|
||||||
|
*/
|
||||||
|
|
||||||
|
hr {
|
||||||
|
-moz-box-sizing: content-box;
|
||||||
|
box-sizing: content-box;
|
||||||
|
height: 0;
|
||||||
|
}
|
||||||
|
|
||||||
|
/**
|
||||||
|
* Contain overflow in all browsers.
|
||||||
|
*/
|
||||||
|
|
||||||
|
pre {
|
||||||
|
overflow: auto;
|
||||||
|
}
|
||||||
|
|
||||||
|
/**
|
||||||
|
* Address odd `em`-unit font size rendering in all browsers.
|
||||||
|
*/
|
||||||
|
|
||||||
|
code,
|
||||||
|
kbd,
|
||||||
|
pre,
|
||||||
|
samp {
|
||||||
|
font-family: monospace, monospace;
|
||||||
|
font-size: 1em;
|
||||||
|
}
|
||||||
|
|
||||||
|
/* Forms
|
||||||
|
========================================================================== */
|
||||||
|
|
||||||
|
/**
|
||||||
|
* Known limitation: by default, Chrome and Safari on OS X allow very limited
|
||||||
|
* styling of `select`, unless a `border` property is set.
|
||||||
|
*/
|
||||||
|
|
||||||
|
/**
|
||||||
|
* 1. Correct color not being inherited.
|
||||||
|
* Known issue: affects color of disabled elements.
|
||||||
|
* 2. Correct font properties not being inherited.
|
||||||
|
* 3. Address margins set differently in Firefox 4+, Safari 5, and Chrome.
|
||||||
|
*/
|
||||||
|
|
||||||
|
button,
|
||||||
|
input,
|
||||||
|
optgroup,
|
||||||
|
select,
|
||||||
|
textarea {
|
||||||
|
color: inherit; /* 1 */
|
||||||
|
font: inherit; /* 2 */
|
||||||
|
margin: 0; /* 3 */
|
||||||
|
}
|
||||||
|
|
||||||
|
/**
|
||||||
|
* Address `overflow` set to `hidden` in IE 8/9/10.
|
||||||
|
*/
|
||||||
|
|
||||||
|
button {
|
||||||
|
overflow: visible;
|
||||||
|
}
|
||||||
|
|
||||||
|
/**
|
||||||
|
* Address inconsistent `text-transform` inheritance for `button` and `select`.
|
||||||
|
* All other form control elements do not inherit `text-transform` values.
|
||||||
|
* Correct `button` style inheritance in Firefox, IE 8+, and Opera
|
||||||
|
* Correct `select` style inheritance in Firefox.
|
||||||
|
*/
|
||||||
|
|
||||||
|
button,
|
||||||
|
select {
|
||||||
|
text-transform: none;
|
||||||
|
}
|
||||||
|
|
||||||
|
/**
|
||||||
|
* 1. Avoid the WebKit bug in Android 4.0.* where (2) destroys native `audio`
|
||||||
|
* and `video` controls.
|
||||||
|
* 2. Correct inability to style clickable `input` types in iOS.
|
||||||
|
* 3. Improve usability and consistency of cursor style between image-type
|
||||||
|
* `input` and others.
|
||||||
|
*/
|
||||||
|
|
||||||
|
button,
|
||||||
|
html input[type="button"], /* 1 */
|
||||||
|
input[type="reset"],
|
||||||
|
input[type="submit"] {
|
||||||
|
-webkit-appearance: button; /* 2 */
|
||||||
|
cursor: pointer; /* 3 */
|
||||||
|
}
|
||||||
|
|
||||||
|
/**
|
||||||
|
* Re-set default cursor for disabled elements.
|
||||||
|
*/
|
||||||
|
|
||||||
|
button[disabled],
|
||||||
|
html input[disabled] {
|
||||||
|
cursor: default;
|
||||||
|
}
|
||||||
|
|
||||||
|
/**
|
||||||
|
* Remove inner padding and border in Firefox 4+.
|
||||||
|
*/
|
||||||
|
|
||||||
|
button::-moz-focus-inner,
|
||||||
|
input::-moz-focus-inner {
|
||||||
|
border: 0;
|
||||||
|
padding: 0;
|
||||||
|
}
|
||||||
|
|
||||||
|
/**
|
||||||
|
* Address Firefox 4+ setting `line-height` on `input` using `!important` in
|
||||||
|
* the UA stylesheet.
|
||||||
|
*/
|
||||||
|
|
||||||
|
input {
|
||||||
|
line-height: normal;
|
||||||
|
}
|
||||||
|
|
||||||
|
/**
|
||||||
|
* It's recommended that you don't attempt to style these elements.
|
||||||
|
* Firefox's implementation doesn't respect box-sizing, padding, or width.
|
||||||
|
*
|
||||||
|
* 1. Address box sizing set to `content-box` in IE 8/9/10.
|
||||||
|
* 2. Remove excess padding in IE 8/9/10.
|
||||||
|
*/
|
||||||
|
|
||||||
|
input[type="checkbox"],
|
||||||
|
input[type="radio"] {
|
||||||
|
box-sizing: border-box; /* 1 */
|
||||||
|
padding: 0; /* 2 */
|
||||||
|
}
|
||||||
|
|
||||||
|
/**
|
||||||
|
* Fix the cursor style for Chrome's increment/decrement buttons. For certain
|
||||||
|
* `font-size` values of the `input`, it causes the cursor style of the
|
||||||
|
* decrement button to change from `default` to `text`.
|
||||||
|
*/
|
||||||
|
|
||||||
|
input[type="number"]::-webkit-inner-spin-button,
|
||||||
|
input[type="number"]::-webkit-outer-spin-button {
|
||||||
|
height: auto;
|
||||||
|
}
|
||||||
|
|
||||||
|
/**
|
||||||
|
* 1. Address `appearance` set to `searchfield` in Safari 5 and Chrome.
|
||||||
|
* 2. Address `box-sizing` set to `border-box` in Safari 5 and Chrome
|
||||||
|
* (include `-moz` to future-proof).
|
||||||
|
*/
|
||||||
|
|
||||||
|
input[type="search"] {
|
||||||
|
-webkit-appearance: textfield; /* 1 */
|
||||||
|
-moz-box-sizing: content-box;
|
||||||
|
-webkit-box-sizing: content-box; /* 2 */
|
||||||
|
box-sizing: content-box;
|
||||||
|
}
|
||||||
|
|
||||||
|
/**
|
||||||
|
* Remove inner padding and search cancel button in Safari and Chrome on OS X.
|
||||||
|
* Safari (but not Chrome) clips the cancel button when the search input has
|
||||||
|
* padding (and `textfield` appearance).
|
||||||
|
*/
|
||||||
|
|
||||||
|
input[type="search"]::-webkit-search-cancel-button,
|
||||||
|
input[type="search"]::-webkit-search-decoration {
|
||||||
|
-webkit-appearance: none;
|
||||||
|
}
|
||||||
|
|
||||||
|
/**
|
||||||
|
* Define consistent border, margin, and padding.
|
||||||
|
*/
|
||||||
|
|
||||||
|
fieldset {
|
||||||
|
border: 1px solid #c0c0c0;
|
||||||
|
margin: 0 2px;
|
||||||
|
padding: 0.35em 0.625em 0.75em;
|
||||||
|
}
|
||||||
|
|
||||||
|
/**
|
||||||
|
* 1. Correct `color` not being inherited in IE 8/9.
|
||||||
|
* 2. Remove padding so people aren't caught out if they zero out fieldsets.
|
||||||
|
*/
|
||||||
|
|
||||||
|
legend {
|
||||||
|
border: 0; /* 1 */
|
||||||
|
padding: 0; /* 2 */
|
||||||
|
}
|
||||||
|
|
||||||
|
/**
|
||||||
|
* Remove default vertical scrollbar in IE 8/9.
|
||||||
|
*/
|
||||||
|
|
||||||
|
textarea {
|
||||||
|
overflow: auto;
|
||||||
|
}
|
||||||
|
|
||||||
|
/**
|
||||||
|
* Don't inherit the `font-weight` (applied by a rule above).
|
||||||
|
* NOTE: the default cannot safely be changed in Chrome and Safari on OS X.
|
||||||
|
*/
|
||||||
|
|
||||||
|
optgroup {
|
||||||
|
font-weight: bold;
|
||||||
|
}
|
||||||
|
|
||||||
|
/* Tables
|
||||||
|
========================================================================== */
|
||||||
|
|
||||||
|
/**
|
||||||
|
* Remove most spacing between table cells.
|
||||||
|
*/
|
||||||
|
|
||||||
|
table {
|
||||||
|
border-collapse: collapse;
|
||||||
|
border-spacing: 0;
|
||||||
|
}
|
||||||
|
|
||||||
|
td,
|
||||||
|
th {
|
||||||
|
padding: 0;
|
||||||
|
}
|
||||||
@ -0,0 +1,97 @@
|
|||||||
|
(define *widgets* (widgets))
|
||||||
|
(define *widget-rules* (widget-rules))
|
||||||
|
|
||||||
|
(define-syntax with-widgets
|
||||||
|
(syntax-rules ()
|
||||||
|
((_ widgets* widget-rules* body ...)
|
||||||
|
(parameterize ((widgets widgets*) (widget-rules widget-rules*))
|
||||||
|
body ...))))
|
||||||
|
|
||||||
|
;; Make defining widgets less cumbersome and prevent conflicting
|
||||||
|
;; transform definitions that are hard to debug.
|
||||||
|
(define (widget name _markup _attributes)
|
||||||
|
(parameterize ((widgets *widgets*) (widget-rules *widget-rules*))
|
||||||
|
(add-widget name `((markup . `(*TOP* ,(begin (use uri-common) ,_markup)))
|
||||||
|
(attributes . ,_attributes))
|
||||||
|
(interaction-environment))
|
||||||
|
(set! *widgets* (widgets))
|
||||||
|
(set! *widget-rules* (widget-rules))))
|
||||||
|
|
||||||
|
|
||||||
|
(widget
|
||||||
|
'stylesheet
|
||||||
|
``(link (@ (href ,(string-append "/res/css/" path)) (type "text/css")
|
||||||
|
(rel "stylesheet")))
|
||||||
|
'((path "")))
|
||||||
|
|
||||||
|
(widget
|
||||||
|
'row
|
||||||
|
``(div (@ (class ,(conc "row" (if full-width " full-width " "")
|
||||||
|
(if padding "" " collapse ")))) ,@contents)
|
||||||
|
'((full-width #f) (padding #t)))
|
||||||
|
|
||||||
|
(widget
|
||||||
|
'col
|
||||||
|
``(div (@ (class ,(conc "column small-" width)) ,@attrs) ,@contents)
|
||||||
|
'((width 1) (attrs ())))
|
||||||
|
|
||||||
|
(widget
|
||||||
|
'cols
|
||||||
|
`(let ((class (++ "column small-" (number->string
|
||||||
|
(inexact->exact (round (/ 12 (length contents))))))))
|
||||||
|
`(div (@ (class ,(conc "row" (if full-width " full-width" ""))))
|
||||||
|
,@(map (lambda (col)
|
||||||
|
`(div (@ (class ,class)) ,col))
|
||||||
|
contents)
|
||||||
|
,(if fill-row `(div (@ (class "column end"))) "")))
|
||||||
|
'((fill-row #t) (full-width #f)))
|
||||||
|
|
||||||
|
(widget
|
||||||
|
'panel
|
||||||
|
``(div (@ (class "panel")) ,@contents)
|
||||||
|
'())
|
||||||
|
|
||||||
|
(widget
|
||||||
|
'panel-small
|
||||||
|
``(div (@ (class "panel panel-small") ,@attrs) ,@contents)
|
||||||
|
'((attrs '())))
|
||||||
|
|
||||||
|
(widget
|
||||||
|
'text-center
|
||||||
|
``(div (@ (class "text-center")) ,@contents)
|
||||||
|
'())
|
||||||
|
|
||||||
|
(widget
|
||||||
|
'group-box
|
||||||
|
``(div (@ (class "panel group-box"))
|
||||||
|
(h4 (@ (class "group-box-title")) ,title)
|
||||||
|
,@contents)
|
||||||
|
'((title "")))
|
||||||
|
|
||||||
|
(widget
|
||||||
|
'radio-button
|
||||||
|
``(label (input (@ (type "radio") (name ,name))) ,label)
|
||||||
|
'((name "radio1") (label "radio1")))
|
||||||
|
|
||||||
|
(widget
|
||||||
|
'spacer
|
||||||
|
``(div (@ (class "spacer")) ,@contents)
|
||||||
|
'())
|
||||||
|
|
||||||
|
(widget
|
||||||
|
'modal
|
||||||
|
``(div (@ (class "modal-overlay"))
|
||||||
|
(div (@ (class "modal-content"))
|
||||||
|
,@contents))
|
||||||
|
'())
|
||||||
|
|
||||||
|
(widget
|
||||||
|
'include-javascript
|
||||||
|
``(script (@ (language "javascript") (type "text/javascript")
|
||||||
|
(src ,(conc "/res/js/" (car contents)))))
|
||||||
|
'())
|
||||||
|
|
||||||
|
(widget
|
||||||
|
'spock-scripts
|
||||||
|
``(include-javascript "spock-runtime-debug.js")
|
||||||
|
'())
|
||||||
Loading…
Reference in New Issue