Merge pull request #169 from FolkComputer/dpip/receipt-printer

Add receipt printer driver

virtual-programs/print.folk

@@ -279,6 +279,20 @@ When /someone/ wishes to print program /id/ with /...options/ {
     if {[dict exists $::printjobs $jobid]} {return}
     puts "Wish to print jobid $jobid"
 
+    set code [dict get $options code]
+
+    set receiptMatches [Statements::findMatchesJoining\
+        [list \
+            {/someone/ claims /printer/ is a receipt printer} \
+            {/someone/ claims /printer/ is the default printer} \
+        ] {}]
+    if {[llength $receiptMatches] > 0} {
+        set matchDict [lindex $receiptMatches 0]
+        set printer [dict get $matchDict printer]
+        ::EscPos::printProgram $printer $id $code
+        return
+    }
+
     # find printer & format
     set defaultStatements ""
     if {![dict exists $options printer]} {
@@ -311,7 +325,6 @@ When /someone/ wishes to print program /id/ with /...options/ {
 
     dict set ::printjobs $jobid [list $id $args]
 
-    set code [dict get $options code]
     set ps [programToPs $id $code $format]
 
     # save code and ps to disk

virtual-programs/receipt-printer.folk

@@ -0,0 +1,95 @@
+namespace eval EscPos {
+    proc printProgram {printer id code} {
+        if {[file exists "$::env(HOME)/folk-printed-programs/$id.folk"]} {
+            error "Program $id already exists on disk. Aborting print."
+        }
+        writeFolkFile $id $code
+        writeGeomFile $printer $id
+
+        set matches [Statements::findMatches [list /someone/ claims $printer is at /address/]]
+        set matchDict [lindex $matches 0]
+        if {![dict exists $matchDict address]} { return }
+        set address [dict get $matchDict address]
+
+        set printerSocket [socket $address 9100]
+
+        fconfigure $printerSocket -translation binary -buffering none
+        set template {
+            [init]
+            [tag $id]
+            [feed 1]
+            $id ([clock format [clock seconds] -timezone :America/Denver -format "%a, %d %b %Y, %r"])
+            [feed 2]
+            $code
+            [feed 3]
+            [cut]
+        }
+        puts -nonewline $printerSocket [subst [prepareTemplate $template]]
+        close $printerSocket
+    }
+
+    proc prepareTemplate {template} {
+        set trimmed [lmap line [split $template "\n"] { string trim $line }]
+        set singleLine [join $trimmed ""]
+        return $singleLine
+    }
+
+    proc writeFolkFile {id code} {
+        set folkFile [open "$::env(HOME)/folk-printed-programs/$id.folk" w]
+        puts $folkFile $code
+        close $folkFile
+    }
+
+    proc writeGeomFile {printer id} {
+        set matches [Statements::findMatches [list /someone/ claims $printer has tag geometry /geometry/]]
+        set matchDict [lindex $matches 0]
+        if {![dict exists $matchDict geometry]} { return }
+        set geometry [dict get $matchDict geometry]
+        set geomFile [open "$::env(HOME)/folk-printed-programs/$id.folkgeom" w]
+        puts $geomFile $geometry
+        close $geomFile
+    }
+
+    proc cut {} {
+        return "\x1dV\x0"
+    }
+
+    proc feed n {
+        return [format "\x1b\x64%c" $n]
+    }
+
+    proc init {} {
+        return "\x1b\x40"
+    }
+
+    proc raw number {
+        return [format "%c" $number]
+    }
+
+    proc scaledAprilTag {id scale} {
+        set tagImage [::tagImageForId $id]
+        set tagBits [list]
+        for {set y 0} {$y < 10} {incr y} {
+            for {set i 0 } {$i < $scale} {incr i} {
+                for {set x 0} {$x < 10} {incr x} {
+                    set j [expr {$y * [image_t bytesPerRow $tagImage] + $x}]
+                    set bit [!= [image_t data $tagImage $j] 255]
+                    lappend tagBits {*}[lrepeat $scale $bit]
+                }
+            }
+        }
+        return $tagBits
+    }
+
+    proc tag {id {scale 20}} {
+        set tagImage [::tagImageForId $id]
+        set tagBits [scaledAprilTag $id $scale]
+
+        set width [expr {10 * $scale}]
+        set xL [expr {$width / 8}]   ;# width in bytes (low byte)
+        set yL [expr {$width % 256}] ;# height in lines (low byte)
+        set yH [expr {$width / 256}] ;# height in lines (high byte)
+
+        return "\x1dv0\x03[raw $xL]\x00[raw $yL][raw $yH][binary format B* [join $tagBits ""]]"
+    }
+}