* ************************************************************ * Palette routine - Feb. 88 (horizontal palette) * revised Jan 89 - April 90 * * by Charles VASSALLO, 33 route des Traouieros * 22730, Tregastel, France * * This program is written to be called from HisoftBasic programs, with * CALL LOC Pal&,WINDOW(7),VARPTR(ColorChange%) * It returns ColChange=1 or 0 depending whether the color change has been * validated (OK) or canceled (CANCEL) * * The source was assembled with DEVPAC2 (Kuma Computers Ltd, UK) * *---------------------------------------- opt o+ ********* From Include files and fd_files : * Exec library ExecBase=4 OpenLib=-30-378 CloseLibrary=-414 AllocMem=-198 FreeMem=-210 WaitPort=-384 GetMsg=-372 ReplyMsg=-378 ClearPublic=65537 *calls to Intuition OpenScreen=-198 OpenWindow=-204 CloseScreen=-66 CloseWindow=-72 ViewAddress=-294 ModifyProp=-156 PrinIText=-216 DrawImage=-114 RefreshGList=-432 RefreshGadgets=-222 MoveWindow=-168 * calls to graphics LoadRGB4=-192 Move=-240 Draw=-246 SetAPen=-342 SetDrMd=-354 Text=-60 * end of amiga.lib call definitions PUSH: macro ; this macro is to remedy the forbidden lea \3(pc),a0 ; addressing mode "move xx,yy(pc)", useful move.\1 \2,(a0) ; for Basic applications (no further link). ENDM ; For instance, write PUSH b,d0,yy ********************************************************************** * * Main Program * ********************************************************************** Palette: * Reads the Screen address movem.l d0-d7/a0-a6,-(sp) move.l 64(sp),a1 ; Window address PUSH l,46(a1),ToScreen ; Screen address, placed in NewWindow move.l 68(sp),a1 PUSH l,a1,ColorChange move.w #1,(a1) ; to be replaced with 1 in case of CANCEL * Opens libraries,screen,window jsr OpenAll(pc) beq MainExit ; if OpenAll fails jsr GetAddrs(pc) ; stategic addresses, color number... jsr OpensWindow(pc) ; opens the palette window beq MainExit ; (in case of failure) * Saves initial color table jsr SaveTableInit(pc) ; for CANCEL operation jsr SaveTabUndo(pc) ; for UNDO * Displays the color range (ColNumb colors). Each color corresponds * to a rectangle of width Curslen=256/ColNumb clr.l d3 move.l #256,d6 move.b ColNumb(pc),d3 divu d3,d6 ; d6 = Curslen PUSH b,d6,Curslen lea InitImage(pc),a5 ; pushes Curslen in the Image move.w d6,4(a5) ; structure for color rectangles subq.w #1,d3 ; we use d3 as the loop counter move.l #276,d2 ; X for right end of color range colrs: move.l gfxbase(pc),a6 move.l d3,d0 move.l myrp(pc),a1 jsr SetAPen(a6) ; sets color d3 sub.w d6,d2 ; substracts Curslen move.l myrp(pc),a0 lea InitImage(pc),a1 ; loads color in Image structure move.b d3,15(a1) ; (ig_PlaneOnOff=15) move.l d2,d0 ; X origin for image move.l #Ycol+YNw,d1 ; Y origin for image move.l intuibase(pc),a6 jsr DrawImage(a6) dbf d3,colrs * The color pointer is initialized with color 2 PUSH b,#2,Col0 PUSH b,#2,Col1 jsr ColorPtr(pc) * Writes gadget texts move.l #2,d7 ; line counter (for 3 lines) clr.l d2 lea ggtxt(pc),a2 lea ggdata(pc),a3 txloop: move.w (a3)+,d6 ; current line Y txl1: move.w (a3)+,d2 ; character number beq txend move.w (a3)+,d0 ; X move.l d6,d1 ; Y clr.l d3 ; for JAM1 mode jsr prtxt(pc) adda.l d2,a2 ; towards next text bra txl1 txend: dbf d7,txloop * draws gadget containers lea Container(pc),a4 movem.w (a4)+,d0-d3 jsr rectangle(pc) move.w (a4)+,d2 move.l #4,d7 contr: movem.w (a4)+,d0-d1 jsr rectangle(pc) dbf d7,contr * Initializing flags. MoveFlag will be set to 1 during MOVE operation * GdgInhib will be set to 1 during COPY or SPREAD operation. * Register d6 will be used to identify the selected gadget PUSH b,#0,MoveFlag PUSH b,#0,GdgInhib ; gadgets non inhibited clr.l d6 ; will be used to identify gadgets bra setcurs ; initialises RVBHSL cursors ; and returns here * Waiting arrival of IDCMP messages www: move.l UserPort(pc),a0 move.l ExecBase,a6 jsr WaitPort(a6) ; waiting for a message * There is now one (or more) messages to deal with. They are located * and answered in the routine ReadMessage, which returns : * Z=0 or 1 according as there is a message or not * message class in a2, IAddress in a3 , Code in d3 * MouseX in d4, mouseY in d5 * There remains to perform the wanted operations, except in case * of GADGETUP message, which are dealt with within ReadMessage * routine. msg: jsr ReadMessage(pc) beq www ; no message waiting * ---------------- NOW, ACTIONS !! ---------------------- * The only use of Code (d3) is to detect the end of MOVE operation, * if d3=$E8 and MoveFlag=1. We then displace the palette window. cmp.w #$E8,d3 bne ggdown ; nothing to do here movend: lea MoveFlag(pc),a0 cmp.b #1,(a0) bne ggdown move.b #0,(a0) ; clears MoveFlag lea MoveWkspce1(pc),a4 movem.w (a4)+,d0-d5 jsr rectangle(pc) ; clears window frame move.l myrp(pc),a1 ; sets drawing mode move.l gfxbase(pc),a6 ; to JAM1 clr.l d0 jsr SetDrMd(a6) lea MoveWkspce1(pc),a4 movem.w (a4)+,d0-d5 move.l mywindow(pc),a0 sub.w 4(a0),d0 sub.w 6(a0),d1 move.l intuibase(pc),a6 jsr MoveWindow(a6) clr.b d6 bra msg *---------------- identifying the message class ------------ * GADGETDOWN ? ggdown: move.b GdgInhib(pc),d0 ; If GdgInhib non zero, GADGETDOWN tst.b d0 ; is not taken into account bne bmouse cmp.l #$20,a2 ; Is it GADGETDOWN ? bne bmouse ; ... No * The message was GADGETDOWN. We now identify the gadget from IAddress * (stored in a3). We use register d6 as an identifying flag lea GdgHue(pc),a5 move.l #1,d6 flag0: cmp.l a5,a3 beq flag1 adda.l #44,a5 ; 44= length of all our gadgets structures addq.b #1,d6 cmp.b #13,d6 ; there are only 12 gadgets bne flag0 flag1: cmp.b #6,d6 bls msg cmp.b #7,d6 ; UNDO ? bne flagCA jsr LoadTabUndo(pc) clr.b d6 bra setcurs ; resets cursors flagCA: cmp.b #11,d6 ; CANCEL ? bne flagOK jsr LoadTableInit(pc) move.l ColorChange(pc),a0 move.w #0,(a0) bra MainExit flagOK: cmp.b #8,d6 ; OK ? beq MainExit cmp.b #9,d6 ; COPY ? bne Spread move.l #70,d0 ; X offset in the window bra spr1 Spread: cmp.b #10,d6 ; SPREAD ? bne drag move.l #160,d0 ; X offset spr1: jsr To(pc) PUSH b,#1,GdgInhib ; puts gadgets off bra msg drag: cmp.b #12,d6 ; MOVE ? bne msg PUSH b,#1,MoveFlag move.l myrp(pc),a1 ; sets drawing mode move.l gfxbase(pc),a6 ; to COMPLEMENT move.l #2,d0 jsr SetDrMd(a6) move.l mywindow(pc),a0 move.w 4(a0),d0 ; window left edge move.w 6(a0),d1 ; window top edge move.w #307,d2 ; width move.w #42,d3 ; height sub.w d0,d4 sub.w d1,d5 lea MoveWkspce(pc),a0 movem.w d0-d5,-(a0) jsr rectangle(pc) bra msg * ------------------------------------------------------------ * Is message MOUSEBUTTONS ($8)? If d6=0, we are (likely) pointing at * a color. If d6=9 or 10, we are answering to questions "COPY TO?" * or SPREAD TO?" * At this point MouseX=d4 and MouseY=d5 bmouse: cmp.l #$8,a2 bne cmouse ; it is no MOUSEBUTTONS. See MOUSEMOVE cmp.w #Ycol,d5 ; we must verify if we clicked bcs msg ; over the color range cmp.w #Ycol+8,d5 bcc msg sub.w #XColMin,d4 bmi msg cmp.w #256,d4 bcc msg clr.l d0 ; now computes the number of the move.b Curslen(pc),d0 ; pointed color -> Col1 and.l #$FFFF,d4 divu d0,d4 PUSH b,d4,Col1 * If d6=0, save current colors (will likely be modified with RVBHSL * cursors), sets up the cursors corresponding to Col1, updates the * color pointer, EXCEPT IF Col1=Col0 (this is required by a correct * operation of UNDO after COPY or SPREAD). tst.b d6 ; reset cursors if d6=0 bne CopyTo move.b Col0(pc),d1 ; if Col0=Col1 ... cmp.b Col1(pc),d1 beq msg ; ... no further action jsr SaveTabUndo(pc) ; saves current colors bra setcurs * If Class=MOUSEBUTTONS and d6 non zero, we must have d6=9 or 10. * The case d6=9 corresponds to the answer to "COPY TO ?". We copy * copy Col0 into Col1 CopyTo: cmp.b #9,d6 ; bne SprTo ; answer to 'SPREAD TO ?' move.l ColTable(pc),a1 clr.l d0 clr.l d1 move.b Col0(pc),d0 asl.w #1,d0 move.b Col1(pc),d1 asl.w #1,d1 move.w 0(a1,d0.w),0(a1,d1.w) move.l #70,d0 bra Toto * Spreads colors from Col0 to Col1. First, we look for left color * (=>d6) and the right color (=>d1), and we put the difference in d7 SprTo: move.b Col0(pc),d6 move.b Col1(pc),d1 cmp.b d6,d1 bcc Spr0 exg d1,d6 Spr0: move.b d1,d7 sub.b d6,d7 beq Spr22 ; nothing to do if Col1=Col0 * We read initial (left) HSL values and store them into d3,d4,d5 * Final values are stored into d0,d1,d2. jsr ReadHSL(pc) ; this routine writes HSL values for movem.l d3-d5,-(sp) ; color d1 into d3,d4,d5 (long words) move.b d6,d1 jsr ReadHSL(pc) movem.l (sp)+,d0-d2 * If Lev0=0, Sat0 and Hue0 are not defined and must be set to * Sat1 and Hue1 ; if Sat0=0, Hue0 is not defined and must be set * to Hue1 ; similarly if Lev1=0 or Sat1=0. tst.w d5 beq set1 tst.w d4 beq set2 set6: tst.w d2 beq set3 tst.w d1 beq set4 bra set5 set1: move.w d1,d4 ; if Lev1=0, updates Sat1 move.w d1,22(a2) set2: move.w d0,d3 ; if Lev1=0 or Sat1=0, updates Hue1 move.w d0,(a2) bra set6 set3: move.w d4,d1 ; if Lev0=0 set4: move.w d3,d0 ; if Lev0=0 or Sat0=0 * Variations of HSL and variations per step set5: sub.l d3,d0 ; substracts initial HSL values sub.l d4,d1 sub.l d5,d2 * The hue variation must not go beyond +/- $8000 : one must not go * from hue (F,1,0) to (F,0,1) by crossing the whole palette !! cmp.l #$8000,d0 ble set51 sub.l #$FFFF,d0 ; if d0>$8000, replace d0 with bra set52 ; d0-$FFFF set51: cmp.l #-$8000,d0 ; if -$8000RVB conversion jsr ModifyColTab(pc) dbf d7,SprLp move.b d4,(a3) ; restores initial Col0 Spr22: move.l #160,d0 Toto: jsr To(pc) PUSH b,#0,GdgInhib ; reactivates gadgets clr.b d6 mousegaf: jsr LoadColors(pc) ; loads Color Table setcurs: jsr ColorPtr(pc) ; resets color pointer move.b Col1(pc),d1 ; resets all cursors jsr ReadRVB(pc) ; for color Col1 jsr RVBHSL(pc) jsr Refresh(pc) ; refreshes gadgets bra msg ReadHSL: lea HuePot(pc),a2 ; obtain the increments for HSL-pots. jsr ReadRVB(pc) ; reads RVB for color d1 jsr RVBHSL(pc) clr.l d3 clr.l d4 clr.l d5 move.w (a2),d3 move.w 22(a2),d4 move.w 44(a2),d5 ; now d3,d4,d5 = HSL for Color d1 rts * ----------------------------------------------------- * Is message MOUSEMOVE ? If MoveFlag=1, we are dragging the palette. * Otherwise, if d6=1,2,..6, we are moving a proportional gadget : * we modify color 'Col0' and we upgrade the other cursors. cmouse: cmp.l #$10,a2 bne msg move.b MoveFlag(pc),d0 ; are we dragging the palette ? tst.b d0 beq propgdg movem.w d4-d5,-(sp) ; stores MouseX,Y lea MoveWkspce1(pc),a4 movem.w (a4)+,d0-d5 ; recovers arguments for 'rectangle' jsr rectangle(pc) movem.w (sp)+,d0-d1 ; new MouseX,Y in d0,d1 * We must prevent the palette from drifting out of the screen : we * must have 03 the R,V,B-pots are directly set up, * otherwise we must deduce them from H,S,L-pots. Then we change the * Col0-th word of ColTable. cmp.b #3,d6 bhi cm1 jsr HSLRVB(pc) ; only if d6=1,2,3 bra cm2 cm1: jsr RVBHSL(pc) ; only if d6=4,5,6 cm2: jsr Refresh(pc) ; refreshes gadgets jsr ModifyColTab(pc) ; modifies Color Table jsr LoadColors(pc) ; and loads it bra www * ------------------------------------------------- * closes all MainExit: jsr CloseAll(pc) movem.l (sp)+,d0-d7/a0-a6 out: rts *************** END OF MAIN PROGRAM ************** *************** reads and answer messages ******** * The message is read and answered at once if necessary. The occurence * of a message is detected with "bne message/beq no message" * Output : Class -> a2 * IAdress -> a3 * Code -> d3 * MouseX -> d4 * MouseY -> d5 ReadMessage: move.l ExecBase,a6 move.l UserPort(pc),a0 jsr GetMsg(a6) tst.l d0 ; if no message left, we return to beq ReadExit ; the waiting state. * Reading the message: Class (im_Class=$14),IAddress(im_IAddress=$1C) * Code (im_Code=$18), X (im_MouseX=$20) and Y (im_MouseY=$22) move.l d0,a1 move.l $14(a1),a2 ; a2 = Class move.l $1C(a1),a3 ; a3 = IAddress move.w $18(a1),d3 ; d3 = Code move.w $20(a1),d4 ; d4 = MouseX move.w $22(a1),d5 ; d5 = MouseY * If the message is GADGETUP($40), we clear d6 cmp.l #$40,a2 bne read1 clr.b d6 * Answer : the message address is already in a1 read1: jsr ReplyMsg(a6) move.b #1,d0 ; to set up Z=0 (message occurence flag) ReadExit: rts ************* Updates Color Table *************** * Updates the Col0-th word of ColTable according to RVB-pots * Registers are preserved ModifyColTab: movem.l d0-d4/a0-a1,-(sp) lea RPot(pc),a0 clr.l d0 clr.l d1 clr.l d3 move.l #8,d2 move.l #2,d4 ; loop counter (3 colors) Mct: move.w 0(a0,d1),d3 mulu #$F,d3 add.l #$8000,d3 and.l #$F0000,d3 lsr.l d2,d3 add.w d3,d0 add.w #22,d1 ; for next Pot add.w #4,d2 ; for next lsr dbf d4,Mct move.l ColTable(pc),a1 clr.l d1 move.b Col0(pc),d1 lsl.b #1,d1 move.w d0,0(a1,d1) movem.l (sp)+,d0-d4/a0-a1 rts ********* Read RVB from Color Table ************* * enter the color number in d1 (byte) * R,V,B are read and written into RVB-pots ReadRVB: and.l #$FF,d1 clr.l d0 move.l ColTable(pc),a0 asl.w #1,d1 move.w 0(a0,d1.w),d0 ; the 3 last nibbles of d0 are R,V,B lea RPot(pc),a0 move.l #44,d2 ; 0(a0,d2) points to BPot move.l #2,d3 ; loop counter rrvb: move.w d0,d1 and.w #$F,d1 ; only the last nibble remains mulu #$1111,d1 move.w d1,0(a0,d2.w) sub.w #22,d2 ; for next color (V, then R) asr.w #4,d0 dbf d3,rrvb rts ********* Conversion RVB -> HSL ***************** * Reads RVB-Pots and builds up HSL-Pots accordingly * Level = max(R,B,V) ; Saturation = [Level-Min(R,B,V)]/Level * Hue is defined from the triplet (R-Min,V-Min,B-Min)/(Max-Min). * One component of the triplet is 1, another one is 0. Hue is then * defined between 0 and $5F according to : * Triplet 1,x,0 -> Hue=$ x (x coded from 0 to FFFF) * Triplet x,1,0 -> Hue=$1,FFFF-x * Triplet 0,1,x -> Hue=$2,x * Triplet 0,x,1 -> Hue=$3,FFFF-x * Triplet x,0,1 -> Hue=$4,x * Triplet 1,0,x -> Hue=$5,FFFF-x * We thus obtain Hue from 0 to 5FFFF. Lastly, we rescale Hue * between 0 and $FFFF. RVBHSL: movem.l d0-d4/a0,-(sp) clr.l d0 clr.l d4 ; d2,d4 must be cleared (for future clr.l d2 ; divisions) move.w RPot(pc),d1 move.w VPot(pc),d2 move.w BPot(pc),d3 * we sort d1,d2,d3 in increasing order. Each permutation is marked * by adding a special bit to d0 cmp.w d1,d2 bcc rvb1 ; jump if d1= d0 : * 1x0 d0=14 ; x10 d0=12 ; 01x d0=8 ; 0x1 d0=0 ; x01 d0=2 ; 10x d0=10 * 110 d0= 4 ; 011 d0=0 ; 101 d0=2 * 010 d0=8 ; 001 d0=0 100 d0=10 * Only d0=0,10,12 require a reverse coding of x inside Hue tst.b d0 beq rvb5 cmp.b #10,d0 beq rvb5 cmp.b #12,d0 bne rvb6 ; towards normal coding of x rvb5: neg.w d2 ; reverse coding of x add.w d1,d2 rvb6: move.l #12,d3 lsl.l d3,d2 divu d1,d2 ; d2 is now between 0 and FFF lea rvbdata(pc),a0 add.w 0(a0,d0),d2 ; d2 is now Hue between 0 and 6FFF mulu #$2AAA,d2 lsr.l d3,d2 bbb: PUSH w,d2,HuePot rvbexit: movem.l (sp)+,d0-d4/a0 rts rvbdata: dc.w $3000,$4000,0,0,$2000,$5000,$1000,0 ********** Conversion HSL -> RVB **************** * Reads HSL-Pots and builds RVB pots accordingly * Registers are preserved * RPot address is put in a5 => 22(a5) = VPot and 44(a5) = BPot HSLRVB: movem.l d0-d4/a0-a5,-(sp) ccc: lea RPot(pc),a5 * We put the color values into d1,d2,d3, in ascending order. The * RVB order will be extracted from the 1st figure of Hue move.w LevPot(pc),d3 ; Max(R,V,B) clr.l d4 move.w SatPot(pc),d4 bne hsl0 move.w d3,(a5) ; if Sat=0, the 3 colors move.w d3,22(a5) ; have the same level move.w d3,44(a5) bra hslexit * Max(RVB) - Min(RVB) is Level * Saturation hsl0: mulu d3,d4 swap d4 ; d4=Max-Min in 4 nibbles move.w d3,d1 sub.w d4,d1 ; d1 = Min * We now compute the medium color (-> d2). We rescale Hue between * 0 and 5FFFF -> Hue=Axxxx . If A is odd, replace xxxx with * FFFF-xxxx; then multiply xxxx with d4=(Max-Min) clr.l d0 move.w HuePot(pc),d0 mulu #6,d0 move.w d0,d2 ; d2=xxxx btst #16,d0 ; test parity of A beq hsl1 ; if A even neg.w d2 subq.w #1,d2 hsl1: mulu d4,d2 swap d2 add.w d1,d2 * We now dispatch d1,d2,d3 swap d0 and.l #$F,d0 bne hsl2 move.w d3,(a5) ; A=0 ; RVB like 1,x,0 move.w d2,22(a5) move.w d1,44(a5) bra hslexit hsl2: cmp.w #1,d0 bne hsl3 move.w d2,(a5) ; A=1 ; RVB like x,1,0 move.w d3,22(a5) move.w d1,44(a5) bra hslexit hsl3: cmp.w #2,d0 bne hsl4 move.w d1,(a5) ; A=2 ; RVB like 0,1,x move.w d3,22(a5) move.w d2,44(a5) bra hslexit hsl4: cmp.w #3,d0 bne hsl5 move.w d1,(a5) ; A=3 ; RVB like 0,x,1 move.w d2,22(a5) move.w d3,44(a5) bra hslexit hsl5: cmp.w #4,d0 bne hsl6 move.w d2,(a5) ; A=4 ; RVB like x,0,1 move.w d1,22(a5) move.w d3,44(a5) bra hslexit hsl6: move.w d3,(a5) ; A=5 ; RVB like 1,0,x move.w d1,22(a5) move.w d2,44(a5) hslexit: movem.l (sp)+,d0-d4/a0-a5 rts ************* Color pointer ********************** * wipes the original pointer (col0), by rewriting in color 0 * writes a new one (col1) in color 1 * upgrades col0 <- col1 ColorPtr: clr.l d7 move.b Curslen(pc),d7 ; stores Curslen move.l gfxbase(pc),a6 move.l mywindow(pc),a5 move.l myrp(pc),a1 clr.l d0 jsr SetDrMd(a6) ; mode JAM1 move.l #0,d0 ; color 0 jsr cursor(pc) PUSH b,Col1(pc),Col0 move.l #1,d0 ; color 1 jsr cursor(pc) rts * the cursor is made with two lines of length Curslen, starting * from X,Y and X,Y+9 with X=Curslen*Col0+XColMin+Window_X_offset * and Y=YCol-1+Window_Y_offset cursor: move.l myrp(pc),a1 ; sets color d0 (fixed when jsr SetAPen(a6) ; calling) move.l #1,d3 clr.l d1 curs1: clr.l d0 move.b Col0(pc),d0 mulu d7,d0 add.w #XColMin,d0 add.w 4(a5),d0 ; adds X offset add.w #30,d1 ; YCol-1=30 add.w 6(a5),d1 ; adds Y window offset in raster move.l myrp(pc),a1 movem.l d0-d1/a1,-(sp) jsr Move(a6) ; sets graphic cursor movem.l (sp)+,d0-d1/a1 add.w d7,d0 subq.w #1,d0 jsr Draw(a6) move.l #9,d1 dbf d3,curs1 rts *********** Refreshing all the gadgets ************* Refresh: lea GdgHue(pc),a0 move.l mywindow(pc),a1 move.l #0,a2 move.l intuibase(pc),a6 jsr RefreshGadgets(a6) rts ********* loading & saving the color table SaveTableInit: move.l ColTable(pc),a0 move.l ColTableInit(pc),a1 bra coltransf SaveTabUndo: move.l ColTable(pc),a0 move.l ColTabUndo(pc),a1 bra coltransf LoadTabUndo: move.l ColTable(pc),a1 move.l ColTabUndo(pc),a0 jsr coltransf(pc) bra LoadColors LoadTableInit: move.l ColTable(pc),a1 move.l ColTableInit(pc),a0 jsr coltransf(pc) LoadColors: move.l myvp(pc),a0 move.l ColTable(pc),a1 clr.l d0 move.b ColNumb(pc),d0 move.l gfxbase(pc),a6 jsr LoadRGB4(a6) rts coltransf: clr.l d0 move.b ColNumb(pc),d0 subq.b #1,d0 coltr2: move.w (a0)+,(a1)+ dbf d0,coltr2 rts ********* text for COPY and SPREAD ************** * The X offset must be already in d0 textto: dc.b 'TO ?' ; text to be printed To: move.l mywindow(pc),a0 add.w 4(a0),d0 ; absolute X move.l #9,d1 add.w 6(a0),d1 ; absolute Y lea textto(pc),a2 move.b #4,d2 ; for 4 characters move.l #6,d3 ; for JAM1,INSVERSVID,COMPLEMENT ; we directly enter the print routine ********* print routine ************************* * the following registers must loaded before calling : * d0,d1 : X,Y for first character (raster coordinates, as long words) * d2 : number of characters (byte) * d3 : drawing mode (long word) * a2 : text address prtxt: move.l myrp(pc),a5 move.l a5,a1 move.l gfxbase(pc),a6 jsr Move(a6) move.l a5,a1 move.l d3,d0 ; JAM1, INVERSVID, COMPLEMENT jsr SetDrMd(a6) move.l a5,a1 move.l a2,a0 move.b d2,d0 jsr Text(a6) rts ********* draws a rectangle ********************* * The following registers must be loaded when calling : * d0,d1 = x0,y0 (top left) ; d2 = width ; d3 = height * (Only lower words are considered) * Use a 3-longword workspace rectangle: move.l gfxbase(pc),a6 move.l ColTableInit(pc),a5 adda.l #76,a5 ; end of the workspace move.l myrp(pc),a1 and.l #$FFFF,d0 and.l #$FFFF,d1 movem.l d0-d1/a1,-(a5) jsr Move(a6) movem.l (a5)+,d0-d1/a1 add.w d2,d0 bsr side movem.l (a5)+,d0-d1/a1 add.w d3,d1 bsr side movem.l (a5)+,d0-d1/a1 sub.w d2,d0 bsr side movem.l (a5)+,d0-d1/a1 sub.w d3,d1 side: movem.l d0-d1/a1,-(a5) jsr Draw(a6) movem.l (a5)+,d0-d1/a1 sub.l #12,a5 jsr Move(a6) rts ********* get addresses of viewport, rastport, ColorTable... GetAddrs: move.l ToScreen(pc),d1 ; Screen address move.l d1,a1 add.l #44,d1 PUSH l,d1,myvp PUSH w,12(a1),ScrWidth PUSH w,14(a1),ScrHeight adda.l #84,a1 PUSH l,a1,myrp ; pointer -> rastport suba.l #40,a1 ; restores a1=viewport adda.l #4,a1 ; (vp_ColorMap=4) move.l (a1),a1 ; a1=ColorMap adda.l #4,a1 ; (cm_ColorTable=4) PUSH l,(a1),ColTable ; ColorTable * depth move.l myrp(pc),a1 adda.l #4,a1 ; (rp_BitMap=4) move.l (a1),a1 ; a1=BitMap adda.l #5,a1 ; (bm_Depth=5) PUSH b,(a1),Depth * number of independent colors clr.l d0 move.b Depth(pc),d0 cmp.b #6,d0 ; the 6th bitplane must never be bne clnb1 ; taken into account. The 5th bitplane move.b #5,d0 ; must be ignored in case of HAM move.l myvp(pc),a0 move.l 32(a0),d1 ; d1=ViewMode and.l #$800,d1 ; V_HAM=$800 beq clnb1 move.b #4,d0 clnb1: move.l #1,d1 asl.w d0,d1 PUSH b,d1,ColNumb rts ******** opens libraries and workspace for ColorTables ********* * returns z=0 in case of failure (then : bne success/ beq failure) * increments OpenFlag at each step . OpenFlag is set to 4 in case of * complete success. This flag will be used in the Exit routine; also * as a error flag OpenAll: lea OpenFlag(pc),a5 move.b #0,(a5) move.l ExecBase,a6 lea dosname(pc),a1 ; opens dos.library jsr OpenLib(a6) PUSH l,d0,dosbase beq OpenExit ; if failure addq.b #1,(a5) ; OpenFlag = 1 lea gfxname(pc),a1 ; opens graphics.library jsr OpenLib(a6) PUSH l,d0,gfxbase beq OpenExit ; if failure addq.b #1,(a5) ; OpenFlag = 2 lea intuiname(pc),a1 ; opens intuition.library jsr OpenLib(a6) PUSH l,d0,intuibase beq OpenExit ; if failure addq.b #1,(a5) ; OpenFlag=3 if all libs opened move.l ExecBase,a6 ; attempts to open a workspace move.l #ClearPublic,d1 ; of 2 x 64 bytes for move.l #140,d0 ; 2 color tables + 3 longwords for jsr AllocMem(a6) ; 'rectangle' function beq OpenExit PUSH l,d0,ColTabUndo add.l #64,d0 PUSH l,d0,ColTableInit addq.b #1,(a5) ; OpenFlag=4 if workspace opened OpenExit: rts ************** Opens the palette window ****************** * First, we must prepare the gadget structure OpensWindow: lea Nwindow(pc),a0 lea GdgHue(pc),a1 move.l a1,18(a0) ; GdgHue is the 1st gadget * we now link the 11 other gadgets move.l #10,d0 ; for a 11-turn loop ggl1: move.l a1,a2 adda.l #44,a2 ; address of next gadget move.l a2,(a1) move.l a2,a1 dbf d0,ggl1 * we now link Image and PropInfo structures for prop. gadgets move.l #5,d0 ; for 6 gadgets lea GdgHue(pc),a1 lea GdgHIm(pc),a2 lea HueSpec(pc),a3 ggl2: move.l a2,18(a1) move.l a3,34(a1) adda.l #44,a1 adda.l #8,a2 adda.l #22,a3 dbf d0,ggl2 move.l intuibase(pc),a6 jsr OpenWindow(a6) beq OpenExit ; window not opened addq.b #1,(a5) ; OpenFlag=5 if Window opened PUSH l,d0,mywindow ; => Struct. Window move.l d0,a0 adda.l #86,a0 ; wd_UserPort=86 move.l (a0),a1 PUSH l,a1,UserPort rts ******************* Closing ************************ * Closes the screen and window possibly opened for display, then * closes all the elements opened in OpenAll (successively : ColTab1 * intuition.lib, gfx.lib, dos.lib ). The entry point depends * on the value of OpenFlag (copied into d7) CloseAll: move.b OpenFlag(pc),d7 move.l intuibase(pc),a6 cmp.b #5,d7 bne clwkspce ; window not opened move.l mywindow(pc),a0 jsr CloseWindow(a6) subq.b #1,d7 clwkspce: cmp.b #4,d7 bne clintui ; workspace not opened move.l ColTabUndo(pc),a1 move.l #140,d0 jsr FreeMem(a6) subq.b #1,d7 clintui: move.l ExecBase,a6 cmp.b #3,d7 bne clgfx ; Intuition was not opened move.l intuibase(pc),a1 ; closes intuition.library jsr CloseLibrary(a6) subq.b #1,d7 clgfx: cmp.b #2,d7 bne cldos ; gfx not opened move.l gfxbase(pc),a1 ; closes graphics.library jsr CloseLibrary(a6) subq.b #1,d7 cldos: cmp.b #1,d7 bne clexit ; dos not opend move.l dosbase(pc),a1 ; closes dos.library jsr CloseLibrary(a6) clexit: rts **************** VARIABLES ********************** dosname: dc.b 'dos.library',0 gfxname: dc.b 'graphics.library',0 even intuiname: dc.b 'intuition.library',0 dosbase: dc.l 0 gfxbase: dc.l 0 intuibase: dc.l 0 myscreen: dc.l 0 myrp: dc.l 0 myvp: dc.l 0 mywindow: dc.l 0 UserPort: dc.l 0 ColorChange: dc.l 0 * NewScreen structure Nscreen: dc.w 0,0 ScrWidth: dc.w 320 ScrHeight: dc.w 200 dc.w 5,$0100,0,15 dc.l 0,0,0,0 ; default font,no title,no gadget,no bitmap * NewWindow structure * IDCMP: MOUSEBUTTONS($8),MOUSEMOVE($10),GADGETDOWN($20),GADGETUP($40) * flags: REPORTMOUSE($200) XNw=10 YNw=20 Nwindow: dc.w XNw,YNw,307,42,$0001 dc.l $78,$200,GdgHue,0,0 ToScreen: dc.l 0,0,0,0 ; ToScreen will be initialised dc.w 15 ; CUSTOMSCREEN * Image structure for filling a 8x8 rectangle * (10 words which can be re-used after initialisation) InitImage: dc.w 0,0,8,8,0,0,0,0,0,0 OpenFlag: dc.b 0 ; opening error flag GdgInhib: dc.b 0 ; inhibits GADGETDOWN MoveFlag: dc.b 0 ; flag for MOVE gadget Curslen: dc.b 0 ; length of color cursor Col0: dc.b 0 Col1: dc.b 0 Depth: dc.b 0 ColNumb: dc.b 0 MoveWkspce1: dcb.w 6 ; workspace for MOVE MoveWkspce: ; function ColTable: dc.l 0 ColTabUndo: dc.l 0 ColTableInit: dc.l 0 * Gadgets : 1st line at y=YGdg1, * 2nd line at YGdg2, color range at Ycol YGdg1=13 YGdg2=YGdg1+9 Ycol=YGdg2+9 XColMin=10 * Proportional gadgets * Flags: GADGHNONE(3), GADGIMAGE(4) * Activation flags: GADGIMMEDIATE(2),FOLLOWMOUSE(8),RELVERIFY(1) GdgHue: dc.l GdgSat dc.w 14,YGdg1,126,4 dc.w 7,11,3 ; (flags,activation, PROP) dc.l GdgHIm,0,0,0,HueSpec dcb.w 3 GdgSat: dc.l GdgLev dc.w 154,YGdg1,66,4 dc.w 7,11,3 ; (flags,activation, PROP) dc.l GdgSIm,0,0,0,SatSpec dcb.w 3 GdgLev: dc.l GdgR dc.w 236,YGdg1,66,4 dc.w 7,11,3 ; (flags,activation, PROP) dc.l GdgLIm,0,0,0,LevSpec dcb.w 3 * second line of gadgets GdgR: dc.l GdgV dc.w 14,YGdg2,66,4 dc.w 7,11,3 ; (flags,activation, PROP) dc.l GdgRIm,0,0,0,RSpec dcb.w 3 GdgV: dc.l GdgB dc.w 95,YGdg2,66,4 dc.w 7,11,3 ; (flags,activation, PROP) dc.l GdgVIm,0,0,0,VSpec dcb.w 3 GdgB: dc.l GdgUndo dc.w 175,YGdg2,66,4 dc.w 7,11,3 ; (flags,activation, PROP) dc.l GdgBIm,0,0,0,BSpec dcb.w 3 * Boolean gadgets * flag = GADGHCOMP(0) * activation = GADGIMMEDIATE(2) GdgUndo: dc.l GdgOK dc.w 251,YGdg2-2,32,8 dc.w 1,2,1 ; (flag,activ.,BOOLEAN) dc.l 0,0,0 ; no imagery, text dcb.w 7 GdgOK: dc.l GdgCopy dc.w 3,2,16,8 dc.w 0,2,1 ; (flag,activ.,BOOLEAN) dc.l 0,0,0 ; no imagery, text dcb.w 7 GdgCopy: dc.l GdgSpread dc.w 32,2,32,8 dc.w 0,2,1 ; (flag,activ.,BOOLEAN) dc.l 0,0,0 ; no imagery, text dcb.w 7 GdgSpread: dc.l GdgCancel dc.w 110,2,48,8 dc.w 0,2,1 ; (flag,activ.,BOOLEAN) dc.l 0,0,0 ; no imagery, text dcb.w 7 GdgCancel: dc.l GdgMove dc.w 200,2,48,8 dc.w 0,2,1 ; (flag,activ.,BOOLEAN) dc.l 0,0,0 ; no imagery, text dcb.w 7 GdgMove: dc.l 0 dc.w 270,2,32,8 dc.w 0,2,1 ; (flag,activ.,BOOLEAN) dc.l 0,0,0 ; no imagery, text dcb.w 7 GdgHIm: dcb.w 4 GdgSIm: dcb.w 4 GdgLIm: dcb.w 4 GdgRIm: dcb.w 4 GdgVIm: dcb.w 4 GdgBIm: dcb.w 4 * SpecialInfo structures for Proportional Gadgets * flags: AUTOKNOB(1), FREEHORIZ(2), PROPBORDERLESS(8) => 11 HueSpec: dc.w 11 HuePot: dc.w $8000,0 dc.w 0 dcb.w 7 SatSpec: dc.w 11 SatPot: dc.w $8000,0 dc.w 0 dcb.w 7 LevSpec: dc.w 11 LevPot: dc.w $8000,0 dc.w 0 dcb.w 7 RSpec: dc.w 11 RPot: dc.w $3000,0 dc.w 0 dcb.w 7 VSpec: dc.w 11 VPot: dc.w $C000,0 dc.w 0 dcb.w 7 BSpec: dc.w 11 BPot: dc.w $8000,0 dc.w 0 dcb.w 7 xx0=XNw+4 ggdata: dc.w YNw+9,2,xx0,4,xx0+32,6,xx0+104,6,xx0+196,4,xx0+264,0 dc.w YNw+17,1,xx0,1,xx0+140,1,xx0+222,0 dc.w YNw+26,1,xx0,1,xx0+81,1,xx0+161,4,xx0+247,0 ggtxt: dc.b 'OKCOPYSPREADCANCELMOVEHSLRVBUNDO' * gadget container Container: dc.w 13+XNw,12+YNw,127,5,67 dc.w XNw+153,YNw+12,XNw+235,YNw+12 dc.w XNw+13,YNw+21,XNw+94,YNw+21,XNw+174,YNw+21 fin: end