path: root/virtual-programs/print.folk

set cc [c create]
$cc cflags -I$::env(HOME)/apriltag -Wall -Werror $::env(HOME)/apriltag/libapriltag.a
c loadlib $::env(HOME)/apriltag/libapriltag.so
::defineImageType $cc

$cc code {
    #include <apriltag.h>
    #include <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 ::programToPs {id text {format "letter"} {side "front"}} {
    set margin 36
    set PageWidth 612; set PageHeight 792

    if {$format eq "indexcard"} {
        # front in portrait, back in landscape
        set tagwidth 150; set tagheight 150
        set fontsize 8; set lineheight [expr $fontsize*1.5]
        set margin 36
        if {$side eq "front"} {
            set tagPs [::tagPsForId $id]
            return [subst {
                %!PS
                << /PageSize \[$PageWidth $PageHeight\] >> setpagedevice

                90 rotate

                gsave
                [expr $PageHeight-$tagheight-$margin] [expr -$margin-$tagwidth] translate
                $tagwidth $tagheight scale
                $tagPs
                grestore

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

            }]
        } elseif {$side eq "back"} {
            set linenum 1
            return [subst {
                %!PS
                << /PageSize \[$PageWidth $PageHeight\] >> setpagedevice

                /Courier findfont
                $fontsize scalefont
                setfont
                newpath
                [join [lmap line [split $text "\n"] {
                    set line [string map {"\\" "\\\\"} $line]
                    set ret "$margin [expr $PageHeight-$margin-$linenum*$lineheight] moveto ($line) show"
                    incr linenum
                    set ret
                }] "\n"]
            }]
        }
    }

    set tagwidth 150; set tagheight 150
    set fontsize 12; set lineheight [expr $fontsize*1.5]

    set image [::tagPsForId $id]

    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]]
    }
    for {set i 0} {$i < [llength $lines]} {incr i} { # hard-wrap lines
        lassign [lindex $lines $i] linenum line
        if {$i < 9 && [string length $line] > 50} {
            lset lines $i 1 [string range $line 0 50]
            set lines [linsert $lines $i+1 [list "" [string range $line 51 end]]]
        } elseif {[string length $line] > 73} {
            lset lines $i 1 [string range $line 0 73]
            set lines [linsert $lines $i+1 [list "" [string range $line 74 end]]]
        }
    }

    set lineidx 0
    subst {
        %!PS
        << /PageSize \[$PageWidth $PageHeight\] >> setpagedevice

        /settextcolor {[expr { $side eq "back" ? { 0.4 setgray } : { 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 { $side eq "back" ? {} : [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
    }
}

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

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

    puts "Wish to print jobid $jobid"
    if {[dict exists $::printjobs $jobid]} {return}

    set id [nextId]
    dict set ::printjobs $jobid [list $id $code]

    set format "letter"
    if {[string first {Wish $this prints on an index card} $code] != -1} {
       set format "indexcard"
    }

    set ps [programToPs $id $code $format front]

    # 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
    exec lpr $::env(HOME)/folk-printed-programs/$id.pdf
}
When /someone/ wishes to print program /id/ with code /code/ with job id /jobid/ {
    if {$::thisNode eq "folk-beads" || $::thisNode eq "folk-convivial"} {
        # HACK: Forward the print request to folk0.
        remotePrintRequest "folk0" [list $::thisNode wishes to print program $id with code $code with job id $jobid]
        return
    }

    puts "Wish to print jobid $jobid"
    if {[dict exists $::printjobs $jobid]} {return}

    dict set ::printjobs $jobid [list $id $code]

    set format "letter"
    if {[string first {Wish $this prints on an index card} $code] != -1} {
       set format "indexcard"
    }

    set ps [programToPs $id $code $format front]

    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
    exec lpr $::env(HOME)/folk-printed-programs/$id.pdf
}
When /someone/ wishes to print the back of job id /jobid/ {
    lassign [dict get $::printjobs $jobid] id code

    set format "letter"
    if {[string first {Wish $this prints on an index card} $code] != -1} {
       set format "indexcard"
    }

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

    exec ps2pdf $::env(HOME)/folk-printed-programs/$id-back.ps $::env(HOME)/folk-printed-programs/$id-back.pdf
    exec lpr $::env(HOME)/folk-printed-programs/$id-back.pdf
}