; PCalender V1.0 ; by Preben Nielsen. ; Assemble it as case-sensitive. ; OPT O+ ; OPT O1+ ;Tells when a branch could be optimised to short ; OPT i+ ;Tells when '#' is probably missing ;MyPref ; if 'MyPref' is defined, the head of the calender will look like this: ; 'Mon Tue Wed Thu Fri Sat Sun' ; otherwise it will look like this: ; 'Sun Mon Tue Wed Thu Fri Sat' incdir "INCLUDE:" include "exec/exec_lib.i" include "graphics/rastport.i" include "graphics/graphics_lib.i" include "intuition/intuition.i" include "intuition/intuition_lib.i" include "libraries/dosextens.i" include "devices/inputevent.i" StartYear =1990 LowerYear =1700 ;Range of years the calender display UpperYear =2500 MonthStep =1 MonthStepShift =4 YearStep =1 YearStepShift =10 xStartB =4 yStartB =22 xSizeB =30 ySizeB =11 xSpaceB =2 ySpaceB =1 xStartT =xStartB+4 yStartT =yStartB+8 WWidth =2*xStartB+7*(xSizeB+xSpaceB)-xSpaceB WHeight =yStartB+6*(ySizeB+ySpaceB)+1 WBenchMsg =0 GfxBase =4 IntBase =8 CWindow =12 Font =16 Year =20 Month =22 ScrHeight =24 Iconified =27 LoadBase MACRO IFNC '\1','ExecBase' movea.l \1(A4),A6 ENDC IFC '\1','ExecBase' movea.l 4.W,A6 ENDC ENDM CallLib MACRO jsr _LVO\1(A6) ENDM Call MACRO bsr \1 ENDM Push MACRO movem.l \1,-(SP) ENDM Pop MACRO movem.l (SP)+,\1 ENDM IconIDCMP =MOUSEBUTTONS+CLOSEWINDOW FullIDCMP =MOUSEBUTTONS+CLOSEWINDOW+RAWKEY SECTION CALCODE,CODE CData EQUR A4 Rp EQUR A5 lea DataStart(PC),CData LoadBase ExecBase suba.l A1,A1 CallLib FindTask ;Find us movea.l D0,A2 tst.l pr_CLI(A2) ;pr_CLI bne.S CLIAndWBStartup WBenchStartup lea pr_MsgPort(A2),A0 ;pr_MsgPort CallLib WaitPort ;wait for a message lea pr_MsgPort(A2),A0 CallLib GetMsg ;then get it move.l D0,WBenchMsg(CData) ;save it for later reply CLIAndWBStartup lea GfxName(PC),A1 CallLib OldOpenLibrary move.l D0,GfxBase(CData) lea IntName(PC),A1 CallLib OldOpenLibrary move.l D0,IntBase(CData) LoadBase GfxBase lea TxtAttr(PC),A0 CallLib OpenFont move.l D0,Font(CData) beq.S Exit GetAWindow LoadBase IntBase lea NW(PC),A0 move.w ScrHeight(CData),D1 ;Screen height sub.w nw_Height(A0),D1 cmp.w nw_TopEdge(A0),D1 bgt.S yPosOk move.w D1,nw_TopEdge(A0) yPosOk CallLib OpenWindow move.l D0,CWindow(CData) beq.S Exit movea.l D0,A0 movea.l wd_RPort(A0),Rp ;RastPort in A5 always movea.l wd_WScreen(A0),A0 move.w sc_Height(A0),ScrHeight(CData) LoadBase GfxBase movea.l Font(CData),A0 movea.l Rp,A1 CallLib SetFont ;Make sure to use topaz in the right size LoadBase IntBase movea.l CWindow(CData),A0 lea WinTitle(PC),A1 lea ScrTitle(PC),A2 CallLib SetWindowTitles bra.S Main Exit FreeWindow LoadBase IntBase move.l CWindow(CData),D0 beq.S FreeIntui movea.l D0,A0 CallLib CloseWindow ;Close window if it is open FreeIntui LoadBase ExecBase move.l IntBase(CData),D0 beq.S FreeGfx movea.l D0,A1 CallLib CloseLibrary ;Close intuition if it is open FreeGfx move.l GfxBase(CData),D0 beq.S ReplyWB movea.l D0,A1 CallLib CloseLibrary ;Close graphics if it is open ReplyWB move.l WBenchMsg(CData),D0 beq.S AllDone CallLib Forbid movea.l D0,A1 CallLib ReplyMsg ;Reply WBenchMessage if we are started from WB AllDone moveq #0,D0 rts Main RefreshWindow tst.w Iconified(CData) bne.S GetNextMsg Call SetDrMd1 ;Refreshes entire window Call SetBPen1 Call SetAPen1 moveq #xStartB,D0 moveq #11,D1 move.w #WWidth-xStartB-1,D2 moveq #20,D3 movea.l Rp,A1 ;RastPort CallLib RectFill moveq #xStartB+2*(xSizeB+xSpaceB),D0 moveq #yStartB+5*(ySizeB+ySpaceB),D1 move.w #WWidth-xStartB-1,D2 move.w D1,D3 add.w #ySizeB-1,D3 movea.l Rp,A1 ;RastPort CallLib RectFill Call SetAPen2 moveq #xStartT-1,D0 moveq #18,D1 moveq #27,D2 lea WeekTxt(PC),A0 Call Txt Call NewYear GetNextMsg LoadBase ExecBase movea.l CWindow(CData),A0 movea.l wd_UserPort(A0),A0 CallLib WaitPort movea.l CWindow(CData),A0 movea.l wd_UserPort(A0),A0 CallLib GetMsg tst.l D0 beq.S GetNextMsg movea.l D0,A1 ;Message address to A1 move.l im_Class(A1),D2 ;Save the event class in D2 move.w im_Code(A1),D3 ;Save the event code in D3 move.w im_Qualifier(A1),D4 ;Save the event qualifier in D4 andi.w #IEQUALIFIER_LSHIFT+IEQUALIFIER_RSHIFT,D4 ;Mask out the shift keys CallLib ReplyMsg ;Reply the message CheckWinClose cmpi.w #CLOSEWINDOW,D2 beq Exit ;Terminate ? CheckButtons cmpi.w #MOUSEBUTTONS,D2 bne.S CheckRawkey cmpi.w #MENUDOWN,D3 ;Pressed the Menu-button ? bne.S CheckRawkey LoadBase IntBase not.w Iconified(CData) beq.S UnIconify Iconify moveq #10,D0 move.l #IconIDCMP,D1 bra.S ChangeWin UnIconify moveq #WHeight,D0 move.l #FullIDCMP,D1 ChangeWin LoadBase IntBase move.l CWindow(CData),A0 lea NW(PC),A1 move.l wd_LeftEdge(A0),nw_LeftEdge(A1) move.w D0,nw_Height(A1) move.l D1,nw_IDCMPFlags(A1) CallLib CloseWindow bra GetAWindow CheckRawkey cmpi.w #RAWKEY,D2 bne GetNextMsg ;No key touched cmpi.w #78,D3 ;A key was touched. Is it an arrow-key ? beq.S ChangeYear cmpi.w #79,D3 beq.S ChangeYear cmpi.w #76,D3 beq.S ChangeMonth cmpi.w #77,D3 bne GetNextMsg ChangeMonth lea Month(CData),A0 moveq #MonthStep,D0 ;Step value for months without Shift key tst.w D4 beq.S NoMonthShift moveq #MonthStepShift,D0 ;Step value for months with Shift key NoMonthShift cmpi.w #76,D3 ;Which direction beq.S AddMonth neg D0 AddMonth add.w (A0),D0 addi.w #12,D0 ext.l D0 divu #12,D0 swap D0 move.w D0,(A0) ;0-11 Call NewMonth bra GetNextMsg ChangeYear lea Year(CData),A0 moveq #YearStep,D0 ;Step value for year without Shift key tst.w D4 beq.S NoYearShift moveq #YearStepShift,D0 ;Step value for year with Shift key NoYearShift cmpi.w #78,D3 ;Which direction beq.S AddYear neg D0 AddYear add.w (A0),D0 subi.w #LowerYear,D0 addi.w #UpperYear-LowerYear+1,D0 ext.l D0 divu #UpperYear-LowerYear+1,D0 swap D0 addi.w #LowerYear,D0 move.w D0,(A0) Call NewYear bra GetNextMsg NewYear Push D0-D7/A0-A3 lea TempTxt+4(PC),A0 ;Convert the year to ascii move.w Year(CData),D0 ext.l D0 ConvertLoop tst.l D0 ;A0=end of printbuffer ble.S EndConvert divu #10,D0 swap D0 addi.b #'0',D0 move.b D0,-(A0) clr.w D0 swap D0 bra.S ConvertLoop EndConvert move.w #xStartT+2*(xSizeB+xSpaceB)+90,D0 moveq #yStartT+5*(ySizeB+ySpaceB),D1 moveq #4,D2 lea TempTxt(PC),A0 ;Print year Call Txt move.w Year(CData),D0 ext.l D0 move.l D0,D1 divu #4,D1 ;Year%4 swap D1 tst.w D1 bne.S NotLeapYear move.l D0,D1 divu #400,D1 ;Year%400 swap D1 tst.w D1 beq.S LeapYear move.l D0,D1 divu #100,D1 swap D1 ;Year%100 tst.w D1 bne.S LeapYear NotLeapYear moveq #28,D0 bra.S LeapYearOrNot LeapYear moveq #29,D0 ;If ((Year%400==0)||((Year%100!=0)&&(Year%4==0))) LeapYearOrNot lea Days+1(PC),A0 move.b D0,(A0) ;Days[1]=28 or Days[1]=28 move.w Year(CData),D0 subq.w #1,D0 ext.l D0 move.l D0,D7 move.l D0,D6 move.l D0,D5 divu #4,D7 ;year/4 divu #100,D6 ;year/100 divu #400,D5 ;year/400 sub.w D6,D7 ;D7=Year/4-Year/100 add.w D5,D7 ;D7=(Year/4)-(Year/100)+(Year/400)=LeapDays add.w D0,D7 ;D7=(Year/4)-(Year/100)+(Year/400)+(Year*(365 % 7)) IFND MyPref addq.w #1,D7 ENDC ext.l D7 divu #7,D7 swap D7 lea Days(PC),A1 lea Offset(PC),A0 move.b D7,(A0) moveq #1,D7 ;for (i=1;i<12;i++) ModLoop cmpi.w #12,D7 ; Offset[i]=(Days[i-1]+Offset[i-1])%7; bge.S EndMod moveq #0,D0 moveq #0,D1 move.b -1(A0,D7.W),D0 move.b -1(A1,D7.W),D1 add.w D1,D0 ;D0=Days[i-1]+Offset[i-1] divu #7,D0 swap D0 ;D0=(Days[i-i]+Offset[i-1])%7 move.b D0,0(A0,D7.W) ;Offset[i]=D0 addq.w #1,D7 bra.S ModLoop EndMod Call NewMonth Pop D0-D7/A0-A3 rts NewMonth Push D0-D7/A0-A3 LoadBase GfxBase Call SetAPen1 moveq #yStartB+5*(ySizeB+ySpaceB),D5 ;Draw black squares from the right bottom moveq #xStartB+1*(xSizeB+xSpaceB),D4 ;Special treatment for the first two squares bra.S xLoop yLoop move.w #xStartB+6*(xSizeB+xSpaceB),D4 xLoop Push D4-D5 move.w D4,D0 move.w D5,D1 move.w D4,D2 move.w D5,D3 addi.w #xSizeB-1,D2 ;SizeX addi.w #ySizeB-1,D3 ;SizeY movea.l Rp,A1 ;RastPort CallLib RectFill Pop D4-D5 subi.w #xSizeB+xSpaceB,D4 cmpi.w #xStartB,D4 bge.S xLoop subi.w #ySizeB+ySpaceB,D5 cmpi.w #yStartB,D5 bge.S yLoop ;Done Drawing Call SetAPen2 moveq #xStartT+2*(xSizeB+xSpaceB)+8,D0 moveq #yStartT+5*(ySizeB+ySpaceB),D1 moveq #9,D2 muls Month(CData),D2 lea Months(PC),A0 adda.w D2,A0 moveq #9,D2 Call Txt ;Write name of month lea Offset(PC),A0 adda.w Month(CData),A0 ;Add month moveq #0,D7 move.b (A0),D7 ;D7=Offset[Month]; ;D5=x,D6=y move.w D7,D5 mulu.w #xSizeB+xSpaceB,D5 addi.w #xStartT+3,D5 ;x=(xSize+xSpace)*D7+xStart+3; moveq #yStartT,D6 ;y=yStart lea Days(PC),A0 adda.w Month(CData),A0 move.b (A0),D4 ;Days[Month] moveq #0,D3 ;for (i=0;i