What's with all these stale sokoban implementations?Alan Grimes alangrimes at starpower.netWed Nov 2 06:00:10 UTC 2005
Dude, the fast way to update a sokoban morph is attached... -- Friends don't let friends use GCC 3.4.4 GCC 3.3.6 produces code that's twice as fast on x86! http://users.rcn.com/alangrimes/ -------------- next part -------------- 'From Squeak3.7 of ''4 September 2004'' [latest update: #5989] on 2 November 2005 at 12:54:39 am'! Morph subclass: #SokobanMorph instanceVariableNames: 'sworld scoremorph player boxes' classVariableNames: 'Fields' poolDictionaries: '' category: 'Games-Sokoban'! !SokobanMorph commentStamp: '<historical>' prior: 0! This is a modified version of the Sokoban game. Modified by Stephan B Wessels! !SokobanMorph methodsFor: 'event handling' stamp: 'rhi 7/14/2003 20:05'! handlesKeyboard: aMorphicEvent ^ true! ! !SokobanMorph methodsFor: 'event handling' stamp: 'rhi 7/14/2003 18:08'! handlesMouseOver: aMorphicEvent ^ true! ! !SokobanMorph methodsFor: 'event handling' stamp: 'sbw 3/27/2004 21:16'! keyStroke: aKeyboardEvent | char accel | accel := aKeyboardEvent controlKeyPressed. char := aKeyboardEvent keyCharacter. char = Character arrowLeft ifTrue: [^ accel ifTrue: [self moveLeftFull] ifFalse: [self moveLeft]]. char = Character arrowRight ifTrue: [^ accel ifTrue: [self moveRightFull] ifFalse: [self moveRight]]. char = Character arrowUp ifTrue: [^ accel ifTrue: [self moveUpFull] ifFalse: [self moveUp]]. char = Character arrowDown ifTrue: [^ accel ifTrue: [self moveDownFull] ifFalse: [self moveDown]]. char asLowercase = $a ifTrue: [^ self again]. char asLowercase = $h ifTrue: [^ self help]. char asLowercase = $n ifTrue: [^ self next]. char asLowercase = $p ifTrue: [^ self previous]. char asLowercase = $q ifTrue: [^ self quit]. char asLowercase = $r ifTrue: [^ self random]. char asLowercase = $z ifTrue: [^ self undo]. char asLowercase = $g ifTrue: [^ self selectGame]. ^ super keyStroke: aKeyboardEvent! ! !SokobanMorph methodsFor: 'event handling' stamp: 'rhi 7/14/2003 18:08'! mouseEnter: aMorphicEvent aMorphicEvent hand newKeyboardFocus: self.! ! !SokobanMorph methodsFor: 'initialization' stamp: 'rhi 7/16/2003 12:33'! initialize self initializeForIndex: 1.! ! !SokobanMorph methodsFor: 'initialization' stamp: 'rhi 7/16/2003 10:07'! initializeForIndex: anInteger self initializeForWorld: (SokobanWorld fromIndex: anInteger).! ! !SokobanMorph methodsFor: 'initialization' stamp: 'none 9/4/2005 11:58'! initializeForWorld: aSokobanWorld super initialize. sworld _ aSokobanWorld. self extent: self fieldSize x * aSokobanWorld extent x @ (self fieldSize y * aSokobanWorld extent y + self controlsHeight); center: World center; initializeMoveStack; forceDestroyAndRedraw! ! !SokobanMorph methodsFor: 'initialization' stamp: 'none 9/4/2005 12:03'! initializeMoveStack sworld initializeMoveStack! ! !SokobanMorph methodsFor: 'initialization' stamp: 'rhi 7/16/2003 12:33'! initializeRandom self initializeForWorld: SokobanWorld random.! ! !SokobanMorph methodsFor: 'moving etc' stamp: 'none 9/4/2005 11:55'! again | position | (self confirm: 'Really start over?') ifTrue: [ position := self position. self delete; initializeForIndex: sworld index; position: position; openInWorld]! ! !SokobanMorph methodsFor: 'moving etc' stamp: 'sbw 3/27/2004 21:19'! help ((StringHolder new contents: 'The game was apparently invented in the early 1980s by Thinking Rabbit, a computer games company in the town of Takarazuka, Japan. The game design is said to have won first prize in a computer games contest. Because of the simplicity and elegance of the rules, and the intellectually challenging complexity of the composed problems, Sokoban quickly became a popular pastime. The object of Sokoban is to push all stones (or boxes) in a maze, such as the one to the right, to the designated goal areas. The player controls the man and the man can only push stones and only one at a time. The restriction of only being able to push the stones makes this game challenging: One can create unsolvable positions. Players will soon learn that this is the main obstacle in solving problems. Advanced players also try to find shorter and shorter solutions, measured in stone pushes and man moves. (http://www.cs.ualberta.ca/~games/Sokoban/) Key mappings: --- Cursor left -> move left (control key down moves as far left as possible) Cursor right -> move right (control key down moves as far right as possible) Cursor up -> move up (control key down moves as far up as possible) Cursor down -> move down (control key down moves as far down as possible) -- a -> again (same maze) h -> help n -> next (another maze, next in line) p -> previous (another maze, previous in line) r -> random (another maze, random selection) g - select a game number z -> undo last move -- q -> quit') embeddedInMorphicWindowLabeled: 'About Sokoban') setWindowColor: Color veryLightGray; openInWorld! ! !SokobanMorph methodsFor: 'moving etc' stamp: 'none 9/16/2005 18:19'! moveDown sworld moveDown. self redraw.! ! !SokobanMorph methodsFor: 'moving etc' stamp: 'none 9/16/2005 18:19'! moveDownFull sworld moveDownFull. self redraw! ! !SokobanMorph methodsFor: 'moving etc' stamp: 'none 9/16/2005 18:19'! moveLeft sworld moveLeft. self redraw.! ! !SokobanMorph methodsFor: 'moving etc' stamp: 'none 9/16/2005 18:19'! moveLeftFull sworld moveLeftFull. self redraw! ! !SokobanMorph methodsFor: 'moving etc' stamp: 'none 9/16/2005 18:19'! moveRight sworld moveRight. self redraw.! ! !SokobanMorph methodsFor: 'moving etc' stamp: 'none 9/16/2005 18:20'! moveRightFull sworld moveRightFull. self redraw! ! !SokobanMorph methodsFor: 'moving etc' stamp: 'none 9/16/2005 18:20'! moveUp sworld moveUp. self redraw.! ! !SokobanMorph methodsFor: 'moving etc' stamp: 'none 9/16/2005 18:20'! moveUpFull sworld moveUpFull. self redraw! ! !SokobanMorph methodsFor: 'moving etc' stamp: 'none 9/4/2005 12:05'! next | position | position _ self position. self delete; initializeForIndex: ((sworld index + 1) min: sworld class mazes size); position: position; openInWorld.! ! !SokobanMorph methodsFor: 'moving etc' stamp: 'none 9/4/2005 11:57'! previous | position | position _ self position. self delete; initializeForIndex: (( sworld index - 1) max: 1); position: position; openInWorld.! ! !SokobanMorph methodsFor: 'moving etc' stamp: 'sbw 3/27/2004 20:24'! quit (self confirm: 'Really quit?') ifTrue: [self delete]! ! !SokobanMorph methodsFor: 'moving etc' stamp: 'rhi 7/16/2003 12:34'! random | position | position _ self position. self delete; initializeRandom; position: position; openInWorld.! ! !SokobanMorph methodsFor: 'moving etc' stamp: 'none 9/16/2005 18:20'! undo sworld undo. self redraw! ! !SokobanMorph methodsFor: 'private' stamp: 'none 9/4/2005 18:52'! addControls: controls self addMorph: (controls position: self topLeft x @ (self bottomLeft y - self controlsHeight))! ! !SokobanMorph methodsFor: 'private' stamp: 'rhi 7/15/2003 20:08'! buildButtonForm: aForm action: aSymbol target: anObject | button | (button _ IconicButton new) labelGraphic: aForm; actionSelector: aSymbol; target: anObject; actWhen: #buttonDown; color: Color black; borderWidth: 0; height: self controlsHeight; layoutInset: 3; hResizing: #rigid; vResizing: #rigid; cornerStyle: #square; changeTableLayout. ^ button! ! !SokobanMorph methodsFor: 'private' stamp: 'rhi 7/16/2003 13:06'! buildButtonLabel: aString action: aSymbol target: anObject | button | (button _ SimpleButtonMorph new) label: aString asText allBold; actionSelector: aSymbol; target: anObject; actWhen: #buttonDown; color: Color black; borderWidth: 0; height: self controlsHeight; layoutInset: 3; hResizing: #rigid; vResizing: #rigid; cornerStyle: #square; changeTableLayout. (button findA: StringMorph) color: Color black. ^ button! ! !SokobanMorph methodsFor: 'private' stamp: 'rhi 7/16/2003 13:11'! buildButtonLabel: aString action: aSymbol target: anObject balloonText: anotherString ^ (self buildButtonLabel: aString action: aSymbol target: anObject) setBalloonText: anotherString! ! !SokobanMorph methodsFor: 'private' stamp: 'none 9/4/2005 11:55'! buildScores ^ TextMorph new contents: ' Maze ', sworld index printString, ' ¥ ', sworld moves printString, ' Moves', ' ¥ ', sworld pushes printString, ' Pushes'; color: Color white; backgroundColor: Color transparent; lock! ! !SokobanMorph methodsFor: 'private' stamp: 'rhi 7/15/2003 19:05'! controlsHeight ^ self class controlsHeight! ! !SokobanMorph methodsFor: 'private' stamp: 'rhi 7/15/2003 20:18'! cross ^ Form extent: 9 at 9 depth: 16 fromArray: #( 65537 0 0 1 65536 65537 65536 0 65537 65536 1 65537 1 65537 0 0 65537 65537 65536 0 0 1 65537 0 0 0 65537 65537 65536 0 1 65537 1 65537 0 65537 65536 0 65537 65536 65537 0 0 1 65536) offset: 0 at 0! ! !SokobanMorph methodsFor: 'private' stamp: 'rhi 7/15/2003 20:08'! downArrow ^ Form extent: 9 at 9 depth: 16 fromArray: #( 14253 862794605 862794605 862729101 934150144 14221 724182793 654911241 654913323 931987456 0 793519881 722086698 652880586 862781440 0 931998474 654977834 648621835 0 0 12107 654911209 717895565 0 0 13164 654976681 789250048 0 0 14254 722085546 929890304 0 0 0 860630796 934150144 0 0 0 934098861 0 0) offset: 0 at 0! ! !SokobanMorph methodsFor: 'private' stamp: 'none 9/4/2005 11:54'! fieldFor: aCharacter ^ (self class fields at: aCharacter) value! ! !SokobanMorph methodsFor: 'private' stamp: 'rhi 7/14/2003 20:37'! fieldSize ^ self class fieldSize! ! !SokobanMorph methodsFor: 'private' stamp: 'none 9/6/2005 12:24'! forceDestroyAndRedraw | x y topLeft | self flag: #rhi. "Apologies not only to Morphic fans..." self removeAllMorphs. self color: (sworld done ifTrue: [Color veryVeryLightGray] ifFalse: [Color lightGray]). topLeft := bounds topLeft. y := 0. boxes := Array new. sworld maze do: [:row | x := 0. row do: [:col | (sworld class allButFree includes: col) ifTrue: [| foo | (col ~= sworld class goal and: [(sworld wallsAt: x + 1 @ (y + 1)) = sworld class goal]) ifTrue: [self addMorph: ((self fieldFor: sworld class goal) position: topLeft + (x * self fieldSize x @ (y * self fieldSize y)))]. foo := (self fieldFor: col) position: topLeft + (x * self fieldSize x @ (y * self fieldSize y)). self addMorph: foo. (foo isKindOf: EllipseMorph) ifTrue: [boxes := boxes copyWith: foo] ifFalse: [(foo isKindOf: StarMorph) ifTrue: [player := foo]]]. x := x + 1]. y := y + 1]. "We need to ensure that our boxes and player are the frontmost things in the display, otherwise they tend to become obstructed by goal tiles. Because the comeToFront operation is fairly expensive, we do it here instead of in our incremental update method (draw)" boxes do: [:b | b comeToFront]. player comeToFront. self addControls: (self initControlsWidth: self width)! ! !SokobanMorph methodsFor: 'private' stamp: 'none 9/4/2005 18:53'! initControlsWidth: anInteger scoremorph := self buildScores. ^ Morph new color: Color darkGray; borderWidth: 0; height: self controlsHeight; width: anInteger; hResizing: #spaceFill; vResizing: #rigid; listDirection: #leftToRight; cellInset: 1; changeTableLayout; addMorph: scoremorph; addMorph: (self buildButtonForm: self downArrow action: #moveDown target: self); addMorph: (self buildButtonForm: self upArrow action: #moveUp target: self); addMorph: (self buildButtonForm: self rightArrow action: #moveRight target: self); addMorph: (self buildButtonForm: self leftArrow action: #moveLeft target: self); addMorph: ((self buildButtonLabel: 'z' action: #undo target: self balloonText: 'undo') color: Color lightGreen); addMorph: ((self buildButtonLabel: '?' action: #help target: self balloonText: 'Help') color: Color lightBlue); addMorph: ((self buildButtonLabel: 'X' action: #quit target: self balloonText: 'Quit') color: Color lightRed)! ! !SokobanMorph methodsFor: 'private' stamp: 'rhi 7/15/2003 20:08'! leftArrow ^ Form extent: 9 at 11 depth: 16 fromArray: #( 0 0 0 0 934084608 0 0 0 934162252 864813056 0 0 14221 724249354 862715904 0 0 793520938 722021130 864813056 0 864824106 654977802 722086666 864813056 13164 722085641 722086666 722086666 864878592 12043 646523626 722086698 722086666 864878592 14254 858532522 648685290 722086666 864878592 0 14221 789260970 650717962 864878592 0 0 13132 717892331 934084608 0 0 0 932000621 0) offset: 8 at 0! ! !SokobanMorph methodsFor: 'private' stamp: 'none 9/16/2005 18:19'! redraw "Once a game has started, no boxes are added or removed from the game. Therefore, the fastest way to update the screen is to assign the pieces new locations. We do this through our special array of boxes. The player is treated seperately. We also check for the winning state, and change the board's color as appropriate. Finally, the score string is updated and the screen is refreshed." | x y topLeft idx | idx := 1. sworld done ifTrue: [self color: Color veryVeryLightGray]. topLeft := bounds topLeft. y := 0. sworld maze do: [:row | x := 0. row do: [:col | col = sworld class box ifTrue: [(boxes at: idx) position: topLeft + (x * self fieldSize x @ (y * self fieldSize y)); color: Color red. idx := idx + 1] ifFalse: [col = sworld class boxAtGoal ifTrue: [(boxes at: idx) position: topLeft + (x * self fieldSize x @ (y * self fieldSize y)); color: Color green. idx := idx + 1] ifFalse: [col = sworld class player ifTrue: [player position: topLeft + (x * self fieldSize x @ (y * self fieldSize y))]]]. x := x + 1]. y := y + 1]. self updateScores; changed! ! !SokobanMorph methodsFor: 'private' stamp: 'rhi 7/15/2003 20:07'! rightArrow ^ Form extent: 9 at 11 depth: 16 fromArray: #( 934084608 0 0 0 0 864825164 934150144 0 0 0 862726922 724252557 0 0 0 864824074 722021162 793509888 0 0 864824074 722086666 654977834 864813056 0 864889610 722086666 722085641 722088812 0 864889610 722086698 722086634 646524683 0 864889610 722085610 648686250 858535854 0 864889610 650717866 789264269 0 0 934095595 717894476 0 0 0 13165 931987456 0 0 0) offset: 0 at 0! ! !SokobanMorph methodsFor: 'private' stamp: 'none 9/4/2005 11:57'! selectGame | upperLimit defaultNextIndex response selected position | upperLimit := sworld class mazes size. defaultNextIndex := sworld index + 1 min: upperLimit. response := FillInTheBlank request: 'Choose game # (1 to ', upperLimit printString, ')' initialAnswer: defaultNextIndex printString. response isEmptyOrNil ifTrue: [^self]. selected := response asNumber. (selected < 1 or: [selected > upperLimit]) ifTrue: [^self]. position := self position. self delete; initializeForIndex: selected; position: position; openInWorld ! ! !SokobanMorph methodsFor: 'private' stamp: 'rhi 7/15/2003 20:07'! upArrow ^ Form extent: 9 at 8 depth: 16 fromArray: #( 0 0 932001709 0 0 0 14254 793457484 0 0 0 13197 654912266 931987456 0 0 12107 654912266 862715904 0 0 931998474 722020105 724252557 0 0 793455401 724183850 724187021 0 14221 724182761 652879594 652816171 931987456 0 791422634 717892298 648686282 862781440) offset: 0 at 0! ! !SokobanMorph methodsFor: 'private' stamp: 'none 9/4/2005 16:41'! updateScores scoremorph contents: ' Maze ', sworld index printString, ' ¥ ', sworld moves printString, ' Moves', ' ¥ ', sworld pushes printString, ' Pushes'. ! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! SokobanMorph class instanceVariableNames: ''! !SokobanMorph class methodsFor: 'accessing' stamp: 'rhi 7/15/2003 17:18'! fields ^ Fields! ! !SokobanMorph class methodsFor: 'accessing' stamp: 'rhi 7/15/2003 17:18'! fields: anIdentityDictionary Fields _ anIdentityDictionary.! ! !SokobanMorph class methodsFor: 'class initialization' stamp: 'none 12/20/2004 22:02'! initFields self fields: (IdentityDictionary new at: SokobanWorld free put: [self freeField]; at: SokobanWorld wall put: [self wallField]; at: SokobanWorld box put: [self boxField]; at: SokobanWorld boxAtGoal put: [self boxAtGoalField]; at: SokobanWorld goal put: [self goalField]; at: SokobanWorld player put: [self playerField]; yourself).! ! !SokobanMorph class methodsFor: 'class initialization' stamp: 'rhi 7/16/2003 08:45'! initialize "doIt: [self initialize]" super initialize. self initFields.! ! !SokobanMorph class methodsFor: 'instance creation' stamp: 'rhi 7/16/2003 10:06'! forWorld: aSokobanWorld "doIt: [(self forWorld: (SokobanWorld fromFile: '.\Screens\screen.1')) openInWorld]" "doIt: [(self forWorld: (SokobanWorld fromIndex: 1)) openInWorld]" ^ self basicNew initializeForWorld: aSokobanWorld! ! !SokobanMorph class methodsFor: 'instance creation' stamp: 'rhi 7/16/2003 10:05'! random "doIt: [self random openInWorld]" ^ self new! ! !SokobanMorph class methodsFor: 'parts bin' stamp: 'rhi 7/16/2003 09:20'! descriptionForPartsBin ^ self partName: 'Sokoban' categories: #('Games') documentation: 'A tricky logic puzzle, created by Hiroyuki Imabayashi in 1982.'! ! !SokobanMorph class methodsFor: 'private' stamp: 'none 12/20/2004 22:04'! boxAtGoalField ^ EllipseMorph new extent: self fieldSize; color: Color green; borderWidth: 1; borderColor: Color gray.! ! !SokobanMorph class methodsFor: 'private' stamp: 'none 12/20/2004 22:03'! boxField ^ EllipseMorph new extent: self fieldSize; color: Color red; borderWidth: 1; borderColor: Color gray.! ! !SokobanMorph class methodsFor: 'private' stamp: 'sbw 4/14/2004 21:43'! controlsHeight ^ self fieldSize x min: 18! ! !SokobanMorph class methodsFor: 'private' stamp: 'sbw 4/14/2004 21:43'! fieldSize ^ 28 at 28! ! !SokobanMorph class methodsFor: 'private' stamp: 'rhi 7/15/2003 17:17'! freeField ^ Morph new extent: self fieldSize; color: Color white! ! !SokobanMorph class methodsFor: 'private' stamp: 'sbw 3/27/2004 19:21'! goalField | m | ^ (m := BorderedMorph new) extent: self fieldSize; color: Color paleYellow darker; borderWidth: 1; borderColor: m color darker! ! !SokobanMorph class methodsFor: 'private' stamp: 'sbw 4/14/2004 21:38'! playerField | m fill | m := StarMorph new extent: self fieldSize; color: Color lightBlue darker darker; borderWidth: 0; borderColor: Color darkGray. fill := GradientFillStyle ramp: {0.0->(Color r: 0.972 g: 0.878 b: 0.349). 1.0->(Color r: 0.972 g: 0.408 b: 0.317)}. fill origin: m topLeft. fill direction: 0 @ 21. fill radial: false. m fillStyle: fill. ^ m! ! !SokobanMorph class methodsFor: 'private' stamp: 'sbw 3/27/2004 19:22'! wallField | m | ^ (m := BorderedMorph new) extent: self fieldSize; color: Color paleGreen darker; borderWidth: 1; borderColor: m color darker; borderRaised! ! SokobanMorph initialize!
More information about the Squeak-dev mailing list |