path: root/virtual-programs/print.folk

# Configuring printers
#
# Start by adding a printer to CUPS. You can do this from the Web UI, or declare it using Folk:
#
#     Assert $::thisNode claims printer "printer-name" is a cups printer with url "http://url/ipp/print" driver "everywhere"
#
# Whether the printer was added via Folk or not, you need to let Folk know which formats your printer supports:
#
#     Claim printer my-printer can print double-sided a4 paper
#     Claim printer alt-printer can print single-sided indexcard paper
#
# Use "two-sided" if the printer supports printing on both sides of the paper in a single printing operation.
#
# Lastly, you need to declare a default printer and default paper format:
# (make sure that the default printer supports the default paper format)
#
#     Claim printer my-printer is the default printer
#     Claim paper format a4 is the default paper format

set cc [c create]
$cc cflags -Wall -Werror ;# $::env(HOME)/apriltag/libapriltag.a
c loadlibLd apriltag
::defineImageType $cc

$cc code {
    #include <apriltag/apriltag.h>
    #include <apriltag/tagStandard52h13.h>
    apriltag_family_t *tf = NULL;

    #define emit(...) i += sprintf(&ret[i], __VA_ARGS__)
}

# HACK (osnr): This is used when someone wants to draw an AprilTag
# (often for calibration/cnc preview purposes); I put it here because
# we already have a whole AprilTag family and C compiler object setup
# here. The returned image_t's data needs to be freed by the caller.
$cc proc ::tagImageForId {int id} image_t {
    if (tf == NULL) tf = tagStandard52h13_create();

    image_u8_t* image = apriltag_to_image(tf, id);
    image_t ret = (image_t) { .width = image->width, .height = image->height, .components = 1, .bytesPerRow = image->stride, .data = image->buf };
    free(image); // doesn't free data
    return ret;
}

$cc proc ::tagPsForId {int id} char* {
    if (tf == NULL) tf = tagStandard52h13_create();

    image_u8_t* image = apriltag_to_image(tf, id);

    char* ret = Tcl_Alloc(10000);
    int i = 0;
    emit("gsave\n");
    emit("0 1 translate\n");
    emit("%f %f scale\n", 1.0/image->width, -1.0/image->height);
    for (int row = 0; row < image->height; row++) {
        for (int col = 0; col < image->width; col++) {
            uint8_t pixel = image->buf[(row * image->stride) + col];
            emit("%d setgray ", pixel != 0);
            emit("newpath ");
            emit("%d %d moveto ", col, row); // bottom-left
            emit("%d %d lineto ", col + 1, row); // bottom-right
            emit("%d %d lineto ", col + 1, row + 1); // top-right
            emit("%d %d lineto ", col, row + 1); // top-left
            emit("closepath fill ");
        }
        emit("\n");
    }
    emit("grestore\n");
    ret[i++] = '\0';
    image_u8_destroy(image);
    return ret;
}
$cc compile

proc ::paginate {text maxlines linelen {linelenOverrides {}}} {
    set lines [split $text "\n"]

    for {set i 0} {$i < [llength $lines]} {incr i} {
        # tag each line with its 1-indexed line number
        lset lines $i [list [expr {$i+1}] [lindex $lines $i]]
    }

    set safeline 0
    set firstline 0
    set pages ""
    for {set i 0} {$i < [llength $lines]} {incr i} { # hard-wrap lines
        if {$i - $firstline > $maxlines - 1} {
            set pagelines [lrange $lines $firstline $safeline-1]
            lappend pagelines [list "..." ""]
            lappend pages $pagelines
            set firstline $safeline
        }

        lassign [lindex $lines $i] linenum line
        set max [dict_getdef $linelenOverrides $i $linelen]
        if {[string length $line] > $max} {
            lset lines $i 1 [string range $line 0 $max]
            set lines [linsert $lines $i+1 [list "" [string range $line $max+1 end]]]
        } elseif {$linenum ne ""} {
            set safeline $i
        }
    }

    lappend pages [lrange $lines $firstline end]

    return $pages
}

proc rangeDict {from to val} {
    set res ""
    for {set i $from} {$i < $to} {incr i} {
        lappend res $i $val
    }
    return $res
}

proc ::programToPs {id text {format "letter"}} {
    set defaults {
        margin 36
        fontsize 12
        tagsize {150 150}
        maxcharsOverride {}
    }
    set formats [subst {
        letter {
            pagesize {612 792}
            maxlines 40
            maxchars 72
            maxcharsOverride {[rangeDict 0 8 49]}
        }
        a4 {
            pagesize {595 842}
            maxlines 43
            maxchars 68
            maxcharsOverride {[rangeDict 0 8 46]}
        }
        indexcard {
            fontsize 8
            pagesize {612 792}
            maxlines 44
            maxchars 68
        }
    }]

    # TODO: indexcard layout exceptions

    set params [dict merge $defaults [dict get $formats $format]]
    dict with params {
        lassign $pagesize PageWidth PageHeight
        lassign $tagsize tagwidth tagheight
        set lineheight [expr $fontsize*1.5]

        set image [::tagPsForId $id]

        set pages [paginate $text $maxlines $maxchars $maxcharsOverride]

        set out ""
        set pageidx 0
        foreach lines $pages {
            set lineidx 0
            append out [subst {
                %!PS
                << /PageSize \[$PageWidth $PageHeight\] >> setpagedevice

                /settextcolor {0 setgray} def

                /Courier findfont
                $fontsize scalefont
                setfont
                newpath
                [join [lmap lineinfo $lines {
                    lassign $lineinfo linenum line
                    set line [string map {"\\" "\\\\" ")" "\\)" "(" "\\("} $line]
                    incr lineidx
                    subst {
                        $margin [expr $PageHeight-$margin-$lineidx*$lineheight] moveto
                        0.4 setgray ([format "%- 3s" $linenum]) show settextcolor ($line) show
                    }
                }] "\n"]

                [expr {$pageidx ? {} : [subst {
                  gsave
                  [expr $PageWidth-$tagwidth-$margin] [expr $PageHeight-$tagheight-$margin] translate
                  $tagwidth $tagheight scale
                  $image
                  grestore

                  /Helvetica-Narrow findfont
                  10 scalefont
                  setfont
                  newpath
                  [expr $PageWidth-$tagwidth-$margin] [expr $PageHeight-$tagheight-16-$margin] moveto
                  ($id ([clock format [clock seconds] -timezone :America/New_York -format "%a, %d %b %Y, %r"])) show
                }] }]
                showpage
            }]
            incr pageidx
        }
    }

    return $out
}

if {$::isLaptop} { return }

if {![file exists "$::env(HOME)/folk-printed-programs"]} {
    exec mkdir -p "$::env(HOME)/folk-printed-programs"
}
proc nextId {} {
    try {
        set fp [open "$::env(HOME)/folk-printed-programs/next-id.txt" r]
        set id [string trim [read $fp]]
        close $fp
    } trap {POSIX ENOENT} {} {
        set id 0
    }

    while {[file exists "$::env(HOME)/folk-printed-programs/$id.folk"]} {
        incr id
    }

    set fp [open "$::env(HOME)/folk-printed-programs/next-id.txt" w]
    puts $fp [expr {$id + 1}]
    close $fp

    set id
}

proc remotePrintRequest {remoteNode clause} {
    ::websocket::open "ws://$remoteNode.local:4273/ws" [list apply {{clause sock type msg} {
        if {$type eq "connect"} {
            ::websocket::send $sock text [list apply {{clause} {
                Assert {*}$clause
                after 5000 [list Retract {*}$clause]
                Step
            }} $clause]
            after 10000 [list ::websocket::close $sock]
        }
    }} $clause]
}

When $::thisNode claims printer /name/ is a cups printer with url /url/ driver /driver/ {
    puts "lpadmin -E -p $name -v $url -m $driver"
}

if {![info exists ::printjobs]} {set ::printjobs [dict create]}
When /someone/ wishes to print /code/ with /...options/ {
    set id [nextId]
    Say $::thisNode wishes to print program $id with code $code {*}$options
}
When /someone/ wishes to print program /id/ with /...options/ {
    if {$::thisNode eq "folk-beads" || $::thisNode eq "folk-convivial"} {
        # HACK: Forward the print request to folk0.
        remotePrintRequest "folk0" [list $::thisNode wishes to print progam $id with {*}$options]
        return
    }

    set jobid [dict get $options job-id]
    if {[dict exists $::printjobs $jobid]} {return}
    puts "Wish to print jobid $jobid"

    # find printer & format
    set defaultStatements ""
    if {![dict exists $options printer]} {
        lappend defaultStatements & /someone/ claims printer /printer/ is the default printer
    }

    if {![dict exists $options format]} {
        lappend defaultStatements & /someone/ claims paper format /format/ is the default paper format
    }
    set query {/someone/ claims printer /printer/ can print /sided/ /format/ paper}

    # first try to satisfy given constraints and any remaining defaults
    set results [Statements::findMatchesJoining [list $query $defaultStatements] $options]
    if {$results eq ""} {
        # fall back to solving only for explicit constraints
        set results [Statements::findMatchesJoining [list $query] $options]
    }
    if {$results eq ""} {
        error "Couldn't find a matching printer"
    }

    set results [lindex $results 0]
    dict with results {
        set args [list -P $printer -o media=$format]
        dict set ::printjobs $jobid [list $id $args]

        set code [dict get $options code]
        set ps [programToPs $id $code $format]

        if {$sided eq "single-sided"} {
            lappend args -o page-ranges=1
        }

        # save code and ps to disk
        if {[file exists "$::env(HOME)/folk-printed-programs/$id.folk"]} {
            error "Program $id already exists on disk. Aborting print."
        }
        set fp [open "$::env(HOME)/folk-printed-programs/$id.folk" w]
        puts $fp $code
        close $fp

        set fp [open "$::env(HOME)/folk-printed-programs/$id.ps" w]
        puts $fp $ps
        close $fp

        exec ps2pdf $::env(HOME)/folk-printed-programs/$id.ps $::env(HOME)/folk-printed-programs/$id.pdf
        puts [list lpr {*}$args $::env(HOME)/folk-printed-programs/$id.pdf]
    }
}

When /someone/ wishes to print the back of job-id /jobid/ {
    lassign [dict get $::printjobs $jobid] id args

    puts [list lpr {*}$args -o page-ranges=2 $::env(HOME)/folk-printed-programs/$id.pdf]
}

# legacy syntax
When /someone/ wishes to print /code/ with job id /id/ {
    Say $::thisNode wishes to print $code with job-id $id
}
When /someone/ wishes to print program /id/ with /code/ with job id /id/ {
    Say $::thisNode wishes to print program $id with $code with job-id $id
}
When /someone/ wishes to print the back of job id /jobid/ {
    Say $::thisNode wishes to print the back of job-id $id
}