;; -*- Mode:LISP; Package: BOXER; Base:10.;fonts:cptfont; -*-

;;; (C) Copyright 1985 Massachusetts Institute of Technology
;;;
;;; Permission to use, copy, modify, distribute, and sell this software
;;; and its documentation for any purpose is hereby granted without fee,
;;; provided that the above copyright notice appear in all copies and that
;;; both that copyright notice and this permission notice appear in
;;; supporting documentation, and that the name of M.I.T. not be used in
;;; advertising or publicity pertaining to distribution of the software
;;; without specific, written prior permission.  M.I.T. makes no
;;; representations about the suitability of this software for any
;;; purpose.  It is provided "as is" without express or implied warranty.
;;;

(defun box-being-told ()
  *BOXER-STATIC-VARIABLES-ROOT*) 

(defmethod (graphics-data-box :type) ()
  ':graphics-data-box)

(defun make-graphics-data-box ()
  (make-initialized-graphics-data-box ':type ':graphics-data-box))
    
(defun make-initialized-graphics-data-box (&rest init-plist)
 (instantiate-flavor 'graphics-data-box (locf init-plist) t)) 

(defmethod (graphics-data-box :graphics-sheet) ()
 graphics-sheet)

(defmethod (graphics-data-box :draw-mode) ()
  (graphics-sheet-draw-mode graphics-sheet))

(defmethod (graphics-data-box :set-draw-mode) (new-mode)
  (setf (graphics-sheet-draw-mode graphics-sheet) new-mode))
			   
(defmethod (graphics-data-box :after :init) (ignore)
  (tell self :export-all-variables))

(defmethod (graphics-box :after :init) (ignore)
  (tell self :export-all-variables))			  

(defmethod (graphics-data-box :before :init) (init-plist)
  (unless (get init-plist ':type)
    (putprop init-plist ':graphics-data-box ':type)))

(DEFMETHOD (graphics-data-BOX :COPY) ()
  (LET ((NEW-BOX (MAKE-INSTANCE 'graphics-data-BOX))
	(BOX-STREAM (MAKE-BOX-STREAM SELF)))
    (TELL NEW-BOX :SET-CONTENTS-FROM-STREAM BOX-STREAM T)
    (WHEN (NOT-NULL PORTS)
      (PUSH (CONS SELF NEW-BOX) .LINK-TARGET-ALIST.))
    (tell new-box :export-all-variables)
    NEW-BOX))

(defmethod (graphics-data-box :before :set-flavor) (new-flavor)
  (when (eq new-flavor 'graphics-box)
    (convert-screen-objs 'graphics-screen-box)
;    (dolist (screen-obj (get-all-screen-objs self))
;      (unless (eq (tell screen-obj :box-type) :port-box)
;      (tell screen-obj :set-box-type ':graphics-box)))
    (tell self :modified)
    (if (null graphics-sheet)
	(setq graphics-sheet (MAKE-GRAPHICS-SHEET (CADR DISPLAY-STYLE-LIST)
						  (CADDR DISPLAY-STYLE-LIST)
						  SELF))
	(tell self :set-fixed-size
	      (drawing-width graphics-sheet)
	      (drawing-height graphics-sheet)))))

;(defmethod (graphics-data-box :after :init-self-from-old-instance) (old-instance)
  ;(convert-screen-objs 'screen-box)
 ; (dolist (row (tell self :rows))
  ;  (tell row :modified))
  ;(redisplay-box self))

(defmethod (graphics-data-box :bit-array) ()
  (graphics-sheet-bit-array graphics-sheet))

(defmethod (graphics-data-box :graphics-sheet) ()
  graphics-sheet)

(defmethod (graphics-data-box :bit-array-wid) ()
  (graphics-sheet-draw-wid graphics-sheet))

(defmethod (graphics-data-box :bit-array-hei) ()
  (graphics-sheet-draw-hei graphics-sheet))

(defmethod (graphics-data-box :graphics-sheet-size) ()
  (values (graphics-sheet-draw-wid graphics-sheet)
	  (graphics-sheet-draw-hei graphics-sheet)))

(defmethod (graphics-data-box :clear-box) ()
  (tv:%draw-rectangle (graphics-sheet-draw-wid graphics-sheet)
		      (graphics-sheet-draw-hei graphics-sheet)
		      0
		      0
		      tv:alu-andca
		      (graphics-sheet-bit-array graphics-sheet)))
 
(defmethod (graphics-data-box :clearscreen) ()
  (tell self :clear-box)
  (dolist (turtle (graphics-sheet-object-list graphics-sheet))
    (if (tell turtle :shown-p) (tell turtle :draw))))

(defmethod (graphics-box :object-list) ()
  (graphics-sheet-object-list graphics-sheet))

(defmethod (graphics-data-box :object-list) ()
  (graphics-sheet-object-list graphics-sheet))