Menu
▾
▴
[Win32forth-cvs] win32forth/apps/Solipon2 FileIO.f, 1.1, 1.2 Menu.f, 1.1, 1.2 SOLIPION.F, 1.8, 1.9
|
From: Dirk B. <db...@us...> - 2008-05-03 08:44:15
|
Update of /cvsroot/win32forth/win32forth/apps/Solipon2 In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv15557/apps/Solipon2 Modified Files: FileIO.f Menu.f SOLIPION.F Log Message: New menu entry "Random board" added to the "Game" menu of "Solipion". If this menu entry is selected you'll get an random board with a random count of pawns every time you start a new game. Index: Menu.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Solipon2/Menu.f,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** Menu.f 30 Apr 2008 15:58:01 -0000 1.1 --- Menu.f 3 May 2008 08:44:05 -0000 1.2 *************** *** 37,40 **** --- 37,45 ---- + defer EnableMenuBar + + : (random-board?) + random-board? 0= to random-board? EnableMenuBar ; + POPUPBAR Solipion-Popup-bar *************** *** 43,46 **** --- 48,53 ---- MENUITEM "&Automatic Game " 'A' +k_control pushkey ; MENUSEPARATOR + :MenuItem mp_random1 "&Random board" (random-board?) ; + MENUSEPARATOR MENUITEM "&Open " 'O' +k_control pushkey ; MENUITEM "&Re-open " 'R' +k_control pushkey ; *************** *** 61,64 **** --- 68,73 ---- MENUITEM "&Automatic \tCtrl+A" 'A' +k_control pushkey ; MENUSEPARATOR + :MenuItem mp_random2 "&Random board" (random-board?) ; + MENUSEPARATOR MENUITEM "&Open... \tCtrl+O" 'O' +k_control pushkey ; MENUITEM "&Re-Open \tCtrl+R" 'R' +k_control pushkey ; *************** *** 76,77 **** --- 85,91 ---- MENUITEM "SoliPion" k_F1 +k_control pushkey ; ENDBAR + + :noname ( -- ) \ enable/disable the menu items + random-board? Check: mp_random1 + random-board? Check: mp_random2 + ; is EnableMenuBar Index: FileIO.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Solipon2/FileIO.f,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** FileIO.f 30 Apr 2008 15:58:01 -0000 1.1 --- FileIO.f 3 May 2008 08:44:05 -0000 1.2 *************** *** 13,48 **** : nothing false ; ' nothing is !bests ! 0 value gameloaded? ! : open-game { \ open$ hfile -- } ! max-path LocalAlloc: open$ ! GetHandle: SOLIPIONW Start: OpenGame dup c@ \ ( -- a1 n1 ) ! IF count open$ place ! open$ count r/w open-file abort" open-file" to hfile ! smallstring 19 hfile read-file 2drop ! smallstring 3 s" SOL" compare 0= dup if true to put-by? then ! smallstring 3 s" PLA" compare 0= dup if false to put-by? then ! or ! IF ! string-player-name 20 hfile read-file 2drop ! &of shift-x cell hfile read-file 2drop ! &of shift-y cell hfile read-file 2drop ! &of moves cell hfile read-file 2drop ! moves-table moves cells hfile read-file 2drop ! THEN ! true to show? ! moves 1- dup dup max-counter > if ! to max-counter to counter !bests ! else 2drop ! then ! hfile close-file drop ! true to gameloaded? ! ELSE DROP THEN ! ; \ --------------------------------------------------------------- --- 13,58 ---- : nothing false ; ' nothing is !bests ! 0 value gameloaded? ! : (load-game) ( addr len -- ) ! { \ hfile -- } ! r/w open-file abort" open-file" to hfile ! smallstring 19 hfile read-file 2drop ! smallstring 3 s" SOL" compare 0= dup if true to put-by? then ! smallstring 3 s" PLA" compare 0= dup if false to put-by? then ! or ! IF string-player-name 20 hfile read-file 2drop ! &of shift-x cell hfile read-file 2drop ! &of shift-y cell hfile read-file 2drop ! &of moves cell hfile read-file 2drop ! moves-table moves cells hfile read-file 2drop + \ for the Thing... + coords2 72 cells hfile read-file drop 0<> + if &of max-pawns cell hfile read-file drop 0<> + else false + then to random-board? THEN + hfile close-file drop + ; ! : open-game { \ open$ hfile -- } ! max-path LocalAlloc: open$ ! GetHandle: SOLIPIONW Start: OpenGame dup c@ \ ( -- a1 n1 ) ! IF count open$ place ! ! open$ count (load-game) ! ! true to show? ! moves 1- dup dup max-counter > ! if to max-counter to counter !bests ! else 2drop ! then ! ! true to gameloaded? ! ELSE DROP ! THEN ; \ --------------------------------------------------------------- *************** *** 50,79 **** \ --------------------------------------------------------------- ! : (re-open-game) { \ open$ hfile -- } ! max-path LocalAlloc: open$ ! in-memory? ! IF counter 1+ to moves ! ELSE ! S" GAME.SOL" open$ place ! open$ count r/w open-file abort" open-file" to hfile ! smallstring 3 hfile read-file 2drop ! smallstring 3 s" SOL" compare 0= dup if true to put-by? then ! smallstring 3 s" PLA" compare 0= dup if false to put-by? then ! or ! IF ! smallstring 16 hfile read-file 2drop ! string-player-name 20 hfile read-file 2drop ! &of shift-x cell hfile read-file 2drop ! &of shift-y cell hfile read-file 2drop ! &of moves cell hfile read-file 2drop ! moves-table moves cells hfile read-file 2drop ! ! THEN ! hfile close-file drop ! THEN ! 0 to tempo false to show? ! ; ! ' (re-open-game) is re-open-game \ --------------------------------------------------------------- --- 60,71 ---- \ --------------------------------------------------------------- ! :noname ( -- ) ! 0 to tempo ! false to show? ! in-memory? ! IF counter 1+ to moves ! ELSE S" GAME.SOL" (load-game) ! THEN ; is re-open-game \ --------------------------------------------------------------- *************** *** 81,108 **** \ --------------------------------------------------------------- ! : (save-game) { \ save$ hfile -- } ! max-path LocalAlloc: save$ \ ! in-memory? ! if counter 1+ to moves ! else ! s" GAME.SOL" save$ place ! save$ count r/w create-file abort" create-file" to hfile ! put-by? ! if s" PLA" ! else s" SOL" ! then hfile write-file drop ! get-local-time ! time-buf 16 hfile write-file drop ! string-player-name 20 hfile write-file drop ! &of shift-x cell hfile write-file drop ! &of shift-y cell hfile write-file drop ! counter 1+ to moves ! &of moves cell hfile write-file drop ! moves-table moves cells hfile write-file drop ! hfile close-file drop ! then ! ; ! ' (save-game) is save-game \ --------------------------------------------------------------- --- 73,106 ---- \ --------------------------------------------------------------- ! : (save-game) ( addr len -- ) ! { \ hfile -- } ! r/w create-file abort" create-file" to hfile ! put-by? ! if s" PLA" ! else s" SOL" ! then hfile write-file drop ! get-local-time ! time-buf 16 hfile write-file drop ! string-player-name 20 hfile write-file drop ! &of shift-x cell hfile write-file drop ! &of shift-y cell hfile write-file drop ! counter 1+ to moves ! &of moves cell hfile write-file drop ! moves-table moves cells hfile write-file drop ! ! random-board? ! if coords2 72 cells hfile write-file drop // for the Thing... ! &of max-pawns cell hfile write-file drop ! then ! ! hfile close-file drop ! ; ! ! :noname ( -- ) ! in-memory? ! if counter 1+ to moves ! else s" GAME.SOL" (save-game) ! then ; is save-game \ --------------------------------------------------------------- *************** *** 110,148 **** \ --------------------------------------------------------------- - : save-game-as { \ hfile save$ -- } max-path LocalAlloc: save$ ! s" Save the Game As : " save$ place ! save$ count SetTitle: SaveGame auto-save? ! if ! counter 0 <# # # # #> save$ place ! s" .SOL" save$ +place ! save$ count delete-file drop ! save$ dup c@ ! else ! GetHandle: SOLIPIONW Start: SaveGame dup c@ \ ( -- a1 n1 ) then ! IF ! count r/w create-file abort" create-file" to hfile ! put-by? if s" SOL" ! else s" PLA" ! then hfile write-file drop ! ! get-local-time ! time-buf 16 hfile write-file drop ! string-player-name 20 hfile write-file drop ! &of shift-x cell hfile write-file drop ! &of shift-y cell hfile write-file drop ! counter 1+ to moves ! &of moves cell hfile write-file drop ! moves-table moves cells hfile write-file drop ! hfile close-file drop ! ELSE ! drop ! THEN ! ! ; \ --------------------------------------------------------------- --- 108,127 ---- \ --------------------------------------------------------------- + : save-game-as { \ save$ -- } max-path LocalAlloc: save$ ! auto-save? ! if counter 0 <# # # # #> save$ place ! s" .SOL" save$ +place ! save$ count delete-file drop ! save$ dup c@ ! else s" Save the Game As : " SetTitle: SaveGame ! GetHandle: SOLIPIONW Start: SaveGame dup c@ \ ( -- a1 n1 ) then ! IF count (save-game) ! ELSE drop ! THEN ; \ --------------------------------------------------------------- Index: SOLIPION.F =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Solipon2/SOLIPION.F,v retrieving revision 1.8 retrieving revision 1.9 diff -C2 -d -r1.8 -r1.9 *** SOLIPION.F 30 Apr 2008 15:58:00 -0000 1.8 --- SOLIPION.F 3 May 2008 08:44:05 -0000 1.9 *************** *** 46,50 **** FALSE value yahoo-already? 0 value auto? - 0 value #toolbar? TRUE value put-by? 0 value hypothesis? --- 46,49 ---- *************** *** 56,59 **** --- 55,63 ---- 0 value dy FALSE value auto-save? + TRUE value best? + 500 value startsize + FALSE value same-thing? + FALSE value random-board? \ get a random board each time you start the game :) + 72 value max-pawns \ --------------------------------------------------------------- *************** *** 61,65 **** \ --------------------------------------------------------------- ! needs lib\BitmapDC.f bitmap-dc solipion-dc --- 65,69 ---- \ --------------------------------------------------------------- ! needs BitmapDC.f bitmap-dc solipion-dc *************** *** 90,96 **** ;Class ! \ --------------------------------------------------------------- ! \ Menu, Popup ... ! \ --------------------------------------------------------------- needs menu.f --- 94,100 ---- ;Class ! \ ------------------------------------------------------------------------------ ! \ Menu, Popup, Toolbar ... ! \ ------------------------------------------------------------------------------ needs menu.f *************** *** 103,112 **** \ ------------------------------------------------------------------------------ - \ the main window \ ------------------------------------------------------------------------------ ! defer save-game ' noop is save-game ! defer re-open-game ' noop is re-open-game ! defer Unroll ' noop is Unroll :Object SOLIPIONW <super window --- 107,119 ---- \ ------------------------------------------------------------------------------ \ ------------------------------------------------------------------------------ ! defer save-game ! defer re-open-game ! defer Unroll ! ! \ ------------------------------------------------------------------------------ ! \ the main window ! \ ------------------------------------------------------------------------------ :Object SOLIPIONW <super window *************** *** 143,147 **** :M MinSize: ( -- width height ) \ minimum window size ! StartSize: Solipion-Tool-bar1 >r 380 max r> 380 + ;M :M StartSize: ( -- width height ) --- 150,154 ---- :M MinSize: ( -- width height ) \ minimum window size ! StartSize: Solipion-Tool-bar1 >r StartSize max r> StartSize + ;M :M StartSize: ( -- width height ) *************** *** 241,247 **** ;Object - : uninit-solipion ( -- ) - DestroyWindow: SOLIPIONW ; - unload-chain chain-add-before uninit-solipion \ --------------------------------------------------------------- --- 248,251 ---- *************** *** 254,260 **** \ --------------------------------------------------------------- - : refresh ( -- ) - Refresh: solipionw ; - : temporizing ( -- ) winpause? --- 258,261 ---- *************** *** 264,272 **** \ --------------------------------------------------------------- - \ --------------------------------------------------------------- - - needs FileIO.f - - \ --------------------------------------------------------------- \ New Game \ --------------------------------------------------------------- --- 265,268 ---- *************** *** 286,289 **** --- 282,287 ---- create coords2 72 allot \ for the thing + needs FileIO.f + font vfont create string4$ cell allot *************** *** 396,400 **** THEN ! refresh temporizing showing? 0= to showing? --- 394,398 ---- THEN ! Refresh: SOLIPIONW temporizing showing? 0= to showing? *************** *** 417,451 **** ; - 0 value Same-Thing? - : Thing ( -- ) - tempo >r 0 to tempo ! 72 0 ! do ! Same-Thing? if ! coords2 i + c@ to nRaw ! coords2 i 1+ + c@ to nLine ! else ! 8 random 6 + dup coords2 i + c! to nRaw ! 8 random 6 + dup coords2 i 1+ + c! to nLine ! then ! pawn ! -1 univers nLine 20 * nRaw + + c! ! 2 ! +loop ! r> to tempo ! true to Same-Thing? ; ! \ rank ( 1st,2nd,3rd,4th,5th pawn of the -line- ) ! \ direction ( 1 = west->east 2 = north-west->south-west ! \ 3 = north->south 4 = south-west->north-east ) ! 0 value clean? ! ! ! : -LINE- { row# line# rank# direction# \ last first -- } --- 415,440 ---- ; : Thing ( -- ) tempo >r 0 to tempo ! max-pawns 0 ! do Same-Thing? ! if coords2 i + c@ to nRaw ! coords2 i 1+ + c@ to nLine ! else 8 random 6 + dup coords2 i + c! to nRaw ! 8 random 6 + dup coords2 i 1+ + c! to nLine ! then ! pawn ! -1 univers nLine 20 * nRaw + + c! ! 2 +loop ! r> to tempo ! true to Same-Thing? ; ! \ rank ( 1st,2nd,3rd,4th,5th pawn of the -line- ) ! \ direction ( 1 = west->east 2 = north-west->south-west ! \ 3 = north->south 4 = south-west->north-east ) ! 0 value clean? : -LINE- { row# line# rank# direction# \ last first -- } *************** *** 475,479 **** direction# last first i couleur row# rank# - j + step * i + dx + line# rank# - j + step * step 3 / i - + dy + MoveTo: solipion-dc ! row# rank# - j + 1+ step * step 3 / i - - dx + line# rank# - j + 1+ step * i - dy + LineTo: solipion-dc loop --- 464,468 ---- direction# last first i couleur row# rank# - j + step * i + dx + line# rank# - j + step * step 3 / i - + dy + MoveTo: solipion-dc ! row# rank# - j + 1+ step * step 3 / i - - dx + line# rank# - j + 1+ step * i - dy + LineTo: solipion-dc loop *************** *** 492,496 **** do direction# first last i couleur ! row# rank# - j + step * step 3 / i - + dx + line# rank# + j - step * i - dy + MoveTo: solipion-dc row# rank# - j + 1+ step * i - dx + line# rank# + j - 1- step * step 3 / i - + dy + LineTo: solipion-dc loop --- 481,485 ---- do direction# first last i couleur ! row# rank# - j + step * step 3 / i - + dx + line# rank# + j - step * i - dy + MoveTo: solipion-dc row# rank# - j + 1+ step * i - dx + line# rank# + j - 1- step * step 3 / i - + dy + LineTo: solipion-dc loop *************** *** 499,533 **** endcase loop ! refresh temporizing loop ; ! ! ! TRUE VALUE BEST? : New-Game ( -- ) ! univers 400 erase ! univers1 400 erase ! univers2 400 erase ! univers3 400 erase ! univers4 400 erase ! 0 to counter true to best? ! hypothesis? 0= if ! ReTitle: solipionw ! then TheSmallsDots - Cross ! ; : 0max19min ! 0 max 19 min ! ; : @line { rank# direction# \ -- flag } --- 488,520 ---- endcase loop ! Refresh: SOLIPIONW temporizing loop ; ! : (random) ( u1 u2 -- u3 ) ! \ *G Returns a random number beetween u1 and u2 (including u1 and u2). ! over - random + 1+ ; : New-Game ( -- ) ! univers 400 erase ! univers1 400 erase ! univers2 400 erase ! univers3 400 erase ! univers4 400 erase 0 to counter true to best? ! hypothesis? 0= if ReTitle: solipionw then TheSmallsDots ! random-board? ! if Same-Thing? 0= if 36 72 (random) to max-pawns then Thing ! else Cross ! then ; : 0max19min ! 0 max 19 min ; : @line { rank# direction# \ -- flag } *************** *** 591,597 **** ; - - - : Playable? { \ rank# direction# ppointer -- } busy? ?exit --- 578,581 ---- *************** *** 663,682 **** -LINE- 1 +to counter - - then - - moves 2 - i = if hypothesis? 0= if ReTitle: solipionw then ! refresh temporizing - - then loop ! r> to tempo 0 to size? TRUE to winpause? --- 647,660 ---- -LINE- 1 +to counter then moves 2 - i = if hypothesis? 0= if ReTitle: solipionw then ! Refresh: SOLIPIONW temporizing then loop ! r> to tempo 0 to size? TRUE to winpause? *************** *** 881,888 **** \ --------------------------------------------------------------- \ Print the Positions of the Game (text) - \ --------------------------------------------------------------- - - - \ --------------------------------------------------------------- \ Print the Bitmap of the Game \ --------------------------------------------------------------- --- 859,862 ---- *************** *** 923,926 **** --- 897,902 ---- : initialisations ( -- ) cursor-off + RANDOM-INIT + 256 malloc to smallstring 256 malloc to string-player-name *************** *** 961,966 **** ; - - \ --------------------------------------------------------------- \ The Beginning --- 937,940 ---- *************** *** 971,976 **** BEGIN ! size? if save-game re-open-game ! then auto? if ekey? if ekey --- 945,949 ---- BEGIN ! size? if save-game re-open-game then auto? if ekey? if ekey *************** *** 983,987 **** 'A' +k_control of <<<bleep1>>> auto? 0= to auto? ! auto? if 0 to music? then endof 'W' +k_control of <<<bleep1>>> --- 956,960 ---- 'A' +k_control of <<<bleep1>>> auto? 0= to auto? ! auto? 0= to music? endof 'W' +k_control of <<<bleep1>>> *************** *** 989,993 **** 'N' +k_control of <<<bleep1>>> !bests ! New-Game endof --- 962,966 ---- 'N' +k_control of <<<bleep1>>> !bests ! false to Same-Thing? New-Game endof *************** *** 1012,1016 **** GetHandle: SOLIPIONW Setup: ThePrinter endof ! 'T' +k_control of print-game endof 'B' +k_control of <<<bleep1>>> 16 print-demo-bmp endof --- 985,989 ---- GetHandle: SOLIPIONW Setup: ThePrinter endof ! 'T' +k_control of print-game endof 'B' +k_control of <<<bleep1>>> 16 print-demo-bmp endof *************** *** 1018,1022 **** true to in-memory? step 8 - 8 max to step - \ step 4 / dup +to dx +to dy true to size? --- 991,994 ---- *************** *** 1026,1034 **** k_right +k_control of <<<bleep1>>> true to in-memory? ! ! step 8 + ( 128 min ) to step ! ! ! \ step 4 / negate dup +to dx +to dy true to size? 'E' +k_control pushkey --- 998,1002 ---- k_right +k_control of <<<bleep1>>> true to in-memory? ! step 8 + to step true to size? 'E' +k_control pushkey *************** *** 1078,1084 **** turnkey? [if] - \ NoConsoleIO \ Setup the Console I/O for an application without the console window. - \ NoConsoleInImage \ Tell Imageman that we don't need the w32fconsole.dll. - \ Create the exe-file &forthdir count &appdir place --- 1046,1049 ---- |
