home *** CD-ROM | disk | FTP | other *** search
- *****
- *
- * $VER : WClose 1.00, Pierre-Louis MANGEARD, Feb. 1993
- *
- *****
-
- OPT l-,c+,d-,w+,o1+,o2+,o3+,o4+,o5+,o6+,o7+,o10+,o11+,o12+
-
- INCLUDE CxPak_Include
-
- SECTION NTRYHUNK,CODE
-
- clr.l d4
- lea _BSSBase,a4
- lea _DataBase,a5
-
- suba.l a1,a1
- EXEC FindTask find us
- movea.l d0,a2
- move.l d0,cxp_Task(a4)
- lea pr_MsgPort(a2),a0
- move.l a0,cxp_Port(a5)
-
- tst.l pr_CLI(a2)
- bne.s end_startup and run the user prog
-
- fromWorkbench
-
- ; move.l cxp_Port(a5),a0 port deja en ao
- CALL WaitPort wait for a message
- move.l cxp_Port(a5),a0
- CALL GetMsg then get it
- move.l d0,RetMsg_ save it for later reply
-
- end_startup
-
- bsr.s _main call our program
-
- tst.l RetMsg_
- beq.s exitToDOS if I was a CLI
-
- EXEC Forbid
- movea.l RetMsg_,a1
- CALL ReplyMsg
-
- exitToDOS
-
- rts
-
- _main
-
- *****
- * debut effectif du programme.
- *****
-
- lea cxname(a5),a1
- CALL OldOpenLibrary
- move.l d0,_CxBase(a4)
- beq cxp55
-
- lea intname(a5),a1
- CALL OldOpenLibrary
- move.l d0,_IntuitionBase(a4)
- beq cxp55
-
- lea layername(a5),a1
- CALL OldOpenLibrary
- move.l d0,_LayerBase(a4)
- beq cxp55
-
- lea iconname(a5),a1
- CALL OldOpenLibrary
- move.l d0,_IconBase(a4)
- beq cxp55
-
- lea dosname(a5),a1
- CALL OldOpenLibrary
- move.l d0,_DOSBase(a4)
- beq cxp55
-
-
- tst.l RetMsg_
- beq cxp020
-
- * si on vient du workbench, recuperer ToolTypeArray :
-
- movea.l RetMsg_,a2
- movea.l sm_ArgList(a2),a2 ArgList sauvegarde provisoire en a2
- beq cxp020
- move.l wa_Lock(a2),d1
- DOS CurrentDir
-
- movea.l wa_Name(a2),a0 name en a0
- ICON GetDiskObject
- move.l d0,cxp_DiskObj(a4)
- beq cxp020
- movea.l d0,a2
- movea.l do_ToolTypes(a2),a2
-
-
- * recupere PRIORITY en tooltype :
-
- movea.l a2,a0
- lea cxp_ToolType(a5),a1
- CALL FindToolType
- tst.l d0
- beq.s cxp05
-
- movea.l d0,a0
- clr.w d2
-
- * conversion ascii -> entier du tooltype CX_PRIORITY :
-
- cmpi.b #'-',(a0)
- bne.s cxp06
-
- moveq #1,d2
- addq.l #BYTE,a0
-
- cxp06 moveq #0,d0
-
- cxp07 moveq #0,d1
- move.b (a0)+,d1
- beq.s cxp09
- subi.b #'0',d1
- add.l d0,d0
- add.l d0,d1
- lsl.l #2,d0
- add.l d1,d0
- bra.s cxp07
-
- cxp09 tst.w d2
- beq.s cxp08
-
- neg.b d0
-
- cxp08 move.b d0,cxp_Pri(a5)
-
-
- * recupere MOUSEBUTTON en tooltype :
-
- cxp05 clr.w d2
-
- movea.l a2,a0
- lea cxp_ToolType2(a5),a1
- ICON FindToolType
- tst.l d0
- beq.s cxp01
-
- movea.l d0,a0
- lea IX_dumm(a4),a1
- CX ParseIX
-
- move.w IX_dumm+ix_Qualifier(a4),d2
- bne.s cxp02
-
- * si on n'a pas de MOUSEBUTTON valide, on met le MOUSEBUTTON par defaut :
-
- cxp01 move.w #IEQUALIFIER_RBUTTON,d2
-
-
- * recupere QUALIFIER en tooltype :
-
- cxp02 movea.l a2,a0
- lea cxp_ToolType1(a5),a1
- ICON FindToolType
- tst.l d0
- beq.s cxp04
- movea.l d0,a0
- lea IX_dumm(a4),a1
- CX ParseIX
-
- tst.w IX_dumm+ix_Qualifier(a4)
- beq.s cxp04
- or.w IX_dumm+ix_Qualifier(a4),d2
-
- bra.s cxp010
-
- * si on n'a pas de QUALIFIER valide, on 'or' avec le QUALIFIER par defaut :
-
- cxp04 or.w #IEQUALIFIER_LCOMMAND,d2
-
- * et on sauve le qualifier :
-
- cxp010 move.w d2,cxp_Qual(a5)
-
- movea.l cxp_DiskObj(a4),a0
- ICON FreeDiskObject
-
-
- * definition du signal :
-
- cxp020 clr.l d0
- movea.l cxp_Port(a5),a1
- move.b MP_SIGBIT(a1),d0
- moveq #1,SigFlg_
- lsl.l d0,SigFlg_
- ori.l #SIGBREAKF_CTRL_C,SigFlg_
-
- * installation du broker :
-
- lea cxp_NewBroker(a5),a0
- moveq #0,d0
- CX CxBroker
- move.l d0,Broker_
- beq cxp55 si WClose deja la
-
- * installation du filter :
-
- moveq #CX_FILTER,d0
- lea cxp_HotKey(a5),a0
- suba.l a1,a1
- CALL CreateCxObj
- move.l d0,d2
- beq cxp55
- movea.l Broker_,a0
- movea.l d0,a1
- CALL AttachCxObj
-
- movea.l d2,a0
- lea IX(a5),a1
- CALL SetFilterIX
-
- * installation du sender :
-
- moveq #CX_SEND,d0
- movea.l cxp_Port(a5),a0
- movea.w #CX_MAGIC,a1
- CALL CreateCxObj
- tst.l d0
- beq cxp55
- movea.l d2,a0
- movea.l d0,a1
- CALL AttachCxObj
-
- * installation du custom :
-
- moveq #CX_CUSTOM,d0
- lea cxp_Action(pc),a0
- suba.l a1,a1
- CALL CreateCxObj
- tst.l d0
- beq cxp55
- movea.l d2,a0
- movea.l d0,a1
- CALL AttachCxObj
-
-
- * activation du broker :
-
- moveq #TRUE,d0
- bsr SwitchBroker
-
-
- * recuperation du message :
-
- cxp1 move.l SigFlg_,d0
- EXEC Wait
-
- cmpi.l #SIGBREAKF_CTRL_C,d0
- bne.s cxp3
-
- moveq #CXCMD_KILL,MsgId_
-
- cxp3 movea.l cxp_Port(a5),a0
- CALL GetMsg
- tst.l d0
- beq cxp40
- movea.l d0,a2
-
- * type et id du message :
-
- movea.l a2,a0
- CX CxMsgType
- move.w d0,MsgType_
-
- movea.l a2,a0
- CALL CxMsgID
- move.w d0,MsgId_
-
- movea.l a2,a1
- EXEC ReplyMsg
-
- * action selon le type :
-
- cmpi.w #CXM_COMMAND,MsgType_
- beq cxp40
-
-
- * localisation de la fenetre :
-
- * screen en a2
-
- moveq #0,d0
- INT LockIBase
- move.l d0,-(sp)
-
- movea.l _IntuitionBase(a4),a0
- movea.l ib_FirstScreen(a0),a2
- cxp5 move.w ib_MouseY(a0),d0 coord Y de la souris
- cmp.w sc_TopEdge(a2),d0 - haut de l'ecran
- bge.s cxp10
- movea.l sc_NextScreen(a2),a2
- cmpa.w #0,a2
- bne.s cxp5
-
- cxp10 movea.l (sp)+,a0
- CALL UnlockIBase
-
- movea.l a2,a0
- adda.w #sc_LayerInfo,a0
- move.l a0,-(sp)
- LAYER LockLayerInfo
-
- movea.l (sp),a0
- move.w sc_MouseX(a2),d0
- move.w sc_MouseY(a2),d1
- CALL WhichLayer
- move.l d0,d2 sauvegarde provisoire
-
- movea.l (sp),a0
- CALL UnlockLayerInfo
-
- movea.l (sp)+,a1 layerinfo en a1
- move.l d2,d0 restaure d0
- beq cxp1 si pas de layer, rien
-
- movea.l d0,a0 layer en a0
- movea.l lr_Window(a0),a0 window en a0
- cmpa.w #NULL,a0
- beq cxp1
- move.l wd_IDCMPFlags(a0),d0
- andi.l #IDCMP_CLOSEWINDOW,d0
- beq cxp1
-
- move.l a0,_IDCMPWindow(a5)
- movea.l wd_UserPort(a0),a0
- lea cxp_Msg(a5),a1
- EXEC PutMsg
-
- bra cxp1
-
-
- * on a recu un msg COMMAND :
-
- cxp40 cmpi.w #CXCMD_KILL,MsgId_ kill WClose
- beq.s cxp60
-
- cmpi.w #CXCMD_UNIQUE,MsgId_ toggle WClose
- beq.s cxp60
-
- cmpi.w #CXCMD_DISABLE,MsgId_ dormant WClose
- bne.s cxp43
-
- moveq #FALSE,d0
- bsr.s SwitchBroker
-
- bra cxp1
-
- cxp43 cmpi.w #CXCMD_ENABLE,MsgId_ wake up WClose
- bne cxp1
-
- moveq #TRUE,d0
- bsr.s SwitchBroker
-
- bra cxp1
-
-
- cxp55 moveq #RETURN_ERROR,d2
-
- bra.s cxp62
-
- * Exit :
-
- cxp60 moveq #RETURN_OK,d2
-
- cxp62 tst.l Broker_
- beq.s cxp70
-
- cxp65 movea.l Broker_,a0
- CX DeleteCxObjAll
-
- cxp70 movea.l _DOSBase(a4),a1
- EXEC CloseLibrary
-
- cxp94 movea.l _IconBase(a4),a1
- CALL CloseLibrary
-
- cxp93 movea.l _LayerBase(a4),a1
- CALL CloseLibrary
-
- cxp92 movea.l _IntuitionBase(a4),a1
- CALL CloseLibrary
-
- cxp91 movea.l _CxBase(a4),a1
- CALL CloseLibrary
-
- * restore la priorite du shell d'origine le cas echeant :
-
- cxp90 move.l d2,d0
-
- rts
-
-
- *****
- * subroutines.
- *****
-
- SwitchBroker:
-
- * void SwitchBroker(BOOL)
- * d0 = TRUE or FALSE
-
- movea.l Broker_,a0
- CX ActivateCxObj
-
- rts
-
-
- cxp_Action:
-
- movea.l _BSSBase+_CxBase,a6
- jsr _LVODisposeCxMsg(a6)
-
- rts
-
-
- *****
- * version.
- *****
-
- dc.b '$VER: WClose 1.00 (02.93)'
-
- cnop 0,2
-
-
- *****
- * constantes du programme.
- *****
-
- SECTION Constantes,DATA
-
- _DataBase:
-
- LAB cxp_NewBroker:
- dc.b NB_VERSION,0
- dc.l _DataBase+cxp_BkName
- dc.l _DataBase+cxp_BkTitle
- dc.l _DataBase+cxp_BkDescr
- dc.w NBU_UNIQUE+NBU_NOTIFY
- dc.w 0
- DAT cxp_Pri
- dc.b 0
- dc.b 0
- DAT cxp_Port
- dc.l 0
- dc.w 0
-
-
- LAB IX
- dc.b IX_VERSION
- dc.b IECLASS_RAWMOUSE
- dc.w 0
- dc.w IECODE_UP_PREFIX
- DAT cxp_Qual
- dc.w IEQUALIFIER_RBUTTON+IEQUALIFIER_LCOMMAND
- DAT cxp_QualMask
- dc.w CXP_QUALMASK
- dc.w 0
-
-
- LAB cxp_Msg
- dc.l 0,0 is_Node.ln_Succ, is_Node.ln_Pred
- dc.b NT_MESSAGE,0 is_Node.ln_Type, is_Node.ln_Pri
- dc.l 0 is_Node.ln_Name
-
- dc.l 0 replyport
- dc.w $20 length
-
- dc.l IDCMP_CLOSEWINDOW
- dc.w 0
- dc.w 0
- dc.l 0
- dc.w 0
- dc.w 0
- dc.l 0
- dc.l 0
- DAT _IDCMPWindow
- dc.l 0
- dc.l 0
-
-
- CHAR cxname
- CXNAME
- CHAR dosname
- DOSNAME
- CHAR intname
- INTNAME
- CHAR iconname
- ICONNAME
- CHAR layername
- dc.b 'layers.library',0
- CHAR cxp_HotKey
- CHAR cxp_BkName
- dc.b 'WClose',0
- CHAR cxp_BkTitle
- dc.b 'Close window if possible',0
- CHAR cxp_BkDescr
- dc.b 'Key+Mousebutton=close window',0
- CHAR cxp_ToolType
- dc.b 'CX_PRIORITY',0
- CHAR cxp_ToolType1
- dc.b 'QUALIFIER',0
- CHAR cxp_ToolType2
- dc.b 'MOUSEBUTTON',0
-
-
- *****
- * variables du programme.
- *****
-
- SECTION Variables,BSS
-
- rsreset
-
- _CxBase rs.l 1
- _IntuitionBase rs.l 1
- _LayerBase rs.l 1
- _IconBase rs.l 1
- _DOSBase rs.l 1
- cxp_Task rs.l 1
- cxp_DiskObj rs.l 1
- IX_dumm rs.b ix_SIZEOF
- Data_SizeOf rs.l 0
-
- _BSSBase: ds.l Data_SizeOf
-
- END
-
-