Kirjautuminen

Haku

Tehtävät

Keskustelu: Projektit: Miinaharava 8th ohjelmointikielellä

jalski [19.04.2018 07:31:49]

#

Kirjoittelin Miinaharava pelin 8th ohjelmointikielellä. Tyhjien ruutujen paljastus rutiini on iteratiivinen rekursiivisen sijaan.

lähdekoodi datatiedostoineen löytyypi täältä.

\
\  Simple Minesweeper game for 8th
\
needs math/matrix


"gfx/n0.png"         app:asset img:new var, zero-img
"gfx/n1.png"         app:asset img:new var, one-img
"gfx/n2.png"         app:asset img:new var, two-img
"gfx/n3.png"         app:asset img:new var, three-img
"gfx/n4.png"         app:asset img:new var, four-img
"gfx/n5.png"         app:asset img:new var, five-img
"gfx/n6.png"         app:asset img:new var, six-img
"gfx/n7.png"         app:asset img:new var, seven-img
"gfx/n8.png"         app:asset img:new var, eight-img
"gfx/tile.png"       app:asset img:new var, tile-img
"gfx/tinted1.png"    app:asset img:new var, tinted1-img
"gfx/tinted2.png"    app:asset img:new var, tinted2-img
"gfx/explosion.png"  app:asset img:new var, explosion-img
"gfx/mine.png"       app:asset img:new var, mine-img
"gfx/flag.png"       app:asset img:new var, flag-img

"snd/explosion.ogg"  app:asset snd:new var, explosion-snd
"snd/zero.ogg"       app:asset snd:new var, zero-snd


true app:isgui !


var gui

var finished
var uncovered
var cleared
var mines

\ max number of mines
: EASY   15 ;
: NORMAL 20 ;
: HARD   25 ;

NORMAL var, difficulty

: BRDSZ 10 ;
: BRDSZI BRDSZ 2 n:+ ;

: TILESIZE 32 ;
: NUMTILES 10 ;

: UNSELECTED 0 ;
: SELECTED   1 ;

: MARKED     16 ;
: MINE       32 ;


var state-board
var draw-board

BRDSZI BRDSZI n:* q:new var, zero-queue


: rand10 rand-pcg n:abs 9 n:mod 1 n:+ ;


: place-mine rand10 rand10 2dup state-board @ mat:@ dup MINE n:band not if MINE n:bor swap mat:! drop mines @ n:1+ mines ! else 2drop 2drop then ;


: init-board
  false finished !
  0 uncovered !
  0 cleared !
  0 mines !

  [ 1,1,1,1,1,1,1,1,1,1,1,1,
    1,0,0,0,0,0,0,0,0,0,0,1,
    1,0,0,0,0,0,0,0,0,0,0,1,
    1,0,0,0,0,0,0,0,0,0,0,1,
    1,0,0,0,0,0,0,0,0,0,0,1,
    1,0,0,0,0,0,0,0,0,0,0,1,
    1,0,0,0,0,0,0,0,0,0,0,1,
    1,0,0,0,0,0,0,0,0,0,0,1,
    1,0,0,0,0,0,0,0,0,0,0,1,
    1,0,0,0,0,0,0,0,0,0,0,1,
    1,0,0,0,0,0,0,0,0,0,0,1,
    1,1,1,1,1,1,1,1,1,1,1,1 ] [ ` BRDSZI ` , ` BRDSZI ` ] mat:new state-board !

  [] [ ` BRDSZ ` , ` BRDSZ ` ] mat:new draw-board !

  ' place-mine difficulty @ times

  gui @ "lbl" g:child cleared @ "   CLEARED: %3d %%" s:strfmt g:text drop ;


locals:
: mines?  \ x y -- num-mines
  "y" w:!
  "x" w:!
  0 "c" w:!
  ( "row" w:! ( "row" w:@ state-board @ mat:@ nip MINE n:band if "c" w:@ n:1+ "c" w:! then ) "x" w:@ n:1- "x" w:@ n:1+ loop ) "y" w:@ n:1- "y" w:@ n:1+ loop
  "c" w:@ ;


: mine?  \ x y -- bool
  state-board @ mat:@ nip MINE n:band if true else false then ;


: selected?  \ x y -- status
  state-board @ mat:@ nip SELECTED n:band if true else false then ;


: marked?  \ x y -- status
  state-board @ mat:@ nip MARKED n:band if true else false then ;


: selected-or-marked?  \ x y -- bool
  state-board @ mat:@ nip SELECTED MARKED n:bor n:band if true else false then ;


: init-queue
  zero-queue @ q:clear drop ;


: add-queue  \ x y --
  2 a:close zero-queue @ swap q:push drop ;


: select  \ x y --
  2dup state-board @ mat:@ nip
  SELECTED n:bor state-board @ mat:! drop ;


: set-board  \ x y value --
  draw-board @ mat:! drop ;


locals:
: uncover-queue
  "y" w:!
  "x" w:!

  ( "row" w:! ( dup "col" w:! "row" w:@ selected-or-marked? not if "col" w:@ "row" w:@ 2dup add-queue select then ) "x" w:@ n:1- "x" w:@ n:1+ loop ) "y" w:@ n:1- "y" w:@ n:1+ loop ;


: cascade
  zero-queue @
  repeat
    q:pop
    a:open 2dup mines? dup >r
    0 n:= if
      \ Add code to play zero-snd
      rdrop
      2dup
      n:1- >r n:1- r> 9 draw-board @ mat:! drop
      1 uncovered n:+!
      uncover-queue
    else
      n:1- >r n:1- r>  r> draw-board @ mat:! drop
      1 uncovered n:+!
    then
    q:len 0 n:= if drop break then
  again ;


\


: draw0
  "gui" w:@ tile-img @ "x" w:@ TILESIZE n:* "y" w:@ TILESIZE n:* g:image-at drop ;


: draw1
  "gui" w:@ one-img @ "x" w:@ TILESIZE n:* "y" w:@ TILESIZE n:* g:image-at drop ;


: draw2
  "gui" w:@ two-img @ "x" w:@ TILESIZE n:* "y" w:@ TILESIZE n:* g:image-at drop ;


: draw3
  "gui" w:@ three-img @ "x" w:@ TILESIZE n:* "y" w:@ TILESIZE n:* g:image-at drop ;


: draw4
  "gui" w:@ four-img @ "x" w:@ TILESIZE n:* "y" w:@ TILESIZE n:* g:image-at drop ;


: draw5
  "gui" w:@ five-img @ "x" w:@ TILESIZE n:* "y" w:@ TILESIZE n:* g:image-at drop ;


: draw6
  "gui" w:@ six-img @ "x" w:@ TILESIZE n:* "y" w:@ TILESIZE n:* g:image-at drop ;


: draw7
  "gui" w:@ seven-img @ "x" w:@ TILESIZE n:* "y" w:@ TILESIZE n:* g:image-at drop ;


: draw8
  "gui" w:@ eight-img @ "x" w:@ TILESIZE n:* "y" w:@ TILESIZE n:* g:image-at drop ;


: draw9
  "gui" w:@ zero-img @ "x" w:@ TILESIZE n:* "y" w:@ TILESIZE n:* g:image-at drop ;


: draw10
  "gui" w:@ explosion-img @ "x" w:@ TILESIZE n:* "y" w:@ TILESIZE n:* g:image-at drop ;


: draw11
  "gui" w:@ mine-img @ "x" w:@ TILESIZE n:* "y" w:@ TILESIZE n:* g:image-at drop ;


: draw16
  "gui" w:@ flag-img @ "x" w:@ TILESIZE n:* "y" w:@ TILESIZE n:* g:image-at drop ;


[  ' draw0 ,
   ' draw1 ,
   ' draw2 ,
   ' draw3 ,
   ' draw4 ,
   ' draw5 ,
   ' draw6 ,
   ' draw7 ,
   ' draw8 ,
   ' draw9 ,
   ' draw10 ,
   ' draw11 ,
   ' noop ,
   ' noop ,
   ' noop ,
   ' noop ,
   ' draw16 ,
   ' noop ,
   ' noop ,
   ' noop ,
   ' noop ,
   ' noop ,
   ' noop ,
   ' noop ,
   ' noop ,
   ' noop ,
   ' noop ,
   ' noop ,
   ' noop ,
   ' noop ,
   ' noop ,
   ' noop ,
   ' noop ,
   ' noop ,
   ' noop ] var, drawtable


: inside-board?  \ x y -- bool
  0 TILESIZE BRDSZ n:* n:int n:between swap 0 TILESIZE BRDSZ n:* n:int n:between and ;


: screen-tile?  \ screen-x screen-y -- tile-x tile-y
  TILESIZE n:/ n:int >r TILESIZE n:/ n:int r> ;

: tile-board?  \ tile-x tile-y -- board-x board-y
  n:1+ >r n:1+ r> ;


: board-tile?
  n:1- >r n:1- r> ;


: draw-coords?  \ tile-x tile-y -- draw-x draw-y
  TILESIZE n:* n:int >r TILESIZE n:* n:int r> ;


: mark  \ x y --
  2dup 2dup state-board @ mat:@ nip
  MARKED n:bor state-board @ mat:! drop
  board-tile? 2dup draw-board @ mat:@ nip
  MARKED n:bor draw-board @ mat:! drop ;


: unmark \ x y --
  2dup 2dup state-board @ mat:@ nip
  MARKED n:bnot n:band state-board @ mat:! drop
  board-tile? 2dup draw-board @ mat:@ nip
  MARKED n:bnot n:band draw-board @ mat:! drop ;


: show-mines
  ( >r ( r@ 2dup mine? if board-tile? 11 set-board  else 2drop then ) 1 BRDSZ loop rdrop ) 1 BRDSZ loop ;


locals:
: ondraw
  "gui" w:!
  ( "y" w:! ( dup "x" w:! "y" w:@ draw-board @ mat:@ nip drawtable @ swap caseof ) 0 BRDSZ n:1- loop ) 0 BRDSZ n:1- loop

  finished @ not if
    "gui" w:@ g:mousepos? 2dup inside-board? if
      screen-tile? tile-board? 2dup selected? not if
        2dup marked? not if
          board-tile? draw-coords? tinted1-img @ -rot g:image-at
        else
          board-tile? draw-coords? tinted2-img @ -rot g:image-at
        then
      else
        2drop
      then
  else
    2drop then drop
  then ;


: onmouse-up
  finished @ if 2drop drop ;; then

  g:mouse? "left" m:@ if
    -rot
    screen-tile? tile-board? 2dup
    selected-or-marked? not if
      2dup
      mine? not if
        2dup select
        init-queue
        add-queue
        cascade
      else
        show-mines
        board-tile? 10 set-board
        \ Add code to play explosion-snd
        true finished !
      then
    then
  else
    "right" m:@ if
      -rot
      screen-tile? tile-board? 2dup selected-or-marked? not if
        mark
      else
        2dup marked? if
          unmark
        then
      then
    then
  then
  2drop
  uncovered @ BRDSZ BRDSZ n:* mines @ n:- n:/ 100 n:* cleared !
  uncovered @ mines @ n:+ BRDSZ BRDSZ n:* n:= if
    show-mines
    true finished !
  then
  gui @ "lbl" g:child cleared @ "   CLEARED: %3d %%" s:strfmt g:text drop ;


: easy
  drop
  [
    [
      "Game", 0,
      "New game", 1,
      "Quit", 2
    ],
    [
      "Difficulty", 3,
      "Easy", { "id" : 4, "checked" : true },
      "Normal", { "id" : 5, "checked" : false },
      "Hard", { "id" : 6, "checked" : false }
    ]
  ] g:menu-update
  EASY difficulty !
  init-board ;


: normal
  drop
  [
    [
      "Game", 0,
      "New game", 1,
      "Quit", 2
    ],
    [
      "Difficulty", 3,
      "Easy", { "id" : 4, "checked" : false },
      "Normal", { "id" : 5, "checked" : true },
      "Hard", { "id" : 6, "checked" : false }
    ]
  ] g:menu-update
  NORMAL difficulty !
  init-board ;


: hard
  drop
  [
    [
      "Game", 0,
      "New game", 1,
      "Quit", 2
    ],
    [
      "Difficulty", 3,
      "Easy", { "id" : 4, "checked" : false },
      "Normal", { "id" : 5, "checked" : false },
      "Hard", { "id" : 6, "checked" : true }
    ]
  ] g:menu-update
  HARD difficulty !
  init-board ;


: onMenuSelected
  n:1- [ ' init-board , ' g:quit , ' noop , ' easy , ' normal , ' hard ] case
  drop ;


: onsize
  2drop
  BRDSZ TILESIZE n:* dup 56 n:+ g:size
  g:invalidate drop ;


{
  "kind" : "win",
  "buttons" : 5,
  "title" : "Minesweeper",
  "wide" : 320,
  "high" : 376,
  "center" : true,
  "bg" : "lightsteelblue",
  "font" : "Arial 10",
  "size" : "onsize",
  "children" :
  [
    {
      "kind" : "menubar",
      "name" : "menu",
      "bounds" : "0,0,parent.width, 24",
      "menu-selected" : "onMenuSelected",
      "menu" :
      [
        [
          "Game", 0,
          "New game", 1,
          "Quit", 2
        ],
        [
          "Difficulty", 3,
          "Easy", { "id" : 4, "checked" : false },
          "Normal", { "id" : 5, "checked" : true },
          "Hard", { "id" : 6, "checked" : false }
        ]
      ]
    },
    {
      "kind" : "label",
      "font" : "Arial 18, bold",
      "bounds": "0,24,parent.right,56",
      "justify" : ["hleft", "vcenter"],
      "name" : "lbl"
    },
    {
      "kind" : "box",
      "bounds": "0, lbl.bottom, 320, 376",
      "name" : "canvas",
      "mouse-up" : "onmouse-up",
      "draw" : "ondraw",
      "timer" : ( g:invalidate ) ,
      "timer-period" : 20
    }
  ]
} var, gui-desc


: app:main
  gui-desc @ g:new gui !
  init-board ;

Vastaus

Aihe on jo aika vanha, joten et voi enää vastata siihen.

Tietoa sivustosta