;;; -*- Mode:Lisp; Readtable:T; Package:USER; Base:10; Patch-File:T -*-
;;; Patch file for MEDIUM-RESOLUTION-COLOR version 17.4
;;; Reason:
;;;  Reverses array subscripts for 2.0 compatibility.
;;; Written 26-Jun-85 09:55:20 by mpg,
;;; while running on Waiting for Godot from band 2
;;; with System 102.149, Local-File 56.9, FILE-Server 13.2, Unix-Interface 5.4, MagTape 40.21, ZMail 57.7, Tiger 20.6, KERMIT 26.20, MEDIUM-RESOLUTION-COLOR 17.3, Experimental Sited 1.0, Experimental window-maker 1.0, Experimental Object Lisp 2.0, Experimental vista 1.0, Experimental IRIS 1.0, microcode 770.



; From file COLOR.LISP#> QL.VIDEO-DEVICE; LAD: (10)
#10R COLOR#:
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "COLOR")))
  (COMPILER#:PATCH-SOURCE-FILE "SYS: VIDEO-DEVICE; COLOR  "

(DEFUN %COLOR-DRAW-CHAR (FONT CHAR X Y COLOR DEVICE)
  (LET ((WIDTH (FONT-RASTER-WIDTH FONT))
	(SCREEN (TV:SHEET-SCREEN-ARRAY DEVICE))
	(HEIGHT (FONT-RASTER-HEIGHT FONT)))
    (DO ((H 0 (1+ H)))
	((> H HEIGHT))
      (DO ((W 0 (1+ W)))
	  ((> W WIDTH))
	(IF (= (FED:FONT-GET-PIXEL FONT CHAR H W) 1)
	    (ASET COLOR SCREEN (+ Y H) (+ X W)))))))

))

; From file COLOR.LISP#> QL.VIDEO-DEVICE; LAD: (10)
#10R COLOR#:
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "COLOR")))
  (COMPILER#:PATCH-SOURCE-FILE "SYS: VIDEO-DEVICE; COLOR  "

(DEFUN PUT-UP-PICT (&OPTIONAL (PICT :10LEAF)
                    &AUX MIN MAX HEIGHT WIDTH SC X0 Y0
                         (SCR (TV:SHEET-SCREEN-ARRAY COLOR-SCREEN)))
  (CLEAR)
  (GRAY-COLOR-MAP)
  (SETQ MIN (CDR (ARRAYDIMS PICT)))
  (SETQ HEIGHT (CAR MIN) WIDTH (CADR MIN))
  (SETQ X0 (TRUNCATE (- (TV:SHEET-WIDTH COLOR-SCREEN) WIDTH) 2)
        Y0 (TRUNCATE (- (TV:SHEET-HEIGHT COLOR-SCREEN) HEIGHT) 2))
  (SETQ MIN COLOR-MAP-ON MAX 0)
  (DO I 0 (1+ I) (>= I HEIGHT)
    (DO J 0 (1+ J) (>= J WIDTH)
      (SETQ MIN (MIN MIN (AREF PICT I J)))
      (SETQ MAX (MAX MAX (AREF PICT I J)))))
  (SETQ SC (// (- MAX MIN) 20.0S0))
  (DO I 0 (1+ I) (>= I HEIGHT)
    (DO J 0 (1+ J) (>= J WIDTH)
      (ASET (FIX (// (- (AREF PICT I J) MIN) SC))
            SCR (+ I X0) (+ J Y0)))))

))