diff --git a/BuildResults/RISC/Lib/CQD.lib b/BuildResults/RISC/Lib/CQD.lib deleted file mode 100644 index b970d22..0000000 Binary files a/BuildResults/RISC/Lib/CQD.lib and /dev/null differ diff --git a/BuildResults/RISC/Lib/MoreCQD.lib b/BuildResults/RISC/Lib/MoreCQD.lib new file mode 100644 index 0000000..c2f65e0 Binary files /dev/null and b/BuildResults/RISC/Lib/MoreCQD.lib differ diff --git a/Interfaces/AIncludes/Processes.a b/Interfaces/AIncludes/Processes.a index ac3e08a..b31d444 100644 --- a/Interfaces/AIncludes/Processes.a +++ b/Interfaces/AIncludes/Processes.a @@ -202,7 +202,8 @@ processAppSpec EQU 56 MACRO _GetFrontProcess - PEA $FFFFFFFF + MOVEQ.L #$FFFFFFFF,D0 + MOVE.L D0,-(SP) MOVE.W #$39,-(SP) _OSDispatch ENDM diff --git a/Internal/Asm/ColorEqu.a b/Internal/Asm/ColorEqu.a index f85f05a..23e6656 100644 --- a/Internal/Asm/ColorEqu.a +++ b/Internal/Asm/ColorEqu.a @@ -266,7 +266,7 @@ PMFlag EQU $8000 ; flag to say it's a new pixMap cPortFlag EQU $C000 ; isPixMap+isCPort pixVersion EQU $0000 ; isPixMap -qdStackXtra EQU $0640 ; stack space left for interrupts <1.4> BAL +qdStackXtra EQU $0800 ; stack space left for interrupts <1.4> BAL isPixMap EQU 15 ; for testing high bit of pRowbytes isCPort EQU 14 ; indicates that "bitmap" belongs to port @@ -376,7 +376,7 @@ CCSTATEREGS EQU CCDEPTH+2 ;[16 BYTES] STATE INFO OF SAVED DATA CCBYTES EQU CCSTATEREGS+16 ;[WORD] ROWBYTES OF EXPANDED DATA CCMAXDEPTH EQU CCBYTES+2 ;[WORD] MAXIMUM SCREEN DEPTH -CCSAVEREC EQU CCMAXDEPTH+2 ;SIZE OF CURSOR SAVE AREA +CCSAVEREC EQU CCMAXDEPTH+2+8 ;SIZE OF CURSOR SAVE AREA ; Font Manager low mem ; diff --git a/Internal/Asm/fontPrivate.a b/Internal/Asm/fontPrivate.a index 405a0b4..a2b1f90 100644 --- a/Internal/Asm/fontPrivate.a +++ b/Internal/Asm/fontPrivate.a @@ -265,70 +265,110 @@ selectInitializediskCache equ $0010 ; <24> MACRO _sbIsOutline IMPORT SplineMgr - MOVEQ #sbIsOutline,D0 + LCLC &OLDOPT +&OLDOPT SETC &Setting('OPT') + OPT NONE + MOVE #sbIsOutline,D0 + OPT &OLDOPT _SplineMgr ENDM MACRO _sbRetrieveGlyph IMPORT SplineMgr - MOVEQ #sbRetrieveGlyph,D0 + LCLC &OLDOPT +&OLDOPT SETC &Setting('OPT') + OPT NONE + MOVE #sbRetrieveGlyph,D0 + OPT &OLDOPT _SplineMgr ENDM MACRO _sbKillSomeCaches IMPORT SplineMgr - MOVEQ #sbKillSomeCaches,D0 + LCLC &OLDOPT +&OLDOPT SETC &Setting('OPT') + OPT NONE + MOVE #sbKillSomeCaches,D0 + OPT &OLDOPT _SplineMgr ENDM MACRO _sbFillWidthTab IMPORT SplineMgr - MOVEQ #sbFillWidthTab,D0 + LCLC &OLDOPT +&OLDOPT SETC &Setting('OPT') + OPT NONE + MOVE #sbFillWidthTab,D0 + OPT &OLDOPT _SplineMgr ENDM MACRO _sbResetWorkSpace IMPORT SplineMgr - MOVEQ #sbResetWorkSpace,D0 + LCLC &OLDOPT +&OLDOPT SETC &Setting('OPT') + OPT NONE + MOVE #sbResetWorkSpace,D0 + OPT &OLDOPT _SplineMgr ENDM MACRO _sbInitMemory IMPORT SplineMgr - MOVEQ #sbInitMemory,D0 + LCLC &OLDOPT +&OLDOPT SETC &Setting('OPT') + OPT NONE + MOVE #sbInitMemory,D0 + OPT &OLDOPT _SplineMgr ENDM MACRO _sbSetFontState IMPORT SplineMgr - MOVEQ #sbSetFontState,D0 + LCLC &OLDOPT +&OLDOPT SETC &Setting('OPT') + OPT NONE + MOVE #sbSetFontState,D0 + OPT &OLDOPT _SplineMgr ENDM MACRO _sbSearchForCache IMPORT SplineMgr - MOVEQ #sbSearchForCache,D0 + LCLC &OLDOPT +&OLDOPT SETC &Setting('OPT') + OPT NONE + MOVE #sbSearchForCache,D0 + OPT &OLDOPT _SplineMgr ENDM MACRO _sbPreFlightFontMem IMPORT SplineMgr - MOVEQ #sbPreFlightFontMem,D0 + LCLC &OLDOPT +&OLDOPT SETC &Setting('OPT') + OPT NONE + MOVE #sbPreFlightFontMem,D0 + OPT &OLDOPT _SplineMgr ENDM MACRO _fsLowestPPEM IMPORT SplineMgr - MOVEQ #fsLowestPPEM,D0 + LCLC &OLDOPT +&OLDOPT SETC &Setting('OPT') + OPT NONE + MOVE #fsLowestPPEM,D0 + OPT &OLDOPT _SplineMgr ENDM @@ -341,19 +381,31 @@ selectInitializediskCache equ $0010 ; <24> MACRO _sbFlushFonts IMPORT SplineMgr - MOVEQ #sbFlushFonts,D0 + LCLC &OLDOPT +&OLDOPT SETC &Setting('OPT') + OPT NONE + MOVE #sbFlushFonts,D0 + OPT &OLDOPT _SplineMgr ENDM Macro ; <24> _InitializePartialFonts ; <24> - moveq #selectInitializePartialFonts,d0 ; <24> + LCLC &OLDOPT +&OLDOPT SETC &Setting('OPT') + OPT NONE + MOVE #selectInitializePartialFonts,d0 ; <24> + OPT &OLDOPT _SplineMgr ; <24> EndM ; <24> Macro ; <24> _InitializeDiskCache ; <24> - moveq #selectInitializeDiskCache,d0 ; <24> + LCLC &OLDOPT +&OLDOPT SETC &Setting('OPT') + OPT NONE + MOVE #selectInitializeDiskCache,d0 ; <24> + OPT &OLDOPT _SplineMgr ; <24> EndM ; <24> diff --git a/QuickDraw/BitMaps.a b/QuickDraw/BitMaps.a index 2283875..eab2aba 100644 --- a/QuickDraw/BitMaps.a +++ b/QuickDraw/BitMaps.a @@ -1071,12 +1071,42 @@ NXTDST MOVE.L (A4)+,D1 ;GET NEXT DST DEVICE MOVE.L srcDevice,A1 ;handle to source gDevice move.l (a1),a1 ;pointer to source gDevice move.l gdRect(a1),d0 ;get rect top.left - move.l theGDevice,a1 ;handle to destination gDevice - move.l (a1),a1 ;pointer to destination gDevice - cmp.l gdRect(a1),d0 ;dest and src gDevice have same top-left? - beq.s nxtdst ;devices overlap, skip drawing - - + move.l theGDevice,a0 ;handle to destination gDevice + move.l (a0),a0 ;pointer to destination gDevice + + CMP $24(A0), D0 + BGT.S @L5 + BLT.S @L2 + SWAP D0 + CMP gdRect+0(A0), D0 + BGT.S @L6 + BLT.S @L3 + MOVE.L gdRect+4(A1), D0 + CMP gdRect+6(A0), D0 + BLT.S @L7 + BGT.S @L4 + BRA.S nxtdst +@L2 SWAP D0 + CMP gdRect+0(A0), D0 + BGT.S @cont +@L3 MOVE.L gdRect+4(A1), D0 + CMP gdRect+6(A0), D0 + BLT.S @cont +@L4 SWAP D0 + CMP gdRect+4(A0), D0 + BLT.S @cont + BRA.S nxtdst +@L5 SWAP D0 + CMP gdRect+0(A0), D0 + BLT.S @cont +@L6 MOVE.L gdRect+4(A1), D0 + CMP gdRect+6(A0), D0 + BGT.S @cont +@L7 SWAP D0 + CMP gdRect+4(A0), D0 + BGT.S @cont + BRA.S nxtdst + @cont ; ; End of @@ -1711,11 +1741,91 @@ DSTRECT EQU MASKRECT-4 ;long, addr of Rect MODE EQU DSTRECT-2 ;WORD MASKRGN EQU MODE-4 ;LONG, RGNHANDLE -VARSIZE EQU 0 +VARSIZE EQU -4 share LINK A6,#VARSIZE ;ALLOCATE STACK FRAME MOVEM.L D3-D7/A2-A4,-(SP) ;SAVE WORK REGISTERS FOR DEVLOOP - + + CLR.L -4(A6) + MOVE.L MASKBITS(A6), D0 + BEQ @skip + MOVEA.L D0, A0 + CMPI #$1, $20(A0) + BNE @skip + MOVEA.L $16(A6), A0 + MOVEA.L $E(A6), A1 + MOVE $4(A0), D0 + SUB (A0), D0 + SUB $4(A1), D0 + ADD (A1), D0 + BGT.B @L0 + MOVE $6(A0), D0 + SUB $2(A0), D0 + SUB $6(A1), D0 + ADD $2(A0), D0 + BLE @skip +@L0 SUBQ #$4, SP + DC.W $AA18 ;_GetCTable + MOVE.L (SP)+, D3 + BEQ @skip + SUBQ #$2, SP + PEA.L -4(A6) + MOVE #$2, -(SP) + PEA.L MASKRECT(A6) + MOVE.L D3, -(SP) + CLR.L -(SP) + PEA 4 + MOVE.L #$160000,D0 ;_QDExtensions -> _NewGWorld + DC.W $AB1D + MOVE (SP)+, D4 + BNE.B @L1 + TST.L -4(A6) + BNE.B @L2 +@L1 SUBQ #$2, SP + PEA.L -4(A6) + MOVE #$2, -(SP) + PEA.L MASKRECT(A6) + MOVE.L D3, -(SP) + CLR.L -(SP) + CLR.L -(SP) + MOVE.L #$160000,D0 ;_QDExtensions -> _NewGWorld + DC.W $AB1D + MOVE (SP)+, D4 +@L2 MOVE.L D3, -(SP) + DC.W $AA24 ;_DisposCTable + TST D4 + BNE.B @skip + MOVE.L -4(A6), D0 + BEQ.B @skip + MOVEA.L D0, A3 + SUBQ #$8, SP + PEA.L $4(SP) + PEA.L $4(SP) + MOVE.L #$80005,D0 ;_QDExtensions -> _GetGWorld + DC.W $AB1D + MOVE.L -4(A6), -(SP) + CLR.L -(SP) + MOVE.L #$80006,D0 ;_QDExtensions -> _SetGWorld + DC.W $AB1D + MOVE.L MASKBITS(A6), -(SP) + PEA.L $2(A3) + MOVE.L MASKRECT(A6), -(SP) + PEA.L $10(A3) + CLR -(SP) + CLR.L -(SP) + DC.W $A8EC ;_CopyBits + SUBQ #$2, SP + MOVE.L $2(A3), -(SP) + MOVE.L #$40001,D0 ;_QDExtensions -> _LockPixels + DC.W $AB1D + ADDQ #$2, SP + MOVEA.L $2(A3), A0 + _HLock + MOVE.L (A0), MASKBITS(A6) + MOVE.L #$80005,D0 ;_QDExtensions -> _GetGWorld + DC.W $AB1D +@skip + ; SET UP REGISTERS FOR CALLING CMDEVLOOP MOVE.L DSTBITS(A6),A1 ;GET DST BIT/PIXMAP @@ -1763,7 +1873,15 @@ SRCOK MOVE.L DSTBITS(A6),A0 ;POINT TO DSTBITS NOTPORT MOVE.L DSTBITS(A6),A1 ;Pass DSTBITS (not derefed) JSR CMDevLoop ;AND DRAW THE IMAGE - + + MOVE.L -4(A6),D0 + BEQ.S @skipQDCall + + MOVE.L D0,-(SP) + MOVE.L #$40004,D0 ;_QDExtensions -> _DisposeGWorld + DC.W $AB1D +@skipQDCall + MOVEM.L (SP)+,D3-D7/A2-A4 ;RESTORE WORK REGISTERS UNLINK PARAMSIZE,'KopyMask' @@ -2296,9 +2414,9 @@ cutOutDevices move.l pmTable(a0),a0 ;get handle to source color table move.l (a0),a0 ;deref it cmp.l ctSeed(a0),d1 ;do the color tables seeds match ? - beq.s @next + beq @next - movem.l d1/a1,-(sp) ;save our scratch registers + movem.l d1/a1-a3,-(sp) ;save our scratch registers clr.b -(sp) ;make space for boolean result pea tempRect1(a6) ;pointer to the SrcRect in global coordinates @@ -2307,7 +2425,34 @@ cutOutDevices pea tempRect2(a6) ;pointer to the result _SectRect ;get the intersection tst.b (sp)+ ;if they didn't intersect at all, then skip to - beq.s @skip ;..the next device + beq @skip ;..the next device + + move.l (a1),a0 + move.l GDPMap(a0),a0 + move.l (a0),a0 + move.l pmTable(a0),a0 + move.l (a0),a0 + move.l (DeviceList),a2 +@again move.l (a2),a2 + move.l GDPMap(a2),a3 + move.l (a3),a3 + move.l pmTable(a3),a3 + move.l (a3),a3 + move.l (a3),d0 + cmp.l (a0),d0 + bne @done + sub.l #8,sp + clr.b -(sp) + pea.l tempRect1(a6) + pea.l $22(a2) + pea.l $a(sp) + _SectRect + tst.b (sp)+ + add.l #8,sp + bne @skip +@done move.l GDNextGD(a2),d0 + move.l d0,a2 + bne.s @again lea tempRect2(a6),a0 ;point to our temp rect pea topleft(a0) ;convert the temp rect back to local coordinates @@ -2323,7 +2468,7 @@ cutOutDevices move.l d6,-(sp) _DiffRgn -@skip movem.l (sp)+,d1/a1 ;restore our scratch registers +@skip movem.l (sp)+,d1/a1-a3 ;restore our scratch registers @next move.l (a1),a0 ;deref the current device list handle move.l GDNextGD(a0),d0 ;get the next device handle into D0 diff --git a/QuickDraw/CCrsrCore.a b/QuickDraw/CCrsrCore.a index 914e811..3fa53e7 100644 --- a/QuickDraw/CCrsrCore.a +++ b/QuickDraw/CCrsrCore.a @@ -102,330 +102,60 @@ cursorShadow EQU 0 -CRSRCORE PROC EXPORT - EXPORT CrsrVBLTask +ShieldCursor PROC EXPORT +;--------------------------------------------------------- +; +; PROCEDURE ShieldCursor(shieldRect: Rect; offset: Point); +; +; ALL REGS PRESERVED. +; +; Lifted from LCursor.a +; + IMPORT QDNew_OtherShieldCursor + + MOVEM.L D0-D2/A0-A1,-(SP) ;SAVE REGS + MOVE.L 28(SP),D0 + MOVE.L 24(SP),D1 + MOVE.L D0,-(SP) ;PUSH GLOBAL TOP + MOVE.L D1,-(SP) ;PUSH GLOBAL LEFT + JSR QDNew_OtherShieldCursor + MOVEM.L (SP)+,D0-D2/A0-A1 ;RESTORE REGS + RTD #8 + + +CRSRCORE PROC EXPORT EXPORT InitCrTable EXPORT PinRect - IMPORT ScrnAddress - IMPORT ScrnSize - IMPORT ScrnBitMap - IMPORT PATCONVERT ; expand routine for color cursors/patterns - IMPORT AllocCrsr ; proc at end of file - IMPORT SETCRSRDATA ; PROC AT END OF FILE - IMPORT SHFTTBL ; TO CONVERT DEPTH TO SHIFT - IMPORT RGetHSize + IMPORT _HideCursor + IMPORT _ShowCursor + IMPORT _ShieldCursor + IMPORT _ScrnAddress + IMPORT _ScrnSize + IMPORT _InitCursor + IMPORT _SetCursor + IMPORT _ObscureCursor + IMPORT AllocCrsr + IMPORT _SetCCursor - IMPORT BLITCURSOR,UNBLITCURSOR ; Cursor Pixelling - EXPORT DRAWCURSOR,ERASECURSOR ; Cursor Displaying - EXPORT CursorSect - EXPORT GETMAINCRSR ;JUST USED INTERNALLY ; ; offset table for jump table initialization ; InitCrTable - DC.W HideCursor-InitCrTable - DC.W ShowCursor-InitCrTable - DC.W ShieldCursor-InitCrTable - DC.W ScrnAddress-InitCrTable - DC.W ScrnSize-InitCrTable - DC.W InitCursor-InitCrTable - DC.W SetCursor-InitCrTable - DC.W ObscureCursor-InitCrTable + DC.W _HideCursor-InitCrTable + DC.W _ShowCursor-InitCrTable + DC.W _ShieldCursor-InitCrTable + DC.W _ScrnAddress-InitCrTable + DC.W _ScrnSize-InitCrTable + DC.W _InitCursor-InitCrTable + DC.W _SetCursor-InitCrTable + DC.W _ObscureCursor-InitCrTable DC.W AllocCrsr-InitCrTable - DC.W SetCCursor-InitCrTable + DC.W _SetCCursor-InitCrTable ;_______________________________________________________________________ -; -; CrsrVBLTask - executed once each vertical retrace -; - -; ugly equs - stay here for now! -adbCount EQU 0 ; word: number of valid error deltas -MaxCnt EQU adbCount+2 ; word: limit on number of error deltas -Err7 EQU MaxCnt+2 ; word: time-7 error magnitude -Err6 EQU Err7+2 ; word: time-6 error magnitude -Err5 EQU Err6+2 ; word: time-5 error magnitude -Err4 EQU Err5+2 ; word: time-4 error magnitude -Err3 EQU Err4+2 ; word: time-3 error magnitude -Err2 EQU Err3+2 ; word: time-2 error magnitude -Err1 EQU Err2+2 ; word: time-1 error magnitude -Error EQU Err1+2 ; word: accumulated error -GSize EQU Error+2 - -CrsrVBLTask ;COME HERE ON VERTICAL RETRACE - - If Not forRom Then ;

- TST.B CrsrNew ; Mouse changed? - BEQ TrackDone ; No É return - TST.B CrsrBusy ; Cursor locked? - BNE TrackDone ; Yes É return - - TST.B CrsrCouple ; Cursor coupled to mouse? - BEQ NoComp ; No É skip computation - - MOVE.W MTemp+H,D0 ; Find ÆMx - SUB.W RawMouse+H,D0 - - MOVE.W MTemp+V,D1 ; Find ÆMy - SUB.W RawMouse+V,D1 - - MOVE.W D0,D2 ; x := |ÆMx| - BGE.S AbslXl - NEG.W D2 -AbslXl - - MOVE.W D1,D3 ; y := |ÆMy| - BGE.S AbslYl - NEG.W D3 -AbslYl - - move.l MickeyBytes,a0 ; <10/7/86 SMH> get globals - CMP.W D2,D3 ; D3 := magnitude(x,y) - BLS.S MagDone - EXG D2,D3 -MagDone ASR.W #1,D3 - ADD.W D2,D3 - - BNE.S DoComp ; Zero magnitude É donÕt compute - MOVE.W #1,adbCount(A0) ; No hits - CLR.W Error(A0) ; No errors - BRA DoPin ; Update the cursor -DoComp -; - MOVEM.L D4-D5,-(A7) ; Save off registers - MOVE.W adbCount(A0),D4 ; D4 is the number of samples - CMP.W MaxCnt(A0),D4 ; Is Count less than MaxCnt - BGE.S CountOK - ADD.W #1,adbCount(A0) ; Yes É we will have one more error -CountOK - - MOVE.W D3,D5 ; Magnitude at current time - - MOVE.W D4,D2 ; Get Count - SUB.W #1,D2 ; Index into JTab - ASL.W #1,D2 ; REQUIRES BRA.SÕs IN JUMP TABLES - JMP JTab(PC,D2.W) ; Jump to the right code per Count - -JTab BRA.S E1 ; Count = 1 - BRA.S E2 ; Count = 2 - BRA.S E3 ; Count = 3 - BRA.S E4 ; Count = 4 - BRA.S E5 ; Count = 5 - BRA.S E6 ; Count = 6 - BRA.S E7 ; Count = 7 - -E8 ADD.W Err7(A0),D5 ; Accumulate time-7 magnitude - -E7 ADD.W Err6(A0),D5 ; Accumulate time-6 magnitude - MOVE.W Err6(A0),Err7(A0) ; Shift out time-6 magnitude - -E6 ADD.W Err5(A0),D5 ; Accumulate time-5 magnitude - MOVE.W Err5(A0),Err6(A0) ; Shift out time-5 magnitude - -E5 ADD.W Err4(A0),D5 ; Accumulate time-4 magnitude - MOVE.W Err4(A0),Err5(A0) ; Shift out time-4 magnitude - -E4 ADD.W Err3(A0),D5 ; Accumulate time-3 magnitude - MOVE.W Err3(A0),Err4(A0) ; Shift out time-3 magnitude - -E3 ADD.W Err2(A0),D5 ; Accumulate time-2 magnitude - MOVE.W Err2(A0),Err3(A0) ; Shift out time-2 magnitude - -E2 ADD.W Err1(A0),D5 ; Accumulate time-1 magnitude - MOVE.W Err1(A0),Err2(A0) ; Shift out time-1 magnitude - -E1 MOVE.W D3,Err1(A0) ; Shift out current magnitude - - MOVE.W D4,D2 ; Round up the divide - ASR.W #1,D2 ; by half the denominator - ADD.W D2,D5 - EXT.L D5 ; Set up for the divide - DIVU D4,D5 ; Find the average magnitude - - MOVE.W D3,D4 ; Get the original magnitude - SUB.W D5,D3 ; Find distance to average magnitude - ADD.W Error(A0),D3 ; Add on the accumulated error - CMP.W #-1,D3 ; Define -1 div 2 = 0 - BNE.S DivOK - CLR.W D3 -DivOK ASR.W #1,D3 ; Get half of it - MOVE.W D3,Error(A0) ; Update it - ADD.W D5,D3 ; Desired mag is average+Error - - CMP.W #255,D5 ; mag := MAX(mag,255) - BLS.S MaxDone - MOVE.B #255,D5 -MaxDone - - move.l MickeyBytes,a0 ; <10/7/86 SMH> get at globals - add #GSize,a0 ; <10/24/86 SMH> point to table - - CLR.W D2 ; i := 0 - -Search ADD.B #1,D2 ; repeat - CMP.B (A0)+,D5 ; i := i+1 - BHI.S Search ; until mag ² Table[i] - - MULS D2,D3 ; D4 := i*(Mag(ÆM)+Error) - - MULS D3,D0 ; ÆCx := (ÆMx*i*(Mag(ÆM)+Error))/Mag(ÆM) - DIVS D4,D0 ; <<<<<< D3 >>>>>>> - BMI.S @1 ; branch if minus - ANDI.W #$007F,D0 ; control max displacement (fix mouse jump) - BRA.S @3 -@1 - ORI.W #$FF80,D0 ; control max displacement (fix mouse jump) -@3 - MULS D3,D1 ; ÆCy := (ÆMy*i*(Mag(ÆM)+Error))/Mag(ÆM) - DIVS D4,D1 ; <<<<<< D3 >>>>>>> - BMI.S @5 ; branch if minus - ANDI.W #$007F,D1 ; control max displacement (fix mouse jump) - BRA.S @7 -@5 - ORI.W #$FF80,D1 ; control max displacement (fix mouse jump) -@7 - MOVEM.L (A7)+,D4-D5 ; Restore registers - ADD.W D0,RawMouse+H ; Update raw mouse location - ADD.W D1,RawMouse+V -; -DoPin ; - LEA CrsrPin,A0 ; Bounding rect for cursor - MOVE.L RawMouse,D0 ; Pin mouse inside rect - - Endif ; Not forRom

- - BSR.S ScrnPin ; return to SHOWIT if screen changes - - MOVE.L D0,RawMOUSE ; update cursor loc with clipped pt - MOVE.L D0,MTEMP ; Update real mouse location with "" - - AND.L MOUSEMASK,D0 ; do jerky masking to drop low order bits - MOVE.L MOUSEOffset,D1 ; Get the offset - BEQ.S skipPin ; and skip 2nd pin if not - ADD.L D1,D0 ; do jerky offset - BSR.S ScrnPin ; return to SHOWIT if screen changes - -skipPin MOVE.L D0,MOUSE - -NotCup BSR ERASECURSOR ; HIDE THE CURSOR -SHOWIT CLR.B CRSRNEW ; RESET THE CURSOR CHANGED FLAG - CLR.B CRSROBSCURE ; it's no longer obscured - BSR DRAWCURSOR ; AND SHOW CURSOR IN NEW POSITION - -CRSRDONE ;AND RETURN - RTS - -TrackDone - move.l MickeyBytes,a0 ; <10/7/86 SMH> get globals - MOVE.W #1,adbCount(A0) ; No hits - CLR.W Error(A0) ; No errors - RTS ; Goodbye - -NoComp move.l MickeyBytes,a0 ; <10/7/86 SMH> get globals - MOVE.W #1,adbCount(A0) ; No hits - CLR.W Error(A0) ; No errors - BRA.S NotCup ; Update the cursor - - -; --------end of ugly jcrsrcoreTask - - - -ScrnPin CMP LEFT(A0),D0 ;less than left? - BGE.S LEFTOK ;if not, no problem - BSR.S FindScreen ;=>look for new screen - MOVE LEFT(A0),D0 ;pin to the left - -LEFTOK CMP RIGHT(A0),D0 ;greater than right? - BLT.S RIGHTOK ;if not, no problem WAS BLE!! <05Apr85> - BSR.S FindScreen ;=>look for new screen - MOVE RIGHT(A0),D0 ;pin to the right - SUBQ #1,D0 ;really want one less - -RIGHTOK SWAP D0 ;consider y - CMP TOP(A0),D0 ;less than top? - BGE.S TOPOK ;if not, no problem - SWAP D0 - BSR.S FindScreen ;=>look for new screen - SWAP D0 - MOVE TOP(A0),D0 ;pin to the top - -TOPOK CMP BOTTOM(A0),D0 ;greater than bottom? - BLT.S BOTOK ;if not, no problem WAS BLE!! <05Apr85> - SWAP D0 - BSR.S FindScreen ;=>look for new screen - SWAP D0 - MOVE BOTTOM(A0),D0 ;pin to the bottom - SUBQ #1,D0 ;really want one less - -BOTOK SWAP D0 - RTS ;and return - -; Check to see if cursor has moved to another screen. -; If not, returns with D0 unchanged. -; If so, hides the cursor, updates cursor globals and does messy return. -; -; Clobbers D1-D3/A0-A3 which are preserved by interrupt handler - -FindScreen MOVE D0,D3 ;pt.h in D3 - MOVE.L D0,D1 ;pt.v in D1 - SWAP D1 ;pt.v in D1 - MOVE.L DeviceList,D2 ;get the first GDevice - BMI.S NoDev ;=>just in case no GDevice -DoDev MOVE.L D2,A3 ;get device handle - MOVE.L (A3),A3 ;get device pointer - TST GDFlags(A3) ;is screen active? - BPL.S NxtDev ;=>no, try next device - LEA GDRect(A3),A1 ;point to rect - CMP (A1)+,D1 ;above top? - BLT.S NxtDev ;=>yes, check next device - CMP (A1)+,D3 ;to left of screen? - BLT.S NxtDev ;=>yes, check next device - CMP (A1)+,D1 ;to bottom of screen? - BGE.S NxtDev ;=>yes, check next device - CMP (A1)+,D3 ;to right of screen? - BLT.S GotDev ;=>no, cursor is on this screen -NxtDev MOVE.L GDNextGD(A3),D2 ;get next device in chain - BNE.S DoDev ;=>there is one, check it -NoDev RTS ;else return and pin to current screen - -; cursor has changed devices, update depth and rowbytes for current device - -GotDev MOVE.L CRSRPTR,A0 ;get handle to cursor data - MOVE.L (A0),A0 ;get pointer to cursor data - MOVE.L CrsrDevice,A1 ;get handle to current device - MOVE.L (A1),A1 ;point to current device - MOVE CCDEPTH(A0),GDCCDEPTH(A1) ;copy depth - MOVE CCBYTES(A0),GDCCBYTES(A1) ;copy expanded rowbytes - -; now get the data, depth and rowbytes for the new device - - BSR ERASECURSOR ;else erase the cursor -@0 SWAP D3 ;get pt.h in high word - MOVE D1,D3 ;get pt.v in low word - SWAP D3 ;now get them in the right order - MOVE.L D3,MTEMP ;update real mouse location with "" - MOVE.L D3,RawMOUSE ;update cursor loc with clipped pt - MOVE.L D3,MOUSE ;update mouse position - MOVE.L D2,CrsrDevice ;set the current cursor device - MOVE.L A3,A1 ;get pointer to grafDevice - JSR SetCrsrData ;and set up low-memory stuff for cursor - - MOVE GDREFNUM(A3),D0 ;get the refNum - NOT D0 ;refNum -> unitnum - ASL #2,D0 ;get offset in unitTable - MOVE.L UTableBase,A0 ;get the base of the unit table - MOVE.L (A0,D0),A3 ;A3 = handle to the DCE - MOVE.L (A3),A0 ;get pointer to the DCE - MOVEQ #0,D0 ;clear out D0 - MOVE.B dCtlSlot(A0),D0 ;get the slot number - _ATTACHVBL ;attach vbl to this slot - - ADDQ #8,SP ;strip 2 RTS's from stack - BRA SHOWIT ;=>and go display cursor on new screen ; This routine is used by the pinrect routine below and is also called directly @@ -473,68 +203,6 @@ PinRect JMP (A0) ;return to caller -;_______________________________________________________________________ ; -; ; -; PROCEDURE CursorSect -- called by shieldcursor, showcursor ; -; ; -; Does a sectrect of CrsrRect and ShieldRect, all global-cošrd like. ; -; CLEAR the z-flag if they DO intersect: BNE YesTheyIntersect. -; This code is was moved out of ShieldCursor. ; -; -; Since CrsrRect is in local screen cošrds, and ShieldRect is in globals, -; the CrsrDevice's GDRect is used as an offset. -;_______________________________________________________________________ ; -CursorSect MOVEM.L A0/A1/D0,-(SP) ;save the approprate regs - - TST ShieldDepth ;Any shielding? - BEQ.s @NoSect - - LEA CrsrRect,A0 ;point to crsr rect ; - MOVE.L CrsrDevice,A1 ;GET CURSOR DEVICE ; - MOVE.L (A1),A1 ;POINT TO CURSOR DEVICE ; - ADD #GDRECT,A1 ;POINT TO DEVICE'S RECT ; - - MOVE ShieldRect+Bottom,D0 ;GET SHIELD BOTTOM ; - SUB TOP(A1),D0 ;CONVERT TO SCREEN LOCAL; - CMP (A0)+,D0 ;IS SHIELDBOTTOM < SAVETOP ? ; - BLT.S @NOSECT ;YES, NO INTERSECTION ; - - MOVE ShieldRect+Right,D0 ;GET SHIELD RIGHT - SUB LEFT(A1),D0 ;CONVERT TO SCREEN LOCAL - CMP (A0)+,D0 ;IS SHIELDRIGHT <= SAVELEFT ? - BLE.S @NOSECT ;YES, NO INTERSECTION - - MOVE ShieldRect+Top,D0 ;GET SHIELD TOP - SUB TOP(A1),D0 ;CONVERT TO SCREEN LOCAL - CMP (A0)+,D0 ;IS SHIELDTOP >= SAVEBOTTOM ? - BGE.S @NOSECT ;YES, NO INTERSECTION - - MOVE ShieldRect+Left,D0 ;GET SHIELD LEFT - SUB LEFT(A1),D0 ;CONVERT TO SCREEN LOCAL - CMP (A0),D0 ;IS SHIELDLEFT >= SAVERIGHT ? - BGE.S @NOSECT ;YES, NO INTERSECTION - -@SECT MOVEQ #1,D0 ;Clear the Z-flag - BRA.S @out ; - -@NOSECT CLR D0 ;Set the Z-flag -@out MOVEM.L (SP)+,A0/A1/D0 ;Restore regs - RTS ;bye. - -;_______________________________________________________________________ -; -; PROCEDURE ObscureCursor -- called via the jump table -; -; Removes the cursor from the screen without hiding it, so the next -; time the mouse moves, it will show up again. -; -;_______________________________________________________________________ - -ObscureCursor - MOVE.B #1,CrsrBusy ;"Occupado" - MOVE.B #1,CrsrObscure ;Mark it as obscure - BRA.S EraseCursor ;and erase it - ;_______________________________________________________________________ ; ; HIDECURSOR - is called from CrsrVBLTask, and via jump table. @@ -542,44 +210,13 @@ ObscureCursor ; Subtracts 1 from crsrstate and hides the cursor if visible. ; ; -HideCursor - MOVE.B #1,CrsrBusy ;MARK CHANGE IN PROGRESS - SUB #1,CRSRSTATE ;CURSOR HIDDEN ONE DEEPER - - ;Fall into EraseCursor - -;________________________________________________________________________ -; CSS Horror vectorized this vector. We are supporting this to be -; compatible with Horror. -; EraseCursor calls a vectorized version of the routine via lomem. -; EraseCursor is vectorized to gain access to low level cursor blit routines. -; (NOTE: Vector is initialized in StartInit.a to routine named VEraseCursor.) - -; EraseCursor is much like HideCursor, but doesn't decrement the CrsrState - -EraseCursor - move.l EraseCrsrVector,-(sp) ; CSS - rts ;jump to the vectored routine CSS -DoneHid CLR.B CRSRBUSY ;CHANGE COMPLETE +_HideCursor PROC EXPORT + MOVEM.L D0-D2/A0-A1,-(SP) + IMPORT QDNEW_HIDECURSOR + JSR QDNEW_HIDECURSOR + MOVEM.L (SP)+,D0-D2/A0-A1 RTS - -;_______________________________________________________________________ -; -; PROCEDURE InitCursor; -; -; Definitely redisplay the cursor, independent of previous calls to -; HideCursor, ShieldCursor and ObscureCursor. It falls into showCursor. -; -InitCursor - MOVE.B #1,CrsrBusy ;mark it busy - CLR.B CrsrObscure ;we wont be obscure no more - CLR CrsrState ;reset state to 0 - CLR ShieldDepth -; -; fall into ShowCursor -; - ;_______________________________________________________________________ ; ; SHOWCURSOR - Called from CrsrVBLTask and via Jump Table. @@ -587,39 +224,12 @@ InitCursor ; Adds 1 to CRSRSTATE and paints cursor if zero and cursor is ; not already visible. ; -;Êthis reflects the fix from QDciPatchROM.a where obscure/show/hide left stb -; the cursor hidden only, and obscure/hide/show left the cursor obscured only. stb -ShowCursor - MOVE.B #1,CRSRBUSY ;MARK CHANGE IN PROGRESS - - TST ShieldDepth ;Any shielding? - BEQ.s @2 - -@1 SUBQ #1,ShieldDepth ;If so, this ShowCursor unshields, - BRA.s DrawCursor ;but doesn't up the cursor level. - -@2 ADDQ #1,CRSRSTATE ;CURSOR HIDDEN ONE LESS DEEP - bmi.s DoneSho - beq.s DrawCursor ; - clr.b CrsrObscure ;unobscure cursor if level went past zero - - ;fall into DrawCursor - -;________________________________________________________________________ -; CSS Horror vectorized this vector. We are supporting this to be -; compatible with Horror. -; DrawCursor calls a vectorized version of the routine via lomem. -; DrawCursor is vectorized to gain access to low level cursor blit routines. -; (NOTE: Vector is initialized in StartInit.a to routine named VDrawCursor.) - -; DrawCursor is much like ShowCursor, but doesn't increment the CrsrState - -DrawCursor - move.l DrawCrsrVector,-(sp) ; CSS - rts ;jump to the vectored routine CSS - -DoneSho CLR.B CRSRBUSY ;CHANGE COMPLETE +_ShowCursor PROC EXPORT + MOVEM.L D0-D2/A0-A1,-(SP) + IMPORT QDNEW_SHOWCURSOR + JSR QDNEW_SHOWCURSOR + MOVEM.L (SP)+,D0-D2/A0-A1 RTS ;_______________________________________________________________________ @@ -634,207 +244,21 @@ DoneSho CLR.B CRSRBUSY ;CHANGE COMPLETE ; ALL REGISTERS RESTORED. ; -ShieldVars RECORD {return},DECREMENT ; -ShieldLeft DS.W 1 ; -ShieldTop DS.W 1 ; -ShieldRight DS.W 1 ; -ShieldBot DS.W 1 ; -return DS.L 1 ; - ENDR - - WITH ShieldVars -ShieldCursor - TST ShieldDepth ;Any shielding already? ; - BEQ.s @2 ;No=>don't unionrect - - MOVEM.L D0/A0,-(SP) ;Save some regs (and +8 our vars below*) - LEA ShieldRect+right,A0 ;A0->ShieldRect.right - - MOVE.L ShieldBot+8(SP),D0 ;D0 = New shield bot,right (*) - CMP (A0),D0 ;Compare to ShieldRect.right - BLE.s @u1 ;Is the new right bigger? - MOVE D0,(A0) - -@u1 SWAP D0 ;D0 = New shield bottom - CMP -(A0),D0 ;Compare to ShieldRect.bottom - BLE.s @u2 ;Is the new bottom bigger? - MOVE D0,(A0) ;If so, replace with it. - -@u2 MOVE.L ShieldTop+8(SP),D0 ;D0 = New shield top,left (*) - CMP -(A0),D0 ;Compare to ShieldRect.left - BGE.s @u3 ;Is the new left smaller? - MOVE D0,(A0) - -@u3 SWAP D0 ;D0 = New shield top - CMP -(A0),D0 ;Compare to ShieldRect.top - BGE.s @u4 ;Is the new top smaller? - MOVE D0,(A0) - -@u4 MOVEM.L (SP)+,D0/A0 - BRA.s @3 - -@2 MOVE.L ShieldBot(SP),ShieldRect+botRight ;save shieldrect ; - MOVE.L ShieldTop(SP),ShieldRect+topLeft ; -@3 ADDQ #1,ShieldDepth ;Shielding officially on - MOVE.B #1,CrsrBusy - BSR CursorSect ; - BEQ.s @1 ; - - BSR EraseCursor ;IT DOES INTERSECT, REMOVE IT - -@1 CLR.B CrsrBusy - MOVE.L (SP)+,(SP) ;STRIP 8 bytes of PARAMETERS, MOVING - MOVE.L (SP)+,(SP) ;RETURN ADDR UP ON STACK - RTS - - ENDWITH - - IMPORT CopyHandle,PatConvert -;_______________________________________________________________________ -; -; PROCEDURE SetCCursor(cCrsr: CCrsrHandle); -; -; This procedure copies the data in the specified color cursor into the -; system's cursor save area. If the depth > 2, it expands it. - -; this routine was taken from QDciPatchROM.a because A2 was getting trashed stb -; when setting CCursor on multiple device systems stb - -SetCCursor MOVEM.L D3-D4/A2-A4,-(SP) ;save work registers - move.l 24(sp),a2 ;get ccrsrHandle - move.l a2,a0 ;make a copy - _HGetState - move d0,-(sp) ;save state for later - move.l a2,a0 ;make a copy - _HLock - MOVE.L (a2),A2 ;GET POINTER TO NEW CURSOR - - MOVE.L ([CRSRPTR]),A3 ;point to current cursor (LOCKED) - MOVE.L crsrID(A2),D0 ;and get ID of new cursor - CMP #CCrsrPat,ccType(A3) ;is current cursor a color cursor? - BNE.S NotCC ;=>no, it has definitely changed - CMP.L ccID(A3),D0 ;same as current one? - BEQ SCCDONE ;=>yes, just return - -NotCC MOVE.B #1,CRSRBUSY ;flag the cursor as busy - MOVE.L D0,ccID(A3) ;set new ID - LEA crsr1Data(A2),A0 ;point to old-cursor data - LEA THECRSR,A1 ;put it here - MOVEQ #16,D0 ;data+mask+hotspot = 17 longs -@0 MOVE.L (A0)+,(A1)+ ;copy data - DBRA D0,@0 ;until done - - LEA crsr1Data(A2),A0 ;point to old-cursor data - LEA CCLASTCRSR(A3),A1 ;save here to indicate cursor changed - MOVEQ #7,D0 ;move 8 longs -@1 MOVE.L (A0)+,(A1)+ ;copy data - DBRA D0,@1 ;=>loop until done - - MOVE crsrType(A2),ccType(A3) ;copy the type - -; NOTE: ALL THE DST HANDLES ARE LOCKED, BUT THEY HAVE BEEN SET TO THE PROPER SIZE - - MOVE.L crsrMap(A2),-(SP) ;push src pixMap handle - MOVE.L ccMap(A3),-(SP) ;push dst pixMap handle - _CopyPixMap ;copy the pixMap - - MOVE.L crsrData(A2),-(SP) ;push src data handle - MOVE.L ccData(A3),-(SP) ;push dst data handle - _CopyHandle ;copy the cursor data - -; FOR EACH ACTIVE SCREEN DEVICE, EXPAND CURSOR, IF NECESSARY - - MOVE.L DEVICELIST,D4 ;D4 = CURRENT DEVICE - MOVE.L D4,A4 ;GET HANDLE TO CURRENT DEVICE -NXTSCR MOVE.L (A4),A4 ;A4 = POINTER TO CURRENT DEVICE - TST.W GDFLAGS(A4) ;IS THE DEVICE ACTIVE? - BPL CHKNXT ;=>NO, CHECK NEXT DEVICE - ;ACTIVE DEVICES ARE LOCKED DOWN - MOVE.L GDPMAP(A4),A0 ;GET HANDLE TO DEVICE'S PIXMAP - MOVE.L (A0),A0 ;POINT TO DEVICE'S PIXMAP - MOVE PIXELSIZE(A0),D3 ;GET DEVICE'S PIXELSIZE - -; IF THE PATTERN IS PRE-EXPANDED TO THE RIGHT DEPTH, JUST COPY THAT DATA - - CLR GDCCDEPTH(A4) ;flag to expand one-bit data - MOVE CRSRXVALID(A2),D0 ;is there pre-expanded data? - BEQ.S GOEXP ;=>no, do expansion - CMP D3,D0 ;is the expanded data the right depth? - BNE.S GOEXP ;=>no, expand from the source - MOVE D0,GDCCDEPTH(A4) ;else copy the expanded depth - MOVE.L crsrXData(A2),-(SP) ;push the src xdata handle - MOVE.L CCXDATA(A3),-(SP) ;push the dst xdata handle - _CopyHandle ;and copy it - BRA.S CHKNXT ;=>data already expanded, just exit - -GOEXP CMP #CCRSRPAT,CCTYPE(A3) ;IS IT A COLOR CURSOR? - BNE.S DONEONE ;=>NO, EXIT WITH DEPTH = 0 - CMP #2,D3 ;IS DEPTH GREATER THAN 2? - BLE.S DONEONE ;=>NO, EXIT WITH DEPTH = 0 - - MOVE D3,GDCCDEPTH(A4) ;RECORD THE EXPANDED DEPTH - MOVE.L GDCCXDATA(A4),CCXDATA(A3) ;GET DEVICE'S EXPANDED DATA FOR PATCONVERT - MOVE.L THEGDEVICE,-(SP) ;SAVE GRAFDEVICE (USED BY PATCONVERT) - MOVE.L D4,THEGDEVICE ;SET IT TO CURRENT DEVICE - MOVE.L CRSRPTR,-(SP) ;PUSH HANDLE TO CURSOR (LOCKED) - _PATCONVERT ;AND EXPAND TO CURRENT DEPTH - MOVE.L (SP)+,THEGDEVICE ;RESTORE GRAFDEVICE - -; EXPAND THE MASK TO THE CURRENT DEPTH - - MOVE D3,D0 ;GET DEPTH - MOVEQ #0,D1 ;DEFAULT SHIFT = 0 -NXTSHFT1 LSR #1,D0 ;CHECK NEXT DEPTH BIT - BCS.S GOTSHFT1 ;=>GOT SHIFT - ADDQ #1,D1 ;ELSE ADD ONE TO SHIFT - BRA.S NXTSHFT1 ;LOOP UNTIL WE HIT A ONE - -GOTSHFT1 LEA THECRSR+MASK,A0 ;SRC = CURSOR MASK - MOVE.L ([GDCCXMASK,A4]),A1 ;POINT TO EXPANDED MASK (LOCKED) - - move.l a2,d4 ;save pointer to new cursor <25APR91 KON> - MOVE.L A1,A2 ;GET START OF DST BUFFER <27May87 EHB> - MOVE #32,D0 ;GET #BYTES OF SOURCE <27May87 EHB> - LSL D1,D0 ;MULTIPLY BY DEPTH <27May87 EHB> - ADD D0,A2 ;POINT TO END OF BUFFER <27May87 EHB> - - move.l ExTblPtr,A3 ;POINT TO ROUTINE TABLE - add.l 0(A3,D1*4),A3 ;USE DEPTH TO SELECT ROUTINE - MOVEQ #0,D0 ;CLEAR HIGH PART OF D0 - JSR (A3) ;EXPAND 32*DEPTH BYTES - MOVE.L ([CRSRPTR]),A3 ;GET BACK POINTER TO CURSOR (LOCKED) - move.l d4,a2 ;restore pointer to new cursor <25APR91 KON> - -DONEONE MOVE GDCCDEPTH(A4),D0 ;GET EXPANDED DEPTH - ADD D0,D0 ;DOUBLE IT - MOVE D0,GDCCBYTES(A4) ;AND SAVE AS CURSOR'S ROWBYTES - -CHKNXT MOVE.L GDNEXTGD(A4),D4 ;IS THERE A NEXT DEVICE? - MOVE.L D4,A4 ;GET HANDLE TO NEXT DEVICE - BNE NXTSCR ;=>THERE IS ONE, PREPARE ITS CURSOR - - BSR.S GETMAINCRSR ;RESTORE EXPAND DATA FOR MAIN CURSOR - BSR ERASECURSOR ;HIDE THE OLD CURSOR - BSR DRAWCURSOR ;DISPLAY THE NEW CURSOR -SCCDONE CLR.B CRSRBUSY ;CURSOR NOT BUSY ANYMORE - move (sp)+,d0 ;get ccrsrhandle state - move.l 24(sp),a0 ;get ccrsrHandle - _HSetState - MOVEM.L (SP)+,D3-D4/A2-A4 ;restore work registers - MOVE.L (SP)+,(SP) ;strip parameter - RTS ;and return +_ShieldCursor PROC EXPORT + IMPORT QDNEW_SHIELDCURSOR + JMP QDNEW_SHIELDCURSOR ;_______________________________________________________________________ +; +; PROCEDURE InitCursor; +; +; Definitely redisplay the cursor, independent of previous calls to +; HideCursor, ShieldCursor and ObscureCursor. It falls into showCursor. +; -GETMAINCRSR MOVE.L CRSRDEVICE,A0 ;GET HANDLE TO CURSOR DEVICE - MOVE.L (A0),A0 ;GET POINTER TO CURSOR DEVICE - MOVE.L CRSRPTR,A1 ;GET HANDLE TO CURSOR SAVE AREA - MOVE.L (A1),A1 ;GET POINTER TO CURSOR SAVE - MOVE.L GDCCXDATA(A0),CCXDATA(A1) ;GET CURRENT EXPANDED DATA - MOVE.L GDCCXMASK(A0),CCXMASK(A1) ;GET CURRENT EXPANDED MASK - MOVE GDCCDEPTH(A0),CCDEPTH(A1) ;GET EXPANDED DEPTH - MOVE GDCCBYTES(A0),CCBYTES(A1) ;GET EXPANDED ROWBYTES - RTS ;AND RETURN +_InitCursor PROC EXPORT + IMPORT QDNEW_INITCURSOR + JMP QDNEW_INITCURSOR ;_______________________________________________________________________ ; @@ -847,1127 +271,45 @@ GETMAINCRSR MOVE.L CRSRDEVICE,A0 ;GET HANDLE TO CURSOR DEVICE ; It ignores the height and mask parameters. It assumes that the mask immediately ; follows the data (as it does when called from LisaGraf) ; -SetCursor MOVE.L ([CRSRPTR]),A0 ;point to crsr data structure (LOCKED) - move.b #1,crsrBusy ;don't allow vbl drawing until we're done <09Aug88> - MOVE #oldCrsrPat,ccType(A0) ;say that it's an old cursor - MOVE.L 8(SP),A0 ;get address of data mask - LEA THECRSR,A1 ;point to system cursor buffer - MOVEQ #15,D2 ;have 16 longs to move - MOVEQ #0,D1 ;flag that its not different +_SetCursor PROC EXPORT + IMPORT QDNEW_SETCURSOR + JMP QDNEW_SETCURSOR -SetCurLoop MOVE.L (A0)+,D0 ;get next longWord of new cursor - CMP.L (A1),D0 ;is it the same as what's there - BEQ.S @1 ;if so, skip - ADDQ #1,D1 ;flag that its different -@1 MOVE.L D0,(A1)+ ;move it into the cursor buffer - DBRA D2,SetCurLoop ;move all 64 bytes - - MOVE.L 14(SP),D0 ;get the alleged hotspot <23Apr85> - -; Clean up the two coordinates to lie between 0 and 16. <23Apr85> - - MOVEQ #16,D2 ; VERY handy temp, from loop above <23Apr85> - CMP.W D2,D0 ; <23Apr85> - BLS.S @31 ; D0 LowerorSame as 16 is ok <23Apr85> - MOVE.W D2,D0 ;pin it at 16 <23Apr85> - -@31 SWAP D0 ;align the high-order coord <23Apr85> - CMP.W D2,D0 ; <23Apr85> - BLS.S @33 ; D0 LowerorSame as 16 is ok <23Apr85> - MOVE.W D2,D0 ; <23Apr85> - -@33 SWAP D0 ;realign coords <23Apr85> - CMP.L TheCrsr+HotSpot,D0 ;is it new? <05Apr85> - BEQ.S @3 ; <05Apr85> - ADDQ #1,D1 ;flag it's different <05Apr85> - MOVE.L D0,TheCrsr+HotSpot ;move in the hotSpot <05Apr85> -@3 - -; DID THE CURSOR CHANGE? - - clr.b crsrBusy ;re-allow vbl drawing <09Aug88> - TST D1 ;did it change? - BEQ.S @6 ;skip if it didn't - -; IF SO, FORCE THE CURSOR TO BE REDISPLAYED BY HIDING AND THEN SHOWING IT - - BSR EraseCursor ;hide it - BSR DrawCursor ;then show it again to redraw it - -@6 MOVE.L (SP)+,A0 ;get return address - ADD #14,SP ;strip parameters - JMP (A0) ;return to caller - - - -SetCrsrData PROC EXPORT -;------------------------------------------------ -; UTILITY SetCrsrData +;_______________________________________________________________________ ; -; This routine is called to initialize low-memory locations -; to the necessary values for the grafDevice pointer in A1. +; PROCEDURE ObscureCursor -- called via the jump table +; +; Removes the cursor from the screen without hiding it, so the next +; time the mouse moves, it will show up again. ; - IMPORT SetCrsrDelay ; CSS - bsr.l SetCrsrDelay ; CSS - MOVE.L CRSRPTR,A0 ;get handle to cursor data - MOVE.L (A0),A0 ;get pointer to cursor data -; initialize the grafDevice's cursor variables +_ObscureCursor PROC EXPORT + IMPORT QDNEW_OBSCURECURSOR + JMP QDNEW_OBSCURECURSOR - MOVE.L GDCCXDATA(A1),CCXDATA(A0) ;copy handle to expanded data - MOVE.L GDCCXMASK(A1),CCXMASK(A0) ;copy handle to expanded mask - MOVE GDCCDEPTH(A1),CCDEPTH(A0) ;copy depth - MOVE GDCCBYTES(A1),CCBYTES(A0) ;copy expanded rowbytes - -; set the pinning rectangle to the current screen - - LEA GDRect(A1),A0 ;get rect for current device - MOVE.L (A0)+,crsrPin ;and set pinning rectangle - MOVE.L (A0),crsrPin+4 ;from device's rectangle - -; set the depth, rowbytes, height, and width of the current screen - - MOVE.L GDPMap(A1),A0 ;get pixMap of current device - MOVE.L (A0),A0 ;point at pixmap - MOVE PixelSize(A0),chunkyDepth ;set depth of cursor's screen - MOVE.L (A0)+,crsrBase ;update base address for cursor - MOVE (A0)+,D0 ;get rowbytes - AND #nuRBMask,D0 ;clear flag bits - MOVE D0,crsrRow ;set cursor rowbytes - MOVE bottom(A0),D0 ;get bottom of cursor's screen - SUB top(A0),D0 ;calc height of cursor's screen - MOVE D0,ColLines ;save height of cursor's screen - MOVE right(A0),D0 ;get right of cursor's screen - SUB left(A0),D0 ;calc width of cursor's screen - MOVE D0,RowBits ;save width of cursor's screen - RTS - - -ALLOCCRSR PROC EXPORT - IMPORT PatConvert,GETMAINCRSR,SetCrsrData - IMPORT RNEWHANDLE,ERASECURSOR,DRAWCURSOR ;-------------------------------------------------- ; ; PROCEDURE AllocCrsr; ; ; Allocates all global cursor data structures. A maximum depth of 8 is assumed. ; -; CRSRPTR IS USED AS A HANDLE TO AN EXTENDED PATTERN WHICH CONTAINS THESE FIELDS: -; -; CCTYPE EQU 0 ;[WORD] CURSOR TYPE -; CCMAP EQU CCTYPE+2 ;[LONG] HANDLE TO CURSOR'S PIXMAP -; CCDATA EQU CCMAP+4 ;[LONG] HANDLE TO CURSOR'S COLOR DATA -; CCXDATA EQU CCDATA+4 ;[LONG] HANDLE TO EXPANDED DATA -; CCXMASK EQU CCXDATA+4 ;[LONG] HANDLE TO EXPANDED MASK -; CCSAVE EQU CCXMASK+4 ;[LONG] HANDLE TO SAVE BITS UNDER CURSOR -; CCLASTCRSR EQU CCSAVE+4 ;[32 BYTES] DATA FOR LAST B/W CURSOR DRAWN -; CCID EQU CCLASTCRSR ;[LONG] ID FOR LAST COLOR CURSOR DRAWN -; CCTABLE EQU CCID+4 ;[LONG] TABLE ID FOR LAST COLOR CURSOR -; CCDEPTH EQU CCLASTCRSR+32 ;[WORD] DEPTH FOR LAST CURSOR DRAWN -; CCSTATEREGS EQU CCDEPTH+2 ;[20 BYTES] STATE INFO OF SAVED DATA -; CCBYTES EQU CCSTATEREGS+16 ;[WORD] ROWBYTES OF EXPANDED DATA -; CCMAXDEPTH EQU CCBYTES+2 ;[WORD] MAXIMUM CURSOR DEPTH - - MOVEM.L D0-D6/A0-A4/A6,-(SP) ;PRESERVE ALL REGS - MOVE.L THEZONE,-(SP) ;SAVE THE CURRENT HEAP ZONE - MOVE.L SYSZONE,THEZONE ;SET CURRENT ZONE TO SYS ZONE - -; ALLOCATE MAIN CURSOR STRUCTURE AND DATA AREAS IF NECESSARY - - BSR ERASECURSOR ;HIDE THE CURSOR - MOVE.B #1,CRSRBUSY ;MARK CHANGE IN PROGRESS - - MOVE.L CRSRPTR,D0 ;GET CRSRPTR (REALLY HANDLE) - CMP.L MINUSONE,D0 ;IS IT ALLOCATED? - BNE.S MAINOK ;=>ALREADY ALLOCATED, CONTINUE - -; RESERVE MEMORY FOR AND ALLOCATE CURSOR STRUCTURE. -; THE CURSOR SAVE RECORD CONTAINS A PIXMAP, A DATA HANDLE, AND A SAVE HANDLE. - - clr.b CrsrObscure ;we wont be obscure no more - clr CrsrState ;reset state to 0 - clr ShieldDepth ;no more shielding - - MOVEQ #CCSAVEREC,D1 ;GET SIZE OF CURSOR SAVE RECORD - BSR GETLOWHANDLE ;ALLOCATE RECORD DOWN LOW AND LOCK - MOVE.L A0,CRSRPTR ;SAVE HANDLE TO CURSOR - MOVE.L (A0),A4 ;KEEP POINTER IN A4 - - MOVEQ #PMREC,D0 ;WE'RE GOING TO LOCK THIS - _RESRVMEM ;SO RESERVE SPACE DOWN LOW - CLR.L -(SP) ;MAKE ROOM FOR FUNCTION RESULT - _NEWPIXMAP ;ALLOCATE A PIXMAP - MOVE.L (SP)+,A0 ;GET HANDLE TO PIXMAP - MOVE.L A0,CCMAP(A4) ;SAVE PIXMAP IN CURSOR RECORD - _HLOCK ;LOCK IT DOWN - - MOVEQ #2,D0 ;DEFAULT SIZE OF DATA HANDLE - JSR RNEWHANDLE ;ALLOCATE IT - MOVE.L A0,CCDATA(A4) ;AND SAVE FOR CURSOR DATA - -; RESERVE AND ALLOCATE MEMORY IN WHICH TO SAVE THE BITS BEHIND THE CURSOR. -; MAGIC AMOUNT OF MEMORY RESERVED IS FOR 32 BIT DEEP, LONG ALIGNED CURSOR. - - if cursorShadow then - MOVE.L #$400*4,D1 ;GET REQUIRED SIZE 32*32*4 - else - MOVE.L #$400,D1 ;GET REQUIRED SIZE 16*16*4 - endif - BSR GETLOWHANDLE ;GET LOW,LOCKED HANDLE - MOVE.L A0,CCSAVE(A4) ;SAVE INTO RECORD - -; INITIALIZE THE CURSOR TO THE ARROW CURSOR. - - MOVE #OLDCRSRPAT,CCTYPE(A4) ;SAY THAT IT'S AN OLD CURSOR - CLR CCDEPTH(A4) ;CLEAR DEPTH TO SAY NOT EXPANDED - - MOVE.L GRAFGLOBALS(A5),A0 ;POINT TO GRAFGLOBALS - LEA ARROW(A0),A0 ;POINT TO ARROW CURSOR - LEA THECRSR,A1 ;PUT IT HERE - MOVEQ #16,D0 ;DATA+MASK+HOTSPOT = 17 LONGS -@2 MOVE.L (A0)+,(A1)+ ;COPY DATA - DBRA D0,@2 ;UNTIL DONE - - -; FOR EACH ACTIVE SCREEN DEVICE, ALLOCATE EXPANDED CURSOR MEMORY IF NECESSARY -; ALL DEVICES ARE GUARANTEED TO BE LOCKED. - -MAINOK MOVE.L CRSRPTR,A4 ;GET HANDLE TO CURSOR STUFF - MOVE.L (A4),A4 ;GET POINTER (LOCKED) - MOVE.L DEVICELIST,D4 ;D4 = CURRENT DEVICE - MOVE.L D4,A6 ;GET HANDLE TO CURRENT DEVICE -NXTDEVICE MOVE.L (A6),A6 ;A6 = POINTER TO CURRENT DEVICE - TST.W GDFLAGS(A6) ;IS THE DEVICE ACTIVE? - BPL CHKNEXT ;=>NO, CHECK NEXT DEVICE - - TST GDCCDEPTH(A6) ;HAS MEMORY BEEN ALLOCATED? - BNE.S DOEXPAND ;=>YES, EXPAND CURSOR IF NECESSARY - - MOVE.L GDCCXDATA(A6),A0 ;GET HANDLE TO EXPANDED DATA - _DISPOSHANDLE ;DISPOSE THE CURRENT HANDLE - MOVE.L #$400,D1 ;GET SIZE OF EXPANDED HANDLE @@@@ used to be $100 - BSR GETLOWHANDLE ;GET A LOW, LOCKED HANDLE - MOVE.L A0,GDCCXDATA(A6) ;AND SAVE IT - - MOVE.L GDCCXMASK(A6),A0 ;GET HANDLE TO EXPANDED DATA - _DISPOSHANDLE ;DISPOSE THE CURRENT HANDLE - BSR GETLOWHANDLE ;GET A LOW, LOCKED HANDLE - MOVE.L A0,GDCCXMASK(A6) ;AND SAVE IT - -DOEXPAND -; MAKE SURE ALL THE HANDLES ARE THE RIGHT SIZE FOR THE CURRENT DEPTH. -; IF COLOR CURSOR AND DEPTH IS > 2 BITS PER PIXEL, THEN EXPAND TO CURRENT DEPTH. -; BLACK AND WHITE (AND 2 BIT) CURSORS ARE EXPANDED BY SHOWCURSOR. - - MOVE.L GDPMAP(A6),A0 ;GET HANDLE TO DEVICE'S PIXMAP - MOVE.L (A0),A0 ;POINT TO DEVICE'S PIXMAP - MOVE PIXELSIZE(A0),D3 ;GET DEVICE'S PIXELSIZE - CMP GDCCDEPTH(A6),D3 ;HAS DEPTH CHANGED? - BEQ.S CHKNEXT ;=>NO, THIS DEVICE IS OK - -; CONVERT DEPTH TO SHIFT AMOUNT IN D6 - - MOVE D3,D0 ;GET DEPTH - MOVEQ #0,D6 ;DEFAULT SHIFT = 0 -NXTSHFT LSR #1,D0 ;CHECK NEXT DEPTH BIT - BCS.S GOTSHFT ;=>GOT SHIFT - ADDQ #1,D6 ;ELSE ADD ONE TO SHIFT - BRA.S NXTSHFT ;LOOP UNTIL WE HIT A ONE - -GOTSHFT CMP #CCRSRPAT,CCTYPE(A4) ;IS IT A COLOR CURSOR? - BNE.S CHKNEXT ;=>NO - CMP #2,D3 ;IS DEPTH GREATER THAN 2? - BLE.S CHKNEXT ;=>NO - - MOVE.L GDCCXDATA(A6),CCXDATA(A4) ;GET EXPAND HANDLE FOR PATCONVERT - MOVE.L THEGDEVICE,-(SP) ;SAVE GRAFDEVICE - MOVE.L D4,THEGDEVICE ;SET IT TO CURRENT DEVICE - MOVE.L CRSRPTR,-(SP) ;PUSH HANDLE TO CURSOR - _PATCONVERT ;AND EXPAND TO CURRENT DEPTH - MOVE.L (SP)+,THEGDEVICE ;RESTORE GRAFDEVICE - -; EXPAND THE MASK TO THE CURRENT DEPTH - - LEA THECRSR+MASK,A0 ;SRC = CURSOR MASK - MOVE.L ([GDCCXMASK,A6]),A1 ;POINT TO EXPANDED MASK (LOCKED) - MOVE.L A1,A2 ;GET START OF DST BUFFER - MOVE #32,D0 ;GET #BYTES OF SOURCE - LSL D6,D0 ;MULTIPLY BY DEPTH - ADD D0,A2 ;POINT TO END OF BUFFER - - move.l ExTblPtr,A3 ;POINT TO ROUTINE TABLE - add.l 0(A3,D6*4),A3 ;USE DEPTH TO SELECT ROUTINE - MOVEQ #0,D0 ;CLEAR HIGH PART OF D0 - JSR (A3) ;EXPAND 32*DEPTH BYTES - - MOVE D3,GDCCDEPTH(A6) ;SAVE DEPTH OF EXPANDED CURSOR - ADD D3,D3 ;GET 2*DEPTH - MOVE D3,GDCCBYTES(A6) ;SAVE ROWBYTES FOR EXPANDED CURSOR - -CHKNEXT MOVE.L GDNEXTGD(A6),D4 ;IS THERE A NEXT DEVICE? - MOVE.L D4,A6 ;GET HANDLE TO NEXT DEVICE - BNE NXTDEVICE ;=>THERE IS ONE, PREPARE ITS CURSOR - - BSR GETMAINCRSR ;SET UP FIELDS FOR MAIN CURSOR - MOVE.L CRSRDEVICE,A1 ;GET HANDLE TO CURSOR DEVICE - MOVE.L (A1),A1 ;GET POINTER TO CURSOR DEVICE - JSR SetCrsrData ;AND SET UP LOW-MEM FOR THIS DEVICE - - MOVE.L (SP)+,THEZONE ;RESTORE THE ZONE - CLR.B CRSRBUSY ;CHANGE COMPLETE - BSR DRAWCURSOR - MOVEM.L (SP)+,D0-D6/A0-A4/A6 ;RESTORE ALL REGS - RTS - - -GETLOWHANDLE -;-------------------------------------------------- -; UTILITY GETLOWHANDLE -; -; THIS ROUTINE RESERVES MEMORY FOR A HANDLE, ALLOCATES THE HANDLE -; AND THEN LOCKS IT DOWN. THE DESIRED SIZE IS IN D1. THE RETURNED HANDLE IS IN A0 -; ONLY D0 IS TRASHED - - MOVE.L D1,D0 ;GET THE DESIRED SIZE - _RESRVMEM ;RESERVE SPACE FOR THE HANDLE DOWN LOW - BNE.S MEMFULL ;=>ON ERROR, JUST BOMB - MOVE.L D1,D0 ;GET THE DESIRED SIZE - _NEWHANDLE ,CLEAR ;ALLOCATE THE HANDLE - _HLOCK ;LOCK IT - RTS ;AND RETURN - -MEMFULL MOVEQ #25,D0 ;MEM FULL ERROR - _SYSERROR ;FLAG IT - DC.W $A9FF ;JUST IN CASE WE RETURN +AllocCrsr PROC EXPORT + IMPORT QDNEW_ALLOCCRSR + JMP QDNEW_ALLOCCRSR ;_______________________________________________________________________ ; -; BLITCURSOR +; PROCEDURE SetCCursor(cCrsr: CCrsrHandle); ; -; The only thing that will stop this routine from blitting the cursor -; to the screen is ShieldRect. Since the new CrsrRect isn't known -; until pretty far through the process, it's checked here, not -; DrawCursor. CrsrState and CrsrObscure are _not_ checked here. -; It seems likely that patching this routine will have use on accelerator -; cards etc. - -BLITCURSOR PROC EXPORT - IMPORT CursorSect, SHFTTBL - - TST.L CRSRPTR ;CURSOR ALLOCATED? - BMI NoBlit ;=>NO, JUST RETURN - MOVEM.L D0-D7/A0-A6,-(SP) ;SAVE REGISTERS - LEA THECRSR+DATA,A2 ;POINT TO THE CURSOR - - -;----------------------------------------------- +; This procedure copies the data in the specified color cursor into the +; system's cursor save area. If the depth > 2, it expands it. ; -; CONVERT CHUNKY DEPTH TO SHIFT AMOUNT IN D7 -; - LEA SHFTTBL,A0 ;TO CONVERT DEPTH TO SHIFT - MOVE CHUNKYDEPTH,D1 ;GET DEPTH - MOVEQ #0,D7 ;DEFAULT SHIFT = 0 - MOVE.B 0(A0,D1),D7 ;GET SHIFT AMOUNT IN D7 - - -;----------------------------------------------- -; -; CHECK THE CURSOR TO SEE IF IT HAS CHANGED -; OLD CURSORS: CHECK CURSOR DATA AND DEPTH -; NEW CURSORS: CHECK DEPTH -; -GOTSHFT MOVE.L ([CRSRPTR]),A4 ;GET POINTER TO CURSOR DATA (LOCKED) - CMP #CCRSRPAT,CCTYPE(A4) ;IS IT A COLOR CURSOR? - BNE.S OLDCUR ;=>NO, JUST AN OLD ONE - CMP CCDEPTH(A4),D1 ;HAS DEPTH CHANGED? - BEQ NOEXPAND ;=>NO, DON'T EXPAND - CMP #2,D1 ;IS DEPTH 2 or 1? - BGT EXPMASK ;=>NO, JUST EXPAND MASK - BRA.S CPYDATA ;=>ELSE JUST COPY DATA - -OLDCUR LEA CCLASTCRSR(A4),A0 ;POINT TO SAVED DATA - MOVE.L A2,A1 ;GET POINTER TO CURSOR - MOVEQ #7,D0 ;CHECK 8 LONGS -@0 CMP.L (A0)+,(A1)+ ;ARE THEY THE SAME? - BNE.S GOEXPAND ;=>NO, EXPAND IT - DBRA D0,@0 ;=>LOOP UNTIL DONE - - CMP CCDEPTH(A4),D1 ;HAS DEPTH CHANGED? - BEQ NOEXPAND ;=>NO, DON'T EXPAND - -GOEXPAND -;----------------------------------------------- -; -; INVALIDATE EXPANDED DATA FOR EACH DEVICE BY CLEARING DEPTH -; THIS MUST BE DONE SO THAT ALL EXPANDED CURSOR IMAGES ARE RENDERED INVALID AFTER -; AN OLD CURSOR HAS BEEN SET. IF THE CURSOR IS NEW, SETCCURSOR ALREADY DID THIS. - - MOVE.L DEVICELIST,A0 ;GET FIRST HANDLE IN DEVICE LIST -NXTGD MOVE.L (A0),A0 ;POINT TO FIRST DEVICE - TST GDFLAGS(A0) ;IS IT ACTIVE? - BPL.S NOTACT ;=>NO, SKIP TO NEXT - CLR GDCCDEPTH(A0) ;ELSE INVALIDATE EXPANDED DATA -NOTACT MOVE.L GDNEXTGD(A0),D0 ;GET NEXT GRAFDEVICE - MOVE.L D0,A0 ;GET INTO A0 - BNE.S NXTGD ;=>REPEAT FOR ALL DEVICES - -; COPY THE CURSOR DATA TO IDENTIFY THIS CURSOR - -CPYDATA LEA CCLASTCRSR(A4),A0 ;POINT TO SAVED DATA - MOVE.L A2,A1 ;GET CURSOR - MOVEQ #7,D0 ;MOVE 8 LONGS -@0 MOVE.L (A1)+,(A0)+ ;MOVE A LONG - DBRA D0,@0 ;=>LOOP UNTIL DONE - -; UPDATE THE ROWBYTES AND DEPTH FOR THE EXPANDED DATA - - ; MOVE D1,(A0)+ ;COPY THE DEPTH TOO - MOVE D1,CCDEPTH(A4) ;SET DEPTH TO SAY IT'S EXPANDED - ADD D1,D1 ;DOUBLE FOR CURSOR'S ROWBYTES - MOVE D1,CCBYTES(A4) ;AND UPDATE ROWBYTES - - -;----------------------------------------------- -; -; EXPAND THE CURSOR TO THE CURRENT DEPTH -; - MOVE.L A2,A0 ;SRC = CURSOR - MOVE.L ([CCXDATA,A4]),A1 ;POINT TO EXPANDED DATA (LOCKED) - MOVE.L A1,A2 ;GET START OF DST BUFFER - MOVE #32,D5 ;GET #BYTES OF SOURCE - LSL D7,D5 ;MULTIPLY BY DEPTH - ADD D5,A2 ;POINT TO END OF BUFFER - - move d7,d0 - cmp #4,d0 ;16/32 bits per pixel? - blt.s @1 ;no, don't hack depth conversion - addq #2,d0 ;get address of spiffy 1 to 15/24 bit expand - -@1 move.l ExTblPtr,A3 ;POINT TO ROUTINE TABLE - add.l 0(A3,D0*4),A3 ;USE DEPTH TO SELECT ROUTINE - MOVEQ #0,D0 ;CLEAR HIGH PART OF D0 - JSR (A3) ;EXPAND 32*DEPTH BYTES - - -;----------------------------------------------- -; -; EXPAND THE MASK TO THE CURRENT DEPTH -; -EXPMASK LEA THECRSR+MASK,A0 ;SRC = CURSOR MASK - MOVE.L ([CCXMASK,A4]),A1 ;POINT TO EXPANDED MASK (LOCKED) - MOVE.L A1,A2 ;GET START OF DST BUFFER - MOVE #32,D5 ;GET #BYTES OF SOURCE - LSL D7,D5 ;MULTIPLY BY DEPTH - ADD D5,A2 ;POINT TO END OF BUFFER - - move.l ExTblPtr,A3 ;POINT TO ROUTINE TABLE - add.l 0(A3,D7*4),A3 ;USE DEPTH TO SELECT ROUTINE - MOVEQ #0,D0 ;CLEAR HIGH PART OF D0 - JSR (A3) ;EXPAND 32*DEPTH BYTES - -;----------------------------------------------- -; -; PREPARE TO BLT THE CURSOR ON THE SCREEN IN ANY DEPTH -; (SUBTITLE: WALTZ OF THE REGISTERS) -; -NOEXPAND - MOVE.L ([CCXDATA,A4]),d0 ;A2 = EXPANDED DATA FOR BLT (LOCKED) - _rTranslate24To32 ;strip off high byte - move.l d0,a2 - MOVE.L ([CCXMASK,A4]),d0 ;A3 = EXPANDED MASK FOR BLT (LOCKED) - _rTranslate24To32 ;strip off high byte - move.l d0,a3 - MOVEQ #16,D5 ;D5 = 16 - -;----------------------------------------------- -; -; CLIP THE CURSOR VERTICALLY AND GET THE TOP AND BOTTOM INTO D2 AND D3. -; IF THE TOP IS CLIPPED, UPDATE THE DATA BASE ADDRESSES IN A2 AND A3. -; - MOVE MOUSE+V,D2 ;MOUSE POSITION Y - SUB CRSRPIN+TOP,D2 ;CONVERT TO SCREEN LOCAL COORDS - SUB THECRSR+HOTSPOT+V,D2 ; - HOTSPOT = TOP EDGE - MOVE D2,D3 ;GET CURSOR BOTTOM - ADD D5,D3 ; = TOP + 16 - CMP D5,D3 ;AT TOP? - BGE.S CHKBOT ;=>NOT AT TOP - NEG D2 ;GET NUMBER OF CLIPPED ROWS - CMP D5,D2 ;ARE ALL 16 CLIPPED? - BEQ SkipBlit ;=>IF SO, NOTHING TO SHOW - MULU CCBYTES(A4),D2 ; * ROWBYTES FOR OFFSET - ADD.L D2,A2 ;ADD VERTICAL OFFSET INTO CURSOR - ADD.L D2,A3 ;ADD VERTICAL OFFSET INTO MASK - MOVEQ #0,D2 ;AND PIN CURSOR TO TOP - -CHKBOT MOVE COLLINES,D4 ;GET BOTTOM OF SCREEN - CMP D4,D3 ;PAST BOTTOM? - BLE.S CHKLFT ;=>NO, VERTICAL OK - MOVE D4,D3 ;ELSE PIN TO BOTTOM EDGE - - -;----------------------------------------------- -; -; CLIP THE CURSOR HORIZONTALLY AND GET THE LEFT AND RIGHT INTO D0 AND D1 -; IF THE LEFT OF THE CURSOR IS CLIPPED, ADJUST THE OFFET IN D6. - -CHKLFT MOVEQ #0,D6 ;INIT SRC/DST OFFSET TO 0 - MOVE MOUSE+H,D0 ;MOUSE POSITION X - SUB CRSRPIN+LEFT,D0 ;CONVERT TO SCREEN LOCAL COORDS - SUB THECRSR+HOTSPOT+H,D0 ; - HOTSPOT = CURSOR LEFT - MOVE D0,D1 ;GET CURSOR RIGHT - ADD D5,D1 ; = LEFT + 16 - CMP D5,D1 ;AT LEFT EDGE? - BGE.S CHKRT ;=>NOT AT LEFT EDGE - SUB D0,D6 ;OFFSET = AMOUNT CLIPPED - MOVEQ #0,D0 ;AND PIN TO LEFT EDGE - -CHKRT MOVE ROWBITS,D4 ;GET RIGHT EDGE OF SCREEN - CMP D4,D1 ;PAST RIGHT EDGE? - BLE.S RTOK ;=>NO, HORIZONTAL OK - MOVE D4,D1 ;ELSE PIN TO RIGHT EDGE -RTOK - -;----------------------------------------------- -; -; USE TOP AND LEFT TO CALCULATE THE LONG ALIGNED SCREEN BASE ADDRESS - - MOVE.L CRSRBASE,A5 ;A5 = POINTER TO BASE OF SCREEN - MOVE CRSRROW,A0 ;A0 = SCREEN ROWBYTES - MOVE A0,D4 ;COPY FOR MULU - MULU D2,D4 ;TOP * ROWBYTES - ADD.L D4,A5 ;ADD VERT OFFSET INTO SCREEN - ext.l d0 ;make it a long - LSL.l D7,D0 ;CONVERT LEFT PIXELS TO BITS - MOVE.l D0,D4 ;GET LEFT EDGE - AND.l #~$1F,D4 ;LONGWORD ALIGNED - MOVE.l D4,D5 ;MAKE A COPY - ASR.l #3,D5 ;CONVERT BITS TO BYTES - ADD.l D5,A5 ;GET BASE OFFSET IN SCREEN - -;----------------------------------------------- -; -; SAVE THE CRSRRECT FOR CURSHIELD - - LEA CrsrRect,A1 ;SET UP CRSRRECT - MOVE D2,(A1)+ ;TOP - MOVE.l D4,D5 ;GET LONG ALIGNED LEFT IN BITS - LSR.l D7,D5 ;CONVERT TO PIXELS - MOVE D5,(A1)+ ;LONG ALIGNED LEFT - MOVE D3,(A1)+ ;BOTTOM - MOVE D5,(A1) ;RIGHT = LEFT + longcount/pixs in long - - if cursorShadow then - add.w #16,-2(a1) ;grow height for shadow - add.w #16,(a1) ;grow width for shadow - endif - -SAMELONG -;----------------------------------------------- -; -; ADJUST DST/SRC OFFSET IN D6 -; GET NUMBER OF ROWS TO DO IN D3 -; GET LONGCNT IN D5 AND USE TO ADJUST DSTBUMP IN A0 - - AND #$1F,D0 ;GET LEFT EDGE MOD 32 - LSL D7,D6 ;CONVERT OFFSET TO BITS - SUB D0,D6 ; = NEG OFFSET FROM SOURCE - - ext.l d1 ;make it a long - LSL.l D7,D1 ;CONVERT RIGHT EDGE TO BITS - MOVE.l D1,D5 ;MAKE COPY - SUB.l D4,D5 ;GET WIDTH OF CURSOR - ble SkipBlit ;crsr fits in 0 or fewer longs so don't draw - subq #1,d5 ;force multiples of 32 to round down - - LSR.l #5,D5 ;GET LONGS-1 - - SUB D2,D3 ;D3 = # ROWS TO DO - SUBQ #1,D3 ;MAKE IT 0 BASED - - MOVE.l D5,D2 ;GET LONGS - ADDQ.l #1,D2 ;MAKE ONE BASED - LSL.l #2,D2 ;CONVERT TO BYTES - SUB.l D2,A0 ;ADJUST DST BUMP - - lsl.l #3,d2 ;get long aligned bit width - lsr.l d7,d2 ;get effective cursr pixel width - add d2,(a1) ;adjust crsrRect.right = left+width - - BSR CursorSect ;Now then, do we intersect shield? - BNE SkipBlit ;If so, ththat's all. - -;----------------------------------------------- -; -; CONVERT LEFT EDGE AND RIGHT EDGE TO LEFTMASK AND RIGHTMASK IN D4 AND D2 - - MOVEQ #-1,D4 ;FILL LONG WITH ONES - LSR.L D0,D4 ;AND SHIFT IN 0'S FOR LEFTMASK - - MOVEQ #-1,D2 ;FILL LONG WITH ONES - AND #$1F,D1 ;GET RIGHT MOD 32 - beq.s @1 ;does right have a real mask? no, flush it - LSR.L D1,D2 ;AND SHIFT 0'S IN FROM RIGHT - NOT.L D2 ;GET RIGHTMASK - -;----------------------------------------------- -; -; SAVE DSTLEFT/DSTBUMP/LONGCNT/ROWCNT INTO CRSRPTR SO THAT -; HIDECURSOR KNOWS HOW MUCH SCREEN TO REPLACE. - -@1 LEA CCBYTES(A4),A6 ;POINT TO END OF SAVE STATE AREA - MOVE (A6),A1 ;A1 = ROWBYTES FOR EXPANDED CURSOR - MOVE.L ([CCSAVE,A4]),d0 ;A4 = POINTER TO SAVE AREA (LOCKED) - _rTranslate24To32 ;strip off high byte - move.l d0,a4 - MOVEM.L A5/A0/D5/D3,-(A6) ;SAVE DSTLEFT/DSTBUMP/LONGCNT/ROWCNT - - moveq #true32b,d0 ;switch to 32 bit addressing - movem.l a0-a2,-(sp) ;save off registers - _rSwapMMUMode ;get previous mode in d0.b (can trash a0/a2, d0/d2) - movem.l (sp)+,a0-a2 ;restore registers - move.b d0,-(sp) ;save previous state for later - - MOVE.L D5,A6 ;SAVE LONGCNT - EXT.L D6 ;BFEXTU LIKES LONG OFFSETS - MOVE.L D6,-(SP) ;SAVE OFFSET ON STACK - MOVE.L D4,-(SP) ;SAVE LEFTMASK ON STACK - - ;use alternate loop if on Direct Device - - cmp #4,d7 ;are we 16 or 32 bits/pixel (direct device) ? - bge Direct ;no, don't hack - - if cursorShadow then - cmp #3,d7 - beq Shadow8 - endif - - TST D5 ;CHECK FOR JUST ONE LONG - BRA.S START ;AND JUMP INTO MIDDLE - -;----------------------------------------------- -; -; DISPLAY THE CURSOR AND SAVE THE BITS BEHIND IT (DO THE CURSOR LIMBO!!) -; -; THE FUNNY TRANSFER MODE USED HERE WORKS THE SAME AS BEFORE FOR ONE BIT -; MODE, AND SIMILARLY FOR COLOR. IN COLOR, THE DATA PIXELS WITHIN THE MASK -; REPLACE THE DESTINATION; THE DATA PIXELS OUTSIDE THE MASK ARE XORED WITH -; THE DST. IF THE DATA PIXELS OUTSIDE OF THE MASK ARE BLACK (ALL F'S), -; THEN THE DST IS SIMPLY INVERTED. IF THEY ARE OTHER COLORS, INTERESTING -; EFFECTS WILL MANIFEST THEMSELVES. -; -; REGISTER USE: D0: SCRATCH A0: DSTBUMP -; D1: SCRATCH A1: SRCBUMP -; D2: RIGHTMASK A2: SRCPTR -; D3: ROWCNT A3: MASKPTR -; D4: LEFTMASK A4: SAVEPTR -; D5: LONGCNT A5: DSTPTR -; D6: OFFSET A6: COPY LONGCNT -; D7: SCRATCH (A7): LEFTMASK -; 4(A7): COPY OFFSET - -END AND.L D2,D4 ;AND RIGHTMASK INTO LEFTMASK -MAIN BFEXTU (A2){D6:0},D0 ;EXTRACT A LONG OF SRC - BFEXTU (A3){D6:0},D1 ;EXTRACT A LONG OF MASK - ADD.L #32,D6 ;BUMP TO NEXT LONG - AND.L D4,D0 ;AND SRC WITH LEFTMASK - AND.L D4,D1 ;AND MASK WITH LEFTMASK - MOVE.L D0,D7 ;COPY SRC - - AND.L D1,D7 ;GET MASK AND SRC (PIXELS TO REPLACE) - NOT.L D1 ;GET NOTMASK - MOVE.L (A5),d4 ;get a long of screen - move.l d4,(A4)+ ;SAVE A LONG OF SCREEN - - AND.L D1,D0 ;GET NOTMASK AND SRC (PIXELS TO INVERT) - AND.L d4,D1 ;PUNCH HOLE FOR PIXELS TO REPLACE (used to be A5) - OR.L D7,D1 ;REPLACE PIXELS WITHIN MASK - EOR.L D0,D1 ;INVERT PIXELS OUTSIDE OF MASK - MOVE.L D1,(A5)+ ;AND PUT TO DST - MOVEQ #-1,D4 ;FLUSH LEFTMASK - SUB #1,D5 ;DECREMENT LONGCNT -START BGT.S MAIN ;=>MORE THAN ONE TO DO - BEQ.S END ;=>DO LAST LONG - MOVE.L 4(SP),D6 ;RESTORE OFFSET - MOVE.L (SP),D4 ;RESTORE LEFTMASK - ADD.L A1,A3 ;BUMP CURSOR DATA - ADD.L A1,A2 ;BUMP CURSOR MASK - ADD.L A0,A5 ;BUMP SCREEN POINTER - MOVE.L A6,D5 ;RESTORE LONGCNT (TEST D5) - DBRA D3,START ;=>DO NEXT ROW - - bra DoneBlit - - -Direct - bgt.s Direct32 - -;----------------------------------------------- -; -; DISPLAY THE CURSOR AND SAVE THE BITS BEHIND IT (DO THE CURSOR LIMBO!!) -; -; THE FUNNY TRANSFER MODE USED HERE WORKS THE SAME AS BEFORE FOR ONE BIT -; MODE, AND SIMILARLY FOR COLOR. IN COLOR, THE DATA PIXELS WITHIN THE MASK -; REPLACE THE DESTINATION; THE DATA PIXELS OUTSIDE THE MASK ARE XORED WITH -; THE DST. IF THE DATA PIXELS OUTSIDE OF THE MASK ARE BLACK (ALL F'S), -; THEN THE DST IS SIMPLY INVERTED. IF THEY ARE OTHER COLORS, INTERESTING -; EFFECTS WILL MANIFEST THEMSELVES. -; -; REGISTER USE: D0: SCRATCH A0: DSTBUMP -; D1: SCRATCH A1: SRCBUMP -; D2: RIGHTMASK A2: SRCPTR -; D3: ROWCNT A3: MASKPTR -; D4: LEFTMASK A4: SAVEPTR -; D5: LONGCNT A5: DSTPTR -; D6: OFFSET A6: COPY LONGCNT -; D7: SCRATCH (A7): LEFTMASK -; 4(A7): COPY OFFSET -Direct16 - swap d4 - - addq #1,d5 ;make one based - add d5,d5 ;convert longcnt to word cnt - move d5,d0 ;save pixel cnt - subq #2,d5 ;make zero based - 1 - move d5,a6 ;save a copy for later scans - - moveq #-1,d7 - lsr.w #1,d7 ;make into low15bits mask - - add d0,d0 ;make into byte cnt - sub d0,a1 ;make srcRow into srcBump - - asr #3,d6 ;make offset into bytes - add d6,a2 ;adjust src ptr - add d6,a3 ;adjust mask ptr - -@first tst d4 ;is left pixel masked? - bne.s @MAIN ;no, go to it - move.w (a5)+,(a4)+ ;save first pixel - addq #2,a2 ;bump past first src pixel - addq #2,a3 ;bump past first mask pixel - bra.s @next - -@MAIN move.w (A2)+,D0 ;EXTRACT A LONG OF SRC - MOVE.w (A5),d1 ;get a long of screen - move.w d1,(A4)+ ;SAVE A LONG OF SCREEN - tst.w (A3)+ ;EXTRACT A LONG OF MASK - bne.s @inside - not.w d0 ;flip src so that black is all 1's - and.w d7,d0 ;mask off high bit - beq.s @skipit ;no use in xoring with zero - eor.w d1,d0 ;xor dst with src -@inside - move.w d0,(a5) -@skipit addq #2,a5 -@next dbra D5,@MAIN ;DECREMENT LONGCNT - - tst d2 ;is right pixel masked? - bne.s @last ;no, go to it - move.w (a5)+,(a4)+ ;save first pixel - addq #2,a2 ;bump past first src pixel - addq #2,a3 ;bump past first mask pixel - bra.s @nxtScn - -@last move.w (A2)+,D0 ;EXTRACT A LONG OF SRC - MOVE.w (A5),d1 ;get a long of screen - move.w d1,(A4)+ ;SAVE A LONG OF SCREEN - tst.w (A3)+ ;EXTRACT A LONG OF MASK - bne.s @in - not.w d0 ;flip src so that black is all 1's - and.w d7,d0 ;mask off high bit - beq.s @skip ;no use in xoring with zero - eor.w d1,d0 ;xor dst with src -@in - move.w d0,(a5) -@skip addq #2,a5 -@nxtScn ADD.L A1,A3 ;BUMP CURSOR DATA - ADD.L A1,A2 ;BUMP CURSOR MASK - ADD.L A0,A5 ;BUMP SCREEN POINTER - MOVE.L A6,D5 ;RESTORE LONGCNT - DBRA D3,@First ;=>DO NEXT ROW - bra DoneBlit - - - - -;----------------------------------------------- -; -; DISPLAY THE CURSOR AND SAVE THE BITS BEHIND IT (DO THE CURSOR LIMBO!!) -; -; THE FUNNY TRANSFER MODE USED HERE WORKS THE SAME AS BEFORE FOR ONE BIT -; MODE, AND SIMILARLY FOR COLOR. IN COLOR, THE DATA PIXELS WITHIN THE MASK -; REPLACE THE DESTINATION; THE DATA PIXELS OUTSIDE THE MASK ARE XORED WITH -; THE DST. IF THE DATA PIXELS OUTSIDE OF THE MASK ARE BLACK (ALL F'S), -; THEN THE DST IS SIMPLY INVERTED. IF THEY ARE OTHER COLORS, INTERESTING -; EFFECTS WILL MANIFEST THEMSELVES. -; -; REGISTER USE: D0: SCRATCH A0: DSTBUMP -; D1: SCRATCH A1: SRCBUMP -; D2: RIGHTMASK A2: SRCPTR -; D3: ROWCNT A3: MASKPTR -; D4: LEFTMASK A4: SAVEPTR -; D5: LONGCNT A5: DSTPTR -; D6: OFFSET A6: COPY LONGCNT -; D7: SCRATCH (A7): LEFTMASK -; 4(A7): COPY OFFSET - - if cursorShadow then - -Direct32 - move d5,d0 ;get a copy of long cnt - addq #1,d0 ;make one based - lsl #2,d0 ;make into byte cnt - sub d0,a1 ;make srcRow into srcBump - - asr #3,d6 ;make offset into bytes - add d6,a2 ;adjust src ptr - add d6,a3 ;adjust mask ptr - - -voff equ 4 -hoff equ 4 - -;----------------------------------------------- -; -; SAVE DSTLEFT/DSTBUMP/LONGCNT/ROWCNT INTO CRSRPTR SO THAT -; HIDECURSOR KNOWS HOW MUCH SCREEN TO REPLACE. - - movem.l d3/d5/a6/a5/a0,-(sp) - MOVE.L ([CRSRPTR]),D0 ;GET POINTER TO CURSOR DATA (LOCKED) - _rTranslate24To32 - MOVE.L D0,A6 - LEA CCBYTES(A6),A6 ;POINT TO END OF SAVE STATE AREA - move.w mouse,d0 ;get vert pos - lsr.w #6,d0 - ; add.w #voff,d3 - add.w d0,d3 - move.w mouse+2,d0 ;get horiz pos - lsr.w #6,d0 - ; add.w #hoff,d5 - add.w d0,d5 - lsl.w #2,d0 - ; sub.w #hoff*4,a0 - sub.w d0,a0 - MOVEM.L A5/A0/D5/D3,-(A6) ;SAVE DSTLEFT/DSTBUMP/LONGCNT/ROWCNT - MOVE.L D5,A6 ;SAVE LONGCNT - -@MAIN2 MOVE.L (A5)+,d1 ;get a long of screen - move.l d1,(a4)+ ;save a long of screen - dbra D5,@MAIN2 ;DECREMENT LONGCNT - - ADD.L A0,A5 ;BUMP SCREEN POINTER - MOVE.L A6,D5 ;RESTORE LONGCNT - DBRA D3,@MAIN2 ;=>DO NEXT ROW - movem.l (sp)+,a5/d3/d5/a6/a0 - - - movem.l d3/a2-a5,-(sp) - - ; moveq #voff,d0 - move.w mouse,d0 ;get vert pos - lsr.w #6,d0 - bra.s @1 - -@0 ADD.w CRSRROW,A5 ;offset SCREEN POINTER vertically -@1 dbra d0,@0 - - move.w mouse+2,d0 ;get horiz pos - lsr.w #6,d0 - lsl.w #2,d0 - ; add.w #hoff*4,a5 - add.w d0,a5 - -@MAIN1 MOVE.L (A5),d1 ;get a long of screen - move.l (A2)+,d0 ;combine A LONG OF src - not.l d0 ;interested in nothing , dammit!!@! - and.l $31a,d0 ; shit line - or.l (A3)+,d0 ;EXTRACT A LONG OF MASK - beq.s @skipit1 - ;d0 = 0 - moveq #0,d0 ;assume result is black - moveq #$3f,d4 ;amount to remove from screen - swap d4 ;d4 = $3f0000 - sub.l d4,d1 ;darken the red channel - bcs.s @pinred - move.l d1,d0 ;take the red channel -@pinred - lsr.l #8,d4 - sub.w d4,d1 ;darken the grn channel - bcs.s @pingrn - move.w d1,d0 ;take the grn channel -@pingrn - lsr.w #8,d4 - sub.b d4,d1 ;darken the blu channel - bcs.s @pinblu - move.b d1,d0 ;take the blu channel -@pinblu - - move.l d0,(a5) -@skipit1 - addq #4,a5 - dbra D5,@MAIN1 ;DECREMENT LONGCNT - - ADD.L A1,A3 ;BUMP CURSOR DATA - ADD.L A1,A2 ;BUMP CURSOR MASK - ADD.L A0,A5 ;BUMP SCREEN POINTER - MOVE.L A6,D5 ;RESTORE LONGCNT - DBRA D3,@MAIN1 ;=>DO NEXT ROW - - movem.l (sp)+,d3/a2-a5 - - - -@MAIN move.l (A2)+,D0 ;EXTRACT A LONG OF SRC - MOVE.L (A5),d1 ;get a long of screen - tst.l (A3)+ ;EXTRACT A LONG OF MASK - bne.s @inside - not.l d0 ;flip src so that black is all 1's - beq.s @skipit ;no use in xoring with zero - eor.l d1,d0 ;xor dst with src -@inside - move.l d0,(a5) -@skipit addq #4,a5 - dbra D5,@MAIN ;DECREMENT LONGCNT - - ADD.L A1,A3 ;BUMP CURSOR DATA - ADD.L A1,A2 ;BUMP CURSOR MASK - ADD.L A0,A5 ;BUMP SCREEN POINTER - MOVE.L A6,D5 ;RESTORE LONGCNT - DBRA D3,@MAIN ;=>DO NEXT ROW - bra DoneBlit - - -; REGISTER USE: D0: SCRATCH A0: DSTBUMP -; D1: SCRATCH A1: SRCBUMP -; D2: RIGHTMASK A2: SRCPTR -; D3: ROWCNT A3: MASKPTR -; D4: LEFTMASK A4: SAVEPTR -; D5: LONGCNT A5: DSTPTR -; D6: OFFSET A6: COPY LONGCNT -; D7: SCRATCH (A7): LEFTMASK -; 4(A7): COPY OFFSET -Shadow8 - move d5,d0 ;get a copy of long cnt - addq #1,d0 ;make one based - lsl #2,d0 ;make into byte cnt - sub d0,a1 ;make srcRow into srcBump - - asr #3,d6 ;make offset into bytes - add d6,a2 ;adjust src ptr - add d6,a3 ;adjust mask ptr - - -;----------------------------------------------- -; -; SAVE DSTLEFT/DSTBUMP/LONGCNT/ROWCNT INTO CRSRPTR SO THAT -; HIDECURSOR KNOWS HOW MUCH SCREEN TO REPLACE. - - movem.l d3/d5/a6/a5/a0,-(sp) - MOVE.L ([CRSRPTR]),D0 ;GET POINTER TO CURSOR DATA (LOCKED) - _rTranslate24To32 - MOVE.L D0,A6 - LEA CCBYTES(A6),A6 ;POINT TO END OF SAVE STATE AREA - move.w mouse,d0 ;get vert pos - lsr.w #6,d0 ;d0=voff - ; add.w #voff,d3 - add.w d0,d3 - move.w mouse+2,d0 ;get horiz pos - lsr.w #6,d0 ;d0=hoff - ; add.w #hoff,d5 - addq #3,d0 - lsr.w #2,d0 ;d0=shadow width longs - add.w d0,d5 - - lsl.w #2,d0 - ; sub.w #hoff*4,a0 - sub.w d0,a0 - MOVEM.L A5/A0/D5/D3,-(A6) ;SAVE DSTLEFT/DSTBUMP/LONGCNT/ROWCNT - MOVE.L D5,A6 ;SAVE LONGCNT - -;------------------------------------------- -; Save bits under cursor/shadow -;------------------------------------------- -@MAIN2 MOVE.L (A5)+,d1 ;get a long of screen - move.l d1,(a4)+ ;save a long of screen - dbra D5,@MAIN2 ;DECREMENT LONGCNT - - ADD.L A0,A5 ;BUMP SCREEN POINTER - MOVE.L A6,D5 ;RESTORE LONGCNT - DBRA D3,@MAIN2 ;=>DO NEXT ROW - movem.l (sp)+,a5/d3/d5/a6/a0 - - -;------------------------------------------- -; Draw Shadow -;------------------------------------------- - movem.l d3/a2-a5,-(sp) - - ; moveq #voff-1,d0 - move.w mouse,d0 ;get vert pos - lsr.w #6,d0 - bra.s @1 - -@0 ADD.w CRSRROW,A5 ;offset SCREEN POINTER vertically -@1 dbra d0,@0 - - move.w mouse+2,d0 ;get horiz pos - lsr.w #6,d0 - add.w d0,a5 - ; add.w #hoff,a5 - -@MAIN1 MOVE.l (A5),d1 ;get a long of screen - move.l (A2)+,d0 ;combine A LONG OF src - or.l (A3)+,d0 ;EXTRACT A LONG OF MASK - beq.s @skipit1 - ;d0 = 0 - moveq #0,d0 ;assume result is black - moveq #$3f,d4 ;amount to remove from screen - swap d4 ;d4 = $3f0000 - sub.l d4,d1 ;darken the red channel - bcs.s @pinred - move.l d1,d0 ;take the red channel -@pinred - lsr.l #8,d4 - sub.w d4,d1 ;darken the grn channel - bcs.s @pingrn - move.w d1,d0 ;take the grn channel -@pingrn - lsr.w #8,d4 - sub.b d4,d1 ;darken the blu channel - bcs.s @pinblu - move.b d1,d0 ;take the blu channel -@pinblu - - ; move.l d0,(a5) -@skipit1 - addq #4,a5 - dbra D5,@MAIN1 ;DECREMENT LONGCNT - - ADD.L A1,A3 ;BUMP CURSOR DATA - ADD.L A1,A2 ;BUMP CURSOR MASK - ADD.L A0,A5 ;BUMP SCREEN POINTER - MOVE.L A6,D5 ;RESTORE LONGCNT - DBRA D3,@MAIN1 ;=>DO NEXT ROW - - movem.l (sp)+,d3/a2-a5 - -;------------------------------------------- -; Draw cursor atop shadow -;------------------------------------------- - -@MAIN move.l (A2)+,D0 ;EXTRACT A LONG OF SRC - tst.l (A3)+ ;EXTRACT A LONG OF MASK - bne.s @inside - tst.l d0 ;flip src so that black is all 1's - beq.s @skipit ;no use in xoring with zero - MOVE.L (A5),d1 ;get a long of screen - eor.l d1,d0 ;xor dst with src -@inside - move.l d0,(a5) -@skipit addq #4,a5 - dbra D5,@MAIN ;DECREMENT LONGCNT - - ADD.L A1,A3 ;BUMP CURSOR DATA - ADD.L A1,A2 ;BUMP CURSOR MASK - ADD.L A0,A5 ;BUMP SCREEN POINTER - MOVE.L A6,D5 ;RESTORE LONGCNT - DBRA D3,@MAIN ;=>DO NEXT ROW - - else - -Direct32 - moveq #-1,d4 - lsr.l #8,d4 ;get low3bytes in d4 - move d5,d0 ;get a copy of long cnt - addq #1,d0 ;make one based - lsl #2,d0 ;make into byte cnt - sub d0,a1 ;make srcRow into srcBump - - asr #3,d6 ;make offset into bytes - add d6,a2 ;adjust src ptr - add d6,a3 ;adjust mask ptr - -@MAIN move.l (A2)+,D0 ;EXTRACT A LONG OF SRC - MOVE.L (A5),d1 ;get a long of screen - move.l d1,(A4)+ ;SAVE A LONG OF SCREEN - tst.l (A3)+ ;EXTRACT A LONG OF MASK - bne.s @inside - not.l d0 ;flip src so that black is all 1's - and.l d4,d0 ;mask off high byte - beq.s @skipit ;no use in xoring with zero - eor.l d1,d0 ;xor dst with src -@inside - move.l d0,(a5) -@skipit addq #4,a5 - dbra D5,@MAIN ;DECREMENT LONGCNT - - ADD.L A1,A3 ;BUMP CURSOR DATA - ADD.L A1,A2 ;BUMP CURSOR MASK - ADD.L A0,A5 ;BUMP SCREEN POINTER - MOVE.L A6,D5 ;RESTORE LONGCNT - DBRA D3,@MAIN ;=>DO NEXT ROW - - endif - - -DoneBlit - ADDQ #8,SP ;STRIP LEFTMASK AND OFFSET - MOVE.B #1,CrsrVis ;CURSOR VISIBLE - - moveq #0,d0 - move.b (sp)+,d0 ;get previous MMU state in d0 - _rSwapMMUMode ;restore MMU mode from d0.b -SkipBlit - MOVEM.L (SP)+,D0-D7/A0-A6 ;THE WALTZ IS OVER...(TANGO VERY MUCH) -NoBlit - RTS - - - -;_______________________________________________________________________ -; -; UNBLITCURSOR -; -; This routine unconditionally removes cursor according to the data in -; CCSTATEREGS. -; Such things as crsrstate, crsrvis, and other nonsense have already been -; checked. Vectoring this routine may prove useful for later cursor -; enhancements. - -UNBLITCURSOR PROC EXPORT - TST.L CRSRPTR ;CURSOR ALLOCATED? - BMI.S DONEHIDE ;=>NO, JUST RETURN - MOVEM.L D1-D4/A0-A2,-(SP) ;SAVE REGS USED - - MOVE.L ([CRSRPTR]),A0 ;GET POINTER TO CURSOR SAVE DATA (LOCKED) - MOVE.L CCSAVE(A0),A1 ;GET HANDLE TO SAVED BITS - MOVE.L (A1),d0 ;POINT TO SAVED BITS - _rTranslate24To32 ;mask off high byte - move.l d0,a1 - LEA CCSTATEREGS(A0),A0 ;POINT TO SAVE STATE AREA - MOVEM.L (A0)+,D2/D3/D4/A2 ;GET /ROWCNT/LONGCNT/DSTBUMP/DSTLEFT - - moveq #true32b,d0 ;switch to 32 bit mode - movem.l d2/a1/a2,-(sp) ;save off registers - _rSwapMMUMode ;get previous mode in d0.b (can trash a0/a2, d0/d2) - movem.l (sp)+,d2/a1/a2 ;restore registers - - MOVE.L D3,A0 ;SAVE LONGCNT -@1 MOVE.L (A1)+,(A2)+ ;RESTORE A LONG OF SOURCE - DBRA D3,@1 ;=>DO ENTIRE ROW - MOVE.L A0,D3 ;RESTORE LONGCNT - ADD D4,A2 ;BUMP DST - DBRA D2,@1 ;=>DO FOR ALL LINES - - _rSwapMMUMode ;restore original mode from d0.b - - CLR.B CRSRVIS ;MARK IT AS INVISIBLE - MOVEM.L (SP)+,D1-D4/A0-A2 ;RESTORE REGS USED -DONEHIDE RTS +_SetCCursor PROC EXPORT + IMPORT QDNEW_SETCCURSOR + JMP QDNEW_SETCCURSOR ; ;_______________________________________________________________________ @@ -1976,7 +318,7 @@ DONEHIDE RTS ; ; return a pointer to the start of the bit-map display ; -ScrnAddress PROC EXPORT +_ScrnAddress PROC EXPORT MOVE.L ScrnBase,4(SP) ;get screenBase set up by OS RTS ;that was easy! @@ -1987,7 +329,7 @@ ScrnAddress PROC EXPORT ; ; return the size of the screen in pixels ; -ScrnSize PROC EXPORT +_ScrnSize PROC EXPORT MOVE.L (SP)+,D0 ;get the return address MOVE.L MainDevice,A0 ;get handle to main screen device MOVE.L (A0),A0 ;point to main screen device diff --git a/QuickDraw/CQD.a b/QuickDraw/CQD.a index 02ddf1a..0a37691 100644 --- a/QuickDraw/CQD.a +++ b/QuickDraw/CQD.a @@ -50,6 +50,7 @@ PrNonPortable EQU 1 WholeErrors EQU 1 AddrModeFlag EQU 0 Quicker EQU 1 +has32BitQD EQU 1 ROMPaletteMgr EQU 1 ;set to zero for System Disk, 1 for ROM build @@ -155,6 +156,7 @@ BlockHead PROC EXPORT endif INCLUDE 'BITBLT.a' INCLUDE 'cCrsrCore.a' + INCLUDE 'QDExtensions2.a' INCLUDE 'QDUtil.a' INCLUDE 'Colorasm.a' INCLUDE 'Patterns.a' diff --git a/QuickDraw/CheckDevicesINIT.a b/QuickDraw/CheckDevicesINIT.a index 794a824..5c9d41b 100644 --- a/QuickDraw/CheckDevicesINIT.a +++ b/QuickDraw/CheckDevicesINIT.a @@ -221,8 +221,8 @@ SlotParms EQU IOPBlk-spBlock.SPBlockSize ; parameter block for slot manag VidParms EQU SlotParms-12 ; [12] size of mode params StartList EQU VidParms-4 ; [long] pointer to start of resource -VARSIZE EQU StartList ; size of local vars for CheckDevices -UTILVARS EQU VidParms ; size of local vars for utility routines +VARSIZE EQU StartList-4 ; size of local vars for CheckDevices +UTILVARS EQU VidParms-$30 ; size of local vars for utility routines ; ¥¥¥ Start of Code ¥¥¥ ; @@ -317,557 +317,42 @@ SetDevGamma ; ---------------------------------------------------------------------------------------------------------- + +NewFunc + + Link A6,#-$B4 + Move.l A2,-(SP) + Move.l (A0),A2 + + Lea.l -$94(A6),A1 + Move.l #-2,(A1) + + Lea.l -$B4(A6),A0 + Move.l A0,$C(A1) + Lea.l -$40(A6),A0 + + Move (A2),$18(A0) + Move #$14,$1A(A0) + Move.l A1,$1C(A0) + dc.w $A205 ; _PBStatusImmed + Move.l (SP)+,A2 + Unlk A6 + Rts + + + CheckDevices ; <19>: Moved label from within if-endif to embed utility ; routines. It would be nice to be able to the the LINK ; stuff AFTER the GotScrn entrypoint. LINK A6,#VARSIZE ; allocate local stack frame - MOVEM.L A0-A6/D0-D7,-(SP) ; so we donÕt screw up the boot process -;+++ MOVEM.L D6-D7/A2-A4,-(SP) ; save work registers + MOVEM.L A0-A4/D0-D7,-(SP) ; so we donÕt screw up the boot process -;+++; check to see if the device list needs to be initialized -;+++ -;+++ MOVE.L DeviceList,A0 ; get handle to device list -;+++ MOVE.L (A0),A0 ; point to head of device list -;+++ MOVE GDFlags(A0),D0 ; get the flags word -;+++ BTST #allInit,D0 ; test initialize flag? -;+++ BNE GoHome ; => devices already initialized - -; ¥¥¥ 1st INIT ¥¥¥ -; -; Try to load in the resource. If none, then just do a SetEntries on the boot device (see -; the comments on the NoScrn code below). -; -GetScrn - CLR.L -(SP) ; make room for function result - MOVE.L #'scrn',-(SP) ; push desired resource type - CLR -(SP) ; resource ID = 0 - _GetResource ; get the resource - MOVE.L (SP)+,D0 ; get the resource handle - Beq.s NoScrn ; if nil, do the no 'scrn' code - -; ¥¥¥ 2nd INIT ¥¥¥ -; -; Test the scrnInval low-mem to make sure the screen resource is valid. (Note: scrnInval -; will generally be cleared by the video cardÕs primaryInit IF the information in -; pRAM doesnÕt match the current set up). This is ALSO a case where we need to -; make a SetEntries call so the screen colors donÕt change on the the first SetEntries -; and/or SetGamma call. -; -ChkScrn - Tst.b scrnInval ; If the 'scrn' resource is not invalid, - Bne.s GotScrn ; then just go on. - - Move.l D0,A4 ; Save the 'scrn' resource handle. - - Move.l #gestaltDisplayMgrAttr,D0 ; We need to know if the Display Manager is around. - _Gestalt ; Ask, and ye shall receive. - Bne.s @NoDM ; Oops, got an error. - Move.l A0,D0 ; Get the result into D0. - Btst #gestaltDisplayMgrPresent,D0 ; If the Display Manager is around, then - Bne.s NoScrn ; donÕt dispose of the 'scrn' resource so -@NoDM ; so that the Display Manager can deal with it. - - Clr.w -(Sp) ; Make room for resFile refNum. - Move.l A4,-(Sp) ; Push 'scrn' resource handle for resFile. - _HomeResFile ; Get refNum. - - Move.l A4,-(Sp) ; Push 'scrn' resource handle for remove. - _RmveResource ; Try to remove it. - Tst.w ResErr ; If everything is okay, then - Beq.s @DisposeIt ; just go on. - - Tst.w (Sp)+ ; Clean up the stack. - Move.l A4,D0 ; Get 'scrn' resource handle back into D0. - Bra.s GotScrn ; And weÕre screwed. - -@DisposeIt Movea.l A4,A0 ; Get 'scrn' resource handle into A0. - _DisposHandle ; Dispose it. - - _UpdateResFile ; Update the 'scrn's resFile lest we die later. - -; If a 'scrn' resource is NOT around weÕll get here. The only thing we want to do at this -; point is to call SetDevEntries on the boot device so that the screen will not change colors -; after a SetEntries/SetGamma call is made later. -; -NoScrn Move.l DeviceList,A0 ; A0 contains gDevice. Move.l #-1,A1 ; Use gDeviceÕs PixMap for colorTable. Bsr.s SetDevEntries ; Bra NoGammaFix -; ¥¥¥ 3rd INIT ¥¥¥ -; -; Lock down the 'scrn' handle, and point at the data (in A4). -; -GotScrn - MOVE.L DeviceList,A0 ; get handle to device list - MOVE.L (A0),A0 ; point to head of device list - BSET #allInit,GDFlags(A0) ; say list has been initialized - - MOVE.L D0,-(SP) ; save 'scrn' resource for ReleaseResource - MOVE.L D0,A0 ; get the resource - _HLock ; lock it down - MOVE.L (A0),A4 ; A4 = resource pointer - -; Validate the 'scrn' resource. There must be a descriptor for every screen device. -; I assume that there are no duplicate entries and that screens don't overlap. -; In addition the devices in the 'scrn' resource must be in slot order. -; - MOVE.L A4,StartList(A6) ; save pointer to start of list - MOVE (A4)+,D7 ; get the number of screens in resource - - WITH spBlock,vpBlock - - LEA SlotParms(A6),A0 ; get pointer to parameter block - MOVE.L #((CatDisplay << 16) ++ TypVideo),spCategory(A0) - ; set category ID, type - MOVE.W #drSwApple,spDrvrSw(A0) ; set software, hardware ID - MOVE.B #$01,spTBMask(A0) ; ignore spDrvrHw - MOVE.B #0,spSlot(A0) ; start with desired slot (0 to check built-in devices) - MOVE.B #0,spID(A0) ; start with first (zeroth) ID - CLR.B spExtDev(A0) ; -NxtDev _sNextTypesRsrc ; get next video device - BEQ.S GotDev ; => there is one - -; There are no more screens; are there any more entries in the 'scrn' resource? -; - TST D7 ; there should have been one per device - BEQ GoodRsrc ; => there was, go initialize them - BRA BadScrn ; - -; Scan through 'scrn' resource entry for this device. -; -GotDev MOVE (A4)+,D0 ; get type - CMP spDrvrHw(A0),D0 ; does it match? - BNE BadScrn ; => nope, bad screen resource - MOVE (A4)+,D0 ; get slot - CMP.B spSlot(A0),D0 ; does it match? - BNE.S BadScrn ; => nope, bad screen resource - -; Get the DCE entry for the device and check dCtlDevBase. -; If no match, look for other devices in the same slot. -; -SlotOK MOVE spRefNum(A0),D0 ; get the refNum - NOT D0 ; refNum to unitnum - ASL #2,D0 ; offset in unitTable - MOVE.L UTableBase,A1 ; get the base of the unit table - MOVE.L (A1,D0),A3 ; A3 = handle to the DCE - MOVE.L (A3),A1 ; get pointer to the DCE - MOVE.L dCtlDevBase(A1),D0 ; get dCtlDevBase - CMP.L (A4)+,D0 ; do they match? - BNE.S BadScrn ; => nope, bad screen resource - -; Test to make sure that the requested mode (screen depth) is valid in this video -; sRsrc list. -; - MOVE.B spID(A0),D1 ; save the spID (so that itÕs correct for the sNextTypesRsrc) - MOVE.W (A4)+,D0 ; get the mode - MOVE.B D0,spID(A0) ; insert into spBlock - _sFindStruct ; find the sRsrc list entry for this mode - BNE.S BadScrn ; if not, then the scrn resource is no good - MOVE.B D1,spID(A0) ; restore the spID - -; To be completely compulsive about it, make sure there's a gDevice. -; - MOVE.L DeviceList,A3 ; A3 = first gDevice in list - MOVE spRefNum(A0),D1 ; get refnum (unaffected by sFindStruct) -@NxtGD MOVE.L (A3),A1 ; get pointer to device - CMP gdRefNum(A1),D1 ; does refnum match? - BEQ.S RectCheck ; => yes, this device matches! - MOVE.L gdNextGD(A1),D0 ; get handle of next device - MOVE.L D0,A3 ; get in A3 - BNE.S @NxtGD ; => check all gDevices - BRA.S BadScrn ; => no such gDevice, bad 'scrn' - -; Compare the size of the remembered screenRect to the size of this gDevice's -; gdRect. At this point, the gdRects are still topleft={0,0} from InitGDevice -; so we can just check 'scrn' rect against botRight. -; -RectCheck - ADD #8,A4 ; skip to global rect in 'scrn' - MOVE.W bottom(A4),D0 ; get bottom - SUB.W top(A4),D0 ; = height - CMP.W gdRect+bottom(A1),D0 ; is it equal? - BNE.S BadScrn ; nope, we're out - MOVE.W right(A4),D0 ; get right - SUB.W left(A4),D0 ; = width - CMP.W gdRect+right(A1),D0 ; is it equal? - BNE.S BadScrn ; nope, we're out - -; This device matches! Go check the next one. -; -SkipData ADD #8,A4 ; skip to control field - MOVE (A4)+,D0 ; get number of control calls - BRA.S SkipCtl ; skip control call -SkipNxt MOVE.L (A4)+,D1 ; get control code, size of params - ADD D1,A4 ; add size of params to skip block -SkipCtl DBRA D0,SkipNxt ; => skip next control - - SUBQ #1,D7 ; decrement device count - BMI.S BadScrn ; => oops, bad screen resource - - LEA SlotParms(A6),A0 ; get pointer to parameter block <14> - BRA.s NxtDev ; => check next device <19>: .s - -; If the 'scrn' resource is bad, then let's walk down the device list and offset -; the invalid screens' gdRects so that they don't all pile up at (0,0). Let's keep -; it simple--just put them all edge-to-edge, with the top edge at 0 (unchanged) and -; to the right of the previous guys'. Offset the gdPMap's rect also. -; -BadScrn - MOVE.L DeviceList,A0 ; get the head of the list (the boot screen) - MOVE.L (A0),A0 ; hndl->ptr - MOVE.W gdRect+right(A0),D1 ; get the boot screen's right edge (if the scrn - ; is invalid, then this is the real right edge) -@Loop MOVE.L gdNextGD(A0),D0 ; get handle to next screen - BEQ ScrnDone ; when NIL we're out of here <19>: Done -> ScrnDone - MOVE.L D0,A0 ; get this device - MOVE.L (A0),A0 ; handle to ptr - ADD.W D1,gdRect+left(A0) ; offset the left edge (normally zero) - ADD.W D1,gdRect+right(A0) ; offset the right edge - MOVE.L gdPMap(A0),A1 ; get the gdPMap handle - MOVE.L (A1),A1 ; get the gdPMap pointer - ADD.W D1,pmBounds+left(A1) ; offset the left edge (normally zero) - ADD.W D1,pmBounds+right(A1) ; offset the right edge - - MOVE.W gdRect+right(A0),D1 ; get the new right edge for the next device - BRA.S @Loop ; for each screen - -GoodRsrc _HideCursor ; cursor must be hidden here - MOVE.B #true,CrsrBusy ; MARK CHANGE IN PROGRESS - -; Configure each entry in the scrn resource -; - MOVE.L StartList(A6),A4 ; save pointer to start of list - MOVE (A4)+,D7 ; get the number of screens in resource - SUBQ #1,D7 ; make it 0 based - -; It would be nice if this routine could use sRsrcInfo or sNextsRsrc here, but we -; don't keep the video sRsrc spID in the scrn resource, just the hw ID!!! To -; make up for this, we must do a search by type. -; -DoNxt LEA SlotParms(A6),A0 ; get pointer to parameter block - MOVE.L #((CatDisplay << 16) ++ TypVideo),spCategory(A0) - ; set category ID, type - MOVE.W #drSwApple,spDrvrSw(A0) ; - ; set software, (invalid) hardware ID - MOVE (A4)+,spDrvrHw(A0) ; set driver hardware ID - MOVE.B #$00,spTBMask(A0) ; all fields valid - MOVE (A4)+,D0 ; get slot - MOVE.B D0,spSlot(A0) ; does it match? - MOVE.B #0,spID(A0) ; start with first ID - CLR.B spExtDev(A0) ; - _sNextTypesRsrc ; get next video device -;+++ BNE BadScrn ; => this should never be taken (so letÕs comment it out) <12> - -; We found a device that matches the given description! Find its gDevice and configure it. -; - MOVE spRefNum(A0),D1 ; D1 = refnum - - MOVE.L DeviceList,A3 ; A3 = first gDevice in list -@NxtGD MOVE.L (A3),A0 ; get pointer to device - CMP gdRefNum(A0),D1 ; does refnum match? - BEQ.S @GotGD ; => yes, got the gDevice - MOVE.L gdNextGD(A0),D0 ; get handle of next device - MOVE.L D0,A3 ; get in A3 - BNE.S @NxtGD ; => check all gDevices -;+++ BRA BadScrn ; => this should never be taken (so letÕs comment it out) <12> - -@GotGD MOVE.L (A4)+,D0 ; discard dCtlDevBase - -; Set up the GDFlags word before calling InitGDevice. -; - MOVE.L (A3),A1 ; point at the grafDevice - MOVE gdFlags(A1),D0 ; get the flags word - AND 2(A4),D0 ; turn off the bits that are used - OR 4(A4),D0 ; turn on new bits - BSET #ramInit,D0 ; say we've initialized it - BSET #screenDevice,D0 ; and flag it as a screen device - MOVE D0,GDFlags(A1) ; set the flags word - -; If main device, set up low-memory handles. (Wait: If the ramInit and screenDevice -; flags are NOT setup, then why would the mainScreen flag be setup? -- jmp) -; - MOVE gdFlags(A1),D0 ; get the flags word - BTST #mainScreen,D0 ; is it the main scrn? - BEQ.S @InitGD ; => no, go init device - - MOVE.L A3,MainDevice ; set up as main screen device - MOVE.L A3,TheGDevice ; set up as default destination device - MOVE.L A3,SrcDevice ; set up as default source device - ; AllocCursor called by InitCursor to init cursor - MOVE.L (A3),A0 ; point to gDevice - MOVE.L gdPMap(A0),A0 ; get pixMap handle - MOVE.L (A0),A0 ; point to pixMap - MOVE.L baseAddr(A0),D0 ; get base address - MOVE.L D0,scrnBase ; and set up screen base - - LEA SlotParms(A6),A0 ; point at slot manager block again (it's still positioned from above) - MOVE (A4),D0 ; get the requested mode - MOVE.B #oneBitMode,spId(A0) ; pass the default mode (assumed to be 1-bit mode) - _sFindStruct ; point to this mode information - - MOVE.B #mVidParams,spID(A0) ; now get the device pixmap - _sGetBlock ; on the current heap (system normally here) - MOVE.L spResult(A0),A1 ; get the result pointer - MOVE.w vpRowBytes(A1),screenRow ; get the screen row bytes (WORD) - -; Set up the low-mem for screen resolution too. TheyÕre only WORD/WORD rather then FIXED/FIXED. -; - MOVE.W vpHRes(A1),ScrHRes ; Take the high word of vpHRes - MOVE.W vpVRes(A1),ScrVRes ; Take the high word of vpVRes - - MOVE.L spResult(A0),A0 ; Do what it says in IM V (p 446) instead of - _DisposPtr ; of using _sDispose. <12> - -@InitGD MOVE D1,-(SP) ; push refnum - MOVE (A4)+,-(SP) ; push mode - CLR -(SP) ; which should be long - MOVE.L A3,-(SP) ; push gDevice - _InitGDevice ; configure the gDevice - ADDQ #4,A4 ; mask and flags already used - -; If there is a gamma table resource id, get the gamma correction table and call the driver. -; We need to do this before setting the color table (via SetEntries) to make sure it takes -; effect right away. -; - MOVE 2(A4),D0 ; get the gamma table resource id - CMP #-1,D0 ; is it -1? - BEQ.S ChkTbl ; => yes, no table - -; If the gamma table resource id = -2, then request linear gamma from the driver. -; - CMP #-2,D0 ; is it -2? - BNE.S @GetFromSys ; nope, so load the system resource - -;+++ LEA VidParms(A6),A1 ; point to parameter block -;+++ CLR.L csGTable(A1) ; pass NIL to tell new drivers to set linear -;+++ BSR.S GammaControl ; call a common routine to set gamma - -; <19>: Use SetDevGamma instead of GammaControl -; - Move.l A3,A0 ; Put gDevice in A0 for SetDevGamma call. - Move.l #0,A1 ; (nil) gammaTable Ptr in A1 (to set linear). - Bsr.s SetDevGamma -; - BRA.S ChkTbl - -; Load the gamma resource from the system and set it. -; -@GetFromSys CLR.L -(SP) ; make room for function result - MOVE.L #'gama',-(SP) ; push gamma table rsrc type - MOVE D0,-(SP) ; else push resource id - _GetResource ; try to read in gamma table - MOVE.L (SP)+,D0 ; get the result - BEQ.S ChkTbl ; => couldn't find it, use default - MOVE.L D0,-(SP) ; save a copy for later - MOVE.L D0,A0 ; setup for HLock - _HLock ; - -;+++ LEA VidParms(A6),A1 ; point to params for SetGamma -;+++ MOVE.L (A0),csGTable(A1) ; gamma table pointer is only param -;+++ BSR.S GammaControl ; call a common routine - -; <19>: Use SetDevGamma instead of GammaControl. For <23>, the setup for the -; SetDevGamma call was backwards. -; - Move.l (A0),A1 ; Put pointer to gammaTable in A1, and - Move.l A3,A0 ; put pointer to GDevice in A0. - Bsr.s SetDevGamma -; - MOVE.L (SP),A0 ; get the resource handle back - _HUnlock ; free it - _ReleaseResource ; and release it (fixing the stack) - -; <19>: Commented out GammaControl as it is replaced by the SetDevGamma utility -; above. Also, the branch around the GammaControl routine is commented -; out. -; -;+++ BRA.S ChkTbl ; continue on -; -; Here's an imbedded utility. I know I burn 2 bytes always BSRing around it, but I -; would burn two with a word branch if the utility were outside. This routine sets -; up the iopb and csParam block for a SetGamma control call. It expects the csGTable -; field to be set up, the csParam block pointer in A1, and the gdevice pointer in A3. -; -;GammaControl -; -; LEA IOPBlk(A6),A0 ; point to parameter block -; MOVE.L A1,csParam(A0) ; move addr of parms into block -; MOVE.W #cscSetGamma,csCode(A0) ; cscSetGamma <12> -;+++ CLR.L ioCompletion(A0) ; no completion routine <16>: not necessary -;+++ CLR.W ioVRefNum(A0) ; no volRefNum <16>: not necessary -; MOVE.L (A3),A1 ; point to gdevice -; MOVE GDRefNum(A1),ioRefNum(A0) ; set device's refnum -; _Control ,IMMED ; SetGamma(GammaTable) -; ; if error here (likely if -2 were passed to -; ; and old driver) then just use default table -; RTS ; and back -; -; -; Previously, if there was a color table resource id, this part loaded that table. Now, -; it checks the state of the gdDevType bit. If it is monochrome (=0), then this routine -; substitutes pixelSize+32 for the resID. If it is color (=1) and in 2- or 4-bit mode, then -; pixelSize+64 is substituted to yield a modified color table that includes the highlight -; color. -; -; If we EVER have a gamma ID <> -1 (not default), then be sure to set the color table -; to flush this gamma into the CLUT hardware. -; -; The pointer to the gDevice is still in A1. -; -; -ChkTbl - MOVE.L (A3),A1 ; point to the gDevice again - MOVE.L gdPMap(A1),A0 ; get pixmap - MOVE.L (A0),A0 ; get pixmap ptr - MOVE.W pmPixelSize(A0),D0 ; get depth - - CMP #clutType,gdType(A1) ; is it a direct/fixed (SKH) device? - BNE SetGRect ; if so, then do nothing <19>:s CSS - - BTST #gdDevType,gdFlags+1(A1) ; is it color or monochrome mode? - BNE.S @ClrMode ; if set, then this is color - CMP.W #2,D0 ; 1 or 2 bit/pixel? - BLE.S @RegClr ; don't do anything funky -@MonoMode - ADD #32,D0 ; add 32 to pixelsize in all modes for linear gray - BRA.S @GetClut ; -@ClrMode - MOVE.W D0,D1 ; copy the depth - AND #9,D1 ; is it 1- or 8-bit mode? - BNE.S @RegClr ; if so, then do regular behavior -@Is2or4 - ADD #64,D0 ; for 2- or 4-bit, add 64 to pixel depth (gives color+highlight) -;!!! BRA.S @GetClut ; - -@RegClr -;!!! MOVE (A4),D1 ; get the color table resource id -;!!! CMP #-1,D1 ; is it -1? -;!!! BNE.S @GetClut ; if not, then set the CLUT -;!!! CMP #-1,2(A4) ; if CLUTid=-1, and gammaID<>-1, then set CLUT to flush -;!!! BEQ.S SetGRect ; if both are default, then continue - -@GetClut CLR.L -(SP) ; make room for function result - MOVE D0,-(SP) ; push resource id - _GetCTable ; get a color table - MOVE.L (SP)+,D0 ; get the result - BEQ.S SetGRect ; => couldn't find it, use default - - MOVE.L D0,A0 ; save source handle in A0 - MOVE.L (A3),A1 ; point at the gDevice - MOVE.L gdPMap(A1),A1 ; get handle to its pixMap - MOVE.L (A1),A1 ; point at the pixMap - MOVE.L pmTable(A1),A1 ; get handle to existing color table - MOVE.L A1,-(SP) ; push the color table for later - MOVE.L A0,-(SP) ; push new table handle for dispose - - _GetHandleSize ; get the source size - MOVE.L D0,D1 ; save size in D1 - EXG A0,A1 ; get dest handle in A0 - _SetHandleSize ; set the dest handle size - EXG A0,A1 ; swap dest back to A1, src to A0 - - MOVE.L (A0),A0 ; get source ptr - MOVE.L (A1),A1 ; get dst ptr - MOVE.L D1,D0 ; get size to move - _BlockMove ; copy it - - _DisposCTable ; and dispose new handle - -; Now call the driver to set this color table (handle on stack) -; <19>: Use SetDevEntries call instead of in-line code. -; - Move.l A3,A0 ; A0 contains gDevice. - Move.l (Sp),A1 ; A1 contain colorTable Handle - Bsr.s SetDevEntries ; - -; MOVE.L (SP),A0 ; get handle to color table -; _HLock ; lock down the color table -; LEA VidParms(A6),A1 ; point to params for SetEntries -; MOVE.L (A0),A0 ; get ctabPtr -; CLR.W csStart(A1) ; start at zero, use sequence mode -; MOVE.W ctSize(A0),csCount(A1) ; for the length of the table -; LEA ctTable(A0),A0 ; get pointer to colorspecs -; MOVE.L A0,csTable(A1) ; color table pointer is first param -; LEA IOPBlk(A6),A0 ; point to parameter block -; MOVE.L A1,csParam(A0) ; move addr of parms into block -; MOVE.W #cscSetEntries,csCode(A0) ; cscSetEntries <12> -;+++ CLR.L ioCompletion(A0) ; no completion routine <14>: not necessary -;+++ CLR.W ioVRefNum(A0) ; no volRefNum <14>: not necessary -; MOVE.L (A3),A1 ; point to gdevice -; MOVE gdRefNum(A1),ioRefNum(A0) ; set device's refnum -; _Control ,IMMED ; do a SetEntries on color table -; -; MOVE.L (SP),A0 ; get handle to color table -; _HUnLock ; unlock the color table - -; Finally, generate an inverse table for the table (handle on stack) -; - MOVE.L (A3),A1 ; point at the gDevice - MOVE.L gdITable(A1),-(SP) ; push inverse table handle - MOVEQ #4,D0 ; make 4-4-4 inverse tables - MOVE D0,gdResPref(A1) ; save in GDevice - MOVE D0,-(SP) ; and push res - _MakeITable ; and generate inverse table (color/inverse table handles still on stack) - -; Use the specified rectangle to determine the device's global coordinates -; -SetGRect - ADDA #4,A4 ; skip the CLUT and gamma resID's - MOVE.L (A3),A0 ; point to the grafDevice - MOVE.L gdPmap(A0),A1 ; get handle to pixMap - MOVE.L (A1),A1 ; get pointer to pixMap - ADDQ #bounds,A1 ; point to pixMap.bounds - LEA gdRect(A0),A0 ; point to its rectangle - MOVE.L (A4)+,D0 ; get topLeft for mouse offset - MOVE.L D0,(A1)+ ; copy topLeft to pixMap.bounds - MOVE.L D0,(A0)+ ; copy topLeft to GDRect - MOVE.L (A4),(A1) ; copy botRight to pixMap.bounds - MOVE.L (A4)+,(A0)+ ; copy botRight to GDRect - -; Parse and execute the additional control commands -; - MOVE (A4)+,D6 ; get number of control calls - BRA.S ChkNxtCtl ; => jump into end of dbra loop -DoCtl LEA IOPBlk(A6),A0 ; point to parameter block - LEA 4(A4),A1 ; point to call parameters - MOVE.L A1,csParam(A0) ; move addr of parms into block - MOVE.W (A4)+,csCode(A0) ; set control code -;+++ CLR.L ioCompletion(A0) ; no completion routine <14>: not necessary -;+++ CLR.W ioVRefNum(A0) ; no volRefNum <14>: not necessary - MOVE.L (A3),A1 ; point to gdevice - MOVE gdRefNum(A1),ioRefNum(A0) ; set device's refnum - _Control ,IMMED ; and issue the control call - - MOVE (A4)+,D0 ; get size of param block - ADD D0,A4 ; skip param block -ChkNxtCtl DBRA D6,DoCtl ; loop for all control calls - -ChkNxt DBRA D7,DoNxt ; loop for all screens in resource - - MOVE.L MainDevice,a0 - move.l a0,CrsrDevice ; cursor is now on main device, no longer on boot device - - import GetDCtlEntry - - subq #4,sp ; room for resulting DCE handle - move.l (a0),a0 - move.w gdRefnum(a0),-(sp) ; get the refNum - jsr GetDCtlEntry - move.l (sp)+,a0 ; get handle to DCE - move.l (a0),a0 ; get pointer to DCE - move.l #0,d0 ; clear out D0 - move.b dCtlSlot(a0),d0 ; get the slot number - _AttachVBL ; attach VBL to this slot - - CLR.B CrsrBusy ; end of change - _AllocCursor ; make sure all cursor structs are updated - _ShowCursor ; now redisplay cursor - -ScrnDone _ReleaseResource ; all done with the resource <19>: Done -> ScrnDone - ; ¥¥¥ 4th INIT ¥¥¥ ; ; As explained above in the SixPack update notes, the NoGammaFix is for $067C-class @@ -879,14 +364,7 @@ ScrnDone _ReleaseResource ; all done with the resource <19>: Done -> ScrnDone ; NoGammaFix - Move.l ROMBase,A0 ; Point to ROMBase with A0. - If Not ForROM Then - Cmp.w #$067C,8(A0) ; If weÕre not running on a $67C - Bne GoHome ; ROM, then just go on. - Else - Cmp.w #$077D,8(A0) ; If weÕre not running on a $77D - Bne GoHome ; ROM, then just go on. - Endif + WITH spBlock,vpBlock ; Get the default gamma table from ROM (so we donÕt have to get it every time ; we find a card that needs it -- if we donÕt find any cards that need @@ -925,6 +403,15 @@ NoGammaFix Move.l (A0),A0 ; DCE Ptr. Move.b dCtlSlot(A0),D0 ; Save slot number. + + Cmp.b #15,D0 + Bcs.b @dont + Move.l A3,A0 + Bsr.w NewFunc + Bne.s @reallyDont + Bra.s @skipGD +@dont + Lea SlotParms(A6),A0 ; Fill out SpBlock: Move.b D0,spSlot(A0) ; spSlot = slot number Clr.w spID(A0) ; spID = 0 @@ -947,6 +434,8 @@ NoGammaFix ; We found a non-TFB card that contains no gamma table directory. So, we need to ; employ our fix, which is to make a SetGamma and then a SetEntries call. +@reallyDont + Move.l A2,A0 ; Lock down the gammaTable Handle. _Hlock @@ -969,11 +458,6 @@ NoGammaFix Move.l A2,A0 ; Dispose of the storage used for the _DisposHandle ; gammaTable Handle. -GoHome -;+++ MOVEM.L (SP)+,D6-D7/A2-A4 ; restore work registers - MOVEM.L (SP)+,A0-A6/D0-D7 ; so we donÕt screw up the boot process - UNLK A6 - ; ¥¥¥ 5th INIT ¥¥¥ ; ;---------------------------------------------------------------- @@ -1139,7 +623,7 @@ DoDrvrPatches ; ; Save all registers to prevent problems with the ROM INIT running code. ; - MOVEM.L A0-A6/D0-D7,-(SP) ; so we donÕt screw up the boot process + MOVEM.L A5-A6,-(SP) ; so we donÕt screw up the boot process ; ; Point to UnitTable in A2. @@ -1195,7 +679,12 @@ NxtSlotLoop MOVE.L (A2,D0*4),A1 ; get DCE handle MOVE.L (A1),A1 ; get DCE pointer - MOVE.L A1,A4 ; save this for driver patching code below + MOVE.L (A1),A4 + MOVE dCtlFlags(A1),D0 + BTST.L #6,D0 + BEQ.S @dont + MOVE.L (A4),A4 +@dont ; ; Point to spBlock. @@ -1235,13 +724,7 @@ NxtSlotLoop ; Take the DCE pointer in A4 (from above), and test to see if we want to patch this driver. ; @IntPtch - If Not ForROM Then - BTST #dRAMBased,dCtlFlags+1(A4) ; test if this is a driver in ROM (Erickson overpatch) <7.0> - BEQ NxtSlot ; if so, then continue to next slot <7.0> - Endif - - MOVE.L dCtlDriver(A4),A1 ; get handle to driver - MOVE.L (A1),A1 ; get pointer to driver + MOVE.L A4,A1 ; get pointer to driver MOVE.L drvrName+2(A1),D0 ; get a unique long from the name CMP.L #'DrWV',D0 ; is it the 2-Page card? @@ -1342,201 +825,10 @@ Out LEA spBlockSize(SP),SP ; clean up the stack ; ; Lets restore more registers than have ever been restored before. (Hey, you can never be too careful.) ; - MOVEM.L (SP)+,A0-A6/D0-D7 ; so we donÕt screw up the boot process + MOVEM.L (SP)+,A5-A6 + MOVEM.L (SP)+,A0-A4/D0-D7 ; so we donÕt screw up the boot process -; ¥¥¥ 6th INIT ¥¥¥ -; - if asINIT then -; -; Early in the boot process an _InitGraf was performed (for the Welcome to Mac box). -; It's not correct if the main screen moved away from the boot screen, so let's call -; InitGraf on these early globals to correct the problem. This will fix a problem -; with the LMgr "init" which didn't do an InitGraf while setting up the environment -; for an alert dialog. -; -; Note that for the new boot process this is no longer necessary. -; - - PEA -4(A5) - _InitGraf - - endif - -; ¥¥¥ 7th INIT ¥¥¥ -; - If Not ForROM Then - -;--------------------------------------------------------------------- -; Local variables, definitions, etc.... -;--------------------------------------------------------------------- - -drHwDAFB Equ $001C ; Built-in Video Hardware ID for Macintosh Quadras 700/900/950. -DrvrVer950 Equ $0001 ; Version number of the Macintosh Quadra 950Õs video driver. - -badEntry Equ $38 ; Location of bad table entry in the Macintosh Quadra 950 driver. - -; Straight from the Macintosh Quadra 950 ROMÕs source codeÉ -; -DAFBVidPrivates RECORD 0 -saveBaseAddr DS.L 1 ; the screen base address (NOT ST corrected!) -saveScreenBase DS.L 1 ; ST corrected version of saveBaseAddr. -saveSQElPtr DS.L 1 ; the SQ element pointer (for _SIntRemove) -saveGammaPtr DS.L 1 ; the pointer to the Gamma correction table -saveGamDispPtr DS.L 1 ; the pointer to the Gamma block -saveVDACBase DS.L 1 ; the base addr of the VDAC -saveDAFBBase DS.L 1 ; the base addr of the DAFB -saveVidPtr DS.L 1 ; pointer to a big block of DAFB video parameters -GFlags DS.W 1 ; flags word -has16bppACDC Ds.b 1 ; true if AC842A is around -pageModeSet Ds.b 1 ; true if the pRam PageMode enable bit is set -saveMode DS.W 1 ; the current mode setting (in lo-byte) -saveMonID DS.W 1 ; monitor type ID (in lo-byte) -saveSlotId DS.W 1 ; spID of video sRsrc (hi-order byte only!) -DAFBVidPrivSize EQU * - ENDR - -; Flags within GFlags wordÉ -; -GrayFlag EQU 15 ; luminance mapped if GFlags(GrayFlag) = 1 -IntDisFlag EQU 14 ; interrupts disabled if GFlags(IntFlag) =1 -IsMono EQU 13 ; true if monochrome only display (Portrait/Kong) -UseSeq EQU 12 ; true if sequence mode SetEntries -UseTrans Equ 12 ; True if weÕre supposed to translate 5-bit into 8 (DAFB 16bpp). -Is16 EQU 11 ; true if 16Mhz (Slow) CPU -IsSlow Equ 11 ; True if Slow CPU (for DAFB, 25Mhz is slow). -IsDirect EQU 10 ; true if direct video mode, else chunkyIndexed -PsuedoIndex EQU 9 ; true if SetEntries request was mapped to indexed from sequential - ; (due to screen depth hardware requirements) -Has16bppSRsrc Equ 9 ; True if FifthVidMode is 16bpp instead of 32bpp (DAFB). -SyncOnGreen Equ 8 ; True if weÕre supposed to put sync on green (DAFB). - - - bra.s PatchQuadra950Driver ; skip over the title - - String Pascal - -DAFBVideoTitle Dc.b '.Display_Video_Apple_DAFB' - Align 2 - -;--------------------------------------------------------------------- -; Main -;--------------------------------------------------------------------- - -PatchQuadra950Driver - String AsIs - With SpBlock,DAFBVidPrivates - -Quadra950SaveRegs Reg D4-D6 ; Define work registers. - - If AsInit Then - Cmp.w #$3FFF,ROM85 ; If Color QuickDraw is not around, - Bne @ExitNow ; then just leave. - EndIf - - Tst.l DeviceList ; If the device list is empty, - Beq @ExitNow ; then just leave. - - Move.l DeviceList,A0 ; Get the DeviceList Handle. - Move.l (A0),A0 ; Make it a pointer. - Move.w gdRefNum(A0),D0 ; If thereÕs no driver, then - Beq @ExitNow ; we canÕt do anything here. - - Movem.l Quadra950SaveRegs,-(Sp) ; Save work registers. - Suba.w #spBlockSize,Sp ; Allocate SpBlock - -; The shipping version of the Macintosh Quadra 950Õs ROM (1.7F2) has a bug in the built-in video -; driver which prevents the DirectSetEntries call from working correctly when the attached display -; is put into 32 bit-per-pixel mode. To fix this problem, we just patch the bad table in place -; since it resides in the System heap. -; - Move.l Sp,A0 ; Get spBlock ptr into A0. - Clr.b spId(A0) ; Begin at id 0. - Clr.b spSlot(A0) ; We only care about Slot $0. - Clr.b spExtDev(A0) ; No external device. - Clr.b spTBMask(A0) ; No mask in search. - Move.w #catDisplay,spCategory(A0) ; Look for: Display, - Move.w #typVideo,spCType(A0) ; Video, - Move.w #drSwApple,spDrvrSW(A0) ; Apple, - Move.w #drHwDAFB,spDrvrHW(A0) ; DAFB. - Clr.l spParamData(A0) ; Look only for enabled sRsrcs. - Bset #foneslot,spParamData+3(A0) ; Limit search to this slot only. - _GetTypeSRsrc ; If built-in video is not enabled, then - Bne.s @AllDone ; just quit. - -; We found the DAFB-based (Macintosh Quadra 700/900/950) built-in video in Slot $0. -; - Moveq #0,D5 ; Prepare D5. - Move.w spRefNum(A0),D5 ; Get the refNum. - Beq.s @AllDone ; If nil, then just leave (no driver). - Not.w D5 ; Convert the refNum intoÉ - Lsl.w #2,D5 ; Éa UTable index. - - Add.l UTableBase,D5 ; Get a ptr to the AuxDCEHandle. - Move.l D5,A0 ; Get it into A0. - - Move.l (A0),A0 ; Get the AuxDCEHandle. - Move.l (A0),A0 ; Get the AuxDCEPtr. - Move.l A0,D5 ; Save it for later. - - move.w dCtlFlags(a0),d0 ; <27> Get driver flags - Move.l dCtlDriver(A0),A0 ; Get driver. - btst #dRAMBased,d0 ; <27> Check to see if dCtlDriver is a handle or a pointer - bz.s @gotDriverPointer ; <27> A ROM based driver means itÕs a pointer - Move.l (A0),A0 ; Get ptr to driver. -@gotDriverPointer - Move.l A0,D6 ; Save it for later. - - Moveq #0,D0 ; Prepare D0. - Lea drvrName(A0),A0 ; Point to the driver name. - Move.l A0,D4 ; Save it for later. - Move.b (A0)+,D0 ; Get its length. - Swap D0 ; Save it. - Lea DAFBVideoTitle,A1 ; Point to the driver name we want. - Move.b (A1)+,D0 ; Get its length. - _CmpString ; Compare the names. - Tst.w D0 ; If they are not equal, then we donÕt know about - Bne.s @AllDone ; this DAFB driver, so just leave. - - Moveq #0,D0 ; Re-prepare D0. - Move.l D4,A0 ; Re-point to the driver name. - Move.b (A0),D0 ; Get its length. - Addq #2,D0 ; Adjust offset to version field. - Bclr #0,D0 ; Adjust offset for word alignment. - Move.w (A0,D0),D4 ; Get the driverÕs version number. - Cmp.w #DrvrVer950,D4 ; If this isnÕt the Quadra 950Õs driver version, - Bne.s @AllDone ; then just leave. - - Adda.w D0,A0 ; Point to version part of driver name. - Move.l A0,D4 ; Save it for later. - -; We found the Macintosh Quadra 950Õs version of the DAFB driver. -; - Move.l D5,A0 ; Re-point to the AuxDCEPtr. - Move.l dCtlStorage(A0),A0 ; Get the Handle to DAFB private storage. - Move.l (A0),A0 ; Make it a pointer. - - Btst #Has16bppSRsrc,GFlags(A0) ; If a 16bpp-capable sRsrc is not in use, - Beq.s @AllDone ; then just leave. - - Move.l D6,A0 ; Re-point to the DAFB driver. - Move.b #$FF,badEntry(A0) ; Fix the bad table entry. - - Move.l D4,A0 ; Re-point to the DAFB driver version number. - Move.w #DrvrVer950+1,(A0) ; Update it. - -@AllDone - Add.w #spBlockSize,Sp ; Deallocate SpBlock. - Movem.l (Sp)+,Quadra950SaveRegs ; Restore work registers. - -@ExitNow ; Outta here, dudes. - Rts - - Endwith - - Else - - Rts - - Endif + UNLK A6 + RTS END diff --git a/QuickDraw/ColorMgr.a b/QuickDraw/ColorMgr.a index 2175257..ca971cc 100644 --- a/QuickDraw/ColorMgr.a +++ b/QuickDraw/ColorMgr.a @@ -637,7 +637,7 @@ Seed MOVE.L D5,D4 ; copy total # of color (and cleared hi word) SUBQ #2,D4 ; this is the number of colors remaining - BLE.S QVille ; if zero or negative, all done + BLT.S QVille ; if zero or negative, all done MOVEQ #1,D5 ; start at color #1 (zero based) @TheRestOfUs ; a temporary label for the rest of us BSR.S QUtil ; queue it diff --git a/QuickDraw/ColorQD.make b/QuickDraw/ColorQD.make index bca464a..fbd3364 100644 --- a/QuickDraw/ColorQD.make +++ b/QuickDraw/ColorQD.make @@ -21,6 +21,7 @@ QDPatchesDir = {ColorQDDir}Patches: CQDObjs = "{ObjDir}CheckDevicesINIT.a.o" ¶ "{ObjDir}CQD.a.o" ¶ + "{LibDir}MoreCQD.lib" ¶ "{ObjDir}DeviceLoop.a.o" @@ -28,8 +29,8 @@ CQDObjs = "{ObjDir}CheckDevicesINIT.a.o" Rez {StdROpts} -o "{Targ}" "{ColorQDDir}CQD.r" -i "{QDPatchesDir}" -# "{LibDir}CQD.lib" Ä {CQDObjs} -# Lib {StdLibOpts} -o "{Targ}" {CQDObjs} +"{LibDir}CQD.lib" Ä {CQDObjs} + Lib {StdLibOpts} -o "{Targ}" {CQDObjs} "{ObjDir}CheckDevicesINIT.a.o" Ä "{ColorQDDir}CheckDevicesINIT.a" diff --git a/QuickDraw/DeviceLoop.a b/QuickDraw/DeviceLoop.a index 303b0f6..671ae3c 100644 --- a/QuickDraw/DeviceLoop.a +++ b/QuickDraw/DeviceLoop.a @@ -105,8 +105,38 @@ LocalSize EQU * link A6, #LocalSize movem.l D3-D7/A2-A4, callerRegs(A6) ; save the callers registers - btst #6, ROM85 ; Color QuickDraw available? - bnz @classicQD ; if not, handle old case + machine MC68030 + move.l ([$2b6],$1fc),a0 + machine MC68020 + + tst.b $b5(a0) + beq.s @noShield + + move.l drawingRgn(a6),d0 + beq.s @noConversion + + move.l d0,a0 + move.l (a0),a0 + move.l $2(a0),localRect+0(a6) + move.l $6(a0),localRect+4(a6) + + pea localRect+0(a6) + _LocalToGlobal + + pea localRect+4(a6) + _LocalToGlobal + + bra.s @proceedWithShield +@noConversion + + move.l #$80008000,localRect+0(a6) + move.l #$7fff7fff,localRect+4(a6) + +@proceedWithShield + pea localRect+0(a6) + clr.l -(sp) + _ShieldCursor +@noShield move.l TheGDevice, D0 ; Get the handle to the current GDevice move.l MainDevice, D1 ; Get the handle to the main device @@ -149,11 +179,11 @@ LocalSize EQU * beq @noMore ; if so, no more devices move.l (A4), A3 ; point at the GDevice record bsr TestAndIntersect ; is device good for drawing? - bz.s @nextDevice ; if not, keep searching + bz @nextDevice ; if not, keep searching move.l flags(A6), D0 ; get the callerÕs options btst #allDevicesBit, D0 ; are we ignoring regions? - bnz.s @visRgnSetup ; if so, donÕt change the visRgn + bnz @visRgnSetup ; if so, donÕt change the visRgn move.l D4, -(SP) ; rectangle region handle pea localRect(A6) ; this device (local coords) @@ -175,10 +205,12 @@ LocalSize EQU * move.l ctSeed(A0), D7 ; stash deviceÕs ctab seed move.l flags(A6), D0 ; get callerÕs flags btst #singleDevicesBit, D0 ; should we group devices? - bnz.s @groupingDone ; if not, donÕt call AddSimilar + bnz @groupingDone ; if not, donÕt call AddSimilar bsr AddSimilarDevices ; find all the like devices @groupingDone movem.l D3-D7/A2-A4/A6, -(SP) ; save OUR registers + bsr NewFunc1 + move D2,-(SP) swap D6 move.l D6, -(SP) ; pass depth and flags move.l A4, -(SP) ; and the GDHandle @@ -187,6 +219,8 @@ LocalSize EQU * movem.l callerRegs(A6), D3-D7/A2-A4 ; restore callerÕs registers move.l A6Link(A6), A6 ; and restore callerÕs A6 jsr (A0) ; call the drawing procedure + move (SP)+,D2 + bsr NewFunc2 movem.l (SP)+, D3-D7/A2-A4/A6 ; get OUR register set back move.l (A4), A3 ; fix GDevicePtr @nextDevice @@ -194,13 +228,6 @@ LocalSize EQU * addq #1, D3 ; increment device number bra.s @deviceIntersect ; try this one -@classicQD - move.l A6, -(SP) ; save our stack frame ptr - move.w #1, -(SP) ; pass depth (always 1) - move.w #fakeDeviceFlags, -(SP) ; and gdflags (something reasonable) - clr.l -(SP) ; NIL for GDHandle - bra.s @simpleDeviceCommon - @oneDevice move.l A6, -(SP) ; save our stack frame ptr move.l gdPMap(A0), A1 ; PixMapHandle @@ -230,6 +257,17 @@ LocalSize EQU * _DisposRgn move.l savedVis(A6), visRgn(A2) ; put original visRgn back @exit + + machine MC68030 + move.l ([$2b6],$1fc),a0 + machine MC68020 + + tst.b $b5(a0) + beq.s @noShow + + _ShowCursor +@noShow + movem.l callerRegs(A6), D3-D7/A2-A4 ; restore regs unlk A6 move.l (SP)+, A0 ; clean stack and return @@ -252,27 +290,30 @@ AddSimilarDevices movem.l A3-A4/D3/D6, -(SP) ; save original state andi.w #importantFlagsMask, D6 ; keep only pertinent flags + move.l A3, A1 move.l gdNextGD(A3), A4 ; start with next device addq #1, D3 ; which is next in number, too @addLoop move.l A4, D0 ; is there a GDHandle? - bz.s @noMore ; if NIL, then weÕre done + bz @noMore ; if NIL, then weÕre done move.l (A4), A3 ; handle->ptr - bsr.s TestAndIntersect ; see if device is okay by itself - bz.s @nextDevice ; if not, try next one + move.l A1, -(SP) + bsr TestAndIntersect ; see if device is okay by itself + move.l (SP)+, A1 + bz @nextDevice ; if not, try next one move.w gdFlags(A3), D0 ; get device attributes andi.w #importantFlagsMask, D0 ; strip unimportant ones cmp.w D0, D6 ; is this device similar to test device? - bne.s @nextDevice ; if not, donÕt use it + bne @nextDevice ; if not, donÕt use it move.l gdPMap(A3), A0 ; get deviceÕs PixMapHandle move.l (A0), A0 ; get deviceÕs PixMapPtr move.l D6, D0 ; get depth and flags swap D0 ; get depth into low word cmp.w pmPixelSize(A0), D0 ; save depth as test device? - bne.s @nextDevice ; if not, donÕt use it + bne @nextDevice ; if not, donÕt use it move.l flags(A6), D0 ; get the option flags btst #dontMatchSeedsBit, D0 ; should we check ctSeeds? @@ -280,12 +321,49 @@ AddSimilarDevices move.l pmTable(A0), A0 ; handle to color table move.l (A0), A0 cmp.l ctSeed(A0), D7 ; are the seeds the same? - bne.s @nextDevice ; if not, donÕt use this one + bne @nextDevice ; if not, donÕt use this one @seedsChecked + move.l A3, A0 + move.l $22(A1), D0 + cmp $24(A0), D0 + bgt.s @L4 + blt.s @L1 + swap D0 + cmp $22(A0), D0 + bgt.s @L5 + blt.s @L2 + move.l $26(A1), D0 + cmp $28(A0), D0 + blt.s @L6 + bgt.s @L3 + bra.s @nextDevice +@L1 swap D0 + cmp $22(A0), D0 + bgt.s @doneWhateverThatWas +@L2 move.l $26(A1), D0 + cmp $28(A0), D0 + blt.s @doneWhateverThatWas +@L3 swap D0 + cmp $26(A0), D0 + blt.s @doneWhateverThatWas + bra.s @nextDevice +@L4 swap D0 + cmp $22(A0), D0 + blt.s @doneWhateverThatWas +@L5 move.l $26(A1), D0 + cmp $28(A0), D0 + bgt.s @doneWhateverThatWas +@L6 swap D0 + cmp $26(A0), D0 + bgt.s @doneWhateverThatWas + bra.s @nextDevice +@doneWhateverThatWas + move.l flags(A6), D0 ; what are the current options? btst #allDevicesBit, D0 ; are we ignoring drawingRgn? bnz.s @visRgnSetup ; if so, no regions to setup + move.l A1, -(SP) move.l D4, -(SP) ; rectangle region handle pea localRect(A6) ; this device (local coords) @@ -299,6 +377,7 @@ AddSimilarDevices move.l (SP), -(SP) ; get ORed together _XorRgn ; XOr is a fast way to Union when guaranteed no overlap move.l (A4), A3 ; fix GDevicePtr + move.l (SP)+, A1 @visRgnSetup bset.l D3, D5 ; mark this device done @@ -347,4 +426,73 @@ TestAndIntersect @exit rts + +NewFunc1 + moveq #0, D2 + move.l (DeviceList), D0 + beq.s @return + moveq #0, D1 +@L0 movea.l D0, A0 + movea.l (A0), A0 + cmp D3, D1 + beq.s @L8 + tst $14(A0) + bpl.s @L8 + movea.l (A4), A1 + move.l $22(A1), D0 + cmp $24(A0), D0 + bgt.s @L4 + blt.s @L1 + swap D0 + cmp $22(A0), D0 + bgt.s @L5 + blt.s @L2 + move.l $26(A1), D0 + cmp $28(A0), D0 + blt.s @L6 + bgt.s @L3 + bra.s @L7 +@L1 swap D0 + cmp $22(A0), D0 + bgt.s @L8 +@L2 move.l $26(A1), D0 + cmp $28(A0), D0 + blt.s @L8 +@L3 swap D0 + cmp $26(A0), D0 + blt.s @L8 + bra.s @L7 +@L4 swap D0 + cmp $22(A0), D0 + blt.s @L8 +@L5 move.l $26(A1), D0 + cmp $28(A0), D0 + bgt.s @L8 +@L6 swap D0 + cmp $26(A0), D0 + bgt.s @L8 +@L7 bclr.s #7, $14(A0) + bset.l D1, D2 +@L8 addq #1, D1 + move.l $1E(A0), D0 + bne.s @L0 +@return Rts + + +NewFunc2 + tst D2 + beq.s @return + move.l (DeviceList), D0 + beq.s @return +@L10 move.l D0, A0 + move.l (A0), A0 + lsr #1, D2 + bcc.s @L11 + bset.s #7, $14(A0) + tst D2 + beq.s @return +@L11 move.l $1E(A0), D0 + bne.s @L10 +@return Rts + END diff --git a/QuickDraw/DrawText.a b/QuickDraw/DrawText.a index 980912b..aed426d 100644 --- a/QuickDraw/DrawText.a +++ b/QuickDraw/DrawText.a @@ -2861,6 +2861,7 @@ renderIt @singleByteFont endif + ; 72624 MOVE.L WidthTabHandle, -(SP) ;2) Push the Width Table Handle onto the stack PEA fontID(A6) ;1) Push the Glyph Rec Ptr TST.B FASTFLAG(A6) ;if slow no need for 32-bit stuff @@ -2868,7 +2869,6 @@ renderIt TST.B needs32bit(A6) ;running 32 bit clean BEQ.S @skip32 ;NOPE, so skip it move.b MMUsave(a6),d0 ;get previous MMU state in d0 - _rSwapMMUMode ;get previous mode in d0.b (can trash a0/a1/a2, d0/d1/d2) _sbRetrieveGlyph ;Call the routine via SplineDispatch moveq #true32b,d0 ;switch to 32 bit addressing _rSwapMMUMode ;get previous mode in d0.b (can trash a0/a1/a2, d0/d1/d2) diff --git a/QuickDraw/FastTraps.a b/QuickDraw/FastTraps.a index 9cb9093..304dc38 100644 --- a/QuickDraw/FastTraps.a +++ b/QuickDraw/FastTraps.a @@ -1005,7 +1005,7 @@ selectGetGray equ 25 MACRO _ZapLinks - DoPaletteDispatch selectZapLinks,0 + DoPaletteDispatch selectZapLinks,4 ENDM MACRO @@ -2921,6 +2921,7 @@ _EmptyHandle OPWORD $A000+43 _InitApplZone OPWORD $A000+44 _SetApplLimit OPWORD $A000+45 _BlockMove OPWORD $A000+46 +_BlockMoveData OPWORD $A000+46+$200 ; Here are the event manager routines diff --git a/QuickDraw/GDevice.a b/QuickDraw/GDevice.a index 93dc4aa..e4d56f4 100644 --- a/QuickDraw/GDevice.a +++ b/QuickDraw/GDevice.a @@ -201,8 +201,6 @@ MODE EQU REFNUM-4 ; LONG, Mode for video card CMP.L #-1,D0 ; if mode = -1, then don't init beq.s Done ; => go home - CMP.W #OneBitMode,D0 ; is it one bit per pixel? - BEQ.S @Mono ; => yes, default to black and white Bsr TestForGray ; is it monochrome only? Bne.s @Mono ; => yes, leave GDevice mono BSET #GDDevType,GDFlags+1(A3) ; else default to color @@ -210,7 +208,7 @@ MODE EQU REFNUM-4 ; LONG, Mode for video card @Mono MOVE.W REFNUM(A6),-(SP) ; pass device to initialize MOVE.L MODE(A6),-(SP) ; pass mode to initialize MOVE.L A2,-(SP) ; and pass gDevice handle - _InitGDevice ; initialize the device port + JSR ([$16B8]) ; initialize the device port DONE MOVE.L (SP)+,theZone ; restore the zone MOVE.L A2,RESULT(A6) ; return graf device handle @@ -364,6 +362,8 @@ oldBaseAddr DS.B 4 ; old base address, for later comparison oldPort DS.B 4 ; thePort, before we got here oldColor DS.B 8 ; a colorSpec used to reinstantiate fg/bk + DS.B 356 + VARSIZE DS.B 0 ; size of locals ENDR @@ -372,6 +372,13 @@ VARSIZE DS.B 0 ; size of locals LINK A6,#VARSIZE ; allocate stack frame MOVEM.L D3/A2-A4,-(SP) ; save off work registers + MOVE.L ExpandMem,A0 + MOVE.L $1FC(A0),A1 + TST.B $B5(A1) + BNE.S @true + CLR $276(A0) +@true + MOVE.L GDH(A6),A0 ; get the gDevice handle _HGetState ; get the current lock state MOVE D0,GDHState(A6) ; save the state @@ -390,16 +397,13 @@ VARSIZE DS.B 0 ; size of locals BNE.S @noShield ; no, don't shield cursor BTST #screenDevice,gdFlags(A2) ; is it screen (check hi byte with #>8) BEQ.S @noShield -;+++ PEA gdRect(A2) -;+++ CLR.L -(SP) ; in global cošrds -;+++ _ShieldCursor - _HideCursor ; changed to Hide from Shield to fix - ; problems when cursor is on the move - ; during InitGDevice + JSR ([$F48]) + @noShield ; initialize the GDevice's mode and refnum + SF.B -$6E(A6) MOVE REFNUM(A6),GDRefNum(A2) ; set up RefNum MOVE.L MODE(A6),D0 ; get the mode CMP.L MinusOne,D0 ; is the mode -1? @@ -415,7 +419,8 @@ VARSIZE DS.B 0 ; size of locals MOVE.L A1,csParam(A0) ; point to param list CMP.L GDMode(A2),D0 ; has the mode changed? - BEQ GrayOrColor ; => no, so don't set depth + BEQ.S GrayOrColor ; => no, so don't set depth + ST.B -$6E(A6) MOVE.L D0,GDMode(A2) ; set up mode ; setup the gDevice fields for the new screen depth @@ -491,97 +496,246 @@ NoTbl MOVEQ #4,D0 ; make 4-4-4 inverse tables MOVE D0,GDResPref(A2) ; save in GDevice MOVE D0,-(SP) ; and push res - _MakeITable ; and generate table + JSR ([$16E4]) ; and generate table -; If this device has not been initialized from the system file, then copy the -; bounds from the pixMap to the GDRect. Otherwise copy the GDRect to the Bounds. ModeOK - LEA BOUNDS(A3),A0 ; point to pixmap.bounds - LEA GDRECT(A2),A1 ; point to device's global rect - MOVE GDFlags(A2),D0 ; get the flags word - BTST #RAMInit,D0 ; initialized from RAM? - BEQ.S BndsOK ; => no, copy pixMap.bounds to GDRect - EXG A0,A1 ; else copy GDRect to pixMap.bounds -BndsOK MOVE.L (A0)+,(A1)+ ; copy topLeft - MOVE.L (A0)+,(A1)+ ; copy botRight - -; -; if we're about the main device, then fix all those -; potentially errant ports. -; - TST.B QDExist ; (Unless QuickDraw don't exist) - BNE @noQD - MOVE.L portList,D1 ; or if portlist = 0 or -1 - BEQ @noQD - ADDQ.L #1,D1 - BEQ @noQD - - BTST #mainScreen,D0 ; is it the main scrn? (flags already in D0) - BEQ @notMain - - PEA oldPort(A6) ; Save the current port + MOVE.L ([$2B6],$1FC),A0 + TST.B $B5(A0) + BEQ @L13 + MOVE $14(A2),D0 + BTST.L #$D,D0 + BEQ @L13 + BTST.L #$A,D0 + BEQ @L13 + TST (A2) + BEQ @L13 + TST.B -$6E(A6) + BEQ @L13 + MOVE.L $22(A2),-$6C(A6) + MOVE.L $26(A2),-$68(A6) + TST.B (QDExist) + BNE @L9 + MOVE.L A5,-$7A(A6) + LEA.L -$7E(A6),A5 + MOVE.L $6(A3),$22(A2) + MOVE.L $A(A3),$26(A2) + MOVE.L (ScrnBase),-$1BC(A6) + MOVE.L -$58(A6),D1 + CMP.L (ScrnBase),D1 + BNE.S @L0 + MOVE $14(A2),D0 + BTST.L #$B,D0 + BEQ @L0 + MOVE.L (A3),(ScrnBase) +@L0 PEA.L -$82(A6) + _InitGraf + PEA.L -$1B8(A6) + _OpenPort + MOVE.L D2,-(SP) + MOVEQ.L #$0,D1 + MOVEQ.L #$1,D2 + MOVE.L (DeviceList),D0 +@L1 BEQ.S @L5 + MOVE.L D0,A0 + CMPA.L $8(A6),A0 + MOVE.L (A0),A0 + BNE.S @L2 + BSET.B #$7,$14(A0) + BNE.S @L4 + BRA.S @L3 +@L2 BTST.B #$7,$14(A0) + BEQ.S @L4 + BCLR.B #$7,$14(A0) +@L3 OR D2,D1 +@L4 LSL #$1,D2 + MOVE.L $1E(A0),D0 + BRA.S @L1 +@L5 MOVE.L (SP)+,D2 + MOVE D1,-(SP) + SUBQ.L #$4,SP + _NewRgn + MOVE.L (SP),-(SP) + MOVE.L (SP),-(SP) + PEA.L $6(A3) + _RectRgn + LEA.L -$1B8(A6),A0 + MOVE.L $18(A0),-(SP) + MOVE.L (SP),-(SP) + _UnionRgn + _DisposRgn + MOVE $C(A3),D0 + SUB $8(A3),D0 + MOVE -$66(A6),D1 + SUB -$6A(A6),D1 + SUB D1,D0 + ASR #$1,D0 + MOVE D0,-$1C6(A6) + MOVE $A(A3),D0 + SUB $6(A3),D0 + MOVE -$68(A6),D1 + SUB -$6C(A6),D1 + SUB D1,D0 + ASR #$1,D0 + MOVE D0,-$1C8(A6) + MOVE $8(A3),D0 + ADD -$1C6(A6),D0 + MOVE.L $6(A3),-$76(A6) + MOVE $A(A3),-$72(A6) + MOVE D0,-$70(A6) + PEA.L -$76(A6) + MOVE.L (A5),A1 + PEA.L -$10(A1) + _FillRect + MOVE $6(A3),D0 + ADD -$1C8(A6),D0 + MOVE $C(A3),-$70(A6) + MOVE D0,-$72(A6) + PEA.L -$76(A6) + MOVE.L (A5),A1 + PEA.L -$10(A1) + _FillRect + MOVE $A(A3),D0 + SUB -$1C8(A6),D0 + MOVE.L $A(A3),-$72(A6) + MOVE $8(A3),-$74(A6) + MOVE D0,-$76(A6) + PEA.L -$76(A6) + MOVE.L (A5),A1 + PEA.L -$10(A1) + _FillRect + MOVE $C(A3),D0 + SUB -$1C6(A6),D0 + MOVE $6(A3),-$76(A6) + MOVE D0,-$74(A6) + PEA.L -$76(A6) + MOVE.L (A5),A1 + PEA.L -$10(A1) + _FillRect + MOVE (SP)+,D1 + BEQ.S @L8 + MOVE.L (DeviceList),D0 +@L6 BEQ.S @L8 + MOVE.L D0,A0 + MOVE.L (A0),A0 + LSR #$1,D1 + BCC.S @L7 + BSET.B #$7,$14(A0) + TST D1 + BEQ.S @L8 +@L7 MOVE.L $1E(A0),D0 + BRA.S @L6 +@L8 PEA.L -$1B8(A6) + _ClosePort + MOVE.L -$1BC(A6),(ScrnBase) + MOVE.L -$6C(A6),$22(A2) + MOVE.L -$68(A6),$26(A2) + MOVE.L -$7A(A6),A5 +@L9 MOVE D2,-(SP) + MOVE.L $16(A2),A0 + MOVE.L (A0),A0 + MOVE $4(A0),D0 + ANDI #$7FFF,D0 + MOVE $A(A0),D1 + SUB $6(A0),D1 + ADD -$6C(A6),D1 + SUB -$68(A6),D1 + ASR #$1,D1 + MULU D1,D0 + MOVE $C(A0),D1 + SUB $8(A0),D1 + ADD -$6A(A6),D1 + SUB -$66(A6),D1 + ASR #$1,D1 + MOVE $20(A0),D2 + CMPI #$8,D2 + BGT.S @L11 + BEQ.S @L12 +@L10 ASR #$1,D1 + ASL #$1,D2 + CMPI #$8,D2 + BLT.S @L10 + BRA.S @L12 +@L11 ASR #$3,D2 + MULU D2,D1 +@L12 EXT.L D1 + ADD.L D1,D0 + ADD.L D0,(A0) + MOVE (SP)+,D2 +@L13 LEA.L $6(A3),A0 + LEA.L $22(A2),A1 + MOVE $14(A2),D0 + BTST.L #$A,D0 + BEQ.S @L14 + EXG.L A0,A1 +@L14 MOVE.L (A0)+,(A1)+ + MOVE.L (A0)+,(A1)+ + TST.B (QDExist) + BNE @L20 + MOVE.L (PortList),D1 + BEQ @L20 + ADDQ.L #$1,D1 + BEQ @L20 + BTST.L #$B,D0 + BEQ @L19 + PEA.L -$5C(A6) _GetPort - MOVE.L mainDevice,theGDevice ; and set to the screen - - MOVE.L PortList,A4 ; A4 = handle to list of ALL ports - MOVE.L (A4),A4 ; A4->list of all ports - MOVE (A4),D3 ; D3 = number of ports that exist - BRA.S @portWalkEnd - -@portWalkLoop - MOVE.L PortList,A4 + MOVE.L (MainDevice),(TheGDevice) + MOVE.L (PortList),A4 MOVE.L (A4),A4 - MOVE.L 2(A4,D3.W*4),A4 ; A4 = this port - MOVE.L A4,-(SP) ; Set to each port in the port list + MOVE (A4),D3 + BRA.S @L17 +@L15 MOVE.L (PortList),A4 + MOVE.L (A4),A4 + MOVE.L $2(A4,D3.W*4),A4 + MOVE.L A4,-(SP) _SetPort - - MOVE.L oldBaseAddr(A6),D1 ; D1 = the scrnbase of ports to change - BTST #7,portVersion(A4) ; high bit set? - BEQ.S @oldPort - MOVE.L portPixMap(A4),A4 ; A4 = handle to the port's pixmap - MOVE.L (A4),A4 ; A4->port's pixmap - CMP.L baseAddr(A4),D1 ; same as the screen's? - BNE.S @portWalkEnd ; no, skip this port - - MOVE.L baseAddr(A3),baseAddr(A4) ; replace a bunch of fields - MOVE rowBytes(A3),rowBytes(A4) - MOVE.L pixelType(A3),pixelType(A4) ; (gets pixelSize, too) - MOVE.L cmpCount(A3),cmpCount(A4) ; (gets cmpSize, too) - MOVE.L planeBytes(A3),planeBytes(A4) - - PEA oldColor(A6) ; placeholder for reinstantiating colors + MOVE.L -$58(A6),D1 + BTST.B #$7,$6(A4) + BEQ.S @L16 + MOVE.L $2(A4),A4 + MOVE.L (A4),A4 + CMP.L (A4),D1 + BNE.S @L17 + MOVE.L (A3),(A4) + MOVE $4(A3),$4(A4) + MOVE.L $1E(A3),$1E(A4) + MOVE.L $22(A3),$22(A4) + MOVE.L $26(A3),$26(A4) + PEA.L -$64(A6) MOVE.L (SP),-(SP) MOVE.L (SP),-(SP) MOVE.L (SP),-(SP) - _SaveFore ; Save and restore the foreground color - _RestoreFore ; (Allowing for pmFore) - _SaveBack ; And the same for the background + _SaveFore + _RestoreFore + _SaveBack _RestoreBack - BRA.S @portWalkEnd - -@oldPort - CMP.L portBits+baseAddr(A4),D1 ; same base on old port? - BNE.S @portWalkEnd - MOVE.L baseAddr(A3),portBits+baseAddr(A4) - MOVE rowBytes(A3),D1 - AND #nurbMask,D1 ; handle NURBs here - MOVE D1,portBits+rowBytes(A4) - -@portWalkEnd - DBRA D3,@portWalkLoop - MOVE.L oldPort(A6),-(SP) ; restore the pre-existing port + BRA.S @L17 +@L16 CMP.L $2(A4),D1 + BNE.S @L17 + MOVE.L (A3),$2(A4) + MOVE $4(A3),D1 + ANDI #$7FFF,D1 + MOVE D1,$6(A4) +@L17 DBF D3,@L15 + MOVE.L -$5C(A6),-(SP) _SetPort - - MOVE.L oldBaseAddr(A6),D1 - CMP.L scrnBase,D1 ; fix scrnBase too, if neede - BNE.S @notMain - MOVE.L baseAddr(A3),scrnBase - -@notMain + MOVE.L -$58(A6),D1 + CMP.L (ScrnBase),D1 + BNE.S @L18 + MOVE.L (A3),(ScrnBase) +@L18 MOVE.L -$58(A6),D1 + MOVE.L (A5),A0 + CMP.L -$7A(A0),D1 + BNE.S @L19 + MOVE.L (A3),-$7A(A0) +@L19 BTST.B #$D,$14(A2) + BEQ.S @L20 _AllocCursor _ShowCursor -@noQD +@L20 BSR.S NewFunc + MOVE.L (ExpandMem),A0 + MOVE D0,$276(A0) ; ; notify the Palette Manager that the mode has changed @@ -605,6 +759,62 @@ BndsOK MOVE.L (A0)+,(A1)+ ; copy topLeft UNLINK result-return-4,'INITGDEV' +NewFunc + MOVE.L (TheGDevice),D0 + BEQ @L32 + MOVE.L (MainDevice),D1 + CMP.L D0,D0 + BNE.S @L22 + MOVE.L (DeviceList),D0 + BEQ.S @L32 +@L22 MOVE.L D0,A0 + MOVE.L (A0),A0 + MOVE.L $1E(A0),D1 + BEQ.S @L32 +@L23 MOVE.L D1,A1 + MOVE.L (A1),A1 + MOVE.L $22(A1),D0 + CMP $24(A0),D0 + BGT.S @L27 + BLT.S @L24 + SWAP D0 + CMP $22(A0),D0 + BGT.S @L28 + BLT.S @L25 + MOVE.L $26(A1),D0 + CMP $28(A0),D0 + BLT.S @L29 + BGT.S @L26 + BRA.S @L30 +@L24 SWAP D0 + CMP $22(A0),D0 + BGT.S @L31 +@L25 MOVE.L $26(A1),D0 + CMP $28(A0),D0 + BLT.S @L31 +@L26 SWAP D0 + CMP $26(A0),D0 + BLT.S @L31 + BRA.S @L30 +@L27 SWAP D0 + CMP $22(A0),D0 + BLT.S @L31 +@L28 MOVE.L $26(A1),D0 + CMP $28(A0),D0 + BGT.S @L31 +@L29 SWAP D0 + CMP $26(A0),D0 + BGT.S @L31 +@L30 MOVEQ.L #$1,D0 + RTS +@L31 MOVE.L $1E(A1),D1 + BNE.S @L23 + MOVE.L $1E(A0),D0 + BNE.S @L22 +@L32 MOVEQ.L #$0,D0 + RTS + + GetDevPixMap PROC EXPORT IMPORT CopyHandle, GetCTSeed, RSetHSize ;---------------------------------------------------------------- @@ -627,7 +837,7 @@ DEVTYPE EQU PMH-4 ; LONG, VAR DevType MYBLOCK EQU -spBlock.SPBLOCKSIZE ; allocate room for parameter block PMHState EQU MyBlock-2 ; save pixMap lockState -VARSIZE EQU PMHState ; size of locals +VARSIZE EQU PMHState-$9A ; size of locals WITH spBlock,vpBlock ; @@ -636,6 +846,7 @@ VARSIZE EQU PMHState ; size of locals ; lock down the pixMap and get pointer in A2 + CLR.B -$D3(A6) MOVE.L PMH(A6),A0 ; get handle to pixMap _HGetState ; get the current state MOVE D0,PMHState(A6) ; save current state @@ -651,6 +862,46 @@ VARSIZE EQU PMHState ; size of locals MOVE.L (A1,D0),A3 ; A3 = handle to the DCE MOVE.L (A3),A1 ; get pointer to the DCE + LEA.L -$D2(A6),A4 + LEA.L -$82(A6),A0 + MOVE.L A4,$1C(A0) + MOVE $18(A1),$18(A0) + MOVE #$A,$1A(A0) + CLR.L $C(A0) + CLR.L $12(A0) + CLR $16(A0) + DC.W $A205 ; _PBStatusImmed + BNE.S @nope + MOVE.L $2(A4),-$3E(A6) + MOVE.L $8(A4),-$42(A6) + MOVE.L $2A(A1),D3 + LEA.L -$AC(A6),A0 + LEA.L -$C2(A6),A4 + MOVE.L A0,$6(A4) + MOVE.L $10(A6),D0 + MOVE D0,$4(A4) + MOVE.L -$3E(A6),(A4) + LEA.L -$82(A6),A0 + MOVE.L A4,$1C(A0) + MOVE $14(A6),$18(A0) + MOVE #$12,$1A(A0) + CLR.L $C(A0) + CLR.L $12(A0) + CLR $16(A0) + DC.W $A205 ; _PBStatusImmed + BNE.S @nope + LEA.L -$C2(A6),A4 + MOVE.B #$1,-$D3(A6) + MOVE.L -$42(A6),D3 + MOVE.L D3,$2A(A1) + MOVE.L $8(A6),A1 + MOVE.L $E(A4),D4 + MOVE D4,(A1) + LEA.L -$38(A6),A0 + LEA.L -$AC(A6),A1 + BRA.S @saveVals +@nope + ; get the resource list for the specified device LEA MYBLOCK(A6),A0 ; point to parameter block @@ -687,6 +938,7 @@ VARSIZE EQU PMHState ; size of locals BNE BadSlot ; => something wrong MOVE.L spResult(A0),A1 ; save the pointer to the block +@saveVals ADD.L vpBaseOffset(A1),D3 ; calculate baseAddr MOVE.L D3,(A2)+ ; save baseAddr @@ -731,11 +983,13 @@ VARSIZE EQU PMHState ; size of locals MOVE.L vpPlaneBytes(A1),(A2)+ ; offset from one plane to another - ; dispose of the sBlock + TST.B -$D3(A6) + BNE.S @dont MOVE.L A1,spsPointer(A0) ; - _sDisposePtr ; + _SDisposePtr ; MOVE.L A4,spsPointer(A0) ; restore pointer to list +@dont ; use DevType to initialize the color table @@ -748,14 +1002,14 @@ VARSIZE EQU PMHState ; size of locals GetClut CLR.L -(SP) ; make room for function result MOVE D5,-(SP) ; push resource ID - _GetCTable ; load in the color table resource + JSR ([$1660]) ; load in the color table resource MOVE.L (SP)+,D0 ; did we get one? BEQ TableOK ; => no, just punt MOVE.L D0,-(SP) ; push new handle for dispose MOVE.L D0,-(SP) ; push source handle MOVE.L (A2),-(SP) ; push destination handle - _CopyHandle ; copy table into our handle - _DisposCTable ; and dispose of new color table + JSR ([$1A14]) ; copy table into our handle + JSR ([$1690]) ; and dispose of new color table BRA.S TableOK ; => and continue ; @@ -788,10 +1042,11 @@ GetFromSlot MOVE.B #mTable,spID(A0) ; the fixed table <2.3> CMPI.L #minSeed,D0 ; is it a resource ID?

BLE.S @UseOriginalSeed ; -> yes, assume we know what we're doing

@GetNewSeed SUBQ #4,SP ; make room for function result <2.3> - _rGetCTSeed ; get a new, unique ctable seed <2.3> + JSR ([$16A0]) ; get a new, unique ctable seed MOVE.L (SP)+,ctSeed(A1) ; put in the new seed <2.3> @UseOriginalSeed ; transindex/ctflags set below <2.3> + ;¥¥¥ CSS end rollin GetDevPixMapPatch from Horror MOVE.L A4,spsPointer(A0) ; Restore the pointer to mode list. @@ -868,472 +1123,7 @@ CheckDevices PROC EXPORT ; CheckDevices is called by InitGraf. -PARAMSIZE EQU 0 - -IOPBlk EQU -IOVQElSize ; [64] parameter blk for I/O calls -SlotParms EQU IOPBlk-spBlock.SPBlockSize ; parameter block for slot manager calls -VidParms EQU SlotParms-12 ; [12] size of mode params -StartList EQU VidParms-4 ; [long] pointer to start of resource -VARSIZE EQU StartList ; size of locals - - - LINK A6,#VARSIZE ; allocate local stack frame - MOVEM.L D6-D7/A2-A4,-(SP) ; save work registers - -; check to see if the device list needs to be initialized - - MOVE.L DeviceList,A0 ; get handle to device list - MOVE.L (A0),A0 ; point to head of device list - MOVE GDFlags(A0),D0 ; get the flags word - BTST #AllInit,D0 ; test initialize flag? - BNE GoHome ; => devices already initialized - -; test the scrnInval lo-mem to make sure the screen resource is valid. - - TST.B scrnInval ; if this byte is cleared, then invalid - BEQ GoHome ; - -; try to load in the resource. If none, then exit - - CLR.L -(SP) ; make room for function result - MOVE.L #'scrn',-(SP) ; push desired resource type - CLR -(SP) ; resource ID = 0 - _GetResource ; get the resource - MOVE.L (SP)+,D0 ; get the resource handle - BEQ GoHome ; => none, don't configure - -; lock down the handle, and point at the data - - MOVE.L DeviceList,A0 ; get handle to device list - MOVE.L (A0),A0 ; point to head of device list - BSET #AllInit,GDFlags(A0) ; say list has been initialized - - MOVE.L D0,-(SP) ; save resource for ReleaseResource - MOVE.L D0,A0 ; get the resource - _HLock ; lock it down - MOVE.L (A0),A4 ; A4 = resource pointer - -; validate the 'scrn' resource. There must be a descriptor for every screen device. -; I assume that there are no duplicate entries and that screens don't overlap. -; In addition the devices in the 'scrn' resource must be in slot order. - - MOVE.L A4,StartList(A6) ; save pointer to start of list - MOVE (A4)+,D7 ; get the number of screens in resource - - WITH spBlock,vpBlock - - LEA SlotParms(A6),A0 ; get pointer to parameter block - MOVE.L #((CatDisplay << 16) ++ TypVideo),spCategory(A0) ; - ; set category ID, type - MOVE.W #DrSwApple,spDrvrSw(A0) ; set software, hardware ID - MOVE.B #$01,spTBMask(A0) ; ignore spDrvrH - MOVE.B #0,spSlot(A0) ; start with desired slot - MOVE.B #0,spID(A0) ; start with first ID - CLR.B spExtDev(A0) ; -NxtDev LEA SlotParms(A6),A0 ; get pointer to parameter block - _sNextTypesRsrc ; get next video device - BEQ.S GotDev ; => there is one - -; there are no more screens, are there more resources? - - TST D7 ; there should have been one per device - BEQ GoodRsrc ; => there was, go initialize them - BRA.S BadScrn ; - -; scan through scrn resource for this device - -GotDev MOVE (A4)+,D0 ; get type - CMP spDrvrHw(A0),D0 ; does it match? - BNE.S badScrn ; => nope, bad screen resource - MOVE (A4)+,D0 ; get slot - CMP.B spSlot(A0),D0 ; does it match? - BNE.S badScrn ; => nope, bad screen resource - -; get the DCE entry for the device and check dCtlDevBase -; if no match look for more devices in same slot - -SlotOK MOVE spRefNum(A0),D0 ; get the refNum - NOT D0 ; refNum -> unitnum - ASL #2,D0 ; get offset in unitTable - MOVE.L UTableBase,A1 ; get the base of the unit table - MOVE.L (A1,D0),A3 ; A3 = handle to the DCE - MOVE.L (A3),A1 ; get pointer to the DCE - MOVE.L dCtlDevBase(A1),D0 ; get dCtlDevBase - CMP.L (A4)+,D0 ; do they match? - BNE.S badScrn ; => nope, bad screen resource - -; to be completely compulsive about it, make sure there's a grafDevice for it - - MOVE.L DeviceList,A3 ; A3 = first grafdevice in list - MOVE spRefNum(A0),D1 ; get refnum -@NxtGD MOVE.L (A3),A1 ; get pointer to device - CMP GDRefNum(A1),D1 ; does refnum match? - BEQ.S RectCheck ; => yes, this device matches! - MOVE.L GDNextGD(A1),D0 ; get handle of next device - MOVE.L D0,A3 ; get in A3 - BNE.S @NxtGD ; => check all grafDevices - BRA.S badScrn ; => no such grafDevice, bad 'scrn' - -; -; compare the size of the remembered screen rect to the size of this gDevice's -; gdRect. At this point, the GDRects are still topleft=(0,0) from InitGDevice -; so we can just check 'scrn' rect against botRight. - -RectCheck - ADD #10,A4 ; skip to global rect in scrn - MOVE.W bottom(A4),D0 ; get bottom - SUB.W top(A4),D0 ; = height - CMP.W GDRect+bottom(A1),D0 ; is it equal? - BNE.S badScrn ; nope, we're out - MOVE.W right(A4),D0 ; get right - SUB.W left(A4),D0 ; = width - CMP.W GDRect+right(A1),D0 ; is it equal? - BNE.S badScrn ; nope, we're out - -; this device matches! go check next one - -SkipData ADD #8,A4 ; skip to control field - MOVE (A4)+,D0 ; get number of control calls - BRA.S SkipCtl ; skip control call -SkipNxt MOVE.L (A4)+,D1 ; get control code, size of params - ADD D1,A4 ; add size of params to skip block -SkipCtl DBRA D0,SkipNxt ; => skip next control - - SUBQ #1,D7 ; decrement device count - BMI.S badScrn ; => oops, bad screen resource - BRA NxtDev ; => check next device - -BadScrn -; If the screen resource is bad, then let's walk down the device list and offset -; the invalid screens' GDRects so that they don't all pile up at (0,0). Let's keep -; is simple- I just put them all edge to edge, top edge at 0 (unchanged) and to the -; right of the previous guys. Offset the GDPMap's rect also. - - MOVE.L DeviceList,A0 ; get the head of the list (the boot screen) - MOVE.L (A0),A0 ; hndl->ptr - MOVE.W GDRect+right(A0),D1 ; get the boot screen's right edge (if the scrn - ; is invalid, then this is the real right edge) -@Loop MOVE.L GDNextGD(A0),D0 ; get handle to next screen - BEQ Done ; if NIL, then we're out of here - MOVE.L D0,A0 ; get this device - MOVE.L (A0),A0 ; hndl->ptr - ADD.W D1,GDRect+left(A0) ; offset the left edge (normally zero) - ADD.W D1,GDRect+right(A0) ; offset the right edge - MOVE.L gdPMap(A0),A1 ; get the GDPMap handle - MOVE.L (A1),A1 ; get the gdPMap pointer - ADD.W D1,pmBounds+left(A1) ; offset the left edge (normally zero) - ADD.W D1,pmBounds+right(A1) ; offset the right edge - - MOVE.W GDRect+right(A0),D1 ; get the new right edge for the next device - BRA.S @Loop ; for each screen - -GoodRsrc _HideCursor ; cursor must be hidden here - MOVE.B #1,CRSRBUSY ; MARK CHANGE IN PROGRESS - MOVE.L CRSRDEVICE,A0 ; GET HANDLE TO CURSOR DEVICE - MOVE.L (A0),A0 ; POINT TO CURSOR DEVICE - MOVE.L GDRECT+TOPLEFT(A0),D0 ; GET SCREEN TOPLEFT - SUB D0,MOUSE+H ; CONVERT MOUSE TO SCREEN LOCAL - SWAP D0 ; GET SCREEN TOP - SUB D0,MOUSE+V ; CONVERT MOUSE TO SCREEN LOCAL - MOVE.L MOUSE,MTEMP ; copy to mouse temp - MOVE.L MOUSE,RAWMOUSE ; and to raw coordinates - -; configure each entry in the scrn resource - - MOVE.L StartList(A6),A4 ; save pointer to start of list - MOVE (A4)+,D7 ; get the number of screens in resource - SUBQ #1,D7 ; make it 0 based - -DoNxt LEA SlotParms(A6),A0 ; get pointer to parameter block - MOVE.L #((CatDisplay << 16) ++ TypVideo),spCategory(A0) ; - ; set category ID, type - MOVE.W #DrSwApple,spDrvrSw(A0) ; - ; set software, (invalid) hardware ID - MOVE (A4)+,spDrvrHw(A0) ; set driver hardware ID - MOVE.B #$00,spTBMask(A0) ; all fields valid - MOVE (A4)+,D0 ; get slot - MOVE.B D0,spSlot(A0) ; does it match? - MOVE.B #0,spID(A0) ; start with first ID - CLR.B spExtDev(A0) ; - _sNextTypesRsrc ; get next video device - BNE BadScrn ; => this should never be taken - -; we found a device that matches the given description! Find its GDevice and configure it - - MOVE spRefNum(A0),D1 ; D1 = refnum - - MOVE.L DeviceList,A3 ; A3 = first grafdevice in list -@NxtGD MOVE.L (A3),A0 ; get pointer to device - CMP GDRefNum(A0),D1 ; does refnum match? - BEQ.S @GotGD ; => yes, got the grafDevice - MOVE.L GDNextGD(A0),D0 ; get handle of next device - MOVE.L D0,A3 ; get in A0 - BNE.S @NxtGD ; => check all grafDevices - BRA BadScrn ; => this should never be taken - -@GotGD MOVE.L (A4)+,D0 ; discard dCtlDevBase - -; set up the GDFlags word before calling InitGDevice - -@0 MOVE.L (A3),A1 ; point at the grafDevice - MOVE GDFlags(A1),D0 ; get the flags word - AND 2(A4),D0 ; turn off the bits that are used - OR 4(A4),D0 ; turn on new bits - BSET #RAMInit,D0 ; say we've initialized it - BSET #ScreenDevice,D0 ; and flag it as a screen device - MOVE D0,GDFlags(A1) ; set the flags word - -; if main device, set up low-memory handles - -ChkMain MOVE GDFlags(A1),D0 ; get the flags word - BTST #mainScreen,D0 ; is it the main scrn? <2.2> - BEQ.S @InitGD ; => no, go init device - - MOVE.L A3,MainDevice ; set up as main screen device - MOVE.L A3,TheGDevice ; set up as default destination device - MOVE.L A3,SrcDevice ; set up as default source device - ; allocCursor called by initgraf to init cursor - MOVE.L (A3),A0 ; point to gDevice - MOVE.L gdPMap(A0),A0 ; get pixMap handle - MOVE.L (A0),A0 ; point to pixMap - MOVE.L baseAddr(A0),D0 ; get base address - MOVE.L D0,scrnBase ; and set up screen base - - LEA SlotParms(A6),A0 ; point at slot manager block again (it's still positioned from above) - MOVE (A4),D0 ; get the requested mode -;+++ MOVE.B D0,spID(A0) ; put in block - MOVE.B #128,spId(A0) ; pass the default mode (assumed to be 1-bit mode) - _sFindStruct ; point to this mode information - - MOVE.B #mVidParams,spID(A0) ; now get the device pixmap - _sGetBlock ; on the system heap (I guess this is OK) - MOVE.L spResult(A0),A1 ; get the result pointer - MOVE.w vpRowBytes(A1),screenRow ; get the screen row bytes (WORD) - -; set up the lo-mem for screen resolution too. It's only WORD/WORD rather then FIXED/FIXED - MOVE.W vpHRes(A1),ScrHRes ; Take the high word of vpHRes - MOVE.W vpVRes(A1),ScrVRes ; Take the high word of vpVRes - - MOVE.L A1,spsPointer(A0) ; now, release the sBlock - _sDisposePtr ; - -@InitGD - MOVE D1,-(SP) ; push refnum - MOVE (A4)+,-(SP) ; push mode - CLR -(SP) ; which should be long - MOVE.L A3,-(SP) ; push grafDevice - _InitGDevice ; configure the grafDevice - ADDQ #4,A4 ; mask and flags already used - -; -; if there is a gamma table resource id, get the gamma correction table and call the driver -; We need to do this before the color table to make sure it takes effect right away. -; - - MOVE 2(A4),D0 ; get the gamma table resource id - CMP #-1,D0 ; is it -1? - BEQ.S ChkTbl ; => yes, no table - -; -; if the gamma table resource id = -2, then request linear gamma from the driver -; - - CMP #-2,D0 ; is it -2? - BNE.S @GetFromSys ; nope, so load the system resource - - LEA VidParms(A6),A1 ; point to parameter block - CLR.L csGTable(A1) ; pass NIL to tell new drivers to set linear - BSR.S GammaControl ; call a common routine to set gamma - BRA.S ChkTbl ; - -; -; load the gamma resource from the system and set it -; - -@GetFromSys - CLR.L -(SP) ; make room for function result - MOVE.L #'gama',-(SP) ; push gamma table rsrc type - MOVE D0,-(SP) ; else push resource id - _GetResource ; try to read in gamma table - MOVE.L (SP)+,D0 ; get the result - BEQ.S ChkTbl ; => couldn't find it, use default - MOVE.L D0,-(SP) ; save a copy for later - MOVE.L D0,A0 ; setup for HLock - _HLock ; - LEA VidParms(A6),A1 ; point to params for SetGamma - MOVE.L (A0),csGTable(A1) ; gamma table pointer is only param - BSR.S GammaControl ; call a common routine - MOVE.L (SP),A0 ; get the resource handle back - _HUnlock ; free it - _ReleaseResource ; and release it (fixing the stack) - BRA.S ChkTbl ; continue on - -; -; here's an imbedded utility. I know I burn 2 bytes always BSRing around it, but I -; would burn two with a word branch if the utility were outside. This routine sets -; up the iopb and csParam block for a SetGamma control call. It expects the csGTable -; field to be set up, the csParam block pointer in A1, and the gdevice pointer in A3. -; - -GammaControl - LEA IOPBlk(A6),A0 ; point to parameter block - MOVE.L A1,csParam(A0) ; move addr of parms into block - MOVE.W #4,csCode(A0) ; csc_SetGamma - CLR.L ioCompletion(A0) ; no completion routine - CLR.W ioVRefNum(A0) ; no volRefNum - MOVE.L (A3),A1 ; point to gdevice - MOVE GDRefNum(A1),ioRefNum(A0) ; set device's refnum - _Control ,IMMED ; SetGamma(GammaTable) - ; if error here (likely if -2 were passed to - ; and old driver) then just use default table - RTS ; and back - -; -; Previously, if there was a color table resource id, this part loaded that table. Now, -; it checks the state of the gdDevType bit. If it is monochrome (=0), then this routine -; substitutes pixelSize+32 for the resID. If it is color (=1) and 2- or 4-bit mode, then -; pixelSize+64 is substituted to yield a modified color table that includes the highlight -; color. -; -; If we EVER have a gamma ID <> -1 (not default), then be sure to set the color table <2.3> -; to flush this gamma into the CLUT hardware. -; -; The pointer to the gDevice is still in A1. -; - -ChkTbl - MOVE.L (A3),A1 ; point to the gDevice again - MOVE.L gdPMap(A1),A0 ; get pixmap - MOVE.L (A0),A0 ; get pixmap ptr - MOVE.W pmPixelSize(A0),D0 ; get depth - - CMP #DirectType,gdType(A1) ; is it a direct device? - BEQ SetGRect ; if so, then do nothing - - BTST #gdDevType,gdFlags+1(A1) ; is it color or monochrome mode? - BNE.S @ClrMode ; if set, then this is color - cmp.w #2,d0 ; 1 or 2 bit/pixel? <2.1> - ble.s @regClr ; don't do anything funky <2.1> -@MonoMode - ADD #32,D0 ; add 32 to pixelsize in all modes for linear gray - BRA.S @GetClut ; -@ClrMode - MOVE.W D0,D1 ; copy the depth - AND #9,D1 ; is it 1- or 8-bit mode? - BNE.S @regClr ; if so, then do regular behavior -@is2or4 - ADD #64,D0 ; for 2- or 4-bit, add 64 to pixel depth (gives color+highlight) - BRA.S @GetClut ; - -@regClr - MOVE (A4),D1 ; get the color table resource id - CMP #-1,D1 ; is it -1? - BNE @GetClut ; if not, then set the CLUT <2.3> - CMP #-1,2(A4) ; if CLUTid=-1, and gammaID<>-1, then set CLUT to flush <2.3> - BEQ.S SetGRect ; if both are default, then continue <2.3> - -@GetClut CLR.L -(SP) ; make room for function result - MOVE D0,-(SP) ; else push resource id - _GetCTable ; get a color table - MOVE.L (SP)+,D0 ; get the result - BEQ.S SetGRect ; => couldn't find it, use default - - MOVE.L (A3),A0 ; point at the grafDevice - MOVE.L GDPMap(A0),A0 ; get handle to its pixmap - MOVE.L (A0),A0 ; point at the pixmap - MOVE.L pmTable(A0),-(SP) ; push our color table for set entries - MOVE.L D0,-(SP) ; push new table handle for dispose - MOVE.L D0,-(SP) ; push source color table - MOVE.L pmTable(A0),-(SP) ; push destination color table - _CopyHandle ; copy new table into our handle - _DisposCTable ; and dispose new handle - -; now call the driver to set this color table (handle on stack) - - MOVE.L (SP),A0 ; get handle to color table - _HLock ; lock down the color table - LEA VidParms(A6),A1 ; point to params for SetEntries - MOVE.L (A0),A0 ; get ctabPtr - CLR.W csStart(A1) ; start at zero, use sequence mode - MOVE.W ctSize(A0),csCount(A1) ; for the length of the table - LEA ctTable(A0),A0 ; get pointer to colorspecs - MOVE.L A0,csTable(A1) ; color table pointer is first param - LEA IOPBlk(A6),A0 ; point to parameter block - MOVE.L A1,csParam(A0) ; move addr of parms into block - MOVE.W #3,csCode(A0) ; csc_SetEntries - CLR.L ioCompletion(A0) ; no completion routine - CLR.W ioVRefNum(A0) ; no volRefNum - MOVE.L (A3),A1 ; point to gdevice - MOVE GDRefNum(A1),ioRefNum(A0) ; set device's refnum - _Control ,IMMED ; SetEntries(ColorTable); - MOVE.L (SP),A0 ; get handle to color table - _HUnLock ; unlock the color table - -; finally, generate an inverse table for the table (handle on stack) - - ; color table handle on stack - MOVE.L (A3),A1 ; point at the grafDevice - MOVE.L GDITable(A1),-(SP) ; push inverse table handle - MOVEQ #4,D0 ; make 4-4-4 inverse tables - MOVE D0,GDResPref(A1) ; save in GDevice - MOVE D0,-(SP) ; and push res - _MakeITable ; and generate inverse table - -; use the specified rectangle to determine the device's global coordinates - -SetGRect - ADDA #4,A4 ; skip the CLUT and gamma resID's - MOVE.L (A3),A0 ; point to the grafDevice - MOVE.L GDPMap(A0),A1 ; get handle to pixMap - MOVE.L (A1),A1 ; get pointer to pixMap - ADDQ #Bounds,A1 ; point to pixMap.bounds - LEA GDRect(A0),A0 ; point to its rectangle - MOVE.L (A4)+,D0 ; get topLeft for mouse offset - MOVE.L D0,(A1)+ ; copy topLeft to pixMap.bounds - MOVE.L D0,(A0)+ ; copy topLeft to GDRect - MOVE.L (A4),(A1) ; copy botRight to pixMap.bounds - MOVE.L (A4)+,(A0)+ ; copy botRight to GDRect - -; parse and execute the additional control commands - - MOVE (A4)+,D6 ; get number of control calls - BRA.S ChkNxtCtl ; => jump into end of dbra loop -DoCtl LEA IOPBlk(A6),A0 ; point to parameter block - LEA 4(A4),A1 ; point to call parameters - MOVE.L A1,csParam(A0) ; move addr of parms into block - MOVE.W (A4)+,csCode(A0) ; set control code - CLR.L ioCompletion(A0) ; no completion routine - CLR.W ioVRefNum(A0) ; no volRefNum - MOVE.L (A3),A1 ; point to gdevice - MOVE GDRefNum(A1),ioRefNum(A0) ; set device's refnum - _Control ,IMMED ; and issue the control call - - MOVE (A4)+,D0 ; get size of param block - ADD D0,A4 ; skip param block -ChkNxtCtl DBRA D6,DoCtl ; loop for all control calls - -ChkNxt DBRA D7,DoNxt ; loop for all screens in resource - -; NOW UPDATE THE MOUSE TO THE COORDINATE SYSTEM OF ITS SCREEN AND DISPLAY IT - - MOVE.L CRSRDEVICE,A0 ; GET HANDLE TO CURSOR DEVICE - MOVE.L (A0),A0 ; POINT TO CURSOR DEVICE - MOVE.L GDRECT+TOPLEFT(A0),D0 ; GET SCREEN TOPLEFT - ADD D0,MOUSE+H ; CONVERT MOUSE TO GLOBAL - SWAP D0 ; GET SCREEN TOP - ADD D0,MOUSE+V ; CONVERT MOUSE TO GLOBAL - MOVE.L MOUSE,MTEMP ; copy to mouse temp - MOVE.L MOUSE,RAWMOUSE ; and to raw coordinates - CLR.B CRSRBUSY ; end of change - _AllocCursor ; make sure cache structures are OK <5+> - _ShowCursor ; now redisplay cursor - -DONE _ReleaseResource ; all done with the resource - -GoHome MOVEM.L (SP)+,D6-D7/A2-A4 ; restore work registers - UNLINK PARAMSIZE,'CHECKDEV' - - ENDWITH + RTS ;------------------------------------------------------------- ; diff --git a/QuickDraw/GWorld.a b/QuickDraw/GWorld.a index c2a1838..3165b6f 100644 --- a/QuickDraw/GWorld.a +++ b/QuickDraw/GWorld.a @@ -695,6 +695,9 @@ varSize equ localRect ; size of local variables move #noErr,result(a6) ; flag a successful operation, + move.l offscreenGWorld(a6),a0 + clr.l (a0) + ;------------------------------------------------------------------------- ; Initialize all offscreen local variables to zero. ; If an error happens during this function, we deallocate the memory for @@ -765,6 +768,14 @@ varSize equ localRect ; size of local variables cmp #32,d7 ; illegal if > 32 bhi badPixelDepth ; exit with error +;------------------------------------------------------------------------- +; Treat 24-bit color as 32-bit. + + cmp #24,d7 + bne.s @dontSetTo32 + moveq #32,d7 +@dontSetTo32 + ;------------------------------------------------------------------------- ; If pixelDepth is not 0, don't try to align offscreen pixmap to screen @@ -1003,6 +1014,17 @@ createPixMap moveq #5,d0 ; no, cmpSize = 5 @0 move d0,pmCmpSize(a1) ; store cmpSize in pixmap + btst.l #$1,d3 + beq.s @skipthisnonsense + move.l ([museDevice,a6]),a0 + move.l ([gdPMap,a0]),a0 + move.l gdMode(a0),a0 + move.l a0,offscreenCTable(a6) + move.l ([offscreenPixMap,a6]),a1 + move.l a0,gdMode(a1) + bra createDevice +@skipthisnonsense + ; Create an empty color table. move #ctRec,d0 ; size of an empty color table @@ -1025,7 +1047,7 @@ createPixMap ; Create a dummy inverse table (doesn't have to be a seed) - moveq #2,d0 ; small handle for dummy inverse table + moveq #4,d0 ; small handle for dummy inverse table _NewHandle ,CLEAR ; allocate it bne reportError ; if Memory Manager error, report it and quit @@ -1149,7 +1171,7 @@ dontCloneCTab ; Allocate inverse table to its initial size - moveq #2,d0 ; initial size is 2 + moveq #4,d0 ; initial size is 2 _NewHandle ,CLEAR ; allocate it bne reportError ; if Memory Manager error, report it and quit @@ -1393,9 +1415,9 @@ disposOffscreenHandles move portVersion(a0),d0 ; get portVersion and #cPortFlag,d0 ; check if cPortFlag set cmp #cPortFlag,d0 ; is it set? - bne @0 ; if not set, don't close port + bne.s @0 ; if not set, don't close port move.l (a0),-(sp) ; push pointer to port - _ClosePort ; close it down + _CloseCPort ; close it down @0 move.l d7,a0 ; get handle to offscreen port _DisposHandle ; dispose it @@ -1732,7 +1754,7 @@ dontDisposeBaseAddr dontDisposeGDevice move.l offscreenGWorld(sp),-(sp) ; push pointer to offscreen port - _ClosePort ; get rid of all substructures + _CloseCPort ; get rid of all substructures move.l offscreenGWorld(sp),a0 ; get pointer to grafport _RecoverHandle ; find handle to grafport diff --git a/QuickDraw/GrafAsm.a b/QuickDraw/GrafAsm.a index 99d678d..cefa226 100644 --- a/QuickDraw/GrafAsm.a +++ b/QuickDraw/GrafAsm.a @@ -72,7 +72,7 @@ SIZEOK _NewHandle ,CLEAR ; ask OS to do request ; handle the memory full error by deep-shitting MemFull MOVEQ #25,D0 ;Deep Shit memory full error code - _SysError + DC.W $A9C9 ;_SysError JacksonPollock DC.W $A9FF ;invoke debugger just in case it comes back @@ -315,7 +315,6 @@ CRSRLP MOVE.L (A0)+,(A4)+ ;COPY A LONG INTO GLOBALS ; IF SCREENS NOT INITIALIZED FROM 'scrn' RESOURCE, INIT THEM - bsr.l CheckDevices ; configure screens, if needed MOVE.L MainDevice,A0 ; get main device MOVE.L A0,theGDevice ; set gDevice MOVE.L A0,srcDevice ; and srcDevice just in case diff --git a/QuickDraw/LCursor.a b/QuickDraw/LCursor.a index 0dcf8cf..1e2ea5b 100644 --- a/QuickDraw/LCursor.a +++ b/QuickDraw/LCursor.a @@ -40,11 +40,7 @@ AllocCursor PROC EXPORT ; PROCEDURE AllocCursor; ; - LEA AllocCrsr,A0 ;get default cursor routine - MOVE.L JAllocCrsr,D0 ;has vector been initialized? - BEQ.S @0 ;=>no, use default routine - MOVE.L D0,A0 ;else use routine in vector -@0 JMP (A0) ;and call it + JMP AllocCrsr InitCursor PROC EXPORT @@ -55,8 +51,8 @@ InitCursor PROC EXPORT MOVE.L GRAFGLOBALS(A5),A0 ;POINT TO QUICKDRAW GLOBALS PEA ARROW(A0) ;PUSH ADDR OF ARROW _SetCursor ;INSTALL ARROW CURSOR - MOVE.L JInitCrsr,A0 ;get lo mem pointer - JMP (A0) ;and call it + IMPORT _InitCursor + JMP _InitCursor @@ -70,8 +66,8 @@ SetCursor PROC EXPORT MOVE #16,-(SP) ;HEIGHT:=16 PEA DATA(A0) ;PUSH ADDR OF DATA PEA MASK(A0) ;PUSH ADDR OF MASK - MOVE.L JSetCrsr,A0 ;get lo mem vector - JSR (A0) ;call vector + IMPORT _SetCursor + JSR _SetCursor MOVE.L (SP)+,(SP) ;strip param RTS ;and return @@ -92,8 +88,8 @@ SetCCursor PROC EXPORT ; _SetCursor ; and set it the old way MOVE.L 4(SP),-(SP) ; Push handle to color cursor - MOVE.L JSetCCrsr,A0 ; get lo mem vector - JSR (A0) ; call vector (but don't call him hector) + IMPORT _SetCCursor + JSR _SetCCursor ; _ShowCursor ; balance is a virtue MOVE.L (SP)+,(SP) ; strip param RTS ; and return @@ -107,8 +103,8 @@ HideCursor PROC EXPORT ; ; ALL REGS PRESERVED. ; - MOVE.L JHideCursor,-(SP) ;get lo mem vector - RTS ;and call it + IMPORT _HideCursor + JMP _HideCursor @@ -119,36 +115,8 @@ ShowCursor PROC EXPORT ; ; ALL REGS PRESERVED. ; - MOVE.L JShowCursor,-(SP) ;get lo mem vector - RTS ;and call it - - - -ShieldCursor PROC EXPORT -;--------------------------------------------------------- -; -; PROCEDURE ShieldCursor(shieldRect: Rect; offset: Point); -; -; ALL REGS PRESERVED. -; - MOVEM.L D0-D3/A0-A1,-(SP) ;SAVE REGS - MOVE.L 32(SP),A0 ;POINT TO SHIELDRECT - MOVEM.W (A0)+,D0/D1/D2/D3 ;GET TOP ... RIGHT - LEA 28(SP),A1 - SUB (A1),D0 ;TOP - OFFSET.V - SUB (A1)+,D2 ;BOTTOM - OFFSET.V - SUB (A1),D1 ;LEFT - OFFSET.H - SUB (A1),D3 ;RIGHT - OFFSET.H - MOVE D1,-(SP) ;PUSH GLOBAL LEFT - MOVE D0,-(SP) ;PUSH GLOBAL TOP - MOVE D3,-(SP) ;PUSH GLOBAL RIGHT - MOVE D2,-(SP) ;PUSH GLOBAL BOTTOM - MOVE.L JShieldCursor,A0 ;get lo mem vector - JSR (A0) ;and call it - MOVEM.L (SP)+,D0-D3/A0-A1 ;RESTORE REGS - MOVE.L (SP)+,(SP) - MOVE.L (SP)+,(SP) ;STRIP 8 BYTES - RTS ;AND RETURN + IMPORT _ShowCursor + JMP _ShowCursor @@ -159,10 +127,8 @@ ObscureCursor PROC EXPORT ; ; Hide the cursor image until the next time the mouse moves. ; - MOVE.L JCrsrObscure,A0 ;get lo mem vector - JMP (A0) ;and call it - - + IMPORT _ObscureCursor + JMP _ObscureCursor ENDPROC diff --git a/QuickDraw/PaletteMgr.a b/QuickDraw/PaletteMgr.a index cad5eb0..f75181a 100644 --- a/QuickDraw/PaletteMgr.a +++ b/QuickDraw/PaletteMgr.a @@ -172,7 +172,7 @@ plttUpdates Equ $0002 ; value passed to SetPalette [short] AWC.PB457 ;ctReserveBit EQU 6 ;ctReserveVal EQU $4000 -PMgrVersNum EQU $0202 ; Version number (VVss: version subversion) +PMgrVersNum EQU $0203 ; Version number (VVss: version subversion) ;----------------------------------------------------------- ; Let's talk about PMgrVersNum -- ; @@ -228,6 +228,46 @@ PMgrVersNum EQU $0202 ; Version number (VVss: version subversion) ; GetNewCWindow which is patched in PatchIIROM.a +FlushPalettes PROC EXPORT ; THIEVED FROM THE MEMORY MGR +;----------------------------------------------------------------------- +; Call DisposePalette for all palettes in the app heap. +; +; Registers: D0-D2/A0-A1 +; Called by vIAZInit. +;---------------------------------------------------------------------- + IMPORT AppZoneAddr + + MOVEM.L A2-A3/D3,-(SP) ; save work registers + MOVE.L PMgrHandle,A2 ; get paletteMgr handle + CMP.L MinusOne,A2 ; is it there? + BEQ.S @DONE ; => no, just return + MOVE.L (A2),A1 ; point to data structure + MOVE.L PListHandle(A1),A0 ; get handle to palette list + _HLock ; and lock it down + MOVE.L (A0),A3 ; point to palette list + + Move APalettes(A1),D3 ; get number of active handles + Beq.s @NoPals ; no friends => go home + Add FreeSpaces(A1),D3 ; calculate total number of entries + BRA.S @FindEnd ; => check for no entries + +@FindLoop Move.L PaletteRef(A3),D1 ; get first entry + BEQ.S @FindNext ; => no palette in entry + MOVE.L D1,D0 ; and get for routine + JSR AppZoneAddr ; in application area (or zero)? + BNE.S @FindNext ; => not in app heap + MOVE.L D1,-(SP) ; push palette handle + DC.W $AA93 ; _DisposePalette ; and dispose it in place +@FindNext AddQ #PLstEntrySz,A3 ; bump to the next entry +@FindEnd DBra D3,@FindLoop ; repeat for all spaces + +@NoPals MOVE.L (A2),A1 ; point to palette stuff + MOVE.L PListHandle(A1),A0 ; get handle to palette list + _HUnlock ; and unlock it + +@DONE MOVEM.L (SP)+,A2-A3/D3 ; restore work registers + RTS + ;--------------------------------------------------- ; ; PROCEDURE ActivatePalette(dstWindow: WindowPtr); INLINE $AA94; @@ -584,14 +624,8 @@ gLoopEnd DBRA D3,gLoop ; loop for all devices ; return Z-flag Clear if the process mgr is here (BNE ProcMgrTrue) CheckForProcessMgr PROC EXPORT - MOVE.L #'os ',D0 ; type of question - _Gestalt - TST D0 ; OSErr from Gestalt? - BEQ.S @a ; No=>test result - SUBA A0,A0 ; Yes=>assume there's no procMgr -@a - MOVE.L A0,D0 - BTST #gestaltLaunchControl,D0 ; clear the Z-flag if procmgr here + MOVE.L ExpandMem,A0 + TST $128(A0) RTS ;--------------------------------------------------- @@ -624,7 +658,7 @@ linkSize DS.B 0 ; linky number movem.l a0-a2/d0-d2,-(sp) ; Those pesky c routines sub.l a0,a0 ; Pass the current process (0) - move.w #12,d0 ; _TrashProcess + moveq #12,d0 ; _TrashProcess ;_FigmentDispatch ; let everyone know this stuff is gone dc.w $A0A4 movem.l (sp)+,a0-a2/d0-d2 ; Restore em @@ -660,7 +694,7 @@ linkSize DS.B 0 ; linky number PEA inFront(A6) _SameProcess ; are we the front process? ADDQ #2,SP ; OSErr leaves inFront true from above - TST inFront(A6) + TST.B inFront(A6) BEQ.S @doNothing @front @@ -1805,8 +1839,9 @@ linkSize DS.B 0 ;linky number MOVE.L (A2),A3 ; A3->gDevice TST gdType(A3) ; a clut device? BNE.S GoHome ; No=> go home w/false - TST gdFlags(A3) ; Device active? - BPL.S GoHome ; No=> ditto + MOVE $14(A3),D0 + AND #$8010,D0 + BEQ.S GoHome ; No=> ditto SUBQ #4,SP ; space for result MOVE.L A2,-(SP) ; push gDevice handle JSR GetClut ; get the appropriate default clut @@ -2505,8 +2540,9 @@ FoundAPltt Move.L A2,srcPalette(A6) ; save it so we can unlock it AWC.PB520 BEQ.s @a ; is it a clut device? SUBQ #1,D1 ; fixed type? BNE.S UnlockPltt ; no => we're almost done -@a TST gdFlags(A0) ; is it active? - BPL.S UnlockPltt ; no => ditto +@a MOVE $14(A3),D0 + AND #$8010,D0 + BEQ.S UnlockPltt Move ciUsage(A3),D1 ; get flags MoveQ #0,D0 ; clear high word Move srcEntry(A6),D0 ; set D0 in case it is an explicit index @@ -3152,8 +3188,9 @@ SetDev Move.L (A0),A0 ; dereference it TST gdType(A0) ; is it CLUT type (zero)? dvb1 BNE GoHome ; No => do nothing - TST gdFlags(A0) ; is it active - BPL GoHome ; No=>go home + MOVE $14(A0),D0 + AND #$8010,D0 + BEQ GoHome ; No=>go home Move.L gdPMap(A0),A0 ; get handle to pixmap Move.L (A0),A0 ; dereference pixmap Move.L pmTable(A0),A0 ; get handle to CTab @@ -4542,66 +4579,7 @@ ReleaseList PROC EXPORT ; FindModeID FUNC Export - WITH SpBlock,VPBlock - -FMVars RECORD {A6Link},Decrement -result DS.B 2 ; integer result -gd DS.B 4 ; input: GDevice -depth DS.B 2 ; input: depth -return DS.B 4 ; return address -A6Link DS.B 4 ; link -spBlk DS.B spBlockSize ; slot parameter block -vpPtr DS.B 4 ; pointer to vidParams block -linkSize DS.B 0 ; size of record - ENDR - - WITH FMVars - - LINK A6,#linkSize - MOVEM.L A2/D3,-(SP) ; save 'em - - CLR result(A6) ; default to failure! - - MOVE.L gd(A6),A0 ; A0 = gDevice handle - MOVE.L (A0),A1 ; A1->gDevice - - MOVE.L UTableBase,A0 ; A0->unit table - MOVE gdRefNum(A1),D0 ; D0 = refnum - NEG D0 - SUBQ #1,D0 - MOVE.L (A0,D0.W*4),A1 ; A1 = AuxDCEHandle for gDevice - MOVE.L (A1),A1 ; A1 = AuxDCEPtr for gDevice - LEA spBlk(A6),A0 ; A0 -> spBlock - MOVE.B dCtlSlot(A1),spSlot(A0) ; stash gDevice slot - CLR.B spID(A0) ; clear the ID - MOVE #catDisplay,spCategory(A0) ; category: display - MOVE #typVideo,spCType(A0) - MOVE #drSwApple,spDrvrSW(A0) ; Appleª style driver - MOVE.B #1,spTBMask(A0) - _sNextTypeSRsrc - BNE.S @goHome ; failure - - MOVE.L spsPointer(A0),A2 ; keep saving it here - MOVE #127,D3 ; the 0th mode we'll look for - -@depthScan - ADDQ #1,D3 ; bump to next mode - MOVE.B D3,spID(A0) ; look for the next mode - MOVE.L A2,spsPointer(A0) ; sFindStruct wipes out each time - _sFindStruct ; look for it - BNE.S @goHome ; failure - MOVE.B #mVidParams,spID(A0) ; now we look for video params - _sGetBlock - BNE.S @goHome ; failure - MOVE.L spResult(A0),A1 ; A1->vidParam block, finally - MOVE vpPixelSize(A1),D0 ; D0 = depth for this description - CMP depth(A6),D0 ; the one we want? - BNE.S @depthScan ; scan 'til found, or slot error - - MOVE D3,result(A6) -@goHome MOVEM.L (SP)+,A2/D3 - UNLK A6 - RTD #result-return-4 + RTS @@ -4625,6 +4603,7 @@ A6Link DS.B 4 ; link r DS.B 4 ; regionhandle oldPort DS.B 4 ; previous port myRect DS.B 8 ; rectangle for little black corners +moreStuff DS.B 10 ; not sure what for? linkSize DS.B 0 ; size of record ENDR @@ -4634,10 +4613,31 @@ linkSize DS.B 0 ; size of record MOVEM.L A2-A3/D3-D5,-(SP) ; <6> MOVE #paramErr,result(A6) ; default to failure! + MOVE.B #1,myRect+6(A6) + MOVEQ #0,D0 + MOVE depth(A6),D0 + MOVE.L D0,r(A6) - MOVE.L gd(A6),A0 ; A0 = gDevice handle - MOVE.L (A0),A1 ; A1->gDevice + CLR -(SP) + MOVE.L gd(A6),-(SP) + CLR.L -(SP) + MOVE.L r(A6),-(SP) + PEA oldPort(A6) + CLR.L -(SP) + PEA myRect+7(A6) + MOVE #$C12,D0 ; _DMRemoveDisplay + DC.W $ABEB + + TST (SP)+ + BNE.S @goHome + + MOVE.L oldPort(A6),D0 + BTST.L #1,D0 + BNE.S @goHome + + MOVE.L gd(A6),A1 + MOVE.L (A1),A1 MOVE whichFlags(A6),D0 ; D0 = mask of flags to change ANDI #whichMask,D0 ; D0 = only the ones we let them change MOVE D0,D1 ; D1 = mask of flags to change @@ -4646,137 +4646,21 @@ linkSize DS.B 0 ; size of record AND gdFlags(A1),D0 ; D0 = all the unchanged gdFlags OR D1,D0 ; D0 = new gdFlags word MOVE D0,gdFlags(A1) ; Put back into gDevice - MOVE gdRefNum(A1),D3 ; D3 = refnum, for later use - - MOVE depth(A6),D4 ; get the depth or mode - TST.B D4 ; see which it is - BMI.S @gotMode - SUBQ #2,SP + CLR -(SP) MOVE.L gd(A6),-(SP) - MOVE D4,-(SP) - Import FindModeID - BSR FindModeID ; find the mode number, if it exists - MOVE (SP)+,D4 ; did we find one? - BEQ @goHome - -@gotMode Movea.l gd(A6),A2 ; Get GDHandle into A2. - Movea.l (A2),A2 ; Get a GDPtr into A2. - Btst #mainScreen,gdFlags(A2) ; If weÕre not on the menubar screen, - Beq.s @NotMain1 ; then just keep going. - Move.w theMenu,D5 ; Get the currently hilited menuID. - Clr.w -(Sp) ; And unhilite it. - _HiliteMenu -@NotMain1 - -; Originally, DVB wasnÕt getting the current port until corner-rounding code -; was about to be executed (below). That seemed to cause port problems, so -; I move the port getting/setting code to here (which is the way Monitors -; does it). -; -; -- jmp -- - - PEA oldPort(A6) ; Save the current port - _GetPort - MOVE.L WMgrPort,-(SP) ; We want to use the WMgrPort - _SetPort - - MOVE D3,-(SP) ; push refnum - EXT.L D4 - MOVE.L D4,-(SP) ; push new gdev mode - MOVE.L gd(A6),-(SP) ; push the handle - _InitGDevice - - Btst #mainScreen,gdFlags(A2) ; If weÕre not on the menubar screen, - Beq.s @NotMain2 ; then just keep going. - Move.w D5,-(Sp) ; Get the hilite state. - _HiliteMenu ; Restore it. - _DrawMenuBar ; Draw the MenuBar. -@NotMain2 - - CLR.L -(SP) ; Activate the front palette - _FrontWindow ; before drawing anything. - _ActivatePalette - -; In Monitors (the cdev) this is the point in the code where -; the PortList is walked to update all the CGrafPorts to the -; new depth. We donÕt need to do that here because InitGDevice -; does that for us with Save/ResoreFore and Save/RestoreBack -; calls. -; -; -- jmp -- - -; If the LayerManger is around, we need to start at the root, otherwise -; we just use FrontWindow. Originally, DVB had PaintOne instead of -; PaintBehind here but VL said that was wrong. Also, Monitors uses the -; PaintOne/PaintBehind method instead of PaintOne/PaintOne method. -; -; -- jmp -- - - If HasLayers Then - _RedrawAll ; CheckUpdate on all layers <42> - Else - SUBQ #4,SP - _NewRgn - MOVE.L (SP),r(A6) ; get a fresh region, LEAVE ON STACK - - MOVE.L gd(A6),A0 ; A0 = gd handle - MOVE.L (A0),A0 ; A0->gdevice - PEA gdRect(A0) ; push rectangle to RectRgn - _RectRgn ; r is now our region - CLR.L -(SP) - MOVE.L r(A6),-(SP) - _PaintOne + PEA r(A6) + CLR.L -(SP) + CLR.L -(SP) - SUBQ #4,SP - _FrontWindow - MOVE.L r(A6),-(SP) - _PaintBehind + MOVE #$A11,D0 ; _DMEnableDisplay + DC.W $ABEB - MOVE.L r(A6),-(SP) ; Done with region - _DisposRgn - Endif - - CLR.L myRect+topLeft(A6) ; Set the empty rect - CLR.L myRect+botRight(A6) - MOVE.L deviceList,A2 ; A2 = 1st GDHandle -@dloop MOVE.L (A2),A2 ; A2 -> GDevice - BTST #screenActive,gdFlags(A2) ; bit 15 in upper byte of word - BEQ.S @dloopEnd ; Inactive screen? - PEA gdRect(A2) - PEA myRect(A6) - MOVE.L (SP),-(SP) - _UnionRect -@dloopEnd MOVE.L gdNextGD(A2),A2 - MOVE.L A2,D0 - BNE.S @dloop + MOVE (SP)+,result(A6) - PEA myRect(A6) ; Set a nice big clip - _ClipRect - PEA myRect(A6) - MOVE.L #$FFFDFFFD,-(SP) ; outset by three - _InsetRect - MOVE.L #$00030003,-(SP) ; pensize is three - _PenSize - PEA myRect(A6) - MOVE.L #$00160016,-(SP) ; and a radius for nice rounding - _FrameRoundRect ; and black out the corners - - _PenNormal - - MOVE.L oldPort(A6),-(SP) ; restore the previous port - _SetPort - - MOVE.L gd(A6),A0 - MOVE.L (A0),A0 - BTST #mainScreen,gdFlags(A0) ; (mainScreen=11, in upper byte) - BEQ.S @notMain - _DrawMenuBar -@notMain - CLR result(A6) ; success @goHome - MOVEM.L (SP)+,A2/D3-D5 + MOVEM.L (SP)+,A2-A3/D3-D5 UNLK A6 RTD #result-return-4 @@ -4790,13 +4674,15 @@ HasDepth FUNC EXPORT whichMask EQU $FFFE ; the lowest bit is settable, else fail SDVars RECORD {A6Link},DECREMENT -result DS.B 2 ; boolean result -gd DS.B 4 ; input: GDevice to set -depth DS.B 2 ; input: depth to set to -whichFlags DS.B 2 ; which GDFlags to affect -flags DS.B 2 ; input: various flags -return DS.B 4 ; return address on stack +result DS.B 2 ; 18 $12 boolean result +gd DS.B 4 ; 14 $E input: GDevice to set +depth DS.B 2 ; 12 $C input: depth to set to +whichFlags DS.B 2 ; 10 $A which GDFlags to affect +flags DS.B 2 ; 8 $8 input: various flags +return DS.B 4 ; 4 $4 return address on stack A6Link DS.B 4 ; link +myDepth DS.B 4 +moreStuff DS.B 24 linkSize DS.B 0 ; size of record ENDR @@ -4809,13 +4695,43 @@ linkSize DS.B 0 ; size of record MOVE whichFlags(A6),D0 ; D0 = mask of flags to change AND flags(A6),D0 ; D0 = new flags to set AND #whichMask,D0 ; D0 = all the bits we can't change - BNE.S @goHome ; User tried to set bits we don't yet do! + BNE @goHome ; User tried to set bits we don't yet do! + + MOVEQ #0,D0 + MOVE depth(A6),D0 + MOVE.L D0,myDepth(A6) + + CLR moreStuff+0(A6) + CLR.L moreStuff+2(A6) + CLR moreStuff+6(A6) + CLR.L moreStuff+8(A6) + CLR.L moreStuff+12(A6) + + CLR -(SP) + MOVE.L gd(A6), -(SP) + PEA moreStuff(A6) + MOVE.L myDepth(A6), -(SP) + PEA -$C(A6) + CLR.L -(SP) + + MOVE #$AF3,D0 ; unknown _DisplayDispatch selector + DC.W $ABEB + + TST (SP)+ + BNE.B @goHome + + MOVEQ.L #$7F, D0 + MOVEQ.L #0, D1 + MOVE depth(A6), D1 + CMP.L D1, D0 + BLT.B @whaaa + + MOVE $C(A6), D0 + CMP -$C(A6), D0 + BNE.B @goHome + +@whaaa MOVE -$1C(A6), $12(A6) - SUBQ #2,SP - MOVE.L gd(A6),-(SP) - MOVE depth(A6),-(SP) - BSR FindModeID ; find the mode number, if it exists - MOVE (SP)+,result(A6) ; did we find one? @goHome UNLK A6 RTD #result-return-4 @@ -5087,6 +5003,7 @@ linkSize DS.B 0 ; size of record _HLock MOVE.L (A0),A2 ; A2->color table to check MOVE ctSize(A2),D3 ; D3 = last color in table + BEQ.S @goHome MOVEQ #0, D5 ; initialized number of colors checked ; MOVE D3,D0 ; ADDQ #1,D0 @@ -5108,6 +5025,9 @@ linkSize DS.B 0 ; size of record @next ADDQ #8,A2 ; Bump to next color DBRA D3,@loop ; loop through all colors + TST D5 + BEQ.S @goHome + DIVU D5,D7 ; compute average tolerance ; DIVU colorCount(A6),D7 ; compute average tolerance CMP maxAveTol(A6),D7 ; in range? diff --git a/QuickDraw/Patterns.a b/QuickDraw/Patterns.a index fcd6b49..7e0a641 100644 --- a/QuickDraw/Patterns.a +++ b/QuickDraw/Patterns.a @@ -2308,12 +2308,12 @@ VARSIZE EQU DstRgnPtr move.w dstPix+pixelSize(A6),d0 ; preload dst depth in case not screen sub.l a0,a0 ; clear maskrgn in case not screen move.w d2,d3 ; remember screen flag in d3 - beq.s NotScreen1 + beq NotScreen1 MOVE.L DEVICELIST,A2 ; GET FIRST ELEMENT IN DEVICE LIST MOVE.L (A2),A1 ; POINT TO DEVICE TST.L GDNEXTGD(A1) ; CHECK NEXT DEVICE - beq.s NotScreen1 ; only 1 device so skip devloop + beq NotScreen1 ; only 1 device so skip devloop ; Copy dst rect and convert to global coordinates @@ -2321,38 +2321,41 @@ VARSIZE EQU DstRgnPtr lea globalRect(a6),a1 ; point at our copy move.l (a0)+,(a1)+ ; copy topleft move.l (a0),(a1)+ ; copy botRight - move.l dstPix+bounds+top(a6),d0 ; get topleft - move.w d0,d1 ; get left - swap d0 ; get top - sub.w d1,-(a1) ; convert right to global - sub.w d0,-(a1) ; convert bottom to global - sub.w d1,-(a1) ; convert left to global - sub.w d0,-(a1) ; convert top to global - lea DstRectRgn(a6),A0 - move.l a0,DstRgnPtr(a6) ; build master pointer - move.w #10,(a0) ; set region size + lea globalRect(a6),a1 + move.l a1,d0 + move.l a1,-(sp) + jsr ([$FC0]) ; _LocalToGlobal? -NEXTGD MOVE.L (A2),A0 ; POINT TO DEVICE - TST GDFLAGS(A0) ; IS IT ACTIVE? - BPL.S SKIPGD ; =>NO, SKIP IT + add #4,d0 + move.l d0,-(sp) + jsr ([$FC0]) ; _LocalToGlobal? + + lea.l DstRectRgn(a6),a0 + move.l a0,DstRgnPtr(a6) + move #10,(a0) + +NEXTGD move.l (a2),a0 + tst $14(a0) + bpl.s SKIPGD CLR.B -(SP) ; MAKE ROOM FOR BOOLEAN RESULT PEA globalRect(A6) ; PUSH SPECIFIED RECTANGLE PEA gdRect(A0) ; PUSH DEVICE'S RECTANGLE PEA dstRectRgn+rgnBBox(A6) ; PUSH DESTINATION RECT - _SECTRECT ; IS THE RECT IN THE DEVICE + JSR ([$10A8]) ; SECTRECT -- IS THE RECT IN THE DEVICE TST.B (SP)+ ; TEST RESULT BEQ.S SKIPGD ; => NO INTERSECTION - move.l dstPix+bounds+top(a6),d0 ; get topleft - move.w d0,d1 ; get left - swap d0 ; get top - lea dstRectRgn+rgnBBox(a6),a0 ; point to rect - add.w d0,(a0)+ ; convert top to local coords - add.w d1,(a0)+ ; convert left to local coords - add.w d0,(a0)+ ; convert bottom to local coords - add.w d1,(a0) ; convert right to local coords + lea dstRectRgn+rgnBBox(A6),a0 + move.l a0,d0 + move.l a0,-(sp) + jsr ([$FC4]) ; _GlobalToLocal? + + add #4,d0 + move.l d0,-(sp) + jsr ([$FC4]) ; _GlobalToLocal? + MOVE.L (A2),A0 ; POINT TO DEVICE MOVE.L GDPMAP(A0),A0 ; GET PIXMAP MOVE.L (A0),A0 ; POINT TO PIXMAP diff --git a/QuickDraw/Pictures.a b/QuickDraw/Pictures.a index ed4e136..0008db4 100644 --- a/QuickDraw/Pictures.a +++ b/QuickDraw/Pictures.a @@ -860,77 +860,6 @@ KillPicture PROC EXPORT _DisposHandle ;discard it JMP (A1) ;and return -;-----------------------Calc GCD --------------------- -CalcGCD PROC EXPORT -; Routine returns GCD( d0, d1 ) using Euclidean method -; On Entry: D0 and D1 contain word size values to reduce -; On Exit: D0 and D1 both contain GCD -; - cmp.l d0,d1 ;while d0 != d1 (unsigned word compare) - beq.s @FoundGCD - bgt.s @D1isBigger ; if( d1 < d0 ) - exg d0,d1 ; swap( d1, d0 ) -@D1isBigger - sub d0,d1 ; d1 = d1 - d0 - bra.s CalcGCD ;end while -@FoundGCD - rts ;d0 and d1 contain GCD - ENDPROC - -ReduceD3D4 PROC EXPORT - IMPORT CalcGCD -; Routine returns ReduceD3D4( d3, d4 ) reduces d3.w and d4.w by GCD for -; both the low and high words -; -; On Entry: D3 and D4 contain two word size values to reduce -; On Exit: D3 and D4 contain reduced values -; -; -; Divide Numer and Denom for width and height by GCD to prevent overflow. -; - moveq #0,d0 ;make sure high word is zero for next 2 divides - move.l d0,d1 ;CalcGCD exchanges regs, so both need to be cleared - move.w d3,d0 ;D0 has denom.v, d1 has numer.v - beq.s @Done ;abort if zero. - move.w d4,d1 ;D0 has denom.v, d1 has numer.v - beq.s @Done ;abort if zero. - jsr CalcGCD ;returns GCD in d0 - move.w d3,d1 ;D0 has denom.v, d1 has numer.v - divu.w d0,d1 ;dividing by GCD should never leave remainder - move.w d1,d3 ;save reduced numer.v - move.w d4,d1 ;D0 has denom.v, d1 has numer.v - divu.w d0,d1 - move.w d1,d4 ;save reduced denom.v -; -; Now do width: Could have different scale factor than height did -; - swap d3 ;operate on high word - swap d4 - move.w d3,d0 ;D0 has denom.h, d1 has numer.h - beq.s @DoneSwap ;abort if zero. - move.w d4,d1 ;D0 has denom.h, d1 has numer.h - beq.s @DoneSwap ;abort if zero. - jsr CalcGCD ;returns GCD in d0 - move.w d3,d1 ;D0 has denom.h, d1 has numer.h - divu.w d0,d1 ;dividing by GCD should never leave remainder - move.w d1,d3 ;save reduced numer.h - move.w d4,d1 ;D0 has denom.h, d1 has numer.h - divu.w d0,d1 - move.w d1,d4 ;save reduced denom.h -@DoneSwap - swap d3 ;put things back - swap d4 -@Done - rts ;all done -; -; End -; - ENDPROC - -;-----------------------END GCD --------------------- - -; as seen in QDciPatchROM.a stb - DrawPicture PROC EXPORT IMPORT PicItem1,NewRgn,InitColorStuff,ReduceD3D4 ;------------------------------------------------------------------ @@ -4316,7 +4245,7 @@ MORE1 MOVE.L A3,A0 ;PTR TO FIRST byte of src move.l d5,d0 ;get rowbytes in d0 - _BlockMove ;copy from there to here + _BlockMoveData ;copy from there to here ;assumes here is a 24 bit address moveq #false32b,d0 ;switch back before calling PutPicProc @@ -4339,47 +4268,6 @@ DONE MOVE.L SAVEDSP(A6),SP ;RESTORE STACK POINTER ; -PutBigPicData PROC EXPORT ;17Jun88 BAL -;------------------------------------------------------ -; -; PROCEDURE PutBigPicData(dataPtr: QDPtr; byteCount:LONG); -; ADD many BYTES TO THEPIC. -; -; This is the same as PutPicData except the byteCount is a long -; -partSize EQU $4000 -partShift EQU $E - - MOVEM.L D7/A3-A4,-(SP) ;save a couple of registers - - MOVE.L 20(SP),A3 ;get the pointer to data - MOVE.L 16(SP),A4 ;get data length - MOVE.L A4,D7 ;copy pointer - MOVEQ #partShift,D0 ;get a constant for the upcoming shift - LSR.L D0,D7 ;find the number of 16K "pages" - BEQ.S LeftOvers ;no, so do the remaining part of the picture - -@1 - MOVE.L A3,-(SP) ;PUSH DATA POINTER - MOVE #partSize,-(SP) ;move 16K of data - JSR PutPicData ;AND CALL GET PROC - ADD.W #partSize,A3 ;move data start pointer up - SUB.W #partSize,A4 ;subtract for remainder later - SUBQ.L #1,D7 ;decrease the number of pages - BNE.S @1 ;loop for each page - -LeftOvers - MOVE.L A3,-(SP) ;PUSH DATA POINTER - MOVE.W A4,-(SP) ;move remainder - JSR PutPicData ;AND CALL GET PROC - - MOVEM.L (SP)+,D7/A2-A4 ;restore registers - RTD #8 ;and return - -; -;GetPMData now included in GetPMData.a -; - PutPMData PROC EXPORT IMPORT PutPicByte,PutPicWord,PutPicData ;------------------------------------------------------ @@ -4956,53 +4844,6 @@ MapRect PROC EXPORT BRA MAPPT ;MAP BOTRIGHT AND RETURN -MapRatio PROC EXPORT -;------------------------------------------------------------- -; -; PROCEDURE MapRatio(VAR numer, denom: Point; fromRect: Rect); -; -; Map ratio so that denom.h/.v = height/width of fromRect. -; This is so that later scaling of the numerator will have some -; range to work within. -; -; NOTE: Only necessary because fractional numer, denom not used -; -; numer.h := numer.h * fromWidth / denom.h -; denom.h := fromWidth -; numer.v := numer.v * fromHeight / denom.v -; denom.v := fromHeight - -PARAMSIZE EQU 12 ; TOTAL BYTES OF PARAMS -NUMER EQU PARAMSIZE+8-4 ; LONG, ADDR OF POINT -DENOM EQU NUMER-4 ; LONG, ADDR OF POINT -FROMRECT EQU DENOM-4 ; LONG, ADDR OF RECT - - LINK A6,#0 ; NO LOCALS - MOVEM.L D0-D1/A0-A2,-(SP) ; SAVE REGS - MOVE.L NUMER(A6),A0 ; point to numer - MOVE.L DENOM(A6),A1 ; point to denom - MOVE.L FROMRECT(A6),A2 ; point to fromRect - - MOVE.W right(A2),D0 ; get fromRect right - SUB.W left(A2),D0 ; get fromWidth - MOVE.W h(A0),D1 ; get numer.h - MULU D0,D1 ; multiply by fromWidth - DIVU h(A1),D1 ; divide by denom.h - MOVE.W D1,h(A0) ; update numer.h - MOVE.W D0,h(A1) ; update denom.h - - MOVE.W bottom(A2),D0 ; get fromRect bottom - SUB.W top(A2),D0 ; get fromHeight - MOVE.W v(A0),D1 ; get numer.v - MULU D0,D1 ; multiply by fromHeight - DIVU v(A1),D1 ; divide by denom.v - MOVE.W D1,v(A0) ; update numer.v - MOVE.W D0,v(A1) ; update denom.v - -DONE MOVEM.L (SP)+,D0-D1/A0-A2 ; RESTORE REGS - UNLINK PARAMSIZE,'MAPRATIO' - - ENDPROC diff --git a/QuickDraw/QDExtensions2.a b/QuickDraw/QDExtensions2.a new file mode 100644 index 0000000..1f0dc78 --- /dev/null +++ b/QuickDraw/QDExtensions2.a @@ -0,0 +1,44 @@ +QDEXTENSIONS2 PROC EXPORT + + + cmp #10,D0 + bhi @bad_selector + jmp @jmptbl(D0.W * 4) + + +@jmptbl + import QDEXTENSIONS2_SELECTOR_0 + jmp QDEXTENSIONS2_SELECTOR_0 + import QDEXTENSIONS2_SELECTOR_1 + jmp QDEXTENSIONS2_SELECTOR_1 + import QDEXTENSIONS2_SELECTOR_2 + jmp QDEXTENSIONS2_SELECTOR_2 + import QDEXTENSIONS2_SELECTOR_3 + jmp QDEXTENSIONS2_SELECTOR_3 + import QDEXTENSIONS2_SELECTOR_4 + jmp QDEXTENSIONS2_SELECTOR_4 + import QDEXTENSIONS2_SELECTOR_5 + jmp QDEXTENSIONS2_SELECTOR_5 + import QDEXTENSIONS2_SELECTOR_6 + jmp QDEXTENSIONS2_SELECTOR_6 + import QDEXTENSIONS2_SELECTOR_7 + jmp QDEXTENSIONS2_SELECTOR_7 + import QDEXTENSIONS2_SELECTOR_8 + jmp QDEXTENSIONS2_SELECTOR_8 + import QDEXTENSIONS2_SELECTOR_9 + jmp QDEXTENSIONS2_SELECTOR_9 + import QDEXTENSIONS2_SELECTOR_10 + jmp QDEXTENSIONS2_SELECTOR_10 + + +@bad_selector + ; The upper half of D0 contains the number of bytes of parameters + ; on the stack + + move.l (SP)+,A0 + swap D0 + ext.l D0 + add.l D0,SP + move #paramErr,D0 + move D0,QDErr + jmp (A0) diff --git a/QuickDraw/QDUtil.a b/QuickDraw/QDUtil.a index 775369f..2431604 100644 --- a/QuickDraw/QDUtil.a +++ b/QuickDraw/QDUtil.a @@ -1389,7 +1389,7 @@ GETPIXEL MOVEQ #0,D2 ;ROUTINE = GETPIXEL SHARE LINK A6,#VARSIZE ;ALLOCATE STACKFRAME - MOVEM.L D4-D5/A2-A3,-(SP) ;SAVE WORK REGISTERS + MOVEM.L D4-D6/A2-A3,-(SP) ;SAVE WORK REGISTERS MOVE.L THEGDEVICE,-(SP) ;SAVE CURRENT GRAFDEVICE MOVE.L GRAFGLOBALS(A5),A0 ;POINT TO QUICKDRAW GLOBALS MOVE.L THEPORT(A0),A0 ;GET THEPORT @@ -1420,8 +1420,15 @@ OLDRB MOVE VLOC(A6),D4 ;GET VERTICAL MOVE D4,-(SP) ;PUSH GLOBAL TOP MOVE D5,-(SP) ;PUSH GLOBAL RIGHT MOVE D4,-(SP) ;PUSH GLOBAL BOTTOM - MOVE.L JShieldCursor,A1 ;get lo mem vector - JSR (A1) ;and call it + + MOVE.L SP,A0 + CLR.L -(SP) + MOVE.L A0,-(SP) + CLR.L -(SP) + MOVE.L #$80000,D0 + DC.W $ABE0 ;_QDExtensions2 + MOVE.L (SP)+,D6 + ADDQ #8,SP MOVE.L DEVICELIST,A3 ;GET FIRST IN DEVICE LIST @@ -1518,9 +1525,11 @@ NOCOLOR cmp.w #16,pixelType(a3) ;direct device? DONE tst.b (sp)+ ;pop and check crsrFlag beq.s @noShow ;need to show cursor? - _SHOWCURSOR ;show it + move.l D6,-(SP) + move.l #$40001,D0 + dc.w $ABE0 ;_QDExtensions2 @noShow MOVE.L (SP)+,THEGDEVICE ;RESTORE CURRENT GRAFDEVICE - MOVEM.L (SP)+,D4-D5/A2-A3 ;RESTORE WORK REGISTERS + MOVEM.L (SP)+,D4-D6/A2-A3 ;RESTORE WORK REGISTERS UNLINK PARAMSIZE,'GETCPIXEL' @@ -4722,7 +4731,7 @@ DSTH EQU SRCH-4 MOVE.L (A0),A0 ; get SRC pointer MOVE.L (A1),A1 ; get DST pointer MOVE.L D1,D0 ; D0 = size - _BlockMove ; copy the data + _BlockMoveData ; copy the data DONE MOVE.L (SP)+,A0 ; get return address ADDQ #8,SP ; strip parameters diff --git a/QuickDraw/ScaleBlt.a b/QuickDraw/ScaleBlt.a index 31ea259..24376e1 100644 --- a/QuickDraw/ScaleBlt.a +++ b/QuickDraw/ScaleBlt.a @@ -127,7 +127,7 @@ multColor EQU RGNC-2 ;byte, set if source contains nonblack/white colors ; _StackAvail ;GET STACK AVAIL IN D0.L LSR.L #2,D0 ;CONVERT BYTES TO LONGS - SUB.L #qdStackXtra,D0 ;SUBTRACT SLOP FACTOR <1.2> BAL + SUB.L #$200,D0 ;SUBTRACT SLOP FACTOR <1.2> BAL MOVE.L D0,STACKFREE(A6) ;AND SAVE FREE LONGS ON STACK bpl.s @stkOK _stNoStack ;=>NOT ENOUGH STACK, QUIT diff --git a/QuickDraw/Stretch.a b/QuickDraw/Stretch.a index b9dc7ac..bae0b7a 100644 --- a/QuickDraw/Stretch.a +++ b/QuickDraw/Stretch.a @@ -9589,32 +9589,107 @@ Scale32to16 PROC EXPORT ; CLOBBERS A0-A1/D0-D5 ; + tst.b -$a5(a6) + bne.s @different_implementation + + lea @sexy_code,a4 + move.l a4,-$228(a6) + +@sexy_code move.l a2,d2 ;get ptr to end sub.l a1,d2 ;sub ptr to beginning lsr.l #2,d2 ;get long cnt in d1 subq #1,d2 ;make zero based + move.l #$7fff7fff,d3 + @NXTSLNG MOVE.L (A0)+,D0 ;GET NEXT LONG OF SRC - ror.l #8,d0 - lsr.w #3,d0 - ror.l #5,d0 - lsr.w #3,d0 - ror.l #6,d0 ;16 bit pixel in high word + lsr.l #3,d0 + lsl.b #3,d0 + lsl #3,d0 + lsr.l #6,d0 + swap d0 MOVE.L (A0)+,D1 ;GET NEXT LONG OF SRC - ror.l #8,d1 - lsr.w #3,d1 - ror.l #5,d1 - lsr.w #3,d1 - ror.l #6,d1 ;16 bit pixel in high word + lsr.l #3,d1 + lsl.b #3,d1 + lsl #3,d1 + lsr.l #6,d1 - swap d1 ;merge pixels move.w d1,d0 + and.l d3,d0 move.l d0,(a1)+ ;write out 2 pixels dbra d2,@NXTSLNG ;loop for all longs in dst scanline RTS +@different_implementation + clr.b -$2a9(a6) + lea @sexy_code_2,a4 + move.l a4,-$228(a6) + +@sexy_code_2 + move.l a2,d2 + sub.l a1,d2 + lsr.l #2,d2 + subq #1,d2 + moveq.l #3,d0 + and.b -$2a9(a6),d0 + move.l @data_tbl(d0.w*4),d3 + addq.b #1,-$2a9(a6) + +@loop + moveq.l #0,d1 + move.l (a0)+,d0 + swap d0 + add.b d3,d0 + scs.b d1 + or.b d0,d1 + lsl.l #5,d1 + swap d0 + move.b d0,d4 + lsr #8,d0 + add.b d3,d0 + scs.b d1 + or.b d0,d1 + lsl.l #5,d1 + add.b d3,d4 + scs.b d1 + or.b d4,d1 + lsr.l #3,d1 + move d1,d5 + rol.l #8,d3 + swap d5 + moveq.l #0,d1 + move.l (a0)+,d0 + swap d0 + add.b d3,d0 + scs.b d1 + or.b d0,d1 + lsl.l #5,d1 + swap d0 + move.b d0,d4 + lsr #8,d0 + add.b d3,d0 + scs.b d1 + or.b d0,d1 + lsl.l #5,d1 + add.b d3,d4 + scs.b d1 + or.b d4,d1 + lsr.l #3,d1 + move d1,d5 + move.l d5,(a1)+ + rol.l #8,d3 + dbf d2,@loop + rts + +@data_tbl + dc.l $05010400 + dc.l $03070206 + dc.l $04000501 + dc.l $02060307 + ; from QDciPatchROM.a verbatim stb diff --git a/Tools/ToolSource/Vectorize.c b/Tools/ToolSource/Vectorize.c index 22bf22b..07714b9 100644 --- a/Tools/ToolSource/Vectorize.c +++ b/Tools/ToolSource/Vectorize.c @@ -687,6 +687,7 @@ int main(int argc, char **argv) my_name = patchstack[pi]->name; original_size = longfrom(mod_sizeobj + 2); + if(original_size & 1) original_size ++; /* even-align the patches -- found this bug while reversing QuickDraw */ if(l) fprintf(l, " File \"{RomDump}\"; Line 0; File \"{RomDump}\"; Find /Entry=¶\"%.*s¶\"/ # patch ID %d, ", *my_name, my_name+1, patchstack[pi]->clean_id); if(l) debug_print_about_patch(l, patchstack[pi]->data, patchstack[pi]->len);