Monday 2 July 2012

Mirror game

Here a new simple game in Rebol, your task is to place 7 mirrors or less in order to connect all light sources with the same number:

The suource is: http://arnoldvanhofwegen.com/stuff/mirror.rebol
Here the source:
REBOL [Title:   "Mirrorgame"
            File:     "mirror.r"
            Auteur:   "Arnold van Hofwegen"
            Version: "1.04"
]
History: [1.00 Initial released version
          1.01 Fixed bug init aantal-spiegels
          1.02 01-07-2012 Added coloring of the labels on the side
          1.03 02-07-2012 Improved on coloring and turn it on from start
          1.04 02-07-2012 labelfont
]
;**********************************************************
; Hulpvelden
;**********************************************************
;***********
; Constanten
;***********
grootte: 30
;***********
; Variabelen
;***********
;*******************************************************************************
; Functies
;*******************************************************************************
;***********************
; Initialiseren schermen
;***********************
init-draw-grid-box: func [/local n] [
    draw-grid-box: copy []
    draw-grid-box: append draw-grid-box [pen black]
    for n 0 8 1 [
        ; Horizontale gridlijnen
        draw-grid-box: append draw-grid-box compose [line (to-pair reduce [0 n * grootte]) (to-pair reduce [8 * grootte n * grootte])]
        ; Verticale gridlijnen
        draw-grid-box: append draw-grid-box compose [line (to-pair reduce [n * grootte 0]) (to-pair reduce [n * grootte 8 * grootte])]
    ]
]
make-draw-mirror-box: func [/local n m] [
    draw-mirror-box: copy []
    draw-mirror-box: append draw-mirror-box [pen black]
    for n 1 8 1 [
        for m 1 8 1 [
            switch lees-veld m n [
                4   [draw-mirror-box: append draw-mirror-box compose [line (to-pair reduce [(n - 1) * grootte m * grootte]) (to-pair reduce [n * grootte (m - 1) * grootte])]
                    ]
                5   [draw-mirror-box: append draw-mirror-box compose [line (to-pair reduce [(n - 1) * grootte (m - 1) * grootte]) (to-pair reduce [n * grootte m * grootte])]
                    ]
]   ]   ]   ]
init-draw-free-mirror-box: func [/local n m] [
    ; schonen van de opgave
    for n 1 8 1 [
        for m 1 8 1 [
            switch lees-veld m n [
                1 2 [bewaar-veld m n 0]
            ]
        ]
    ]
    make-draw-free-mirror-box
]
make-draw-free-mirror-box: func [/local n m] [
    draw-free-mirror-box: copy []
    draw-free-mirror-box: append draw-free-mirror-box [pen blue]
    for n 1 8 1 [
        for m 1 8 1 [
            switch lees-veld m n [
                2   [draw-free-mirror-box: append draw-free-mirror-box compose [line (to-pair reduce [(n - 1) * grootte m * grootte])
                      (to-pair reduce [n * grootte (m - 1) * grootte])]
                    ]
                1   [draw-free-mirror-box: append draw-free-mirror-box compose [line (to-pair reduce [(n - 1) * grootte (m - 1) * grootte])
                      (to-pair reduce [n * grootte m * grootte])]
                    ]
]   ]   ]   ]
;*******************
; Initialiseren veld
;*******************
bepaal-random-veld: func [/local spel flip randspel tussenblok n m] [
    veld: copy []
    randspel: spel: copy ""
    aantal-spiegels: 0
    lbl-spiegelinfo/text: aantal-spiegels
    show lbl-spiegelinfo
    random/seed
    loop 10 [flip: random true
            either flip [spel: append spel "5"][spel: append spel "4"]
            ]
    loop 7   [flip: random true
            either flip [spel: append spel "1"][spel: append spel "2"]
            ]
    loop 47 [spel: append spel "0"]
    randspel: random spel
    for n 0 7 1 [tussenblok: copy []
        for m 1 8 1 [append tussenblok to-block substr randspel (n * 8 + m) 1]
        veld: append/only veld tussenblok
    ]
]
doorloop-doolhof: func [n /local stapr stapk richting m op-bord] [
    switch n [
        1 2 3 4 5 6 7 8         [stapr: 1
                                stapk: n
                                richting: 2]
        9 10 11 12 13 14 15 16   [stapr: n - 8
                                stapk: 8
                                richting: 3]
        17 18 19 20 21 22 23 24 [stapr: 8
                                stapk: 25 - n
                                richting: 0]
        25 26 27 28 29 30 31 32 [stapr: 33 - n
                                stapk: 1
                                richting: 1]
    ]
    op-bord: true
    while [op-bord] [
        if   found? find [2 4] lees-veld stapr stapk [;slash-spiegel
            richting: richting xor 1
        ]
        if   found? find [1 5] lees-veld stapr stapk [;backslash-spiegel
            richting: richting xor 3
        ]
        switch richting [
            2 [stapr: stapr + 1]
            3 [stapk: stapk - 1]
            0 [stapr: stapr - 1]
            1 [stapk: stapk + 1]
        ]
        if any [stapr < 1
            stapr > 8
            stapk < 1
            stapk > 8][op-bord: false]
    ]
    either stapr = 0 [m: stapk ][
        either stapr = 9 [
            m: 25 - stapk
        ][
            either stapk = 0 [
                m: 33 - stapr
            ][; stapk is nu 9
                m: 8 + stapr
            ]
        ]
    ]
    return m
]
bepaal-labels: func [/local idx volgorde] [
    randwaarden: copy [0 0 0 0 0   0 0 0 0 0   0 0 0 0 0   0 0 0 0 0   0 0 0 0 0   0 0 0 0 0   0 0]
    volgorde: random [1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16]
    idx: 1
    for n 1 32 1 [
        if   0 = pick randwaarden n [
            poke randwaarden n pick volgorde idx
            m: doorloop-doolhof n
            poke randwaarden m pick volgorde idx
            idx: idx + 1
        ]
    ]
]
vul-labels: func [/local n waarde] [
    for n 1 8 1 [
      waarde: to-string pick randwaarden n
      panel-boven/pane/:n/text: waarde
      waarde: to-string pick randwaarden 8 + n
      panel-rechts/pane/:n/text: waarde
      waarde: to-string pick randwaarden 25 - n
      panel-onder/pane/:n/text: waarde
      waarde: to-string pick randwaarden 33 - n
      panel-links/pane/:n/text: waarde
    ]
]
zet-label-kleur: func [n onoff /local p] [
    either n < 9 [
        either onoff [panel-boven/pane/:n/font: lbl-bo/font]
                    [panel-boven/pane/:n/font: txt-bo/font]
        show panel-boven/pane/:n
    ][either n < 17 [
            p: n - 8
            either onoff [panel-rechts/pane/:p/font: lbl-r/font]
                        [panel-rechts/pane/:p/font: txt-r/font]
            show panel-rechts/pane/:p
        ][either n < 25 [
                p: 25 - n
                either onoff [panel-onder/pane/:p/font: lbl-bo/font]
                            [panel-onder/pane/:p/font: txt-bo/font]
                show panel-onder/pane/:p
            ][
                p: 33 - n
                either onoff [panel-links/pane/:p/font: lbl-l/font]
                            [panel-links/pane/:p/font: txt-l/font]
                show panel-links/pane/:p
]   ]   ]   ]
;*************
; Hulpfuncties
;*************
substr: func [string start length] [copy/part at string start length ]
lees-veld: func [x y /local temparr] [
    temparr: pick veld x
    return pick temparr y
]
bewaar-veld: func [x y waarde /local temparr] [
    temparr: pick veld x
    poke temparr y waarde
]
bereken-veld: func [xypair] [
    rij: 1 + to-integer xypair/2 / grootte
    kolom: 1 + to-integer xypair/1 / grootte
]
;******************************************
; Belangrijkste functies voor de verwerking
;******************************************
check-oplossing: func [/local m n opgelost] [
    opgelost: true
    for n 1 32 1 [
        m: doorloop-doolhof n
        either equal? pick randwaarden n pick randwaarden m [
            zet-label-kleur n on
        ][
            zet-label-kleur n off
            opgelost: false
    ]   ]
    return opgelost
]
zet-spiegel: func [rij kolom
                  /local veld-waarde
                  nieuwe-waarde
                  teveel-spiegels
                  is-opgelost] [
    veld-waarde: lees-veld rij kolom
    nieuwe-waarde: 99
    teveel-spiegels: false
    lbl-spelbericht/text: ""
    lbl-spelbericht/color: none
    switch veld-waarde [
        0   [ nieuwe-waarde: 2
                    either aantal-spiegels < 7 [
                        aantal-spiegels: aantal-spiegels + 1
                    ][
                        nieuwe-waarde: 99
                        teveel-spiegels: true
            ] ]
        1   [nieuwe-waarde: 0
              aantal-spiegels: aantal-spiegels - 1]
        2   [nieuwe-waarde: 1]
        4 5 [lbl-spelbericht/text: "Solid mirrors cannot be changed or removed."
              lbl-spelbericht/color: red
            ]
    ]
    if   all [nieuwe-waarde < 3
            not teveel-spiegels][bewaar-veld rij kolom nieuwe-waarde ]
    lbl-spiegelinfo/text: aantal-spiegels
    show lbl-spiegelinfo
    if   teveel-spiegels [
        lbl-spelbericht/text: "Already 7 mirrors are placed."
        lbl-spelbericht/color: red
    ]
    ; check-opgelost
    is-opgelost: check-oplossing
    if   is-opgelost [
        either aantal-spiegels = 7 [
            lbl-spelbericht/text: "Solution found! Congratulations!!!"
            lbl-spelbericht/color: green
        ][
            lbl-spelbericht/text: "Almost, but there have to be exactly 7 mirrors!"
            lbl-spelbericht/color: yellow
        ]
    ]
    show lbl-spelbericht
    make-draw-free-mirror-box
    show free-mirror-box
]
;**************
; Button acties
;**************
action-nieuw-spel: func [] [
    bepaal-random-veld
    bepaal-labels
    vul-labels
    make-draw-mirror-box
    mirror-box/effect: reduce ['draw draw-mirror-box]
    init-draw-free-mirror-box
    free-mirror-box/effect:   reduce ['draw draw-free-mirror-box]
    show mirror-box
    show free-mirror-box
    check-oplossing
]
action-help-spel: func [] [
    inform layout [backdrop ivory
        text bold "Mirrorgame."
        text " "
        text "Try to connect the same values along the borders "
        text "of the diagram by placing exactly 7 extra mirrors in the field. "
        text "Imagine that you send beams of light into the grid and "
        text "your beams should go from one value to the corresponding "
        text "value. Values that are matching are shown in white, others "
        text "will appear in black. "
        text " "
        text "Have fun, good luck!"]
]
;*******************
; Stijlen voor faces
;*******************
spiegel-styles: stylize [
    horleftlab: text to-pair reduce [40 grootte]
    horrightlab: text right to-pair reduce [40 grootte]
    vertlab: text center to-pair reduce [grootte 40]
]
;**********************************************************
; Layout applicatiescherm
;**********************************************************
main: layout [
    size 400x400
        styles spiegel-styles
        across
        panel-links: panel [below
            space 0x0
        horrightlab "_" horrightlab "_" horrightlab "_" horrightlab "_"
        horrightlab "_" horrightlab "_" horrightlab "_" horrightlab "_"
    ]
    hier: at
    at hier + 0x-22
        panel-boven: panel [across
            space 0x0
            vertlab "_" vertlab "_" vertlab "_" vertlab "_"
            vertlab "_" vertlab "_" vertlab "_" vertlab "_"
        ]
    at hier
    grid-box: box " " 1x1 white
    at hier
    mirror-box: box " " 1x1 white
    at hier
    free-mirror-box: box " " 1x1 white feel [
        engage: func [face action event] [
            if   action = 'down [
                bereken-veld event/offset
                wat: lees-veld rij kolom
                zet-spiegel rij kolom
                free-mirror-box/effect:   reduce ['draw draw-free-mirror-box]
                show free-mirror-box
    ]   ]   ]
    at hier + 240x0
        panel-rechts: panel [below
            space 0x0
            horleftlab "_" horleftlab "_" horleftlab "_" horleftlab "_"
            horleftlab "_" horleftlab "_" horleftlab "_" horleftlab "_"
    ]
    return
    across
    at hier + 0x240
        panel-onder: panel [across
            space 0x0
            vertlab "_" vertlab "_" vertlab "_" vertlab "_"
            vertlab "_" vertlab "_" vertlab "_" vertlab "_"
        ]
    at hier + 0x260
    text "Number of placed mirrors: "
    lbl-spiegelinfo: text "" 30
        return
    lbl-spelbericht: text "" 300
    return
    btn-help: button "Rules" [action-help-spel]
    btn-nieuw: button "New game" [action-nieuw-spel]
    btn-stoppen: button "Stop" [unview/all]
    lbl-bo: label top     center 0 ""
    txt-bo: text   top     center 0 ""
    lbl-l:   label middle right   0 ""
    txt-l:   text   middle right   0 ""
    lbl-r:   label middle left   0 ""
    txt-r:   text   middle left   0 ""
]
;**********************************************************
; Uiteindelijke programma
;**********************************************************
box-size: to-pair reduce [8 * grootte + 1 8 * grootte + 1]
grid-box/size: box-size
mirror-box/size: box-size
free-mirror-box/size: box-size
mirror-box/color: none
free-mirror-box/color: none
init-draw-grid-box
grid-box/effect: reduce ['draw draw-grid-box]
action-nieuw-spel
view main

No comments:

Post a Comment