Less a cool use for perl than a cool use for parrot, the following is a modification of the life game that comes with parrot. The interesting bit here is that it uses the new native call interface to connect to curses (without any modules, nor parrot itself actually knowing about curses) to do the drawing.

This is courtesy of Leon Brocard, Orange Parrot Hacker extraordinaire. 

#
# life.pasm
#
# Play conway's (no, not *him*. The other conway) game
# of life
#
# Hacked by Leon Brocard <acme@astray.com> to use curses


    loadlib P1, "libcurses.so"
    dlfunc P0, P1, "initscr", "i"
    invoke
    dlfunc P0, P1, "curs_set", "ii"
    set I5, 0
    invoke


    # First the generation count
    set I2, 5000
    # Note the time
    time N5
    # If true, we don't print
    set I12, 0
    set S0,  "               "
    set S1,  "               "
    set S2,  "               "
    set S3,  "               "
        set S4,  "   **          "
        set S5,  " *    *        "
    set S6,  "       *       "
    set S7,  " *     *       "
    set S8,  "  ******       "
    set S9,  "               "
    set S10, "               "
    set S11, "               "
    set S12, "               "
    set S13, "               "
    set S14, "               "
    set S15, ""
    concat S15, S0
    concat S15, S1
    concat S15, S2
    concat S15, S3
    concat S15, S4
    concat S15, S5
    concat S15, S6
    concat S15, S7
    concat S15, S8
    concat S15, S9
    concat S15, S10
    concat S15, S11
    concat S15, S12
    concat S15, S13
    concat S15, S14
    bsr dump
    set I0, 0
loop:    ge I0, I2, getout
    inc I0
    mod I31,I0,100
    if I31, skip
skip:

    bsr generate

    bsr dump
    branch loop
getout:

    dlfunc P0, P1, "curs_set", "ii"
    set I5, 1
    invoke
    dlfunc P0, P1, "endwin", "i"
    invoke


    end

# S15 has the incoming string, S0 is scratch, S1 is scratch, S2 is scr
+atch
#
# I0 is the length of the string
# I1 is the current cell we're checking
# I2 is the count for that cell
# I3 is the offset to the neighbor
generate:
    pushi
    length I0, S15
    set S1, ""
    set I1, 0
genloop:
    set I2, 0
NW:
    set I3, -16
    add I3, I3, I0
    add I3, I3, I1
    mod I3, I3, I0
    substr S0, S15, I3, 1
    ne S0, "*", North
    inc I2
North:
    set I3, -15
    add I3, I3, I0
    add I3, I3, I1
    mod I3, I3, I0
    substr S0, S15, I3, 1
    ne S0, "*", NE
    inc I2
NE:
    set I3, -14
    add I3, I3, I0
    add I3, I3, I1
    mod I3, I3, I0
    substr S0, S15, I3, 1
    ne S0, "*", West
    inc I2
West:
    set I3, -1
    add I3, I3, I0
    add I3, I3, I1
    mod I3, I3, I0
    substr S0, S15, I3, 1
    ne S0, "*", East
    inc I2
East:
    set I3, 1
    add I3, I3, I0
    add I3, I3, I1
    mod I3, I3, I0
    substr S0, S15, I3, 1
    ne S0, "*", SW
    inc I2
SW:
    set I3, 14
    add I3, I3, I0
    add I3, I3, I1
    mod I3, I3, I0
    substr S0, S15, I3, 1
    ne S0, "*", South
    inc I2
South:
    set I3, 15
    add I3, I3, I0
    add I3, I3, I1
    mod I3, I3, I0
    substr S0, S15, I3, 1
    ne S0, "*", SE
    inc I2
SE:
    set I3, 16
    add I3, I3, I0
    add I3, I3, I1
    mod I3, I3, I0
    substr S0, S15, I3, 1
    ne S0, "*", check
    inc I2
check:
    substr S0, S15, I1, 1
    eq S0, "*", check_alive

# If eq 3, put a star in else a space
check_dead:
    eq I2, 3, star
    branch space

check_alive:
    lt I2, 2, space
    gt I2, 3, space
    branch star

space:
    concat S1, " "
    branch iter_done
star:
    concat S1, "*"
iter_done:
    inc I1
    lt I1, I0, genloop
done:
    set S15, S1
    popi
    ret

# S15 has the incoming string, S0 is scratch
dump:
    saveall
    dlfunc P0, P1, "move", "iii"
    set I5, 0
    set I6, 0
    invoke
    restoreall

    if I12, dumpend
    save I0
    save I1

    saveall
    save I0
    dlfunc P0, P1, "addstr", "it"
    set S5, "Generation: "
    invoke
    restore I0

    dlfunc P0, P1, "addstr", "it"
    set S5, I0
    invoke

    dlfunc P0, P1, "refresh", "i"
    invoke
    restoreall


    set I0, 0
    set I1, 14
printloop:
    substr S0, S15, I0, 15

    saveall
    dlfunc P0, P1, "addstr", "it"
    set S5, S0
    invoke

    dlfunc P0, P1, "addstr", "it"
     set S5, "\n"
    invoke
    restoreall

    add I0, I0, 15
    dec I1
    ge I1, 0 printloop
    restore I1
    restore I0
    sleep 1
dumpend:
    ret

[download]

Replies are listed 'Best First'.
Re: Conway's life, with parrot curses
by theorbtwo (Prior) on Dec 06, 2002 at 09:58 UTC

    Hm... when I first read this, I thought it would be some sort of strange poetry on the life of Damian Conway, with colorful (or off-color) parrot curses thrown in...

    Also, a note for those running it: if you don't have curses, this will, of course, die. If you /do/ have curses, but it isn't compatable with the curses that the author has, this will probably die in very strange ways (see nasal demons).

    Warning: Unless otherwise stated, code is untested. Do not use without understanding. Code is posted in the hopes it is useful, but without warranty. All copyrights are relinquished into the public domain unless otherwise stated. I am not an angel. I am capable of error, and err on a fairly regular basis. If I made a mistake, please let me know (such as by replying to this node).

[reply]
      Nasal Demons ?? Feh? Can I issue a 'Please explain' for that one, since the link does not seem to derive anything. Or have I obtusely missed another gag?

[reply]
[reply]

Back to Cool Uses for Perl