(DECLARE ;-*-LISP-*- ; ** (c) Copyright 1980 Massachusetts Institute of Technology ** (SPECIAL BRUSH PAINT PAINT-SCREEN PAINT-LIST ALTERNATE-PAINT PAINT-MENU SELECT-MENU AREA-MENU DRAW-MENU BRUSH-LOW-X BRUSH-LOW-Y BRUSH-HIGH-X BRUSH-HIGH-Y BRUSH-CURSOR BRUSH-CURSOR-ARRAY BRUSH-CURSOR-WD-ARRAY BRUSH-PHASE BRUSH-CURSOR-X BRUSH-CURSOR-Y TV-ALU-ANDCA PAINT-CLOCK PAINT-CLOCK-RATE PAINT-DEFAULT-CLOCK-RATE BLINK-CLOCK-RATE PAINT-AREA-Y PAINT-AREA-X PAINT-DISPATCH-ALWAYS MOUSE-TOP-SWITCH MOUSE-TOP-SWITCH-HOLD MOUSE-MID-SWITCH MOUSE-BOT-SWITCH MOUSE-MIDSW-HOLD ;IF T, WILL NOT DISPATCH TO COMMAND UNTIL MIDSW RELEASED MOUSE-BOTSW-HOLD ;SET TO NIL IF BOTSW SEEN OFF. MOUSE-X MOUSE-Y PAINT-MODE PAINT-BRUSH-INHIBIT-BLINK PAINT-CURRENT-MENU PAINT-SAVED-SCREEN PAINT-MODE-PC-PPR PAINT-MODE-STREAM PAINT-CONSOLE-IO-PC-PPR CONSOLE-IO-PC-PPR PAINT-LABELING-PC-PPR PAINT-LABELING-STREAM PAINT-DLC-STATE PAINT-DLC-MODE PAINT-DLC-BASE-X PAINT-DLC-BASE-Y PAINT-SUBC-X PAINT-SUBC-Y PAINT-SUBC-PHASE PAINT-EXIT-FLAG PAINT-ARG-STRING PAINT-TEXT-HOLDING-STRING PAINT-TEXT-FONT PAINT-PICTURE-LIST )) (DECLARE (SPECIAL TV-ALU-NOOP)) ; (SETQ TV-ALU-NOOP '760) ;CAUSES NOOP AGE. (EVAL-WHEN (COMPILE LOAD EVAL) (DEFSTRUCT (PAINT-AREA) PAINT-AREA-NAME ;FOR DEBUGGING AND DISPLAY PAINT-AREA-BIT-ARRAY ;TWO DIMENSIONED ARRAY TO REF AREA (X,Y) NOTE X AND Y MUST ; "ABSOLUTE" (IE BETWEEN PAINT-AREA-X AND THAT PLUS ; PAINT-AREA-X-SIZE, ETC). OF ART-TVB TYPE PAINT-AREA-WD-ARRAY ;ONE DIMENSIONED ARRAY TO REF AREA "WORDWISE". OF ART-32B TYPE, ; WITH 16 ACTIVE BITS PER WORD. NOTE THAT WITHIN WORD BITS ; "GO" FROM LEFT TO RIGHT AS BIT INDEX INCREASES, WHICH IS ; THE OPPOSITE FROM NORMAL LISP MACHINE ART-1B ARRAYS BUT ; WHICH IS THE SAME AS ART-TVB ARRAYS. PAINT-AREA-WD-Y-IDX ;# WDS IN X-LINE OF ABOVE. FOR BALL TV-BUFFER, = 36. PAINT-AREA-X ;LOW X COORD OF AREA WITHIN ARRAY PAINT-AREA-Y ;LOW Y COORD OF AREA WITHIN ARRAY PAINT-AREA-X-SIZE ;X-SIZE IN # BITS PAINT-AREA-Y-SIZE ;Y-SIZE IN # BITS )) (DEFSTRUCT (PAINT-LINE-ITEM) ;ALSO USED FOR CIRCLES PAINT-LINE-HANDLER ;NAMED-STRUCTURE-HANDLER PAINT-LINE-TYPE ;LINE OR CIRCLE PAINT-LINE-STATUS ;IN OR OUT PAINT-LINE-MODE ;0S 1S OR XOR PAINT-LINE-X0 ;CENTER OF CIRCLE OR ENDPOINT OF LINE PAINT-LINE-Y0 PAINT-LINE-X1 ;RADIUS OF CIRCLE OR ENDPOINT OF LINE PAINT-LINE-Y1 ;UNUSED IF CIRCLE ) (DEFSTRUCT (PAINT-PATH) PAINT-PATH-HANDLER ;NAMED-STRUCTURE-HANDLER PAINT-PATH-STATUS PAINT-PATH-MODE PAINT-PATH-POINTS-ARRAY ) (DEFSTRUCT (PAINT-TEXT) PAINT-TEXT-NAME PAINT-TEXT-TEXT PAINT-TEXT-FONT PAINT-TEXT-XPOS PAINT-TEXT-YPOS ) (DEFUN PAINT-INIT NIL (MAKUNBOUND 'PAINT-LABELING-PC-PPR) (MAKUNBOUND 'PAINT-LABELING-STREAM) (MAKUNBOUND 'PAINT-MODE-PC-PPR) (MAKUNBOUND 'PAINT-MODE-STREAM) (MAKUNBOUND 'PAINT-CONSOLE-IO-PC-PPR) (MAKUNBOUND 'PAINT-MENU) (MAKUNBOUND 'SELECT-MENU) (MAKUNBOUND 'AREA-MENU) (MAKUNBOUND 'DRAW-MENU) ) (DEFUN PAINT (&OPTIONAL (INPUT-ROUTINE 'MOUSE) (INITP T)) (PROG (DX DY MOUSE-TOP-SWITCH MOUSE-TOP-SWITCH-HOLD MOUSE-MID-SWITCH MOUSE-MIDSW-HOLD MOUSE-BOT-SWITCH MOUSE-BOTSW-HOLD TEM (MOUSE-X 300) (MOUSE-Y 300) (PAINT-CLOCK 0) (BLINK-CLOCK 0) PAINT-MODE NEW-PAINT-MODE PAINT-BRUSH-INHIBIT-BLINK PAINT-CURRENT-MENU OLD-CONSOLE-IO-PC-PPR PAINT-DISPATCH-ALWAYS PAINT-EXIT-FLAG PAINT-ARG-STRING CH PAINT-TEXT-HOLDING-STRING PAINT-TEXT-FONT PAINT-PICTURE-LIST) (COND ((NOT (ZEROP (SCREEN-PLANE-MASK TV-DEFAULT-SCREEN))) (SETQ TV-DEFAULT-SCREEN SI:TV-CPT-SCREEN) ; (BREAK "TV-DEFAULT-SCREEN not 32 bit." T) )) (COND ((AND (BOUNDP 'PAINT-SCREEN) ;JUST TO UNWEDGE IF YOU LOSE (NOT (EQ TV-DEFAULT-SCREEN PAINT-SCREEN))) ;THIS VERSION ONLY WINS (PAINT-INIT))) ;FOR 32 BIT TV'S (SETQ BRUSH-PHASE NIL) (COND ((NULL (BOUNDP 'PAINT-DEFAULT-CLOCK-RATE)) (SETQ PAINT-DEFAULT-CLOCK-RATE 1))) (SETQ PAINT-CLOCK-RATE PAINT-DEFAULT-CLOCK-RATE) (COND ((NULL (BOUNDP 'BLINK-CLOCK-RATE)) (SETQ BLINK-CLOCK-RATE 200))) (COND ((NULL (BOUNDP 'PAINT-LABELING-PC-PPR)) (SETQ PAINT-LABELING-PC-PPR (TV-DEFINE-PC-PPR 'PAINT-LABELING-PC-PPR (LIST (SCREEN-DEFAULT-FONT TV-DEFAULT-SCREEN)) 'BLINKER-P NIL 'MORE-P NIL)) (SETF (PC-PPR-CHAR-ALUF PAINT-LABELING-PC-PPR) TV-ALU-XOR) (SETF (PC-PPR-ERASE-ALUF PAINT-LABELING-PC-PPR) TV-ALU-NOOP))) (COND ((NULL (BOUNDP 'PAINT-LABELING-STREAM)) (SETQ PAINT-LABELING-STREAM (TV-MAKE-STREAM PAINT-LABELING-PC-PPR)))) (COND ((NULL (BOUNDP 'PAINT-MODE-PC-PPR)) (SETQ PAINT-MODE-PC-PPR (TV-DEFINE-PC-PPR 'PAINT-MODE-PC-PPR (LIST (SCREEN-DEFAULT-FONT TV-DEFAULT-SCREEN)) 'TOP 0 ;THIS IS THE SMALL FROB IN THE UPPER RIGHT THAT 'BOTTOM 12. ;SHOWS THE CURRENT MODE 'RIGHT (SCREEN-X2 TV-DEFAULT-SCREEN) 'LEFT (- (SCREEN-X2 TV-DEFAULT-SCREEN) 120.) 'BLINKER-P NIL 'MORE-P NIL 'END-LINE-FCN 'TV-BACKSPACE 'END-SCREEN-FCN 'TV-HOME)))) (COND ((NULL (BOUNDP 'PAINT-MODE-STREAM)) (SETQ PAINT-MODE-STREAM (TV-MAKE-STREAM PAINT-MODE-PC-PPR)))) (COND ((NULL (BOUNDP 'PAINT-CONSOLE-IO-PC-PPR)) (SETQ PAINT-CONSOLE-IO-PC-PPR (TV-DEFINE-PC-PPR 'PAINT-CONSOLE-IO-PC-PPR (LIST (SCREEN-DEFAULT-FONT TV-DEFAULT-SCREEN)) 'TOP (- (SCREEN-Y2 TV-DEFAULT-SCREEN) 100) 'RIGHT (// (SCREEN-X2 TV-DEFAULT-SCREEN) 2) 'MORE-P NIL)))) (SETQ OLD-CONSOLE-IO-PC-PPR CONSOLE-IO-PC-PPR) (COND ((NOT (EQ CONSOLE-IO-PC-PPR PAINT-CONSOLE-IO-PC-PPR)) (TV-DEACTIVATE-PC-PPR CONSOLE-IO-PC-PPR) (SETQ CONSOLE-IO-PC-PPR PAINT-CONSOLE-IO-PC-PPR) (TV-ACTIVATE-PC-PPR CONSOLE-IO-PC-PPR))) (COND (INITP (TV-CLEAR-SCREEN) (INIT-PAINTS))) (COND ((NULL (BOUNDP 'PAINT-MENU)) (SETQ PAINT-MENU (DEFINE-MENU 'PAINT-MENU '(SELECT-MENU DRAW-MENU AREA-MENU RESTORE-PALLET NORMAL-MODE XOR-MODE EXIT) 'OPTION 'ADVANCING)))) (COND ((NULL (BOUNDP 'SELECT-MENU)) (SETQ SELECT-MENU (DEFINE-MENU 'SELECT-MENU '(SELECT-BRUSH SELECT-PAINT SELECT-ALTERNATE-PAINT PAINT-MENU EXIT) 'OPTION 'ADVANCING)))) (COND ((NULL (BOUNDP 'AREA-MENU)) (SETQ AREA-MENU (DEFINE-MENU 'AREA-MENU '(SAVE-SCREEN RESTORE-SCREEN MOUSE-UPPER-LEFT MOUSE-LOWER-RIGHT DEFINE-AREA SHOW-AREA SELECT-MENU PAINT-MENU EXIT) 'OPTION 'ADVANCING)))) (COND ((NULL (BOUNDP 'DRAW-MENU)) (SETQ DRAW-MENU (DEFINE-MENU 'DRAW-MENU '(DRAW-DIRECT DRAW-LINES-AND-CIRCLES TEXT PAINT-MENU EXIT) 'OPTION 'ADVANCING)))) (SETQ PAINT-TEXT-FONT (SCREEN-DEFAULT-FONT TV-DEFAULT-SCREEN)) (SETQ PAINT-ARG-STRING (MAKE-ARRAY NIL 'ART-STRING 50 NIL '(0))) (PAINT-SELECT-MODE 'NORMAL-MODE) ;INITIALIZE PAINT-ARG-STRING BEFORE THIS (SETQ PAINT-CURRENT-MENU PAINT-MENU) (DISPLAY-MENU PAINT-CURRENT-MENU) (SETQ PAINT-SCREEN TV-DEFAULT-SCREEN) A (COND ((SETQ CH (KBD-TYI-NO-HANG)) (SETQ TEM (LOGAND CH 377)) ;FLUSH BUCKY BITS (COND ((= TEM 201) ;BREAK (SETQ PAINT-EXIT-FLAG T)) ((= TEM 204) ;ESCAPE (KBD-ESC)) ((= TEM 207) ;RUBOUT (COND ((NOT (ZEROP (ARRAY-ACTIVE-LENGTH PAINT-ARG-STRING))) (ARRAY-POP PAINT-ARG-STRING)))) ((< TEM 200) (ARRAY-PUSH PAINT-ARG-STRING TEM))))) ;STORE CHAR (COND (PAINT-EXIT-FLAG (TV-DEACTIVATE-PC-PPR CONSOLE-IO-PC-PPR) (SETQ CONSOLE-IO-PC-PPR OLD-CONSOLE-IO-PC-PPR) (TV-ACTIVATE-PC-PPR CONSOLE-IO-PC-PPR) (RETURN T))) (MULTIPLE-VALUE (DX DY MOUSE-TOP-SWITCH MOUSE-MID-SWITCH MOUSE-BOT-SWITCH) (FUNCALL INPUT-ROUTINE)) (SETQ MOUSE-X (+ MOUSE-X DX) MOUSE-Y (- MOUSE-Y DY)) ;upside-down coordinate system, use -dy (COND ((< MOUSE-X BRUSH-LOW-X) (SETQ MOUSE-X BRUSH-LOW-X)) ((> MOUSE-X BRUSH-HIGH-X) (SETQ MOUSE-X BRUSH-HIGH-X))) (COND ((< MOUSE-Y BRUSH-LOW-Y) (SETQ MOUSE-Y BRUSH-LOW-Y)) ((> MOUSE-Y BRUSH-HIGH-Y) (SETQ MOUSE-Y BRUSH-HIGH-Y))) A1 (COND (MOUSE-TOP-SWITCH (BRUSH-CLEAR) (COND ((< MOUSE-Y PAINT-AREA-Y) (COND ((< MOUSE-X PAINT-AREA-X) ;IN PAINT AREA, SELECT BRUSH (COND ((SETQ TEM (PAINT-SELECT-ARRAY MOUSE-X MOUSE-Y)) ;OR PAINT DIRECTLY (SETQ PAINT TEM))) ) (T (COND ((SETQ TEM (PAINT-SELECT-ARRAY MOUSE-X MOUSE-Y)) (SELECT-BRUSH TEM))))) ) (T (MULTIPLE-VALUE (NIL NEW-PAINT-MODE) ;IN MENU AREA, SELECT FROM MENU, ;OTHERWISE MAYBE COUNT MODE (SELECT-ITEM-FROM-MENU PAINT-CURRENT-MENU MOUSE-X MOUSE-Y (NULL MOUSE-TOP-SWITCH-HOLD))) ; (PAINT-SELECT-MODE NEW-PAINT-MODE) )) (SETQ MOUSE-TOP-SWITCH-HOLD T) (GO A))) (SETQ MOUSE-TOP-SWITCH-HOLD NIL) (COND ((NULL MOUSE-BOT-SWITCH) ;CLEAR THIS IF BOTSW SEEN OFF (SETQ MOUSE-BOTSW-HOLD NIL))) (COND (NEW-PAINT-MODE (COND (MOUSE-MID-SWITCH ;NEW MODE WAITING TO BE SELECTED, SELECT IT. (PAINT-SELECT-MODE NEW-PAINT-MODE) (SETQ NEW-PAINT-MODE NIL) (MENU-CLEAR-CURSOR PAINT-CURRENT-MENU))) (SETQ PAINT-CLOCK -1)) ;JUST BLINK, DONT PAINT (MOUSE-MIDSW-HOLD (COND (MOUSE-MID-SWITCH (SETQ PAINT-CLOCK -1)) ;THAT ONE WAS FOR MODE SELECTION (T (SETQ MOUSE-MIDSW-HOLD NIL))))) (COND ((AND MOUSE-MID-SWITCH PAINT-BRUSH-INHIBIT-BLINK)) ;IN THIS MODE, ;BLINKING CAUSES TOO MUCH LOSSAGE IF PAINTING ((> (SETQ BLINK-CLOCK (1+ BLINK-CLOCK)) (COND (MOUSE-MID-SWITCH (* BLINK-CLOCK-RATE 10.)) ;BLINK SLOWER IF PAINTING, (T BLINK-CLOCK-RATE))) ; BUT DO BLINK OCCAISIONALLY (BRUSH-BLINK MOUSE-X MOUSE-Y) (SETQ BLINK-CLOCK 0) (GO A))) (COND ((< (SETQ PAINT-CLOCK (1+ PAINT-CLOCK)) PAINT-CLOCK-RATE) (GO A))) (SETQ PAINT-CLOCK 0) (COND ((AND (SETQ TEM (GET PAINT-MODE 'PAINT-COMMAND)) (OR MOUSE-MID-SWITCH MOUSE-BOT-SWITCH PAINT-DISPATCH-ALWAYS)) (BRUSH-CLEAR) (FUNCALL TEM))) (GO A) )) (DEFUN PAINT-SELECT-MODE (NEW-MODE &AUX TEM) (PROG NIL (COND ((EQ NEW-MODE PAINT-MODE) ;REALLY SAME MODE. (RETURN NIL))) (COND ((SETQ TEM (GET PAINT-MODE 'PAINT-LEAVING-FCTN)) (FUNCALL TEM))) (COND ((NOT (ZEROP (SETQ TEM (ARRAY-ACTIVE-LENGTH PAINT-ARG-STRING)))) (ADJUST-ARRAY-SIZE PAINT-ARG-STRING TEM) (SETQ PAINT-ARG-STRING (MAKE-ARRAY NIL 'ART-STRING 50 NIL '(0))))) (SETQ PAINT-MODE NEW-MODE) (TV-CLEAR-PC-PPR PAINT-MODE-PC-PPR) (PRINC PAINT-MODE PAINT-MODE-STREAM) (SETQ PAINT-SUBC-PHASE NIL PAINT-SUBC-X NIL) (COND ((SETQ TEM (GET PAINT-MODE 'PAINT-ENTERING-FCTN)) (FUNCALL TEM))) (SETQ PAINT-BRUSH-INHIBIT-BLINK (GET PAINT-MODE 'PAINT-BRUSH-INHIBIT-BLINK)) (SETQ PAINT-DISPATCH-ALWAYS (GET PAINT-MODE 'PAINT-DISPATCH-ALWAYS)) (COND ((SETQ TEM (GET PAINT-MODE 'PAINT-CLOCK-RATE)) (SETQ PAINT-CLOCK-RATE TEM)) (T (SETQ PAINT-CLOCK-RATE PAINT-DEFAULT-CLOCK-RATE))) (SETQ MOUSE-MIDSW-HOLD T))) ;DONT DO ANYTHING UNTIL MIDSW RELEASED (DEFUN PAINT-SELECT-MENU (NEW-MENU) (MENU-CLEAR-CURSOR PAINT-CURRENT-MENU) (ERASE-MENU PAINT-CURRENT-MENU) (SETQ PAINT-CURRENT-MENU NEW-MENU) (DISPLAY-MENU PAINT-CURRENT-MENU) (PAINT-SELECT-MODE 'NORMAL-MODE)) (DEFPROP NORMAL-MODE PAINT-COM-NORMAL-MODE PAINT-COMMAND) (DEFUN PAINT-COM-NORMAL-MODE NIL (COND (MOUSE-MID-SWITCH (BRUSH-PAINT BRUSH PAINT MOUSE-X MOUSE-Y)) (MOUSE-BOT-SWITCH (BRUSH-PAINT BRUSH ALTERNATE-PAINT MOUSE-X MOUSE-Y)))) (DEFPROP XOR-MODE PAINT-COM-XOR-MODE PAINT-COMMAND) (DEFUN PAINT-COM-XOR-MODE NIL (COND (MOUSE-MID-SWITCH (BRUSH-PAINT BRUSH PAINT MOUSE-X MOUSE-Y 'T)) (MOUSE-BOT-SWITCH (BRUSH-PAINT BRUSH ALTERNATE-PAINT MOUSE-X MOUSE-Y)))) (DEFPROP RESTORE-PALLET PAINT-COM-RESTORE-PALLET PAINT-COMMAND) (DEFUN PAINT-COM-RESTORE-PALLET NIL (INIT-PAINTS) (PAINT-SELECT-MENU PAINT-MENU)) (DEFPROP SELECT-MENU PAINT-COM-SELECT-MENU PAINT-COMMAND) (DEFUN PAINT-COM-SELECT-MENU NIL (PAINT-SELECT-MENU SELECT-MENU)) (DEFPROP AREA-MENU PAINT-COM-AREA-MENU PAINT-COMMAND) (DEFUN PAINT-COM-AREA-MENU NIL (PAINT-SELECT-MENU AREA-MENU)) (DEFPROP PAINT-MENU PAINT-COM-PAINT-MENU PAINT-COMMAND) (DEFUN PAINT-COM-PAINT-MENU NIL (PAINT-SELECT-MENU PAINT-MENU)) (DEFPROP DRAW-MENU PAINT-COM-DRAW-MENU PAINT-COMMAND) (DEFUN PAINT-COM-DRAW-MENU NIL (PAINT-SELECT-MENU DRAW-MENU)) (DEFPROP DRAW-DIRECT PAINT-COM-DRAW-DIRECT PAINT-COMMAND) (DEFPROP DRAW-DIRECT T PAINT-BRUSH-INHIBIT-BLINK) (DEFPROP DRAW-DIRECT 1 PAINT-CLOCK-RATE) (DEFUN PAINT-COM-DRAW-DIRECT NIL (COND (MOUSE-MID-SWITCH (AS-2 1 (SCREEN-BUFFER-PIXEL-ARRAY TV-DEFAULT-SCREEN) MOUSE-X MOUSE-Y)) (MOUSE-BOT-SWITCH (AS-2 0 (SCREEN-BUFFER-PIXEL-ARRAY TV-DEFAULT-SCREEN) MOUSE-X MOUSE-Y)))) (DEFPROP SELECT-BRUSH PAINT-COM-SELECT-BRUSH PAINT-COMMAND) (DEFUN PAINT-COM-SELECT-BRUSH (&AUX TEM) (COND ((SETQ TEM (PAINT-SELECT-ARRAY MOUSE-X MOUSE-Y)) (SELECT-BRUSH TEM) (PAINT-SELECT-MODE 'NORMAL-MODE))) ) (DEFPROP SELECT-PAINT PAINT-COM-SELECT-PAINT PAINT-COMMAND) (DEFUN PAINT-COM-SELECT-PAINT (&AUX TEM) (COND ((SETQ TEM (PAINT-SELECT-ARRAY MOUSE-X MOUSE-Y)) (SETQ PAINT TEM) (PAINT-SELECT-MODE 'NORMAL-MODE))) ) (DEFPROP SELECT-ALTERNATE-PAINT PAINT-COM-SELECT-ALTERNATE-PAINT PAINT-COMMAND) (DEFUN PAINT-COM-SELECT-ALTERNATE-PAINT (&AUX TEM) (COND ((SETQ TEM (PAINT-SELECT-ARRAY MOUSE-X MOUSE-Y)) (SETQ ALTERNATE-PAINT TEM) (PAINT-SELECT-MODE 'NORMAL-MODE))) ) (DEFUN SELECT-BRUSH (ARG &AUX TEM) (SETQ BRUSH ARG) (SETQ BRUSH-LOW-X (SETQ TEM (// (CADDR BRUSH) 2))) (SETQ BRUSH-HIGH-X (- (SCREEN-X2 TV-DEFAULT-SCREEN) TEM)) (SETQ BRUSH-LOW-Y (SETQ TEM (// (CADDDR BRUSH) 2))) (SETQ BRUSH-HIGH-Y (- (SCREEN-Y2 TV-DEFAULT-SCREEN) TEM)) (COND ((NULL (BOUNDP 'BRUSH-CURSOR-ARRAY)) (SETQ BRUSH-CURSOR-ARRAY (MAKE-ARRAY NIL 'ART-1B '(40 40))) ;ART-1B (SETQ BRUSH-CURSOR-WD-ARRAY (MAKE-ARRAY NIL 'ART-16B '(100) BRUSH-CURSOR-ARRAY)) ;32. ROWS BY 32. BITS )) (DO Y 0 (1+ Y) (= Y 40) (DO X 0 (1+ X) (= X 40) (AS-2 (COND ((OR (NOT (< X (CADDR BRUSH))) (NOT (< Y (CADDDR BRUSH)))) 0) (T (AR-2 (SCREEN-BUFFER-PIXEL-ARRAY TV-DEFAULT-SCREEN) (+ (CAR BRUSH) X) (+ (CADR BRUSH) Y)))) BRUSH-CURSOR-ARRAY X Y))) (SETQ BRUSH-CURSOR (LIST 0 0 (COND ((< (CADDR BRUSH) 40) (CADDR BRUSH)) (T 40)) (COND ((< (CADDDR BRUSH) 40) (CADDDR BRUSH)) (T 40)))) ) (DEFUN BRUSH-CLEAR NIL (COND (BRUSH-PHASE (BRUSH-BLINK)))) (DEFUN BRUSH-BLINK (&OPTIONAL X Y) ;X AND Y BETTER BE GIVEN EXCEPT FROM BRUSH-CLEAR (COND (BRUSH-PHASE (SETQ BRUSH-PHASE NIL)) (T (SETQ BRUSH-CURSOR-X X BRUSH-CURSOR-Y Y BRUSH-PHASE T))) (BRUSH-XOR BRUSH-CURSOR BRUSH-CURSOR-WD-ARRAY BRUSH-CURSOR-X BRUSH-CURSOR-Y)) (DEFUN BRUSH-XOR (BRUSH BRUSH-ARRAY X0 Y0) (PROG (B-IIDX B-IDX B-OVER B-IBC B-BC B-YC ;B-IOVER IS 0 PICT-IIDX PICT-IDX PICT-IOVER PICT-OVER PICT-TEM PICT-FIELD BITS BRUSH-WD PICT-WD BUFFER-WORDS SCREEN-LINE-LOCATIONS) (SETQ SCREEN-LINE-LOCATIONS (* 2 (SCREEN-LOCATIONS-PER-LINE TV-DEFAULT-SCREEN))) (SETQ BUFFER-WORDS (SCREEN-BUFFER-HALFWORD-ARRAY TV-DEFAULT-SCREEN)) (SETQ B-IIDX 0) (SETQ B-IBC (CADDR BRUSH)) (SETQ B-YC (CADDDR BRUSH)) (SETQ X0 (- X0 (// B-IBC 2)) Y0 (- Y0 (// B-YC 2))) (SETQ PICT-IIDX (+ (LSH X0 -4) (* Y0 SCREEN-LINE-LOCATIONS))) (SETQ PICT-IOVER (LOGAND X0 17)) XL (SETQ B-IDX B-IIDX PICT-IDX PICT-IIDX B-OVER 0 PICT-OVER PICT-IOVER B-BC B-IBC) L (SETQ BITS (MIN (- 20 (MAX B-OVER PICT-OVER)) B-BC)) (SETQ BRUSH-WD (LDB (+ (LSH B-OVER 6) BITS) (AR-1 BRUSH-ARRAY B-IDX))) (SETQ PICT-WD (LDB (SETQ PICT-FIELD (+ (LSH PICT-OVER 6) BITS)) (SETQ PICT-TEM (AR-1 BUFFER-WORDS PICT-IDX)))) (SETQ PICT-WD (LOGXOR PICT-WD BRUSH-WD)) (AS-1 (DPB PICT-WD PICT-FIELD PICT-TEM) BUFFER-WORDS PICT-IDX) (COND ((ZEROP (SETQ B-BC (- B-BC BITS))) (COND ((ZEROP (SETQ B-YC (1- B-YC))) (RETURN T)) (T (SETQ B-IIDX (+ B-IIDX 2) PICT-IIDX (+ PICT-IIDX SCREEN-LINE-LOCATIONS)) (GO XL))))) (COND ((>= (SETQ B-OVER (+ B-OVER BITS)) 20) (SETQ B-OVER 0 B-IDX (1+ B-IDX)))) (COND ((>= (SETQ PICT-OVER (+ PICT-OVER BITS)) 20) (SETQ PICT-OVER 0 PICT-IDX (1+ PICT-IDX)))) (GO L) )) ;(DEFUN BRUSH-XOR (BRUSH BRUSH-ARRAY X0 Y0) ; (PROG (PX PY BX BY BXL BYL) ; (SETQ PY (- Y0 (// (CADDDR BRUSH) 2)) ; BY (CADR BRUSH) ; BYL (+ BY (CADDDR BRUSH))) ; L (COND ((NOT (< BY BYL)) ; (RETURN T))) ; (SETQ PX (- X0 (// (CADDR BRUSH) 2)) ; BX (CAR BRUSH) ; BXL (+ BX (CADDR BRUSH))) ; L1 (COND ((NOT (< BX BXL)) ; (SETQ BY (1+ BY)) ; (SETQ PY (1+ PY)) ; (GO L))) ; (COND ((NOT (= 0 (AR-2 BRUSH-ARRAY BX BY))) ; (AS-2 (LOGXOR (AR-2 (SCREEN-BUFFER-PIXEL-ARRAY TV-DEFAULT-SCREEN) PX PY) 1) ; (SCREEN-BUFFER-PIXEL-ARRAY TV-DEFAULT-SCREEN) ; PX ; PY))) ; (SETQ PX (1+ PX) ; BX (1+ BX)) ; (GO L1))) (DEFUN BRUSH-PAINT (BRUSH PAINT X0 Y0 &OPTIONAL XOR-MODE) (PROG (B-IIDX B-IDX B-IOVER B-OVER B-IBC B-BC B-YC PAINT-IIDX PAINT-IDX PAINT-IOVER PAINT-OVER PAINT-IXBC PAINT-XBC PAINT-YBC PAINT-X PAINT-Y ZX ZY ZXW ZYW ZXD ZYD PICT-IIDX PICT-IDX PICT-IOVER PICT-OVER PICT-TEM PICT-FIELD BITS BRUSH-WD PAINT-WD PICT-WD BUFFER-WORDS SCREEN-LINE-LOCATIONS) (SETQ BUFFER-WORDS (SCREEN-BUFFER-HALFWORD-ARRAY TV-DEFAULT-SCREEN)) (SETQ SCREEN-LINE-LOCATIONS (* 2 (SCREEN-LOCATIONS-PER-LINE TV-DEFAULT-SCREEN))) ;XXX-IDX IS A WORD INDEX INTO THE TV-BUFFER FOR XXX. ;XXX-IIDX IS THE VALUE OF XXX-IDX AT START OF CURRENT X-LINE. INCREMENT BY ;(* 2 (SCREEN-LOCATIONS-PER-LINE TV-DEFAULT-SCREEN)) TIMES TWO BECAUSE TWO ARRAY ENTRIES ; PER MEMORY WORD. ; (# VIDEO BUFFER WDS IN X LINE) WHEN STARTING NEW X-LINE. ;XXX-OVER IS HOW MANY BITS OVER WITHIN THAT WORD XXX IS. THUS XXX-OVER CAN VARY FROM ; 0 IF ALL 16. BITS ARE ACTIVE TO 17 IF ONLY ONE BIT IS. NOTE THIS ACTUALLY POINTS ; "AT" OF THE ACTIVE BIT, READY TO GOBBLE IT ON DIRECTLY ; (UNLIKE SIMILAR TO PDP-10 ILDB INSTRUCTION). ;XXX-IOVER IS VALUE OF XXX-OVER AT START OF X-LINE. ;XXX-BC IS BIT COUNT OF BITS REMAINING IN XXX IN CURRENT X-LINE. ; BITS IS SET TO THE MINIMUM OF ; 1- NUMBER OF BRUSH BITS REMAINING IN CURRENT X-LINE. ; 2- NUMBER OF BRUSH BITS IN CURRENT BRUSH WD. ; 3- NUMBER OF PAINT BITS REMAINING ALTOGETHER (BEFORE X WRAP REQD). ; 4- NUMBER OF PAINT BITS IN CURRENT PAINT WD. ; 5- NUMBER OF PICTURE BITS IN CURRENT PICTURE WD. ; THEN THIS NUMBER OF BITS ARE PROCESSED. (NOTE THAT NO WORD BOUNDARIES CAN BE ; CROSSED IN ANY OF THE BRUSH, PAINT OR PICTURE). ; THEN ALL THE POINTERS ARE INCREMENTED BY BITS, AND ANOTHER LOOP MADE, IF NECC, ETC. (SETQ B-IIDX (+ (LSH (CAR BRUSH) -4) (* (CADR BRUSH) SCREEN-LINE-LOCATIONS))) (SETQ B-IOVER (LOGAND (CAR BRUSH) 17)) (SETQ B-IBC (CADDR BRUSH)) (SETQ B-YC (CADDDR BRUSH)) ;COUNT OF Y-LINES (SETQ X0 (- X0 (// B-IBC 2)) ;MOVE FROM CENTER OF BRUSH TO UPPER LEFT Y0 (- Y0 (// B-YC 2))) (SETQ ZX (CAR PAINT) ;FIGURE OUT PAINT PHASE, ETC. ZY (CADR PAINT) ZXW (CADDR PAINT) ZYW (CADDDR PAINT) ZXD (- ZXW (\ ZX ZXW)) ;PHASE OF PAINT ORIGIN ZYD (- ZYW (\ ZY ZYW))) (SETQ PAINT-X (\ (+ X0 ZXD) ZXW)) ;COMPUTE PAINT RELATIVE X-COORD OF FIRST BIT (SETQ PAINT-IXBC (- ZXW PAINT-X)) ;THIS MANY BITS AVAIL BEFORE MUST WRAP (SETQ PAINT-Y (\ (+ Y0 ZYD) ZYW)) ;LIKEWISE Y (SETQ PAINT-YBC (- ZYW PAINT-Y)) (SETQ PAINT-IIDX (+ (LSH (+ PAINT-X ZX) -4) (* (+ PAINT-Y ZY) SCREEN-LINE-LOCATIONS))) (SETQ PAINT-IOVER (LOGAND (+ PAINT-X ZX) 17)) (SETQ PICT-IIDX (+ (LSH X0 -4) (* Y0 SCREEN-LINE-LOCATIONS))) (SETQ PICT-IOVER (LOGAND X0 17)) XL (SETQ B-IDX B-IIDX PAINT-IDX PAINT-IIDX PICT-IDX PICT-IIDX ;START NEW X-LINE B-OVER B-IOVER PAINT-OVER PAINT-IOVER PICT-OVER PICT-IOVER PAINT-XBC PAINT-IXBC B-BC B-IBC) L (SETQ BITS (MIN (- 20 (MAX B-OVER PAINT-OVER PICT-OVER)) PAINT-XBC B-BC)) (SETQ BRUSH-WD (LDB (+ (LSH B-OVER 6) BITS) (AR-1 BUFFER-WORDS B-IDX))) (SETQ PAINT-WD (LDB (+ (LSH PAINT-OVER 6) BITS) (AR-1 BUFFER-WORDS PAINT-IDX))) (SETQ PICT-WD (LDB (SETQ PICT-FIELD (+ (LSH PICT-OVER 6) BITS)) (SETQ PICT-TEM (AR-1 BUFFER-WORDS PICT-IDX)))) (SETQ PAINT-WD (LOGAND PAINT-WD BRUSH-WD)) (SETQ PICT-WD (COND (XOR-MODE (LOGXOR PICT-WD BRUSH-WD)) (T (LOGIOR (LOGAND PICT-WD (LOGXOR -1 BRUSH-WD)) PAINT-WD)))) (AS-1 (DPB PICT-WD PICT-FIELD PICT-TEM) BUFFER-WORDS PICT-IDX) (COND ((ZEROP (SETQ B-BC (- B-BC BITS))) ;THRU WITH BRUSH IN X DIRECTION (COND ((ZEROP (SETQ B-YC (1- B-YC))) (RETURN T)) ;THRU IN Y, TOO. (T (SETQ PAINT-IIDX (+ PAINT-IIDX SCREEN-LINE-LOCATIONS) B-IIDX (+ B-IIDX SCREEN-LINE-LOCATIONS) PICT-IIDX (+ PICT-IIDX SCREEN-LINE-LOCATIONS) ) (COND ((ZEROP (SETQ PAINT-YBC (1- PAINT-YBC))) ;WRAP PAINT IN Y (SETQ PAINT-YBC ZYW) ; DIRECTION (SETQ PAINT-IIDX (- PAINT-IIDX (* SCREEN-LINE-LOCATIONS ZYW))))) (GO XL))) )) (COND ((ZEROP (SETQ PAINT-XBC (- PAINT-XBC BITS))) (SETQ PAINT-XBC ZXW) (SETQ PAINT-OVER (LOGAND ZX 17)) (SETQ PAINT-IDX (+ (LSH ZX -4) (* SCREEN-LINE-LOCATIONS (// PAINT-IDX SCREEN-LINE-LOCATIONS))))) ;SAME Y LINE AS BEFORE ((>= (SETQ PAINT-OVER (+ PAINT-OVER BITS)) 20) (SETQ PAINT-OVER 0 PAINT-IDX (1+ PAINT-IDX)))) (COND ((>= (SETQ B-OVER (+ B-OVER BITS)) 20) (SETQ B-OVER 0 B-IDX (1+ B-IDX)))) (COND ((>= (SETQ PICT-OVER (+ PICT-OVER BITS)) 20) (SETQ PICT-OVER 0 PICT-IDX (1+ PICT-IDX)))) (GO L) )) ;(DEFUN BRUSH-PAINT (BRUSH PAINT X0 Y0 &OPTIONAL XOR-MODE) ; (PROG (PX PY BX BY BXL BYL ZX ZY ZXW ZYW ZXD ZYD PB) ; (SETQ ZX (CAR PAINT) ; ZY (CADR PAINT) ; ZXW (CADDR PAINT) ; ZYW (CADDDR PAINT) ; ZXD (- ZXW (\ ZX ZXW)) ;THESE VARIABLES ARE SO THAT IF THE PAINT ITSELF ; ZYD (- ZYW (\ ZY ZYW))) ; IS PAINTED OVER, EACH BIT IS EXACTLY PAINTED ; ;OVER WITH ITSELF. THIS ASSURES THE PAINT IS UNCHANGED AND ALSO ; ;THAT WALL-PAPER PATTERNS "LINE UP" ; (SETQ PY (- Y0 (// (CADDDR BRUSH) 2)) ; BY (CADR BRUSH) ; BYL (+ BY (CADDDR BRUSH))) ; L (COND ((NOT (< BY BYL)) ; (RETURN T))) ; (SETQ PX (- X0 (// (CADDR BRUSH) 2)) ; BX (CAR BRUSH) ; BXL (+ BX (CADDR BRUSH))) ; L1 (COND ((NOT (< BX BXL)) ; (SETQ BY (1+ BY)) ; (SETQ PY (1+ PY)) ; (GO L))) ; (SETQ PB (AR-2 (SCREEN-BUFFER-PIXEL-ARRAY TV-DEFAULT-SCREEN) ; (+ ZX (\ (+ PX ZXD) ZXW)) ; (+ ZY (\ (+ PY ZYD) ZYW)))) ; (COND ((NOT (= 0 (AR-2 (SCREEN-BUFFER-PIXEL-ARRAY TV-DEFAULT-SCREEN) BX BY))) ; (AS-2 (COND (XOR-MODE (LOGXOR 1 (AR-2 (SCREEN-BUFFER-PIXEL-ARRAY TV-DEFAULT-SCREEN) PX PY))) ; (T PB)) ; (SCREEN-BUFFER-PIXEL-ARRAY TV-DEFAULT-SCREEN) PX PY))) ; (SETQ PX (1+ PX) ; BX (1+ BX)) ; (GO L1))) (DEFUN INIT-PAINT (X0 Y0 PATTERN-LIST) (PROG (X Y XL YL PAT COUNT) (SETQ Y Y0 XL (+ X0 40) YL (+ Y0 40) PAT PATTERN-LIST) L (COND ((NOT (< Y YL)) (RETURN (LIST X0 Y0 40 40)))) (SETQ X X0 COUNT -3) XL (AS-2 (LSH (CAR PAT) COUNT) (SCREEN-BUFFER-PIXEL-ARRAY TV-DEFAULT-SCREEN) X Y) (COND ((NOT (< X XL)) (SETQ Y (1+ Y)) (COND ((NULL (SETQ PAT (CDR PAT))) (SETQ PAT PATTERN-LIST))) (GO L))) (SETQ X (1+ X)) (COND ((> (SETQ COUNT (1+ COUNT)) 0) (SETQ COUNT -3))) (GO XL))) (DEFUN INIT-PAINTS NIL (PROG ((X 0) (Y 10) (PL '((0 0 0 0) (1 0 0 4) (2 10 2 10) (1 12 2 14) (5 12 5 12) (16 5 15 3) (15 7 15 7) (16 17 17 13) (17 17 17 17))) (BL '((600 600 600 600 600 600 600 600 600 600 600 600 600 600 600 600) (0 0 0 0 0 0 0 177777 177777 0 0 0 0 0 0 0) (177777 177777 177777 177777 177777 177777 177777 177777 177777 177777 177777 177777 177777 177777 177777 177777) (0 0 0 0 7760 7760 7760 7760 7760 7760 7760 7760 0 0 0 0) (600 3740 17770 37774 37774 77776 77776 177777 177777 77776 77776 37774 37774 17770 3740 600) (0 0 0 0 1700 3740 7760 7760 7760 7760 3740 1700 0 0 0 0) (0 0 0 0 0 0 200 200 200 200 0 0 0 0 0 0) (0 0 0 0 0 0 0 1700 0 0 0 0 0 0 0 0))) (COUNT 0)) (TV-SELECT-SCREEN TV-DEFAULT-SCREEN) (TV-ERASE (SCREEN-WIDTH TV-DEFAULT-SCREEN) 50 0 0 TV-ALU-ANDCA) (SETQ PAINT-AREA-Y 50) ;MAX Y OF MAIN PAINT AREA (SETQ PAINT-LIST NIL) L (COND ((NULL PL) (SETQ PAINT-AREA-X X) ;MAX X OF MAIN PAINT AREA (SETQ X (+ X 40)) (SETQ COUNT 0) (GO L1))) (SETQ PAINT-LIST (CONS (INIT-PAINT X Y (CAR PL)) PAINT-LIST)) (COND ((= COUNT 0) (SETQ ALTERNATE-PAINT (CAR PAINT-LIST))) ((= COUNT 4) (SETQ PAINT (CAR PAINT-LIST)))) (SETQ X (+ X 42) PL (CDR PL)) (SETQ COUNT (1+ COUNT)) (GO L) L1 (COND ((NULL BL) (RETURN T))) (SETQ PAINT-LIST (CONS (INIT-BRUSH X (+ Y 10) (CAR BL)) PAINT-LIST)) (COND ((= COUNT 3) (SELECT-BRUSH (CAR PAINT-LIST)))) (SETQ X (+ X 24) BL (CDR BL)) (SETQ COUNT (1+ COUNT)) (GO L1))) (DEFUN PAINT-SELECT-ARRAY (X Y) (PROG (TEM) (SETQ TEM PAINT-LIST) L (COND ((NULL TEM) (RETURN NIL)) ((AND (< (CAAR TEM) X) (< (CADAR TEM) Y) (< X (+ (CAAR TEM) (CADDAR TEM))) (< Y (+ (CADAR TEM) (CAR (CDDDAR TEM))))) (RETURN (CAR TEM)))) (SETQ TEM (CDR TEM)) (GO L))) (DEFUN INIT-BRUSH (X0 Y0 PATTERN-LIST) (PROG (X Y XL YL PAT COUNT) (SETQ Y Y0 XL (+ X0 20) YL (+ Y0 20) PAT PATTERN-LIST) L (COND ((NOT (< Y YL)) (RETURN (LIST X0 Y0 20 20)))) (SETQ X X0 COUNT -17) XL (AS-2 (LSH (CAR PAT) COUNT) (SCREEN-BUFFER-PIXEL-ARRAY TV-DEFAULT-SCREEN) X Y) (COND ((NOT (< X XL)) (SETQ Y (1+ Y)) (SETQ PAT (CDR PAT)) (GO L))) (SETQ X (1+ X)) (SETQ COUNT (1+ COUNT)) (GO XL))) (DEFPROP SAVE-SCREEN PAINT-COM-SAVE-SCREEN PAINT-COMMAND) (DEFUN PAINT-COM-SAVE-SCREEN NIL (SAVE-SCREEN)) (DEFUN SAVE-SCREEN NIL (COND ((NULL (BOUNDP 'PAINT-SAVED-SCREEN)) (SETQ PAINT-SAVED-SCREEN (MAKE-ARRAY NIL 'ART-16B (ARRAY-DIMENSION-N 1 (SCREEN-BUFFER-HALFWORD-ARRAY TV-DEFAULT-SCREEN)))))) (COPY-ARRAY-1 (SCREEN-BUFFER-HALFWORD-ARRAY TV-DEFAULT-SCREEN) PAINT-SAVED-SCREEN)) (DEFPROP RESTORE-SCREEN PAINT-COM-RESTORE-SCREEN PAINT-COMMAND) (DEFUN PAINT-COM-RESTORE-SCREEN NIL (RESTORE-SCREEN)) (DEFUN RESTORE-SCREEN NIL (COND ((NULL (BOUNDP 'PAINT-SAVED-SCREEN)) NIL) (T (COPY-ARRAY-1 PAINT-SAVED-SCREEN (SCREEN-BUFFER-HALFWORD-ARRAY TV-DEFAULT-SCREEN))))) (DEFPROP DRAW-LINES-AND-CIRCLES PAINT-COM-DRAW-LINES-AND-CIRCLES PAINT-COMMAND) (DEFPROP DRAW-LINES-AND-CIRCLES PAINT-COM-DLC-ENTER PAINT-ENTERING-FCTN) (DEFPROP DRAW-LINES-AND-CIRCLES PAINT-COM-DLC-LEAVE PAINT-LEAVING-FCTN) (DEFPROP DRAW-LINES-AND-CIRCLES T PAINT-DISPATCH-ALWAYS) (DEFPROP DRAW-LINES-AND-CIRCLES 300 PAINT-CLOCK-RATE) (DEFUN PAINT-COM-DLC-ENTER NIL (SETQ PAINT-DLC-STATE 'SET-BASEPOINT) (SETQ PAINT-DLC-MODE 'LINE)) (DEFUN PAINT-COM-DRAW-LINES-AND-CIRCLES NIL (COND (MOUSE-MID-SWITCH (PAINT-DLC-ADVANCE) (SETQ MOUSE-MIDSW-HOLD T)) (T (PAINT-DLC-BLINK))) (COND ((AND MOUSE-BOT-SWITCH (NULL MOUSE-BOTSW-HOLD)) (PAINT-DLC-ALTER) (SETQ MOUSE-BOTSW-HOLD T)))) (DEFUN PAINT-DLC-ADVANCE NIL (COND ((EQ PAINT-DLC-STATE 'SET-BASEPOINT) (SETQ PAINT-DLC-BASE-X MOUSE-X) (SETQ PAINT-DLC-BASE-Y MOUSE-Y) (SETQ PAINT-SUBC-PHASE NIL) (SETQ PAINT-DLC-STATE (COND ((EQ PAINT-DLC-MODE 'LINE) 'RUBBER-BAND) ((EQ PAINT-DLC-MODE 'CIRCLE) 'RUBBER-CIRCLE)))) ((MEMQ PAINT-DLC-STATE '(RUBBER-BAND RUBBER-CIRCLE)) (COND (PAINT-SUBC-X (COND ((EQ PAINT-DLC-STATE 'RUBBER-BAND) (DRAW-ABSOLUTE-VECTOR-RASTER-COORDS PAINT-DLC-BASE-X PAINT-DLC-BASE-Y PAINT-SUBC-X PAINT-SUBC-Y 'IOR)) ((EQ PAINT-DLC-STATE 'RUBBER-CIRCLE) (DRAW-ABSOLUTE-CIRCLE-RASTER-COORDS PAINT-DLC-BASE-X PAINT-DLC-BASE-Y PAINT-SUBC-X PAINT-SUBC-Y 'IOR))) (SETQ PAINT-SUBC-X NIL))) (SETQ PAINT-SUBC-PHASE NIL) (SETQ PAINT-DLC-STATE 'SET-BASEPOINT)))) (DEFUN PAINT-DLC-BLINK NIL (COND ((NULL PAINT-SUBC-PHASE) (PAINT-DLC-SET)) (T (PAINT-DLC-CLEAR)))) (DEFUN PAINT-DLC-SET NIL (COND ((NULL PAINT-SUBC-PHASE) (SETQ PAINT-SUBC-X MOUSE-X PAINT-SUBC-Y MOUSE-Y) (COND ((EQ PAINT-DLC-STATE 'RUBBER-BAND) (DRAW-ABSOLUTE-VECTOR-RASTER-COORDS PAINT-DLC-BASE-X PAINT-DLC-BASE-Y PAINT-SUBC-X PAINT-SUBC-Y 'XOR)) ((EQ PAINT-DLC-STATE 'RUBBER-CIRCLE) (DRAW-ABSOLUTE-CIRCLE-RASTER-COORDS PAINT-DLC-BASE-X PAINT-DLC-BASE-Y PAINT-SUBC-X PAINT-SUBC-Y 'XOR))) (SETQ PAINT-SUBC-PHASE T)))) (DEFUN PAINT-DLC-CLEAR NIL (COND (PAINT-SUBC-PHASE (COND ((EQ PAINT-DLC-STATE 'RUBBER-BAND) (DRAW-ABSOLUTE-VECTOR-RASTER-COORDS PAINT-DLC-BASE-X PAINT-DLC-BASE-Y PAINT-SUBC-X PAINT-SUBC-Y 'XOR)) ((EQ PAINT-DLC-STATE 'RUBBER-CIRCLE) (DRAW-ABSOLUTE-CIRCLE-RASTER-COORDS PAINT-DLC-BASE-X PAINT-DLC-BASE-Y PAINT-SUBC-X PAINT-SUBC-Y 'XOR))) (SETQ PAINT-SUBC-PHASE NIL)))) (DEFUN PAINT-DLC-ALTER NIL (PAINT-DLC-CLEAR) (SETQ PAINT-DLC-MODE (COND ((EQ PAINT-DLC-MODE 'LINE) 'CIRCLE) (T 'LINE))) (COND ((EQ PAINT-DLC-STATE 'RUBBER-BAND) (SETQ PAINT-DLC-STATE 'RUBBER-CIRCLE)) ((EQ PAINT-DLC-STATE 'RUBBER-CIRCLE) (SETQ PAINT-DLC-STATE 'RUBBER-BAND)))) (DEFUN PAINT-COM-DLC-LEAVE NIL NIL) (DEFUN COPY-ARRAY-1 (FROM TO) (PROG (LIM LIM2) (COND ((< (SETQ LIM2 (ARRAY-LENGTH FROM)) (SETQ LIM (ARRAY-LENGTH TO))) (SETQ LIM LIM2))) (DO I (1- LIM) (1- I) (= I 0) (AS-1 (AR-1 FROM I) TO I)))) (DEFPROP EXIT PAINT-COM-EXIT PAINT-COMMAND) (DEFPROP EXIT PAINT-COM-EXIT PAINT-ENTERING-FCTN) ;REALLY TRY TO GET THERE (DEFPROP EXIT T PAINT-DISPATCH-ALWAYS) (DEFPROP EXIT 1 PAINT-CLOCK-RATE) (DEFUN PAINT-COM-EXIT NIL (SETQ PAINT-EXIT-FLAG T)) (DEFPROP TEXT PAINT-COM-TEXT-ENTER PAINT-ENTERING-FCTN) (DEFPROP TEXT PAINT-COM-TEXT PAINT-COMMAND) (DEFPROP TEXT PAINT-COM-TEXT-LEAVE PAINT-LEAVING-FCTN) (DEFPROP TEXT T PAINT-DISPATCH-ALWAYS) (DEFPROP TEXT 300 PAINT-CLOCK-RATE) (DEFUN PAINT-COM-TEXT-ENTER NIL (SETQ PAINT-TEXT-HOLDING-STRING (MAKE-ARRAY NIL 'ART-STRING 50 NIL '(0)))) (DEFUN PAINT-COM-TEXT (&AUX TEM) (COND (MOUSE-MID-SWITCH (PAINT-TEXT-ADVANCE) (SETQ MOUSE-MIDSW-HOLD T)) (T (PAINT-TEXT-BLINK))) (COND ((AND MOUSE-BOT-SWITCH (NULL MOUSE-BOTSW-HOLD) PAINT-SUBC-X (NOT (ZEROP (ARRAY-ACTIVE-LENGTH PAINT-ARG-STRING))) (BOUNDP (SETQ TEM (INTERN PAINT-ARG-STRING))) (ARRAYP (SYMEVAL TEM))) (SETQ PAINT-TEXT-FONT (SYMEVAL TEM)) (PAINT-TEXT-CLEAR) (SETQ PAINT-SUBC-X NIL) (STORE-ARRAY-LEADER 0 PAINT-ARG-STRING 0) ))) (DEFUN PAINT-TEXT-ADVANCE NIL (COND (PAINT-SUBC-X (PAINT-TEXT-SET) (STORE-ARRAY-LEADER 0 PAINT-ARG-STRING 0) ;RESET STRING ARG (SETQ PAINT-SUBC-X NIL) (SETQ PAINT-SUBC-PHASE NIL)))) (DEFUN PAINT-COM-TEXT-LEAVE NIL (RETURN-ARRAY PAINT-TEXT-HOLDING-STRING)) (DEFUN PAINT-TEXT-BLINK NIL (COND ((NULL PAINT-SUBC-PHASE) (PAINT-TEXT-SET)) (T (PAINT-TEXT-CLEAR)))) (DEFUN PAINT-TEXT-SET NIL (COND ((NULL PAINT-SUBC-PHASE) (SETQ PAINT-SUBC-X MOUSE-X PAINT-SUBC-Y MOUSE-Y) (COPY-ARRAY-CONTENTS-AND-LEADER PAINT-ARG-STRING PAINT-TEXT-HOLDING-STRING) (PAINT-TEXT-DRAW) (SETQ PAINT-SUBC-PHASE T)))) (DEFUN PAINT-TEXT-CLEAR NIL (COND (PAINT-SUBC-PHASE (PAINT-TEXT-DRAW) (SETQ PAINT-SUBC-PHASE NIL)))) (DEFUN PAINT-TEXT-DRAW NIL (TV-SET-CURSORPOS PAINT-LABELING-PC-PPR PAINT-SUBC-X PAINT-SUBC-Y) (TV-SET-FONT PAINT-LABELING-PC-PPR PAINT-TEXT-FONT) (TV-STRING-OUT PAINT-LABELING-PC-PPR PAINT-TEXT-HOLDING-STRING) )