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

Compare commits

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

2 Commits
13439f6e24 ... 0179a4ce08

Author SHA1 Message Date
Steve Ayerhart 0179a4ce08
adding bonerbonerboner vocab 2023-06-16 21:37:31 -04:00
Steve Ayerhart e3e24c5c4b
flac wip 2023-06-16 21:35:43 -04:00
9 changed files with 261 additions and 83 deletions
Show Stats Expand all files Collapse all files

41
bonerbonerboner/actions/actions.factor Normal file
View File

@ -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 ;

14
bonerbonerboner/actions/subdomains.xml Normal file
View File

@ -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>

5
bonerbonerboner/bonerbonerboner.factor Normal file
View File

@ -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

44
bonerbonerboner/dns/dns.factor Normal file
View File

@ -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 ;

22
bonerbonerboner/server/server.factor Normal file
View File

@ -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 ;

30
flac/decoder/decoder.factor
View File

@ -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 ;

21
flac/format/format.factor
View File

@ -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 } }

71
flac/metadata/metadata.factor
View File

@ -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 ;

96
flac/stream/stream.factor
View File

@ -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 ;