|
Volume Number: 17 (2001)
Issue Number: 08
Column Tag: Programmer's Challenge
by Bob Boonstra, Westford, MA
Carribean Cruising
I love sailing. That is, most of the time I love it, in between the moments when I'm terrified in an exhilarating sort of way. I don't own a boat, which has allowed me to avoid both of the two favorite days of a boat owner's life - the day he buys the boat, and the day he sells the boat. Most years I'm a two-week-a-year sailor, renting small to medium size boats on inland lakes during summer vacations.
But this year we did something different. We decided to charter a sailboat and spend a week in the U.S. and British Virgin Islands. Thanks to Captain Jerry and Chef Christine Miller on a 51' Beneteau, the Rusty Nail II
So why am I telling you this? Not to arouse envy, certainly not. No, I'm telling you this because the August Challenge is based on sailing. Your task this month is to write code that will efficiently sail a simulated boat around a set of obstacles, through a specified sequence of marks.
The prototype for the code you should write is:
typedef struct Position { long x; /* positive x is East */ long y; /* positive y is North */ } Position; typedef double Direction; /* clockwise from north, in radians */ typedef struct Velocity { Direction direction; double speed; /* x velocity is speed*sin(direction) */ /* y velocity is speed*cos(direction) */ } Velocity; void InitCarribeanCruise( short numberOfMarks, Position mark[], /* must pass through mark[i] for each i in turn */ double tolerance, /* must pass within this distance of each mark */ double integrationInterval /* amount of time between calls to Cruise, in seconds */ ); Boolean /* done */ Cruise( Position boatLocation, /* boat position at the start of this time segment */ Velocity boatVelocity, /* boat velocity at the start of this time segment */ Velocity windVelocity, /* true wind velocity at this location and time */ double currentTime, /* time since cruise start, in seconds */ Direction *targetBoatDirection, /* commanded boat direction */ Direction *sailTrim /* commanded sail trim, 0..PI/4, measured as angle off the stern, in the direction away from the source of the wind. Actual sail position is a function of trim and wind direction. */ ); void TermCarribeanCruise(void);
The Challenge works like this. First, your InitCarribeanCruise routine is called, providing you with a description of the course to be followed. You will need to pass through the specified marks in sequence, approaching each within a specified distance tolerance. Then your Cruise routine is called repeatedly, at time intervals of integrationInterval, until you complete the course. Finally, your TermCarribeanCruise routine is called, where you should return any dynamically allocated memory.
With each Cruise call, you are given the current boatLocation and boatVelocity, along with the current WindVelocity for your location at the currentTime. You have two controls for the boat, the helm and the sailTrim. For simplicity, we're going to treat your boat as if it has only one sail - no need to separately trim the main and the jib. Our simplified sail trim model lets you control the maximum amount the sail can be let out, from 0° off the stern (tight trim) to 90° off the stern. The sail always moves away from the stern in the direction away from the source of the wind, clockwise off the stern when the wind is from starboard (right of the boat), and counterclockwise when the wind is from port (left of the boat).
High fidelity sailing models use complicated velocity prediction programs to determine boat speed as a function of wind and sails, but we'll use something simpler. When sailing into the wind (you cannot sail directly into the wind, but you can sail up to 45° off the wind direction in our model), the greatest sailing force is provided with the sails tight, 0° off the stern. As you fall off the wind, greater thrust is provided by easing the sails out. When the wind is directly astern (behind you), letting the sail out a full 90° provides the greatest thrust.
As counterintuitive as it might seem, you actually sail faster when going upwind. This is because the motion of the boat actually increases the apparent speed of the wind. You can take my word for it, or you can do a little vector arithmetic to convince yourself. Similarly, going downwind, the force of the wind on the boat actually approaches zero as the boat speed gets closer to the true wind speed, reducing the apparent wind speed. Of course, the resistance of the water prevents the boat from actually reducing the apparent wind speed to zero.
Enough about sailing, back to what you need to do. For each call to Cruise, you need to return the direction you want the boat to move (targetBoatDirection), and how you want to trim the sail (sailTrim). There are limits on how quickly the boat can turn, so you might not actually attain the targetBoatDirection in one integration interval. As for the sailTrim, if you ease the sail too much, it will luff and provide less (or perhaps no) force. If you keep it too tight, you'll also get less force from the wind and will go more slowly. The specifics of the velocity model will be included in the test code provided with the problem - see www.mactech.com/progchallenge/ for details.
Your objective is to sail through the marks as quickly as possible. The winner will be the entry that completes the course in the minimum simulated time, after adding a penalty of one simulated second for each millisecond of execution time. The Challenge prize will be divided between the overall winner and the best scoring entry from a contestant that has not won the Challenge recently.
This will be a native PowerPC Challenge, using the CodeWarrior Pro 6 environment. Solutions may be coded in C or C++. You may provide a solution in Java instead, provided you also provide a test driver equivalent to the C code provided on the web for this problem.
Three Months Ago Winner
Nine contestants, including many first-time participants, submitted entries for the May Klondike Challenge. This Challenge required readers to create a Klondike solitaire game using the RealBASIC development environment. Unlike most Challenges, performance played no role in evaluating the entries. Instead, the evaluation was based on features, both features specified in the problem statement, and extra features that readers were invited to add. There were several excellent solutions submitted, and it was difficult to select a winner. Congratulations to Peter Truskier (San Mateo, CA) for winning the Klondike Challenge.
Peter's solution satisfies all but one of the features specified in the problem. He provides a high quality representation of the game state; allows cards to be played by dragging them to their destination; highlights a legal destination when a card is dragged over it; provides an undo/redo capability; includes menu items for saving, replaying, and restarting games; and allows cards to be turned over in increments of one or three. As extras, he provides sound effects, including a shuffle sound at the start of a new game, a celebratory sound following victory, and feedback when a card was clicked. He displays the tableaus in staggered fashion, so it is possible to see how many cards remain to be uncovered (not all entries did this, which made play more difficult). Peter displays cards being dragged translucently, so it is possible to see what is under the card as it is dragged. He allows cards to be played to their final destinations by clicking as well as dragging. He provides extra preference options, including control over whether strict or loose rules apply to game play and scoring. And he provides preference control over the background and highlight colors. Peter's entry automatically detects a win when all cards have been uncovered and made playable, but before the cards are actually played. Finally, Peter provides a help function.
The second-place entry by Noah Desch also has some interesting features. He provides extensive preference options for controlling scoring, including subtracting points as time passes, subtracting points for multiple passes through the deck, and subtracting points as a penalty for using the undo/redo feature. His entry displays not only the score, but the elapsed time, and sound effects notify the user when a time penalty is being applied. His preference panel displays a rollover explanation of what each item does. Noah displays the top ten high scores and gives you an option to clear those scores. And he provides four choices for card deck style and three choices for the game board. Noah also provides warnings to the user when he quits a game that is in progress without saving it. Noah's entry was targeted at Mac OS X, but it ran under 9.1 as well. It could easily have been the winner.
Closely following Noah in the admittedly subjective scoring is Presidential Klondike, by Will Leshner. Will provides all of the specified features, plays sound effects during the game, and plays the U.S. national anthem as a bonus after a win. He also provides the convenience of automatically turning over the next card in a tableau when a card is played. Will provides preference control over sound, a scoring time penalty, and animation. He also provides a folder of saved games developed as his spouse became addicted to the game during testing (sorry about that. :)).
Tied in the scoring with Will, Thomas Reed also submitted an excellent entry. Thomas provides preference control over the game and scoring rules, a separate "hard *ss" option to set them all, and a slider control over the number of undo/redo levels allowed. He provides balloon help. And you can change the background by placing a gif file in a Backgrounds folder. Finally, Thomas provides a "play out" option, that will complete the game for you once all of the cards have been exposed.
Rounding out the top five entries is the submission from Jacqueline Landsman Gay. Jacque's entry would have scored even higher, but it was written in MetaCard rather than RealBASIC. Given the unusual rules for this Challenge, I decided to accept the entry, even though I couldn't rebuild the application (not having access to MetaCard), and instead withheld evaluation points for not meeting one of the problem requirements. The graphics in the game are excellent, it has a high score list, it provides options for the card back and playing surface. It also has attractive features cited for some of the earlier entries, like a shuffle sound, play by double-clicking cards, automatically detecting a win, and playing a tribute when a win is detected.
I also asked people for feedback about using RealBASIC or other non-C environments for the Challenge, and the reaction was quite positive. Many new readers decided to enter, although few traditional Challenge participants did so. I'm inclined to try this again sometime. If you have additional thoughts on the topic, let me know at progchallenge@mactech.com.
The table below lists, for each of the solutions submitted, the points earned in various categories: features specified in the problem statement, extra game play and help features, display and sound features, extra scoring and preference options, and a subjective assessment of style and quality of play. As usual, the number in parentheses after the entrant's name is the total number of Challenge points earned in all Challenges prior to this one.
Name | Specified | Play | Display |
Features | and Help | and Sound | |
Peter Truskier | 50 | 6 | 6 |
Noah Desch | 53 | 1 | 5 |
Will Leshner | 53 | 1 | 4 |
Thomas Reed | 53 | 3 | 4 |
Jacqueline Gay | 42 | 6 | 6 |
Henrik Rintala | 47 | 3 | 5 |
Bruno Dlubak | 50 | 0 | 3 |
Ernst Munter(751) | 32 | 3 | 2 |
Thomas Cunningham | 5 | 0 | 0 |
Name | Scoring | Style | TOTAL |
and Prefs | Points | Points | |
Peter Truskier | 1 | 10 | 73 |
Noah Desch | 6 | 6 | 71 |
Will Leshner | 2 | 10 | 70 |
Thomas Reed | 3 | 7 | 70 |
Jacqueline Gay | 4 | 8 | 66 |
Henrik Rintala | 1 | 4 | 60 |
Bruno Dlubak | 0 | 6 | 59 |
Ernst Munter | 0 | 4 | 41 |
Thomas Cunningham | 0 | 0 | 5 |
Top Contestants...
Listed here are the Top Contestants for the Programmer's Challenge, including everyone who has accumulated 20 or more points during the past two years. The numbers below include points awarded over the 24 most recent contests, including points earned by this month's entrants.
Rank | Name | Points | Wins | Total |
(24 mo) | (24 mo) | Points | ||
1. | Munter, Ernst | 284 | 11 | 751 |
2. | Rieken, Willeke | 83 | 3 | 134 |
3. | Saxton, Tom | 69 | 2 | 185 |
4. | Taylor, Jonathan | 56 | 2 | 56 |
5. | Wihlborg, Claes | 49 | 2 | 49 |
6. | Shearer, Rob | 55 | 1 | 62 |
7. | Maurer, Sebastian | 38 | 1 | 108 |
8. | Truskier, Peter | 20 | 1 | 20 |
...and the Top Contestants Looking for a Recent Win
In order to give some recognition to other participants in the Challenge, we also list the high scores for contestants who have accumulated points without taking first place in a Challenge during the past two years. Listed here are all of those contestants who have accumulated 6 or more points during the past two years.
Rank | Name | Points | Total |
(24 mo) | Points | ||
9. | Boring, Randy | 32 | 142 |
10. | Schotsman, Jan | 14 | 14 |
11. | Sadetsky, Gregory | 12 | 14 |
12. | Nepsund, Ronald | 10 | 57 |
13. | Day, Mark | 10 | 30 |
14. | Jones, Dennis | 10 | 22 |
15. | Downs, Andrew | 10 | 12 |
16. | Desch, Noah | 10 | 10 |
17. | Duga, Brady | 10 | 10 |
18. | Fazekas, Miklos | 10 | 10 |
19. | Flowers, Sue | 10 | 10 |
20. | Strout, Joe | 10 | 10 |
21. | Nicolle, Ludovic | 7 | 55 |
22. | Hala, Ladislav | 7 | 7 |
23. | Leshner, Will | 7 | 7 |
24. | Miller, Mike | 7 | 7 |
25. | Widyatama, Yudhi | 7 | 7 |
26. | Heithcock, JG | 6 | 43 |
There are three ways to earn points: (1) scoring in the top 5 of any Challenge, (2) being the first person to find a bug in a published winning solution or, (3) being the first person to suggest a Challenge that I use. The points you can win are:
1st place | 20 points | ||
2nd place | 10 points | ||
3rd place | 7 points | ||
4th place | 4 points | ||
5th place | 2 points | ||
finding bug | 2 points | ||
suggesting Challenge | 2 points |
Here is Peter's winning Klondike solution:
Klondike_ptruskier.rbp
Copyright © 2001
Peter Truskier
Window1 Window1.newGame: Sub newGame() Canvas1.newGame(flip3) gameOver = false gameUnderWay = false pushNewState() End Sub Window1.Open: Sub Open() dim i as integer canvas1.setDepth(32) canvas1.repaint newGame() showScore = true windowOpen = true aboutDialog.close End Sub Window1.Canvas1.MouseDrag: Sub MouseDrag(X As Integer, Y As Integer) dim i,j,m,n as integer me.targetPile = nil me.dragX = x me.dragY = y //are we dragging from the deck? if me.theDeck.topCardDragging then me.dragObj.matingRect.xUL = x - me.dragObj.mouseOffsetX me.dragObj.matingRect.yUL = y - me.dragObj.mouseOffsetY me.dragObj.matingRect.xLR = me.dragObj.matingRect.xUL + w1 me.dragObj.matingRect.yLR = me.dragObj.matingRect.yUL + h1 n = uBound(me.theTableaus) for i = 0 to n if me.theTableaus(i).myRect.isOverlapping(me.dragObj.matingRect) then if me.theTableaus(i).canIDrop(me.dragObj) then me.targetPile = me.theTableaus(i) exit end if end if next n = uBound(me.theFoundations) for i = 0 to n if me.theFoundations(i).myRect.isOverlapping(me.dragObj.matingRect) then if me.theFoundations(i).canIDrop(me.dragObj) then me.targetPile = me.theFoundations(i) exit end if end if next end if //or a tableau? m = uBound(me.theTableaus) for j = 0 to m if me.theTableaus(j).topCardDragging then me.dragObj.matingRect.xUL = x - me.dragObj.mouseOffsetX me.dragObj.matingRect.yUL = y - me.dragObj.mouseOffsetY me.dragObj.matingRect.xLR = me.dragObj.matingRect.xUL + w1 me.dragObj.matingRect.yLR = me.dragObj.matingRect.yUL + h1 n = uBound(me.theTableaus) for i = 0 to n if me.theTableaus(i).myRect.isOverlapping(me.dragObj.matingRect) then if me.theTableaus(i).canIDrop(me.dragObj) then me.targetPile = me.theTableaus(i) exit end if end if next n = uBound(me.theFoundations) for i = 0 to n if me.theFoundations(i).myRect.isOverlapping(me.dragObj.matingRect) then if me.theFoundations(i).canIDrop(me.dragObj) then me.targetPile = me.theFoundations(i) exit end if end if next end if next me.repaint End Sub Window1.Canvas1.dealCards: Sub dealCards() dim i,j,n as integer dim num as integer for i = 0 to 6 for j = i to 6 num = num + 1 if j = i then me.theTableaus(j).addCard(me.theDeck.getTopCard,true) else me.theTableaus(j).addCard(me.theDeck.getTopCard,false) end if next next //initialize the score me.theScore = me.theScore - 52 //save a state on the stack pushNewState() End Sub Window1.Canvas1.MouseUp: Sub MouseUp(X As Integer, Y As Integer) dim success as boolean dim i,n as integer dim temp as integer if not gameOver then temp = me.theScore me.dragging = false me.theDeck.topCardDragging = false if me.deckRect1.isWithin(x,y) then me.theDeck.flip me.graphics.drawPicture dimCard,me.deckRect1.xUL,me.deckRect1.yUL else n = uBound(me.theTableaus) for i = 0 to n me.theTableaus(i).topCardDragging = false next if me.targetPile <> nil then success = me.targetPile.dropCards(me.dragObj,temp) me.dragObj.source.removeCards(me.dragObj) me.dragObj = nil elseif me.dragObj <> NIL then //here's where we implement playng a top card to a foundation with a click //in this case, me.targetPile will be nil, but me.dragObj will NOT for i = 0 to 3 if me.theFoundations(i).canIDrop(me.dragObj) then success = me.theFoundations(i).dropCards(me.dragObj,temp) me.dragObj.source.removeCards(me.dragObj) me.dragObj = nil me.repaint exit //the for-next loop end if next end if end if me.targetPile = nil me.theScore = temp me.repaint end if End Sub Window1.Canvas1.MouseDown: Function MouseDown(X As Integer, Y As Integer) As Boolean dim i,n as integer if not gameOver then if me.deckRect2.isWithin(x,y) then me.dragObj = me.theDeck.getDragCard(x,y,me.deckRect2.yUL,me.deckRect2.xUL) me.dragging = true else for i = 0 to 6 if me.theTableaus(i).myRect.isWithin(x,y) then n = uBound(me.theTableaus(i).theCards) if n > -1 then if me.theTableaus(i).theCards(n).faceUP then me.dragObj = me.theTableaus(i).getDragCards(x,y) me.dragging = true else me.theTableaus(i).theCards(uBound(me.theTableaus(i).theCards)).faceUP = true pushNewState() cardDownSound.play end if end if end if next end if return true end if End Function Window1.Canvas1.Open: Sub Open() dim i as integer //initilaize the position of our deck rectangles me.deckRect1 = new aRectangle(20,220,w1,h1) me.deckRect2 = new aRectangle(20,320,w1,h1+44) End Sub Window1.Canvas1.Paint: Sub Paint(g as Graphics) dim i,c,w as integer dim s as string if windowOpen then //don't draw intot he window unless it ready g.foreColor = backGroundColor g.fillRect 0,0,me.width,me.height //draw the deck me.theDeck.drawSelf(g,me.deckRect1,me.deckRect2) //draw each fo the tableaux for i = 0 to 6 me.theTableaus(i).drawSelf(g) next //and each of the foundations for i = 0 to 3 me.theFoundations(i).drawSelf(g) next //if we are dragging then draw the drag object's pict if me.dragging then if me.dragObj <> NIL then g.drawPicture me.dragObj.thePic,me.dragX - me.dragObj.mouseOffsetX,me.dragY - me.dragObj.mouseOffsetY end if end if if showScore then me.drawScore(g,480,20) end if if gameWon then for i = 0 to 51 g.drawPicture packOfCards(i).cardPic,rnd*(self.width - w1),rnd*(self.height - h1) next c = round(rnd)*255 g.foreColor = rgb(c,0,0) s = "You Win !!" g.textSize = 110 w = g.stringWidth(s) g.drawString s,(me.width - w)/2,me.height/2 + 18 end if end if End Sub Card // see online code app // see online code CardConstants // see online code Globals // see online code deck deck.deck: Sub deck(f3 as boolean) //constructor dim i as integer flipThree = f3 for i = 0 to 51 me.theCards.append packOfCards(i) next currentCard = -1 clearStates() End Sub deck.drawSelf: Sub drawSelf(g as graphics,L as aRectangle, R as aRectangle) dim x1,y1,x2,y2 as Integer dim dY as integer dim i,n,numCards,numUP as integer x1 = L.xUL y1 = L.yUL x2 = R.xUL y2 = R.yUL if not gameOver then g.drawPicture cardBack, x1,y1 g.drawPicture dimCard, x2,y2 if currentCard > -1 then if flipThree then n = 2 else n = 0 end if n = min(n,currentCard ) numCards = uBound(theCards) for i = 0 to numCards if theCards(i).faceUP then numUP = numUP + 1 end if next if numUP = 0 then theCards(currentCard).faceUP = true end if for i = -n to 0 if theCards(currentCard + i).faceUP then g.drawPicture theCards(currentCard + i).cardPic,x2,y2 + dY dY = dY + 19 end if next if dY > 0 then dY = dY - 19 end if if topCardDragging then g.drawPicture dimCard,x2,y2+(numUP-1)*19 end if else g.drawPicture doneWithDeckCard, x1,y1 end if else //game over g.drawPicture gameOverCard, x1,y1 end if End Sub deck.shuffle: Sub shuffle() dim i,j as integer dim tempCard as card dim t1,t2 as double t1 = microseconds shuffleSound.playLooping do until t2 > t1 +750000 j = rnd*52 tempCard = theCards(j) theCards.remove j j = rnd*51 theCards.insert j,tempCard t2 = microseconds loop for i = 0 to 51 theCards(i).faceUP = false next currentCard = -1 shuffleSound.stop End Sub deck.flip: Sub flip() dim i,n,numCards as integer dim newCurrentCard as integer if not gameOver then numCards = uBound(theCards) carddownSound.play if not done then if flipThree then n = 3 else n = 1 end if //turn them all face down for i = 0 to currentCard theCards(i).faceUp = false next newCurrentCard = min(currentCard + n,numCards) if newCurrentCard = numCards then done = true timesThroughDeck = timesThroughDeck + 1 if strict then if flip3 then gameOver = (timesThroughDeck = 3) else gameOver = (timesThroughDeck = 1) end if end if end if if newCurrentCard <= numCards then for i = currentCard + 1 to newCurrentCard theCards(i).faceUP = true next currentCard = newCurrentCard end if else // the deck IS done n = uBound(theCards) for i = 0 to n theCards(i).faceUp = false next currentCard = -1 done = false end if gameUnderWay = true pushNewState() end if End Sub deck.getTopCard: Function getTopCard() As card dim tempCard as card tempCard = theCards(0) theCards.remove 0 return tempCard End Function deck.getDragCard: Function getDragCard(x as integer,y as integer,t as integer,l as integer) As dragObject dim d as dragObject dim p as picture dim topCardTop as integer dim i,numCards,numUP as integer if currentCard > -1 then numCards = uBound(theCards) for i = 0 to numCards if theCards(i).faceUP then numUP = numUP + 1 end if next topCardTop = t + (numUP-1)*19 if y < topCardTop + h1 then d = new dragObject d.source = me p = newpicture(dragCard.width,dragCard.height,32) if p = nil then msgBox "NIL PIC IN deck.getdragcards" end if d.theCards.append me.theCards(currentCard) d.matingCard = me.theCards(currentCard) p.graphics.drawPicture dragCard,0,0 p.graphics.drawPicture d.theCards(0).cardPic,0,0 p.mask.graphics.drawPicture dragShadow2,0,0 d.thePic = p d.mouseOffsetX = x - l d.mouseOffsetY = y - topCardTop topCardDragging = true flySound.play return d end if end if End Function deck.removeCards: Sub removeCards(d As dragObject) me.theCards.remove currentCard currentCard = currentCard - 1 pushNewState() End Sub deck.stateString: Function stateString() As string //save a string representation of the current state of the deck dim s as string dim i,n as integer if flipThree then s = "3|" else s = "1|" end if s = s + str(currentCard) + "|" if gameUnderWay then s = s + "gameUnderWay"+"|" else s = s + "|" end if if gameOver then s = s + "gameOver"+"|" else s = s + "|" end if if done then s = s + "done"+"|" else s = s + "|" end if n = uBound(theCards) for i = 0 to n s = s + theCards(i).stateString + "," next return s End Function deck.restoreState: Sub restoreState(stateStr as string) //restore the state of the deck represented in the string saved by the stateString method dim s,cardStr as string dim i,n,v as integer s = nthField(stateStr,"|",1) me.flipThree = (s = "3") s = nthField(stateStr,"|",2) me.currentCard = val(s) gameUnderWay = (nthField(stateStr,"|",3) = "gameUnderWay") gameOver = (nthField(stateStr,"|",4) = "gameOver") done = (nthField(stateStr,"|",5) = "done") s = nthField(stateStr,"|",6) n = countFields(s,",") redim me.theCards(-1) for i = 1 to n if s <> "" then cardStr = nthField(s,",",i) if cardStr <> "" then v = val(cardStr) if v > 51 then v = v - 52 packOfCards(v).faceUp = true else packOfCards(v).faceUp = false end if me.theCards.append packOfCards((v)) end if end if next End Sub deck.CardCount: Function CardCount() As integer return uBound(theCards) + 1 End Function SmoothCanvas // see online code CardCanvas CardCanvas.dealCards: Sub dealCards() dealCards() End Sub CardCanvas.newGame: Sub newGame(flip3 as boolean) dim i as integer redim theFoundations(-1) redim theTableaus(-1) me.theDeck = new deck(flip3) me.theDeck.shuffle for i = 0 to 6 me.theTableaus.append new tableau(new aRectangle(110+65*i,120,w1,h1)) next for i = 0 to 3 me.theFoundations.append new foundation(new aRectangle(110+97*i,10,w1,h1)) next dealCards timesThroughDeck = 0 me.repaint End Sub CardCanvas.drawScore: Sub drawScore(g as graphics,x as integer,y as integer) dim i,n as integer dim s as string dim neg as boolean g.forecolor = rgb(0,0,0) g.textSize = 12 neg = (theScore < 0) s = "Score: " if neg then g.forecolor = rgb(255,0,0) s = s + " - " end if s = s + "$" + str(abs(theScore)) g.drawString s,x,y End Sub CardCanvas.updateWinningGameScore: Sub updateWinningGameScore() dim i,n as integer theScore = theScore + me.theDeck.cardCount * 5 for i = 0 to 6 theScore = theScore + me.theTableaus(i).cardCount*5 next End Sub CardCanvas.stateString: Function stateString() As string return str(theScore) End Function CardCanvas.restoreState: Sub restoreState(stateStr as string) theScore = val(stateStr) End Sub soundGlobals // see online code aRectangle // see online code tableau tableau.tableau: Sub tableau(r as aRectangle) me.myRect = r End Sub tableau.addCard: Sub addCard(c as card,fUP as boolean) theCards.append c c.faceUp = fUP End Sub tableau.drawSelf: Sub drawSelf(g as graphics) dim x,y,dY,numUP as integer dim i,n as integer n = uBound(theCards) numUp = 0 x = myRect.xUL y = myRect.yUL g.drawPicture dimCard,x,y for i = 0 to n if theCards(i).faceUp then g.drawPicture theCards(i).cardPic,x,y y = y + 19 numUP = numUP + 1 else g.drawPicture cardBack,x,y y = y + 3 end if next if numUP = 0 then numUP = 1 end if if n = -1 then n = 0 end if myRect.yLR = myRect.yUL + h1 dY = (numUP - 1)*16 + (n)*3 myRect.yLR = myRect.yLR + dY if me.couldAccept then g.drawPicture hiliteCard,myRect.xUL,myRect.yLR - h1 couldAccept = false end if if topCardDragging then g.drawPicture myDimCard,myRect.xUL,myRect.yLR - myDimCard.height end if End Sub tableau.canIDrop: Function canIDrop(d as dragObject) As boolean dim n as integer couldAccept = false n = uBound(me.theCards) if n > -1 then couldAccept = (d.matingCard.isRed <> me.theCards(n).isRed) and (d.matingCard.cardVal = me.theCards(n).cardVal - 1) else couldAccept = (d.matingCard.cardVal = 12) end if return couldAccept End Function tableau.dropCards: Function dropCards(d As dragObject,byRef theScore as integer) As Boolean dim i,n as integer n = uBound(d.theCards) cardDownSound.play for i = 0 to n d.theCards(i).faceUP = true me.theCards.append d.theCards(i) next gameUnderWay = true End Function tableau.removeCards: Sub removeCards(d As dragObject) dim i,j,m,n as integer n = uBound(d.theCards) for i = 0 to n m = uBound(me.theCards) me.theCards.remove m next pushNewState() End Sub tableau.getDragCards: Function getDragCards(x as integer,y as integer) As dragObject dim d as dragObject dim p,pMask,tempPic as picture dim bottomCard as integer dim i,numCards,numUP,curTop as integer dim picHt as integer if not gameOver then bottomCard = whichCard(y) d = new dragObject if strict then if bottomCard <> uBound(theCards) then //unless it's the top card... for i = 0 to (bottomCard-1) if theCards(i).faceUP then return d //we'll return a null object since the player cannot play a partial run... end if next end if end if if theCards(bottomCard).faceUP then //don't even consider face down cards d.source = me numCards = uBound(theCards) picHt = dragCard.height + (numCards - bottomCard)*19 p = newpicture(dragCard.width,picHt,32) if p = nil then msgBox "NIL PIC IN tableau.getdragcards" end if myDimCard = newpicture(w1,picHt-14,32) if p = nil then msgBox "NIL PIC IN tableau.getdragcards" end if pMask = newpicture(dragCard.width,picHt,8) if p = nil then msgBox "NIL PIC IN tableau.getdragcards" end if p.graphics.foreColor = rgb(0,0,0) p.graphics.fillrect 0,0,p.width,p.height for i = bottomCard to numCards d.theCards.append me.theCards(i) p.graphics.drawPicture me.theCards(i).cardPic,0,curTop p.graphics.drawPicture tempPic,0,curTop if i = bottomCard then pMask.graphics.drawPicture dragShadow2,0,curTop else pMask.graphics.drawPicture dragShadow3,0,curTop end if if i = bottomCard then myDimCard.mask.graphics.drawPicture dimCardMask,0,curTop else myDimCard.mask.graphics.drawPicture dimCardMask2,0,curTop end if curTop = curTop + 19 next d.matingCard = me.theCards(bottomCard) d.thePic = p d.mouseOffsetX = x - me.myRect.xUL d.mouseOffsetY = y - topOfCardY(bottomCard) - myRect.yUL topCardDragging = true end if p.mask.graphics.drawPicture pMask,0,0 flySound.play return d end if End Function tableau.whichCard: Function whichCard(canvasY as integer) As integer dim i,n,testY as integer testY = 0 n = uBound(me.theCards) for i = 0 to n if testY > canvasY-myRect.yUL then return i - 1 end if if theCards(i).faceUP then testY = testY + 19 else testY = testY + 3 end if next return n //if we've gotten here, it must be the top card... End Function tableau.topOfCardY: Function topOfCardY(theIndex as integer) As integer //this function will return the top of the specified card in local coordinates dim i,n,curTop as integer n = uBound(theCards) for i = 0 to n if i = theIndex then exit end if if theCards(i).faceUP then curTop = curTop + 19 else curTop = curTop + 3 end if next return curTop End Function tableau.stateString: Function stateString() As string //save a string representation of the current state of this tableau dim s as string dim i,n as integer s = myRect.stateString + "|" n = uBound(theCards) for i = 0 to n s = s + theCards(i).stateString + "," next return s End Function tableau.restoreState: Sub restoreState(stateStr as string) //restore the state of this tableau represented in the string saved by the stateString method dim s,cardStr as string dim i,n,v as integer s = nthField(stateStr,"|",1) me.myRect.restoreState(s) s = nthField(stateStr,"|",2) n = countFields(s,",") redim me.theCards(-1) for i = 1 to n if s <> "" then cardStr = nthField(s,",",i) if cardStr <> "" then v = val(cardStr) if v > 51 then v = v - 52 packOfCards(v).faceUp = true else packOfCards(v).faceUp = false end if me.theCards.append packOfCards((v)) end if end if next End Sub tableau.allFaceUp: Function allFaceUp() As boolean dim i,n as integer if uBound(me.theCards) <=0 then return true end if n = uBound(theCards) for i = 0 to n if not theCards(i).faceUP then return false end if next return true End Function tableau.cardCount: Function cardCount() As integer return uBound(theCards) + 1 End Function Foundation Foundation.foundation: Sub foundation(r as aRectangle) me.myRect = r End Sub Foundation.addCard: Sub addCard(c as card) theCards.append c End Sub Foundation.drawSelf: Sub drawSelf(g as graphics) dim x,y,dY,numUP as integer dim i,n as integer n = uBound(theCards) x = myRect.xUL y = myRect.yUL g.drawPicture dimCard,x,y if n > -1 then g.drawPicture theCards(n).cardPic,x,y end if if me.couldAccept then g.drawPicture hiliteCard,myRect.xUL,myRect.yUL couldAccept = false end if End Sub Foundation.canIDrop: Function canIDrop(d As dragObject) As Boolean dim n as integer couldAccept = false n = uBound(d.theCards) if n <> 0 then //you can only move one card to a foundation return couldAccept end if n = uBound(me.theCards) if n > -1 then couldAccept = (d.matingCard.cardSuit = me.theCards(n).cardSuit) and (d.matingCard.cardVal = me.theCards(n).cardVal + 1) else couldAccept = (d.matingCard.cardVal = 0) end if return couldAccept End Function Foundation.dropCards: Function dropCards(d As dragObject,byRef theScore as integer) As boolean cardDownSound.play d.theCards(0).faceUP = true me.theCards.append d.theCards(0) theScore = theScore + 5 gameUnderWay = true return true End Function Foundation.stateString: Function stateString() As string //save a string representation of the current state of this foundation dim s as string dim i,n as integer n = uBound(theCards) for i = 0 to n s = s + theCards(i).stateString + "," next return s End Function Foundation.restoreState: Sub restoreState(stateStr as string) //restore the state of this foundation represented in the string saved by the stateString method dim i,n,v as integer dim s,cardStr as string n = countFields(stateStr,",") redim me.theCards(-1) for i = 1 to n cardStr = nthField(stateStr,",",i) if cardStr <> "" then v = val(cardStr) if v > 51 then v = v - 52 packOfCards(v).faceUp = true else packOfCards(v).faceUp = false end if me.theCards.append packOfCards((v)) end if next End Sub dragObject dragObject.dragObject: Sub dragObject() //the "matingRect" is the rectangle that we will test for overlap with each // tableau and foundation me.matingRect = new aRectangle(0,0,w1,h1) End Sub DroppablePile.canIDrop: Function canIDrop(d as dragObject) As boolean End Function DroppablePile DroppablePile.dropCards: Function dropCards(d as dragObject,byRef theScore as integer) As boolean End Function dropSource.removeCards: Sub removeCards(d as dragObject) End Sub stateMachine stateMachine.theStateString: Function theStateString() As string dim i,n as integer dim s as string s = globalsStateString + "&" s = s + window1.canvas1.stateString + "&" s = s + window1.canvas1.theDeck.stateString + "&" for i = 0 to 6 s = s + window1.canvas1.theTableaus(i).stateString + "&" next for i = 0 to 2 s = s + window1.canvas1.theFoundations(i).stateString + "&" next s = s + window1.canvas1.theFoundations(3).stateString return s End Function stateMachine.restoreTheState: Sub restoreTheState(stateStr as string) dim i,n as integer dim s as string restoreGlobals(nthField(stateStr,"&",1)) window1.canvas1.restoreState(nthField(stateStr,"&",2)) window1.canvas1.theDeck.restoreState(nthField(stateStr,"&",3)) for i = 0 to 6 window1.canvas1.theTableaus(i).restoreState(nthField(stateStr,"&",i+4)) next for i = 0 to 3 window1.canvas1.theFoundations(i).restoreState(nthField(stateStr,"&",i+11)) next window1.canvas1.repaint End Sub stateMachine.initStateMachine: Sub initStateMachine() currentState = -1 End Sub stateMachine.undoAvailable: Function undoAvailable() As boolean return currentState > 0 End Function stateMachine.redoAvailable: Function redoAvailable() As boolean return uBound(stateArray) > currentState End Function stateMachine.pushNewState: Sub pushNewState() dim i,n as integer dim s as string //first we need to pop off anything above our current state.. n = uBound(stateArray) for i = currentState+1 to n stateArray.remove (currentState+1) next s = theStateString stateArray.append s currentState = uBound(stateArray) if hasGameBeenWon then doGameWinRoutine end if //now we'll raise our flag to mark us as dirty gDirty = true End Sub stateMachine.undo: Sub undo() currentState = currentState - 1 restoreTheState(stateArray(currentState)) undoSound.play End Sub stateMachine.redo: Sub redo() currentState = currentState + 1 undoSound.play restoreTheState(stateArray(currentState)) End Sub stateMachine.clearStates: Sub clearStates() redim stateArray(-1) currentState = -1 End Sub stateMachine.startOver: Sub startOver() dim i,n as integer n = uBound(stateArray) for i = n downto 0 currentState = i restoreTheState(stateArray(i)) undoSound.play next End Sub stateMachine.saveGameFile: Function saveGameFile() As boolean dim f as folderItem dim tos as textOutputStream dim i,n as integer f = getSaveFolderItem("TEXT","myGame") if f <> NIL then tos = f.createTextFile if tos <> NIL then n = uBound(stateArray) for i = 0 to n tos.writeLine stateArray(i) next tos.close gDirty = false return true end if end if return false End Function stateMachine.openGameFile: Function openGameFile() As boolean dim f as folderItem dim tis as textInputStream dim s as string f = getOpenFolderItem("TEXT") if f <> NIL then tis = f.openAsTextFile if tis <> NIL then clearStates() while not tis.eof s = tis.readLine stateArray.append s currentState = uBound(stateArray) wend restoreTheState(stateArray(currentState)) gDirty = false return true end if end if return false End Function AboutDialog // see online code PrefsWin // see online code AlertWin // see online code
- SPREAD THE WORD:
- Slashdot
- Digg
- Del.icio.us
- Newsvine