;;; -*- Mode:LISP; Package:ABUSER; Base:10 -*-

;;; this will cause EH::MAKE-UCODE-ERROR to blow out reading a DTP-TRAP from control tables.
;;; 24-Oct-85 13:25:24 -ed hardebeck

;;; Constraint Frame for Visual Oblisp

(DEFUN MAKE-Oblisp-Frame-BUG ()
   (make-instance
     'tv:constraint-frame
     :PANES
      '((work-pane round-borders-window
		   :SAVE-BITS T
		   :BLINKER-P NIL
		   :LABEL     NIL)
	(title-pane round-borders-window
		    :BLINKER-P NIL
		    :LABEL     (:centered :string "ObLisp" :font cptfontb)
		    :SAVE-BITS T)
	(junk-pane round-borders-window
		   :SAVE-BITS T
		   :BLINKER-P NIL
		   :LABEL     NIL
		   :SAVE-BITS T)
	(menu-pane round-borders-window
		   :BLINKER-P NIL
		   :LABEL     NIL
		   :SAVE-BITS T))
      :CONSTRAINTS
       '((main
	   (WHOLE)
	   ((WHOLE :HORIZONTAL
				 (:EVEN)
				 (DUMMY-NAME11 DUMMY-NAME13)
				 ((DUMMY-NAME11 :VERTICAL
						(0.8s0)
						(title-pane work-pane)
						((title-pane 0.08s0))
						((work-pane :EVEN)))
				  )
				 ((DUMMY-NAME13 :VERTICAL
						(:EVEN)
						(menu-pane junk-pane)
						((menu-pane 0.30s0))
						((junk-pane :EVEN)))
				  )))))))
;;;; Extended Graphics

(defflavor extended-graphics-mixin
	   ()
	   ()
  (:required-flavors tv:essential-window))

(defvar pi-over-2 (// pi 2))
(defvar 3-pi-over-2 (* 3 pi-over-2))
(defvar 2-pi (* 2 pi))

(defmethod (extended-graphics-mixin :draw-round-rect)
	   (width height x y radius &optional (alu tv:char-aluf))
  (let ((right (+ x width))
	(bottom (+ y height))
	(top-center (+ y radius))
	(left-center (+ x radius))
	(bottom-center (- (+ y height) radius))
	(right-center (- (+ x width) radius)))
  (send self :draw-circular-arc left-center top-center radius pi-over-2 pi alu)
  (send self :draw-line x top-center x bottom-center alu)
  (send self :draw-circular-arc left-center bottom-center radius pi 3-pi-over-2 alu)
  (send self :draw-line left-center bottom right-center bottom alu)
  (send self :draw-circular-arc right-center bottom-center radius 3-pi-over-2 0 alu)
  (send self :draw-line right bottom-center right top-center alu)
  (send self :draw-circular-arc right-center top-center radius 0 pi-over-2 alu)
  (send self :draw-line right-center y left-center y alu)))



(defflavor extended-graphics-window
	   ()
	   (extended-graphics-mixin tv:window))


(defflavor round-borders-mixin
	   ((corner-radius 20.))
	   ()
  :gettable-instance-variables
  :settable-instance-variables
  :inittable-instance-variables
  (:default-init-plist :borders nil)
  (:required-flavors extended-graphics-mixin tv:essential-window))

(defmethod (round-borders-mixin :compute-margins) (lm tm rm bm)
  (values (+ lm 2) (+ tm 2) (- rm 2) (- bm 2)))

(defmethod (round-borders-mixin :after :refresh-margins) ()
  (tv:sheet-force-access (self)
    (send self :draw-round-rect (1- tv:width) (1- tv:height) 0 0  corner-radius tv:char-aluf)))

(defflavor round-borders-window
	   ()
	   (round-borders-mixin extended-graphics-window))