home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / scheme / boxer / boxer.lha / grdata.lisp < prev    next >
Encoding:
Text File  |  1993-07-17  |  3.9 KB  |  111 lines
  1. ;; -*- Mode:LISP; Package: BOXER; Base:10.;fonts:cptfont; -*-
  2.  
  3. ;;; (C) Copyright 1985 Massachusetts Institute of Technology
  4. ;;;
  5. ;;; Permission to use, copy, modify, distribute, and sell this software
  6. ;;; and its documentation for any purpose is hereby granted without fee,
  7. ;;; provided that the above copyright notice appear in all copies and that
  8. ;;; both that copyright notice and this permission notice appear in
  9. ;;; supporting documentation, and that the name of M.I.T. not be used in
  10. ;;; advertising or publicity pertaining to distribution of the software
  11. ;;; without specific, written prior permission.  M.I.T. makes no
  12. ;;; representations about the suitability of this software for any
  13. ;;; purpose.  It is provided "as is" without express or implied warranty.
  14. ;;;
  15.  
  16. (defun box-being-told ()
  17.   *BOXER-STATIC-VARIABLES-ROOT*) 
  18.  
  19. (defmethod (graphics-data-box :type) ()
  20.   ':graphics-data-box)
  21.  
  22. (defun make-graphics-data-box ()
  23.   (make-initialized-graphics-data-box ':type ':graphics-data-box))
  24.     
  25. (defun make-initialized-graphics-data-box (&rest init-plist)
  26.  (instantiate-flavor 'graphics-data-box (locf init-plist) t)) 
  27.  
  28. (defmethod (graphics-data-box :graphics-sheet) ()
  29.  graphics-sheet)
  30.  
  31. (defmethod (graphics-data-box :draw-mode) ()
  32.   (graphics-sheet-draw-mode graphics-sheet))
  33.  
  34. (defmethod (graphics-data-box :set-draw-mode) (new-mode)
  35.   (setf (graphics-sheet-draw-mode graphics-sheet) new-mode))
  36.                
  37. (defmethod (graphics-data-box :after :init) (ignore)
  38.   (tell self :export-all-variables))
  39.  
  40. (defmethod (graphics-box :after :init) (ignore)
  41.   (tell self :export-all-variables))              
  42.  
  43. (defmethod (graphics-data-box :before :init) (init-plist)
  44.   (unless (get init-plist ':type)
  45.     (putprop init-plist ':graphics-data-box ':type)))
  46.  
  47. (DEFMETHOD (graphics-data-BOX :COPY) ()
  48.   (LET ((NEW-BOX (MAKE-INSTANCE 'graphics-data-BOX))
  49.     (BOX-STREAM (MAKE-BOX-STREAM SELF)))
  50.     (TELL NEW-BOX :SET-CONTENTS-FROM-STREAM BOX-STREAM T)
  51.     (WHEN (NOT-NULL PORTS)
  52.       (PUSH (CONS SELF NEW-BOX) .LINK-TARGET-ALIST.))
  53.     (tell new-box :export-all-variables)
  54.     NEW-BOX))
  55.  
  56. (defmethod (graphics-data-box :before :set-flavor) (new-flavor)
  57.   (when (eq new-flavor 'graphics-box)
  58.     (convert-screen-objs 'graphics-screen-box)
  59. ;    (dolist (screen-obj (get-all-screen-objs self))
  60. ;      (unless (eq (tell screen-obj :box-type) :port-box)
  61. ;      (tell screen-obj :set-box-type ':graphics-box)))
  62.     (tell self :modified)
  63.     (if (null graphics-sheet)
  64.     (setq graphics-sheet (MAKE-GRAPHICS-SHEET (CADR DISPLAY-STYLE-LIST)
  65.                           (CADDR DISPLAY-STYLE-LIST)
  66.                           SELF))
  67.     (tell self :set-fixed-size
  68.           (drawing-width graphics-sheet)
  69.           (drawing-height graphics-sheet)))))
  70.  
  71. ;(defmethod (graphics-data-box :after :init-self-from-old-instance) (old-instance)
  72.   ;(convert-screen-objs 'screen-box)
  73.  ; (dolist (row (tell self :rows))
  74.   ;  (tell row :modified))
  75.   ;(redisplay-box self))
  76.  
  77. (defmethod (graphics-data-box :bit-array) ()
  78.   (graphics-sheet-bit-array graphics-sheet))
  79.  
  80. (defmethod (graphics-data-box :graphics-sheet) ()
  81.   graphics-sheet)
  82.  
  83. (defmethod (graphics-data-box :bit-array-wid) ()
  84.   (graphics-sheet-draw-wid graphics-sheet))
  85.  
  86. (defmethod (graphics-data-box :bit-array-hei) ()
  87.   (graphics-sheet-draw-hei graphics-sheet))
  88.  
  89. (defmethod (graphics-data-box :graphics-sheet-size) ()
  90.   (values (graphics-sheet-draw-wid graphics-sheet)
  91.       (graphics-sheet-draw-hei graphics-sheet)))
  92.  
  93. (defmethod (graphics-data-box :clear-box) ()
  94.   (tv:%draw-rectangle (graphics-sheet-draw-wid graphics-sheet)
  95.               (graphics-sheet-draw-hei graphics-sheet)
  96.               0
  97.               0
  98.               tv:alu-andca
  99.               ((Xaphics-sheet-bit-array graphics-sheet)))
  100.  
  101. (defmethod (graphics-data-box :clearscreen) ()
  102.   (tell self :clear-box)
  103.   (dolist (turtle (graphics-sheet-object-list graphics-sheet))
  104.     (if (tell turtle :shown-p) (tell turtle :draw))))
  105.  
  106. (defmethod (graphics-box :object-list) ()
  107.   (graphics-sheet-object-list graphics-sheet))
  108.  
  109. (defmethod (graphics-data-box :object-list) ()
  110.   (graphics-sheet-object-list graphics-sheet))
  111.