opt o+,ow-
;*************************************************
;** PatchWB © 1997,98 THOR                      **
;**                                             **
;** Fixes bugs in the workbench library         **
;** AddAppItem crashes if the WB is closed      **
;** IPrefs/OpenWorkBench() hang                 **
;*************************************************

        opt o+,ow-

        include inc:macros.asm
        include inc:exec_lib.asm
        include inc:intuition_lib.asm
        include inc:workbench_lib.asm
        include inc:graphics_lib.asm

        section main_code,code

;*************************************************
;** Program starts here                         **
;*************************************************
Start:
        move.l ExecBase,a6
        lea WBName(pc),a1
        move.l a6,SysBase       ;SaveBack SysBase
        moveq #39,d0            ;Only V39,V40
        jsr OpenLibrary(a6)
        move.l d0,a4
        tst.l d0
        beq .nowblib
        cmp.w #40,20(a4)        ;newer version -> forget it!
        bhi .nowblib

        lea IntName,a1
        moveq #37,d0
        jsr OpenLibrary(a6)
        move.l d0,a3
        tst.l d0
        beq.s .nointuilib

        jsr Forbid(a6)

        move.l #_NewLockIBase,d0
        lea LockIBase,a0
        move.l a3,a1
        jsr SetFunction(a6)
        move.l d0,_OldLockIBase+2

        move.l #_NewUnlockIBase,d0
        lea UnlockIBase,a0
        move.l a3,a1
        jsr SetFunction(a6)
        move.l d0,_OldUnLockIBase+2

        move.l #_NewAppMenu,d0
        lea AddAppMenuItemA,a0
        move.l a4,a1
        jsr SetFunction(a6)
        move.l d0,_OldAppMenu+2

        move.l #_NewRemMenu,d0
        lea RemoveAppMenuItem,a0
        move.l a4,a1
        jsr SetFunction(a6)
        move.l d0,_OldRemMenu+2
        
        jsr CacheClearU(a6)                     ;Execbase still in a6: Flush Cache

        lea Start(pc),a0
        move.l a3,IntuitionBase                 ;save back intuition for later use
        clr.l -4(a0)                            ;Unlink segments...

        jsr Permit(a6)

                                                ;intuition isn't closed
                                                ;it won't get away and
                                                ;can't be flushed from memory
.nointuilib:
        move.l a4,a1                            ;close workbench
        jsr CloseLibrary(a6)
.nowblib:
        moveq #0,d0                             ;fail quietly
        rts

WBName:         dc.b "workbench.library",0
IntName:        dc.b "intuition.library",0
                dc.b "$VER: PatchWB 1.00",0

        section resident_code,code

;*************************************************
;** The resident code starts here               **
;** this segment is unlinked and stays          **
;** resident                                    **
;** Remember that this is still a patch         **
;** don't try this at home!                     **
;*************************************************
_NewAppMenu:
        saveregs d0-d1/a0-a1/a6

        move.l IntuitionBase(pc),a6
        lea WBSName(pc),a0
        jsr LockPubScreen(a6)   ;WB MUST be open ! This call will do that

        loadregs
_OldAppMenu:
        jsr $aaaaaaaa           ;old address gets patched in here! Don't try this at home!

        saveregs d0/a6

        move.l IntuitionBase(pc),a6
        lea WBSName(pc),a0
        sub.l a1,a1
        jsr UnlockPubScreen(a6)

        loadregs
        rts

_NewRemMenu:
        saveregs a0/a6

        move.l IntuitionBase(pc),a6
        lea WBSName(pc),a0
        jsr LockPubScreen(a6)   ;WB MUST be open ! This call will do that

        loadregs
_OldRemMenu:
        jsr $aaaaaaaa           ;old address gets patched in here! Don't try this at home!

        saveregs d0/a6

        move.l IntuitionBase(pc),a6
        lea WBSName(pc),a0
        sub.l a1,a1
        jsr UnlockPubScreen(a6)

        loadregs
        rts


_NewLockIBase:
        saveregs d0/a4

        move.l a6,a4            ;keep intuitionbase

        move.l SysBase(pc),a6
        jsr Forbid(a6)

        do
         tst.w $b3a(a4)         ;Obtain magic intuition lock
         break.s eq
         move.l $568(a4),a6     ;get graphics lib from IBase
                                ;!!! This works ONLY for V39,V40
         jsr WaitTOF(a6)
        loop.s
        addq.w #1,$b3a(a4)

        move.l SysBase(pc),a6
        jsr Permit(a6)

        move.l a4,a6
        loadregs

_OldLockIBase:
        jmp $aaaaaaaa           ;patch in old address here... Don't try this at home...

_NewUnlockIBase:
_OldUnlockIBase:
        jsr $aaaaaaaa
        subq.w #1,$b3a(a6)      ;free magic intuition base
        rts

IntuitionBase:  dc.l 0
SysBase:        dc.l 0
WBSName:        dc.b "Workbench",0