steve
/
factor-work
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Compare commits

base: steve:0179a4ce082da5965519ae231420fb03aba53a32
Branches Tags
steve:master
..
compare: steve:13439f6e24af7ae2793506e38e3171d579c624e7
Branches Tags
steve:master

No commits in common. "0179a4ce082da5965519ae231420fb03aba53a32" and "13439f6e24af7ae2793506e38e3171d579c624e7" have entirely different histories.
0179a4ce08 ... 13439f6e24

9 changed files with 83 additions and 261 deletions
Show Stats Expand all files Collapse all files

41
bonerbonerboner/actions/actions.factor
View File

@ -1,41 +0,0 @@
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 ;

14
bonerbonerboner/actions/subdomains.xml
View File

@ -1,14 +0,0 @@
<?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>

5
bonerbonerboner/bonerbonerboner.factor
View File

@ -1,5 +0,0 @@
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

44
bonerbonerboner/dns/dns.factor
View File

@ -1,44 +0,0 @@
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 ;

22
bonerbonerboner/server/server.factor
View File

@ -1,22 +0,0 @@
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 ;

30
flac/decoder/decoder.factor
View File

@ -12,8 +12,8 @@ SYMBOL: current-flac-output
{ [ 0b0000 = ] [ drop reserved-block-size ] } { [ 0b0000 = ] [ drop reserved-block-size ] }
{ [ 0b0001 = ] [ drop 192 ] } { [ 0b0001 = ] [ drop 192 ] }
{ [ 0b0010 0b0101 between? ] [ 2 - 2^ 567 * ] } { [ 0b0010 0b0101 between? ] [ 2 - 2^ 567 * ] }
{ [ 0b0110 = ] [ drop 8 flac-read-uint 1 + ] } { [ 0b0110 = ] [ drop 8 flac-read 1 + ] }
{ [ 0b0111 = ] [ drop 16 flac-read-uint 1 + ] } { [ 0b0111 = ] [ drop 16 flac-read 1 + ] }
{ [ 0b1000 0b1111 between? ] [ 8 - 2^ 256 * ] } { [ 0b1000 0b1111 between? ] [ 8 - 2^ 256 * ] }
} cond-case ; } cond-case ;
@ -31,20 +31,20 @@ SYMBOL: current-flac-output
{ 0b1001 [ 44100 ] } { 0b1001 [ 44100 ] }
{ 0b1010 [ 48000 ] } { 0b1010 [ 48000 ] }
{ 0b1011 [ 96000 ] } { 0b1011 [ 96000 ] }
{ 0b1100 [ 8 flac-read-uint 1000 * ] } ! sample rate in kHz { 0b1100 [ 8 flac-read 1000 * ] } ! sample rate in kHz
{ 0b1101 [ 16 flac-read-uint ] } ! sample rate in Hz { 0b1101 [ 16 flac-read ] } ! sample rate in Hz
{ 0b1110 [ 16 flac-read-uint 10 * ] } ! sample rate in tens of Hz { 0b1110 [ 16 flac-read 10 * ] } ! sample rate in tens of Hz
{ 0b1111 [ invalid-sample-rate ] } { 0b1111 [ invalid-sample-rate ] }
} case ; } case ;
: decode-channel-correlation ( n -- channel-correlation ) : decode-channel-assignment ( n -- channel-assignment )
{ {
{ [ 0b0000 0b0111 between? ] [ 0 ] } { [ 0b0000 0b0111 between? ] [ 0 ] }
{ [ 0b1000 = ] [ 1 ] } { [ 0b1000 = ] [ 1 ] }
{ [ 0b1001 = ] [ 2 ] } { [ 0b1001 = ] [ 2 ] }
{ [ 0b1010 = ] [ 3 ] } { [ 0b1010 = ] [ 3 ] }
[ reserved-channel-assignment ] [ reserved-channel-assignment ]
} cond-case <flac-channel-correlation> ; } cond-case <flac-channel-assignment> ;
: decode-bits-per-sample ( stream-info n -- n ) : decode-bits-per-sample ( stream-info n -- n )
{ {
@ -60,18 +60,18 @@ SYMBOL: current-flac-output
dup 0 = [ drop bits-per-sample>> ] [ nip ] if ; dup 0 = [ drop bits-per-sample>> ] [ nip ] if ;
: read/assert-frame-sync-code ( -- ) : read/assert-frame-sync-code ( -- )
15 flac-read-uint 0b111111111111100 = [ sync-code-error ] unless ; 15 flac-read 0b111111111111100 = [ sync-code-error ] unless ;
: read-flac-frame-header ( stream-info -- frame-header ) : read-flac-frame-header ( stream-info -- frame-header )
[ [
read/assert-frame-sync-code read/assert-frame-sync-code
1 flac-read-uint <flac-frame-blocking-strategy> 1 flac-read <flac-frame-blocking-strategy>
4 flac-read-uint ! blocksize code 4 flac-read ! blocksize code
4 flac-read-uint ! sample rate code 4 flac-read ! sample rate code
4 flac-read-uint [ <flac-channel-assignment> ] [ decode-channel-correlation ] bi 4 flac-read decode-channel-assignment
] dip ] dip
3 flac-read-uint decode-bits-per-sample 3 flac-read decode-bits-per-sample
1 flac-read-uint drop ! ignore magic sync for now 1 flac-read drop ! ignore magic sync for now
flac-read-coded-number flac-read-coded-number
! decoding blocksize/samplerate potentially reads from end of header ! decoding blocksize/samplerate potentially reads from end of header
[ decode-block-size ] 4dip [ decode-block-size ] 4dip
@ -80,7 +80,7 @@ SYMBOL: current-flac-output
flac-frame-header boa ; flac-frame-header boa ;
: read-flac-subframe-wasted-bits ( -- k ) : read-flac-subframe-wasted-bits ( -- k )
1 flac-read-uint 1 = [ 0 [ 1 + 1 flac-read-uint 0 = ] loop ] [ 0 ] if ; 1 flac-read 1 = [ 0 [ 1 + 1 flac-read 0 = ] loop ] [ 0 ] if ;
: read-flac-subframe-constant ( blocksize bps -- samples ) : read-flac-subframe-constant ( blocksize bps -- samples )
flac-read-int <repetition> [ ] map ; flac-read-int <repetition> [ ] map ;

21
flac/format/format.factor
View File

@ -38,23 +38,10 @@ ENUM: flac-frame-number-type
frame-number-type-sample ; frame-number-type-sample ;
ENUM: flac-channel-assignment ENUM: flac-channel-assignment
channel-assignment-mono channel-assignment-independent
channel-assignment-left,right channel-assignment-left
channel-assignment-left,right,center channel-assignment-right
channel-assignment-front-left,front-right,back-left,back-right channel-assignment-mid ;
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 TUPLE: flac-frame-header
{ blocking-strategy maybe{ fixed-blocksize variable-blocksize } } { blocking-strategy maybe{ fixed-blocksize variable-blocksize } }

71
flac/metadata/metadata.factor
View File

@ -10,29 +10,29 @@ IN: flac.metadata
ERROR: cuesheet-index-reserved-must-be-zero ; ERROR: cuesheet-index-reserved-must-be-zero ;
: read-metadata-block-header ( -- header ) : read-metadata-block-header ( -- header )
1 flac-read-uint 1 = 1 flac-read 1 =
7 flac-read-uint <metadata-type> 7 flac-read <metadata-type>
24 flac-read-uint 24 flac-read
metadata-block-header boa ; metadata-block-header boa ;
: read-metadata-block-stream-info ( -- stream-info ) : read-metadata-block-stream-info ( -- stream-info )
16 flac-read-uint 16 flac-read
16 flac-read-uint 16 flac-read
24 flac-read-uint 24 flac-read
24 flac-read-uint 24 flac-read
20 flac-read-uint 20 flac-read
3 flac-read-uint 1 + 3 flac-read 1 +
5 flac-read-uint 1 + 5 flac-read 1 +
36 flac-read-uint 36 flac-read
128 flac-read-uint 16 >be bytes>hex-string 128 flac-read 16 >be bytes>hex-string
stream-info boa ; stream-info boa ;
: read-metadata-block-seek-table ( length -- seek-table ) : read-metadata-block-seek-table ( length -- seek-table )
18 / <iota> [ 18 / <iota> [
drop drop
64 flac-read-uint 64 flac-read
64 flac-read-uint 64 flac-read
16 flac-read-uint 16 flac-read
seek-point boa seek-point boa
] map ] map
seek-table boa ; seek-table boa ;
@ -40,11 +40,11 @@ ERROR: cuesheet-index-reserved-must-be-zero ;
: read-metadata-block-vorbis-comment ( length -- vorbis-comment ) : read-metadata-block-vorbis-comment ( length -- vorbis-comment )
! vorbis comments are in little endian... ! vorbis comments are in little endian...
drop drop
32 flac-read-uint 4 >le be> dup 8 * flac-read-uint swap >n-byte-array utf8 decode 32 flac-read 4 >le be> dup 8 * flac-read swap >n-byte-array reverse utf8 decode
32 flac-read-uint 4 >le be> <iota> 32 flac-read 4 >le be> <iota>
[ [
drop drop
32 flac-read-uint 4 >le be> dup 8 * flac-read-uint swap >n-byte-array utf8 decode 32 flac-read 4 >le be> dup 8 * flac-read swap >n-byte-array reverse utf8 decode
"=" split "=" split
] map ] map
>alist vorbis-comment boa ; >alist vorbis-comment boa ;
@ -68,13 +68,13 @@ ERROR: cuesheet-index-reserved-must-be-zero ;
length>> <byte-array> ; length>> <byte-array> ;
: read-metadata-block-padding ( length -- padding ) : read-metadata-block-padding ( length -- padding )
dup 8 * flac-read-uint drop flac-padding boa ; dup 8 * flac-read drop flac-padding boa ;
: read-metadata-block-application ( length -- application ) : read-metadata-block-application ( length -- application )
8 * flac-read-uint drop application new ; 8 * flac-read drop application new ;
: read-metadata-block-cuesheet ( length -- cuesheet ) : read-metadata-block-cuesheet ( length -- cuesheet )
dup [ 8 * flac-read-uint ] dip >be dup [ 8 * flac-read ] dip >be
binary binary
[ [
128 io:read ascii decode 128 io:read ascii decode
@ -99,14 +99,15 @@ ERROR: cuesheet-index-reserved-must-be-zero ;
: read-metadata-block-picture ( length -- picture ) : read-metadata-block-picture ( length -- picture )
drop drop
32 flac-read-uint <picture-type> 32 flac-read <picture-type>
32 flac-read-uint dup 8 * flac-read-uint swap >n-byte-array utf8 decode 32 flac-read dup 8 * flac-read swap >n-byte-array reverse utf8 decode
32 flac-read-uint dup 8 * flac-read-uint swap >n-byte-array utf8 decode 32 flac-read dup 8 * flac-read swap >n-byte-array reverse utf8 decode
32 flac-read-uint 32 flac-read
32 flac-read-uint 32 flac-read
32 flac-read-uint 32 flac-read
32 flac-read-uint 32 flac-read
32 flac-read-uint dup 8 * flac-read-uint swap >n-byte-array reverse 32 flac-read dup 8 *
32 flac-read dup 8 * flac-read swap >n-byte-array reverse
picture boa ; picture boa ;
: append-picture ( metadata picture -- metadata ) : append-picture ( metadata picture -- metadata )
@ -136,16 +137,16 @@ PRIVATE>
[ read-metadata-block ] dip [ read-metadata-block ] dip
] loop ; ] loop ;
! : read-stream-info/seek-data ( -- stream-info ) : read-stream-info/seek-data ( -- stream-info )
! read/assert-flac-magic read/assert-flac-magic
! 32 flac-read-uint drop 32 flac-read drop
! read-metadata-block-stream-info read-metadata-block-stream-info
! [ read-metadata-block-header [ length>> 8 * flac-seek ] [ last?>> not ] bi ] loop ; [ read-metadata-block-header [ length>> 8 * flac-seek ] [ last?>> not ] bi ] loop ;
: <flac-stream-info> ( filename -- stream-info ) : <flac-stream-info> ( filename -- stream-info )
[ [
read/assert-flac-magic read/assert-flac-magic
32 flac-read-uint drop 32 flac-read drop
read-metadata-block-stream-info read-metadata-block-stream-info
] with-flac-file-reader ; ] with-flac-file-reader ;

96
flac/stream/stream.factor
View File

@ -7,85 +7,45 @@ IN: flac.stream
SYMBOL: flac-input-stream SYMBOL: flac-input-stream
TUPLE: flac-stream-reader stream buffer buffer-length ; CONSTANT: default-bitreader-capacity 6553600
TUPLE: flac-stream-reader stream bitstream ;
M: flac-stream-reader dispose stream>> dispose ; 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 ) : <flac-stream-reader> ( stream -- flac-stream-reader )
0 0 flac-stream-reader boa ; B{ } bitstreams:<msb0-bit-reader> flac-stream-reader boa ;
:: flac-read-uint ( num-bits -- uint ) : flac-read ( n -- m )
flac-input-stream> [ dup flac-input-stream get bitstream>> bitstreams:enough-bits? not ]
[ buffer-length>> num-bits < ]
[ [
flac-input-stream> flac-input-stream get
flac-input-stream-stream> io:stream-read1 [ stream>> default-bitreader-capacity swap io:stream-read ] [ bitstream>> ] bi
flac-input-stream-buffer> 8 shift bitor dup bytes>> swap [ prepend ] dip swap >>bytes drop
>>buffer ] while flac-input-stream get bitstream>> bitstreams:read ;
flac-input-stream-buffer-length> 8 + : flac-seek ( n -- )
>>buffer-length [ dup flac-input-stream get bitstream>> bitstreams:enough-bits? not ]
] 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-buffer> flac-input-stream get
1 flac-input-stream-buffer-length> shift 1 - bitand [ stream>> default-bitreader-capacity swap io:stream-read ] [ bitstream>> ] bi
>>buffer drop dup bytes>> swap [ prepend ] dip swap >>bytes drop
] dip ; ] while flac-input-stream get bitstream>> bitstreams:seek ;
: flac-read-sint ( num-bits -- sint ) : flac-align-to-byte ( -- )
dup flac-read-uint swap >signed ; 8 flac-input-stream get bitstream>> bitstreams:align ;
! flac-input-stream> buffer-length>> n - >>buffer-length : flac-read-int ( n -- m )
! flac-input-stream> buffer>> flac-input-stream buffer-length>> neg dup flac-read swap >signed ;
! 1 n shift 1 -
! [ flac-input-stream> buffer>> 1 flac-input-stream buffer-length>> shift 1 - bitand ] keep ;
! : flac-read ( n -- m ) : flac-read-rice-signed-int ( param -- n )
! [ dup flac-input-stream get bitstream>> bitstreams:enough-bits? not ] [ 0 [ 1 flac-read 0 = ] [ 1 + ] while ] dip
! [ [ shift ] keep flac-read bitor
! flac-input-stream get [ -1 shift ] [ 1 bitand -1 * ] bi bitxor ;
! [ 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-seek ( n -- ) : flac-read-coded-number ( -- n )
! [ dup flac-input-stream get bitstream>> bitstreams:enough-bits? not ] 8 flac-read
! [ [ dup 0b11000000 >= ] [ 8 flac-read drop 2^ 0xff bitand ] while ;
! 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 -- ) : (with-flac-stream-reader) ( stream quot -- )
flac-input-stream swap with-variable ; inline flac-input-stream swap with-variable ; inline
@ -97,4 +57,4 @@ M: flac-stream-reader dispose stream>> dispose ;
[ binary <file-reader> ] dip with-flac-stream-reader ; inline [ binary <file-reader> ] dip with-flac-stream-reader ; inline
: read/assert-flac-magic ( -- ) : read/assert-flac-magic ( -- )
32 flac-read-uint FLAC-MAGIC = [ not-a-flac-stream ] unless ; 32 flac-read FLAC-MAGIC = [ not-a-flac-stream ] unless ;