Share Gallery 1

home *** CD-ROM | disk | FTP | other *** search

/ Share Gallery 1 / share_gal_1.zip / share_gal_1 / UT / UT070.ZIP / MENUS.EXE / SLIDE.MNU < prev next >

Wrap

Text File | 1990-11-11 | 9KB | 419 lines

Comment ======================================= Slide.mnu The object of this game is to move the tiles into numerical order. The shuffle feature does not generate a truly random order, it just starts you at a different place. Marc is going to work on the RANDOM function in MarxMenu to work better. Enjoy! KLM (06-01-90) Kevin L. Moore Computer Tyme (417)866-1665 (417)546-3130 ======================================= EndComment Var TileArr Row Col TmpArr OldCol OldRow ClearChar MainScreenForeColor MainScreenBackColor TitleForeColor TitleBackColor WindowBorderForeColor WindowBorderBackColor WindowInsideForeColor WindowInsideBackColor TileForeColor TileBackColor TileNumForeColor TileNumBackColor MessageWinBorderForeColor MessageWinBorderBackColor MessageWinInsideForeColor MessageWinInsideBackColor Const MaxRow = 4 MaxCol = 4 Main Procedure Setup if ColorScreen MainScreenForeColor = White MainScreenBackColor = Blue TitleForeColor = Yellow TitleBackColor = Mag WindowBorderForeColor = LRed WindowBorderBackColor = Brown WindowInsideForeColor = Blue WindowInsideBackColor = Brown TileForeColor = Blue TileBackColor = Brown TileNumForeColor = White TileNumBackColor = Blue MessageWinBorderForeColor = Green MessageWinBorderBackColor = Brown MessageWinInsideForeColor = Yellow MessageWinInsideBackColor = Brown ClearChar = 32 else MainScreenForeColor = Grey MainScreenBackColor = Black TitleForeColor = Black TitleBackColor = Grey WindowBorderForeColor = White WindowBorderBackColor = Brown WindowInsideForeColor = White WindowInsideBackColor = Brown TileForeColor = Green TileBackColor = Black TileNumForeColor = Black TileNumBackColor = Grey MessageWinBorderForeColor = Green MessageWinBorderBackColor = Brown MessageWinInsideForeColor = Yellow MessageWinInsideBackColor = Brown ClearChar = 177 endif UseArrows Off TextColor MainScreenForeColor MainScreenBackColor ClearScreen ClearChar TextColor TitleForeColor TitleBackColor GotoXY 1 1 ClearLine GotoXY 63 1 Write 'Slide Puzzle 1.00' GotoXY 1 24 ClearLine WriteCenter 'F1 - Panic Button * F10 - Shuffle * ESC - Exit ' GotoXY 1 25 ClearLine WriteCenter '(C) Copyright 1990 Computer Tyme * All rights reserved' ClockColor TitleForeColor TitleBackColor ClockPos 1 1 Explode Off Shadow Off BlockBox BoxBorderColor WindowBorderForeColor WindowBorderBackColor BoxInsideColor WindowInsideForeColor WindowInsideBackColor DrawBox 20 3 45 19 DrawBoard Shuffle NumberBoard EndProc ;Setup ;--- Procedure DrawBoard Var X Y TextColor TileForeColor TileBackColor X = 1 While X < (MaxRow + 1) GotoXY 1, ((X * 4) - 2) Writeln ' ██████ ██████ ██████ ██████' Writeln ' ██████ ██████ ██████ ██████' Write ' ██████ ██████ ██████ ██████' X = X + 1 EndWhile EndProc ;DrawBoard ;--- Procedure NumberBoard Var X Y TextColor TileNumForeColor TileNumBackColor X = 1 While X < (MaxRow + 1) Y = 1 While Y < (MaxCol + 1) NumberTile (X, Y) Y = Y + 1 EndWhile X = X + 1 EndWhile DrawEmptyTile EndProc ;NumberBoard ;--- Procedure DrawEmptyTile NoBoxBorder BoxInsideColor TileBackColor TileBackColor DrawBox (((Col + 3) * 7) + 1) (((Row + 1) * 4) - 3) 6 3 EndProc ;DrawEmptyTile ;--- Procedure Shuffle Var X Y C Seed BlockBox BoxInsideColor Yellow Brown DrawBox 27 10 30 3 WriteCenter 'Shuffling . . .' Seed = Random C = 1 While C < ((MaxRow * MaxCol) + 1) TmpArr[C] = C C = C + 1 EndWhile C = 0 X = 1 While X < (MaxRow + 1) Y = 1 While Y < (MaxCol + 1) TileArr[X,Y] = 99 While TileArr[X,Y] = 99 C = ( Random Mod (MaxRow * MaxCol)) + 1 if TmpArr[C] <> 0 If C = (MaxRow * MaxCol) TileArr[X,Y] = 0 Row = X Col = Y else TileArr[X,Y] = C endif TmpArr[C] = 0 endif EndWhile Y = Y + 1 EndWhile X = X + 1 EndWhile EraseTopWindow EndProc ;Shuffle ;--- Procedure SlideRight if Col > 1 TileArr[Row, Col] = Tilearr[Row, Col - 1] OldRow = Row OldCol = Col TileArr[Row, Col - 1] = 0 Col = Col - 1 MoveTile endif EndProc ;SlideRight ;--- Procedure SlideLeft If Col < MaxCol TileArr[Row, Col] = TileArr[Row, Col + 1] OldCol = Col OldRow = Row TileArr[Row, Col + 1] = 0 Col = Col + 1 MoveTile endif EndProc ;SlideLeft ;--- Procedure SlideUp If Row < MaxRow TileArr[Row, Col] = TileArr[Row + 1, Col] OldCol = Col OldRow = Row TileArr[Row + 1, Col] = 0 Row = Row + 1 MoveTile endif EndProc ;SlideUp ;--- Procedure SlideDown If Row > 1 TileArr[Row, Col] = TileArr[Row - 1, Col] OldRow = Row OldCol = Col TileArr[Row - 1, Col] = 0 Row = Row - 1 MoveTile endif EndProc ;SlideDown ;--- Procedure MoveTile EraseTopWindow NumberTile (OLdRow, OldCol) DrawEmptyTile if CheckForWin AdmitDefeat ClearScreen if AskYesNo(' Play again') Shuffle DrawBoard else ExitMenu endif endif EndProc ;MoveTile ;--- Procedure NumberTile (X, Y) TextColor TileNumForeColor TileNumBackColor GotoXY ((Y * 7) + 4) ((X * 4) - 1) If TileArr[X, Y] < 10 then Write ' ' Write TileArr[X,Y] EndProc ;NumberTile ;--- Procedure CheckForWin Var X Y C C = 0 X = 1 While X < (MaxRow + 1) Y = 1 While Y < (MaxCol + 1) C = C + 1 if (TileArr[X,Y] <> 0) if TileArr[X,Y] <> C then Return False endif Y = Y + 1 EndWhile X = X + 1 EndWhile Return True EndProc ;CheckForWin ;--- Procedure AdmitDefeat BlockBox BoxBorderColor MessageWinBorderForeColor MessageWinBorderBackColor BoxInsideColor MessageWinInsideForeColor MessageWinInsideBackColor Drawbox 27 11 31 3 WriteCenter 'You Win !!!' Write Char(7) Write Char(7) Wait(150) EndProc ;AdmitDefeat ;--- Procedure AskYesNo (Question) Var YesNo Write ' ',Question,' [Y,N] ? ' YesNo = UpperCase(ReadKey) YesNo = YesNo = 'Y' if YesNo Write 'Yes' else Write 'No' endif Wait 50 EraseTopWindow Return (YesNo) EndProc ;AskYesNo ;--- Procedure PanicButton Var AllClear NoBoxBorder ClockPos 0,0 BoxInsideColor White Blue DrawBox 1 1 80 25 Writeln 'SuperCalc 1.00 Memory: 52163' Writeln '1 A B C D E F G' Writeln '1' Writeln '2' Writeln '3' Writeln '4' Writeln '5' Writeln '6' Writeln '7' Writeln '8' Writeln '9' Writeln '10' Writeln '11' Writeln '12' Writeln '13' Writeln '14' Writeln '15' Writeln '16' Writeln '17' Writeln '18' Writeln '19' Writeln 'A3 Empty No file' Writeln Writeln Write 'F2-Save F3-Load F7-Formula F8-AutoCalc F9-Recalc F10-Menu Ins-Block Alt-X-Exit' AllClear = ReadKey EraseTopWindow ClockColor TitleForeColor TitleBackColor ClockPos 1 1 EndProc ;PanicButton ;--- Procedure Main Var Key Setup Repeat Key = ReadKey if Key = Char(4) then SlideRight if Key = Char(19) then SlideLeft if Key = Char(5) then SlideUp if Key = Char(24) then SlideDown if Key = F10 Shuffle EraseTopWindow NumberBoard endif if Key = F1 then PanicButton Until Key = ESC EndProc ;Main