gray-stitch.ey

#!./loaded

bin .print "<=" via
{ _ ==s len <=un16 s cat } /string deffd
{ ==divisor _ 0 lt { neg divisor div neg } { divisor div } ? * } '00.0 /idiv deffd

sys .argv len 4 neq { "Usage: ./gray-stitch.ey <μm cross size (try 2000)> <input.ppm (grayscale, gimp .ppm, raw data formatting)> <output.vp3>" die } rep

sys .file ":" via
sys .file "<-" via
"Scale μm: " 1 sys .argv * txt .consume .u 100 div _ ==scale 100 mul txt .produce .u cat dump
2 sys .argv * :open
<-truncating <-creating <-writeonly 3 sys .argv * <-open


{ =*stitch
  scale ==dy
  scale ==dx

  { # ==pos
    0 ==cx 0 ==cy
    { 2 dearray
        dy mul 600 idiv ==ny
        dx mul 600 idiv ==nx
      nx cx sub ny cy sub stitch
      nx =cx ny =cy
    } each
  } /encodeStitches deffst

  [
    { [
        # [   0 0 ]
        [ 600 0 ]
    ] encodeStitches }
    { [
        # [   0   0     ]
        [ 300 100 neg ]
        [ 300 100     ] 
        [ 600   0     ]
    ] encodeStitches }
    { [
        # [   0   0     ]
        [ 300 200 neg ]
        [ 300 200     ] 
        [ 600   0     ]
    ] encodeStitches }
    { [
        # [   0   0     ]
        [ 300 300 neg ]
        [ 300 300     ] 
        [ 600   0     ]
    ] encodeStitches }
    { [
        # [   0   0     ]
        [ 300 300 neg ]
        [ 450 300 neg ]
        [ 150 300     ]
        [ 300 300     ] 
        [ 600   0     ]
    ] encodeStitches }
    { [
        # [   0   0     ]
        [ 300 300 neg ]
        [ 600 300 neg ]
        [   0 300     ]
        [ 300 300     ] 
        [ 600   0     ]
    ] encodeStitches }
    { [
        # [   0   0     ]
        [ 300 300 neg ]
        [ 600 300 neg ]
        [ 600 100 neg ]
        [   0 100     ]
        [   0 300     ]
        [ 300 300     ] 
        [ 600   0     ]
    ] encodeStitches }
    { [
        # [   0   0     ]
        [ 300 300 neg ]
        [ 600 300 neg ]
        [ 600 100 neg ]
        [   0 300 neg ]
        [ 600 300     ]
        [   0 100     ]
        [   0 300     ]
        [ 300 300     ] 
        [ 600   0     ]
    ] encodeStitches }
    { [
        # [   0   0     ]
        [ 300 300 neg ]
        [ 600 300 neg ]
        [ 600 100 neg ]
        [   0 300 neg ]
        [ 400   0     ]
        [ 200   0     ]
        [ 600 300     ]
        [   0 100     ]
        [   0 300     ]
        [ 300 300     ] 
        [ 600   0     ]
    ] encodeStitches }
  ] ==stitches
  
  16000000 :read ==data
  data "\n" str .split =*lines
  0 lines "P6" neq { "Not in P6 format" die } rep
  2 lines " " str .split _ 0 -01 * txt .consume .u ==width
                           1 -01 * txt .consume .u ==height
  3 lines txt .consume .u ==maxValue

  "Width: " width txt .produce .u cat "   Height: " cat height txt .produce .u cat dump
  "MaxValue: " maxValue txt .produce .u cat dump

  "" 4 |lines len range { lines cat "\n" cat } each =*imgData

  0 height range { ==y
    "( " y txt .produce .u cat " / " cat height txt .produce .u cat " )\n" cat sys .out .writeall
    y 2 mod not ==even
    scale even not { neg } rep =dx
    scale =dy

    0 width range { ==x
      y width mul
      even { x } { width x sub 1 sub } ? * add
      3 mul imgData 900 mul maxValue div ==p
      
      [
        { p  75 lt } { 8 stitches * * }
        { p 150 lt } { 7 stitches * * }
        { p 200 lt } { 6 stitches * * }
        { p 250 lt } { 5 stitches * * }
        { p 300 lt } { 4 stitches * * }
        { p 450 lt } { 3 stitches * * }
        { p 600 lt } { 2 stitches * * }
        { p 750 lt } { 1 stitches * * }
        { 1 }        { 0 stitches * * }
      ] conds
    } each

    0 dy stitch
    "\n" sys .out .writeall
    even not =even
  } each
} /produceImage deffd

0 ==xStart 0 ==yStart
0 ==minX 0 ==maxX 0 ==minY 0 ==maxY

{ ""
  [ 10 246 0 ] str .fromArray cat # unknown
  ==data
  list ==collectedData
  {
    stitch data -01 cat =data
    data len 4096 gt {
      data collectedData .append1
      "" =data
    } rep
  } produceImage
  "" collectedData { cat } each data cat
} /rawStitchContent deffst

< xStart ==x yStart ==y
  { ==dy ==dx
    dx 128 neg gt dx 128 lt and
    dy 128 neg gt dy 128 lt and and {
      [ dx dy ] str .fromArray
    } {
      [ 128 1 ] str .fromArray dx <=sn16 dy <=sn16 [ 128 2 ] str .fromArray cat
    } ? *
    x dx add =x
    y dy add =y
    x minX lt { x =minX } rep
    y minY lt { y =minY } rep
    x maxX gt { x =maxX } rep
    y maxY gt { y =maxY } rep
  }
> -- /stitch deffd

rawStitchContent { }_ =*rawStitchContent
maxX minX sub ==xSize
maxY minY sub ==ySize

{ ""
  minX neg xSize 2 div sub 100 mul <=sn32 # start X-offset
  minY neg ySize 2 div sub 100 mul neg <=sn32 # start Y-offset
  [ 1 0 ] str .fromArray cat # unknown
  0 <=sn8 # red
  0 <=sn8 # green
  0 <=sn8 # blue
  [ 0 0 0 5 40 ] str .fromArray cat # unknown
  "1234" string # unknown numeric string
  "Color name" string # unknown what values are acceptable
  "Thread type" string # "Robison-Anton Rayon 40" in all generated files
  0 <=sn32 # start x offset for next color
  0 <=sn32 # start y offset for next color
  "\0" string
  rawStitchContent _ len "" -01 <=un32 -01 cat cat
} /stitchContent deffd

{ ""
  0 <=sn32 # origin X
  0 <=sn32 # origin Y
  [ 0 0 0 ] str .fromArray cat # unknown
  xSize 100 mul 2 div <=sn32
  ySize 100 mul 2 div <=sn32
  xSize 100 mul 2 div neg <=sn32
  ySize 100 mul 2 div neg <=sn32
  xSize 100 mul <=sn32
  ySize 100 mul <=sn32
  "Yet another comment" string
  25700 <=un16 # unknown
  4096 <=un32 # unknown
  0 <=un32 # unknown
  0 <=un32 # unknown
  4096 <=un32 # unknown
  "xxPP
\0" cat # stitch section header
  "Yet another vendor string" string
  1 <=un16 # number of colors
  [ 0 5 0 ] str .fromArray cat # unknown
  stitchContent _ len 1 add "" -01 <=un32 -01 cat cat
} /innerContent deffd

{ ""
  "File comments go here (or don't)" string
  xSize 100 mul 2 div <=sn32
  ySize 100 mul 2 div <=sn32
  xSize 100 mul 2 div neg <=sn32
  ySize 100 mul 2 div neg <=sn32
  [ 0 0 122 134 ] str .fromArray cat # TODO thread length (ahem)
  [ 0 ] str .fromArray cat # unknown
  1 <=un8 # number of colors
  [ 12 0 1 0 3 0 ] str .fromArray cat # unknown
  innerContent _ len "" -01 <=un32 -01 cat cat
} /mainContent deffd

"%vsm%\0"
"Stratum 0 Embroidery Hack\0" string
[ 0 2 0 ] str .fromArray cat # unknown
mainContent _ len "" -01 <=un32 -01 cat cat
<-writeall

:close
<-close

# vim: syn=elymas