; Le bitmap virtuel pour X-windows
; a re'e'crire completement, ainsi que virbitmap.ll
; $Header: x.ll,v 4.10 89/01/03 17:04:17 duquesno Exp $

(defvar #:sys-package:bitmap '#:bitmap:x)
(defvar #:sys-package:colon #:sys-package:bitmap)

(unless (boundp '#:bitmap:planes) (defvar #:bitmap:planes))

(unless (boundp ':ymax)
	(defvar :xmax 1100)
	(defvar :ymax 800))

; .Section "Implantation du fene↑trage virtuel sur x"

; (defextern-cache t)
(defextern |←XFlush| ())
(defextern |←bitprologue| (t t t t t t))
(defextern |←bitepilogue| ())
(defextern |←create←window| (t fix fix fix fix string fix fix))
(defextern |←modify←window| (fix fix fix fix fix fix fix string fix fix))
(defextern |←find←window| (fix fix t) t)
(defextern |←map←window| (fix fix fix t t))
(defextern |←grab←keyboard| (fix fix))
(defextern |←grab←mouse| (fix fix))
(defextern |←create←subwindow| (t fix fix fix fix fix fix) fix)
(defextern |←pop←window| (fix))
(defextern |←kill←window| (fix))
(defextern |←move←behind←window| (fix fix))
(defextern |←draw←cn| (fix fix fix fix))
(defextern |←draw←substr| (fix fix fix string fix fix))
(defextern |←width←substr| (string fix fix fix) fix)
(defextern |←height←cn| (fix fix) fix)
(defextern |←xinc←substr| (string fix fix fix) fix)
(defextern |←tycleol| (fix fix fix))
(defextern |←load←font| (string) external)
(defextern |←current←font| (fix external))
(defextern |←default←font1| () external)
(defextern |←default←font2| () external)
(defextern |←draw←cursor| (fix fix fix fix))
(defextern |←clear←ge| (fix))
(defextern |←i←peek←mouse| (vector))
(defextern |←i←read←mouse| (vector))
(defextern |←flush←event| ())
(defextern |←set←event←mode| (fix))
(defextern |←eventp| (t) t)
(defextern |←read←mouse| (vector))
(defextern |←set←cur←mode| (fix fix))
(defextern |←set←line←style| (fix fix))
(defextern |←set←clip| (fix fix fix fix fix))
(defextern |←draw←polymarker| (fix fix vector vector))
(defextern |←draw←point| (fix fix fix))
(defextern |←draw←polyline| (fix fix vector vector))
(defextern |←draw←line| (fix fix fix fix fix))
(defextern |←draw←rectangle| (fix fix fix fix fix))
(defextern |←set←cur←pattern| (fix fix))
(defextern |←fill←area| (fix fix vector vector))
(defextern |←fill←rectangle| (fix fix fix fix fix))
#-(memq (system) '(sun ibmrt))
(defextern |←draw←ellipse| (fix fix fix fix fix))
#-(memq (system) '(sun ibmrt))
(defextern |←fill←ellipse| (fix fix fix fix fix))
(defextern |←llreversevideo| () fix)
#|
(defextern |←make←color| (fix fix fix) external)
(defextern |←set←foreground| (external))
(defextern |←set←background| (external))
|#
#+(memq (system) '(ibmrt))
(defextern |←no←cursor| (fix))
#+(memq (system) '(ibmrt))
(defextern |←std←cursor| (fix))
; (defextern-cache ())

(unless (boundp '#:bitmap:x:fuck-window)
	(defvar #:bitmap:bit-reverse-vector)
	(defvar #:bitmap:x:fuck-window))

(de :bitprologue ()
    (unless (getenv "DISPLAY")
            (error ':bitprologue "unbound shell variable" "DISPLAY"))
    (|←bitprologue| ':xmax ':ymax '#:bitmap:planes () 'errx 'error)
    (setq #:graph-env:main-graph-env (#:graph-env:x:make))
    (setq #:graph-env:current-graph-env #:graph-env:main-graph-env)
    (setq #:bitmap:bit-reverse-vector
	  (ifn (eq (|←llreversevideo|) 0)
	       #[#%0000 #%1000 #%0100 #%1100
 	        #%0010 #%1010 #%0110 #%1110
	        #%0001 #%1001 #%0101 #%1101
	        #%0011 #%1011 #%0111 #%1111]
	       #[#%1111 #%0111 #%1011 #%0011
	        #%1101 #%0101 #%1001 #%0001
	        #%1110 #%0110 #%1010 #%0010
	        #%1100 #%0100 #%1000 #%0000]))
    (#:graph-env:x:init-fonts)
    (current-window (setq #:bitmap:x:fuck-window
			  (create-window 'window 0 0 0 0 "" 0 0))))

(de :bitepilogue ()
    (current-window ())
    (kill-window #:bitmap:x:fuck-window)
    (|←bitepilogue|))

(de :bitmap-refresh ()
    (comline "xrefresh"))

(de :bitmap-flush ()
    (|←XFlush|))

(dmd #:bitmap:x:proofed (f w . body)
     `(progn
        (unless (and (vectorp ,w)
                     (#:image:rectangle:window:extend ,w))
                (setq #:window:current-window #:bitmap:x:fuck-window))
        ,.body))

(de #:tty:window:tycleol ()
    (#:bitmap:x:proofed 'tycleol (current-window)
	     (|←tycleol| (#:image:rectangle:window:extend (current-window))
			 (#:image:rectangle:window:tty:cx (current-window))
			 (#:image:rectangle:window:tty:cy (current-window)))))

(de #:tty:window:tyback (cn)
    (#:tty:window:tybs cn)
    (with ((current-mode 0))
          (draw-cn (#:image:rectangle:window:tty:cx (current-window))
                (#:image:rectangle:window:tty:cy (current-window))
                cn)))

; .Section "Les fene↑tres"

(de :create-window (w)
    (let ((le (#:window:left w))
          (to (#:window:top w))
          (wi (#:window:width w))
          (he (#:window:height w))
          (ti (#:image:rectangle:window:title w))
          (hi (#:image:rectangle:window:hilited w))
          (vi (#:image:rectangle:window:visible w))
          (ge (#:graph-env:x:make)))
         (#:image:rectangle:window:graph-env w ge)
         (#:graph-env:clip-w ge wi)
         (#:graph-env:clip-h ge he)
         (#:image:rectangle:window:extend
          w
          (|←create←window| w le to wi he (string ti) hi vi))
         ))

(de :create-subwindow (swin)
    (#:bitmap:x:proofed
     'create-subwindow (#:image:rectangle:window:father swin)
     (let ((ge (#:graph-env:x:make))
          (wi (#:window:width swin))
          (he (#:window:height swin)))
       (#:image:rectangle:window:graph-env swin ge)
       (#:graph-env:clip-w ge wi)
       (#:graph-env:clip-h ge he)
       (#:image:rectangle:window:extend
        swin
        (|←create←subwindow|
         swin
         (#:image:rectangle:window:extend
          (#:image:rectangle:window:father swin))
         (#:window:left swin)
         (#:window:top swin)
         wi
         he
         (#:window:visible swin)))
       swin)))

; .SSection "Ope'rations primitives sur les fene↑tres"

(de #:image:rectangle:window:current-window (win))

(de #:image:rectangle:window:uncurrent-window (win))

(de #:image:rectangle:window:modify-window (win le to wi he ti hi vi)
    (when le (#:window:left win le))
    (when to (#:window:top win to))
    (when wi (#:window:width win wi))
    (when he (#:window:height win he))
    (when ti (#:image:rectangle:window:title win ti))
    (when hi (#:image:rectangle:window:hilited win hi))
    (when vi (#:image:rectangle:window:visible win vi))
    (#:bitmap:x:proofed 'modify-window win
	     (|←modify←window|
	      (#:image:rectangle:window:extend win)
	      (if (or le to) 1 0)
	      (#:window:left win)
	      (#:window:top win)
	      (if (or wi he) 1 0)
	      (#:window:width win)
	      (#:window:height win)
	      (#:image:rectangle:window:title win)
	      (#:image:rectangle:window:hilited win)
	      (#:image:rectangle:window:visible win)))
    (let ((b (#:graph-env:bitmap (#:image:rectangle:window:graph-env win))))
      (when b
            (#:bitmap:w b (#:image:rectangle:w win))
            (#:bitmap:h b (#:image:rectangle:h win))))
    win)

(de #:image:rectangle:window:update-window (win le to wi he)
    (when le (#:window:left win le))
    (when to (#:window:top win to))
    (when wi (#:window:width win wi))
    (when he (#:window:height win he))
    win)

(de #:image:rectangle:window:kill-window (win)
    (when (eq win :grabber)
	  (setq :grabber ()))
    (mapc (lambda (w)
	    (when (eq win (#:window:father w))
		  (kill-window w)))
	  #:window:all-windows)
    (#:bitmap:x:proofed
     'kill-window1 win
     (let ((n (#:image:rectangle:window:extend win)))
       (when (eq (|←kill←window| n) 0)
	     (mapc
	      (lambda (m)
		(#:bitmap:x:proofed
		 'kill-window2 m
		 (when (gt (#:image:rectangle:window:extend m) n)
		       (#:image:rectangle:window:extend
			m 
			(sub1 (#:image:rectangle:window:extend m)))
		       (when (#:graph-env:bitmap
			      (#:window:graph-env m))
			     (#:bitmap:extend
			      (#:graph-env:bitmap
			       (#:window:graph-env m))
			      (#:image:rectangle:window:extend m))))))
	      #:window:all-windows)
	     (setq #:window:all-windows
		   (delq win #:window:all-windows))
	     (#:window:extend win ())))))

(de #:image:rectangle:window:pop-window (win)
    (#:bitmap:x:proofed 'pop-window win
	     (|←pop←window| (#:image:rectangle:window:extend win))))

(de #:image:rectangle:window:move-behind-window (win1 win2)
    (#:bitmap:x:proofed 'move-behind-window1 win1
	     (#:bitmap:x:proofed 'move-behind-window2 win2
		      (|←move←behind←window|
		       (#:image:rectangle:window:extend win1)
		       (#:image:rectangle:window:extend win2)))))

(de :find-window (x y)
    (|←find←window| x y ()))

(de #:image:rectangle:window:map-window (win :x :y :lx :ly)
    (#:bitmap:x:proofed 'map-window win
	     (|←map←window|
	      (#:image:rectangle:window:extend win) :x :y :lx :ly)))

(de #:Image:Rectangle:Window:current-keyboard-focus-window (win)
    (#:bitmap:x:proofed 'focus win
	     (|←grab←keyboard| (#:window:extend win) 1)))

(de #:Image:Rectangle:Window:uncurrent-keyboard-focus-window (win)
    (|←grab←keyboard| 0 0))

(unless (boundp ':grabber)
	(defvar :reread ())
	(defvar :x 0)
	(defvar :y 0)
	(defvar :grabber ()))

(de :parse-event (event)
    (selectq (#:event:code event)
	     (259 (setq :grabber (#:event:window event)))
	     (264
	      (#:event:x event (#:window:left (#:event:window event)))
	      (#:event:y event (#:window:top (#:event:window event)))))
    (#:event:code event
           (or (cassq (#:event:code event)
                      '((256 . ascii-event)
                        (257 . move-event)
                        (258 . drag-event)
                        (259 . down-event)
                        (260 . up-event)
                        (264 . modify-window-event)
                        ;(265 . kill-window-event)
                         (266 . repaint-window-event)
                         ;(267 . release)
                          (268 . enterwindow-event)
                          (269 . leavewindow-event)
                          ;(270 . unmapwindow)
                           ;(271 . keyboard-focus-event)
                            ;(272 . codebidon)
                             ))
               (#:event:code event))))

(de :event-mode (mode) (|←set←event←mode| mode))

(de :eventp () (or :reread (|←eventp| ())))

(de :read-event (event)
    (ifn :reread
        (|←i←read←mouse| event)
        (bltvector event 0 (nextl :reread) 0))
    (:parse-event event))

(de :peek-event (event)
    (ifn :reread
        (|←i←peek←mouse| event)
        (bltvector event 0 (car :reread) 0))
    (:parse-event event))

(de :flush-event ()
    (setq :reread ())
    (|←flush←event|))

(de copyvector1 (vector)
    (let ((res (makevector (vlength vector) ())))
         (bltvector res 0 vector 0)
         res))

(de :add-event (event)
    (newr :reread (copyvector1 event)))

(de :grab-event (window)
    (#:bitmap:x:proofed 'grab-event window
	     (|←grab←mouse| (#:window:extend window) 1))
    (setq :grabber window))

(de :ungrab-event ()
    (|←grab←mouse| 0 0)
    (setq :grabber ()))

(de :itsoft-event (event))

(de :read-mouse (event)
    (|←read←mouse| event))

; .Section "Les environnements graphiques"


(defstruct #:graph-env:x)

(defvar #:sys-package:colon '#:graph-env:x)

; .SSection "Structure des environnements graphiques"

(unless (boundp ':font-name-list)
	(defvar :font-vector #[0 0])
	(defvar :font-name-list ()))

(de :font-max (ge) (sub1 (vlength :font-vector)))

(de :init-fonts ()
    (setq #:graph-env:x:font-vector #[0 0]
	  :font-name-list ())
    (vset #:graph-env:x:font-vector 0 (|←default←font1|))
    (vset #:graph-env:x:font-vector 1 (|←default←font2|)))

(de :current-font (ge font)
    (ifn (and (fixp font) (le font (:font-max ge)))
	 (error 'curent-font 'erroob font)
	 (#:bitmap:x:proofed 'current-font #:window:current-window
		  (|←current←font|
		   (#:image:rectangle:window:extend #:window:current-window) 
		   (vref :font-vector font)))
         (#:graph-env:font ge font)))

(de :load-font (ge font)
    (let ((Xfont (|←load←font| font))
	  (nf (vlength :font-vector)))
      (if (eq Xfont 0)
	  (error 'load-font erroob font)
	(setq :font-vector
	      (bltvector (makevector (add1 nf) (vref :font-vector 0))
			 0 :font-vector 0 nf))
	(vset :font-vector nf Xfont))
      (newr :font-name-list font)
      nf))

(unless (getdef '#:system:restore-core)
	(synonymq #:system:restore-core restore-core))

(unless (getdef '#:system:save-core)
	(synonymq #:system:save-core save-core))

(de save-core (corefile)
    (ifn #:window:prologuep
	 (#:system:save-core corefile)
	 (let ((fonts :font-name-list)
	       (windows #:window:all-windows)
	       (cf (current-font))
	       (cp (current-pattern))
	       (cls (current-line-style))
	       (cw (current-window))
	       (ckf (current-keyboard-focus-window)))
	   (mapc 'check-window-position windows)
	   (mapc (lambda (w)
		   (#:graph-env:bitmap (#:image:rectangle:window:graph-env w)
				       ()))
		 windows)
	   (mapc (lambda (b)
                   (#:bitmap:extend b (#:bitmap:bits b)))
		 #:bitmap:x:all-pixmaps)
	   (bitepilogue)
	   (#:system:save-core corefile)
	   (bitprologue)
	   (mapc 'load-font fonts)
	   (recreate-windows windows)
	   (current-window cw)
	   (current-font cf)
	   (current-pattern cp)
	   (current-line-style cls)
	   (current-keyboard-focus-window ckf)
	   (mapc (lambda (b)
                   (let ((bits (#:bitmap:extend b)))
                     (#:bitmap:extend b
                                      (|←XPixmapSave| (|←rootwindow|) 0 0
                                                      (#:bitmap:w b)
                                                      (#:bitmap:h b)))
                     (#:bitmap:bits b bits)))
                 #:bitmap:x:all-pixmaps)
	   (mapc '#:menu:x:rebuild-menu #:menu:x:all-menus)
	   (bitmap-flush))))

(de restore-core (corefile)
    (ifn #:window:prologuep
	 (#:system:restore-core corefile)
	 (bitepilogue)
	 (#:system:restore-core corefile)))

(de recreate-windows (windows)
    (when windows
	  (let ((father (#:image:rectangle:window:father (car windows))))
	    (if (or (null father) (windowp father))
		(progn
		  (make-window (car windows))
		  (when (null father)
			(add-repaint-event (car windows)))
		  (recreate-windows (cdr windows)))
	      (recreate-windows (nconc1 (cdr windows) (car windows)))))))

(de add-repaint-event (window)
    (let ((event (new 'event)))
      (#:event:window event window)
      (#:event:code event 'repaint-window-event)
      (#:event:x event 0)
      (#:event:y event 0)
      (#:event:w event (#:image:rectangle:w window))
      (#:event:h event (#:image:rectangle:h window))
      (add-event event)))

(de :draw-substring (ge x y s st le)
    (#:bitmap:x:proofed 'draw-substring #:window:current-window
	     (let* ((slen (slen s)) (maxle (sub slen st)))
	       (when (lt st slen)
		     (when (gt le maxle) (setq le maxle))
		     (|←draw←substr|
		      (#:image:rectangle:window:extend
		       #:window:current-window) x y s st le)))))

(de :draw-cn (ge x y cn)
    (#:bitmap:x:proofed 'draw-cn #:window:current-window
          (|←draw←cn|
             (#:image:rectangle:window:extend #:window:current-window)
	     x y cn)))

(de :clear-graph-env (ge)
    (#:bitmap:x:proofed 'clear-graph-env #:window:current-window
	     (|←clear←ge|
	      (#:image:rectangle:window:extend #:window:current-window))))

(de :width-substring (ge s st le)
    (#:bitmap:x:proofed 'width-substring #:window:current-window
	     (|←width←substr|
	      s st le 
	      (if #:window:current-window
		  (#:image:rectangle:window:extend #:window:current-window)
		-1))))

(de :height-substring (ge s st le)
    (#:bitmap:x:proofed 'height-substring #:window:current-window
	     (|←height←cn|
	      0 
	      (if #:window:current-window
		  (#:image:rectangle:window:extend #:window:current-window)
		-1))))

(de :x-base-substring (ge s st le)
    0)

(de :y-base-substring (ge s st le)
    0)

(de :x-inc-substring (ge s st le)
    (#:bitmap:x:proofed 'x-inc-substring #:window:current-window
	     (|←xinc←substr|
	      s st le 
	      (if #:window:current-window
		  (#:image:rectangle:window:extend #:window:current-window)
		-1))))

(de :y-inc-substring (ge s st le) 
    0)

(de :draw-cursor (ge x y st)
    (#:bitmap:x:proofed 'draw-cursor #:window:current-window
	     (|←draw←cursor|
	      (#:image:rectangle:window:extend #:window:current-window)
	      x y (if st 1 0))))

; le graphique


(de :current-clip (ge x y w h)
    (#:bitmap:x:proofed 'clip #:window:current-window
	     (|←set←clip|
	      (#:image:rectangle:window:extend #:window:current-window)
	      x y w h)
	     (#:graph-env:clip-x ge x)
	     (#:graph-env:clip-y ge y)
	     (#:graph-env:clip-w ge w)
	     (#:graph-env:clip-h ge h)))

(de :current-line-style (ge line-style)
    (ifn (and (fixp line-style) (le line-style (:line-style-max ge)))
	 (error 'current-line-style 'erroob line-style)
	 (#:bitmap:x:proofed 'current-line-style #:window:current-window
		  (|←set←line←style|
		   (#:image:rectangle:window:extend #:window:current-window)
		   line-style))
	 (#:graph-env:line-style ge line-style)))

(de :line-style-max (ge) 3)

(de :current-pattern (ge pattern)
    (ifn (and (fixp pattern) (le pattern (:pattern-max ge)))
	 (error 'current-pattern 'erroob pattern)
	 (#:bitmap:x:proofed 'pattern #:window:current-window
			     (|←set←cur←pattern|
			      (#:image:rectangle:window:extend
			       #:window:current-window)
			      pattern)
			     (#:graph-env:pattern ge pattern))))

(de :pattern-max (ge) 4)

#|
(de :current-foreground (ge color)
    (#:bitmap:x:proofed 'foreground-color #:window:current-window
        (|←set←foreground| color)))

(de :current-background (ge color)
    (#:bitmap:x:proofed 'background-color #:window:current-window
        (|←set←background| color)))
|#

(de :current-mode (ge mode)
    (ifn (and (fixp mode) (le mode 15) (ge mode 0))
	 (error 'current-mode 'erroob mode)
	 (#:bitmap:x:proofed 'current-mode #:window:current-window
	  (|←set←cur←mode|
	   (#:image:rectangle:window:extend #:window:current-window) mode)
	  (#:graph-env:mode ge mode))))

; .SSection "Les primitives graphiques"

(de :draw-polyline (ge n vx vy)
    (#:bitmap:x:proofed 'draw-polyline #:window:current-window
	     (|←draw←polyline|
	      (#:image:rectangle:window:extend #:window:current-window)
	      n vx vy)))

(de :draw-line (ge x0 y0 x1 y1)
    (#:bitmap:x:proofed 'draw-line #:window:current-window
	     (|←draw←line|
	      (#:image:rectangle:window:extend #:window:current-window)
	      x0 y0 x1 y1)))

(de :draw-point (ge x0 y0)
    (#:bitmap:x:proofed 'draw-point #:window:current-window
	     (|←draw←point|
	      (#:image:rectangle:window:extend #:window:current-window)
	      x0 y0)))

(de :draw-rectangle (ge x y w h)
    (#:bitmap:x:proofed 'draw-rectangle #:window:current-window
	     (|←draw←rectangle|
	      (#:image:rectangle:window:extend #:window:current-window)
	      x y w h)))

(de :draw-polymarker (ge n vx vy)
    (#:bitmap:x:proofed 'draw-polymarker #:window:current-window
	     (|←draw←polymarker|
	      (#:image:rectangle:window:extend #:window:current-window)
	      n vx vy)))

(de :fill-area (ge n vx vy)
    (#:bitmap:x:proofed
     'fill-area #:window:current-window
         (|←fill←area|
          (#:image:rectangle:window:extend #:window:current-window)
          n vx vy)))
  

(de :fill-rectangle (ge x y w h)
    (#:bitmap:x:proofed 'fill-rectangle #:window:current-window
	     (|←fill←rectangle|
	      (#:image:rectangle:window:extend #:window:current-window)
	      x y w h)))

#+(memq (system) '(sun ibmrt))
(progn
  (defvar :vx)
  (defvar :vy)
  (de :defvectors ()
      (unless :vx
              (setq :vx (makevector 1000 0)
                    :vy (makevector 1000 0)))))

#-(memq (system) '(sun ibmrt))
(de :draw-ellipse (ge x y rx ry) 
    (#:bitmap:x:proofed 'draw-ellipse #:window:current-window
	     (|←draw←ellipse|
	      (#:image:rectangle:window:extend #:window:current-window)
	      x y rx ry)))

#+(memq (system) '(sun ibmrt))
(de :draw-ellipse (ge x y rx ry)
    (:defvectors)
    (let ((n (min 999 (max 10 (add rx ry)))))
      (let ((teta (/ 6.283 n)))
        (for (i 0 1  n ())
             (vset :vx i (add x (fix (* rx (cos (* i teta))))))
             (vset :vy i (add y (fix (* ry (sin (* i teta)))))))
        (draw-polyline (add1 n) :vx :vy)
        (when (eq 6 (current-mode)) (draw-polymarker n :vx :vy)))))


#-(memq (system) '(sun ibmrt))
(de :fill-ellipse (ge x y rx ry) 
    (#:bitmap:x:proofed 'fill-ellipse #:window:current-window
	     (|←fill←ellipse|
	      (#:image:rectangle:window:extend #:window:current-window)
	      x y rx ry)))

#+(memq (system) '(sun ibmrt))
(de :fill-ellipse (ge x y rx ry)
    (:defvectors)
    (let ((n (min 999 (max 10 (add rx ry)))))
      (let ((teta (/ 6.283 n)))
        (for (i 0 1  n ())
             (vset :vx i (add x (fix (* rx (cos (* i teta))))))
             (vset :vy i (add y (fix (* ry (sin (* i teta)))))))
        (fill-area (add1 n) :vx :vy))))


; les cercles sont vraiment trop laids en standard
(unless (boundp ':y-vector)
        (defvar :x-vector (makevector 1024 0))
        (defvar :y-vector (makevector 1024 0)))


(de :fill-circle (ge x y r)
    (:fill-ellipse ge x y r r))

  
(de :draw-circle (ge x y r)
    (let ((xn 0) (yn r) (e 0) (2xn 0) (2yn (add r r)) e1 e2 abse2
          (n 0))
      
      (until (lt yn xn)
             
             (add-point (add x xn) (add y yn) n)
             (add-point (add x xn) (sub y yn) n)
             (add-point (sub x xn) (add y yn) n)
             (add-point (sub x xn) (sub y yn) n)
             
             (add-point (add x yn) (add y xn) n)
             (add-point (add x yn) (sub y xn) n)
             (add-point (sub x yn) (add y xn) n)
             (add-point (sub x yn) (sub y xn) n)
             
             (setq e1 (add e (add1 2xn))
                   e2 (add e (sub 2xn 2yn)))
             (setq abse2 (if (lt e2 0) (sub 0 e2) e2))
             (if (lt abse2 e1)
                 (setq e e2
                       yn (sub1 yn)
                       2yn (sub 2yn 2))
               (setq e e1))
             (setq xn (add1 xn)
                   2xn (add 2xn 2)))
      (draw-polymarker n :x-vector :y-vector)))

(dmd add-point (x y n)
     `(progn
        (vset :x-vector ,n ,x)
        (vset :y-vector ,n ,y)
        (setq ,n (add1 ,n))
        (when (eq ,n 1024)
              (draw-polymarker ,n :x-vector :y-vector)
              (setq ,n 0)))))