home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Club Amiga de Montreal - CAM
/
CAM_CD_1.iso
/
files
/
563.lha
/
ChangeDefaultTool
/
CDT.s
< prev
next >
Wrap
Text File
|
1991-10-28
|
18KB
|
776 lines
opt o-,x-
Incdir "Include:"
Include "Misc/DevPacMacros.i"
Include "Exec/Exec.i"
Include "Intuition/Intuition.i"
Include "Graphics/GfxBase.i"
Include "DOS/DOS.i"
Include "DOS/DOSExtens.i"
Include "WorkBench/Startup.i"
Include "WorkBench/WorkBench.i"
******************************************************************************
* *
* © by Peter Kunath and Frank Riffel $Release 1.0 /24.10.1991/$ *
* *
******************************************************************************
* *
* *
* THIS TOOL REQUIRES KICKSTART V37.175 OR HIGHER !!! *
* *
* ChangeDefaultTool (CDT) changes the DEFAULT TOOL entry of a project *
* icon. CDT opens a AppWin so you can simply drop the icon on it and *
* the Tooltype of this icon is magicaly changed to the specified one. *
* *
* TOOLTYPES: *
* POSITION= ; default 0/0 *
* SIZE= ; default 110/100+Screenfontheight *
* DEFAULTTOOL= ; default C:MuchMore *
* *
* The tooltypes are not case sensitive. The CLI qualifier can be *
* derived from the first letter of the tooltypes (e.g. -s). *
* *
* DISCLAIMER *
* *
* This program is FREELY DISTRIBUTABLE, but COPYRIGHTED. This means *
* that you can copy it freely as long as you don't ask for any more *
* money than a nominal fee for copying. This program may be put on PD *
* disks, especially on Fred Fish's AmigaLibDisks. If you want to *
* distribute this program you MUST keep the source code with it. *
* Program, document and source code must be distributed in their *
* original UNMODIFIED form. Of course you can use an archiver like *
* LHarc to make it available on mailboxes and FTP sites. This program *
* cannot be used for commercial purposes without written permission *
* from the authors. The authors can not be made responsible for any *
* damage which is caused by using this program. *
* *
******************************************************************************
;
;
SECTION ChangeDefautToolStart,Code
;
;
Startup
move.l 4.w,a6 ; ^ExecBase
move.l ThisTask(a6),a2 ; ExecBase->ThisTask
tst.l pr_CLI(a2) ; are we running under WB?
beq.s FromWB ; yes !
;--------------------------------------------------------------------------
;
; CLI start
FromCLI
clr.b -1(a0,d0.l) ; clear linefeed
move.l a0,d7
bra.s OpenDOS
FromWB
lea pr_MsgPort(a2),a0
jsr _LVOWaitPort(a6) ; wait for StartMsg
lea pr_MsgPort(a2),a0
jsr _LVOGetMsg(a6) ; get the msg and
move.l d0,WBMsg ; store it
;-------------
OpenDOS
lea dosname(pc),a1 ; open dos.library
jsr _LVOOldOpenLibrary(a6)
move.l d0,_DOSBase
beq Exit_Err ; this should never occour!!!
lea No2.0TextS(pc),a0 ; error text
cmpi.w #37,LIB_VERSION(a6) ; check execversion
blt Write_Err ; no Kick 2.0
lea intuitionname(pc),a1 ; open intuition.libray
CALLEXEC OldOpenLibrary
move.l d0,_IntuitionBase
beq Exit_Err
lea iconname(pc),a1 ; open icon.library
CALLEXEC OldOpenLibrary
move.l d0,_IconBase
beq Exit_Err
lea wbname(pc),a1 ; open workbench.library
CALLEXEC OldOpenLibrary
move.l d0,_WorkbenchBase
beq Exit_Err
tst.l pr_CLI(a2) ; WB launch ?
beq.s HandleWB ; yes
;--------------------------------------------------------------------------
;
; CLI stuff
HandleCLI
bsr ParseCLI
tst.b d0 ; print help ?
beq.s NoHelp ; yes
CALLDOS Output ; get handle
move.l d0,d1
move.l #HelpTextS,d2
move.l #HelpTextE-HelpTextS,d3
jsr _LVOWrite(a6) ; print help text
bra Exit_Err ; return with error
NoHelp
bra StartProggy ; do the background start
;--------------------------------------------------------------------------
;
; WB stuff
HandleWB
move.l WBMsg,a0 ; ArgList
move.l sm_ArgList(a0),a2 ; ptr to Arglist
move.l sm_NumArgs(a0),d0 ; number of elements in ArgList
beq WB_End ; no ArgList
move.l wa_Lock(a2),d1 ; get Lock
beq.s WB_End ; no Lock
CALLDOS CurrentDir
move.l d0,MyLock ; remember old Lock
move.l wa_Name(a2),a0 ; get DiskObj-Name
move.l _IconBase,a6 ; get Disk-Object
jsr _LVOGetDiskObjectNew(a6)
move.l d0,MyDiskObject
beq.s WB_End ; no object
move.l d0,a0 ; make sure that you
move.l do_ToolTypes(a0),d7 ; USE 2.04 INCLUDES !!!
bsr ParseWB
move.l MyDiskObject,a0 ; free Disk-Object
move.l _IconBase,a6
jsr _LVOFreeDiskObject(a6)
WB_End
;--------------------------------------------------------------------------
;
; start the tool as process
StartProggy
move.l 4.w,a6 ; ^ExecBase
move.l ThisTask(a6),a0 ; ExecBase->ThisTask
move.l pr_CurrentDir(a0),d1 ; get Lock
CALLDOS DupLock ; copy Lock
move.l d0,a3
lea Startup-4(pc),a0 ; SegList
move.l (a0),d3 ; BPTR to 2. segment (Prog)
clr.l (a0) ; clear from Seglist
CALLEXEC Forbid
move.l #ProcessName,d1 ; Name
moveq #0,d2 ; Pri
move.l #4096,d4 ; Stack
CALLDOS CreateProc ; start new process
tst.l d0
beq.s Exit_Err ; error
move.l d0,a0
move.l a3,pr_CurrentDir-pr_MsgPort(a0) ; set Lock
CALLEXEC Permit
moveq #0,d7 ; no error
bra.s SetOldLock
;--------------------------------------------------------------------------
;
; write error message
Write_Err
move.l #ConName,d1 ; open a console
move.l #MODE_NEWFILE,d2 ; window for
CALLDOS Open ; output
move.l d0,_FileHandle
beq.s Exit_Err ; open err
move.l d0,d1
move.l #No2.0TextS,d2
moveq #No2.0TextE-No2.0TextS,d3
jsr _LVOWrite(a6) ; Write to CON:
move.l #5*50,d1 ; wait 5 secs
jsr _LVODelay(a6)
move.l _FileHandle,d1 ; close File
jsr _LVOClose(a6)
jsr CloseLibs ; close all libs
Exit_Err
moveq #20,d7 ; error
;--------------------------------------------------------------------------
;
; End
SetOldLock ; restore old Lock
move.l MyLock,d1
beq.s NoLock
CALLDOS CurrentDir
NoLock move.l WBMsg,d2 ; from wb?
beq.s Ende ; no then just exit
CALLEXEC Forbid ; we forbid so workbench can't
; UnLoadSeg() us before we are done
move.l d2,a1
jsr _LVOReplyMsg(a6) ; reply the msg
Ende move.l d7,d0 ; set error level
rts
;--------------------------------------------------------------------------
ParseCLI
move.l d7,a0
Space move.b (a0)+,d0 ; get one char
beq.s CLIEnd ; end of commandstring
cmp.b #" ",d0 ; space ?
beq.s Space ; yes, skip it!
cmp.b #"-",d0 ; switch ?
bne.s CLIHelp ; not found -> error !
move.b (a0)+,d0 ; get character
beq.s CLIHelp ; help output
bset #5,d0 ; make lowercase
lea ToolTypesTab(pc),a1 ; ToolTypesTab
CLIloop
move.l (a1)+,d1 ; ptr to ToolTypesText
beq.s CLIHelp ; help output
move.l d1,a4
cmp.b (a4),d0
beq.s CLIfound
addq.l #4,a1
bra.s CLIloop
CLIfound
move.l (a1),a1 ; get functionptr from ToolTypesTab
jsr (a1) ; excute function (a0:^CommandString)
bra.s Space ; search for next switch
CLIHelp
moveq #-1,d0 ; help flag (d0 <> 0 (!))
CLIEnd
rts
;--------------------------------------------------------------------------
ParseWB
tst.l d7 ; any ToolTypes?
beq.s FWB_End ; no
move.l d7,a4
FWB_Loop
move.l (a4)+,d2 ; get ptr to ToolType
beq.s FWB_End ; exit if no more ToolType
lea ToolTypesTab(pc),a3 ; ToolTypesTab
FWB_CompLoop
move.l d2,a0
move.l (a3)+,d0 ; prt to ToolTypesText
beq.s FWB_Loop ; next ToolType
move.l d0,a1
FWB_Comp
tst.b (a1) ; are we at the end?
beq.s FWB_CompOk ;
move.b (a0)+,d0 ; get next char
beq.s FWB_CompNext ; the ToolTypestring is done
bset #5,d0 ; make lowercase
cmp.b (a1)+,d0 ; compare
beq.s FWB_Comp
FWB_CompNext
addq.l #4,a3 ; next func in ToolTypesTab
bra.s FWB_CompLoop
FWB_CompOk
move.l (a3),a1 ; get Func from ToolTypesTab
jsr (a1) ; execute it (a0:^ToolTypesText)
bra.s FWB_Loop ; next ToolType
FWB_End
rts
;--------------------------------------------------------------------------
PositionFunc ; set WindowPos
lea MyWindow,a1
bra.s SetXY
SizeFunc ; set WindowSize
lea MyWindow+4,a1
SetXY jsr GetDez
move.w d0,(a1)+
tst.b (a0)
beq.s SetXYEnd
addq.l #1,a0
jsr GetDez
move.w d0,(a1)
SetXYEnd
rts
;--------------------------------------------------------------------------
DefaultToolFunc ; copy DefTool
lea DefaultToolStr,a1
Copyinput
moveq #' ',d0
cmpi.b #'"',(a0) ; " ?
beq.s CI_Hoch
cmpi.b #"'",(a0) ; ' ?
bne.s CI_Loop
CI_Hoch
move.b (a0)+,d0
CI_Loop
move.b (a0),(a1)+ ; copy char
beq.s CI_End
cmp.b (a0)+,d0 ; termiantion char?
bne.s CI_Loop ; no !
clr.b -(a1) ; clear the char
CI_End
rts
;--------------------------------------------------------------------------
;
; Data
;
ToolTypesTab
dc.l PositionText,PositionFunc
dc.l SizeText,SizeFunc
dc.l DefaultToolText,DefaultToolFunc
dc.l 0,0
ConName dc.b 'CON:20/20/350/50/CDT',0
ProcessName dc.b 'Defaut Tool Changer',0
intuitionname dc.b 'intuition.library',0
dosname dc.b 'dos.library',0
iconname dc.b 'icon.library',0
wbname dc.b 'workbench.library',0
HelpTextS
dc.b 10,27,"[33mChangeDefaultTool Version 1.00",27,"[31m © 11/10/91 by Peter Kunath and Frank Riffel",10,10
dc.b "Usage: CDT [-dDefault_Tool] [-pPosX/PosY] [-sSizeX/SizeY]",10,10
dc.b "This Tool opens a AppWin. If you drop a project icon into this window it",10
dc.b "changes the defaut tool to the specified one (default is <C:Muchmore>).",10,10
HelpTextE
No2.0TextS
dc.b "I need Kickstart V37 to run !!!",10
dc.b '... exiting',10,0
No2.0TextE
PositionText dc.b 'position=',0
SizeText dc.b 'size=',0
DefaultToolText dc.b 'defaulttool=',0
;-----------------------------------
;-------- Here starts the real tool
;-----------------------------------
;
;
SECTION DefTool,Code
;
;
Begin
moveq #-1,d0
CALLEXEC AllocSignal ; allocate one signalbit
lea _AppPort(pc),a1
move.b d0,MP_SIGBIT(a1)
move.l ThisTask(a6),MP_SIGTASK(a1) ; copy ^ThisTask
CALLEXEC AddPort ; MsgPort for AppWindow
bsr MainWinOpen ; open MainWindow
;--------------------------------------------------------------------------
;
; Hauptschleife
MainLoop
moveq #0,d0 ; clear Mask
lea _AppPort(pc),a0
move.b MP_SIGBIT(a0),d1
bset.l d1,d0 ; build waitmask
move.l _MyWin(pc),a0
move.l a0,d1
beq.s NoMainWin
move.l wd_UserPort(a0),a0
move.b MP_SIGBIT(a0),d1
bset.l d1,d0 ; build waitmask
NoMainWin
CALLEXEC Wait ; sleep well ;-)
Collect0
lea _AppPort(pc),a0 ; AppWindowPort
CALLEXEC GetMsg
tst.l d0 ; no more msg?
beq.s CollMainWin
move.l d0,-(sp)
move.l d0,a1
tst.w am_Version(a1) ; test Version
beq.s AppReply ; to low !
bsr AppWinSelect
AppReply
move.l (sp)+,a1
CALLEXEC ReplyMsg ; back with greetings
bra.s Collect0
CollMainWin
moveq #0,d7 ; no Class
Collect1
move.l _MyWin(pc),a0 ; MainWindowPort
move.l a0,d1
beq.s MainLoop ; no win -> loop
move.l wd_UserPort(a0),a0
CALLEXEC GetMsg
tst.l d0 ; last Msg ?
beq.s MainSelect ; yes !
move.l d0,a1 ; for ReplyMsg
move.l im_Class(a1),d7 ; Class (used later)
move.w im_Code(a1),d6 ; Code
move.l im_IAddress(a1),a2 ; Intuitionobjekt
CALLEXEC ReplyMsg ; back with greetings
bra.s Collect1
MainSelect
cmpi.l #CLOSEWINDOW,d7 ; close event ?
bne MainLoop ; no
;--------------------------------------------------------------------------
;
; Programmende
Quit
bsr MainWinQuit ; close MainWindow if open
lea _AppPort(pc),a1 ; remove port
CALLEXEC RemPort
lea _AppPort(pc),a1 ; free signal
move.b MP_SIGBIT(a1),d0
CALLEXEC FreeSignal
CALLEXEC Forbid ; attention !!!
bsr.s CloseLibs ; close all libs
move.l 4.w,a6 ; ^ExecBase
move.l ThisTask(a6),a0 ; ExecBase->ThisTask
move.l pr_CurrentDir(a0),d1 ; get lock
CALLDOS UnLock ; free lock
lea Begin-4(pc),a0 ; start segment
move.l a0,d1
lsr.l #2,d1 ; APTR->BPTR
CALLDOS UnLoadSeg ; unload us from memory
moveq #0,d1 ; no error
CALLDOS Exit ; kill 0 -9
;--------------------------------------------------------------------------
CloseLibs ; close all open libs
moveq #3,d2 ; there are 4 libs
lea _IconBase(pc),a2 ; address of first libptr
CL_Loop move.l (a2)+,d0 ; get lib ptr
beq.s CL_Skip ; is it open?
move.l d0,a1 ; yes !
CALLEXEC CloseLibrary ; then close it
CL_Skip dbra d2,CL_Loop ; next lib
rts
;--------------------------------------------------------------------------
AppWinSelect
cmpi.w #MTYPE_APPWINDOW,am_Type(a1) ; Type
bne AWS_End
tst.l am_NumArgs(a1) ; the number of elements in ArgList
beq AWS_End ; no ArgList
move.l am_ArgList(a1),a2 ; argumentpointer
move.l wa_Lock(a2),d1 ; get Lock
CALLDOS DupLock ; and duplicate it
move.l d0,d1
beq AWS_End ; no Lock
CALLDOS CurrentDir ; change Dir
move.l d0,d1
CALLDOS UnLock ; rem old Lock
move.l wa_Name(a2),d2 ; get DiskObj-Namen
beq.s AWS_End ; no name !
move.l d2,a0 ; name
move.l _IconBase,a6 ; get Disk-Object
jsr _LVOGetDiskObjectNew(a6) ; for compatibility with
move.l d0,MyDiskObject ; default icons!
beq.s AWS_End ; no object
move.l MyDiskObject,a0
cmpi.b #WBPROJECT,do_Type(a0) ; PROJECT TYPE ?
bne.s AWS_Free ; no!
move.l MyDiskObject,a0
move.l do_DefaultTool(a0),_DefaultTool ; save old ^DefaultTool
move.l #DefaultToolStr,do_DefaultTool(a0) ; use new string
move.l d2,a0 ; name
move.l MyDiskObject,a1
move.l _IconBase,a6 ; write Disk-Object
jsr _LVOPutDiskObject(a6)
move.l MyDiskObject,a0
move.l _DefaultTool,do_DefaultTool(a0) ; restore old ^DefaultTool
AWS_Free
move.l MyDiskObject,a0 ; and finaly free it
move.l _IconBase,a6
jsr _LVOFreeDiskObject(a6)
AWS_End
rts
;--------------------------------------------------------------------------
;
; open MainWindow
MainWinOpen
tst.l _MyWin ; is the window open?
bne.s AWS_End ; yes !
CALLEXEC Forbid
bsr GetBarHeight ; get fontheigth
add.w d0,WHeight ; correct windowsize
add.w d0,ZHeight ; correct zoomsize
CALLEXEC Permit
lea MyWindow,a0 ; Window
CALLINT OpenWindow
move.l d0,d2
bne.s MainWinOpend
lea MyWindow,a0 ; Window
clr.w nw_LeftEdge(a0) ; try 0/0 for the windoworgin
clr.w nw_TopEdge(a0)
CALLINT OpenWindow
move.l d0,d2
MainWinOpend
move.l d2,_MyWin ; no win -> exit
beq.s MainWinOpenEnd
move.l d0,a0 ; Show the Tool
lea -1.w,a1
lea ScreenTitle(pc),a2
CALLINT SetWindowTitles
moveq #0,d0 ; id
moveq #0,d1 ; userdata
move.l d2,a0 ; windowptr
lea _AppPort(pc),a1 ; msgport
sub.l a2,a2 ; taglist (always NULL)
CALLWB AddAppWindowA ; Window -> AppWindow
move.l d0,_MyAppWin
MainWinOpenEnd
rts
;--------------------------------------------------------------------------
;
; MainWindow schließen
MainWinQuit
move.l _MyAppWin,d0 ; AppWindow -> Window
beq.s MainWinNoApp
move.l d0,a0
CALLWB RemoveAppWindow
MainWinNoApp
move.l _MyWin(pc),d0 ; close Window
beq.s MainWinQuitEnd
move.l d0,a0
CALLINT CloseWindow
MainWinQuitEnd
rts
;--------------------------------------------------------------------------
;
; (output: d0:Barheight)
GetBarHeight
moveq #10,d0 ; default BarHeight
move.l _IntuitionBase,a1 ; search WBenchScreen
move.l ib_FirstScreen(a1),d1
FindWBScr
beq.s GetBarHeightEnd ; not found !
move.l d1,a1
move.w sc_Flags(a1),d1
andi.w #SCREENTYPE,d1
cmpi.w #WBENCHSCREEN,d1
beq.s GetFontHeight ; found !
move.l sc_NextScreen(a1),d1
bra.s FindWBScr
GetFontHeight
move.b sc_BarHeight(a1),d0 ; Bar size for this Screen
GetBarHeightEnd
rts
;--------------------------------------------------------------------------
;
; convert string to hexword
; (a0:^Eingabestring/d0.w:Zahl/d1.l=-1 => Fehler)
GetDez
move.b (a0),-(sp) ; first char
moveq #0,d0
moveq #-1,d1
cmpi.b #"+",(a0)+ ; plus ?
beq.s GetDLoop ; yes !
subq.l #1,a0
cmpi.b #"-",(a0)+ ; minus ?
beq.s GetDLoop ; yes !
subq.l #1,a0
GetDLoop
cmpi.b #"0",(a0) ;
blt.s GetDEnd ; out of range !
cmpi.b #"9",(a0) ;
bgt.s GetDEnd ; out of range !
cmpi.w #3276,d0 ; old value to big ?
bgt.s GetDErr ; yes !
mulu #10,d0 ; old value * 10
moveq #0,d1
move.b (a0)+,d1 ; get next char
sub.b #"0",d1
add.w d1,d0 ; old value + digit => new value
bpl.s GetDLoop ; do it again
GetDErr
moveq #-1,d1 ; error flag
GetDEnd
cmpi.b #"-",(sp)+ ; is it negative ?
bne.s GetDEnde ; no !
neg.w d0
GetDEnde
rts
;--------------------------------------------------------------------------
;
; Datas
;
;--------------------------------------------------------------------------
;
; Pointer
_IconBase dc.l 0
_WorkbenchBase dc.l 0
_IntuitionBase dc.l 0
_DOSBase dc.l 0
_MyWin dc.l 0
_MyAppWin dc.l 0
_FileHandle dc.l 0
_DefaultTool dc.l 0
;--------------------------------------------------------------------------
;
; Daten
MyLock dc.l 0
WBMsg dc.l 0
MyDiskObject dc.l 0
;--------------------------------------------------------------------------
;
; Window
MyWindow
dc.w 0,0 ; LeftEdge, TopEdge
WWidth dc.w 110 ; Breite
WHeight dc.w 100 ; +BHeight
dc.b 0,1
dc.l CLOSEWINDOW
dc.l WFLG_CLOSEGADGET+WFLG_DRAGBAR+WFLG_DEPTHGADGET+WFLG_ACTIVATE+WFLG_RMBTRAP+WFLG_NW_EXTENDED
dc.l 0
dc.l 0
dc.l AppWinName
dc.l 0
dc.l 0
dc.w 80,80
dc.w -1,-1
dc.w WBENCHSCREEN
dc.l MyTags ; ^TagItemArray
MyTags
dc.l WA_Zoom ; zoomgadget
dc.l Zoomed ; ti_Data
dc.l TAG_DONE ; end of TagItemArray
dc.l 0 ; not used
Zoomed dc.w 0,0 ; left/top in zoomed mode
ZWidth dc.w 110 ; width in zoomed mode
ZHeight dc.w 0 ; height in zoomed mode
;--------------------------------------------------------------------------
;
; AppWindowPort
_AppPort
dc.l 0 ; LN_SUCC
dc.l 0 ; LN_PRED
dc.b NT_MSGPORT ; LN_TYPE
dc.b 0 ; LN_PRI
dc.l AppPortName ; LN_NAME
dc.b PA_SIGNAL ; MP_FLAGS
dc.b 0 ; MP_SIGBIT
dc.l 0 ; MP_SIGTASK
dc.l 0 ; LH_HEAD
dc.l 0 ; LH_TAIL
dc.l 0 ; LH_TAILPRED
dc.b NT_MSGPORT ; LH_TYPE
dc.b 0 ; LH_pad
;--------------------------------------------------------------------------
;
; Strings
AppPortName dc.b 'CDT_AppWindow',0
AppWinName dc.b 'CDT',0
ScreenTitle dc.b 'DefautTool='
DefaultToolStr dc.b 'C:MuchMore',0
dcb.b 256,0