(setf *windows01*

'(let ()

(let ((xpos 0)
      (ypos 0)
      (xpos-mem 0)
      (ypos-mem 0))

(defun update-getpt (getpt)
  (set-word 100 0 (next-i getpt 31)))

(defun main ()
  (main-init)
  (setq *i* 0)
  (reset-peek-pt)
  (do ()
      (nil)
      (print-hex 5380 (setq *i* (%+ *i* 1)))
    (let ((ch -1))
      (setf ch (peek-ch))
      (if (%/= ch -1)
          (progn
            (%print 111)
            (%print ch)
            (process-key-event ch)
            (set-peek-pt)))
      (if (new-event-ready)
          (main-dispatch)))))

(defun main-init ()
  (set-cursor 1 xpos-mem ypos-mem))

;;
;; memdiffs for movement on screen
;;

(defconstant *xdiff* 4)
(defconstant *ydiff* 532)

(defconstant *line-len* 133)

(defconstant *max-lines* 54)


;;
;; cursor - routines
;;
;;


(defun set-cursor (v x y)
  (set-byte base_vga (%+ (%+ x y) 1) v))

(defun move-cursor (x0 y0 x1 y1)
  (set-cursor 0 x0 y0)
  (set-cursor 1 x1 y1))


(defun main-dispatch ()
  (let ((ch (new-char))
        (modif (new-modifier)))

    (if (%/= (addr-and modif *setcode*) 0)
        (let ()
          (if (and (%= (addr-and ch 256) 0))
              (let ((xpos1 xpos)
                    (ypos1 ypos)
                    (xpos1-mem xpos-mem)
                    (ypos1-mem ypos-mem))
                (set-byte base_vga (%+ ypos-mem xpos-mem) (addr-and ch 255))
                (if (%< xpos (%- *line-len* 1))
                    (let ()
                      (setq xpos1 (%+ xpos 1))
                      (setq xpos1-mem (%+ xpos-mem *xdiff*)))
                  (let ()
                    (setq xpos1 0)
                    (setq xpos1-mem 0)
                    (setq ypos1 (%+ ypos 1))
                    (setq ypos1-mem (%+ ypos-mem *ydiff*))))
                (move-cursor xpos-mem ypos-mem xpos1-mem ypos1-mem)
                (setq xpos-mem xpos1-mem)
                (setq ypos-mem ypos1-mem)
                (setq xpos xpos1)
                (setq ypos ypos1))
            (let ((xpos-mem-old xpos-mem)
                  (ypos-mem-old ypos-mem))
              (cond ((vk-p ch VK_U_ARROW) (do-vk-up))
                    ((vk-p ch VK_D_ARROW) (do-vk-down))
                    ((vk-p ch VK_L_ARROW) (do-vk-left))
                    ((vk-p ch VK_R_ARROW) (do-vk-right)))
              (move-cursor xpos-mem-old ypos-mem-old xpos-mem ypos-mem)))))

    (print-hex 5320 modif)
    (print-hex 5360 ch)))


(defun vk-p (ch mask)
  (%= (addr-and ch mask) mask))

(defun do-vk-up ()
  (if (%> ypos 0)
      (let ()
        (setq ypos (%- ypos 1))
        (setq ypos-mem (%- ypos-mem *ydiff*)))))

(defun do-vk-down ()
  (if (%< ypos (%- *max-lines* 1))
      (let ()
        (setq ypos (%+ ypos 1))
        (setq ypos-mem (%+ ypos-mem *ydiff*)))))


(defun do-vk-left ()
  (if (%> xpos 0)
      (let ()
        (setq xpos (%- xpos 1))
        (setq xpos-mem (%- xpos-mem *xdiff*)))))


(defun do-vk-right ()
  (if (%< xpos (%- *line-len* 1))
      (let ()
        (setq xpos (%+ xpos 1))
        (setq xpos-mem (%+ xpos-mem *xdiff*)))))


)

(%print 1212)
(%print (p-shiftl 111 2))
(main)
))