Hi All,

thanks for all the answers so far, if someone has a bit of time, do you 
have any comments on this little Calendar App?

(No, don't ask, something like this is really used here, originally it 
is an Excel spreadsheet - my plan is to give them the same 'look' with 
added 'feel', then add a better look for me, and last, educate them to 
try out my improved look.)

Especially, is there a better way to do the layout? maybe a predefined 
spreadsheet morph?


Kind regards,

Ingo


-------------- next part --------------
BorderedMorph subclass: #Calendar
	instanceVariableNames: 'today displayStart displayEnd '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'IHO-Calendar'!
!Calendar commentStamp: 'iho 5/21/2003 22:48' prior: 0!
A sort of a calendar App

(no, please don't ask, I have to work with the 'Real Thing' (TM) which is an MS Excel Spreadshirt -
it really can't get worse ;-)

OK, this is in a state to roughly show what I am hinting at:
- clicking into a CalendarHour field adds an entry (either on mo/mi tu/tu or fr) with a/text encoding
  in the display
- the calendar logic is nearly inexistant so far
- scrolling (so far) would be done by sending #startDate: to the CalendarWeeks

- Any ideas how I might make this better? Layout?

Calendar new openInWorld.!


!Calendar methodsFor: 'as yet unclassified' stamp: 'iho 5/21/2003 22:37'!
entry: aString date: aDate time: aTime 
	(aDate < displayStart or: [aDate > displayEnd])
		ifTrue: [^ nil].
	(submorphs allButFirst
		detect: [:m | m contains: aDate]
		ifNone: [^ nil])
		entry: aString
		date: aDate
		time: aTime! !

!Calendar methodsFor: 'as yet unclassified' stamp: 'iho 5/21/2003 19:33'!
initialize
	| temp tempDate |
	super initialize.
	self extent: 700 @ 300.

	today _ Date today.
	displayStart _ (Week fromDate: today) firstDate.

	tempDate _ displayStart.
	self layoutPolicy: TableLayout new;
		 listDirection: #topToBottom.
	self borderWidth: 1.
	temp _ CalendarHeader new.
	self addMorph: temp.
	1
		to: 5
		do: [:cnt | 
			temp _ CalendarWeek new.
			self addMorphBack: temp.
			temp startDate: tempDate.
			tempDate _ tempDate addDays: 7.
			temp hResizing: #spaceFill;
				 vResizing: #spaceFill;
				 spaceFillWeight: 1].
	displayEnd _ tempDate addDays: -1.! !


BorderedMorph subclass: #CalendarDate
	instanceVariableNames: 'date displayDate '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'IHO-Calendar'!

!CalendarDate methodsFor: 'as yet unclassified' stamp: 'iho 5/21/2003 22:39'!
initialize
	super initialize.
	self borderWidth: 1.
	self color: Color gray.
	self clipSubmorphs: true.
	self layoutPolicy: TableLayout new.
	self listCentering: #center;
		 wrapCentering: #center.
	displayDate _ TransformationMorph new.
	displayDate addMorph: StringMorph new.
	displayDate rotationDegrees: 90.
	self addMorph: displayDate! !

!CalendarDate methodsFor: 'as yet unclassified' stamp: 'iho 5/21/2003 14:27'!
setDate: aDate 
	date _ aDate.
	(displayDate submorphs at: 1)
		contents: date dayOfMonth asString , '. ' , (date monthName first: 3).
"		contents: '' , (date day) asString, (date month) asString"! !


BorderedMorph subclass: #CalendarDay
	instanceVariableNames: 'date '
	classVariableNames: 'Times '
	poolDictionaries: ''
	category: 'IHO-Calendar'!

!CalendarDay methodsFor: 'as yet unclassified' stamp: 'iho 5/21/2003 19:57'!
date
	^ date! !

!CalendarDay methodsFor: 'as yet unclassified' stamp: 'iho 5/21/2003 19:13'!
entry: aString time: aTime
	| cnt |
	cnt _ 1.
	[(Times at: cnt) < aTime] whileTrue: [
		cnt _ cnt + 1.
	].
	(self submorphs at: (cnt + 1)) setText: aString.

			
		! !

!CalendarDay methodsFor: 'as yet unclassified' stamp: 'iho 5/21/2003 22:32'!
initialize
	| temp labels |
	super initialize.
	labels _ {'9:00' asTime. '11:00' asTime. '16:00' asTime. '18:00' asTime. '20:00' asTime}.
	self extent: 200 @ 100.
	self layoutPolicy: TableLayout new;
		 listDirection: #leftToRight.
	self borderWidth: 0.
	temp _ CalendarDate new.
	self addMorph: temp.
	temp hResizing: #spaceFill;
		 vResizing: #spaceFill.
	temp spaceFillWeight: 2.
	1
		to: 5
		do: [:cnt | 
			temp _ CalendarHour new.
			temp
				from: (labels at: cnt).
			self addMorphBack: temp.
			temp hResizing: #spaceFill;
				 vResizing: #spaceFill.
			temp spaceFillWeight: 1]! !

!CalendarDay methodsFor: 'as yet unclassified' stamp: 'iho 5/21/2003 17:46'!
setDate: aDate 
	date _ aDate.
	(self submorphs at: 1)
		setDate: aDate! !

!CalendarDay methodsFor: 'as yet unclassified' stamp: 'iho 5/21/2003 17:49'!
weekDay
	^ date weekdayIndex! !


Object subclass: #CalendarEntry
	instanceVariableNames: 'header dates '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'IHO-Calendar'!


BorderedMorph subclass: #CalendarHeader
	instanceVariableNames: 'date displayDate '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'IHO-Calendar'!

!CalendarHeader methodsFor: 'as yet unclassified' stamp: 'iho 5/21/2003 18:29'!
initialize
	| tmp txt labels |
	super initialize.
	self extent: 100 @ 100.
	self layoutPolicy: TableLayout new;
		 listDirection: #leftToRight.
	self borderWidth: 0.
	self hResizing: #spaceFill;
		 vResizing: #spaceFill.
	labels _ {'09'. '11'. '16'. '18'. '20'}.
	1
		to: 5
		do: [:cnt0 | 
			tmp _ BorderedMorph new.
			self addMorphBack: tmp.
			tmp borderWidth: 1.
			tmp color: Color gray.
			tmp clipSubmorphs: true.
			tmp layoutPolicy: TableLayout new.
			tmp listCentering: #center;
				 wrapCentering: #center.
			txt _ TransformationMorph new.
			txt
				addMorph: (StringMorph new
						contents: ((Week nameOfDay: cnt0) first: 3)).
			txt rotationDegrees: 90.
			tmp addMorph: txt.
			tmp hResizing: #spaceFill;
				 vResizing: #spaceFill.
			tmp spaceFillWeight: 2.
			1
				to: 5
				do: [:cnt | 
					tmp _ CalendarHour new.
					tmp
						setText: (labels at: cnt).
					self addMorphBack: tmp.
					tmp hResizing: #spaceFill;
						 vResizing: #spaceFill.
					tmp spaceFillWeight: 1]]! !


BorderedMorph subclass: #CalendarHour
	instanceVariableNames: 'from label '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'IHO-Calendar'!

!CalendarHour methodsFor: 'as yet unclassified' stamp: 'iho 5/21/2003 22:34'!
buttonClick
	self color: Color blue.
	"create the calendar entry ..."
	owner weekDay = 5
		ifTrue: ["set all Fridays times"
			owner entry: 'TEST' time: '9:00' asTime.
			owner entry: 'TEST' time: '11:00' asTime.
			owner entry: 'TEST' time: '16:00' asTime]
		ifFalse: [owner weekDay < 3
				ifTrue: ["set +2 +5 +2 +5 +2"
					self setText: 'TEST'.
					owner owner owner
						entry: 'TEST'
						date: (owner date addDays: 2)
						time: from]
				ifFalse: [self setText: 'TEST'.
					owner owner owner
						entry: 'TEST'
						date: (owner date addDays: 5)
						time: from]

]! !

!CalendarHour methodsFor: 'as yet unclassified' stamp: 'iho 5/21/2003 16:48'!
from: aTime
	from _ aTime.! !

!CalendarHour methodsFor: 'as yet unclassified' stamp: 'iho 5/21/2003 16:36'!
initialize
	super initialize.
	self borderWidth: 1.
	self color: Color white.
	self
		on: #click
		send: #buttonClick
		to: self.
	self clipSubmorphs: true.
	self layoutPolicy: TableLayout new.
	self listCentering: #center;
		 wrapCentering: #center.
	label _ TransformationMorph new.
	label addMorph: (StringMorph contents: '').
	label rotationDegrees: 90.
	self addMorph: label! !

!CalendarHour methodsFor: 'as yet unclassified' stamp: 'iho 5/21/2003 16:34'!
setText: aString 
	(label submorphs at: 1) contents: aString.
! !


BorderedMorph subclass: #CalendarWeek
	instanceVariableNames: 'firstDate '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'IHO-Calendar'!

!CalendarWeek methodsFor: 'as yet unclassified' stamp: 'iho 5/21/2003 22:26'!
contains: aDate 
	^ aDate >= firstDate
		and: [aDate
				< (firstDate addDays: 7)]! !

!CalendarWeek methodsFor: 'as yet unclassified' stamp: 'iho 5/21/2003 22:27'!
entry: aString date: aDate time: aTime 
	(self contains: aDate)
		ifFalse: [^ false].
	(submorphs at: (aDate subtractDate: firstDate)
			+ 1)
		entry: aString
		time: aTime! !

!CalendarWeek methodsFor: 'as yet unclassified' stamp: 'iho 5/21/2003 17:45'!
initialize
	| temp |
	super initialize.
	self extent: 200 @ 100.
	self borderWidth: 0.
	self layoutPolicy: TableLayout new;
		 listDirection: #leftToRight.
	1
		to: 5
		do: [:cnt | 
			temp _ CalendarDay new.
			self addMorphBack: temp.
			temp hResizing: #spaceFill;
				 vResizing: #spaceFill.
			temp spaceFillWeight: 1]! !

!CalendarWeek methodsFor: 'as yet unclassified' stamp: 'iho 5/21/2003 19:31'!
startDate: aDate 
	| tmpDate |
	firstDate _ tmpDate _ aDate.
	self submorphs
		do: [:m | 
			m setDate: tmpDate.
			tmpDate _ tmpDate addDays: 1]! !


Object subclass: #TimeSpan
	instanceVariableNames: 'from to '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'IHO-Calendar'!

!TimeSpan methodsFor: 'as yet unclassified' stamp: 'iho 5/21/2003 18:09'!
from: startTime
	from _ startTime.
! !

!TimeSpan methodsFor: 'as yet unclassified' stamp: 'iho 5/21/2003 18:09'!
from: startTime to: endTime 
	self from: startTime .
	self to: endTime.! !

!TimeSpan methodsFor: 'as yet unclassified' stamp: 'iho 5/21/2003 18:10'!
to: endTime 
	to _ endTime! !

"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

TimeSpan class
	instanceVariableNames: ''!

!TimeSpan class methodsFor: 'as yet unclassified' stamp: 'iho 5/21/2003 18:08'!
from: startTime to: endTime
	| tmp |
	tmp _ self new.
	tmp from: startTime 	to: endTime! !