Compare commits
2 Commits
13439f6e24
...
0179a4ce08
| Author | SHA1 | Date |
|---|---|---|
 Steve Ayerhart
|
0179a4ce08 | |
|
Steve Ayerhart
|
e3e24c5c4b |
|
|
@ -0,0 +1,41 @@
|
|||
USING: kernel furnace.actions sequences validators accessors html.forms http.server.responses http.server.dispatchers formatting ;
|
||||
USING: bonerbonerboner.dns ;
|
||||
|
||||
IN: bonerbonerboner.actions
|
||||
|
||||
TUPLE: bbb-dispatcher < dispatcher ;
|
||||
|
||||
: v-valid-subdomain ( str -- subdomain )
|
||||
dup get-subdomains member? [ "not a valid subdomain" throw ] unless ;
|
||||
|
||||
: validate-subdomain ( -- )
|
||||
{
|
||||
{ "name" [ v-required v-valid-subdomain ] }
|
||||
} validate-params ;
|
||||
|
||||
: <subdomain-action> ( -- action )
|
||||
<page-action>
|
||||
[
|
||||
validate-subdomain
|
||||
"name" value "subdomain" set-value
|
||||
] >>init
|
||||
{ bbb-dispatcher "subdomains" } >>template ;
|
||||
|
||||
: <404-subdomain-action> ( -- action )
|
||||
<page-action>
|
||||
[ "_404" "subdomain" set-value ] >>init
|
||||
{ bbb-dispatcher "subdomains" } >>template ;
|
||||
|
||||
: <heartbeat-action> ( -- action )
|
||||
<action> [ "bonerbonerboner" <text-content> ] >>display ;
|
||||
|
||||
TUPLE: subdomain-link subdomain url ;
|
||||
|
||||
: <meta-action> ( -- action )
|
||||
<page-action>
|
||||
[
|
||||
get-subdomains
|
||||
[ dup "name" "https://%s.bonerbonerboner.com" sprintf subdomain-link boa ]
|
||||
map "subdomains" set-value
|
||||
] >>init
|
||||
{ bbb-dispatcher "meta" } >>template ;
|
||||
|
|
@ -0,0 +1,14 @@
|
|||
<?xml version='1.0'?>
|
||||
<!DOCTYPE html>
|
||||
<t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
|
||||
<html class="@subdomain" lang="en">
|
||||
<head>
|
||||
<title>boners</title>
|
||||
<meta name="viewport"
|
||||
content="width=device-width, initial-scale=1" />
|
||||
<link rel="stylesheet" type="text/css"
|
||||
href="https://static.bonerbonerboner.com/css/bbb.css" />
|
||||
</head>
|
||||
<body />
|
||||
</html>
|
||||
</t:chloe>
|
||||
|
|
@ -0,0 +1,5 @@
|
|||
USING: kernel regexp dns hashtables sequences splitting assocs urls arrays http http.client json json.http io.sockets.secure accessors ;
|
||||
USING: prettyprint ;
|
||||
USING: io.encodings.utf8 io.encodings.string ;
|
||||
|
||||
IN: bonerbonerboner
|
||||
|
|
@ -0,0 +1,44 @@
|
|||
USING: kernel regexp dns hashtables sequences splitting assocs urls arrays http http.client json json.http io.sockets.secure accessors ;
|
||||
USING: prettyprint ;
|
||||
|
||||
IN: bonerbonerboner.dns
|
||||
|
||||
CONSTANT: bbb-domain "bonerbonerboner.com"
|
||||
CONSTANT: meta R/ ^meta=/
|
||||
CONSTANT: do-key "TODO: ADD TO ENV"
|
||||
CONSTANT: do-api-base-url URL" https://api.digitalocean.com/v2/"
|
||||
|
||||
: get-subdomain-metadata ( -- assoc )
|
||||
bbb-domain dns-TXT-query TXT-message>strings
|
||||
H{ }
|
||||
[
|
||||
first dup
|
||||
meta re-contains?
|
||||
[ swap [ meta "" re-replace ":" split [ second ] [ first ] bi ] dip ?set-at ]
|
||||
[ drop ] if
|
||||
] reduce ;
|
||||
|
||||
: get-subdomains ( -- seq )
|
||||
get-subdomain-metadata keys ;
|
||||
|
||||
: post-domain-records-url ( -- url )
|
||||
do-api-base-url URL" domains/bonerbonerboner.com/records" derive-url ;
|
||||
|
||||
: add-authorization ( request -- request' )
|
||||
"Bearer " do-key append "Authorization" set-header ;
|
||||
|
||||
: <json-post-request> ( data url -- post-request )
|
||||
[ <json-post-data> ] dip
|
||||
"POST" <json-request> swap >>post-data ;
|
||||
|
||||
: create-subdomain-meta ( name color -- )
|
||||
2array ":" join "meta=" prepend
|
||||
'H{
|
||||
{ "data" _ }
|
||||
{ "name" "@" }
|
||||
{ "type" "TXT" }
|
||||
}
|
||||
post-domain-records-url
|
||||
<json-post-request>
|
||||
add-authorization
|
||||
http-request 2drop ;
|
||||
|
|
@ -0,0 +1,22 @@
|
|||
USING: kernel http.server http.server.responses http.server.dispatchers accessors namespaces io.servers ;
|
||||
USING: bonerbonerboner.actions ;
|
||||
|
||||
IN: bonerbonerboner.server
|
||||
|
||||
SYMBOL: current-bbb-server
|
||||
|
||||
: <bbb> ( -- responder )
|
||||
bbb-dispatcher new-dispatcher
|
||||
<404-subdomain-action> >>default
|
||||
<heartbeat-action> "heartbeat" add-responder
|
||||
<subdomain-action> "subdomains" add-responder
|
||||
<meta-action> "meta" add-responder ;
|
||||
|
||||
: <bbb-website-server> ( -- threaded-server )
|
||||
<http-server>
|
||||
f >>secure
|
||||
8069 >>insecure ;
|
||||
|
||||
: start-bbb-site ( -- )
|
||||
<bbb> main-responder set-global
|
||||
<bbb-website-server> start-server current-bbb-server set ;
|
||||
|
|
@ -12,8 +12,8 @@ SYMBOL: current-flac-output
|
|||
{ [ 0b0000 = ] [ drop reserved-block-size ] }
|
||||
{ [ 0b0001 = ] [ drop 192 ] }
|
||||
{ [ 0b0010 0b0101 between? ] [ 2 - 2^ 567 * ] }
|
||||
{ [ 0b0110 = ] [ drop 8 flac-read 1 + ] }
|
||||
{ [ 0b0111 = ] [ drop 16 flac-read 1 + ] }
|
||||
{ [ 0b0110 = ] [ drop 8 flac-read-uint 1 + ] }
|
||||
{ [ 0b0111 = ] [ drop 16 flac-read-uint 1 + ] }
|
||||
{ [ 0b1000 0b1111 between? ] [ 8 - 2^ 256 * ] }
|
||||
} cond-case ;
|
||||
|
||||
|
|
@ -31,20 +31,20 @@ SYMBOL: current-flac-output
|
|||
{ 0b1001 [ 44100 ] }
|
||||
{ 0b1010 [ 48000 ] }
|
||||
{ 0b1011 [ 96000 ] }
|
||||
{ 0b1100 [ 8 flac-read 1000 * ] } ! sample rate in kHz
|
||||
{ 0b1101 [ 16 flac-read ] } ! sample rate in Hz
|
||||
{ 0b1110 [ 16 flac-read 10 * ] } ! sample rate in tens of Hz
|
||||
{ 0b1100 [ 8 flac-read-uint 1000 * ] } ! sample rate in kHz
|
||||
{ 0b1101 [ 16 flac-read-uint ] } ! sample rate in Hz
|
||||
{ 0b1110 [ 16 flac-read-uint 10 * ] } ! sample rate in tens of Hz
|
||||
{ 0b1111 [ invalid-sample-rate ] }
|
||||
} case ;
|
||||
|
||||
: decode-channel-assignment ( n -- channel-assignment )
|
||||
: decode-channel-correlation ( n -- channel-correlation )
|
||||
{
|
||||
{ [ 0b0000 0b0111 between? ] [ 0 ] }
|
||||
{ [ 0b1000 = ] [ 1 ] }
|
||||
{ [ 0b1001 = ] [ 2 ] }
|
||||
{ [ 0b1010 = ] [ 3 ] }
|
||||
[ reserved-channel-assignment ]
|
||||
} cond-case <flac-channel-assignment> ;
|
||||
} cond-case <flac-channel-correlation> ;
|
||||
|
||||
: decode-bits-per-sample ( stream-info n -- n )
|
||||
{
|
||||
|
|
@ -60,18 +60,18 @@ SYMBOL: current-flac-output
|
|||
dup 0 = [ drop bits-per-sample>> ] [ nip ] if ;
|
||||
|
||||
: read/assert-frame-sync-code ( -- )
|
||||
15 flac-read 0b111111111111100 = [ sync-code-error ] unless ;
|
||||
15 flac-read-uint 0b111111111111100 = [ sync-code-error ] unless ;
|
||||
|
||||
: read-flac-frame-header ( stream-info -- frame-header )
|
||||
[
|
||||
read/assert-frame-sync-code
|
||||
1 flac-read <flac-frame-blocking-strategy>
|
||||
4 flac-read ! blocksize code
|
||||
4 flac-read ! sample rate code
|
||||
4 flac-read decode-channel-assignment
|
||||
1 flac-read-uint <flac-frame-blocking-strategy>
|
||||
4 flac-read-uint ! blocksize code
|
||||
4 flac-read-uint ! sample rate code
|
||||
4 flac-read-uint [ <flac-channel-assignment> ] [ decode-channel-correlation ] bi
|
||||
] dip
|
||||
3 flac-read decode-bits-per-sample
|
||||
1 flac-read drop ! ignore magic sync for now
|
||||
3 flac-read-uint decode-bits-per-sample
|
||||
1 flac-read-uint drop ! ignore magic sync for now
|
||||
flac-read-coded-number
|
||||
! decoding blocksize/samplerate potentially reads from end of header
|
||||
[ decode-block-size ] 4dip
|
||||
|
|
@ -80,7 +80,7 @@ SYMBOL: current-flac-output
|
|||
flac-frame-header boa ;
|
||||
|
||||
: read-flac-subframe-wasted-bits ( -- k )
|
||||
1 flac-read 1 = [ 0 [ 1 + 1 flac-read 0 = ] loop ] [ 0 ] if ;
|
||||
1 flac-read-uint 1 = [ 0 [ 1 + 1 flac-read-uint 0 = ] loop ] [ 0 ] if ;
|
||||
|
||||
: read-flac-subframe-constant ( blocksize bps -- samples )
|
||||
flac-read-int <repetition> [ ] map ;
|
||||
|
|
|
|||
|
|
@ -38,10 +38,23 @@ ENUM: flac-frame-number-type
|
|||
frame-number-type-sample ;
|
||||
|
||||
ENUM: flac-channel-assignment
|
||||
channel-assignment-independent
|
||||
channel-assignment-left
|
||||
channel-assignment-right
|
||||
channel-assignment-mid ;
|
||||
channel-assignment-mono
|
||||
channel-assignment-left,right
|
||||
channel-assignment-left,right,center
|
||||
channel-assignment-front-left,front-right,back-left,back-right
|
||||
channel-assignment-front-left,front-right,front-center,back/surround-left,back/surround-right
|
||||
channel-assignment-front-left,front-right,front-center,LFE,back/surround-left,back/surround-right
|
||||
channel-assignment-front-left,front-right,front-center,LFE,back-center,side-left,side-right
|
||||
channel-assignment-front-left,front-right,front-center,LFE,back-left,back-right,side-left,side-right
|
||||
channel-assignment-left/side-stereo
|
||||
channel-assignment-right/side-stereo
|
||||
channel-assignment-mid/side-stereo ;
|
||||
|
||||
ENUM: flac-channel-correlation
|
||||
channel-correlation-independent
|
||||
channel-correlation-left
|
||||
channel-correlation-right
|
||||
channel-correlation-mid ;
|
||||
|
||||
TUPLE: flac-frame-header
|
||||
{ blocking-strategy maybe{ fixed-blocksize variable-blocksize } }
|
||||
|
|
|
|||
|
|
@ -10,29 +10,29 @@ IN: flac.metadata
|
|||
ERROR: cuesheet-index-reserved-must-be-zero ;
|
||||
|
||||
: read-metadata-block-header ( -- header )
|
||||
1 flac-read 1 =
|
||||
7 flac-read <metadata-type>
|
||||
24 flac-read
|
||||
1 flac-read-uint 1 =
|
||||
7 flac-read-uint <metadata-type>
|
||||
24 flac-read-uint
|
||||
metadata-block-header boa ;
|
||||
|
||||
: read-metadata-block-stream-info ( -- stream-info )
|
||||
16 flac-read
|
||||
16 flac-read
|
||||
24 flac-read
|
||||
24 flac-read
|
||||
20 flac-read
|
||||
3 flac-read 1 +
|
||||
5 flac-read 1 +
|
||||
36 flac-read
|
||||
128 flac-read 16 >be bytes>hex-string
|
||||
16 flac-read-uint
|
||||
16 flac-read-uint
|
||||
24 flac-read-uint
|
||||
24 flac-read-uint
|
||||
20 flac-read-uint
|
||||
3 flac-read-uint 1 +
|
||||
5 flac-read-uint 1 +
|
||||
36 flac-read-uint
|
||||
128 flac-read-uint 16 >be bytes>hex-string
|
||||
stream-info boa ;
|
||||
|
||||
: read-metadata-block-seek-table ( length -- seek-table )
|
||||
18 / <iota> [
|
||||
drop
|
||||
64 flac-read
|
||||
64 flac-read
|
||||
16 flac-read
|
||||
64 flac-read-uint
|
||||
64 flac-read-uint
|
||||
16 flac-read-uint
|
||||
seek-point boa
|
||||
] map
|
||||
seek-table boa ;
|
||||
|
|
@ -40,11 +40,11 @@ ERROR: cuesheet-index-reserved-must-be-zero ;
|
|||
: read-metadata-block-vorbis-comment ( length -- vorbis-comment )
|
||||
! vorbis comments are in little endian...
|
||||
drop
|
||||
32 flac-read 4 >le be> dup 8 * flac-read swap >n-byte-array reverse utf8 decode
|
||||
32 flac-read 4 >le be> <iota>
|
||||
32 flac-read-uint 4 >le be> dup 8 * flac-read-uint swap >n-byte-array utf8 decode
|
||||
32 flac-read-uint 4 >le be> <iota>
|
||||
[
|
||||
drop
|
||||
32 flac-read 4 >le be> dup 8 * flac-read swap >n-byte-array reverse utf8 decode
|
||||
32 flac-read-uint 4 >le be> dup 8 * flac-read-uint swap >n-byte-array utf8 decode
|
||||
"=" split
|
||||
] map
|
||||
>alist vorbis-comment boa ;
|
||||
|
|
@ -68,13 +68,13 @@ ERROR: cuesheet-index-reserved-must-be-zero ;
|
|||
length>> <byte-array> ;
|
||||
|
||||
: read-metadata-block-padding ( length -- padding )
|
||||
dup 8 * flac-read drop flac-padding boa ;
|
||||
dup 8 * flac-read-uint drop flac-padding boa ;
|
||||
|
||||
: read-metadata-block-application ( length -- application )
|
||||
8 * flac-read drop application new ;
|
||||
8 * flac-read-uint drop application new ;
|
||||
|
||||
: read-metadata-block-cuesheet ( length -- cuesheet )
|
||||
dup [ 8 * flac-read ] dip >be
|
||||
dup [ 8 * flac-read-uint ] dip >be
|
||||
binary
|
||||
[
|
||||
128 io:read ascii decode
|
||||
|
|
@ -99,15 +99,14 @@ ERROR: cuesheet-index-reserved-must-be-zero ;
|
|||
|
||||
: read-metadata-block-picture ( length -- picture )
|
||||
drop
|
||||
32 flac-read <picture-type>
|
||||
32 flac-read dup 8 * flac-read swap >n-byte-array reverse utf8 decode
|
||||
32 flac-read dup 8 * flac-read swap >n-byte-array reverse utf8 decode
|
||||
32 flac-read
|
||||
32 flac-read
|
||||
32 flac-read
|
||||
32 flac-read
|
||||
32 flac-read dup 8 *
|
||||
32 flac-read dup 8 * flac-read swap >n-byte-array reverse
|
||||
32 flac-read-uint <picture-type>
|
||||
32 flac-read-uint dup 8 * flac-read-uint swap >n-byte-array utf8 decode
|
||||
32 flac-read-uint dup 8 * flac-read-uint swap >n-byte-array utf8 decode
|
||||
32 flac-read-uint
|
||||
32 flac-read-uint
|
||||
32 flac-read-uint
|
||||
32 flac-read-uint
|
||||
32 flac-read-uint dup 8 * flac-read-uint swap >n-byte-array reverse
|
||||
picture boa ;
|
||||
|
||||
: append-picture ( metadata picture -- metadata )
|
||||
|
|
@ -137,16 +136,16 @@ PRIVATE>
|
|||
[ read-metadata-block ] dip
|
||||
] loop ;
|
||||
|
||||
: read-stream-info/seek-data ( -- stream-info )
|
||||
read/assert-flac-magic
|
||||
32 flac-read drop
|
||||
read-metadata-block-stream-info
|
||||
[ read-metadata-block-header [ length>> 8 * flac-seek ] [ last?>> not ] bi ] loop ;
|
||||
! : read-stream-info/seek-data ( -- stream-info )
|
||||
! read/assert-flac-magic
|
||||
! 32 flac-read-uint drop
|
||||
! read-metadata-block-stream-info
|
||||
! [ read-metadata-block-header [ length>> 8 * flac-seek ] [ last?>> not ] bi ] loop ;
|
||||
|
||||
: <flac-stream-info> ( filename -- stream-info )
|
||||
[
|
||||
read/assert-flac-magic
|
||||
32 flac-read drop
|
||||
32 flac-read-uint drop
|
||||
read-metadata-block-stream-info
|
||||
] with-flac-file-reader ;
|
||||
|
||||
|
|
|
|||
|
|
@ -7,45 +7,85 @@ IN: flac.stream
|
|||
|
||||
SYMBOL: flac-input-stream
|
||||
|
||||
CONSTANT: default-bitreader-capacity 6553600
|
||||
|
||||
TUPLE: flac-stream-reader stream bitstream ;
|
||||
TUPLE: flac-stream-reader stream buffer buffer-length ;
|
||||
|
||||
M: flac-stream-reader dispose stream>> dispose ;
|
||||
|
||||
: flac-input-stream> ( -- flac-input-stream )
|
||||
flac-input-stream get ;
|
||||
: flac-input-stream-stream> ( -- stream )
|
||||
flac-input-stream> stream>> ;
|
||||
: flac-input-stream-buffer> ( -- buffer )
|
||||
flac-input-stream> buffer>> ;
|
||||
: flac-input-stream-buffer-length> ( -- buffer-length )
|
||||
flac-input-stream> buffer-length>> ;
|
||||
|
||||
: <flac-stream-reader> ( stream -- flac-stream-reader )
|
||||
B{ } bitstreams:<msb0-bit-reader> flac-stream-reader boa ;
|
||||
0 0 flac-stream-reader boa ;
|
||||
|
||||
: flac-read ( n -- m )
|
||||
[ dup flac-input-stream get bitstream>> bitstreams:enough-bits? not ]
|
||||
:: flac-read-uint ( num-bits -- uint )
|
||||
flac-input-stream>
|
||||
[ buffer-length>> num-bits < ]
|
||||
[
|
||||
flac-input-stream get
|
||||
[ stream>> default-bitreader-capacity swap io:stream-read ] [ bitstream>> ] bi
|
||||
dup bytes>> swap [ prepend ] dip swap >>bytes drop
|
||||
] while flac-input-stream get bitstream>> bitstreams:read ;
|
||||
flac-input-stream>
|
||||
flac-input-stream-stream> io:stream-read1
|
||||
flac-input-stream-buffer> 8 shift bitor
|
||||
>>buffer
|
||||
|
||||
: flac-seek ( n -- )
|
||||
[ dup flac-input-stream get bitstream>> bitstreams:enough-bits? not ]
|
||||
flac-input-stream-buffer-length> 8 +
|
||||
>>buffer-length
|
||||
] while
|
||||
|
||||
flac-input-stream>
|
||||
flac-input-stream-buffer-length> num-bits -
|
||||
>>buffer-length
|
||||
|
||||
flac-input-stream-buffer> flac-input-stream-buffer-length> neg shift
|
||||
1 num-bits shift 1 - bitand
|
||||
[
|
||||
flac-input-stream get
|
||||
[ stream>> default-bitreader-capacity swap io:stream-read ] [ bitstream>> ] bi
|
||||
dup bytes>> swap [ prepend ] dip swap >>bytes drop
|
||||
] while flac-input-stream get bitstream>> bitstreams:seek ;
|
||||
flac-input-stream-buffer>
|
||||
1 flac-input-stream-buffer-length> shift 1 - bitand
|
||||
>>buffer drop
|
||||
] dip ;
|
||||
|
||||
: flac-align-to-byte ( -- )
|
||||
8 flac-input-stream get bitstream>> bitstreams:align ;
|
||||
: flac-read-sint ( num-bits -- sint )
|
||||
dup flac-read-uint swap >signed ;
|
||||
|
||||
: flac-read-int ( n -- m )
|
||||
dup flac-read swap >signed ;
|
||||
! flac-input-stream> buffer-length>> n - >>buffer-length
|
||||
! flac-input-stream> buffer>> flac-input-stream buffer-length>> neg
|
||||
! 1 n shift 1 -
|
||||
! [ flac-input-stream> buffer>> 1 flac-input-stream buffer-length>> shift 1 - bitand ] keep ;
|
||||
|
||||
: flac-read-rice-signed-int ( param -- n )
|
||||
[ 0 [ 1 flac-read 0 = ] [ 1 + ] while ] dip
|
||||
[ shift ] keep flac-read bitor
|
||||
[ -1 shift ] [ 1 bitand -1 * ] bi bitxor ;
|
||||
! : flac-read ( n -- m )
|
||||
! [ dup flac-input-stream get bitstream>> bitstreams:enough-bits? not ]
|
||||
! [
|
||||
! flac-input-stream get
|
||||
! [ stream>> default-bitreader-capacity swap io:stream-read ] [ bitstream>> ] bi
|
||||
! dup bytes>> swap [ prepend ] dip swap >>bytes drop
|
||||
! ] while flac-input-stream get bitstream>> bitstreams:read ;
|
||||
|
||||
: flac-read-coded-number ( -- n )
|
||||
8 flac-read
|
||||
[ dup 0b11000000 >= ] [ 8 flac-read drop 2^ 0xff bitand ] while ;
|
||||
! : flac-seek ( n -- )
|
||||
! [ dup flac-input-stream get bitstream>> bitstreams:enough-bits? not ]
|
||||
! [
|
||||
! flac-input-stream get
|
||||
! [ stream>> default-bitreader-capacity swap io:stream-read ] [ bitstream>> ] bi
|
||||
! dup bytes>> swap [ prepend ] dip swap >>bytes drop
|
||||
! ] while flac-input-stream get bitstream>> bitstreams:seek ;
|
||||
!
|
||||
! : flac-align-to-byte ( -- )
|
||||
! 8 flac-input-stream get bitstream>> bitstreams:align ;
|
||||
!
|
||||
! : flac-read-int ( n -- m )
|
||||
! dup flac-read swap >signed ;
|
||||
!
|
||||
! : flac-read-rice-signed-int ( param -- n )
|
||||
! [ 0 [ 1 flac-read 0 = ] [ 1 + ] while ] dip
|
||||
! [ shift ] keep flac-read bitor
|
||||
! [ -1 shift ] [ 1 bitand -1 * ] bi bitxor ;
|
||||
!
|
||||
! : flac-read-coded-number ( -- n )
|
||||
! 8 flac-read
|
||||
! [ dup 0b11000000 >= ] [ 8 flac-read drop 2^ 0xff bitand ] while ;
|
||||
|
||||
: (with-flac-stream-reader) ( stream quot -- )
|
||||
flac-input-stream swap with-variable ; inline
|
||||
|
|
@ -57,4 +97,4 @@ M: flac-stream-reader dispose stream>> dispose ;
|
|||
[ binary <file-reader> ] dip with-flac-stream-reader ; inline
|
||||
|
||||
: read/assert-flac-magic ( -- )
|
||||
32 flac-read FLAC-MAGIC = [ not-a-flac-stream ] unless ;
|
||||
32 flac-read-uint FLAC-MAGIC = [ not-a-flac-stream ] unless ;
|
||||
|
|
|
|||
Loading…
Reference in New Issue