(FILECREATED "21-Jul-85 16:09:00" {ERIS}<LISPUSERS>ROTATEBM.;2
 5277   

      changes to:  (FNS ROTATEBM SIGN TEXTURELINE \TEXTURELINE)
		   (VARS ROTATEBMCOMS)

      previous date: "21-Jul-85 16:03:54" {ERIS}<LISPUSERS>ROTATEBM.;1)


(* Copyright (c) 1985 by Xerox Corporation. All rights reserved.)

(PRETTYCOMPRINT ROTATEBMCOMS)

(RPAQQ ROTATEBMCOMS
 ((FNS SIGN TEXTURELINE \TEXTURELINE ROTATEBM)))
(DEFINEQ

(SIGN

  (LAMBDA (X)                                                (* kbr: "21-Jul-85 16:02")

    (
COND

      ((
IGREATERP
 X 0)
	1)
      ((
EQ
 X 0)
	0)
      (T -1))))

(TEXTURELINE

  (LAMBDA (SOURCE U1 V1 U2 V2 DEST X1 Y1 WIDTH)              (* kbr: "21-Jul-85 16:02")

    (
PROG
 (U DELTAU UBUCKET DU ULIMIT V DELTAV VBUCKET DV VLIMIT X DELTAX XBUCKET DX XLIMIT Y DSTEP)
          (
SETQ
 DU (
IDIFFERENCE
 U2 U1))
          (
SETQ
 DV (
IDIFFERENCE
 V2 V1))
          (
SETQ
 DX (
SUB1
 WIDTH))
          (
SETQ
 DELTAU (SIGN
 DU))
          (
SETQ
 DELTAV (SIGN
 DV))
          (
SETQ
 DELTAX (SIGN
 DX))
          (
SETQ
 DU (IABS DU))
          (
SETQ
 DV (IABS DV))
          (
SETQ
 DX (IABS DX))
          (
SETQ
 DSTEP (
IMAX
 DU DV DX))
          (
SETQ
 UBUCKET (
IQUOTIENT
 DU 2))
          (
SETQ
 VBUCKET (
IQUOTIENT
 DV 2))
          (
SETQ
 XBUCKET (
IQUOTIENT
 DX 2))
          (\TEXTURELINE
 SOURCE DEST U1 DELTAU (
IPLUS
 DSTEP (
IQUOTIENT
 DU 2))
			DU U2 V1 DELTAV (
IPLUS
 DSTEP (
IQUOTIENT
 DV 2))
			DV V2 X1 DELTAX (
IPLUS
 DSTEP (
IQUOTIENT
 DX 2))
			DX
			(
IPLUS
 X1 WIDTH -1)
			Y1 DSTEP))))

(\TEXTURELINE

  (LAMBDA (SOURCE DEST U DELTAU UBUCKET DU ULIMIT V DELTAV VBUCKET DV VLIMIT X DELTAX XBUCKET DX 
		  XLIMIT Y DSTEP)                            (* kbr: "21-Jul-85 16:02")

    (
PROG
 (UCLIP VCLIP XCLIP)
          (do
                                                (* Dest X DDA. *)

	      (
COND

		((
IGEQ
 XBUCKET DSTEP)
		  (
BITMAPBIT
 DEST X Y (
BITMAPBIT
 SOURCE U V))
		  (
SETQ
 X (
IPLUS
 X DELTAX))
		  (
COND

		    (XCLIP (
RETURN
))
		    ((
EQ
 X XLIMIT)
		      (
SETQ
 XCLIP T)))
		  (
SETQ
 XBUCKET (
IDIFFERENCE
 XBUCKET DSTEP))))
	      (
SETQ
 XBUCKET (
IPLUS
 XBUCKET DX))              (* Source U DDA. *)

	      (
COND

		((
IGEQ
 UBUCKET DSTEP)
		  (
SETQ
 U (
IPLUS
 U DELTAU))
		  (
COND

		    (UCLIP (
RETURN
))
		    ((
EQ
 U ULIMIT)
		      (
SETQ
 UCLIP T)))
		  (
SETQ
 UBUCKET (
IDIFFERENCE
 UBUCKET DSTEP))))
	      (
SETQ
 UBUCKET (
IPLUS
 UBUCKET DU))              (* Source V DDA. *)

	      (
COND

		((
IGEQ
 VBUCKET DSTEP)
		  (
SETQ
 V (
IPLUS
 V DELTAV))
		  (
COND

		    (VCLIP (
RETURN
))
		    ((
EQ
 V VLIMIT)
		      (
SETQ
 VCLIP T)))
		  (
SETQ
 VBUCKET (
IDIFFERENCE
 VBUCKET DSTEP))))
	      (
SETQ
 VBUCKET (
IPLUS
 VBUCKET DV))))))

(ROTATEBM

  (LAMBDA (SOURCE DEST ANGLE)                                (* kbr: "21-Jul-85 16:08")

    (
PROG
 (SWIDTH SWIDTH2 SHEIGHT2 DWIDTH DWIDTH2 DHEIGHT2 DHEIGHT SIN COS AU BU CU AV BV CV U1 V1 U2 
		  V2 DELTAU DELTAV)
          (
SETQ
 SWIDTH (
COND

	      ((
WINDOWP
 SOURCE)
		(
WINDOWPROP
 SOURCE (
QUOTE
 WIDTH)))
	      ((
BITMAPP
 SOURCE)
		(
BITMAPWIDTH
 SOURCE))
	      (T (
\ILLEGAL.ARG
 SOURCE))))
          (
SETQ
 SWIDTH2 (
IQUOTIENT
 SWIDTH 2))
          (
SETQ
 SHEIGHT2 (
IQUOTIENT
 (
COND

				      ((
WINDOWP
 SOURCE)
					(
WINDOWPROP
 SOURCE (
QUOTE
 HEIGHT)))
				      ((
BITMAPP
 SOURCE)
					(
BITMAPHEIGHT
 SOURCE))
				      (T (
\ILLEGAL.ARG
 SOURCE)))
				    2))
          (
SETQ
 DWIDTH (
COND

	      ((
WINDOWP
 DEST)
		(
WINDOWPROP
 DEST (
QUOTE
 WIDTH)))
	      ((
BITMAPP
 DEST)
		(
BITMAPWIDTH
 DEST))
	      (T (
\ILLEGAL.ARG
 DEST))))
          (
SETQ
 DWIDTH2 (
IQUOTIENT
 DWIDTH 2))
          (
SETQ
 DHEIGHT (
COND

	      ((
WINDOWP
 DEST)
		(
WINDOWPROP
 DEST (
QUOTE
 HEIGHT)))
	      ((
BITMAPP
 DEST)
		(
BITMAPHEIGHT
 DEST))
	      (T (
\ILLEGAL.ARG
 DEST))))
          (
SETQ
 DHEIGHT2 (
IQUOTIENT
 DHEIGHT 2))
          (
SETQ
 SIN (
SIN
 ANGLE))
          (
SETQ
 COS (
COS
 ANGLE))
          (
SETQ
 AU COS)
          (
SETQ
 BU SIN)
          (
SETQ
 CU (
FPLUS
 SWIDTH2 (
FTIMES
 (
FMINUS
 DWIDTH2)
					  COS)
			  (
FTIMES
 (
FMINUS
 DHEIGHT2)
				  SIN)))
          (
SETQ
 AV (
FMINUS
 SIN))
          (
SETQ
 BV COS)
          (
SETQ
 CV (
FPLUS
 SHEIGHT2 (
FTIMES
 DWIDTH2 SIN)
			  (
FTIMES
 (
FMINUS
 DHEIGHT2)
				  COS)))
          (
SETQ
 U1 CU)
          (
SETQ
 V1 CV)
          (
SETQ
 U2 (
FPLUS
 (
FTIMES
 AU DWIDTH)
			  CU))
          (
SETQ
 V2 (
FPLUS
 (
FTIMES
 AV DWIDTH)
			  CV))
          (for
 Y from
 0 to
 DHEIGHT
	     do
 (
SETQ
 DELTAU (
FTIMES
 Y BU))
		(
SETQ
 DELTAV (
FTIMES
 Y BV))
		(TEXTURELINE
 SOURCE (
FIXR
 (
FPLUS
 U1 DELTAU))
			     (
FIXR
 (
FPLUS
 V1 DELTAV))
			     (
FIXR
 (
FPLUS
 U2 DELTAU))
			     (
FIXR
 (
FPLUS
 V2 DELTAV))
			     DEST 0 Y DWIDTH)))))
)
(PUTPROPS ROTATEBM COPYRIGHT ("Xerox Corporation" 1985))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (412 5198 (SIGN 422 . 608) (TEXTURELINE 610 . 1639) (\TEXTURELINE 1641 . 2941) (ROTATEBM
 2943 . 5196)))))
STOP