;* textscreen object
;*     char_buffer
;*     textcolor
;*     bkcolor
;*     current_rowcol
;*     pixel_buffer

;* createtextscreen takes a pathname to a text screen and a handle to the 
;* pixel screen
;* FIX: textcolor and background color should be different in the target handle 
;* pixel screen
;* FIX: buffers should be checked 

(de createtextscreen (devname handle name row col textcolor bkcolor screenname)
    (setq screenname (cdddr (strtok (car handle) "/")))
    (setq name (cdddr (strtok (car devname) "/")))
    (setq row (cdr name))
    (setq col (cdr row))
    (setq textcolor (cdr col))
    (setq bkcolor (cdr textcolor))
    (setq name (car name))
    (setq screenname (car screenname))
    (setq row (car row))
    (setq col (car col))
    (setq textcolor (car textcolor))
    (setq bkcolor (car bkcolor))
    (cond ((nilp name) (setq name '"defaultscreen")))
    (cond ((nilp row) (setq row "43")))
    (cond ((nilp col) (setq col "80")))
    (cond ((nilp textcolor) (setq textcolor '"GREEN")))
    (cond ((nilp bkcolor) (setq bkcolor '"BLACK")))
    (setq devname (strcat "/dev/screen/text/" name "/" row "/" col "/" textcolor "/" bkcolor))
    (setq row (strtol row 10) col (strtol col 10))
    (set (quality name '"row") row)
    (set (quality name '"col") col)
    (set (quality name '"irow") 0)
    (set (quality name '"icol") 0)
    (set (quality name '"textcolor") (eval textcolor))
    (set (quality name '"bkcolor") (eval bkcolor))
    (set (quality name '"buffer") (new (mul row col)))
    (set (quality name '"hscreen") handle)
    (set (quality name '"hwnd") (eval (quality screenname '"hwnd")))
    devname
)

;* readtextscreen takes a handle to a text screen a buffer a rowcol address 
;* and bytes of characters to read.  The characters from the character buffer 
;* at the point of rowcol are returned up to bytes.
;* FIX: a write of something that changes a pixel in the grapics area 
;* corresponding to a  character should invalidate that character or those 
;* characters.  It may be that a further read of an invalidated character
;* should simply return the closest characer. Think of it as a ascii art encoding.
;* FIX: buffers should be checked 

(de readtextscreen (handle buffer rowcol bytes i name)
    (setq handle (cdddr (strtok (car handle) "/")))
    (setq name (car handle) handle (cdr handle))

    (cond 
        ((and (nilp rowcol) handle (car handle))
            (setq rowcol (strtol (car handle) 10))
        )
    )
    (cond ((and (nilp bytes) handle (cdar handle)) (setq bytes (strtol (cdar handle) 10))))

    (cond ((nilp rowcol) (setq rowcol 0)))
    (cond ((nilp bytes) (setq bytes 1)))

    (memcpy buffer (add (eval (quality name '"buffer")) rowcol) bytes)
    bytes
)


;* writetextscreen takes a handle to a text screen a buffer a rowcol address 
;* and bytes of characters to write.  The characters are written to the character buffer 
;* at the point of rowcol up to bytes.
;* FIX: buffers should be checked.

(de writetextscreen (handle buffer rowcol bytes textcolor bkcolor i name hwnd hdc)
    (setq handle (cdddr (strtok (car handle) "/")))
    (setq name (car handle) handle (cdr handle))

    (cond 
        ((and (nilp rowcol) handle (car handle))
            (setq rowcol (strtol (car handle) 10))
        )
    )
    (cond ((and (nilp bytes) handle (cdar handle)) (setq bytes (strtol (cdar handle) 10))))

    (cond ((nilp rowcol) (setq rowcol 0)))
    (cond ((nilp bytes) (setq bytes 1)))

    (setq hwnd (eval (quality name '"hwnd")))
    (setq hdc (GetDC hwnd))
    (setq textcolor (eval (quality name '"textcolor")) bkcolor (eval (qaulity name '"bkcolor")))
    (SetBkColor hdc bkcolor)
    (SetTextColor hdc textcolor)

    (memcpy (add (eval (quality name '"buffer")) rowcol) buffer bytes)
    (setq i 0)
    (while (lt i bytes)
        (TextOut hdc (mul CHAR_WIDTH (col rowcol)) (mul CHAR_HEIGHT (row rowcol)) (chr (deref (add buffer i) 1)) 1)
        (setq rowcol (add rowcol 1))
        (setq i (add i 1))
    )
    (ReleaseDC hwnd hdc)
    bytes
)