(de createscreen (devname handle name width height) (setq name (cdddr (strtok (car devname) "/"))) (setq width (cdr name)) (setq height (cdr width)) (setq name (car name)) (setq width (car width)) (setq height (car height)) (cond ((nilp name) (setq name '"defaultscreen"))) (cond ((nilp width) (setq width "640"))) (cond ((nilp height) (setq height "480"))) (setq devname (strcat "/dev/screen/mono/" name "/" width "/" height)) (setq width (strtol width 10) height (strtol height 10)) (set (quality name '"width") width) (set (quality name '"height") height) (set (quality name '"ix") 0) (set (quality name '"iy") 0) (set (quality name '"buffer") (new (mul width height))) (set (quality name '"hscreen") handle) (set (quality name '"hwnd") hwnd) devname ) ;* readscreen takes a handle to a graphics screen a buffer a xy address ;* and bytes of values to read. The pixel values from the graphics buffer ;* at the point of xy are returned up to bytes. ;* FIX: buffers should be checked (de readscreen (handle buffer xy bytes hdc i x y name hwnd) (setq name (cdddr (strtok (car handle) "/"))) (setq handle (cdr name) name (car name)) (setq y (div xy (eval (quality name '"width")))) (setq x (mod xy (eval (quality name '"width")))) (cond ((nilp buffer) (setq buffer (car handle)))) (cond ((nilp bytes) (setq bytes (car (cdddr handle) )))) (cond ((nilp bytes) (setq bytes 1))) (setq hwnd (eval (quality name '"hwnd"))) (setq hdc (GetDC hwnd)) (setq i 0) (while (lt i bytes) (cond ((gt (GetPixel hdc x y) 0) (iasgn (add buffer i) 1 255) ) (t (iasgn (add buffer i) 1 0) ) ) (setq x (add x 1)) (setq i (add i 1)) ) (ReleaseDC hwnd hdc) bytes ) ;* writescreen takes a handle to a graphics screen a buffer a xy address ;* and bytes of pixel values to write. The pixel values are written to the graphics buffer ;* at the point of xy 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. ;* if this is done, then this action should either rework the character buffer or ;* cause a further action to rework the character buffer ;* FIX: buffers should be checked. (de writescreen (handle buffer xy bytes hdc i x y name hwnd) (setq name (cdddr (strtok (car handle) "/"))) (setq handle (cdr name) name (car name)) (setq y (div xy (eval (quality name '"width")))) (setq x (mod xy (eval (quality name '"width")))) (cond ((nilp buffer) (setq buffer (car handle)))) (cond ((nilp bytes) (setq bytes (strtol (car (cdddr handle) 10))))) (cond ((nilp bytes) (setq bytes 1))) (setq hwnd (eval (quality name '"hwnd"))) (setq hdc (GetDC hwnd)) (setq i 0) (while (lt i bytes) (SetPixel hdc x y (RGB 0 (deref (add buffer i) 1) 0)) (setq x (add x 1)) (cond ((gt x (eval (quality name '"width"))) (setq x 0) (setq y (add y 1)) (cond ((gt y (eval (quality name '"height"))) (setq y 0) ) ) ) ) (setq i (add i 1)) ) (ReleaseDC hwnd hdc) bytes )