################################################################
#
#	File:	  vcsa2pnm.icn
#
#	Subject:  converts a text screen (/dev/vcsaN) to a pnm
#		  image. Hardwired to 80x50, 8x8...
#
#	Author:	  Edrx
#
#	Date:	  
#
################################################################
#
#
#
# Libbables:
#
################################################################

$include "zinc.icn"

global colors			# array de strings tipo " 0 2 2"
global font			# array de 256 arrays de 8 uchars
global hchars
global vchars

procedure readfont(fname)
  fontstr := fname2string(fname)
  font := []
  every i := 0 to 255 do {
    A := []
    cs := fontstr[1+i*8 +: 8]
    every put(A, ord(!cs))
    put(font, A)
  }
end

procedure setcolors()
  colors := [" 0 0 0", " 0 0 2", " 0 2 0", " 0 2 2",
	     " 2 0 0", " 2 0 2", " 2 2 0", " 2 2 2",
	     " 1 1 1", " 0 0 3", " 0 3 0", " 0 3 3",
	     " 3 0 0", " 3 0 3", " 3 3 0", " 3 3 3"]
end

procedure translate_vcsabitrow(vcsaline, row)
  every p := 0 to (hchars-1)*2 by 2 do {

    Char := ord(vcsaline[p+1])
    bitmapbyte := font[Char+1][row+1]

    Attr := ord(vcsaline[p+2])
    bg := iand(Attr, 15*16)/16
    fg := iand(Attr, 15)
    longbg := colors[bg+1]
    longfg := colors[fg+1]

    write((if iand(bitmapbyte, 128) > 0 then longfg else longbg),
	  (if iand(bitmapbyte,  64) > 0 then longfg else longbg),
	  (if iand(bitmapbyte,  32) > 0 then longfg else longbg),
	  (if iand(bitmapbyte,  16) > 0 then longfg else longbg),
	  (if iand(bitmapbyte,   8) > 0 then longfg else longbg),
	  (if iand(bitmapbyte,   4) > 0 then longfg else longbg),
	  (if iand(bitmapbyte,   2) > 0 then longfg else longbg),
	  (if iand(bitmapbyte,   1) > 0 then longfg else longbg))
  }
end

# (eeman "ppm")
# P3 width height maxcolorcomp ...

procedure main(args)
  if *args ~= 2 then
    error("Example of usage: \n" ||
	  "  ~/ICON/vcsa2pnm /home/root/C/math1.8 2 | convert - /tmp/v.png")
  readfont(args[1])
  # readfont("/home/root/C/math1.8")
  setcolors()
  hchars := 80
  vchars := 50
  # vcsastring := fname2string("/dev/vcsa1)
  vcsastring := fname2string("/dev/vcsa" || args[2])
  vcsastring := vcsastring[5:0]       # ignore some headers (rows, cols, ???)
  write("P3 ", hchars*8, " ", vchars*8, " 3")
  every i := 0 to vchars-1 do {
    vcsaline := vcsastring[1+i*hchars*2 +: hchars*2]
    every j := 0 to 7 do {
      translate_vcsabitrow(vcsaline, j)
    }      
  }
end