home *** CD-ROM | disk | FTP | other *** search
/ BURKS 2 / BURKS_AUG97.ISO / BURKS / LANGUAGE / SMALTALK / TEXTBOOK / AP19.ST (.txt) < prev    next >
Text File  |  1997-04-22  |  13KB  |  486 lines
  1.  
  2. 'Smalltalk Textbook Appendix 19'!
  3.  
  4.  
  5.  
  6.  
  7.  
  8. View subclass: #EngiCalendarView
  9.     instanceVariableNames: 'frames '
  10.     classVariableNames: ''
  11.     poolDictionaries: ''
  12.     category: 'Engi-Calendar'!
  13. EngiCalendarView comment:
  14. '
  15.  
  16. Engi 0.06 (19 March 1994)
  17. Copyright (C) 1994 by Atsushi Aoki
  18.  
  19. '!
  20.  
  21.  
  22. !EngiCalendarView methodsFor: 'accessing'!
  23.  
  24. frames
  25.     ^frames! !
  26.  
  27. !EngiCalendarView methodsFor: 'controller accessing'!
  28.  
  29. defaultControllerClass
  30.     ^EngiCalendarController! !
  31.  
  32. !EngiCalendarView methodsFor: 'displaying'!
  33.  
  34. displayBox: aRectangle on: aGraphicsContext bool: aBoolean 
  35.     | box gc |
  36.     box := aRectangle insetBy: (0 @ 0 corner: 1 @ 1).
  37.     gc := aGraphicsContext copy.
  38.     aBoolean = true
  39.         ifTrue: [gc paint: (ColorValue brightness: 0.25)]
  40.         ifFalse: [gc paint: (ColorValue brightness: 0.75)].
  41.     gc displayLineFrom: box bottomLeft to: box bottomRight.
  42.     gc displayLineFrom: box topRight to: box bottomRight.
  43.     aBoolean = true
  44.         ifTrue: [gc paint: (ColorValue brightness: 0.75)]
  45.         ifFalse: [gc paint: (ColorValue brightness: 0.25)].
  46.     gc displayLineFrom: box topLeft to: box topRight.
  47.     gc displayLineFrom: box topLeft to: box bottomLeft!
  48.  
  49. displayOn: aGraphicsContext 
  50.     | width height today x y box para rect j i |
  51.     frames := OrderedCollection new.
  52.     width := self bounds width / 7.
  53.     height := self bounds height / 7.
  54.     today := Date today.
  55.     x := width * 1.
  56.     y := 0.
  57.     box := x @ y extent: width @ height.
  58.     para := self model yearIndex printString asComposedText.
  59.     rect := para bounds align: para bounds center with: box center.
  60.     para displayOn: aGraphicsContext at: rect origin rounded.
  61.     frames add: (box merge: rect) rounded -> #year.
  62.     x := width * 3.
  63.     y := 0.
  64.     box := x @ y extent: width @ height.
  65.     para := self model monthIndex printString asComposedText.
  66.     rect := para bounds align: para bounds center with: box center.
  67.     para displayOn: aGraphicsContext at: rect origin rounded.
  68.     frames add: (box merge: rect) rounded -> #month.
  69.     x := 0.
  70.     y := height * 1.
  71.     self model weekDayNames
  72.         do: 
  73.             [:each | 
  74.             box := x @ y extent: width @ height.
  75.             para := each asComposedText.
  76.             rect := para bounds align: para bounds center with: box center.
  77.             para displayOn: aGraphicsContext at: rect origin rounded.
  78.             x := x + width].
  79.     y := height * 2.
  80.     j := 1.
  81.     self model calendarMatrix
  82.         do: 
  83.             [:week | 
  84.             x := 0.
  85.             i := 1.
  86.             week
  87.                 do: 
  88.                     [:each | 
  89.                     each isNil
  90.                         ifFalse: 
  91.                             [box := x @ y extent: width @ height.
  92.                             para := each printString asComposedText.
  93.                             rect := para bounds align: para bounds center with: box center.
  94.                             para displayOn: aGraphicsContext at: rect origin rounded.
  95.                             ((self model yearIndex = today year and: [self model monthIndex = today monthIndex])
  96.                                 and: [each = today dayOfMonth])
  97.                                 ifTrue: [self
  98.                                         displayBox: (box merge: rect)
  99.                                         on: aGraphicsContext
  100.                                         bool: true].
  101.                             frames add: (box merge: rect) rounded -> (i @ j)].
  102.                     x := x + width.
  103.                     i := i + 1].
  104.             y := y + height.
  105.             j := j + 1]! !
  106. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  107.  
  108. EngiCalendarView class
  109.     instanceVariableNames: ''!
  110.  
  111.  
  112. !EngiCalendarView class methodsFor: 'instance creation'!
  113.  
  114. openOn: calendarModel 
  115.     | calendarView edgeDecorator openRectangle topWindow |
  116.     calendarView := self model: calendarModel.
  117.     edgeDecorator := LookPreferences edgeDecorator on: calendarView.
  118.     edgeDecorator noMenuBar.
  119.     edgeDecorator noVerticalScrollBar.
  120.     edgeDecorator noHorizontalScrollBar.
  121.     openRectangle := Point zero extent: 30 * 7 @ (20 * 7).
  122.     topWindow := ScheduledWindow
  123.                 model: nil
  124.                 label: 'Calendar'
  125.                 minimumSize: openRectangle extent.
  126.     topWindow component: edgeDecorator.
  127.     topWindow open! !
  128.  
  129.  
  130.  
  131.  
  132.  
  133. ControllerWithMenu subclass: #EngiCalendarController
  134.     instanceVariableNames: 'today '
  135.     classVariableNames: 'CalendarMenu '
  136.     poolDictionaries: ''
  137.     category: 'Engi-Calendar'!
  138. EngiCalendarController comment:
  139. '
  140.  
  141. Engi 0.06 (19 March 1994)
  142. Copyright (C) 1994 by Atsushi Aoki
  143.  
  144. '!
  145.  
  146.  
  147. !EngiCalendarController methodsFor: 'initialize-release'!
  148.  
  149. initialize
  150.     super initialize.
  151.     today := Date today! !
  152.  
  153. !EngiCalendarController methodsFor: 'control defaults'!
  154.  
  155. controlActivity
  156.     today = Date today
  157.         ifFalse: 
  158.             [today := Date today.
  159.             self view clearInside.
  160.             self view displayOn: self view graphicsContext].
  161.     (self sensor redButtonPressed and: [self viewHasCursor])
  162.         ifTrue: [^self redButtonActivity].
  163.     (self sensor yellowButtonPressed and: [self viewHasCursor])
  164.         ifTrue: [^self yellowButtonActivity]!
  165.  
  166. redButtonActivity
  167.     | point pair box |
  168.     point := self sensor cursorPoint.
  169.     pair := self view frames detect: [:assoc | assoc key containsPoint: point]
  170.                 ifNone: [nil].
  171.     pair isNil ifTrue: [^nil].
  172.     box := pair key.
  173.     self view
  174.         displayBox: box
  175.         on: self view graphicsContext
  176.         bool: false.
  177.     [self sensor anyButtonPressed and: [box containsPoint: self sensor cursorPoint]] whileTrue.
  178.     self view invalidateRectangle: box repairNow: true.
  179.     (box containsPoint: self sensor cursorPoint)
  180.         ifFalse: [^nil].
  181.     ^pair!
  182.  
  183. yellowButtonActivity
  184.     | pair selection |
  185.     pair := self redButtonActivity.
  186.     pair isNil
  187.         ifTrue: 
  188.             [CalendarMenu notNil
  189.                 ifTrue: 
  190.                     [selection := CalendarMenu startUp.
  191.                     selection ~= 0 ifTrue: [^self model perform: selection]].
  192.             ^nil].
  193.     pair value = #year ifTrue: [^self model changeYear].
  194.     pair value = #month ifTrue: [^self model changeMonth].
  195.     ^self model spawnDay: pair value! !
  196. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  197.  
  198. EngiCalendarController class
  199.     instanceVariableNames: ''!
  200.  
  201.  
  202. !EngiCalendarController class methodsFor: 'class initialization'!
  203.  
  204. initialize
  205.     "EngiCalendarController initialize."
  206.  
  207.     CalendarMenu := PopUpMenu
  208.                 labelArray: #('new' 'open' 'save' )
  209.                 lines: #(2 )
  210.                 values: #(#newCalendar #openCalendar #saveCalendar )! !
  211.  
  212.  
  213.  
  214.  
  215.  
  216. Model subclass: #EngiCalendarModel
  217.     instanceVariableNames: 'monthIndex yearIndex calendarMatrix memoDictionary '
  218.     classVariableNames: 'MonthNames WeekDayNames '
  219.     poolDictionaries: ''
  220.     category: 'Engi-Calendar'!
  221. EngiCalendarModel comment:
  222. '
  223.  
  224. Engi 0.06 (19 March 1994)
  225. Copyright (C) 1994 by Atsushi Aoki
  226.  
  227. '!
  228.  
  229.  
  230. !EngiCalendarModel methodsFor: 'accessing'!
  231.  
  232. calendarMatrix
  233.     ^calendarMatrix!
  234.  
  235. memoDictionary
  236.     memoDictionary isNil ifTrue: [memoDictionary := Dictionary new].
  237.     ^memoDictionary!
  238.  
  239. monthIndex
  240.     ^monthIndex!
  241.  
  242. monthNames
  243.     ^MonthNames!
  244.  
  245. weekDayNames
  246.     ^WeekDayNames!
  247.  
  248. yearIndex
  249.     ^yearIndex! !
  250.  
  251. !EngiCalendarModel methodsFor: 'copying'!
  252.  
  253. postCopy
  254.     | dictionary |
  255.     super postCopy.
  256.     dictionary := Dictionary new.
  257.     memoDictionary associationsDo: [:assoc | dictionary add: assoc key copy -> assoc value copy].
  258.     memoDictionary := dictionary! !
  259.  
  260. !EngiCalendarModel methodsFor: 'menu messages'!
  261.  
  262. changeMonth
  263.     | menu index |
  264.     menu := PopUpMenu labelArray: ((1 to: 12)
  265.                     collect: [:each | each printString]).
  266.     menu selection: self monthIndex.
  267.     index := menu startUp.
  268.     index = 0 ifTrue: [^nil].
  269.     self month: index year: self yearIndex!
  270.  
  271. changeYear
  272.     | answer year |
  273.     answer := self yearIndex printString.
  274.     answer := EngiTextModel request: 'Please enter year.' default: answer.
  275.     (answer isNil or: [answer isEmpty])
  276.         ifTrue: [^nil].
  277.     year := Compiler evaluate: answer logged: false.
  278.     self month: self monthIndex year: year!
  279.  
  280. newCalendar
  281.     EngiCalendarView openOn: self class new!
  282.  
  283. openCalendar
  284.     | fileName fileStream binaryObjectStorage readBlockClosure className calendarModel |
  285.     fileName := EngiTextModel request: 'file name?'.
  286.     (fileName isNil or: [fileName isEmpty])
  287.         ifTrue: [^nil].
  288.     (self class errorSignal
  289.         handle: 
  290.             [:exception | 
  291.             Transcript cr; show: 'file not found'.
  292.             exception returnWith: nil]
  293.         do: [fileStream := fileName asFilename readStream]) isNil ifTrue: [^nil].
  294.     (self class errorSignal
  295.         handle: 
  296.             [:exception | 
  297.             Transcript cr; show: 'can not read boss'.
  298.             exception returnWith: nil]
  299.         do: [binaryObjectStorage := BinaryObjectStorage onOldNoScan: fileStream]) isNil ifTrue: [^nil].
  300.     readBlockClosure := 
  301.             [className := binaryObjectStorage next.
  302.             className = self class name ifTrue: [calendarModel := binaryObjectStorage next]].
  303.     Cursor read showWhile: [[readBlockClosure value]
  304.             valueNowOrOnUnwindDo: [binaryObjectStorage close]].
  305.     className = self class name ifFalse: [^nil].
  306.     EngiCalendarView openOn: calendarModel.
  307.     ^calendarMod