
!"Pocket Smalltalk fileout - 8:18:27 PM, Friday, March 19, 1999"!


!Object constantsFor: 'PalmOS Events'!

appStopEvent 22! 
ctlEnterEvent 7! 
ctlExitEvent 8! 
ctlRepeatEvent 10! 
ctlSelectEvent 9! 
daySelectEvent 20! 
firstUserEvent 35! 
fldChangedEvent 17! 
fldEnterEvent 15! 
fldHeightChangedEvent 16! 
frmCloseEvent 28! 
frmGotoEvent 25! 
frmLoadEvent 23! 
frmOpenEvent 24! 
frmSaveEvent 27! 
frmTitleEnterEvent 29! 
frmTitleSelectEvent 30! 
frmUpdateEvent 26! 
keyDownEvent 4! 
lstEnterEvent 11! 
lstExitEvent 13! 
lstSelectEvent 12! 
menuEvent 21! 
nilEvent 0! 
penDownEvent 1! 
penMoveEvent 3! 
penUpEvent 2! 
popSelectEvent 14! 
sclEnterEvent 32! 
sclExitEvent 33! 
sclRepeatEvent 34! 
tblEnterEvent 18! 
tblExitEvent 31! 
tblSelectEvent 19! 
winEnterEvent 5! 
winExitEvent 6! !

!Object constantsFor: 'PalmOS UI Constants'!

boldRoundFrame 1794! 
dialogFrame 770! 
downDirection 1! 
halftoneFillPattern #[170 85 170 85 170 85 170 85]! 
leftDirection 2! 
noFrame 0! 
popupFrame 517! 
rightDirection 3! 
roundFrame 1025! 
simpleFrame 1! 
upDirection 0! !

Object subclass: #Application
	instanceVariableNames: 'nextToRun widgets widgetsByName widgetsByID menuActions'
	classVariableNames: ''!

Application subclass: #MiniDebugger
	instanceVariableNames: 'context contextsList localsList'
	classVariableNames: ''!

Application subclass: #PopupApplication
	instanceVariableNames: 'owner finished'
	classVariableNames: ''!

CStructure subclass: #CEvent
	instanceVariableNames: ''
	classVariableNames: 'LastEvent'!

Object subclass: #Form
	instanceVariableNames: ''
	classVariableNames: ''!

Model subclass: #FormObject
	instanceVariableNames: 'application name aspect model id'
	classVariableNames: ''!

FormObject subclass: #FormControl
	instanceVariableNames: ''
	classVariableNames: ''!

FormControl subclass: #Button
	instanceVariableNames: ''
	classVariableNames: ''!

Button subclass: #PushButton
	instanceVariableNames: ''
	classVariableNames: ''!

PushButton subclass: #Checkbox
	instanceVariableNames: ''
	classVariableNames: ''!

Button subclass: #RepeatButton
	instanceVariableNames: ''
	classVariableNames: ''!

FormControl subclass: #PopupTrigger
	instanceVariableNames: ''
	classVariableNames: ''!

FormControl subclass: #SelectorTrigger
	instanceVariableNames: ''
	classVariableNames: ''!

FormObject subclass: #FormTitle
	instanceVariableNames: ''
	classVariableNames: ''!

FormObject subclass: #Label
	instanceVariableNames: ''
	classVariableNames: ''!

FormObject subclass: #Listbox
	instanceVariableNames: ''
	classVariableNames: ''!

FormObject subclass: #Scrollbar
	instanceVariableNames: 'immediate inhibitUpdate'
	classVariableNames: ''!

FormObject subclass: #TextField
	instanceVariableNames: ''
	classVariableNames: ''!

ValueHolder subclass: #ScrollValueHolder
	instanceVariableNames: 'min max pageSize previousValue'
	classVariableNames: ''!

!Application comment!
Application is an abstract superclass implementing the application framework.  In general, each form in a Smalltalk program will correspond to one Application subclass.

Override the class-side method #formID to answer the resource ID of the form for the Application subclass.  Override #createComponents to create bindings to PalmOS widgets (using #add:id:name:aspect:) and #createMenus to create bindings to menu options (using #addMenuAction:forID:).

To launch one Application from another, send #spawn: to the running application (self) with the application instance to jump to as an argument.  Only use the class-side #show method for the top-level form.
! !


!Application methodsFor: 'control flow'!

getNextEvent
	"Answer true if event was handled by the system, false if the receiver should handle it."
	| event |
	event := CEvent waitForEvent: self eventTimeout.
	^CEvent sysHandleEvent: event.!

handleLastEvent
	| event selectors type |
	event := CEvent last.
	type := event eventType.
	selectors := self class eventHandlerSelectors.
	(selectors includesKey: type + 1)
		ifFalse: [^true].  "unknown event type!!"
	(self perform: (selectors at: type + 1)) 
		ifFalse: [CEvent formHandleEvent: event].
	^type ~~ ##frmCloseEvent.!

eventLoop
	[self getNextEvent or: [self handleLastEvent]]
		whileTrue.! !


!Application methodsFor: 'utility'!

spawn: application
	"Use this to launch one application from another, rather than Application class>>#show!!"
	nextToRun := application.
	Form gotoForm: application class formID.!

isDirty
	^(SYSTRAP FrmGetUserModifiedState: Form activeFormPointer)
		asBoolean.!

clearDirty
	SYSTRAP FrmSetNotUserModified: Form activeFormPointer.!

popup: application
	"application needs to be a PopupApplication."
	application owner: self.
	application class popupFor: self.
	! !


!Application methodsFor: 'accessing'!

nextToRun
	^nextToRun.!

nextToRun: app
	nextToRun := app.!

widgetNamed: name
	^widgetsByName at: name.!

widgetWithID: id
	^widgetsByID at: id ifAbsent: [nil].! !


!Application methodsFor: 'events'!

onPenDownAt: position
	^self.!

onOpened
	"Subclasses can override."
	^self.!

onPenUpAt: position
	^self.!

onPenMoveAt: position
	^self.!

onKeyDown: key modifiers: modifiers
	^self.!

onVirtualKeyDown: key modifiers: modifiers
	^self.! !


!Application methodsFor: 'initialization'!

initializeWidgets
	widgets do: [:each | 
		each application: self.
		each acquireModel].!

createComponents
	"Subclasses override to create form objects."
	^self.!

add: formObjectClass
id: objectID
name: objectName
aspect: objectAspect
	| object |
	object := formObjectClass new.
	object
		id: objectID
		name: objectName
		aspect: objectAspect.
	objectName ifNotNil: [
			widgetsByName at: objectName put: object].
	widgetsByID at: objectID put: object.
	widgets add: object.!

createMenus
	"Forms with menus should override this to create the menu actions (using #addMenuAction:forID:)."
	^self.!

addMenuAction: selector forID: menuID
	menuActions at: menuID put: selector.!

release
	"Sent when the application 'terminates'; i.e., when another form is activated."
	self releaseWidgets.!

releaseWidgets
	widgets do: [:each | each release].!

initialize
	widgetsByName := IdentityDictionary new.
	widgetsByID := IdentityDictionary new.
	widgets := IdentityList new.
	menuActions := IdentityDictionary new.!

create
	self createComponents.
	self createMenus.! !


!Application methodsFor: 'event handling'!

handleListEnterEvent
	^self handleControlEnterEvent.!

handleListExitEvent
	^self handleControlExitEvent.!

handleFieldEnterEvent
	^self handleControlEnterEvent.!

handleScrollbarEnterEvent
	^self handleControlEnterEvent.!

handleNilEvent
	^true.!

eventTimeout
	"May be overridden by subclasses that want to do 'polling' event loops."
	^-1.!

handleControlRepeatEvent
	^self handleControlSelectEvent.!

handleAppStopEvent
	Smalltalk exit.
	^false.!

handleDaySelectEvent
	^false.!

handleFormGotoEvent
	"only for special launch codes..."
	^false.!

handleFormLoadEvent
	Form initForm: (CEvent lastArgument: 0).
	self initializeWidgets.
	^true.!

handleWindowEnterEvent
	^false.!

handleWindowExitEvent
	^false.!

handleFormSaveEvent
	"No idea what this is for."
	^false.!

handleFieldChangedEvent
	^false.!

handleFormTitleEnterEvent
	^false.!

handleFormTitleSelectEvent
	^false.!

handleFormUpdateEvent
	"not really sure what this is supposed to do..."
	^false.!

handleFormOpenEvent
	| formPtr |
	formPtr := SYSTRAP FrmGetActiveForm.
	SYSTRAP FrmDrawForm: formPtr.
	self onOpened.
	^true.!

handlePenDownEvent
	self onPenDownAt: CEvent lastPosition.
	^false.!

handlePenMoveEvent
	self onPenMoveAt: CEvent lastPosition.
	^false.!

handlePenUpEvent
	self onPenUpAt: CEvent lastPosition.
	^false.!

handleKeyDownEvent
	| modifiers key |
	modifiers := CEvent lastArgument: 2.
	key := CEvent lastArgument: 0.
	key == 0
		ifTrue: [self 
			onVirtualKeyDown: (CEvent lastArgument: 1)
			modifiers: modifiers]
		ifFalse: [self onKeyDown: key modifiers: modifiers].
	^false.!

handleTableEnterEvent
	"Tables not implemented yet ..."
	^false.!

handleTableExitEvent
	"Tables not implemented yet ..."
	^false.!

handleTableSelectEvent
	"Tables not implemented yet ..."
	^false.!

handleMenuEvent
	| id selector |
	id := CEvent lastArgument: 0.
	selector := menuActions at: id ifAbsent: [nil].
	selector ifNotNil: [self perform: selector].
	^false.!

handleControlEnterEvent
	| control |
	control := self widgetWithID: (CEvent lastArgument: 0).
	control ifNotNil: [control changed: #entered].
	^false.!

handleControlExitEvent
	| control |
	control := self widgetWithID: (CEvent lastArgument: 0).
	control ifNotNil: [control changed: #exited].
	^false.!

handleControlSelectEvent
	| id control |
	id := CEvent lastArgument: 0.
	control := self widgetWithID: id.
	control ifNotNil: [
		control onSelected.
		control changed: #selected].
	^false.!

handleFieldHeightChangedEvent
	| control |
	control := self widgetWithID: (CEvent lastArgument: 0).
	control ifNotNil: [control changed: #height].
	^false.!

handleListSelectEvent
	| id control |
	id := CEvent lastArgument: 0.
	control := self widgetWithID: id.
	control ifNotNil: [
		control onSelected: (CEvent lastArgument: 3) + 1.
		control changed: #selected].
	^false.!

handleScrollbarExitEvent
	| control  |
	control := self widgetWithID: (CEvent lastArgument: 0).
	control ifNotNil: [
		control immediate ifFalse: [
			control
				scrollTo: (CEvent lastArgument: 4)
				oldValue: (CEvent lastArgument: 3)].
		control changed: #exited].
	^false.!

handleScrollbarRepeatEvent
	| control  |
	control := self widgetWithID: (CEvent lastArgument: 0).
	control ifNotNil: [
		control immediate ifTrue: [
			control
				scrollTo: (CEvent lastArgument: 4)
				oldValue: (CEvent lastArgument: 3)]].
	^false.!

handleFormCloseEvent
	self release.
	^false.  "let PalmOS clean up"!

handlePopSelectEvent
	"Send it to the list object, not the popup trigger."
	| id control |
	id := CEvent lastArgument: 3.
	control := self widgetWithID: id.
	control ifNotNil: [
		control onSelected: (CEvent lastArgument: 6) + 1.
		control changed: #selected].
	^true.! !


!Application class methodsFor: 'accessing'!

formID
	^self subclassResponsibility.!

eventHandlerSelectors
	^#(handleNilEvent handlePenDownEvent handlePenUpEvent handlePenMoveEvent handleKeyDownEvent handleWindowEnterEvent handleWindowExitEvent handleControlEnterEvent handleControlExitEvent handleControlSelectEvent handleControlRepeatEvent handleListEnterEvent handleListSelectEvent handleListExitEvent handlePopSelectEvent handleFieldEnterEvent handleFieldHeightChangedEvent handleFieldChangedEvent handleTableEnterEvent handleTableSelectEvent handleDaySelectEvent handleMenuEvent handleAppStopEvent handleFormLoadEvent handleFormOpenEvent handleFormGotoEvent handleFormUpdateEvent handleFormSaveEvent handleFormCloseEvent handleFormTitleEnterEvent handleFormTitleSelectEvent handleTableExitEvent handleScrollbarEnterEvent handleScrollbarExitEvent handleScrollbarRepeatEvent).! !


!Application class methodsFor: 'instance creation'!

new
	^super new initialize.! !


!Application class methodsFor: 'utility'!

show
	^self showFor: self new.!

popup
	^self popupFor: self new.!

consumeExcessEvents
	| event |
	[event := CEvent waitForEvent: -1.
	 CEvent sysHandleEvent: event.
	 event eventType == ##frmLoadEvent] whileFalse.!

popupFor: instance
	SYSTRAP FrmPopupForm: self formID.
	instance create.
	instance eventLoop.!

showFor: instance
	| temp |
	Form gotoForm: self formID.
	[instance isNil] whileFalse: [
		self consumeExcessEvents.
		instance create.
		instance handleLastEvent.
		instance eventLoop.
		temp := instance nextToRun.
		instance nextToRun: nil.  "clear forward reference"
		"Note: hard assignment is used here to avoid keeping a perpetual reference to the first shown application...this is one of the few places where ::= is actually required"
		instance ::= temp].! !


!MiniDebugger methodsFor: 'initialization'!

context: contextIndex
	context := contextIndex.!

initialize
	super initialize.
	contextsList := ListModel list: #().
	localsList := ListModel list: #().
	contextsList addDependent: self.!

initializeWidgets
	super initializeWidgets.
	self fillContextList.
	self updateLocalVariables.!

createComponents
	super createComponents.
	self
		add: Listbox
		id: 3000
		name: #contextsList
		aspect: #contextsList.
	self
		add: Listbox
		id: 3001
		name: #localsList
		aspect: #localsList.
	self
		add: Button
		id: 3002
		name: nil
		aspect: #exitSmalltalk.
	self
		add: Button
		id: 3003
		name: nil
		aspect: #showFreeMemory.!

fillContextList
	contextsList list: (Context allContextsFrom: context).
	contextsList selectionIndex: 1.! !


!MiniDebugger methodsFor: 'updating'!

update: aspect with: parameter from: object
	(object == contextsList and: [aspect == #selection])
		ifTrue: [self updateLocalVariables].!

updateLocalVariables
	| context |
	context := contextsList selection.
	context ifNotNil: [
		localsList list: context localVariableDescriptions].! !


!MiniDebugger methodsFor: 'actions'!

exitSmalltalk
	Smalltalk exit.!

showFreeMemory
	| mem |
	mem := Smalltalk freeMemory.
	Window
		drawString: 'ST: ', mem printString, '    '
		x: 86
		y: 142.
	Window
		drawString: 'PalmOS: ', PalmOS freeMemory printString, '    '
		x: 86
		y: 151.! !


!MiniDebugger methodsFor: 'aspects'!

localsList
	^localsList.!

contextsList
	^contextsList.! !


!MiniDebugger class methodsFor: 'accessing'!

formID
	^2050.! !


!MiniDebugger class methodsFor: 'utility'!

debug
	| context instance |
	ErrorInProgress := true.
	context := thisContext - 1.
	instance := self new context: context.
	^self popupFor: instance.! !


!PopupApplication methodsFor: 'initialization'!

initialize
	super initialize.
	finished := false.! !


!PopupApplication methodsFor: 'control flow'!

handleLastEvent
	^super handleLastEvent and: [finished not].!

leave
	finished ifFalse: [
		finished := true.
		Form returnToForm: self owner class formID].! !


!PopupApplication methodsFor: 'accessing'!

owner
	^owner.!

owner: newOwner
	owner := newOwner.! !


!CEvent methodsFor: 'accessing'!

eventType
	^pointer wordAt: 0.!

isPenDown
	^(pointer wordAt: 2) asBoolean.!

screenX
	^pointer wordAt: 4.!

screenY
	^pointer wordAt: 6.!

argument: n
	"n is 0..7"
	^pointer wordAt: 8 + (n * 2).! !


!CEvent class methodsFor: 'event handling'!

sysHandleEvent: event
	"Try system and menu event handling.  Answer whether the event was completely handled."
	(SYSTRAP SysHandleEvent: event pointer) asBoolean
		ifTrue: [^true].
	^(SYSTRAP 
		MenuHandleEvent: SYSTRAP MenuGetActiveMenu
		eventP: event pointer
		err: PadBuffer) asBoolean.
	!

waitForEvent: eventTimeout
	"Answer true if the event was handled completely, false if the application should try handling it."
	| event |
	event := self last.
	SYSTRAP EvtGetEvent: event pointer timeout: eventTimeout.
	^event.
	!

formHandleEvent: event
	^(SYSTRAP
		FrmHandleEvent: Form activeFormPointer
		event: event pointer) asBoolean.! !


!CEvent class methodsFor: 'accessing'!

sizeInBytes
	^24.!

last
	LastEvent ifNil: [LastEvent := self new].
	^LastEvent.!

lastArgument: index
	^LastEvent argument: index.!

lastPosition
	^LastEvent screenX @ LastEvent screenY.! !


!Form class methodsFor: 'utility'!

gotoForm: id
	SYSTRAP FrmGotoForm: id.!

help: helpID
	SYSTRAP FrmHelp: helpID.!

deleteActiveForm
	| formPtr |
	formPtr := SYSTRAP FrmGetActiveForm.
	SYSTRAP FrmEraseForm: formPtr.
	SYSTRAP FrmDeleteForm: formPtr.!

redraw
	| formPtr |
	formPtr := SYSTRAP FrmGetActiveForm.
	SYSTRAP FrmEraseForm: formPtr.
	SYSTRAP FrmDrawForm: formPtr.!

alert: alertID
	^SYSTRAP FrmAlert: alertID.!

notify: message
	^self
		customAlert: 2020
		message: message displayString.!

getControlPointer: controlID
	"Answer a CPointer to the control structure with the given ID.  Always uses the active form."
	| formPtr index |
	formPtr := SYSTRAP FrmGetActiveForm.
	index := SYSTRAP FrmGetObjectIndex: formPtr id: controlID.
	^SYSTRAP FrmGetObjectPtr: formPtr index: index.!

activeFormPointer
	^SYSTRAP FrmGetActiveForm.!

initForm: formID
	| formPtr |
	formPtr := SYSTRAP FrmInitForm: formID.
	SYSTRAP FrmSetActiveForm: formPtr.
	!

customAlert: alertID message: message
	| string |
	string := message copyToHeap.
	SYSTRAP 
		FrmCustomAlert: alertID
		with: string
		with: CPointer null
		with: CPointer null.
	string free.!

dialog: formID
	"Answers the index of the button pressed."
	| formPtr result |
	formPtr := SYSTRAP FrmInitForm: formID.
	result := SYSTRAP FrmDoDialog: formPtr.
	SYSTRAP FrmDeleteForm: formPtr.
	^result.!

returnToForm: formID
	^SYSTRAP FrmReturnToForm: formID.! !


!FormObject methodsFor: 'utility'!

hide
	SYSTRAP 
		FrmHideObject: Form activeFormPointer
		index: self index.!

show
	SYSTRAP 
		FrmShowObject: Form activeFormPointer
		index: self index.! !


!FormObject methodsFor: 'updating'!

update: aspect with: parameter from: object
	object == model
		ifTrue: [^self updateFromModel].!

updateFromModel
	"Take the model's value and put it in the PalmOS widget."
	^self subclassResponsibility.!

updateModel
	"Take the contents of the PalmOS widget and update the model."
	^self subclassResponsibility.! !


!FormObject methodsFor: 'predicates'!

usesModel
	^true.! !


!FormObject methodsFor: 'accessing'!

aspect
	^aspect.!

model
	^model.!

id
	^id.!

name
	^name.!

application: owner
	application := owner.!

application
	^application.!

getPointer
	^Form getControlPointer: id.!

index
	^SYSTRAP 
		FrmGetObjectIndex: Form activeFormPointer
		id: id.! !


!FormObject methodsFor: 'events'!

onModelChanged
	^self.! !


!FormObject methodsFor: 'initialization'!

acquireModel
	aspect ifNotNil: [
		self usesModel ifTrue: [self reallyAcquireModel]].!

id: newID name: newName aspect: newAspect
	id := newID.
	name := newName.
	aspect := newAspect.!

releaseDynamicMemory
	^self.!

release
	self releaseDynamicMemory.
	model isNil ifFalse: [
		model removeDependent: self].!

reallyAcquireModel	
	"If the aspect is an array, send the first element as a selector and the second as an argument."
	model := aspect class == Array
		ifTrue: [
			application 
				perform: aspect first
				with: (aspect at: 2)]
		ifFalse: [application perform: aspect].
	model addDependent: self.! !


!FormControl methodsFor: 'actions'!

push
	"Simulate a button push."
	SYSTRAP CtlHitControl: self getPointer.!

onSelected
	aspect ifNotNil: [
		"If the aspect is an array, send the first element as a selector and the second as an argument."
		aspect class == Array
			ifTrue: [
				application 
					perform: aspect first
					with: (aspect at: 2)]
			ifFalse: [application perform: aspect]].! !


!FormControl methodsFor: 'predicates'!

isEnabled
	^(SYSTRAP CtlEnabled: self getPointer) asBoolean.!

usesModel
	^false.! !


!FormControl methodsFor: 'accessing'!

label
	^(SYSTRAP CtlGetLabel: self getPointer) 
		extractCString.!

label: string freePrevious: freePrevious
	"If freePrevious is true, the previous label string is freed (MemPtrFree)."
	| pointer prevStringPtr stringPtr |
	pointer := self getPointer.
	prevStringPtr := SYSTRAP CtlGetLabel: pointer.
	stringPtr := string copyToHeap.
	SYSTRAP CtlSetLabel: pointer string: stringPtr.
	freePrevious ifTrue: [
		prevStringPtr isNull ifFalse: [prevStringPtr free]].!

enabled: boolean
	SYSTRAP 
		CtlSetEnabled: self getPointer 
		to: boolean asInteger.!

usable: boolean
	SYSTRAP 
		CtlSetUsable: self getPointer 
		to: boolean asInteger.! !


!FormControl methodsFor: 'utility'!

hide
	SYSTRAP CtlHideControl: self getPointer.!

show
	SYSTRAP CtlShowControl: self getPointer.!

erase
	SYSTRAP CtlEraseControl: self getPointer.!

draw
	SYSTRAP CtlDrawControl: self getPointer.! !


!PushButton methodsFor: 'initialization'!

reallyAcquireModel
	super reallyAcquireModel.
	self updateFromModel.! !


!PushButton methodsFor: 'updating'!

updateFromModel
	| val |
	model ifNotNil: [
		val := model value.
		(val == true or: [val == false]) ifTrue: [
			SYSTRAP CtlSetValue: self getPointer to: val asInteger]].!

updateModel
	model ifNotNil: [
		model value: 
			(SYSTRAP CtlGetValue: self getPointer) asBoolean].! !


!PushButton methodsFor: 'actions'!

onSelected
	self updateModel.
	^super onSelected.! !


!PushButton methodsFor: 'predicates'!

usesModel
	^true.! !


!Label methodsFor: 'accessing'!

label
	| formPtr |
	formPtr := Form activeFormPointer.
	^(SYSTRAP FrmGetLabel: formPtr labelID: id)
		extractCString.!

label: string
	"BE CAREFUL when using this method: the new label string must not be longer than the string defined in the label resource, or PalmOS will overwrite memory!!"
	| formPtr index stringPtr |
	formPtr := Form activeFormPointer.
	index := SYSTRAP FrmGetObjectIndex: formPtr id: id.
	stringPtr := string copyToHeap.
	SYSTRAP FrmHideObject: formPtr index: index.
	SYSTRAP FrmCopyLabel: formPtr id: id newLabel: stringPtr.
	SYSTRAP FrmShowObject: formPtr index: index.
	stringPtr free.! !


!Listbox methodsFor: 'initialization'!

reallyAcquireModel
	super reallyAcquireModel.
	model ifNotNil: [
		self
			primSetListChoices: self listStrings
			controlID: id
			freeVisibleItems: false].!

releaseDynamicMemory
	"This tells C to zorch the existing list..."
	model ifNotNil: [
		self
			primSetListChoices: nil
			controlID: id
			freeVisibleItems: true].! !


!Listbox methodsFor: 'events'!

onSelected: index
	model selectionIndex: index.! !


!Listbox methodsFor: 'updating'!

updateListFromModel
	self
		primSetListChoices: self listStrings
		controlID: id
		freeVisibleItems: true.!

update: aspect with: parameter from: object
	object == model ifTrue: [
		(aspect == #list or: [aspect == #element])
			ifTrue: [
				self updateListFromModel.
				^self updateModelFromSelection].
		aspect == #selection
			ifTrue: [^self updateSelectionFromModel]].!

updateSelectionFromModel
	| index |
	index := model selectionIndex.
	self setSelectionIndex: ((index isNil or: [index <= 0])
		ifTrue: [-1] ifFalse: [index - 1]).!

updateModelFromSelection
	| index |
	model ifNotNil: [
		index := SYSTRAP LstGetSelection: self getPointer.
		model selectionIndex: (index >= 65535
			ifTrue: [0]
			ifFalse: [index])].! !


!Listbox methodsFor: 'private'!

setSelectionIndex: index
	| listPtr |
	listPtr := self getPointer.
	SYSTRAP LstSetSelection: listPtr index: index.
	SYSTRAP LstMakeItemVisible: listPtr index: index.!

listStrings
	^(model list collect: [:each | each displayString]) asArray.!

primSetListChoices: choices
controlID: controlID
freeVisibleItems: boolean
	<primitive: 100>
	^self primitiveFailed.! !


!Scrollbar comment!
If 'immediate' is true, the scroll value is continuously updated as the user holds the pen down.  If it is false, the scroll value is updated once, when the pen is lifted.! !


!Scrollbar methodsFor: 'initialization'!

reallyAcquireModel
	super reallyAcquireModel.
	self updateFromModel.!

initialize
	inhibitUpdate := false.
	immediate := true.! !


!Scrollbar methodsFor: 'updating'!

updateFromModel
	inhibitUpdate ifTrue: [^self].
	SYSTRAP
		SclSetScrollBar: self getPointer
		value: model value
		min: model min
		max: model max
		pageSize: model pageSize.!

scrollTo: value oldValue: oldValue
	inhibitUpdate := true.
	model
		previousValue: oldValue;
		value: value.
	inhibitUpdate := false.! !


!Scrollbar methodsFor: 'accessing'!

immediate
	^immediate.! !


!Scrollbar class methodsFor: 'instance creation'!

new
	^super new initialize.! !


!TextField methodsFor: 'utility'!

selectFrom: start to: stop
	SYSTRAP
		FldSetSelection: self getPointer
		start: start
		stop: stop.!

deleteFrom: start to: stop
	SYSTRAP
		FldDelete: self getPointer
		start: start
		stop: stop.!

undo
	SYSTRAP FldUndo: self getPointer.!

scrollTo: position
	"Set string index 'position' as the first character in the first line of the field."
	SYSTRAP FldSetScrollPosition: self getPointer to: position.!

insertionPoint: position
	"Set the insertion point to the given index."
	SYSTRAP FldSetInsPtPosition: self getPointer to: position.!

scroll: lines direction: direction
	"direction must be ##upDirection or ##downDirection."
	SYSTRAP
		FldScrollField: self getPointer
		lines: lines
		direction: direction.!

releaseFocus
	SYSTRAP FldReleaseFocus: self getPointer.!

paste
	SYSTRAP FldPaste: self getPointer.!

beFullyVisible
	SYSTRAP FldMakeFullyVisible: self getPointer.!

insert: string
	"Answer whether the string was successfully inserted."
	^(SYSTRAP
		FldInsert: self getPointer
		insertChars: string
		insertLen: string size) asBoolean.!

grabFocus
	SYSTRAP FldGrabFocus: self getPointer.!

cut
	SYSTRAP FldCut: self getPointer.!

copySelection
	"Don't confuse this with #copy, the Smalltalk object copy method."
	SYSTRAP FldCopy: self getPointer.!

compact
	SYSTRAP FldCompactText: self getPointer.! !


!TextField methodsFor: 'updating'!

updateModel
	model ifNotNil: [model value: self getFieldText].!

updateFromModel
	model ifNotNil: [
		self 
			setFieldText: self textForField
			redraw: true].! !


!TextField methodsFor: 'accessing'!

font
	^SYSTRAP FldGetFont: self getPointer.!

font: fontID
	SYSTRAP FldSetFont: self getPointer to: fontID.!

usable: boolean
	SYSTRAP FldSetUsable: self getPointer to: boolean asInteger.!

maxChars: count
	SYSTRAP FldSetMaxChars: self getPointer to: count.!

isDirty
	^(SYSTRAP FldDirty: self getPointer) asBoolean.!

isDirty: boolean
	SYSTRAP FldSetDirty: self getPointer to: boolean asInteger.!

bounds: newBounds
	| rect |
	rect := CRectangle buffer.
	rect copyFromRectangle: newBounds.
	SYSTRAP FldSetBounds: self getPointer to: rect.!

isScrollable: direction
	"direction is ##upDirection or ##downDirection."
	^(SYSTRAP FldScrollable: self getPointer direction: direction) asBoolean.!

visibleLines
	^SYSTRAP FldGetVisibleLines: self getPointer.!

scrollPosition
	^SYSTRAP FldGetScrollPosition: self getPointer.!

scrollPosition: position
	SYSTRAP FldSetScrollPosition: self getPointer to: position.!

maxChars
	^SYSTRAP FldGetMaxChars: self getPointer.!

bounds
	| rect |
	rect := CRectangle buffer.
	SYSTRAP FldGetBounds: self getPointer rectangle: rect.
	^rect asSmalltalkRectangle.!

selectionRange
	| startPad endPad interval |
	startPad := PadBuffer.
	endPad := CPointer newPad.
	SYSTRAP
		FldGetSelection: self getPointer
		start: startPad
		end: endPad.
	interval := (startPad wordAt: startPad) to: (endPad wordAt: endPad).
	endPad free.
	^interval.! !


!TextField methodsFor: 'initialization'!

reallyAcquireModel
	super reallyAcquireModel.
	model ifNotNil: [
		self 
			setFieldText: self textForField
			redraw: false].! !


!TextField methodsFor: 'private'!

textForField
	^model value displayString.!

getFieldText
	| fieldPtr len handle textPtr string |
	fieldPtr := self getPointer.
	len := SYSTRAP FldGetTextLength: fieldPtr.
	handle := SYSTRAP FldGetTextHandle: fieldPtr.
	string := String new: len.
	textPtr := handle lock.
	SYSTRAP MemMove: string from: textPtr bytes: len.
	handle unlock.
	^string.!

setFieldText: string redraw: redraw
	| fieldPtr handle oldHandle ptr |
	fieldPtr := self getPointer.
	handle := CPointer allocateMovableChunk: string basicSize + 1.
	ptr := handle lock.
	SYSTRAP MemMove: ptr from: string bytes: string basicSize.
	ptr byteAt: string basicSize put: 0.
	handle unlock.
	oldHandle := SYSTRAP FldGetTextHandle: fieldPtr.
	SYSTRAP FldSetTextHandle: fieldPtr handle: handle.
	oldHandle isNull ifFalse: [oldHandle freeHandle].
	redraw ifTrue: [SYSTRAP FldDrawField: fieldPtr].! !


!ScrollValueHolder methodsFor: 'accessing'!

min
	^min.!

max	
	^max.!

pageSize
	^pageSize.!

max: n
	max == n ifFalse: [
		max := n.
		self changed: #limits].!

min: n
	min == n ifFalse: [
		min := n.
		self changed: #limits].!

pageSize: n
	pageSize == n ifFalse: [
		pageSize := n.
		self changed: #limits].!

previousValue
	^previousValue.!

previousValue: val
	previousValue := val.
	"no dependency event"!

value: newValue
	| val |
	val := newValue class == String
		ifTrue: [Integer fromString: newValue]
		ifFalse: [newValue].
	val class == SmallInteger ifFalse: [val := 0].
	^super value: ((val max: min) min: max).! !


!Object methodsFor: 'error handling'!

error: info
	| message |
	message := info class == SmallInteger
		ifTrue: ['#', (Context textOfSymbol: info)]
		ifFalse: [info displayString].
	Smalltalk runningOnDevice
		ifTrue: [
			ErrorInProgress == true  "do not 'fix' this..."
				ifTrue: [self basicError: message]
				ifFalse: [
					Form notify: 'Error: ', message displayString.
					MiniDebugger debug]]
		ifFalse: [self basicError: message].! !


