Sunday, October 6, 2013

Rock-paper-scissors

The ever-popular game of rock-paper-scissors is a fun game to play with friends and, as it turns out, a fun game to implement in Factor.

We have an open issue to finish some planned changes to multi-methods. While largely a syntax improvement, one of the challenges will be keeping the simple case fast while providing for enhanced dispatch ability. As a way of showing how the current syntax works, I thought I would implement the "rock-paper-scissors" game.

First, we define each type of object in our game:

SINGLETONS: rock paper scissors ;
Note: we are not playing rock-paper-scissors-lizard-spock, which is a bit more complicated and possibly a lot more fun.

Next, we need to determine a winner using multi-methods. You'll notice that our generic method dispatches off the types of two objects. We can use any type here, including predicate classes, but can simply dispatch off the singletons we defined above:

FROM: multi-methods => GENERIC: METHOD: ;

GENERIC: beats? ( obj1 obj2 -- ? )

METHOD: beats? { scissors paper } 2drop t ;
METHOD: beats? { rock scissors } 2drop t ;
METHOD: beats? { paper rock } 2drop t ;
METHOD: beats? { object object } 2drop f ;

Each play of the game will determine the outcome (win, lose, or tie) and print a summary:

: play. ( obj1 obj2 -- )
    {
        { [ 2dup beats? ] [ "WIN" ] }
        { [ 2dup = ] [ "TIE" ] }
        [ "LOSE" ]
    } cond "%s vs. %s: %s\n" printf ;

The computer will choose randomly amongst the possibilities:

: computer ( -- obj )
    { rock paper scissors } random ;

And for fun, we will define words to allow the user to play the computer at the listener:

: rock ( -- ) \ rock computer play. ;

: paper ( -- ) \ paper computer play. ;

: scissors ( -- ) \ scissors computer play. ;

A sample output from a few games:

The code for this is available on my GitHub.

Tuesday, October 1, 2013

Color Support

For a fairly long time, Factor has had support for RGB, HSV, and grayscale color spaces.

More recently, I got interested in colors, even having some fun by building color tab completion. We have now added support for CMYK, HSL, RYB, YIQ, and YUV color spaces. All colors support an alpha channel and conversion to and from RGB colors!

You could say two colors are equal if their RGB components are very, very, very close:

: color= ( color1 color2 -- ? )
    [ >rgba-components 4array ] bi@
    [ 0.00000000000001 ~ ] 2all? ;

Using that, you can write a test to confirm that our round trip through color spaces preserves the original color information:

{ t } [
    COLOR: sky-blue
    >hsva
    >yiqa
    >cmyka
    >yuva
    >hsla
    >ryba
    >rgba
    COLOR: sky-blue color=
] unit-test

This is now available in the development version of Factor!

Note: we also support basic color mixing, with the ability to do linear gradients between colors.

Monday, September 23, 2013

YouTube Downloader

YouTube needs no introduction - it hosts many videos and has a virtual firehose of new content uploaded every second of every day. The primary interface is through a web browser with no easy way to download content for offline viewing. Naturally, "YouTube downloader" plugins have become a popular addition to most web browsers.

I thought it would be fun to implement a basic "YouTube downloader" in Factor.

First, we start by obtaining information about a video using the YouTube API, parsing the response as a query string:

CONSTANT: video-info-url URL" http://www.youtube.com/get_video_info"

: get-video-info ( video-id -- video-info )
    video-info-url clone
        3 "asv" set-query-param
        "detailpage" "el" set-query-param
        "en_US" "hl" set-query-param
        swap "video_id" set-query-param
    http-get nip query>assoc ;

Next, we can get a list of the available video formats:

: video-formats ( video-info -- video-formats )
    "url_encoded_fmt_stream_map" of
    "," split [ query>assoc ] map ;

A particular video format includes a download URL and a signature that needs to be attached to it to successfully download the video:

: video-download-url ( video-format -- url )
    [ "url" of ] [ "sig" of ] bi "&signature=" glue ;

We are going to use the video title to create a filename, but first we want to sanitize it by removing unprintable characters and a few characters which might conflict with your filesystem and making it no more than 200 characters long:

: sanitize ( title -- title' )
    [ 0 31 between? not ] filter
    [ "\"#$%'*,./:;<>?^|~\\" member? not ] filter
    200 short head ;

Finally, to download a video, we lookup its video info, find the first mp4 formatted video, convert it to a download URL, and then download-to a file.

: download-video ( video-id -- )
    get-video-info [
        video-formats [ "type" of "video/mp4" head? ] find nip
        video-download-url
    ] [
        "title" of sanitize ".mp4" append download-to
    ] bi ;

You can choose a directory to download it to using the with-directory word. For example, downloading a video to your home directory:

IN: scratchpad "~" [ "G8LC8ES6ogw" download-video ] with-directory

The code for this is on my GitHub.

Wednesday, September 18, 2013

ZeroMQ

ZeroMQ is a "high-level" socket library that provides some middleware capabilities and markets itself as "The Simplest Way to Connect Pieces".

About a year ago, Eungju Park created a binding that was usable from Factor. He was gracious to allow us to merge his vocabulary into the main repository. In the process, I cleaned up the API a little bit and made sure it works with the latest version of ZeroMQ (currently 3.2.3).

As a quick tease, I thought I would show off a simple "echo" example.

echo

Our "echo" server will bind to port 5000. It will loop forever, sending any messages that it receives back to the client:

: echo-server ( -- )
    [
        <zmq-context> &dispose
        ZMQ_REP <zmq-socket> &dispose
        dup "tcp://127.0.0.1:5000" zmq-bind
        [ dup 0 zmq-recv dupd 0 zmq-send t ] loop
        drop
    ] with-destructors ;

Our "echo" client will connect to the server on port 5000. Each second, we grab the current time (by calling now), format it into as string and send it to the server, printing the message being sent and the message that was received:

: echo-client ( -- )
    [
        <zmq-context> &dispose
        ZMQ_REQ <zmq-socket> &dispose
        dup "tcp://127.0.0.1:5000" zmq-connect
        [
            now present
            [ "Sending " write print flush ]
            [ >byte-array dupd 0 zmq-send ] bi
            dup 0 zmq-recv >string
            "Received " write print flush
            1 seconds sleep
            t
        ] loop
        drop
    ] with-destructors ;

Perhaps not as simple as a pure Factor echo server, but all the nuts and bolts are working. Maybe in the future we could write a wrapper for a wrapper to simplify using ZeroMQ in common use-cases.

The zeromq vocabulary and several other examples of its use are available in the latest development version of Factor.

Note: the calls into the ZeroMQ are blocking in such a way that we have to run the echo-server in one Factor process and the echo-client in another Factor process. It would be nice to integrate it in such a way this was not necessary.

Wednesday, September 4, 2013

Verbal Expressions

Recently, thechangelog.com wrote a blog post asking programmers to stop writing regular expressions and begin using "verbal expressions".

Instead of writing this regular expression to parse a URL:

^(?:http)(?:s)?(?:\:\/\/)(?:www\.)?(?:[^\ ]*)$

You could be writing this verbal expression (in Javascript):

var tester = VerEx()
            .startOfLine()
            .then( "http" )
            .maybe( "s" )
            .then( "://" )
            .maybe( "www." )
            .anythingBut( " " )
            .endOfLine();

I'm not sure the second is more readable than the first once you get comfortable with regular expressions, but it could be useful in some circumstances and particularly to programmers that aren't as familiar with the esoteric syntax that is frequently required when matching text.

These "verbal" expressions seem to have become popular, with a GitHub organization listing implementations in 19 languages so far.

With that in mind, let's make a Factor implementation!

Basics

We need to create an object that will keep our state as we build our regular expression, holding a prefix and suffix that surround a source string as well as any modifiers that are requested (like case-insensitivity):

TUPLE: verbexp prefix source suffix modifiers ;

: <verbexp> ( -- verbexp )
    "" "" "" "" verbexp boa ; inline

Making a regular expression is as simple as combining the prefix, source, and suffix, and creating a regular expression with the requested modifiers:

: >regexp ( verbexp -- regexp )
    [ [ prefix>> ] [ source>> ] [ suffix>> ] tri 3append ]
    [ modifiers>> ] bi <optioned-regexp> ; inline

For convenience, we could have a combinator that creates the verbal expression, calls a quotation with it on the stack, then converts it to a regular expression:

: build-regexp ( quot: ( verbexp -- verbexp ) -- regexp )
    '[ <verbexp> @ >regexp ] call ; inline

When we want to add to our expression, we just append it to the source:

: add ( verbexp str -- verbexp )
    '[ _ append ] change-source ;

Anything that is not a letter or a digit can be escaped with a backslash:

: re-escape ( str -- str' )
    [
        [
            dup { [ Letter? ] [ digit? ] } 1||
            [ CHAR: \ , ] unless ,
        ] each
    ] "" make ;

Methods

We can specify "anything" or "anything but":

: anything ( verbexp -- verbexp )
    "(?:.*)" add ;

: anything-but ( verbexp value -- verbexp )
    re-escape "(?:[^" "]*)" surround add ;

We can specify "something" and "something but":

: something ( verbexp -- verbexp )
    "(?:.+)" add ;

: something-but ( verbexp value -- verbexp )
    re-escape "(?:[^" "]+)" surround add ;

We can specify looking for "start of line" or "end of line":

: start-of-line ( verbexp -- verbexp )
    [ "^" append ] change-prefix ;

: end-of-line ( verbexp -- verbexp )
    [ "$" append ] change-suffix ;

We can specify a value ("then"), or an optional value ("maybe"):

: then ( verbexp value -- verbexp )
    re-escape "(?:" ")" surround add ;

: maybe ( verbexp value -- verbexp )
    re-escape "(?:" ")?" surround add ;

We could specify "any of" a set of characters:

: any-of ( verbexp value -- verbexp )
    re-escape "(?:[" "])" surround add ;

Or, maybe simply a line break, tab, word, or space:

: line-break ( verbexp -- verbexp )
    "(?:(?:\\n)|(?:\\r\\n))" add ;

: tab ( verbexp -- verbexp ) "\\t" add ;

: word ( verbexp -- verbexp ) "\\w+" add ;

: space ( verbexp -- verbexp ) "\\s" add ;

Perhaps many of whatever has been specified so far:

: many ( verbexp -- verbexp )
    [
        dup ?last "*+" member? [ "+" append ] unless
    ] change-source ;

Modifiers

Some helper words allow us to easily add and remove modifiers:

: add-modifier ( verbexp ch -- verbexp )
    '[ _ suffix ] change-modifiers ;

: remove-modifier ( verbexp ch -- verbexp )
    '[ _ swap remove ] change-modifiers ;

Should we be case-insensitive or not:

: case-insensitive ( verbexp -- verbexp )
    CHAR: i add-modifier ;

: case-sensitive ( verbexp -- verbexp )
    CHAR: i remove-modifier ;

Should we search across multiple lines or not:

: multiline ( verbexp -- verbexp )
    CHAR: m add-modifier ;

: singleline ( verbexp -- verbexp )
    CHAR: m remove-modifier ;

Testing

We can try out our original example using the unit test framework to show that it works:

{ t } [
    "https://www.google.com" [
        start-of-line
        "http" then
        "s" maybe
        "://" then
        "www." maybe
        " " anything-but
        end-of-line
    ] build-regexp matches?
] unit-test

I'm not convinced this is an improvement. In the current specification for "verbal" expressions, the language for expressing characteristics to match against is relatively limited. Perhaps with some effort, this could evolve into a more capable (but still readable) syntax.

In any event, the code for this is on my GitHub.

Monday, August 12, 2013

Domai.nr

The domai.nr service is a handy way to find domains that make nice short URLs like debu.gs, nick.is, and craftstud.io.

I had a need awhile back to access this web service from a script and query a bunch of domains all at the same time, so I thought it would be nice to have a wrapper in Factor.

The domai.nr service has a JSON API for performing searches, that we can build URLs for:

: domainr-url ( query -- url )
    URL" http://domai.nr/api/json/search"
    swap "q" set-query-param ;

Each result has these fields that are returned:

TUPLE: result domain host path subdomain availability
register_url ;

It is pretty simple to map a JSON request to these result tuples:

: domainr ( query -- data )
    domainr-url http-get nip json> "results" of
    [ result from-slots ] map ;

Finally, we can perform a query and print the output nicely showing which domains or URLs are available:

: domainr. ( query -- )
    domainr [
        [ subdomain>> ] [ path>> ] [ availability>> ] tri
        "%s%s - %s\n" printf
    ] each ;

Running this query for "factorcode" looks like:

IN: scratchpad "factorcode" domainr.
factorcode.com - available
factorcode.net - available
factorcode.org - taken
factorcode.co - available
factor.co/de - taken
factorcode.io - available
factorco.de - available
factorc.de - available
fac.to/rcode - available
f.actor/code - unavailable
f.ac/torcode - unavailable
fctrc.de - available
fctr.cd/e - available
fc.tr/cde - unavailable

Well, if we wanted to make our URL something like factorco.de we could, but I'm not sure that's worth it. Still, a neat way to look for interesting URLs and available on my GitHub.

Tuesday, August 6, 2013

uniq

I've used Factor to build several common unix programs including copy, cat, fortune, wc, move, and others.

Today, I wanted to show how to build the uniq program. If we look at the man page, we can see that it is used to:

Filter adjacent matching lines from INPUT (or standard input), writing to OUTPUT (or standard output).

Using the each-line combinator to output each line of text that is not identical to the previous line (using f to force the first line to always be printed):

: uniq-lines ( -- )
    f [
        2dup = [ dup print ] unless nip
    ] each-line drop ;

The input is optionally specified, so need a uniq-file word that will "uniq" the lines of a file, or read directly from the current input-stream (which will be standard input when run from the command line):

: uniq-file ( path/f -- )
    [
        utf8 [ uniq-lines ] with-file-reader
    ] [
        uniq-lines
    ] if* ;

Finally, our "main method" checks the command-line, writing our output to a file if a second command-line argument is provided:

: run-uniq ( -- )
    command-line get [ ?first ] [ ?second ] bi [
        utf8 [ uniq-file ] with-file-writer
    ] [
        uniq-file
    ] if* ;

MAIN: run-uniq

The code for this is on my GitHub.