home *** CD-ROM | disk | FTP | other *** search
Text File | 1992-04-16 | 58.7 KB | 1,463 lines |
- OPT l-,c+,d-,a+,o+
-
- incdir "2:20_include/" ;where to look
-
- include intuition/intuition.i
- ; include exec/exec_lib.i
- include libraries/dos_lib.i ;and DOS
- include libraries/dos.i
-
-
- ;****************************************************************************
- ;* *
- ;* NonClick V1.06 by Kjell Cederfeldt 91-May-25 *
- ;* *
- ;* Copyright (C) by Kjell Cederfeldt 1991. All rights reserved. *
- ;* *
- ;* Change NoClick flag in trackdisk.device. Note Rel 37 or later *
- ;* *
- ;* Written in DevPac assembler on an A3000. *
- ;* *
- ;* Kjell Cederfeldt Phone +46 (0)31 - 306334 home *
- ;* Hammarkulletorget 39 +46 (0)31 - 139316 office *
- ;* S-442 37 ANGERED SWEDEN +46 (0)31 - 306310 support BBS *
- ;* *
- ;* UseNet ...{uunet|pyramid|rutgers}!cbmvax!cbmehq!cbmswe!datac!kjell *
- ;* *
- ;****************************************************************************
-
- ; Preset and definitions
- ; ----------------------
-
- ExecBase = 4
- OpenLibrary = -552 ; exec offset OpenLibrary(libName,version)(A1,D0)
- CloseLibrary = -414 ; exec offset CloseLibrary(library)(a1)
- FindTask = -294 ; exec offset FindTask(name)(a1)
- AddPort = -354 ; exec offset AddPort(port)(a1)
- RemPort = -360 ; exec offset RemPort(port)(a1)
- WaitPort = -384 ; exec offset WaitPort(port)(a0)
- GetMsg = -372 ; exec offset GetMsg(port)(a0)
- FindPort = -390 ; exec offset FindPort(name)(a1)
- PutMsg = -366 ; exec offset PutMsg(port,message)(a0/a1)
- ReplyMsg = -378 ; exec offset ReplyMsg(message)(a1)
- Forbid = -132 ; exec offset Forbid()
- AllocMem = -198 ; exec offset AllocMem(byteSize,requirements)(d0,d1)
- FreeMem = -210 ; exec offset FreeMem(memoryBlock,byteSize)(a1,d0)
- SetSignal = -306 ; exec offset SetSignal(newSignals,signalSet)(d0/d1)
- AllocSignal = -330 ; exec offset AllocSignal(signalNum)(d0)
- FreeSignal = -336 ; exec offset FreeSignal(signalNum)(d0)
- OpenDevice = -444 ; exec offset OpenDevice(devname,unit,iorequest,flags)(a0,d0/a1,a1)
- CloseDevice = -450 ; exec offset CloseDevice(IoRequest)(a1)
- DoIO = -456
-
- Write = -48 ; dos offset Write(fileHandler,buffer,length)(d1/d2/d3)
- OutPut = -60 ; dos offset OutPut()
-
- DrawBorder = -108 ; intuition DrawBorder(Rastport,Border,Leftoffset,Toppoffset)(a0,a1/d0,d1)
- DrawImage = -114 ; intuition DrawImage(Rastport,Image,Leftoffset,Toppoffset)(a0,a1/d0,d1)
- PrintIText = -216 ; intuition PrintIText(Rastport,Itext,Leftoffset,Toppoffset)(a0,a1/d0,d1)
- OpenWindow = -204 ; intuition OpenWindow(owargs)(a0)
- _CloseWindow = -72 ; intuition CloseWindow(window)(a0)
- AutoRequest = -348 ; intuition AutoRequest(Window,Body,PTest,NText,PFlag,NFlag,W,H)
- RefreshGadgets = -222 ; intuition RefreshGadgets(Gadget,Window,Requester)(a0/a1/a2)
- RefreshGList = -432 ; intuition RefreshGList(Gadget,Window,Requester,NumGad)(a0/a1/a2,d0)
- OpenWindowTagList = -606 ; intuition (37) OpenWindowTagList(NewWindow,TagItems)(A0,A1)
- AddGadget = -42 AddGadget(Window,Gadget,Position)(A0,A1,D0)
-
- RectFill = -306 ; graphics RectFill(RasterPort,xmin,ymin,xmax,ymax)(a1,d0,d1,d2,d3)
- SetAPen = -342 ; graphics SetAPen(RasterPort,Pen)(a1,d0)
- SetBPen = -348 ; graphics SetAPen(RasterPort,Pen)(a1,d0)
-
- AddAppMenuItemA = -72 ; workbench (37) AddAppMenuItemA(id,userdata,text,msgport,taglist)(d0/d1,a0/a1/a2)
- RemoveAppMenuItem = -78 ; workbench (37) RemovAppMenuItem(appmenuitem)(a0)
-
- OpenDiskFont = -30
-
-
-
- ;NT_MSGPORT = 4 ;override by includes
- ;PA_SIGNAL = 0 ;override by includes
- ;NT_MESSAGE = 5 ;override by includes
- MEMF_TYPE = $10001
- MEMF_PUBLIC = $0000001
- MTYPE_CHIP = $0000002 ; Memory type bits
- MEMF_CLEAR = $0010000
- MEMF_ANY_CLEAR = $10000
-
-
- ;******************************************************************************
- ;*
- ;* Initiseringar !!!!
- ;*
-
-
- move.l sp,Initial_SP ;Spara stackpekaren
- move.l a0,ArgList ;CLI=true spara adress till agument
- subq.l #1,d0 ;Minska längden med 1
- add.l d0,a0 ;Addera längden till adressen
- move.b #0,(a0) ;Nolla sista byten (CLI=0A)
-
-
- ;* CLI eller WB start ?
-
-
- move.l (ExecBase).w,a6 ;Execbase
- sub.l a1,a1 ;Hitta detta task
- jsr FindTask(a6)
- move.l d0,a4 ;spara strukturen i a4
- tst.l $ac(a4) ;CLI eller WB ?
- bne.s NoCopy
-
- lea $5c(a4),a0 ;WBench message
- jsr WaitPort(a6) :vänta på meddelandet
- jsr GetMsg(a6) ;hämta message
- move.l d0,Message ;spara pekare till WBMessage
- beq Cleanup ;error?
-
-
- ; Already in use? We will not run another copy of this program.
-
- move.l (ExecBase).w,a6 ;Execbase
- lea PortName(pc),a1 ;leta efter egen port!
- jsr FindPort(a6) ;har vi redan en port?
- tst.l d0
- beq.s NoCopy ;Nej kör vidare!
- move.l d0,a0
-
- lea GgText3(pc),a1
- jsr PutMsg(a6) ;sänd meddelande till porten
- bra Cleanup ;och avsluta! (Väck första prog.)
- NoCopy:
- moveq #0,d0
- move.l (ExecBase).w,a6
- lea IntName(pc),a1
- jsr OpenLibrary(a6) ;öppna intuition
- move.l d0,IntBase
- beq Cleanup ;fel? Avsluta
-
- moveq #37,d0
- lea GrafName(pc),a1
- jsr OpenLibrary(a6) ;öppna graphiclibrary
- move.l d0,GrafBase
- beq ReqError ;fel? Avsluta
-
- tst.l Message ;koll om StartWB el CLI?
- beq.s CLIStart ;hopp till CLIStart om CLI
-
- moveq #37,d0
- lea WBName(pc),a1 hämta namn 'workbench.library'
- jsr OpenLibrary(a6) öppna library
- move.l d0,WBBase spara hanterare.
- beq ReqError ;fel? Avsluta
-
- bra.s Create ;hopp till Cleanup2 om CLI
-
-
- ;*****************************
-
-
- CLIStart:
- moveq #0,d0
- lea Dosname(pc),a1 ;Ladda adressen för DosName i a1
- moveq #0,d0 ;Tillåt alla dosversioner
- jsr OpenLibrary(a6) ;öppna doslibrary
- move.l d0,Dosbase ;Spara Dosbase
- beq Cleanup ;Hoppa till Cleanup om fel!
-
- ; hitta CLI dit jag kan sända text.
-
- bsr PointTOCLI ;Peka till CLI
- bsr ScreenMSG ;Skriv text till Skärmen
-
- ; Hämta argument från CLI
-
- InNameArg:
- bsr GetInArg ;Hämta argumenten från CLI
-
-
- Create:
-
- ; Create Port
-
- bsr CreatePort
- tst.l d0
- beq Cleanup ;fel? Avsluta
-
-
- ; Create ExtIO
-
- moveq #56,d0
- move.l MyPort(pc),a0
- bsr CreateExtIO
- move.l d0,MyIORequest
- beq Cleanup ;fel? Avsluta
-
- ; Vilkar drivar har vi i systemet ?
-
- bsr CheckConfig
-
- tst.l Message ;koll om StartWB el CLI?
- bne.s WBINIT
-
- tst.b Inter ;koll om interface open window!
- bne.s WBINIT
-
- bsr SetUnit
- bra Cleanup
-
-
- WBINIT: bsr WinOpen ;öppna fönster
- bsr BorderDraw
- bsr RectDraw
- bsr PrintText
- bsr ImageDraw
-
- Loop:
- move.l (ExecBase).w,a6 ;basadress till EXEC i a6
- move.l NewMessage(pc),d0
- beq.s NoReply
- move.l d0,a1
- jsr ReplyMsg(a6)
- move.l #0,NewMessage
-
- NoReply: move.l WinHandle(pc),a0 ;pekare till datastruktur i a0
- move.l 86(a0),a0 ;userport-pekare i a0
- jsr WaitPort(a6)
- move.l WinHandle(pc),a0 ;pekare till datastruktur i a0
- move.l 86(a0),a0 ;userport-pekare i a0
- jsr GetMsg(a6) ;hämta meddelande
- move.l d0,NewMessage
- beq.s Loop ;ingen händelse
-
- move.l d0,a0 ;message-pekare i a0
- move.l $14(a0),d6 ;spara händelsen i d6
- cmp.l #GADGETDOWN,d6 ;gadget nedtryckt?
- beq.s Ev1 ;ja: kolla vilken
- cmp.l #GADGETUP,d6 ;Gadget släppt?
- beq.s Ev2 ;ja: kolla vilken
- bra.s Loop
-
- Ev1: bsr DownGadgets
- bra.s Loop
- Ev2: bsr UpGadgets
-
-
- bsr ByeWindow
- tst.b Inter ;koll om interface lägg ej till menyn
- bne.s Cleanup
-
- bsr AddAppMenuIA Lägg till ny menuitem (under tool)
-
- move.l (ExecBase).w,a6 Execbase
- move.l MyPort(pc),a0
- jsr WaitPort(a6)
-
- move.l MyPort(pc),a0
- jsr GetMsg(a6) ;hämta meddelande
- move.l d0,a1
- jsr ReplyMsg(a6)
-
- bsr RemAppMenuIA ta bort ny menuitem
- bsr CheckConfig
-
- bra WBINIT
-
- ; Här skall allt vara klar för att kunna avsluta (inga guru's tror du ?)
-
-
- Cleanup
- move.l (ExecBase).w,a6 Execbase
- move.l WBBase(pc),a1 hämta hanterare
- cmp.l #0,a1
- beq.s Cleanup1
- jsr CloseLibrary(a6) stäng workbench.library
- Cleanup1
- move.l disklib_base(pc),a1 hämta hanterare
- cmp.l #0,a1
- beq.s Cleanup2
- jsr CloseLibrary(a6) stäng workbench.library
- Cleanup2
- move.l GrafBase(pc),a1
- cmp.l #0,a1
- beq.s Cleanup3
- jsr CloseLibrary(a6)
- Cleanup3
- move.l IntBase(pc),a1
- cmp.l #0,a1
- beq.s Cleanup4
- jsr CloseLibrary(a6)
- Cleanup4
- move.l MyIORequest(pc),a1 ;hämta min IORequest
- cmp.l #0,a1
- beq.s Cleanup5 ;blev den skapad?
- bsr DeleteExtIO ;ja tag bort den!
- Cleanup5
- move.l MyPort(pc),d0 ;hämta min Port
- beq.s Cleanup6 ;blev den skapad?
- bsr DeletePort ;ja tag bort porten
- Cleanup6
- move.l (ExecBase).w,a6 ;
- move.l Dosbase(pc),a1 ;Hämta Dosbase
- cmp.l #0,a1 ;blev dos öppnad?
- beq.s Cleanup7 ;nej!
- jsr CloseLibrary(a6) ;ja stäng Doslibrary:
- Cleanup7
- tst.l Message ;koll om StartWB el CLI?
- beq.s Cleanup8 ;hopp till Cleanup6 om CLI
- move.l (ExecBase).w,a6
- jsr Forbid(a6)
- move.l Message(pc),a1
- jsr ReplyMsg(a6)
- Cleanup8
- move.l Initial_SP(pc),sp ;Hämta start stacken
- moveq #0,d0
-
- rts ;Hej då!
-
- ;****************************************************************************
- ;*
- ;*
- ;* Subrutiner
- ;*
- ;*
- ;****************************************************************************
- ;*
- ;*
- ;* Öppna Dos.library och spara dosbasen.
- ;*
- ;*
-
- ;****************************************************************************
-
- ; ******* !! AutoRequest for WB !! ******************
- ReqError:
- move.l #0,a0
- lea ReqText1(pc),a1
- lea ReqTextPos(pc),a2
- move.l a2,a3
- moveq #0,d0
- move.l d0,d1
- move.l #358,d2
- moveq #80,d3
- move.l IntBase(pc),a6 ;basadress till Intuition
- jsr AutoRequest(a6)
-
- bra Cleanup
-
- ;****************************************************************************
-
- SetUnit:
- lea US0(pc),a5
- lea U0(pc),a4
- moveq #0,d5
- SetCheck:
- cmp.b #'-',(a5,d5)
- beq.s SetOff
- SetNext:
- cmp.b #'+',(a5,d5)
- beq.s SetOn
-
- SetNextUnit:
- addq #1,d5
- cmp.l #4,d5
- bne.s SetCheck
- rts
-
- SetOff:
- cmp.b #0,(a4,d5)
- beq.s SetNextUnit
- move.l d5,d0
- bsr OffClick
- bra.s SetNextUnit
-
- SetOn:
- cmp.b #0,(a4,d5)
- beq.s SetNextUnit
- move.l d5,d0
- bsr OnClick
- bra.s SetNextUnit
-
-
- ;****************************************************************************
-
- PointTOCLI:
- move.l Dosbase(pc),a6 ;doslibrary pekare till
- jsr OutPut(a6) ;hämta output pekare till Dos!
- move.l d0,CLIpoint ;Spara undan pekaren
- rts
-
- ;****************************************************************************
-
-
- CreatePort
- move.l (ExecBase).w,a6 ;Laddar Execbase
- moveq #-1,d0
- jsr AllocSignal(a6)
- cmp.b #-1,d0
- beq.s Crt_Err
- move.l d0,sigbit
-
- moveq #34,d0 längden på messagestrukturen
- move.l #MEMF_TYPE,d1 public-mem + clear
- jsr AllocMem(a6) allokera minne
- bne.s CreateCount
- move.l sigbit(pc),d0
- jsr FreeSignal(a6)
- Crt_Err moveq #0,d0
- rts
-
- CreateCount
- move.l d0,MyPort Spara adressen till minne/MSGstrukturen
- move.l d0,a4 samt till a4
- move.l #PortName,10(a4) adressen till namnet
- move.b pri(pc),9(a4) prioriteten
- move.b #NT_MSGPORT,8(a4)
- move.b #PA_SIGNAL,14(a4)
- move.l #0,a1
- jsr FindTask(a6) hitta vårt task
- move.l d0,16(a4) spara det
- move.l MyPort(pc),a1 adressen till MSGstrukturen
- jsr AddPort(a6) lägg till porten
- move.l MyPort(pc),d0
-
- EndCreatePort rts
-
- ;****************************************************************************
-
- DeletePort
- move.l (ExecBase).w,a6 ;Ladda Execbase
- move.l MyPort(pc),a4 ;portsturkturen
- move.l MyPort(pc),a1
- jsr RemPort(a6) avlägnsa porten
-
- ;* OBS Dessa två rader råder det tvivel om Det skiljer sig mellan RKM och
- ; Amiga System programer's guide.
-
- move.l #-1,16(a4) Enligt RKM manualen.
- move.l #$FF,(a4) Enligt Amiga System prog. guide
-
- move.l #-1,20(a4)
- moveq #0,d0
- move.b 15(a4),d0
- jsr FreeSignal(a6)
- move.l MyPort(pc),a1 adressen till minnet vi allokerade
- moveq #34,d0 antal allokerade byte
- jsr FreeMem(a6) frigör minnet.
-
-
- EndDelPort
- rts
- ;****************************************************************************
- even
-
- ; CreateExtIO Exec support function
- ;
- ; Input: a0 = MsgPort
- ; d0.l = Size
-
- CreateExtIO: cmp.l #0,a0
- beq.s CEIO_Error
-
- move.l a0,CEIO_Port
- move.w d0,CEIO_Size
-
- move.l #MEMF_PUBLIC+MEMF_CLEAR,d1
- move.l (ExecBase).w,a6
- jsr AllocMem(a6)
- tst.l d0
- ; beq CEIO_Error
-
- move.l d0,a0
- move.b #NT_MESSAGE,8(a0) ; Node Type
- move.w CEIO_Size(pc),18(a0) ; NumBytes
- move.l CEIO_Port(pc),14(a0) ; ReplyPort
-
- rts
-
- CEIO_Error: moveq #0,d0
- rts
-
- CEIO_Port: dc.l 0 ; For CreateExtIO
- CEIO_Size: dc.w 0
-
-
- ;****************************************************************************
-
-
- ; DeleteExtIO Exec support function
- ;
- ; Input: a1 = IORequest
-
- DeleteExtIO: cmp.l #0,a1
- beq.s DEIO_Error
-
- move.b #$ff,8(a1) ; Node Type
- move.l #-1,20(a1) ; Device
- move.l #-1,24(a1) ; Unit
-
- move.w 18(a1),d0 ; Size
- ext.l d0
- move.l (ExecBase).w,a6
- jsr FreeMem(a6)
-
- DEIO_Error: rts
-
- ;****************************************************************************
-
-
- ; Vilkar drivar har vi i systemet ?
-
- CheckConfig:
- lea U0(pc),a2
- lea Act0(pc),a3
- lea UW0(pc),a5
- moveq #0,d5
- UnitCheck:
- move.l d5,d0 ;Unit nr
- bsr.s SmartOpen
- tst.l d0
- bne.s CheckNextUnit ;No Unit Check next!
- bsr AskClick
- move.b #1,(a2,d5)
- move.b d1,(a5,d5)
- move.l d5,d0 ;Unit nr
- bsr.s SmartClose
-
- CheckNextUnit:
- addq #1,d5
- add.l #44,a3
- cmp.l #4,d5
- bne.s UnitCheck
- rts
-
- ;****************************************************************************
- ;*
- ;* SmartOpen
-
- SmartOpen:
- move.l (ExecBase).w,a6 ;Execbase
- lea DevName(pc),a0
- move.l MyIORequest(pc),a1
- moveq #0,d1
- jsr OpenDevice(a6)
- rts
-
- ;****************************************************************************
- ;*
- ;* SmartClose
-
- SmartClose:
- move.l (ExecBase).w,a6 ;Execbase
- move.l MyIORequest(pc),a1
- jsr CloseDevice(a6)
- rts
-
- ;****************************************************************************
- ;*
- ;* Ställer om trackdisk.device till NoClick
- ;
- OffClick:
-
- bsr.s SmartOpen
- tst.l d0
- bne.s EndOffClick ;error open
- move.l MyIORequest(pc),a1
- move.l 24(a1),a6 io_Unit
- add.l #53,a6 PubFlags
-
- BSET #0,(a6) Bit 0 = NoClick
-
- move.l (ExecBase).w,a6
- jsr DoIO(a6)
- bsr.s SmartClose
- EndOffClick rts
-
- ;****************************************************************************
- ;*
- ;* Ställer om trackdisk.device till Click (fy vad jag hatar Click)
- ;
-
- OnClick:
- bsr.s SmartOpen
- tst.l d0
- bne.s EndOnClick ;error open
- move.l MyIORequest(pc),a1
- move.l 24(a1),a6 io_Unit
- add.l #53,a6 PubFlags
-
- BCLR #0,(a6) Bit 0 = Click
-
- move.l (ExecBase).w,a6
- jsr DoIO(a6)
- bsr.s SmartClose
- EndOnClick rts
-
- ;****************************************************************************
-
- AskClick:
- move.l MyIORequest(pc),a4
- move.l 24(a4),a4 io_Unit
- add.l #53,a4 PubFlags
- BTST #0,(a4) Bit 0 = Click
- bne.s EndAskClick
- move.w #$2,(a3)
- move.b #'+',d1
- lea GgText1(pc),a4
- move.l a4,14(a3)
- rts
- EndAskClick
- move.w #$82,(a3)
- move.b #'-',d1
- lea GgText2(pc),a4
- move.l a4,14(a3)
- rts
-
- ;****************************************************************************
-
- Ok: bra SetUnit
- rts
-
- ;****************************************************************************
-
- Quit: bsr SetUnit
- bsr ByeWindow
- bra Cleanup
-
- ;****************************************************************************
-
- Cancel: bsr CheckConfig
- move.b UW0(pc),US0
- move.b UW1(pc),US1
- move.b UW2(pc),US2
- move.b UW3(pc),US3
- bra SetUnit
-
-
- ;****************************************************************************
-
- GetInArg:
- move.l ArgList(pc),a1 ;Hämta pekare til Arglistan
- cmp.b #0,(a1)
- beq ErrorMSG ;ja
- cmp.b #'h',(a1)
-
- beq HelpMSG ;ja
- cmp.b #'?',(a1)
- beq HelpMSG ;ja
-
- ArgInLoop move.b (a1)+,d1 ;flytta byte till d1
- cmp.b #0,d1 ;är arglista slut ?
- beq.s ArgInEnd ;ja
- cmp.b #'-',d1 ;är introd ett '-' ?
- beq.s ArgSet ;ja
- cmp.b #'+',d1 ;är introd ett '-' ?
- beq.s ArgSet ;ja
- cmp.b #' ',d1 ;är introd ett '-' ?
- beq.s ArgInLoop ;ja
- bra ErrorMSG
-
- ArgInEnd
- rts
-
-
- ArgSet
- cmp.b #'h',(a1)
- beq HelpMSG ;ja
- cmp.b #'?',(a1)
- beq HelpMSG ;ja
- cmp.b #'i',(a1)
- beq ArgSetFace ;ja
- move.b d1,Moj
- ArgSetloop
-
- move.b (a1)+,d1 ;flytta byte till d1
- cmp.b #'a',d1
- beq.s ArgSetAll ;ja
- cmp.b #'0',d1
- beq.s ArgSetSingel ;ja
- cmp.b #'1',d1
- beq.s ArgSetSingel ;ja
- cmp.b #'2',d1
- beq.s ArgSetSingel ;ja
- cmp.b #'3',d1
- beq.s ArgSetSingel ;ja
- bra ErrorMSG
-
- ArgSetAll
- move.b Moj(pc),US0
- move.b Moj(pc),US1
- move.b Moj(pc),US2
- move.b Moj(pc),US3
- bra.s ArgSetEnd
-
- ArgSetSingel
- lea US0(pc),a3
- sub.b #$30,d1
- add.l d1,a3
- move.b Moj(pc),(a3)
-
- ArgSetEnd
- cmp.b #'-',(a1)
- beq ArgInLoop
- cmp.b #'+',(a1)
- beq ArgInLoop
- cmp.b #' ',(a1)
- beq ArgInLoop
- cmp.b #0,(a1)
- beq ArgInLoop
- bra.s ArgSetloop
-
-
- ArgSetFace
- move.b #1,Inter
-
- FaceNext move.b (a1)+,d1 ;flytta byte till d1
- cmp.b #' ',(a1) ;är nästa blank?
- beq.s FaceNext ;ja läs nästa!
- cmp.b #0,(a1) ;är det slut på raden?
- bne ErrorMSG ;nej error
- rts
-
-
- WBChgSingel
- ; move.w #0,$dff180
-
- lea US0(pc),a3
- add.w d6,a3
- lea UW0(pc),a2
- add.w d6,a2
- lea ActTxt0(pc),a1
-
- moveq #44,d5
- mulu d6,d5
- add.l d5,a1
-
- moveq #0,d5
- move.b (a2),d5
- moveq #6,d6
- eor.b d6,d5
- move.b d5,(a2)
- move.b (a2),(a3)
-
- lea GgText1(pc),a3
- move.l (a1),d2
- move.l a3,d1
-
- cmp.l d1,d2
- bne.s Byttext2
- lea GgText2(pc),a3
- move.l a3,(a1)
- bra.s Endbyttxt
- Byttext2 lea GgText1(pc),a3
- move.l a3,(a1)
- Endbyttxt
-
- bsr ChgGadTxt
- rts
-
- ;****************************************************************************
-
-
- ScreenMSG:
- move.l #SText1,d2 ;pekare till textsträngen
- move.l #SText1E-SText1,d3 ;sträng längd
- bsr.s TextWrite ;skriv strängen
- rts
-
-
- HelpMSG:
- move.l #HText1,d2
- move.l #HText1E-HText1-1,d3 ;sträng längd
- bsr.s TextWrite
- bra Cleanup
- rts
-
-
- ErrorMSG: move.l #EText,d2 ;pekare till Errortext
- move.l #ETextE-EText-1,d3 ;sträng längd
- bsr.s TextWrite ;skriv strängen
- bra Cleanup
-
-
- TextWrite:
- move.l Dosbase(pc),a6
- move.l CLIpoint(pc),d1
- jsr Write(a6)
- rts
-
- ;****************************************************************************
-
- WinOpen:
-
- move.l (ExecBase).w,a6
- lea DiskFontName(pc),a1
- jsr OpenLibrary(a6) ;öppna intuition
- move.l d0,disklib_base
- beq Cleanup ;fel? Avsluta
-
- move.l disklib_base,a6 ;get ptr to diskfont.library
- lea mydiskfont(pc),a0 ;load ptr to string
- jsr OpenDiskFont(a6) ;open the font
- move.l d0,myfont_base ;save ptr to real font
- beq Cleanup ;fel? Avsluta
-
- move.l IntBase(pc),a6
- move.l #0,a0
- lea WinTagList(pc),a1
- jsr OpenWindowTagList(a6)
- move.l d0,WinHandle ;sparar fönsterhanterare
- beq Cleanup ;fel? Avsluta
- rts
-
- ByeWindow:
- move.l (ExecBase).w,a6 ;basadress till EXEC i a6
- move.l NewMessage(pc),d0
- beq.s WinClose
- move.l d0,a1
- jsr ReplyMsg(a6)
- move.l #0,NewMessage
-
- WinClose: move.l IntBase(pc),a6
- move.l WinHandle(pc),a0
- jsr _CloseWindow(a6)
- rts
-
- ;****************************************************************************
-
- AddAppMenuIA
- move.l WBBase(pc),a6 Hämta workbenchBase
- moveq #1,d0 dessa är nollade i testen ändast
- moveq #0,d1 se i autodoc WB.doc (2.0)
- move.l #0,a2
- move.l MyPort(pc),a1
- lea PortName(pc),a0 MenuItem-text
- jsr AddAppMenuItemA(a6) lägg till under toolmeny ny Item
- move.l d0,MenuItemHandle Spara item hanteraren
- rts
-
- ;****************************************************************************
-
- RemAppMenuIA
- move.l WBBase(pc),a6 ;Hämta workbenchBase
- move.l MenuItemHandle(pc),a0 ;Hämta hanteraren
- jsr RemoveAppMenuItem(a6) ;tag bort ur menyn
- rts
-
- ;****************************************************************************
-
- DownGadgets: ;vilken gadgets tycktes?
-
- move.l $1c(a0),a4 ;hämta gadgets adress
- move.w $26(a4),d7 ;hämta gadget ID#
- move.w d7,d6
- lea DNGadgetTable(pc),a4 ;hämta adress till tabel
- mulu #4,d7 ;justera adressen
- move.l (a4,d7.w),a4 ;adressen till gadgetrutiner
- cmp #0,a4 ;ingen funktion för denna
- beq.s EndDownGadgets ;nej! Gör ingeting
- jmp (a4)
- EndDownGadgets: rts
-
- UpGadgets: ;vilken gadgets släpptes?
-
- move.l $1c(a0),a4 ;hämta gadgets adress
- move.w $26(a4),d7 ;hämta gadget ID#
- lea UPGadgetTable(pc),a4 ;hämta adress till tabel
- mulu #4,d7 ;justera adressen
- move.l (a4,d7.w),a4 ;adressen till gadgetrutiner
- cmp #0,a4 ;ingen funktion för denna
- beq.s EndUpGadgets ;nej! Gör ingeting
- jmp (a4)
- EndUpGadgets: rts
-
- ;****************************************************************************
-
- ChgGadTxt:
- move.l IntBase(pc),a6
- move.l WinHandle(pc),a1 ;pekare till fönster
- move.l GadgetList1(pc),a0 ;adressen till Gadgetlistan
- move.l #0,a2
- jsr RefreshGadgets(a6) ;uppdatera.
- rts
-
-
- ;****************************************************************************
-
- BorderDraw:
- move.l IntBase(pc),a6
- move.l WinHandle(pc),a0
- lea Border1A(pc),a1
- move #10,d0
- move #6,d1
- move.l 50(a0),a0
- jsr DrawBorder(a6)
- rts
-
- ;****************************************************************************
- ;
- RectDraw:
- move.l GrafBase(pc),a6
- move.l WinHandle(pc),a1
- move.l 50(a1),a1
- moveq #3,d0
- jsr SetAPen(a6)
- move.l WinHandle(pc),a1
- move.l 50(a1),a1
- moveq #12,d0 ;X-Min
- moveq #7,d1 ;Y-Min
- move.l #342,d2 ;X-Max
- moveq #26,d3 ;Y-Max
- jsr RectFill(a6)
- rts
-
- ;****************************************************************************
-
- PrintText:
- move.l IntBase(pc),a6
- move.l WinHandle(pc),a0
- move.l 50(a0),a0
- lea NiceText(pc),a1
- moveq #1,d0
- moveq #1,d1
- jsr PrintIText(a6)
- rts
-
- ;****************************************************************************
-
- ImageDraw:
- move.l IntBase(pc),a6
- lea Image1(pc),a1
- move #0,d0
- move #0,d1
- move.l WinHandle(pc),a0
- move.l 50(a0),a0
- jsr DrawImage(a6)
- rts
-
-
- ;****************************************************************************
- ;*
- ; mina data
- ;*
- ;****************************************************************************
-
-
- PortName: dc.b 'NonClick',0
- even
- DevName: dc.b 'trackdisk.device',0
- even
- Dosname: dc.b 'dos.library',0
- even
- IntName: dc.b 'intuition.library',0
- even
- GrafName: dc.b 'graphics.library',0
- even
- WBName: dc.b 'workbench.library',0
- even
- DiskFontName: dc.b 'diskfont.library',0
- even
- SText1: dc.b 10,'NonClick V1.06 (C) Copyright by Kjell'
- dc.b ' Cederfeldt 1991',10,10
- SText1E: even
-
- HText1:
- dc.b ' Programmed in 100% Assembler by Kjell Cederfeldt in'
- dc.b ' May 1991',10,' This is Public Domain',10,10
- dc.b 'Usage: NonClick <-|+Unit#:>',10,10
- dc.b ' - Turn off Click | + Turn on Click',10
- dc.b ' -a Turn off Click in all Units',10
- dc.b ' +a Turn on Click in all Units',10
- dc.b ' -i Use WBInterface to set units',10
- dc.b ' Valid Unit# from 0 to 3',10,10
- HText1E: even
-
- EText:
- dc.b 'Bad arguments, Usage "NonClick h or ?" for help',10,10,10
- ETextE: even
-
- WinTagList:
- dc.l WA_Left,160
- dc.l WA_Top,30
- dc.l WA_Width,355
- dc.l WA_Height,82
- dc.l WA_IDCMP,GADGETUP+GADGETDOWN
- dc.l WA_Gadgets,GadgetList1
- dc.l WA_DetailPen,3,2
- ; dc.l WA_Flags,ACTIVATE
- dc.l TAG_DONE
-
-
- GadgetList1: ;** Här börjar min gadgets lista!
-
- GadGetOk: dc.l GadGetQuit ; Further gadgets
- dc.w 29,59 ; Position
- dc.w 52,13 ; Hitbox size
- dc.w 2 ; Hit action (0=inverted)
- dc.w $1 ; Activation flags
- dc.w BOOLGADGET ; Gadget type
- dc.l NormButtBordC ; Image 1
- dc.l NormButtBordD ; Image 2
- dc.l GgText3 ; first IntuiText structure
- dc.l 0 ; No exclude
- dc.l 0 ; SpecialInfo
- dc.w 4 ; Gadget Id#
- dc.l 0 ; User data
-
- GadGetQuit: dc.l GadGetCancel ; Further gadgets
- dc.w 151,59 ; Position
- dc.w 52,13 ; Hitbox size
- dc.w 2 ; Hit action (0=inverted)
- dc.w $1 ; Activation flags
- dc.w BOOLGADGET ; Gadget type
- dc.l NormButtBordC ; Image 1
- dc.l NormButtBordD ; Image 2
- dc.l GgText4 ; first IntuiText structure
- dc.l 0 ; No exclude
- dc.l 0 ; SpecialInfo
- dc.w 5 ; Gadget Id#
- dc.l 0 ; User data
-
- GadGetCancel: dc.l GadGetUnit0 ; Further gadgets
- dc.w 272,59 ; Position
- dc.w 52,13 ; Hitbox size
- dc.w 2 ; Hit action (0=inverted)
- dc.w $1 ; Activation flags
- dc.w BOOLGADGET ; Gadget type
- dc.l NormButtBordC ; Image 1
- dc.l NormButtBordD ; Image 2
- dc.l GgText5 ; first IntuiText structure
- dc.l 0 ; No exclude
- dc.l 0 ; SpecialInfo
- dc.w 6 ; Gadget Id#
- dc.l 0 ; User data
-
-
- GadGetUnit0: dc.l GadGetUnit1 ; Further gadgets
- dc.w 22,42 ; Position
- dc.w 66,13 ; Hitbox size
- Act0: dc.w $100 ; Hit action (0=inverted)
- dc.w $102 ; Activation flags
- dc.w BOOLGADGET ; Gadget type
- dc.l NormButtBordA ; Image 1
- dc.l NormButtBordB ; Image 2
- ActTxt0: dc.l GgText1 ; first IntuiText structure
- dc.l 0 ; No exclude
- dc.l 0 ; SpecialInfo
- dc.w 0 ; Gadget Id#
- dc.l 0 ; User data
-
- GadGetUnit1: dc.l GadGetUnit2 ; Further gadgets
- dc.w 103,42 ; Position
- dc.w 66,13 ; Hitbox size
- Act1: dc.w $100 ; Hit action (0=inverted)
- dc.w $102 ; Activation flags
- dc.w BOOLGADGET ; Gadget type
- dc.l NormButtBordA ; Image 1
- dc.l NormButtBordB ; Image 2
- ActTxt1: dc.l GgText1 ; first IntuiText structure
- dc.l 0 ; No exclude
- dc.l 0 ; SpecialInfo
- dc.w 1 ; Gadget Id#
- dc.l 0 ; User data
-
- GadGetUnit2: dc.l GadGetUnit3 ; Further gadgets
- dc.w 184,42 ; Position
- dc.w 66,13 ; Hitbox size
- Act2: dc.w $100 ; Hit action (0=inverted)
- dc.w $102 ; Activation flags
- dc.w BOOLGADGET ; Gadget type
- dc.l NormButtBordA ; Image 1
- dc.l NormButtBordB ; Image 2
- ActTxt2: dc.l GgText1 ; first IntuiText structure
- dc.l 0 ; No exclude
- dc.l 0 ; SpecialInfo
- dc.w 2 ; Gadget Id#
- dc.l 0 ; User data
-
- GadGetUnit3: dc.l 0 ; Further gadgets
- dc.w 265,42 ; Position
- dc.w 66,13 ; Hitbox size
- Act3: dc.w $100 ; Hit action (0=inverted)
- dc.w $102 ; Activation flags
- dc.w BOOLGADGET ; Gadget type
- dc.l NormButtBordA ; Image 1
- dc.l NormButtBordB ; Image 2
- ActTxt3: dc.l GgText1 ; first IntuiText structure
- dc.l 0 ; No exclude
- dc.l 0 ; SpecialInfo
- dc.w 3 ; Gadget Id#
- dc.l 0 ; User data
-
- NormButtBordA: dc.w 0,0 ; Zero offset
- dc.b 2,0 ; Colors
- dc.b 0 ; Mode (0=JAM1)
- dc.b 5 ; Line nodes
- dc.l NormButtLine1 ; Coordinates
- dc.l NormButtBordA2 ; Further structures
-
- NormButtBordA2: dc.w 0,0 ; Zero offset
- dc.b 1,0 ; Colors
- dc.b 0 ; Mode (0=JAM1)
- dc.b 5 ; Line nodes
- dc.l NormButtLine2 ; Coordinates
- dc.l 0 ; Further structures
-
-
- NormButtBordB: dc.w 0,0 ; Zero offset
- dc.b 1,0 ; Colors
- dc.b 0 ; Mode (0=JAM1)
- dc.b 5 ; Line nodes
- dc.l NormButtLine1 ; Coordinates
- dc.l NormButtBordB2 ; Further structures
-
- NormButtBordB2: dc.w 0,0 ; Zero offset
- dc.b 2,0 ; Colors
- dc.b 0 ; Mode (0=JAM1)
- dc.b 5 ; Line nodes
- dc.l NormButtLine2 ; Coordinates
- dc.l 0 ; Further structures
-
- ;*
-
- NormButtBordC: dc.w 0,0 ; Zero offset
- dc.b 2,0 ; Colors
- dc.b 0 ; Mode (0=JAM1)
- dc.b 5 ; Line nodes
- dc.l NormButtLine3 ; Coordinates
- dc.l NormButtBordC2 ; Further structures
-
- NormButtBordC2: dc.w 0,0 ; Zero offset
- dc.b 1,0 ; Colors
- dc.b 0 ; Mode (0=JAM1)
- dc.b 5 ; Line nodes
- dc.l NormButtLine4 ; Coordinates
- dc.l 0 ; Further structures
-
-
- NormButtBordD: dc.w 0,0 ; Zero offset
- dc.b 1,0 ; Colors
- dc.b 0 ; Mode (0=JAM1)
- dc.b 5 ; Line nodes
- dc.l NormButtLine3 ; Coordinates
- dc.l NormButtBordD2 ; Further structures
-
- NormButtBordD2: dc.w 0,0 ; Zero offset
- dc.b 2,0 ; Colors
- dc.b 0 ; Mode (0=JAM1)
- dc.b 5 ; Line nodes
- dc.l NormButtLine4 ; Coordinates
- dc.l 0 ; Further structures
-
-
- NormButtLine1: dc.w 66,0
- dc.w 0,0
- dc.w 0,13
- dc.w 1,12
- dc.w 1,1
-
- NormButtLine2: dc.w 1,13
- dc.w 66,13
- dc.w 66,1
- dc.w 67,0
- dc.w 67,13
-
- NormButtLine3: dc.w 52,0
- dc.w 0,0
- dc.w 0,13
- dc.w 1,12
- dc.w 1,1
-
- NormButtLine4: dc.w 1,13
- dc.w 52,13
- dc.w 52,1
- dc.w 53,0
- dc.w 53,13
-
- GgText1:
- dc.b 1,0 ;färger
- dc.b 1 ;utskriftsätt
- even
- dc.w 7,2 ;X / Y position
- dc.l mydiskfont ;Standardteckenuppsättning
- dc.l GgTxt1 ;pekare till texten
- dc.l 0 ;ingen mer text
- GgText2:
- dc.b 1,0 ;färger
- dc.b 1 ;utskriftsätt
- even
- dc.w 7,2 ;X / Y position
- dc.l mydiskfont ;Standardteckenuppsättning
- dc.l GgTxt2 ;pekare till texten
- dc.l 0 ;ingen mer text
- GgText3:
- dc.b 1,0 ;färger
- dc.b 1 ;utskriftsätt
- even
- dc.w 20,2 ;X / Y position
- dc.l mydiskfont ;Standardteckenuppsättning
- dc.l GgTxt3 ;pekare till texten
- dc.l 0 ;ingen mer text
- GgText4:
- dc.b 1,0 ;färger
- dc.b 1 ;utskriftsätt
- even
- dc.w 11,2 ;X / Y position
- dc.l mydiskfont ;Standardteckenuppsättning
- dc.l GgTxt4 ;pekare till texten
- dc.l 0 ;ingen mer text
- GgText5:
- dc.b 1,0 ;färger
- dc.b 1 ;utskriftsätt
- even
- dc.w 4,2 ;X / Y position
- dc.l mydiskfont ;Standardteckenuppsättning
- dc.l GgTxt5 ;pekare till texten
- dc.l 0 ;ingen mer text
-
-
- GgTxt1:
- dc.b ' Click ',0 ;unit-select
- even
- GgTxt2:
- dc.b 'NoClick',0 ;unit-select
- even
- GgTxt3:
- dc.b 'OK',0 ;Ok-gadget
- even
- GgTxt4:
- dc.b 'QUIT',0 ;Quit-gadget
- even
- GgTxt5:
- dc.b 'CANCEL',0 ;Quit-gadget
- even
-
-
- DNGadgetTable:
- UPGadgetTable:
- dc.l WBChgSingel ;Gadget0 Df0:
- dc.l WBChgSingel ;Gadget1 Df1:
- dc.l WBChgSingel ;Gadget2 Df2:
- dc.l WBChgSingel ;Gadget3 Df3:
- ; dc.l 0 ;Gadget4 OK
- ; dc.l 0 ;Gadget5 QUIT
- ; dc.l 0 ;Gadget6 CANCEL
- ;
- ;UPGadgetTable:
- ; dc.l 0 ;Gadget0 Df0:
- ; dc.l 0 ;Gadget1 Df1:
- ; dc.l 0 ;Gadget2 Df2:
- ; dc.l 0 ;Gadget3 Df3:
- dc.l Ok ;Gadget4 OK
- dc.l Quit ;Gadget5 QUIT
- dc.l Cancel ;CheckConfig ;Gadget6 CANCEL
-
-
- Border1A:
- dc.w 0,0 ;XY origin relative to container TopLeft
- dc.b 1,0 ;Colors
- dc.b 0 ;draw-mode
- dc.b 5 ;number of XY vectors
- dc.l Vectors1 ;pointer to XY vectors
- dc.l Border1B ;next border in list
-
- Border1B:
- dc.w 0,0 ;XY origin relative to container TopLeft
- dc.b 2,0 ;Colors
- dc.b 0 ;draw-mode
- dc.b 5 ;number of XY vectors
- dc.l Vectors2 ;pointer to XY vectors
- dc.l 0 ;ingen mer ram-lista.
-
-
- Vectors1:
-
- dc.w 333,0
- dc.w 0,0
- dc.w 0,21
- dc.w 1,20
- dc.w 1,1
-
- Vectors2:
-
- dc.w 1,21
- dc.w 334,21
- dc.w 334,0
- dc.w 333,1
- dc.w 333,20
-
-
- NiceText:
-
- Text1: dc.b 2,3 ;färger
- dc.b 1 ;utskriftsätt
- even
- dc.w 18,8 ;textposition
- dc.l TOPAZ80 ;mydiskfont ;Standardteckenuppsättning
- dc.l Txt1 ;pekare till texten
- dc.l Text2 ;ingen mer text
-
- Text2: dc.b 2,3 ;färger
- dc.b 1 ;utskriftsätt
- even
- dc.w 18,17 ;textposition
- dc.l TOPAZ80 ;mydiskfont ;Standardteckenuppsättning
- dc.l Txt2 ;pekare till texten
- dc.l TextU0 ;ingen mer text
-
- TextU0 dc.b 1,4 ;färger
- dc.b 1 ;utskriftsätt
- even
- dc.w 40,31 ;textposition
- dc.l TOPAZ80 ;Standardteckenuppsättning
- dc.l TxtU0 ;pekare till texten
- dc.l TextU1 ;ingen mer text
-
- TextU1: dc.b 1,4 ;färger
- dc.b 1 ;utskriftsätt
- even
- dc.w 121,31 ;textposition
- dc.l TOPAZ80 ;Standardteckenuppsättning
- dc.l TxtU1 ;pekare till texten
- dc.l TextU2 ;ingen mer text
-
- TextU2: dc.b 1,4 ;färger
- dc.b 1 ;utskriftsätt
- even
- dc.w 202,31 ;textposition
- dc.l TOPAZ80 ;Standardteckenuppsättning
- dc.l TxtU2 ;pekare till texten
- dc.l TextU3 ;ingen mer text
-
- TextU3: dc.b 1,4 ;färger
- dc.b 1 ;utskriftsätt
- even
- dc.w 281,31 ;textposition
- dc.l TOPAZ80 ;Standardteckenuppsättning
- dc.l TxtU3 ;pekare till texten
- dc.l 0 ;ingen mer text
-
- Txt1: dc.b 'NonClick V1.06 Copyright 1991 by',0
- even
- Txt2: dc.b 'Kjell Cederfeldt. This is Public Domain.',0
- even
- TxtU0: dc.b 'DF0:',0
- even
- TxtU1: dc.b 'DF1:',0
- even
- TxtU2: dc.b 'DF2:',0
- even
- TxtU3: dc.b 'DF3:',0
- even
-
- TOPAZ80:
- dc.l TOPAZname
- dc.w TOPAZ_EIGHTY
- dc.b 0,0
-
- TOPAZname:
- dc.b 'topaz.font',0,0
- even
-
- mydiskfont:
- dc.l TOPAZname
- dc.w 11
- dc.b 0,0
-
- ReqText1: dc.b 0,1 ;färger
- dc.b 1 ;utskriftsätt
- even
- dc.w 7,12 ;textposition
- dc.l 0 ;standard textuppsättning
- dc.l ReqTxt1 ;pekare till texten
- dc.l ReqText2 ;ingen mer text
-
- ReqText2: dc.b 0,1 ;färger
- dc.b 1 ;utskriftsätt
- even
- dc.w 27,23 ;textposition
- dc.l 0 ;standard textuppsättning
- dc.l ReqTxt2 ;pekare till texten
- dc.l 0 ;ingen mer text
-
- ReqTextPos: dc.b 0,1 ;färger
- dc.b 1 ;utskriftsätt
- even
- dc.w 5,4 ;textposition
- dc.l 0 ;standard textuppsättning
- dc.l ReqTxt3 ;pekare till texten
- dc.l 0 ;ingen mer text
-
- ReqTxt1: dc.b 'You have to run NonClick under WB 2.0',0
- even
- ReqTxt2: dc.b 'Release 37 or later. SORRY!',0
- even
- ReqTxt3: dc.b 'I understand',0
- even
-
- ImageList:
- Image1:
- dc.w 136,7 ; X/Y avstånd
- dc.w 21,11 ; Bredd och höjd
- dc.w 2 ; Antal bitplan
- dc.l StartImage1 ; Pekare till Image-Data
- dc.b 3 ; färg bitplan 1
- dc.b 2 ; färg bitplan 2
- dc.l 0 ; Inga fler Images
-
- Initial_SP: dc.l 0
- Message: dc.l 0
- NewMessage: dc.l 0
- Dosbase: dc.l 0
- IntBase: dc.l 0
- GrafBase: dc.l 0
- disklib_base: dc.l 0
- myfont_base: dc.l 0
- WBBase: dc.l 0
- ArgList: dc.l 0
- CLIpoint: dc.l 0
- MyPort: dc.l 0
- MyIORequest: dc.l 0
- sigbit: dc.l 0
- WinHandle: dc.l 0
- MenuItemHandle: dc.l 0
- pri: dc.b 0
- even
- U0: dc.b 0
- U1: dc.b 0
- U2: dc.b 0
- U3: dc.b 0
- US0: dc.b 0
- US1: dc.b 0
- US2: dc.b 0
- US3: dc.b 0
- UW0: dc.b 0
- UW1: dc.b 0
- UW2: dc.b 0
- UW3: dc.b 0
- Moj: dc.b 0
- Inter: dc.b 0
- even
-
- SECTION foo,DATA_C
-
- StartImage1:
- ; INCBIN ram:NonClick.raw
-
- dc.b $FF,$FF,$F8,$00,$FC,$01,$F8,$00
- dc.b $E0,$F8,$38,$00,$C1,$CC,$18,$00
- dc.b $C3,$80,$18,$00,$83,$80,$08,$00
- dc.b $C3,$80,$18,$00,$C1,$CC,$18,$00
- dc.b $E0,$F8,$38,$00,$FC,$01,$F8,$00
- dc.b $FF,$FF,$F8,$00,$FC,$00,$F8,$00
- dc.b $E3,$FE,$38,$00,$DF,$07,$D8,$00
- dc.b $BE,$33,$E8,$00,$3C,$7F,$E0,$00
- dc.b $7C,$7F,$F0,$00,$3C,$7F,$E0,$00
- dc.b $BE,$33,$E8,$00,$DF,$07,$D8,$00
- dc.b $E3,$FE,$38,$00,$F8,$00,$F8,$00
-
- EndImage1:
- even
- VersionTag dc.b 0,'$VER: NonClick V37.1.06 (25.05.91)',0
- even
- end
-