home *** CD-ROM | disk | FTP | other *** search
-
- * Day2Day
- *
- * Calculates the difference between two dates (in days).
- *
- *
- * NOTE: There's no need to 'RUN' or 'RUNBACK' this program from the
- * CLI. It is auto-detaching.
- *
- *HISTORY
- * Made with Hisoft V2.12
- * V1.0 27-Jul-91: Made the calculation and parsing routines. Works fine.
- * Added intuition interface.
- * 28-Jul-91: Rewrote calculation routine - now much faster (but still
- * not optimal).
- * Added date validity-check.
-
- OPT O+
- OPT O1+ ; Tells when a branch could be optimised to short
- OPT i+ ; Tells when '#' is probably missing
-
- incdir "AsmInc:"
- include "P.i"
- include "Intui.i"
- include "Detach.i"
- include "relMacros.i"
- include "intuition/intuition.i"
- include "intuition/intuition_lib.i"
- include "libraries/dosextens.i"
-
- DB EQUR A4
-
- dcDeclare A4
- dcAPtr WBenchMsg
- dcAPtr IntuiBase
- dcAPtr DWindow
- dcAPtr Up
- dcAPtr Rp
- dcLong Class
- dcAPtr IAddress
- dcArea FromInfo,si_SIZEOF
- dcArea ToInfo,si_SIZEOF
- dcArea FromBuf,11
- dcArea ToBuf,11
- dcEnd
-
- Start DetachSingle <'Day2Day'>,4000,0
- dcAlloc ; Allocate memory for variables
- dcReset ; Clear the memory
- lea FromGad(PC),A1
- lea FromInfo(DB),A2
- move.l A2,gg_SpecialInfo(A1)
- lea FromBuf(DB),A1
- move.l A1,si_Buffer(A2)
- move.w #11,si_MaxChars(A2)
-
- lea ToGad(PC),A1
- lea ToInfo(DB),A2
- move.l A2,gg_SpecialInfo(A1)
- lea ToBuf(DB),A1
- move.l A1,si_Buffer(A2)
- move.w #11,si_MaxChars(A2)
-
- Prepare Exec_Call
- suba.l A1,A1
- CallLib FindTask ; Find us
- movea.l D0,A2
- tst.l pr_CLI(A2)
- bne.S GetLibs
- lea pr_MsgPort(A2),A0
- CallLib WaitPort ; wait for a message
- lea pr_MsgPort(A2),A0
- CallLib GetMsg ; then get it
- move.l D0,WBenchMsg(DB) ; save it for later reply
- GetLibs lea IntuiName(PC),A1
- CallLib OldOpenLibrary
- move.l D0,IntuiBase(DB)
- beq.S Error
-
- Prepare Intuition_Call
- lea NW(PC),A0
- CallLib OpenWindow
- move.l D0,DWindow(DB)
- movea.l D0,A0
- beq.S Error
- move.l wd_RPort(A0),Rp(DB)
- move.l wd_UserPort(A0),Up(DB)
- lea WinTitle(PC),A1
- lea ScrTitle(PC),A2
- CallLib SetWindowTitles
- bra.S Main
-
- Error
- Exit
- FreeWindow Prepare Intuition_Call
- move.l DWindow(DB),D0
- beq.S FreeIntui
- move.l D0,A0
- CallLib CloseWindow
- FreeIntui Prepare Exec_Call
- move.l IntuiBase(DB),D0
- beq.S ReplyWB
- movea.l D0,A1
- CallLib CloseLibrary
- ReplyWB move.l WBenchMsg(DB),D2
- beq.S AllDone
- CallLib Forbid
- movea.l D2,A1
- CallLib ReplyMsg ; Reply WBenchMessage if we are started from WB
- AllDone dcFree
- moveq #0,D0
- DoNothing rts
-
-
- Main
- EventLoop movea.l Up(DB),A0
- Prepare Exec_Call
- CallLib WaitPort
- GetNextMsg Call GetAMessage
- beq.S EventLoop
- move.l Class(DB),D0
- cmp.l #CLOSEWINDOW,D0
- beq.S Exit
- andi.w #GADGETDOWN+GADGETUP,D0
- bne.S GJ
- cmp.l #ACTIVEWINDOW,D0
- bne.S GetNextMsg
- Call ActivateFrom
- bra.S GetNextMsg
- GJ movea.l IAddress(DB),A1
- move.w gg_GadgetID(A1),D0 ; GadgetID is offset from GJ
- jsr GJ(PC,D0.W)
- bra.S GetNextMsg
-
- *»»» User pressed RETURN in the 'To' string-gadget,
- *»»» or activated the window, or an error was found
- *»»» in the 'From' string-gadget.
- ActivateFrom lea FromGad(PC),A0
- bra.S ActivateStr
- *»»» User pressed RETURN in the 'From' string-gadget,
- *»»» or an error was found in the 'To' string-gadget.
- ActivateTo lea ToGad(PC),A0
- ActivateStr Prepare Intuition_Call
- move.l DWindow(DB),A1
- suba.l A2,A2
- CallLib ActivateGadget
- rts
-
- *»»» User clicked the 'Solve' button
- DoSolve lea FromBuf(DB),A0
- Call ParseDate
- bmi.S 1$
- move.l D1,D4
- move.l D2,D5
- move.l D3,D6
- lea ToBuf(DB),A0
- Call ParseDate
- bmi.S 2$
- exg D1,D4
- exg D2,D5
- exg D3,D6
- move.l D3,D0
- swap D0
- move.w D2,D0
- lsl.w #8,D0
- move.b D1,D0
- move.l D6,D7
- swap D7
- move.w D5,D7
- lsl.w #8,D7
- move.b D4,D7
- cmp.l D0,D7 ; Compare date order
- blt.S 1$
- Call CalcDays
- lea TxtAre+6(PC),A0
- Call MakeDecStr
- Call PrintSolution
- Call ActivateFrom
- rts
- 1$ Call ActivateFrom
- bra.S 3$
- 2$ Call ActivateTo
- 3$ Prepare Intuition_Call
- move.l DWindow(DB),A0
- move.l wd_WScreen(A0),A0
- CallLib DisplayBeep
- lea TxtAre+6(PC),A0
- moveq #8,D0
- 4$ move.b #'?',(A0)+
- dbf D0,4$
- Call PrintSolution
- rts
-
- PrintSolution Prepare Intuition_Call
- move.l Rp(DB),A0
- lea ITxtAre(PC),A1
- move.w #Sx,D0
- moveq #Sy,D1
- CallLib PrintIText
- rts
-
- *»»» Call: D1 = Day (from)
- *»»» D2 = Month (from)
- *»»» D3 = Year (from)
- *»»» D4 = Day (to)
- *»»» D5 = Month (to)
- *»»» D6 = Year (to)
- CalcDays Push D1-D7/A0
- moveq #0,D7
- move.w D3,D0
- Call AdjustYear
- lea Days-1(PC),A0
- add.w D2,A0
- move.b (A0)+,D7
- sub.w D1,D7
- add.w D4,D7
- sub.w D3,D6
- subq.w #1,D6
- bge.S 1$
- sub.w D2,D5
- bgt.S 6$
- move.w D4,D7
- sub.w D1,D7
- bra.S 9$
- 1$ neg.w D2
- add.w #12,D2
- bra.S 3$
- 2$ moveq #0,D0
- move.b (A0)+,D0
- add.l D0,D7
- 3$ dbf D2,2$
- bra.S 5$
- 4$ add.l #365-28,D7
- moveq #0,D0
- move.b Days+1(PC),D0
- add.l D0,D7
- 5$ addq.w #1,D3
- move.w D3,D0
- Call AdjustYear
- dbf D6,4$
- lea Days(PC),A0
- 6$ subq.w #1,D5
- bra.S 8$
- 7$ moveq #0,D0
- move.b (A0)+,D0
- add.l D0,D7
- 8$ dbf D5,7$
- 9$ move.l D7,D0
- Pop D1-D7/A0
- rts
-
- *»»» Call: D0 = year to adjust
- *»»» Changes the number of days in the month of February
- *»»» according to the rules for leapyear.
- AdjustYear Push D0-D1/A0
- ext.l D0
- move.l D0,D1
- andi.w #%11,D1 ;Year%4
- bne.S 1$
- move.l D0,D1
- divu #400,D1 ;Year%400
- swap D1
- tst.w D1
- beq.S 2$
- move.l D0,D1
- divu #100,D1
- swap D1 ;Year%100
- tst.w D1
- bne.S 2$
- 1$ moveq #28,D0
- bra.S 3$
- 2$ moveq #29,D0 ;If ((Year%400==0)||((Year%100!=0)&&(Year%4==0)))
- 3$ lea Days+1(PC),A0
- move.b D0,(A0) ;Days[1]=28 or Days[1]=28
- Pop D0-D1/A0
- rts
-
- *»»» Call: A0 = String
- ParseDate Call DoNumber
- bne.S 1$
- move.l D0,D1 ; Day
- Call DoNumber
- bne.S 1$
- move.l D0,D2 ; Month
- Call DoNumber
- bmi.S 1$
- beq.S 1$
- move.l D0,D3 ; Year
- Call AdjustYear ; Check for valid date
- tst.l D2
- ble.S 1$
- cmp.w #12,D2
- bgt.S 1$
- tst.l D1 ; Month was valid
- ble.S 1$
- lea Days(PC),A0
- cmp.b -1(A0,D2),D1
- bgt.S 1$
- moveq #0,D0 ; And day was valid too
- rts
- 1$ moveq #-1,D0
- rts
-
- *»»» Call: A0 = String
- DoNumber Push D1
- moveq #0,D0
- 1$ move.b (A0)+,D1
- beq.S 6$
- cmp.b #'-',D1
- beq.S 5$
- sub.b #'0',D1
- blt.S 4$
- cmp.b #9,D1
- bgt.S 4$
- mulu #10,D0
- ext.w D1
- add.w D1,D0
- bra.S 1$
- 4$ moveq #-1,D1
- bra.S 3$
- 6$ moveq #1,D1
- bra.S 3$
- 5$ moveq #0,D1
- 3$ Pop D1
- rts
-
- *»»» Call: D0 = Number to convert to ascii
- *»»» A0 = Where to put string
- MakeDecStr Push D1-D5/A0
- moveq #9,D1
- tst.l D0
- beq.S 6$
- subq.l #1,D1
- asl.l #2,D1
- moveq #' ',D4
- moveq #'0',D2
- 1$ move.w D2,D3
- move.l 9$(PC,D1.l),D5
- 2$ cmp.l D5,D0
- blt.S 3$
- addq.w #1,D3
- sub.l D5,D0
- bra.S 2$
- 3$ cmp.b D2,D3
- bne.S 4$
- move.w D4,D3
- bra.S 5$
- 4$ move.w D2,D4
- 5$ move.b D3,(A0)+
- subq.w #4,D1
- bge.S 1$
- bra.S 8$
- 6$ subq.l #2,D1
- 7$ move.b #' ',(A0)+
- dbf D1,7$
- move.b #'0',(A0)+
- 8$ Pop D1-D5/A0
- rts
- 9$ dc.l 1,10,100,1000,10000,100000,1000000,10000000
-
- GetAMessage Push D0-D1/A0-A1/A6
- movea.l Up(DB),A0
- Prepare Exec_Call
- CallLib GetMsg
- tst.l D0
- beq.S 1$
- movea.l D0,A1
- move.l 20(A1),Class(DB)
- move.l 28(A1),IAddress(DB)
- CallLib ReplyMsg
- moveq #1,D0
- 1$ Pop D0-D1/A0-A1/A6
- rts
-
- Days dc.b 31,28,31,30,31,30,31,31,30,31,30,31
-
- IntuiName dc.b 'intuition.library',0
- EVEN
-
- IDCMPFlags =GADGETUP+GADGETDOWN+CLOSEWINDOW+ACTIVEWINDOW
- OtherFlags =WINDOWCLOSE+WINDOWDRAG+WINDOWDEPTH+NOCAREREFRESH+ACTIVATE
- NW dc.w 320-WW/2,128-WH/2,WW,WH
- dc.b 0,1
- dc.l IDCMPFlags,OtherFlags
- dc.l GadgetList,0,0,0,0
- dc.w 0,0,0,0,WBENCHSCREEN
-
- WW =222 ; window width
- WH =78 ; window height
- SW =53 ; gadget width
- SH =21 ; gadget height
- Sx =157 ; gadget xpos
- Sy =34 ; gadget ypos
- FW =88 ; gadget width
- FH =10 ; gadget height
-
- GadgetList
- FromGad Gadget ToGad,52,33,FW,FH,GADGHCOMP,RELVERIFY,STRGADGET
- Gadget2 FBorder,0,ITxtFrom,0,0,ActivateTo-GJ,0
- ToGad Gadget SolveGad,52,48,FW,FH,GADGHCOMP,RELVERIFY,STRGADGET
- Gadget2 FBorder,0,ITxtTo,0,0,ActivateFrom-GJ,0
- SolveGad Gadget 0,Sx,Sy,SW,SH,GADGHCOMP,RELVERIFY,BOOLGADGET
- Gadget2 ButBorder,0,ITxtSolve,0,0,DoSolve-GJ,0
-
- ButBorder Border -2,-1,1,0,1,9,ButVectors,But2Border
- ButVectors dc.w 2,0,SW+1,0,SW+3,2,SW+3,SH-1,SW+1,SH+1,2,SH+1,0,SH-1,0,2,2,0
- But2Border Border -107,37,1,0,1,2,FVectors,0
- FBorder Border 0,8,1,0,1,2,FVectors,0
- FVectors dc.w 0,0,FW-1,0
-
- ITxtSolve IntuiText 3,0,1,6,7,TxtSolve,ITxtAre
- ITxtAre IntuiText 1,0,1,-147,29,TxtAre,ITxtFormat
- ITxtFormat IntuiText 1,0,1,-148,-16,TxtFormat,0
- ITxtFrom IntuiText 1,0,1,-43,0,TxtFrom,0
- ITxtTo IntuiText 1,0,1,-43,0,TxtTo,0
-
- TxtSolve dc.b 'Solve',0
- TxtAre dc.b 'are ????????? days',0
- TxtFormat dc.b 'Date-format is DD-MM-YYYY',0
- TxtFrom dc.b 'From',0
- TxtTo dc.b 'to',0
- WinTitle dc.b 'Day2Day V1.0',0
- ScrTitle dc.b 'Day2Day V1.0 © 1991 by Preben Nielsen',0
- EVEN
-
- TxtAttr dc.l FontName
- dc.w TOPAZ_EIGHTY
- dc.b FS_NORMAL,FPB_ROMFONT
- FontName dc.b 'topaz.font',0
- END
-
-