;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;                                COMPATIBILITE                                ;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(unless (boundp '#:window:all-windows)
        (defvar #:window:all-windows))
(unless (boundp '#:window:current-window)
        (defvar #:window:current-window))
(unless (boundp '#:window:current-keyboard-focus-window)
        (defvar #:window:current-keyboad-focus-window))
(unless (boundp '#:graph-env:current-graph-env)
        (defvar #:graph-env:current-graph-env))
(unless (boundp '#:graph-env:main-graph-env)
        (defvar #:graph-env:main-graph-env))
(unless (boundp '#:window:prologuep)
        (defvar #:window:prologuep))
(unless (boundp '#:bitmap:xmax)
        (defvar #:bitmap:xmax 1024))
(unless (boundp '#:bitmap:ymax)
	(defvar #:bitmap:ymax 1024))

(unless (boundp 'errnotimplemented)
        (defvar errnotimplemented
          #- #:system:foreign-language "Fonction non implemente'"
          #+ #:system:foreign-language "not yet implemented"))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;                               COMPATIBILITE                                 ;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(dmd to-display (cmd display . larg)
     `(let ((f (getfn (#:display:package display) ,cmd ())))
        (unless f
                (error
                 'to-display 'errudf (symbol #:sys-package:bitmap ,cmd)))
        (funcall f ,@larg)))

(dmd to-bitmap (cmd . larg)
     `(let ((f (getfn #:sys-package:bitmap ,cmd ())))
           (unless f
                   (error
                     'to-bitmap 'errudf (symbol #:sys-package:bitmap ,cmd)))
           (funcall f ,@larg)))

(dmd get-bitmap (var)
     `(symeval (getsymb #:sys-package:bitmap ,var ())))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;                            COMPATIBILITE                                    ;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(de #:display:bitprologue (display)
    (let ((#:display:current-display display))
      (to-display 'bitprologue display)
      (#:display:xmax display
                      (symeval (getsymb (#:display:package display) 'xmax)))
      (#:display:ymax display
                      (symeval (getsymb (#:display:package display) 'ymax)))
      (#:display:prologuep display #:window:prologuep)
      (#:display:window display #:window:current-window)
      (#:display:windows display #:window:all-windows)
      (#:display:graph-env display #:graph-env:current-graph-env)
      (#:display:main-graph-env display #:graph-env:main-graph-env)
      (#:display:keyboard-focus-window display
                                       #:window:current-keyboard-focus-window)
      ))

(de #:display:bitepilogue (display)
    (to-display 'bitepilogue display)
    (setq #:window:all-windows ())
    (setq #:window:current-window ())
    (setq #:window:current-keyboard-focus-window ())
    (setq #:graph-env:main-graph-env ())
    (setq #:graph-env:current-graph-env ()) 
    (#:display:prologuep display #:window:prologuep))

(de #:display:bitmap-save (display)
    (send 'bitepilogue display))

(de #:display:bitmap-restore (display)
    (send 'bitprologue display))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(de #:display:bitmap-refresh (display)
    (to-display 'bitmap-refresh display))

(de #:display:bitmap-flush (display)
    (to-display 'bitmap-flush display))

(de #:display:bitmap-sync (display)
    (to-display 'bitmap-flush display))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(de #:display:current-display (display)
    (setq #:bitmap:name (#:display:name display))
    (setq #:sys-package:bitmap (#:display:package display))
    (set (getsymb #:sys-package:bitmap 'xmax) (#:display:xmax display))
    (set (getsymb #:sys-package:bitmap 'ymax) (#:display:ymax display))
    (setq #:window:prologuep (#:display:prologuep display))
    (setq #:window:all-windows (#:display:windows display))
    (setq #:window:current-window (#:display:window display))
    (setq #:graph-env:main-graph-env (#:display:main-graph-env display))
    (setq #:graph-env:current-graph-env (#:display:graph-env display))
    (setq #:window:current-keyboard-focus-window
          (#:display:keyboard-focus-window display)))

(de #:display:prin (d)
    (princn #/#)
    (princn #/<)
    (prin (#:display:package d))
    (princn #\sp)
    (prin (#:display:name d))
    (princn #\sp)
    (prin (#:display:device d))
    (princn #/>))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(de #:display:standard-roman-font (display)
    (error 'standard-roman-font errnotimplemented ()))

(de #:display:standard-bold-font (display)
    (error 'standard-bold-font errnotimplemented ()))

(de #:display:large-roman-font (display)
    (error 'large-roman-font errnotimplemented ()))

(de #:display:small-roman-font (display)
    (error 'small-roman-font errnotimplemented ()))

(de #:display:standard-background-pattern (display)
    (error 'standard-background-pattern errnotimplemented ()))

(de #:display:standard-foreground-pattern (display)
    (error 'standard-foreground-pattern errnotimplemented ()))

(de #:display:standard-medium-gray-pattern (display)
    (error 'standard-medium-gray-pattern errnotimplemented ()))

(de #:display:standard-light-gray-pattern (display)
    (error 'standard-light-gray-pattern errnotimplemented ()))

(de #:display:standard-dark-gray-pattern (display)
    (error 'standard-dark-gray-pattern errnotimplemented ()))

(de #:display:standard-lelisp-cursor (display)
    (error 'standard-lelisp-cursor errnotimplemented ()))

(de #:display:standard-gc-cursor (display)
    (error 'standard-gc-cursor errnotimplemented ()))

(de #:display:standard-busy-cursor (display)
    (error 'standard-busy-cursor errnotimplemented ()))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(de #:display:create-window (display win)
    (to-display 'create-window display win))

(de #:display:create-subwindow (display win)
    (to-display 'create-subwindow display win))

(de #:display:current-window (display win)
    (to-display 'current-window display win))  

(de #:display:uncurrent-window (display win)
    (to-display 'uncurrent-window display win))

(de #:display:modify-window (display win le to wi he ti hi vi)
    (to-display 'modify-window display win le to wi he ti hi vi))

(de #:display:update-window (display win le to wi he)
    (to-display 'update-window display win le to wi he))

(de #:display:kill-window (display win)
    (to-display 'kill-window display win))

(de #:display:pop-window (display win)
    (to-display 'pop-window display win))

(de #:display:move-behind-window (display win1 win2)
    (to-display 'move-behind-window display win1 win2))

(de #:display:current-keyboard-focus-window (display win)
    (to-display 'current-keyboard-focus-window display win))

(de #:display:uncurrent-keyboard-focus-window (display win)
    (to-display 'uncurrent-keyboard-focus-window display win))

(de #:display:find-window (display x y)
    (to-display 'find-window display x y))

(de #:display:map-window (display win :x :y :lx :ly)
    (to-display 'map-window display win :x :y :lx :ly))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(de #:display:event-mode (display mode)
    (to-display 'event-mode display #:mouse:event-mode))

(de #:display:flush-event (display)
    (to-display 'flush-event display))

(de #:display:eventp (display)
    (to-display 'eventp display))

(de #:display:read-event (display event)
    (to-display 'read-event display event))

(de #:display:peek-event (display event)
    (to-display 'peek-event display event))

(de #:display:read-mouse (display event)
    (to-display 'read-mouse display event))

(de #:display:add-event (display event)
    (to-display 'add-event display event))

(de #:display:grab-event (display window)
    (to-display 'grab-event display window))

(de #:display:ungrab-event (display)
    (to-display 'ungrab-event display))

(de #:display:itsoft-event (display)
    (to-display 'itsoft-event display #:mouse:event)
    #:mouse:event)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(de #:display:clear-graph-env (display ge)
    (to-display 'clear-graph-env display ge))

(de #:display:current-clip (display ge)
    (to-display 'current-clip display ge))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(de #:display:font-max (display ge)
    (to-display 'font-max display ge))

(de #:display:load-font (display ge font)
    (to-display 'load-font display ge font))

(de #:display:current-font (display ge font)
    (to-display 'current-font display ge font))

(de #:display:width-substring (display ge s st le)
    (to-display 'width-substring display ge s st le))

(de #:display:height-substring (display ge s st le)
    (to-display 'height-substring display ge s st le))

(de #:display:x-base-string (display ge s st le)
    (to-display 'x-base-string display ge s st le))

(de #:display:y-base-string (display ge s st le)
    (to-display 'y-base-string display ge s st le))

(de #:display:x-inc-string (display ge s st le)
    (to-display 'x-inc-string display ge s st le))

(de #:display:y-inc-string (display ge s st le)
    (to-display 'y-inc-string display ge s st le))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(de #:display:current-line-style (display ge line-style)
    (to-display 'current-line-style display ge line-style))

(de #:display:line-style-max (display ge)
    (to-display 'line-style-max display ge))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(de #:display:current-pattern (display ge pattern)
    (to-display 'current-pattern display ge pattern))

(de #:display:pattern-max (display ge)
    (to-display 'pattern-max display ge))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(de #:display:current-mode (display ge mode)
    (to-display 'current-mode display ge mode))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(de #:display:draw-cn (display ge x y cn)
    (to-display 'draw-cn display ge x y cn))

(de #:display:draw-substring (display ge x y s st le)
    (to-display 'draw-substring display ge x y s st le))

(de #:display:draw-point (display ge x y)
    (to-display 'draw-point display ge x y))

(de #:display:draw-polymarker (display ge n vx vy)
    (to-display 'draw-polymarker display ge n vx vy))

(de #:display:draw-line (display ge x0 y0 x1 y1)
    (to-display 'draw-line display ge x0 y0 x1 y1))

(de #:display:draw-rectangle (display ge x y w h)
    (to-display 'draw-rectangle display ge x y w h))

(de #:display:draw-polyline (display ge n vx vy)
    (to-display 'draw-polyline display ge n vx vy))

(de #:display:draw-ellipse (display ge x y rx ry)
    (to-display 'draw-ellipse display ge x y rx ry))

(de #:display:draw-circle (display ge x y r)
    (send 'draw-circle display ge x y r ))

(de #:display:fill-rectangle (display ge x y w h)
    (to-display 'fill-rectangle display ge x y w h))

(de #:display:fill-area (display ge n vx vy)
    (to-display 'fill-area display ge n vx vy))

(de #:display:fill-ellipse (display ge x y rx ry)
    (to-display 'fill-ellipse display ge x y rx ry))

(de #:display:fill-circle (display ge x y r)
    (to-display 'fill-circle display ge x y r))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(de #:display:cursor-max (d)
    (error 'cursor-max errnotimplemented ()))

(de #:display:make-cursor (d b1 b2 x y)
    (error 'make-cursor errnotimplemented ()))

(de #:display:current-cursor (d)
    (error 'current-cursor errnotimplemented ()))

(de #:display:move-cursor (d x y)
    (error 'move-cursor errnotimplemented ()))

(de #:display:draw-cursor (display ge x y st)
    (to-display 'draw-cursor display ge x y st))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(de #:display:make-color (d c r g b)
    (error 'make-color errnotimplemented ()))

(de #:display:make-mutable-color (d c r g b)
    (error 'make-mutable-color errnotimplemented ()))

(de #:display:make-name-color (d c s)
    (error 'make-name-color errnotimplemented ()))

(de #:display:kill-color (d c)
    (error 'kill-color errnotimplemented ()))

(de #:display:make-color (d c r g b)
    (error 'make-color errnotimplemented ()))

(de #:display:current-foreground (d c)
    (error 'current-foreground errnotimplemented ()))

(de #:display:current-background (d c)
    (error 'current-background errnotimplemented ()))

(de #:display:red-component (d c r)
    (error 'red-component errnotimplemented ()))

(de #:display:green-component (d c r)
    (error 'green-component errnotimplemented ()))

(de #:display:blue-component (d c r)
    (error 'blue-component errnotimplemented ()))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(de #:display:create-bitmap (display bitmap)
    (to-display 'create-bitmap display bitmap))

(de #:display:create-window-bitmap (display window bitmap)
    (to-display 'create-window-bitmap display window bitmap))

(de #:display:kill-bitmap (display bitmap)
    (to-display 'kill-bitmap display bitmap))

(de #:display:get-bit-line (display bitmap i bitvector)
    (to-display 'get-bit-line display bitmap i bitvector))

(de #:display:set-bit-line (display bitmap i bitvector)
    (to-display 'set-bit-line display bitmap i bitvector))

(de #:display:bmref (display bitmap x y)
    (to-display 'bmref display bitmap x y))

(de #:display:bmset (display bitmap x y bit)
    (to-display 'bmset display bitmap x y bit))

(de #:display:bitblit (display b1 b2 x1 y1 x2 y2 w h)
    (to-display 'bitblit display b1 b2 x1 y1 x2 y2 w h))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(de #:display:create-menu (display menu)
    (to-display 'create-menu display menu))
    
(de #:display:kill-menu (display menu)
    (send 'kill-menu menu))

(de #:display:activate-menu (display menu x y)
    (send 'activate-menu menu x y))

(de #:display:menu-insert-item-list (display menu choix name active)
    (send 'menu-insert-item-list menu choix name active))

(de #:display:menu-insert-item (display menu choix index name active value)
    (send 'menu-insert-item menu choix index name active value))

(de #:display:menu-delete-item-list (display menu choix)
    (send 'menu-delete-item-list menu choix))

(de #:display:menu-delete-item (display menu choix index)
    (send 'menu-delete-item menu choix index))

(de #:display:menu-modify-item-list (display menu choix name active)
    (send 'menu-modify-item-list menu choix name active))

(de #:display:menu-modify-item (display menu choix index name active value)
    (send 'menu-modify-item menu choix index name active value))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;                              DEFAULTS                                       ;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(de #:bitmap:bitprologue ()
    (setq #:window:prologuep t)
    (setq #:window:all-windows ())
    (setq #:window:current-window ())
    (setq #:window:current-keyboard-focus-window ())
    (setq #:graph-env:main-graph-env ())
    (setq #:graph-env:current-graph-env ()))

(de #:bitmap:bitepilogue ()
    (mapc 'kill-window #:window:all-windows)
    (setq #:window:prologuep ())
    (setq #:window:all-windows ())
    (setq #:window:current-window ())
    (setq #:window:current-keyboard-focus-window ())
    (setq #:graph-env:main-graph-env ())
    (setq #:graph-env:current-graph-env ()))

(de #:bitmap:bitmap-refresh ())

(de #:bitmap:bitmap-flush ())

(de #:bitmap:draw-cn (ge x y cn)
    (let ((#:graph-env:arg0 "X"))
      (sset #:graph-env:arg0 0 cn)
      (send 'draw-substring ge x y #:graph-env:arg0 0 1)))

(de #:bitmap:draw-line (ge x0 y0 x1 y1)
    (vset #:graph-env:vx 0 x0)
    (vset #:graph-env:vx 1 x1)
    (vset #:graph-env:vy 0 y0)
    (vset #:graph-env:vy 1 y1)
    (send 'draw-polyline ge 2 #:graph-env:vx #:graph-env:vy))

(de #:bitmap:draw-point (ge x y)
    (vset #:graph-env:vx 0 x)
    (vset #:graph-env:vy 0 y)
    (send 'draw-polymarker ge 1 #:graph-env:vx #:graph-env:vy))

(de #:bitmap:draw-rectangle (ge x y w h)
    (vset #:graph-env:vx 0 x)
    (vset #:graph-env:vx 1 x)
    (vset #:graph-env:vx 2 (add x w))
    (vset #:graph-env:vx 3 (add x w))
    (vset #:graph-env:vx 4 x)
    (vset #:graph-env:vy 0 y)
    (vset #:graph-env:vy 1 (add y h))
    (vset #:graph-env:vy 2 (add y h))
    (vset #:graph-env:vy 3 y)
    (vset #:graph-env:vy 4 y)
    (send 'draw-polyline ge 5 #:graph-env:vx #:graph-env:vy))

(de #:bitmap:fill-rectangle (ge x y w h)
    (vset #:graph-env:vx 0 x)
    (vset #:graph-env:vx 1 x)
    (vset #:graph-env:vx 2 (add x w))
    (vset #:graph-env:vx 3 (add x w))
    (vset #:graph-env:vx 4 x)
    (vset #:graph-env:vy 0 y)
    (vset #:graph-env:vy 1 (add y h))
    (vset #:graph-env:vy 2 (add y h))
    (vset #:graph-env:vy 3 y)
    (vset #:graph-env:vy 4 y)
    (send 'fill-area ge 5 #:graph-env:vx #:graph-env:vy))