;;; -*- Mode:Lisp; Readtable:T; Package:USER; Base:10; Patch-File:T -*- ;;; Patch file for MEDIUM-RESOLUTION-COLOR version 17.1 ;;; Reason: ;;; Change makes color-draw-line sort args properly so it can draw left-to-right. It was only sorting the "x"s! AND changed to COND. ;;; Written 4-Feb-85 17:10:28 by PECANN, ;;; while running on Waiting for Godot from band 2 ;;; with Experimental System 102.50, Experimental Local-File 55.3, Experimental FILE-Server 13.1, Experimental Unix-Interface 5.1, Experimental MagTape 40.6, Experimental ZMail 57.0, Experimental MEDIUM-RESOLUTION-COLOR 17.0, Experimental MICRO-COMPILATION-TOOLS 1.0, NIL Tiger 8.0, Experimental iris 3.0, microcode 729, IRIS. ; From file COLOR.LISP#> QL.VIDEO-DEVICE; LAM3: (10) #10R COLOR#: (COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "COLOR"))) (COMPILER#:PATCH-SOURCE-FILE "SYS: VIDEO-DEVICE; COLOR  " (DEFUN COLOR-DRAW-LINE (X1 Y1 X2 Y2 &OPTIONAL (COLOR 17) (ALU TV:ALU-SETA) (SCREEN COLOR-SCREEN)) "Draw a line from X1, Y1 to X2, Y2 in color COLOR." (COND ((> X1 X2) (SWAPF X1 X2) (SWAPF Y1 Y2))) (TV:PREPARE-SHEET (SCREEN) (LET ((DX (- X2 X1)) (DY (- Y2 Y1)) (PIXEL-ARRAY (TV:SHEET-SCREEN-ARRAY COLOR-SCREEN))) (LET ((DIR-Y (IF (MINUSP DY) -1 1)) (DY (ABS DY))) (COND ((ZEROP DY) (RECTANGLE X1 Y1 (- X2 X1) 1 COLOR ALU)) ((ZEROP DX) (RECTANGLE X1 (MIN Y1 Y2) 1 (- (MAX Y1 Y2) (MIN Y1 Y2)) COLOR ALU)) ((> DX DY) ;X IS LARGER STEP (DO ((X1 X1 (1+ X1)) (REM (TRUNCATE DY 2) (+ REM DY))) ((> X1 X2)) (IF ( REM DX) (SETQ Y1 (+ Y1 DIR-Y) REM (- REM DX))) (AS-2-REVERSE (BOOLE ALU COLOR (AR-2-REVERSE PIXEL-ARRAY X1 Y1)) PIXEL-ARRAY X1 Y1))) (T ;Y IS LARGER STEP (DO ((I 0 (1+ I)) (Y Y1 (+ Y DIR-Y)) (REM (TRUNCATE DX 2) (+ REM DX))) ((> I DY)) (IF ( REM DY) (SETQ X1 (1+ X1) REM (- REM DY))) (AS-2-REVERSE (BOOLE ALU COLOR (AR-2-REVERSE PIXEL-ARRAY X1 Y)) PIXEL-ARRAY X1 Y)))))))) ))