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