Squeak Help System

Edgar J. De Cleene edgardec2001 at yahoo.com.ar
Mon Sep 25 13:55:12 UTC 2006


To all what are working on Squeak Beginners Tutorial and Squeak
Documentation Project

I have this old idea of centralized Help system
http://minnow.cc.gatech.edu/squeak/3895, what I start and don't complete

Now I figure how have save and load again a compressed ReferenceStream , for
having some very small for storing and download.

If you file the attached in ANY Squeak, could see typing in Workspace

| stream unzipped |
stream  := (HTTPSocket httpGet:
'http://squeakros.atspace.com/SqueakBooks/Julio2005.shc').
stream binary.
stream reset.
unzipped := (GZipReadStream on: stream) upToEnd.
MiStack reloadMeFromDisk: unzipped asString.

I hope this could be useful to some.
I volunteer to assist to any what wish do step by step tutorial of how build
this kind of stuff

-------------- next part --------------
BorderedMorph subclass: #InsideSelectionMorph
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'HyperCardNostalgia'!

!InsideSelectionMorph methodsFor: 'miscellaneous' stamp: 'EDC 10/8/2002 07:02'!
deSelect
	| acambiar |
	acambiar _ submorphs
				collect: [:each | each].
	self delete.
	acambiar do: [:each | each openInWorld].! !


!InsideSelectionMorph methodsFor: 'layout-properties' stamp: 'di 8/31/2000 22:29'!
addHandlesTo: aHaloMorph box: box
	| onlyThese |
	aHaloMorph haloBox: box.
	onlyThese _ #(addDismissHandle: addMenuHandle: addGrabHandle: addDragHandle: addDupHandle: addHelpHandle: addGrowHandle: addFontSizeHandle: addFontStyleHandle: addFontEmphHandle: addRecolorHandle:).
	Preferences haloSpecifications do:
		[:aSpec | (onlyThese includes: aSpec addHandleSelector) ifTrue:
				[aHaloMorph perform: aSpec addHandleSelector with: aSpec]].
	aHaloMorph innerTarget addOptionalHandlesTo: aHaloMorph box: box! !

!InsideSelectionMorph methodsFor: 'layout-properties' stamp: 'di 8/31/2000 22:59'!
addOptionalHandlesTo: aHalo box: box
	aHalo addHandleAt: box leftCenter color: Color blue icon: nil
		on: #mouseUp send: #addOrRemoveItems: to: self.! !

!InsideSelectionMorph methodsFor: 'layout-properties' stamp: 'edc 8/13/2004 06:54'!
addOrRemoveItems: handOrEvent 
	"Make a new selection extending the current one."
	| oldOwner hand |
	hand := (handOrEvent isKindOf: HandMorph)
				ifTrue: [handOrEvent]
				ifFalse: [handOrEvent hand].

	hand
		addMorphBack: ((self class
				newBounds: (hand lastEvent cursorPoint extent: 16 @ 16))
				setOtherSelection: self).
	oldOwner := owner.
	self world abandonAllHalos.
	"Will delete me"
	oldOwner addMorph: self! !

!InsideSelectionMorph methodsFor: 'layout-properties' stamp: 'EDC 10/5/2002 08:15'!
alignBottomEdges
	"Make the bottom coordinate of all my elements be the same"
	| maxBottom |
	maxBottom _ (submorphs
				collect: [:itm | itm bottom]) max.
	submorphs
		do: [:itm | itm bottom: maxBottom].
self newExtent! !

!InsideSelectionMorph methodsFor: 'layout-properties' stamp: 'EDC 10/5/2002 08:15'!
alignCentersHorizontally
	"Make every morph in the selection have the same vertical center as the 
	topmost item."
	| minLeft leftMost |
	submorphs size > 1
		ifFalse: [^ self].
	minLeft _ (submorphs
				collect: [:itm | itm left]) min.
	leftMost _ submorphs
				detect: [:m | m left = minLeft].
	submorphs
		do: [:itm | itm center: itm center x @ leftMost center y].
	self newExtent! !

!InsideSelectionMorph methodsFor: 'layout-properties' stamp: 'EDC 10/5/2002 08:15'!
alignCentersVertically
	"Make every morph in the selection have the same horizontal center as 
	the topmost item."
	| minTop topMost |
	submorphs size > 1
		ifFalse: [^ self].
	minTop _ (submorphs
				collect: [:itm | itm top]) min.
	topMost _ submorphs
				detect: [:m | m top = minTop].
	submorphs
		do: [:itm | itm center: topMost center x @ itm center y].
	self newExtent! !

!InsideSelectionMorph methodsFor: 'layout-properties' stamp: 'EDC 10/5/2002 08:16'!
alignLeftEdges
	"Make the left coordinate of all my elements be the same"
	| minLeft |
	minLeft _ (submorphs
				collect: [:itm | itm left]) min.
	submorphs
		do: [:itm | itm left: minLeft].
	self newExtent! !

!InsideSelectionMorph methodsFor: 'layout-properties' stamp: 'EDC 10/5/2002 08:16'!
alignRightEdges
	"Make the right coordinate of all my elements be the same"
	| maxRight |
	maxRight _ (submorphs
				collect: [:itm | itm right]) max.
	submorphs
		do: [:itm | itm right: maxRight].
	self newExtent! !

!InsideSelectionMorph methodsFor: 'layout-properties' stamp: 'EDC 10/5/2002 08:16'!
alignTopEdges
	"Make the top coordinate of all my elements be the same"
	| minTop |
	minTop _ (submorphs
				collect: [:itm | itm top]) min.
	submorphs
		do: [:itm | itm top: minTop].
	self newExtent! !

!InsideSelectionMorph methodsFor: 'layout-properties' stamp: 'di 8/31/2000 22:59'!
balloonHelpTextForHandle: aHandle
	aHandle eventHandler firstMouseSelector == #addOrRemoveItems:
		ifTrue: [^'Add items to, or remove them from, this selection.'].
	^ super balloonHelpTextForHandle: aHandle! !

!InsideSelectionMorph methodsFor: 'layout-properties' stamp: 'di 9/19/2000 18:25'!
borderColor: aColor

	| bordered |
	bordered _ submorphs select: [:m | m isKindOf: BorderedMorph].
	undoProperties ifNil: [undoProperties _ bordered collect: [:m | m borderColor]].
	bordered do: [:m | m borderColor: aColor]! !

!InsideSelectionMorph methodsFor: 'layout-properties' stamp: 'di 9/19/2000 18:25'!
borderWidth: aWidth

	| bordered |
	bordered _ submorphs select: [:m | m isKindOf: BorderedMorph].
	undoProperties ifNil: [undoProperties _ bordered collect: [:m | m borderWidth]].
	bordered do: [:m | m borderWidth: aWidth]! !

!InsideSelectionMorph methodsFor: 'layout-properties' stamp: 'di 8/23/2000 17:06'!
dismissViaHalo

	super dismissViaHalo.
	submorphs do: [:m | m dismissViaHalo]! !

!InsideSelectionMorph methodsFor: 'layout-properties' stamp: 'nk 3/12/2001 17:08'!
doDup: evt fromHalo: halo handle: dupHandle.

	submorphs _ self duplicateMorphCollection: submorphs.
	submorphs do: [:m | self owner addMorph: m].
	dupDelta == nil
		ifTrue: ["First duplicate operation -- note starting location"
				dupLoc _ self position.
				evt hand grabMorph: self.
				halo removeAllHandlesBut: dupHandle]
		ifFalse: ["Subsequent duplicate does not grab, but only moves me and my morphs"
				dupLoc _ nil.
				self position: self position + dupDelta]
! !

!InsideSelectionMorph methodsFor: 'layout-properties' stamp: 'di 9/19/2000 21:53'!
fillStyle: aColor
	undoProperties ifNil: [undoProperties _ submorphs collect: [:m | m fillStyle]].
	submorphs do: [:m | m fillStyle: aColor]! !

!InsideSelectionMorph methodsFor: 'layout-properties' stamp: 'di 8/31/2000 20:50'!
maybeAddCollapseItemTo: aMenu
	"... don't "! !

!InsideSelectionMorph methodsFor: 'layout-properties' stamp: 'sw 3/6/2002 00:04'!
organizeIntoColumn
	"Place my objects in a column-enforcing container"

	((AlignmentMorph inAColumn: submorphs) setNameTo: 'Column'; color: Color orange muchLighter; enableDragNDrop: true; yourself) openInHand
! !

!InsideSelectionMorph methodsFor: 'layout-properties' stamp: 'sw 3/6/2002 00:04'!
organizeIntoRow
	"Place my objects in a row-enforcing container"

	((AlignmentMorph inARow: submorphs) setNameTo: 'Row'; color: Color orange muchLighter; enableDragNDrop: true; yourself) openInHand
! !


!InsideSelectionMorph methodsFor: 'menu' stamp: 'sw 3/19/2002 22:55'!
addCustomMenuItems: aMenu hand: aHandMorph
	"Add custom menu items to the menu"

	super addCustomMenuItems: aMenu hand: aHandMorph.
	aMenu addLine.
	aMenu add: 'add or remove items' target: self selector: #addOrRemoveItems: argument: aHandMorph.
	aMenu addList: #(
		-
		('place into a row' organizeIntoRow)
		('place into a column' organizeIntoColumn)
		-
		('align left edges' alignLeftEdges)
		('align top edges' alignTopEdges)
		('align right edges' alignRightEdges)
		('align bottom edges' alignBottomEdges)
		-
		('align centers vertically' alignCentersVertically)
		('align centers horizontally' alignCentersHorizontally))


! !

!InsideSelectionMorph methodsFor: 'menu' stamp: 'edc 8/13/2004 06:50'!
addMenuItemsTo: aMenu hand: aHandMorph 
	"Add custom menu items to the menu"
	super addCustomMenuItems: aMenu hand: aHandMorph.
	
aMenu
		add: 'eliminar seleccion '
		target: self
		action: #deSelect.
	aMenu addLine.
	aMenu
		add: 'add or remove items'
		target: self
		selector: #addOrRemoveItems:
		argument: aHandMorph.
	aMenu addList: #(#- #('place into a row' #organizeIntoRow) #('place into a column' #organizeIntoColumn) #- #('align left edges' #alignLeftEdges) #('align top edges' #alignTopEdges) #('align right edges' #alignRightEdges) #('align bottom edges' #alignBottomEdges) #- #('align centers vertically' #alignCentersVertically) #('align centers horizontally' #alignCentersHorizontally) )! !


!InsideSelectionMorph methodsFor: 'event handling' stamp: 'EDC 10/5/2002 07:54'!
handlesMouseDown: evt 
	"Prevent stray clicks from picking up the whole game in MVC."
	^ Smalltalk isMorphic not
		or: [evt yellowButtonPressed]! !

!InsideSelectionMorph methodsFor: 'event handling' stamp: 'EDC 10/5/2002 07:54'!
mouseDown: evt 
	| menu |
	evt yellowButtonPressed
		ifFalse: [^ evt hand waitForClicksOrDrag: self event: evt].
	menu _ MenuMorph new defaultTarget: self.
	self addMenuItemsTo: menu hand: evt hand.
	menu popUpEvent: evt in: self world! !

!InsideSelectionMorph methodsFor: 'event handling' stamp: 'edc 8/13/2004 06:58'!
setOtherSelection: otherOrNil 
	otherSelection := otherOrNil.
	otherOrNil isNil 
		ifTrue: [super borderColor: Color blue]
		ifFalse: 
			[itemsAlreadySelected := otherSelection selectedItems.
			super borderColor: Color green]! !


!InsideSelectionMorph methodsFor: 'initialization' stamp: 'EDC 10/5/2002 07:01'!
initialize
	super initialize.
	color _ Color transparent.
	borderWidth _ 2.
	borderColor _ Color red.! !


!InsideSelectionMorph methodsFor: 'submorphs-add/remove' stamp: 'EDC 10/5/2002 08:15'!
addMorph: aMorph 
	| |
	super addMorph: aMorph.
	
	self newExtent! !

!InsideSelectionMorph methodsFor: 'submorphs-add/remove' stamp: 'EDC 10/30/2002 08:16'!
newExtent
	| minLeft minTop minRight minBottom oldPositions |
	minLeft _ (submorphs
				collect: [:itm | itm left]) min.
	minTop _ (submorphs
				collect: [:itm | itm top]) min.
	minRight _ (submorphs
				collect: [:itm | itm right]) max.
	minBottom _ (submorphs
				collect: [:itm | itm bottom]) max.
oldPositions _ (submorphs
				collect: [:itm | itm position]) .
	self
		bounds: (Rectangle origin: minLeft @ minTop corner: minRight @ minBottom).
	submorphs with: oldPositions do: [:each :oldP | each position: oldP]! !


TextLink subclass: #MiCardLink
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'HyperCardNostalgia'!

!MiCardLink methodsFor: 'as yet unclassified' stamp: 'edc 11/18/2004 08:36'!
actOnClickFor: anObject
	"Do what you can with this URL.  Later a web browser."

	| |
(anObject ownerChain ) do: [ :any| (any isKindOf: MiStack) ifTrue: [any goToCardName: self]].! !


BorderedMorph subclass: #MiIndiceVisual
	instanceVariableNames: 'visualNumberOfCards'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'HyperCardNostalgia'!

!MiIndiceVisual methodsFor: 'initialization' stamp: 'edc 8/12/2004 09:32'!
initialize
	
	|  frame |
	super initialize.
self useRoundedCorners;
				color: (Color
						r: 0.4
						g: 0.4
						b: 0.4
						alpha: 0.5);
				 borderWidth: 2.
	visualNumberOfCards :=  UpdatingStringMorph new.
	
	visualNumberOfCards initWithContents: '1' font:  (StrikeFont familyName:  #ComicSansMS size: 11) emphasis: 1.
		visualNumberOfCards		color: Color red.
				
	self extent: visualNumberOfCards extent + (8 @ 6) asPoint.
	frame := LayoutFrame new.
	frame leftFraction: 0.5 offset: visualNumberOfCards width // -2.
	frame topFraction: 0 offset: 0.
	visualNumberOfCards layoutFrame: frame.
	self layoutPolicy: ProportionalLayout new.
	self addMorph: visualNumberOfCards.
	^ self
	! !


!MiIndiceVisual methodsFor: 'stepping and presenter' stamp: 'edc 8/12/2004 09:00'!
step 
"| old| 
old := visualNumberOfCards text asString asInteger > 1 ifTrue:[ self extent: visualNumberOfCards extent + (8 @ 6) asPoint.
	self owner goToPage: old ]."

! !


!MiIndiceVisual methodsFor: 'change reporting' stamp: 'edc 8/12/2004 08:22'!
handleEvent: anEvent 
anEvent isKeyboard ifTrue: [self halt.
	self literal: submorphs last contents]! !

!MiIndiceVisual methodsFor: 'change reporting' stamp: 'edc 8/10/2004 08:07'!
literal: anObject 
	literal := anObject asInteger.
	self updateLiteralLabel.
	submorphs last informTarget.
	owner checkIndex: self literal.
	! !


!MiIndiceVisual methodsFor: 'accessing' stamp: 'edc 8/12/2004 08:22'!
visualNumberOfCards
	"Answer the value of visualNumberOfCards"

	^ visualNumberOfCards! !

!MiIndiceVisual methodsFor: 'accessing' stamp: 'edc 8/12/2004 08:22'!
visualNumberOfCards: anObject
	"Set the value of visualNumberOfCards"

	visualNumberOfCards _ anObject! !


BorderedMorph subclass: #MiStack
	instanceVariableNames: 'htmlDir listaImages index currentCard lastCardNumber visualNumberOfCards'
	classVariableNames: 'Current'
	poolDictionaries: ''
	category: 'HyperCardNostalgia'!
!MiStack commentStamp: '<historical>' prior: 0!
MiStack new "lets you create a fresh one"
MiStack reloadMeFromServer "lets you share others work"
MiStack reloadMeFromDisk "quick load of default SqueakBooks dir"
MiStack loadFromOtherDir "from you choose where save and load "!


!MiStack methodsFor: 'initialization' stamp: 'edc 11/14/2004 08:56'!
addCardFromHtmlFile: afileName name: cardName
|  input w  |


	self addCardName: cardName.
	
	input :=  FileStream oldFileNamed: afileName.
	w := (HtmlParser parse: input) formattedText.
	self fieldFillingThisCard:  w ! !

!MiStack methodsFor: 'initialization' stamp: 'edc 12/8/2004 08:55'!
arregla

|   todas|
todas := self allCards.
1 to: todas size do: [ :ind| currentCard _ todas at: ind.
self currentCard submorphs do:[ :each| (each isKindOf: RectangleMorph)  ifTrue: [ each delete]].
currentCard index: ind.
currentCard show.]



! !

!MiStack methodsFor: 'initialization' stamp: 'edc 4/9/2005 07:39'!
buildStackFromHtml
| fileName input w |
fileName _ (htmlDir findTokens: FileDirectory slash) last.
htmlDir _ htmlDir copyReplaceAll: fileName with: ''.
listaImages do: [ :each| self halt. fileName _ (each findTokens: FileDirectory slash) last.
	fileName _  fileName copyUpTo: $..
	(FileDirectory default fileExists: htmlDir ,each) ifTrue: [
	self addCardName: fileName.
	
	input _  FileStream oldFileNamed: htmlDir ,each.
	w := (HtmlParser parse: input) formattedText.
	self fieldFillingThisCard:  w]]! !

!MiStack methodsFor: 'initialization' stamp: 'edc 4/9/2005 08:27'!
buildStackFromHtmlDir
|  input w pos newName |

listaImages do: [ :fileName| 
pos _ fileName findString: '.' startingAt: 1.
newName _ fileName copyFrom: 1 to: pos.
	self addCardName: newName.
	
	input _  FileStream oldFileNamed: htmlDir ,fileName.
	w := (HtmlParser parse: input) formattedText.
	self fieldFillingThisCard:  w]! !

!MiStack methodsFor: 'initialization' stamp: 'edc 12/7/2004 08:54'!
doButtons
	| labels actions thisButton frame fill |
frame := PasteUpMorph new.
	
	frame width: self width -8.
frame becomeLikeAHolder.
	fill := GradientFillStyle sample.
	frame fillStyle: fill;
		 borderWidth: 2;
		 borderColor: Color black.


labels := #('First' 'Previous' 'Index' 'AddCard' 'RemoveCard' 'SaveStack' 'Next' 'Last').
actions := #(#goToFirstCard #previous #index #addCard #removeCard #localDiskSave #next #goToLastCard ).
labels with: actions do: [ :bNames :bActions| thisButton  :=(SimpleButtonMorph new label: bNames ;
				 target: self;
				 color: Color lightBlue;
				 actionSelector: bActions).
frame addMorphBack: thisButton ].
frame addMorphBack: self visualNumberOfCards.
frame center: self center.
frame bottom: self bottom.
self addMorph: frame

! !

!MiStack methodsFor: 'initialization' stamp: 'edc 3/3/2005 08:48'!
initialize
	
	| |
	super initialize.
	self extent: 512 @ 342;color: Color paleYellow.
	
	index := 1.

lastCardNumber := 0.
	self doButtons.
	self openCenteredInWorld.

	

	! !

!MiStack methodsFor: 'initialization' stamp: 'edc 12/7/2004 09:03'!
initializeFromHtml
	
	super initialize.
	self extent: 512 @ 342;color: Color paleYellow.
	listaImages := OrderedCollection new.
	index := 1.

lastCardNumber := 0.
	self doButtons.
	self openCenteredInWorld.
	
	! !


!MiStack methodsFor: 'fileIn/out' stamp: 'edc 3/22/2005 09:21'!
exporting
	| baseDir outputStream |
	baseDir := ServerDirectory localSqueakBooksDirectory,FileDirectory slash.


outputStream := ReferenceStream fileNamed:  (self getStackNamefromUser) , '.shc'.
self allCards do: [ :each | 
	outputStream nextPut: each title.
	outputStream nextPut:  each text.
].
outputStream close.
! !

!MiStack methodsFor: 'fileIn/out' stamp: 'edc 12/19/2005 17:43'!
exportingToXml
	| outputStream 
	dir |
	 FileDirectory default createDirectory: self externalName.
	dir := FileDirectory default directoryNamed: self externalName.
	self indexToXml: dir.
	self allCards do: [ :each | 
		outputStream := dir newFileNamed: (each index + 1) asString,'.xml'.
outputStream nextPutAll: self class headingXml.
outputStream nextPutAll: '<settings>
</settings>
<name>'.
outputStream nextPutAll: each title.
outputStream nextPutAll:'</name>
<text>'.
outputStream nextPutAll:each text.

outputStream nextPutAll:'</text>
</page>'.
outputStream close..
].
PopUpMenu inform: 'Convertido a Xml'
! !

!MiStack methodsFor: 'fileIn/out' stamp: 'edc 6/29/2005 18:02'!
localDiskSave
| baseDir outputStream|
	baseDir := ServerDirectory localSqueakBooksDirectory,FileDirectory slash.


outputStream := ReferenceStream fileNamed: baseDir, (self getStackNamefromUser) , '.shc'.
self allCards do: [ :each | 
	outputStream nextPut: each title.
	outputStream nextPut:  each text.
].
outputStream close.
! !

!MiStack methodsFor: 'fileIn/out' stamp: 'edc 4/1/2005 09:29'!
serverlDiskSave
| baseDir outputStream |
	baseDir := ServerDirectory serverSqueakBooksDirectory,FileDirectory slash.


outputStream := ReferenceStream fileNamed:  (self getStackNamefromUser) , '.shc'.
self allCards do: [ :each | 
	outputStream nextPut: each title.
	outputStream nextPut:  each text.
].
outputStream close.
! !


!MiStack methodsFor: 'events-alarms' stamp: 'edc 4/26/2005 10:39'!
error: aString 
	aString caseOf: {
		['primero'] -> [PopUpMenu inform: 'This is a first card '].
		['fin'] -> [PopUpMenu inform: 'This is a last card '].
['sin'] -> [PopUpMenu inform: 'This card is missing ']}
		 otherwise: 
			[Transcript open.
			Transcript show: 'Se pudri todo']! !


!MiStack methodsFor: 'other events' stamp: 'edc 4/18/2006 11:33'!
next


	index = lastCardNumber
		ifTrue: [self error: 'fin']
	ifFalse: [index := index + 1.
			self goToCardIndex: index].! !

!MiStack methodsFor: 'other events' stamp: 'edc 4/18/2006 11:48'!
previous
| result|
	index = 1
		ifTrue: [self error: 'primero']
		ifFalse: [index := index - 1.
			result _ self goToCardIndex: index.
			result ifFalse: [ self previous]].
! !


!MiStack methodsFor: 'accessing' stamp: 'edc 8/8/2004 10:23'!
currentCard
^currentCard! !

!MiStack methodsFor: 'accessing' stamp: 'edc 8/29/2004 17:52'!
currentCard: anObject
	"Set the value of currentCard"

	currentCard _ anObject! !

!MiStack methodsFor: 'accessing' stamp: 'edc 8/8/2004 10:20'!
font
	"Answer the value of font"

	^  StrikeFont familyName: #Accuny15 size: 12.! !

!MiStack methodsFor: 'accessing' stamp: 'edc 8/29/2004 17:52'!
htmlDir
	"Answer the value of htmlDir"

	^ htmlDir! !

!MiStack methodsFor: 'accessing' stamp: 'edc 8/29/2004 17:52'!
htmlDir: anObject
	"Set the value of htmlDir"

	htmlDir _ anObject! !

!MiStack methodsFor: 'accessing' stamp: 'edc 8/29/2004 17:52'!
image
	"Answer the value of image"

	^ image! !

!MiStack methodsFor: 'accessing' stamp: 'edc 8/29/2004 17:52'!
image: anObject
	"Set the value of image"

	image _ anObject! !

!MiStack methodsFor: 'accessing' stamp: 'edc 6/11/2005 11:23'!
index
	"Answer the value of index"

	| menu  res searchFor  |
	menu := CustomMenu new.
	menu title: 'Select Card title '.
	self allCardsTitles
		do: [:each | 
			menu add: each action: #goToPage:.
			menu addLine].
	 menu startUp.
	res := menu selection.

	res > 0 ifTrue: [searchFor := (menu labels at: res) copyFrom: 2 to: (menu labels at: res) size - 1.
self goToCardTile: searchFor]! !

!MiStack methodsFor: 'accessing' stamp: 'edc 8/29/2004 17:52'!
index: anObject
	"Set the value of index"

	index _ anObject! !

!MiStack methodsFor: 'accessing' stamp: 'edc 8/9/2004 07:55'!
lastCardNumber
^ lastCardNumber! !

!MiStack methodsFor: 'accessing' stamp: 'edc 8/9/2004 07:55'!
lastCardNumber: aNumer
lastCardNumber_ aNumer! !

!MiStack methodsFor: 'accessing' stamp: 'edc 8/29/2004 17:52'!
listaImages
	"Answer the value of listaImages"

	^ listaImages! !

!MiStack methodsFor: 'accessing' stamp: 'edc 8/29/2004 17:52'!
listaImages: anObject
	"Set the value of listaImages"

	listaImages _ anObject! !

!MiStack methodsFor: 'accessing' stamp: 'edc 3/19/2005 09:45'!
visualNumberOfCards
	| rect frame |
	rect := RectangleMorph authoringPrototype useRoundedCorners
				color: (Color
						white
						alpha: 0.5);
				 borderWidth: 2.
	visualNumberOfCards := TextMorph new contents: lastCardNumber asString;
				 textColor: Color red;
				 fontName: #ComicBold size: 9.
	rect extent: visualNumberOfCards extent + (8 @ 6) asPoint.
	frame := LayoutFrame new.
	frame leftFraction: 0.5 offset: visualNumberOfCards width // -2.
	frame topFraction: 0 offset: 0.
	visualNumberOfCards layoutFrame: frame.
	rect layoutPolicy: ProportionalLayout new.
	rect addMorph: visualNumberOfCards.
	^ rect! !


!MiStack methodsFor: 'card in a stack' stamp: 'edc 5/13/2005 09:09'!
addCard
self lastCardNumber: self lastCardNumber + 1.
index := lastCardNumber.
	currentCard :=MiTarjetaCard index: self lastCardNumber.
	currentCard center: self center;top: self top +2.
	currentCard getCardNamefromUser.
	self addMorphBack: currentCard.
	visualNumberOfCards contents:  lastCardNumber asString.
	self fieldFillingThisCard: ''
	
	! !

!MiStack methodsFor: 'card in a stack' stamp: 'edc 3/18/2005 08:23'!
addCardFromDisk: aCard
self lastCardNumber: self lastCardNumber + 1.
index := lastCardNumber.
	self currentCard: aCard.
	currentCard center: self center;top: self top +2.
	
	self addMorph: currentCard.
	visualNumberOfCards contents:  lastCardNumber asString.
	
	
	! !

!MiStack methodsFor: 'card in a stack' stamp: 'edc 8/29/2004 18:07'!
addCardName: aString
self lastCardNumber: self lastCardNumber + 1.
index := lastCardNumber.
	currentCard :=MiTarjetaCard index: self lastCardNumber name: aString.
	currentCard center: self center;top: self top +2.
	self addMorph: currentCard.
	visualNumberOfCards contents:  lastCardNumber asString.! !

!MiStack methodsFor: 'card in a stack' stamp: 'edc 11/18/2004 07:17'!
addCardNoTitle
self lastCardNumber: self lastCardNumber + 1.
index := lastCardNumber.
	currentCard :=MiTarjetaCard index: self lastCardNumber.
	currentCard center: self center;top: self top +2.
	
	self addMorph: currentCard.
	visualNumberOfCards contents:  lastCardNumber asString.
	
	
	! !

!MiStack methodsFor: 'card in a stack' stamp: 'edc 5/13/2005 17:56'!
fieldFillingThisCard: aText 
	| sf r |
	sf _ (ScrollableField new)
			
				color: (Color 
							r: 0.972
							g: 0.972
							b: 0.662).
	r _ Rectangle 
				left: currentCard left + 5
				right: currentCard right - 5
				top: currentCard top + 20
				bottom: currentCard bottom - 5.
	sf bounds: r.
	sf setMyText: aText.
	currentCard addMorph: sf.
	self addMorph: currentCard.
	currentCard submorphs last comeToFront! !

!MiStack methodsFor: 'card in a stack' stamp: 'edc 4/18/2006 11:34'!
goToCardIndex: aNumber
self allCards do:[ :each| each hide].
currentCard := self allCards detect: [ :any| any index = aNumber] ifNone:[ ^false].
self index: aNumber.
currentCard show.
^ true
! !

!MiStack methodsFor: 'card in a stack' stamp: 'edc 11/18/2004 08:18'!
goToCardName: aNumber
self halt.
self allCards do:[ :each| each hide].
currentCard := self allCards detect: [ :any| any index = aNumber].
currentCard show.! !

!MiStack methodsFor: 'card in a stack' stamp: 'edc 4/18/2006 11:31'!
goToFirstCard
self
	goToCardIndex: 1
	! !

!MiStack methodsFor: 'card in a stack' stamp: 'edc 4/18/2006 11:35'!
goToLastCard
self
	goToCardIndex: self lastCardNumber.
	! !

!MiStack methodsFor: 'card in a stack' stamp: 'edc 4/9/2005 08:08'!
removeCard

self currentCard delete.
self lastCardNumber: self lastCardNumber - 1.
index := lastCardNumber.
visualNumberOfCards contents:  lastCardNumber asString.
self goToCardIndex: index
! !


!MiStack methodsFor: 'card controls' stamp: 'edc 7/6/2004 15:02'!
getStackNamefromUser
^FillInTheBlank request: 'Give a name for this Stack '.
! !

!MiStack methodsFor: 'card controls' stamp: 'edc 6/11/2005 11:23'!
goToCardTile: aString

self allCards do:[ :each| each hide].
currentCard := self allCards detect: [ :any| any title = aString] ifNone: [
	self error: ' No card have this name '
	].
currentCard show.! !

!MiStack methodsFor: 'card controls' stamp: 'edc 7/14/2004 11:04'!
insertCard
| texto r |
	pages isEmpty 
	ifTrue: [^ self insertPageColored: self color]. 
	self insertPageColored: self color. 
	self getPageNamefromUser.
	
	texto :=  self textContainer.
	r := Rectangle
				left: currentCard left + 5
				right: currentCard right - 5
				top: currentCard top + 20
				bottom: currentCard bottom - 5.
	texto bounds: r.
	self currentCard addMorph: texto! !


!MiStack methodsFor: 'evaluating' stamp: 'edc 8/9/2004 10:46'!
allCards
^ self submorphs select:[ :each| each isKindOf: MiTarjetaCard] thenCollect:[ :any| any]! !

!MiStack methodsFor: 'evaluating' stamp: 'edc 8/17/2004 10:06'!
allCardsThumbnails
| esteBoton fondo f |
fondo := PasteUpMorph new.
	fondo becomeLikeAHolder.
 self allCards do: [ :each | each show.f := each imageForm.
	f := f scaledToSize: 60 at 38.
	esteBoton := IconicButton new.
			esteBoton target: self;
				 actionSelector: #goToCardIndex:;
				
				arguments: (Array
						with: (each index)).
				
			esteBoton
				labelGraphic: f.
				fondo addMorphBack: esteBoton
].
fondo width: 80;openInWorld! !

!MiStack methodsFor: 'evaluating' stamp: 'edc 11/23/2004 09:53'!
allCardsTitles
^( self submorphs select:[ :each| each isKindOf: MiTarjetaCard] thenCollect:[ :any|  any title.
	]) asSortedCollection! !


!MiStack methodsFor: 'message handling' stamp: 'edc 2/2/2005 06:42'!
goToPage: aNumber
| searchTitle |


self allCards do:[ :each| each hide].
searchTitle := self allCardsTitles at: aNumber.
currentCard := self allCards detect: [ :any| any title = searchTitle].
currentCard show.! !


!MiStack methodsFor: 'as yet unclassified' stamp: 'edc 11/18/2004 06:22'!
addCardFromICabZipFile: aFile
| zip   unzipped w|


zip := ZipArchive new readFrom: aFile.
	unzipped := RWBinaryOrTextStream on: (ByteArray new: ((zip members) second ) uncompressedSize).
	(zip members) second extractTo: unzipped.
 unzipped reset.
self addCardNoTitle.
w := (HtmlParser parse: unzipped contents asString)  formattedText.
	self fieldFillingThisCard:  w
	
	

	
! !

!MiStack methodsFor: 'as yet unclassified' stamp: 'edc 12/19/2005 17:47'!
indexToXml: aDirectory
| outputStream |
outputStream := aDirectory newFileNamed: '1.xml'.
outputStream nextPutAll: self class headingXml.
outputStream nextPutAll: '<settings>
</settings>
<name>'.
outputStream nextPutAll: 'Indice'.
outputStream nextPutAll:'</name>
<text>'.
self allCards do: [ :each | outputStream nextPutAll: '*',each title ,'*',Character cr asString].		
outputStream nextPutAll:'</text>
</page>'.
outputStream close.! !

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

MiStack class
	instanceVariableNames: 'fileStream'!

!MiStack class methodsFor: 'as yet unclassified' stamp: 'edc 12/19/2005 18:01'!
headingXml
	|  head |
	head := '<?xml version="1.0"?>
<page>
<version date='.

head := head ,'"',((Date today) dayMonthYearDo: [ :d :m :y | d asString ,'/', m asString,'/', y asString ]),'" '.

head := head ,'time='.

head := head ,'"',(Time now) asString,'" '.


head := head ,  'user="localhost" />'.
^head! !

!MiStack class methodsFor: 'as yet unclassified' stamp: 'edc 5/15/2005 09:04'!
loadFromOtherDir

| newFolder newDir |
newFolder := FileList2 modalFolderSelector.
newDir _	FileDirectory on: newFolder pathName.
MiStack  selectingSavedStacks: newDir
! !

!MiStack class methodsFor: 'as yet unclassified' stamp: 'edc 8/31/2004 08:42'!
moreLinks: aSet baseDir: htmlDir

|   strmIn  newLink cleabLink newLlistLink |

newLlistLink := Set new.
aSet do: [ :aFile|
	self halt.
strmIn := FileStream oldFileNamed: htmlDir,aFile.

 '<a href.*' asRegex matchesIn: strmIn do: [ :each| newLink := (each  findTokens: '"') second. 
	cleabLink := newLink  copyReplaceAll:'/' with: ':' .
	cleabLink :=  cleabLink copyReplaceAll:'%20' with: ' ' .
	newLlistLink add: cleabLink].strmIn close].

strmIn close.! !

!MiStack class methodsFor: 'as yet unclassified' stamp: 'edc 9/16/2006 07:32'!
newFromDirWithHtmlFiles: aHtmlDirPath 
	| newStack aList htmlDir aSuffixList |
	aSuffixList  := #('.htm' '.html').
	htmlDir := FileDirectory on: aHtmlDirPath.
	aList := OrderedCollection new.
	aSuffixList
		do: [:aSuffix | aList
				addAll: (htmlDir fileNamesMatching: '*' , aSuffix)].
	newStack := self basicNew initializeFromHtml.
	newStack htmlDir: aHtmlDirPath.
	newStack listaImages: aList.
	newStack buildStackFromHtmlDir.
	^ newStack! !

!MiStack class methodsFor: 'as yet unclassified' stamp: 'edc 8/31/2004 08:40'!
newFromHtmlFiles: aFile
|  newStack strmIn listLink newLink cleabLink htmlDir|
htmlDir := (aFile findTokens: FileDirectory slash) last.
htmlDir := aFile copyReplaceAll: htmlDir with: ''.
strmIn := FileStream oldFileNamed: aFile.
listLink := Set new.
listLink add:   (aFile findTokens: FileDirectory slash) last.
 '<a href.*' asRegex matchesIn: strmIn do: [ :each| newLink := (each  findTokens: '"') second. 
	cleabLink := newLink  copyReplaceAll:'/' with: ':' .
	cleabLink :=  cleabLink copyReplaceAll:'%20' with: ' ' .
	listLink add: cleabLink].

strmIn close.

self moreLinks: listLink baseDir: htmlDir .


	newStack := self basicNew initializeFromHtml.
	newStack htmlDir: aFile.
	newStack listaImages: listLink.
	newStack buildStackFromHtml.
	^newStack! !

!MiStack class methodsFor: 'as yet unclassified' stamp: 'edc 8/19/2006 08:42'!
reloadMeFromDisk
|    dir  |



dir :=  (FileDirectory on: (ServerDirectory localSqueakBooksDirectory)).

self selectingSavedStacks: dir.

! !

!MiStack class methodsFor: 'as yet unclassified' stamp: 'edc 9/25/2006 10:29'!
reloadMeFromDisk: aFile
|   newStack cardName cardText rr  nombre|

nombre := (FileDirectory default  on:
aFile name) pathParts last .
nombre := (nombre findBetweenSubStrs: '.') first.
self current: self new.
self current name: nombre.

newStack :=  self current.
(aFile isKindOf: String ) ifFalse:[
rr := ReferenceStream on: aFile]
ifTrue:[rr := ReferenceStream on: (RWBinaryOrTextStream with: aFile ) reset ]
.
[rr atEnd] whileFalse: [
	cardName := rr next.
cardText  := rr next.
newStack addCardName: cardName.
	newStack fieldFillingThisCard: cardText].

	rr close.

! !

!MiStack class methodsFor: 'as yet unclassified' stamp: 'edc 4/18/2006 09:39'!
reloadMeFromServer
|    dir server |


server := (ServerDirectory serverNamed: 'SqueakRos').
dir := server directoryNamed: 'SqueakBooks'.

self selectingSavedStacksOnServer: dir

! !

!MiStack class methodsFor: 'as yet unclassified' stamp: 'edc 4/18/2006 15:03'!
saveOnServer
|    dir server nombre 	unzipped zipped buffer packageFile |
nombre := 'Abril2006.shc'.

server := (ServerDirectory serverNamed: 'SqueakRos').
dir := server directoryNamed: 'SqueakBooks'.
unzipped := RWBinaryOrTextStream on: ''.
unzipped fileOutClass: nil andObject: self current.
unzipped reset.
zipped := FileDirectory default newFileNamed: nombre.
zipped binary.
zipped := GZipWriteStream on: zipped.
buffer := ByteArray new: 50000.
'Compressing ' , self name
displayProgressAt: Sensor cursorPoint
from: 0
to: unzipped size
during: [:bar | 
[unzipped atEnd]
whileFalse: [bar value: unzipped position.
zipped
nextPutAll: (unzipped nextInto: buffer)].
zipped close.
unzipped close].
packageFile := FileDirectory default readOnlyFileNamed: nombre.
dir putFile: packageFile named: nombre

 ! !

!MiStack class methodsFor: 'as yet unclassified' stamp: 'edc 9/23/2006 11:00'!
selectingSavedStacks: dir
| lista file  sel  |
lista := dir fileNamesMatching:  '*.shc'.
lista  isEmptyOrNil ifTrue:[^PopUpMenu inform: 'No saved MiStak in this dir ' ]. 
sel := (PopUpMenu
  labelArray: lista
  )
  startUp .



file := dir pathName , FileDirectory slash , (lista at: sel) .

self reloadMeFromDisk: (FileStream oldFileOrNoneNamed: file )! !

!MiStack class methodsFor: 'as yet unclassified' stamp: 'edc 4/18/2006 15:16'!
selectingSavedStacksOnServer: dir
| lista nombre  sel zipped unzipped |
lista := dir entries select: [:fname | '*.shc'  match:  fname name] thenCollect: [:ea| ea name] .
lista  isEmptyOrNil ifTrue:[^PopUpMenu inform: 'No saved MiStak in this dir ' ]. 
sel := (PopUpMenu
  labelArray: lista
  )
  startUp .

nombre := ((lista at: sel)  findBetweenSubStrs: '.') first.
self current: self new.
self current name: nombre.

	
		zipped:=   RWBinaryOrTextStream with: (dir getFileNamed: nombre, '.shc' ).
		zipped reset.
		unzipped := RWBinaryOrTextStream with:  zipped decompressGZip.
	unzipped binary.
	unzipped reset.
self reloadMeFromDisk: unzipped! !


!MiStack class methodsFor: 'accessing' stamp: 'edc 5/15/2005 08:54'!
current

^ Current! !

!MiStack class methodsFor: 'accessing' stamp: 'edc 3/22/2005 06:47'!
current: aStack
 Current _ aStack! !


!MiStack class methodsFor: '*services-extras' stamp: 'edc 9/7/2006 10:58'!
fileReaderServicesForFile: fullName suffix: suffix
	| services |
	services _ OrderedCollection new.
	
	(fullName asLowercase endsWith: '.shc')
		ifTrue: [ services add: self serviceLoadSqueakBook ].
	^services! !

!MiStack class methodsFor: '*services-extras' stamp: 'edc 9/7/2006 16:24'!
registeredServices
	^ { 
	Service new
		label: 'Open saved SqueakBook';
		shortLabel: 'SqueakBook'; 
		description: 'load back saved notes ';
		action: [:stream | self reloadMeFromDisk: ((RWBinaryOrTextStream with: stream contents asString)reset)];
		shortcut: nil;
		categories: Service worldServiceCat.} ! !

!MiStack class methodsFor: '*services-extras' stamp: 'edc 9/7/2006 16:37'!
serviceLoadSqueakBook
"Answer a service for opening a saved SqueakBook"

	^ (SimpleServiceEntry 
		provider: self 
		label: 'saved SqueakBook'
		selector: #reloadMeFromDisk:
		description: 'open a SqueakBook'
		buttonLabel: 'SqueakBook')
		argumentGetter: [:fileList | fileList readOnlyStream]! !


!MiStack class methodsFor: 'class initialization' stamp: 'edc 9/7/2006 11:04'!
initialize
" MiStack initialize"
FileList registerFileReader: self.! !


BorderedMorph subclass: #MiTarjetaCard
	instanceVariableNames: 'index image font title'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'HyperCardNostalgia'!

!MiTarjetaCard methodsFor: 'initialization' stamp: 'edc 5/13/2005 17:59'!
initialize
	super initialize.
	self extent: 504 @ 306.
	! !


!MiTarjetaCard methodsFor: 'accessing' stamp: 'edc 3/26/2003 11:33'!
agregarHijo: anObject 
	"Set the value of hijos"
	hijos add: anObject! !

!MiTarjetaCard methodsFor: 'accessing' stamp: 'edc 11/18/2004 06:25'!
changeTitle: aString
	"Set the value of title"

	| s |
	title := aString.
s := self submorphs detect: [ :any| any isKindOf:	StringMorph ].
	s contents: aString! !

!MiTarjetaCard methodsFor: 'accessing' stamp: 'edc 8/6/2004 19:26'!
font
	"Answer the value of font"

	^  StrikeFont familyName: #Accuny15 size: 12.! !

!MiTarjetaCard methodsFor: 'accessing' stamp: 'edc 8/6/2004 19:27'!
font: anObject
	"Set the value of font"

	font _ anObject! !

!MiTarjetaCard methodsFor: 'accessing' stamp: 'edc 3/26/2003 11:13'!
hijos
	"Answer the value of hijos"

	^ hijos! !

!MiTarjetaCard methodsFor: 'accessing' stamp: 'edc 8/9/2004 10:57'!
hijos: anObject
	"Set the value of hijos"

	hijos _ anObject! !

!MiTarjetaCard methodsFor: 'accessing' stamp: 'edc 3/26/2003 11:13'!
image
	"Answer the value of image"

	^ image! !

!MiTarjetaCard methodsFor: 'accessing' stamp: 'edc 3/26/2003 11:13'!
image: anObject
	"Set the value of image"

	image _ anObject! !

!MiTarjetaCard methodsFor: 'accessing' stamp: 'edc 3/19/2005 09:35'!
index
	"Answer the value of index"
	| rect text frame |
	rect := RectangleMorph authoringPrototype useRoundedCorners
				color: (Color
						white
						alpha: 0.5);
				 borderWidth: 2.
	text := TextMorph new contents: index asString;
				 textColor: Color red;
				 fontName: #ComicBold size: 9.
	rect extent: text extent + (8 @ 6) asPoint.
	frame := LayoutFrame new.
	frame leftFraction: 0.5 offset: text width // -2.
	frame topFraction: 0 offset: 0.
	text layoutFrame: frame.
	rect layoutPolicy: ProportionalLayout new.
	rect addMorph: text.
	rect bottomRight: self bottomRight - (15 @ 0) asPoint.
	self addMorph: rect.
	^ index! !

!MiTarjetaCard methodsFor: 'accessing' stamp: 'edc 11/24/2004 07:43'!
index: anObject
	"Set the value of index"

	index := anObject.
	self index! !

!MiTarjetaCard methodsFor: 'accessing' stamp: 'edc 3/22/2005 08:38'!
text
^(self submorphs detect:[ :each| each isKindOf: ScrollableField])
text 

! !

!MiTarjetaCard methodsFor: 'accessing' stamp: 'edc 2/1/2005 07:52'!
title
	"Answer the value of title"
title isEmptyOrNil ifTrue: [ self halt].
	^ title! !

!MiTarjetaCard methodsFor: 'accessing' stamp: 'edc 8/9/2004 10:57'!
title: anObject
	"Set the value of title"

	title _ anObject! !


!MiTarjetaCard methodsFor: 'viewing' stamp: 'edc 8/7/2004 09:51'!
showingListView
	"Answer whether the receiver is currently showing a list view"

	^ self hasProperty: #showingListView! !


!MiTarjetaCard methodsFor: 'miscellaneous' stamp: 'edc 8/18/2004 07:20'!
alignSubmorphs

| container |
container := InsideSelectionMorph new.
self submorphsDo: [ :each| (each isKindOf: String) ifFalse: [ container addMorph: each ]].
container openInWorld! !

!MiTarjetaCard methodsFor: 'miscellaneous' stamp: 'edc 8/7/2004 09:49'!
alwaysShowThumbnail
	^ self hasProperty: #alwaysShowThumbnail! !


!MiTarjetaCard methodsFor: 'dropping/grabbing' stamp: 'edc 8/7/2004 09:55'!
acceptDroppingMorph: dropped event: evt
	"The supplied morph, known to be acceptable to the receiver, is now to be assimilated; the precipitating event is supplied"

	| mm tfm aMorph |
	aMorph := self morphToDropFrom: dropped.
	self isWorldMorph
		ifTrue:["Add the given morph to this world and start stepping it if it wants to be."
				self addMorphFront: aMorph.
				(aMorph fullBounds intersects: self viewBox) ifFalse:
					[Beeper beep.  aMorph position: self bounds center]]
		ifFalse:[super acceptDroppingMorph: aMorph event: evt].

	aMorph submorphsDo: [:m | (m isKindOf: HaloMorph) ifTrue: [m delete]].
	aMorph allMorphsDo:  "Establish any penDown morphs in new world"
		[:m | m player ifNotNil:
			[m player getPenDown ifTrue:
				[((mm := m player costume) notNil and: [(tfm := mm owner transformFrom: self) notNil])
					ifTrue: [self noteNewLocation: (tfm localPointToGlobal: mm referencePosition)
									forPlayer: m player]]]].

	self isPartsBin
		ifTrue:
			[aMorph isPartsDonor: true.
			aMorph stopSteppingSelfAndSubmorphs.
			aMorph suspendEventHandler]
		ifFalse:
			[self world startSteppingSubmorphsOf: aMorph].

	self presenter morph: aMorph droppedIntoPasteUpMorph: self.

	self showingListView ifTrue:
		[self sortSubmorphsBy: (self valueOfProperty: #sortOrder).
		self currentWorld abandonAllHalos]! !

!MiTarjetaCard methodsFor: 'dropping/grabbing' stamp: 'sw 2/4/2001 00:54'!
dropEnabled
	"Get this morph's ability to add and remove morphs via drag-n-drop."

	^ (self valueOfProperty: #dropEnabled) ~~ false
! !

!MiTarjetaCard methodsFor: 'dropping/grabbing' stamp: 'sw 9/1/2000 05:37'!
justDroppedInto: aMorph event: anEvent
	"This message is sent to a dropped morph after it has been dropped on--and been accepted by--a drop-sensitive morph"

	super justDroppedInto: aMorph event: anEvent.
	self isPartsBin ifTrue: [self setPartsBinStatusTo: true]  "gets some things right about the subtle case of dropping a parts bin"
! !

!MiTarjetaCard methodsFor: 'dropping/grabbing' stamp: 'gm 2/22/2003 13:08'!
morphToDropFrom: aMorph 
	"Given a morph being carried by the hand, which the hand is about to drop, answer the actual morph to be deposited.  Normally this would be just the morph itself, but several unusual cases arise, which this method is designed to service."

	| aNail representee handy posBlock tempPos |
	handy := self primaryHand.
	posBlock := 
			[:z | 
			tempPos := handy position 
						- ((handy targetOffset - aMorph formerPosition) 
								* (z extent / aMorph extent)) rounded.
			self pointFromWorld: tempPos].
	self alwaysShowThumbnail 
		ifTrue: 
			[aNail := aMorph 
						representativeNoTallerThan: self maxHeightToAvoidThumbnailing
						norWiderThan: self maximumThumbnailWidth
						thumbnailHeight: self heightForThumbnails.
			aNail == aMorph 
				ifFalse: 
					[aMorph formerPosition: aMorph position.
					aNail position: (posBlock value: aNail)].
			^aNail].
	((aMorph isKindOf: MorphThumbnail) 
		and: [(representee := aMorph morphRepresented) owner isNil]) 
			ifTrue: 
				[representee position: (posBlock value: representee).
				^representee].
	self showingListView 
		ifTrue: 
			[^aMorph 
				listViewLineForFieldList: (self valueOfProperty: #fieldListSelectors)].
	(aMorph hasProperty: #newPermanentScript) 
		ifTrue: [^aMorph asEmptyPermanentScriptor].
	((aMorph isKindOf: PhraseTileMorph) or: [aMorph isSyntaxMorph]) 
		ifFalse: [^aMorph].
	aMorph userScriptSelector isEmptyOrNil 
		ifTrue: 
			["non-user"

			self automaticPhraseExpansion ifFalse: [^aMorph]].
	^aMorph morphToDropInPasteUp: self! !

!MiTarjetaCard methodsFor: 'dropping/grabbing' stamp: 'sw 5/2/1998 11:31'!
positionNear: aPoint forExtent: anExtent adjustmentSuggestion: adjustmentPoint
	"Compute a plausible positioning for adding a subpart of size anExtent, somewhere near aPoint, using adjustmentPoint as the unit of adjustment"

	| adjustedPosition |
	adjustedPosition _ aPoint.
	[((self morphsAt: (adjustedPosition + (anExtent // 2))) size > 1) and:  "that 1 is self here"
		[bounds containsPoint: adjustedPosition]]
	whileTrue:
		[adjustedPosition _ adjustedPosition + adjustmentPoint].

	^ adjustedPosition! !

!MiTarjetaCard methodsFor: 'dropping/grabbing' stamp: 'ar 10/11/2000 18:22'!
repelsMorph: aMorph event: ev
	(aMorph wantsToBeDroppedInto: self) ifFalse: [^ false].
	self dropEnabled ifFalse: [^ true].
	(self wantsDroppedMorph: aMorph event: ev) ifFalse: [^ true].
	^ super repelsMorph: aMorph event: ev "consults #repelling flag"! !

!MiTarjetaCard methodsFor: 'dropping/grabbing' stamp: 'ar 10/11/2000 18:22'!
wantsDroppedMorph: aMorph event: evt
	self isWorldMorph ifTrue:[^true]. "always"
	self visible ifFalse: [^ false].  "will be a call to #hidden again very soon"
	self dropEnabled ifFalse: [^ false].
	^ true! !


!MiTarjetaCard methodsFor: 'event handling' stamp: 'mir 1/10/2002 17:35'!
dropFiles: anEvent
	"Handle a number of dropped files from the OS.
	TODO:
		- use a more general mechanism for figuring out what to do with the file (perhaps even offering a choice from a menu)
		- remember the resource location or (when in browser) even the actual file handle
	"
	| numFiles stream handler |
	numFiles _ anEvent contents.
	1 to: numFiles do: [:i |
		stream _ FileStream requestDropStream: i.
		handler _ ExternalDropHandler lookupExternalDropHandler: stream.
		[handler ifNotNil: [handler handle: stream in: self dropEvent: anEvent]]
			ensure: [stream close]].! !

!MiTarjetaCard methodsFor: 'event handling' stamp: 'ar 10/10/2000 15:22'!
handlesKeyboard: evt
	^self isWorldMorph or:[evt keyCharacter == Character tab and:[self hasProperty: #tabAmongFields]]! !

!MiTarjetaCard methodsFor: 'event handling' stamp: 'ar 10/3/2000 22:46'!
handlesMouseDown: evt
	^true! !

!MiTarjetaCard methodsFor: 'event handling' stamp: 'ar 10/10/2000 14:12'!
keyStroke: anEvent
	"A keystroke has been made.  Service event handlers and, if it's a keystroke presented to the world, dispatch it to #unfocusedKeystroke:"

	super keyStroke: anEvent.  "Give event handlers a chance"
	(anEvent keyCharacter == Character tab) ifTrue:
		[(self hasProperty: #tabAmongFields)
			ifTrue:[^ self tabHitWithEvent: anEvent]].
	self isWorldMorph ifTrue:
		[self keystrokeInWorld: anEvent]! !

!MiTarjetaCard methodsFor: 'event handling' stamp: 'ar 2/23/2001 16:44'!
morphToGrab: event
	"Return the morph to grab from a mouse down event. If none, return nil."
	self submorphsDo:[:m|
		((m rejectsEvent: event) not and:[m fullContainsPoint: event cursorPoint]) ifTrue:[^m].
	].
	^nil! !

!MiTarjetaCard methodsFor: 'event handling' stamp: 'jcg 9/21/2001 13:22'!
mouseDown: evt
	"Handle a mouse down event."
	| grabbedMorph handHadHalos |
	grabbedMorph _ self morphToGrab: evt.
	grabbedMorph ifNotNil:[
		grabbedMorph isSticky ifTrue:[^self].
		self isPartsBin ifFalse:[^evt hand grabMorph: grabbedMorph].
		grabbedMorph _ grabbedMorph partRepresented duplicate.
		grabbedMorph restoreSuspendedEventHandler.
		(grabbedMorph fullBounds containsPoint: evt position) 
			ifFalse:[grabbedMorph position: evt position].
		"Note: grabbedMorph is ownerless after duplicate so use #grabMorph:from: instead"
		^evt hand grabMorph: grabbedMorph from: self].

	(super handlesMouseDown: evt)
		ifTrue:[^super mouseDown: evt].
	handHadHalos _ evt hand halo notNil.
	evt hand halo: nil. "shake off halos"
	evt hand releaseKeyboardFocus. "shake of keyboard foci"
	evt shiftPressed ifTrue:[
		^evt hand 
			waitForClicksOrDrag: self 
			event: evt 
			selectors: { #findWindow:. nil. nil. #dragThroughOnDesktop:}
			threshold: 5].
	self isWorldMorph ifTrue: [
		handHadHalos ifTrue: [^self addAlarm: #invokeWorldMenu: with: evt after: 200].
		^self invokeWorldMenu: evt
	].
	"otherwise, explicitly ignore the event if we're not the world,
	so that we could be picked up if need be"
	self isWorldMorph ifFalse:[evt wasHandled: false].
! !

!MiTarjetaCard methodsFor: 'event handling' stamp: 'ar 10/6/2000 00:04'!
mouseUp: evt
	self isWorldMorph ifTrue:[self removeAlarm: #invokeWorldMenu:].
	super mouseUp: evt.! !

!MiTarjetaCard methodsFor: 'event handling' stamp: 'ar 1/10/2001 21:29'!
wantsDropFiles: anEvent
	^self isWorldMorph! !

!MiTarjetaCard methodsFor: 'event handling' stamp: 'sw 5/6/1998 17:07'!
wantsKeyboardFocusFor: aSubmorph
	aSubmorph inPartsBin ifTrue: [^ false].
	aSubmorph wouldAcceptKeyboardFocus ifTrue: [ ^ true].
	^ super wantsKeyboardFocusFor: aSubmorph! !


!MiTarjetaCard methodsFor: 'as yet unclassified' stamp: 'edc 8/18/2004 07:32'!
getCardNamefromUser
|  pn aString |

pn := FillInTheBlank request: 'Name of this card ? '.
aString := StringMorph contents: pn font: self font.
self title: pn.
aString emphasis: 1.
aString center: (self  center x) @ (self top + 10).
aString color: Color yellow.
self  addMorph: aString.
aString beSticky.
aString setProperty: #couldBeAligned toValue: false.
 
! !

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

MiTarjetaCard class
	instanceVariableNames: ''!

!MiTarjetaCard class methodsFor: 'as yet unclassified' stamp: 'edc 8/9/2004 08:33'!
index: aNumber
^(self new) index: aNumber! !

!MiTarjetaCard class methodsFor: 'as yet unclassified' stamp: 'edc 8/29/2004 19:24'!
index: aNumber name: aString
| card titMorph |
card _ (self new) index: aNumber.

card title: aString. 
titMorph _ (StringMorph contents: aString font: card font).
titMorph emphasis: 1.
card addMorph: titMorph.
titMorph center: (card  center x) @ (card top + 10).
titMorph color: Color yellow. 
titMorph beSticky.
titMorph setProperty: #couldBeAligned toValue: false.
^ card! !

MiStack initialize!


More information about the Squeak-dev mailing list