'From Squeak3.7alpha of 11 September 2003 [latest update: #5623] on 16 January 2004 at 2:32:34 pm'! AlignmentMorph subclass: #MonthMorph instanceVariableNames: 'month todayCache tileRect model' classVariableNames: '' poolDictionaries: '' category: 'Morphic-PDA'! AlignmentMorph subclass: #WeekMorph instanceVariableNames: 'week month tileRect' classVariableNames: '' poolDictionaries: '' category: 'Morphic-PDA'! !MonthMorph methodsFor: 'controls' stamp: 'brp 9/3/2003 08:46'! chooseYear | newYear yearString | newYear _ (SelectionMenu selections: {'today'} , (month year - 5 to: month year + 5) , {'other...'}) startUpWithCaption: 'Choose another year'. newYear ifNil: [^ self]. newYear isNumber ifTrue: [^ self month: (Month month: month monthName year: newYear)]. newYear = 'today' ifTrue: [^ self month: (Month starting: Date today)]. yearString _ FillInTheBlank request: 'Type in a year' initialAnswer: Date today year asString. yearString ifNil: [^ self]. newYear _ yearString asNumber. (newYear between: 0 and: 9999) ifTrue: [^ self month: (Month month: month monthName year: newYear)]. ! ! !MonthMorph methodsFor: 'controls' stamp: 'brp 1/13/2004 11:33'! nextYear self month: (Month month: month month year: month year + 1) ! ! !MonthMorph methodsFor: 'controls' stamp: 'brp 1/13/2004 11:33'! previousYear self month: (Month month: month month year: month year - 1) ! ! !MonthMorph methodsFor: 'controls' stamp: 'dgd 8/30/2003 21:53'! startMondayOrSundayString ^ (Week startMonday ifTrue: ['start Sunday'] ifFalse: ['start Monday']) translated! ! !MonthMorph methodsFor: 'controls' stamp: 'brp 9/2/2003 15:14'! toggleStartMonday (Week startDay = #Monday) ifTrue: [ Week startDay: #Sunday ] ifFalse: [ Week startDay: #Monday ]. self initializeWeeks ! ! !MonthMorph methodsFor: 'initialization' stamp: 'brp 9/2/2003 15:14'! defaultColor "answer the default color/fill style for the receiver" ^ Color red! ! !MonthMorph methodsFor: 'initialization' stamp: 'brp 9/2/2003 15:14'! initialize "initialize the state of the receiver" super initialize. "" tileRect _ 0 @ 0 extent: 23 @ 19. self layoutInset: 1; listDirection: #topToBottom; vResizing: #shrinkWrap; hResizing: #shrinkWrap; month: Month current. self rubberBandCells: false. self extent: 160 @ 130! ! !MonthMorph methodsFor: 'initialization' stamp: 'brp 9/3/2003 08:52'! initializeWeeks | weeks | self removeAllMorphs. weeks _ OrderedCollection new. month weeksDo: [ :w | weeks add: (WeekMorph newWeek: w month: month tileRect: tileRect model: model)]. weeks reverseDo: [ :w | w hResizing: #spaceFill; vResizing: #spaceFill. "should be done by WeekMorph but isn't" w submorphsDo:[ :m | m hResizing: #spaceFill; vResizing: #spaceFill ]. self addMorph: w ]. self initializeHeader; highlightToday. ! ! !PDA methodsFor: 'example' stamp: 'brp 9/3/2003 08:45'! sampleScheduleList ^ { PDAEvent new key: 'home'; date: Date today; description: 'wake up'; time: (Time hour: 6 minute: 0 second: 0). PDAEvent new key: 'home'; date: Date today; description: 'go for a run'; time: (Time hour: 7 minute: 0 second: 0). PDAEvent new key: 'home'; date: Date today; description: 'take a shower'; time: (Time hour: 8 minute: 0 second: 0). PDAEvent new key: 'home'; date: (Date today addDays: 2); description: 'dinner out'; time: (Time hour: 18 minute: 0 second: 0). PDAEvent new key: 'work'; date: (Date today addDays: 1); description: 'conf call'; time: (Time hour: 10 minute: 0 second: 0). PDAEvent new key: 'work'; date: (Date today addDays: 2); description: 'Leave for Conference'; time: (Time hour: 8 minute: 0 second: 0). PDAEvent new key: 'work'; date: Date today; description: 'call Boss'; time: (Time hour: 15 minute: 0 second: 0). PDAEvent new key: 'work'; date: Date today; description: 'Call about 401k'; time: (Time hour: 10 minute: 0 second: 0). }! ! !WeekMorph methodsFor: 'all' stamp: 'brp 9/3/2003 08:36'! initializeDays: modelOrNil | extent days tile | self removeAllMorphs. days _ OrderedCollection new: 7. extent _ self tile extent. week datesDo: [:each | tile _ (self tileLabeled: each dayOfMonth printString) extent: extent. each month = month month ifFalse: [tile color: Color gray; offColor: Color gray; onColor: Color veryLightGray]. modelOrNil ifNotNil: [tile target: modelOrNil; actionSelector: #setDate:fromButton:down:; arguments: {each. tile}]. days add: tile]. days reverseDo: [:each | self addMorph: each]! ! !WeekMorph methodsFor: 'all' stamp: 'brp 9/2/2003 15:16'! initializeForWeek: aWeek month: aMonth tileRect: rect model: aModel super initialize. tileRect _ rect. self layoutInset: 0; color: Color transparent; listDirection: #leftToRight; hResizing: #shrinkWrap; disableDragNDrop; height: tileRect height. self week: aWeek month: aMonth model: aModel ! ! !WeekMorph methodsFor: 'all' stamp: 'brp 1/13/2004 16:46'! title "Answer a title with the names of the days." | title extent days | title _ AlignmentMorph new layoutInset: 0; color: Color red; listDirection: #leftToRight; vResizing: #shrinkWarp; height: tileRect height. extent _ self tile extent. days _ (Week startDay = #Monday) ifTrue: [ #(2 3 4 5 6 7 1) ] ifFalse: [ 1 to: 7 ]. (days reverse collect: [:each | Date nameOfDay: each]) do: [:each | title addMorph: ((self tileLabeled: (each copyFrom: 1 to: 2)) extent: extent)]. ^ title ! ! !WeekMorph methodsFor: 'initialization' stamp: 'brp 9/2/2003 15:16'! initialize ^ self initializeForWeek: Date today asWeek month: Date today asMonth tileRect: (0@0 extent: 23@19) model: nil! ! !WeekMorph class methodsFor: 'instance creation' stamp: 'brp 9/2/2003 15:17'! on: aDate ^ self new week: aDate asWeek month: aDate asMonth model: nil! !