Front Page | Atom Feed | Admin

[ planet-factor ]

John Benediktsson: Factor 0.98 now available

“Even though you're growing up, you should never stop having fun.” - Nina Dobrev

I'm very pleased to announce the release of Factor 0.98!

OS/CPUWindowsMac OS XLinux
x86
0.98
0.98
0.98
x86-64
0.98
0.98
0.98

Source code: 0.98

This release is brought to you with almost 4,300 commits by the following individuals:

Alexander Ilin, Arkady Rost, Benjamin Pollack, Björn Lindqvist, Cat Stevens, Chris Double, Dimage Sapelkin, Doug Coleman, Friedrich von Never, John Benediktsson, Jon Harper, Mark Green, Mark Sweeney, Nicolas Pénet, Philip Dexter, Robert Vollmert, Samuel Tardieu, Sankaranarayanan Viswanathan, Shane Pelletier, @catb0t, @hyphz, @thron7, @xzenf

Besides several years of bug fixes and library improvements, I want to highlight the following changes:

  • Improved user interface with light and dark themes and new icons
  • Fix GTK library issue affecting some Linux installations
  • Support Cocoa TouchBar on MacOS
  • Factor REPL version banner includes build information.
  • Bindings for ForestDB
  • New graphical demos including Minesweeper, Game of Life, Bubble Chamber, etc.
  • Better handling of "out of memory" errors
  • Improved VM and compiler documentation, test fixtures, and bug fixes
  • Much faster Heaps and Heapsort
  • Support for Adobe Brackets, CotEditor, and Microsoft Visual Studio Code editors
  • On Mac OS X, allow use of symlinks to factor binary
  • Lots of improvements to FUEL (Factor's emacs mode)

Some possible backwards compatibility issues:

  • Flattened unicode namespace (either USE: ascii or USE: unicode).
  • Unified CONSTRUCTOR: syntax to include generated word name
  • Returning a struct by value with two register-sized values on 64bit now works correctly
  • Since shutdown hooks run first, calling exit will now unconditionally exit even if there is an error
  • On Windows, don't call cd to change directory when launching processes; there is another mechanism for that
  • In libc, renamed (io-error) to throw-errno
  • In match, renamed ?1-tail to ?rest
  • In sequences, renamed iota to <iota>
  • In sequences, renamed start/start* to subseq-start/subseq-start-from
  • In syntax, renamed GENERIC# to GENERIC#:
  • Improve command-line argument parsing of "executable"
  • Make buffered-port not have a length, because of problem with Linux virtual files and TCP sockets
  • Fix broken optimization that made floats work for integer keys in case statements
  • Growable sequences expand by factor of 2 (instead of 3) when growing
  • Removed support for "triple-quote" strings

What is Factor

Factor is a concatenative, stack-based programming language with high-level features including dynamic types, extensible syntax, macros, and garbage collection. On a practical side, Factor has a full-featured library, supports many different platforms, and has been extensively documented.

The implementation is fully compiled for performance, while still supporting interactive development. Factor applications are portable between all common platforms. Factor can deploy stand-alone applications on all platforms. Full source code for the Factor project is available under a BSD license.


New Libraries:


Improved Libraries:

Tue, 31 Jul 2018 17:09:00

John Benediktsson: Minesweeper

Minesweeper is a fun game that was probably made most popular by its inclusion in various Microsoft Windows versions since the early 1990's.

I thought it would be fun to build a simple Minesweeper clone using Factor.

You can run this by updating to the latest code and running:

IN: scratchpad "minesweeper" run

Game Engine

We are going to represent our game grid as a two-dimensional array of "cells".

Each cell contains the number of mines contained in the (up to eight) adjacent cells, whether the cell contains a mine, and a "state" flag showing whether the cell was +clicked+, +flagged+, or marked with a +question+ mark.

SYMBOLS: +clicked+ +flagged+ +question+ ;

TUPLE: cell #adjacent mined? state ;

Making a (rows, cols) grid of cells:

: make-cells ( rows cols -- cells )
    '[ _ [ cell new ] replicate ] replicate ;

We can lookup a particular cell using its (row, col) index:

:: cell-at ( cells row col -- cell/f )
    row cells ?nth [ col swap ?nth ] [ f ] if* ;

Placing a number of mines into cells, just looks for a certain number of unmined cells at random, and then marks them as mined:

: unmined-cell ( cells -- cell )
    f [ dup mined?>> ] [ drop dup random random ] do while nip ;

: place-mines ( cells n -- cells )
    [ dup unmined-cell t >>mined? drop ] times ;

We can count the number of adjacent mines for each cell, by looking at its neighbors:

CONSTANT: neighbors {
    { -1 -1 } { -1  0 } { -1  1 }
    {  0 -1 }           {  0  1 }
    {  1 -1 } {  1  0 } {  1  1 }
}

: adjacent-mines ( cells row col -- #mines )
    neighbors [
        first2 [ + ] bi-curry@ bi* cell-at
        [ mined?>> ] [ f ] if*
    ] with with with count ;

The each-cell word looks at all the cells, helping us update the "adjacent mines" counts:

:: each-cell ( ... cells quot: ( ... row col cell -- ... ) -- ... )
    cells [| row |
        [| cell col | row col cell quot call ] each-index
    ] each-index ; inline

:: update-counts ( cells -- cells )
    cells [| row col cell |
        cells row col adjacent-mines cell #adjacent<<
    ] each-cell cells ;

Since we aren't storing the number of rows and columns, we can get it from the array of cells:

: cells-dim ( cells -- rows cols )
    [ length ] [ first length ] bi ;

We can get the number of mines contained in the grid by counting them up:

: #mines ( cells -- n )
    [ [ mined?>> ] count ] map-sum ;

We can reset the game by making new cells and then placing the same number of mines in them:

: reset-cells ( cells -- cells )
    [ cells-dim make-cells ] [ #mines place-mines ] bi update-counts ;

The player wins if they click on all cells that aren't mines:

: won? ( cells -- ? )
    [ [ { [ state>> +clicked+ = ] [ mined?>> ] } 1|| ] all? ] all? ;

The player loses if they click on any cell that's a mine:

: lost? ( cells -- ? )
    [ [ { [ state>> +clicked+ = ] [ mined?>> ] } 1&& ] any? ] any? ;

And then the game is over if the player either wins or loses:

: game-over? ( cells -- ? )
    { [ lost? ] [ won? ] } 1|| ;

We can tell this is a new game if no cells are clicked on:

: new-game? ( cells -- ? )
    [ [ state>> +clicked+ = ] any? ] any? not ;

When we click on a cell, if it is not adjacent to any mines, we click on all the "clickable" (non-mined) cells around it:

DEFER: click-cell-at

:: click-cells-around ( cells row col -- )
    neighbors [
        first2 [ row + ] [ col + ] bi* :> ( row' col' )
        cells row' col' cell-at [
            mined?>> [
                cells row' col' click-cell-at
            ] unless
        ] when*
    ] each ;

Handle clicking a cell. If it's the first click and the cell is mined, we move it to another random cell, then continue with the click. The click is ignored if the cell was already clicked or flagged. Continue clicking around any cells that have no adjacent mines and are not themselves mined.

:: click-cell-at ( cells row col -- )
    cells row col cell-at [
        cells new-game? [
            ! first click shouldn't be a mine
            dup mined?>> [
                cells unmined-cell t >>mined? drop f >>mined?
                cells update-counts drop
            ] when
        ] when
        dup state>> { +clicked+ +flagged+ } member? [ drop ] [
            +clicked+ >>state
            { [ mined?>> not ] [ #adjacent>> 0 = ] } 1&& [
                cells row col click-cells-around
            ] when
        ] if
    ] when* ;

Handle marking a cell. First by flagging it as a likely mine, or marking with a question mark to come back to later. If the cell is not clicked, we just cycle through flagging, question, or not clicked.

:: mark-cell-at ( cells row col -- )
    cells row col cell-at [
        dup state>> {
            { +clicked+ [ +clicked+ ] }
            { +flagged+ [ +question+ ] }
            { +question+ [ f ] }
            { f [ +flagged+ ] }
        } case >>state drop
    ] when* ;

Graphical Interface

Our graphical interface is going to consist of a gadget with an array of cells and a cache of OpenGL texture objects that can be easily drawn on the screen.

TUPLE: grid-gadget < gadget cells textures ;

When you make a new grid-gadget, it initializes the game to a specified number of rows, columns, and number of mines:

:: <grid-gadget> ( rows cols mines -- gadget )
    grid-gadget new
        rows cols make-cells
        mines place-mines update-counts >>cells
        H{ } clone >>textures
        COLOR: gray <solid> >>interior ;

When ungraft* is called to indicate the gadget is no longer visible on the screen, we clean up the cached textures:

M: grid-gadget ungraft*
    dup find-gl-context
    [ values dispose-each H{ } clone ] change-textures
    call-next-method ;

Our images are going to be 32 x 32 squares, so the preferred dimension is number of rows and columns times 32 pixels for each square.

M: grid-gadget pref-dim*
    cells>> cells-dim [ 32 * ] bi@ swap 2array ;

Some slightly complex logic to decide which image to display for each cell, taking into account whether the game is over so we can show the positions of all the mines and whether the player was correct in flagging a cell as mined, etc:

:: cell-image-path ( cell game-over? -- image-path )
    game-over? cell mined?>> and [
        cell state>> +clicked+ = "mineclicked.gif" "mine.gif" ?
    ] [
        cell state>>
        {
            { +question+ [ "question.gif" ] }
            { +flagged+ [ game-over? "misflagged.gif" "flagged.gif" ? ] }
            { +clicked+ [
                cell mined?>> [
                    "mine.gif"
                ] [
                    cell #adjacent>> 0 or number>string
                    "open" ".gif" surround
                ] if ] }
            { f [ "blank.gif" ] }
        } case
    ] if "vocab:minesweeper/_resources/" prepend ;

Drawing a cached texture is a matter of looking up the image in our texture cache and then rendering to the screen:

: draw-cached-texture ( path gadget -- )
    textures>> [ load-image { 0 0 } <texture> ] cache
    [ dim>> ] [ draw-scaled-texture ] bi ;

Drawing our gadget, is basically drawing all of the cells at their proper locations on the screen:

M:: grid-gadget draw-gadget* ( gadget -- )
    gadget cells>> game-over? :> game-over?
    gadget cells>> [| row col cell |
        col row [ 32 * ] bi@ 2array [
            cell game-over? cell-image-path
            gadget draw-cached-texture
        ] with-translation
    ] each-cell ;

Basic handling for the gadget being left-clicked on:

:: on-click ( gadget -- )
    gadget hand-rel first2 :> ( w h )
    h w [ 32 /i ] bi@ :> ( row col )
    gadget cells>> :> cells
    cells game-over? [
        cells row col click-cell-at
    ] unless gadget relayout-1 ;

Basic handling for the gadget being right-clicked on:

:: on-mark ( gadget -- )
    gadget hand-rel first2 :> ( w h )
    h w [ 32 /i ] bi@ :> ( row col )
    gadget cells>> :> cells
    cells game-over? [
        cells row col mark-cell-at
    ] unless gadget relayout-1 ;

Logic for creating new games of varying difficulties: easy, medium, and hard:

: new-game ( gadget rows cols mines -- )
    [ make-cells ] dip place-mines update-counts >>cells
    relayout-window ;

: com-easy ( gadget -- ) 7 7 10 new-game ;

: com-medium ( gadget -- ) 15 15 40 new-game ;

: com-hard ( gadget -- ) 15 30 99 new-game ;

We set our gesture handlers for keyboard and mouse inputs:

grid-gadget {
    { T{ key-down { sym "1" } } [ com-easy ] }
    { T{ key-down { sym "2" } } [ com-medium ] }
    { T{ key-down { sym "3" } } [ com-hard ] }
    { T{ button-up { # 1 } } [ on-click ] }
    { T{ button-up { # 3 } } [ on-mark ] }
    { T{ key-down { sym " " } } [ on-mark ] }
} set-gestures

And a main word that creates an easy game in our grid-gadget and opens it in a new window:

MAIN-WINDOW: run-minesweeper {
        { title "Minesweeper" }
        { window-controls
            { normal-title-bar close-button minimize-button } }
    } 7 7 10 <grid-gadget> >>gadgets ;

The implementation above is about 200 lines of code and contains the full game logic. The final version is just under 300 lines of code, and adds:

  • support for a toolbar to easily start new games
  • the traditional counter of the number of mines remaining
  • display of the number of seconds elapsed
  • a smiley face showing a funny "uh-oh!" face when you are about to click as well as winning and losing smileys
  • support for retina displays using 2x images

Mon, 12 Feb 2018 21:39:00

John Benediktsson: $7.11

Today, someone blogged about a fun problem:

“A mathematician purchased four items in a grocery store. He noticed that when he added the prices of the four items, the sum came to $7.11, and when he multiplied the prices of the four items, the product came to $7.11.”

In some ways, this is similar to the SEND + MORE = MONEY problem that I blogged about awhile ago. You can always approach this problem with an direct and iterative solution, but instead we will use the backtrack vocabulary to solve this problem with less code.

We'll be solving this exactly, using integer "numbers of cents", progressively restricting the options, and then calling fail if the solution is not found, so we check the next. The first valid solution will be returned:

:: solve-711 ( -- seq )
    711 <iota> amb-lazy :> w
    711 w - <iota> amb-lazy :> x
    711 w - x - <iota> amb-lazy :> y
    711 w - x - y - :> z

    w x * y * z * 711,000,000 = [ fail ] unless

    { w x y z } ;

Using it, we get our answer:

IN: scratchpad solve-711 .
{ 120 125 150 316 }

And that is: $1.20, $1.25, $1.50, and $3.16.

Sat, 11 Feb 2017 22:05:00

John Benediktsson: Dirty Money: Code Challenge

There's a fun coding challenge to follow the dirty money that I discovered recently.

A shady Internet business has been discovered.

The website has been made public by a whistle blower. We have enough evidence about the dirty deals they did. But to charge them we need to get hands on precise numbers about the transactions that happened on their platform.

Unfortunately no record of the transactions could be seized so far. The only hint we have is this one transaction:

fd0d929f-966f-4d1a-89cd-feee5a1c5347.json

What we need is the total of all transactions in Dollar. Can you trace down all other transactions and get the total?

Be careful to count each transaction only once, even if it is linked multiple times. You can use whatever tool works best.

We need a way to extract the dollar amount from the transaction text. The dollars might be specified with period or a comma to represent the decimal point. We use regular expressions to look for the dollar amount and then convert to a number.

: dollars ( str -- $ )
    R/ \$\d*[,.]\d+/ first-match rest
    "," "." replace string>number ;

We will use a hash-set of visited links, and only if the link has not been visited will we http-get the contents of the URL, parse the JSON, and extract the dollar amount of both the transaction and any links it contains. The set of visited links will tell us how many total transactions we traced.

:: transaction ( url visited -- dollars )
    url visited ?adjoin [
        url http-get nip json> :> data
        data "content" of dollars
        data "links" of [ visited transaction ] map-sum +
    ] [ 0 ] if ;

: transactions ( url -- dollars #transactions )
    HS{ } clone [ transaction ] [ cardinality ] bi ;

That's all we need to solve the problem. We can run this with the initial URL and get the answer:

$9064.79 in 50 transactions.

Sun, 5 Feb 2017 23:59:00

John Benediktsson: The Twelve Days of Christmas

Programming Praxis posted a task to write a program to print the words to The Twelve Days of Christmas song. We are going to solve it in Factor.

We start off by defining all the gifts received on each day:

CONSTANT: gifts {
    { "first" "a partridge in a pear tree" }
    { "second" "two turtle doves and " }
    { "third" "three French hens, " }
    { "fourth" "four calling birds, " }
    { "fifth" "five golden rings, " }
    { "sixth" "six geese a-laying, " }
    { "seventh" "seven swans a-swimming, " }
    { "eighth" "eight maids a-milking, " }
    { "ninth" "nine ladies dancing, " }
    { "tenth" "ten lords a-leaping, " }
    { "eleventh" "eleven pipers piping, " }
    { "twelfth" "twelve drummers drumming, " }
}

Then we iterate through the days, gathering all the gifts in reverse for each day, and formatting them, and wrapping to 72 columns of text for display.

gifts [
    [ first ] [ 1 + gifts swap head values reverse concat ] bi*
    "On the %s day of Christmas my true love gave to me %s." sprintf
    72 wrap-string print nl
] each-index

Which gives us these words:

On the first day of Christmas my true love gave to me a partridge in a pear tree.

On the second day of Christmas my true love gave to me two turtle doves and a partridge in a pear tree.

On the third day of Christmas my true love gave to me three French hens, two turtle doves and a partridge in a pear tree.

On the fourth day of Christmas my true love gave to me four calling birds, three French hens, two turtle doves and a partridge in a pear tree.

On the fifth day of Christmas my true love gave to me five golden rings, four calling birds, three French hens, two turtle doves and a partridge in a pear tree.

On the sixth day of Christmas my true love gave to me six geese a-laying, five golden rings, four calling birds, three French hens, two turtle doves and a partridge in a pear tree.

On the seventh day of Christmas my true love gave to me seven swans a-swimming, six geese a-laying, five golden rings, four calling birds, three French hens, two turtle doves and a partridge in a pear tree.

On the eighth day of Christmas my true love gave to me eight maids a-milking, seven swans a-swimming, six geese a-laying, five golden rings, four calling birds, three French hens, two turtle doves and a partridge in a pear tree.

On the ninth day of Christmas my true love gave to me nine ladies dancing, eight maids a-milking, seven swans a-swimming, six geese a-laying, five golden rings, four calling birds, three French hens, two turtle doves and a partridge in a pear tree.

On the tenth day of Christmas my true love gave to me ten lords a-leaping, nine ladies dancing, eight maids a-milking, seven swans a-swimming, six geese a-laying, five golden rings, four calling birds, three French hens, two turtle doves and a partridge in a pear tree.

On the eleventh day of Christmas my true love gave to me eleven pipers piping, ten lords a-leaping, nine ladies dancing, eight maids a-milking, seven swans a-swimming, six geese a-laying, five golden rings, four calling birds, three French hens, two turtle doves and a partridge in a pear tree.

On the twelfth day of Christmas my true love gave to me twelve drummers drumming, eleven pipers piping, ten lords a-leaping, nine ladies dancing, eight maids a-milking, seven swans a-swimming, six geese a-laying, five golden rings, four calling birds, three French hens, two turtle doves and a partridge in a pear tree.

Sat, 24 Dec 2016 19:21:00

John Benediktsson: AnyBar

AnyBar is a macOS status indicator that displays a "colored dot" in the menu bar that can be changed programatically. What it means and when it changes is entirely up to the user.

You can easily install it with Homebrew-cask:

$ brew cask install anybar

The README lists a number of alternative clients in different programming languages. I thought it would be fun to show how to use it from Factor. Since AnyBar responds to AppleScript (and I added support for AppleScript a few years ago), we could do this:

USE: cocoa.apple-script

"tell application \"AnyBar\" to set image name to \"blue\""
run-apple-script

The AnyBar application also listens to a UDP port (default: 1738) and can be instructed to change from a Terminal using a simple echo | nc command:

$ echo -n "blue" | nc -4u -w0 localhost 1738

Using our networking words similarly is pretty simple:

"blue" >byte-array "127.0.0.1" 1738 <inet4> send-once

But if we wanted to get more fancy, we could use symbols to configure which AnyBar instance to send to, with default values to make it easy to use, and resolve-host to lookup hostnames:

SYMBOL: anybar-host
"localhost" anybar-host set-global

SYMBOL: anybar-port
1738 anybar-port set-global

: anybar ( str -- )
    ascii encode
    anybar-host get resolve-host first
    anybar-port get with-port send-once ;

AnyBar is a neat little program!

Mon, 28 Nov 2016 20:58:00

John Benediktsson: Reverse Factorial

A few years ago, I wrote about implementing various factorials using Factor. Recently, I came across a programming challenge to implement a "reverse factorial" function to determine what factorial produces a number, or none if it is not a factorial.

To do this, we examine each factorial in order, checking against the number being tested:

: reverse-factorial ( m -- n )
    1 1 [ 2over > ] [ 1 + [ * ] keep ] while [ = ] dip and ;

And some unit tests:

{ 10 } [ 3628800 reverse-factorial ] unit-test
{ 12 } [ 479001600 reverse-factorial ] unit-test
{ 3 } [ 6 reverse-factorial ] unit-test
{ f } [ 18 reverse-factorial ] unit-test

Sun, 27 Nov 2016 06:28:00

John Benediktsson: Gopher Server

A few days ago, I noticed a post about building a Gopher Server in Perl 6. I had already implemented a Gopher Client in Factor, and thought it might be fun to show a simple Gopher Server in Factor in around 50 lines of code.

Using the io.servers vocabulary, we will define a new multi-threaded server that has a directory to serve content from and hostname that it can be accessed at:

TUPLE: gopher-server < threaded-server
    { serving-hostname string }
    { serving-directory string } ;

When a file is requested, it can be streamed back to clients:

: send-file ( path -- )
    binary [ [ write ] each-block ] with-file-reader ;

The Gopher protocol is defined in RFC 1436 and lists a few differentiated file types. We use the mime.types vocabulary to return the correct one.

: gopher-type ( entry -- type )
    dup directory? [
        drop "1"
    ] [
        name>> mime-type {
            { [ dup "text/" head? ] [ drop "0" ] }
            { [ dup "image/gif" = ] [ drop "g" ] }
            { [ dup "image/" head? ] [ drop "I" ] }
            [ drop "9" ]
        } cond
    ] if ;

When a directory is requested, we can send a listing of all the sub-directories and files it contains, sending their relative path to the root directory being served so they can be requested properly by the client:

:: send-directory ( server path -- )
    path [
        [
            [ gopher-type ] [ name>> ] bi
            dup path prepend-path
            server serving-directory>> ?head drop
            server serving-hostname>>
            server insecure>>
            "%s%s\t%s\t%s\t%d\r\n" sprintf utf8 encode write
        ] each
    ] with-directory-entries ;

To know which path was requested, we read the line, split on the first tab, carriage return, or newline character we see:

: read-gopher-path ( -- path )
    readln [ "\t\r\n" member? ] split1-when drop ;

With all of that built, we can now implement a word to handle a client request:

M: gopher-server handle-client*
    dup serving-directory>> read-gopher-path append-path
    dup file-info directory? [
        send-directory
    ] [
        send-file drop
    ] if flush ;

Initializing a gopher-server instance and providing a convenience word to start one:

: <gopher-server> ( directory port -- server )
    utf8 gopher-server new-threaded-server
        "gopher.server" >>name
        swap >>insecure
        binary >>encoding
        "localhost" >>serving-hostname
        swap resolve-symlinks >>serving-directory ;

: start-gopher-server ( directory port -- server )
    <gopher-server> start-server ;

This is available in the gopher.server vocabulary with a few improvements such as:

  • Support for .gophermap files for alternate results when content is requested.
  • Support for .gopherhead files to print headers above directory listings.
  • Navigation to parent directories using .. links.
  • Display file modified timestamp and file sizes.
  • Improved error handling.

Thu, 27 Oct 2016 21:14:00

Blogroll

planet-factor is an Atom/RSS aggregator that collects the contents of Factor-related blogs. It is inspired by Planet Lisp.

Syndicate