2 Nov
2005
2 Nov
'05
7 a.m.
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/
'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@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@0! !
!SokobanMorph methodsFor: 'private' stamp: 'rhi 7/15/2003 20:08'!
downArrow
^ Form
extent: 9@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@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@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@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@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@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@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@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@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!