Last active
July 18, 2019 17:31
-
-
Save dockimbel/46b358bdda64f60c7f7aaa9e2bc32033 to your computer and use it in GitHub Desktop.
Rebox game in Red with gpio-powered joypad. Asset files: https://github.com/hyzwhu/redbox
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Red [ | |
Needs: View | |
Title: "red-box" | |
Author: "Huang Yongzhao" | |
File: %redbox.red | |
Tabs: 4 | |
Version: "Alpha" | |
Purpose: "Famous BoxWorld! game ported to red" | |
Rights: "Copyright (C) 2015-2018 Red Foundation. All rights reserved." | |
License: { | |
Distributed under the Boost Software License, Version 1.0. | |
See https://github.com/red/red/blob/master/BSL-License.txt | |
} | |
Repository: https://github.com/hyzwhu/redbox | |
] | |
ctx-redbox: context [ | |
tiles: [ | |
1 wall | |
2 floor | |
3 target | |
] | |
boxes: make block! 10 | |
man-img: make block! 2 | |
map-img: make image! 480x420 | |
targets: make block! 10 | |
moves-file: load %moves.ini | |
maps: none | |
level: 1 | |
lx: ly: 0 | |
man-pos: 0x0 | |
undo-box: undo-man: 0x0 | |
box-index: 0 | |
load-bin: func [file][reduce load decompress read/binary file] | |
judge: true | |
box-move-num: 0 | |
maps: load-bin %map.gz | |
all-image: load %all-image.png | |
crop: function [offset [integer!] size [pair!]][ | |
copy/part skip all-image offset size | |
] | |
l1: crop 0 30x30 | |
l2: crop 30 30x30 | |
r1: crop 60 30x30 | |
r2: crop 90 30x30 | |
d1: crop 120 30x30 | |
d2: crop 150 30x30 | |
u1: crop 180 30x30 | |
u2: crop 210 30x30 | |
box1: crop 240 30x30 | |
wall: crop 270 30x30 | |
floor: crop 300 30x30 | |
target: crop 330 30x30 | |
box2: crop 360 30x30 | |
credits: crop 390 * 30 378x292 | |
append man-img l1 | |
append man-img l2 | |
tile-type?: function [pos [pair!]][ | |
pos: pos + 1x1 | |
to-integer pick pick level-data/map pos/y pos/x | |
] | |
decode-tile: function [value [integer!]][ | |
any [reduce select tiles value 'unknown] | |
] | |
for-pair: function [ | |
'word [word!] | |
start [pair!] | |
end [pair!] | |
body [block!] | |
/local | |
do-body | |
val | |
][ | |
do-body: func reduce [word] body | |
val: start | |
while [val/y <= end/y][ | |
val/x: start/x | |
while [val/x <= end/x][ | |
do-body val | |
val/x: val/x + 1 | |
] | |
val/y: val/y + 1 | |
] | |
] | |
dir-to-pos: func [value [word!]][ | |
select [up 0x-30 down 0x30 left -30x0 right 30x0] value | |
] | |
can-move?: func [value [word!] pos [pair!]/local new1 new nx ny][ | |
new1: pos - 0x20 + dir-to-pos value | |
nx: new1/x / 30 | |
ny: new1/y / 30 | |
new1: as-pair nx ny | |
new: tile-type? new1 | |
find [2 3] new | |
] | |
box-world: layout/tight [ | |
title "red-box" | |
style btn: button bold 40x20 | |
at 0x0 btn "Goto" [level-choose/offset: none view level-choose] | |
at 40x0 btn "Undo" [ | |
if 0x0 <> undo-box [ | |
box-world/pane/:box-index/offset: undo-box | |
move-txt/data: move-txt/data - 1 | |
poke boxes (:box-index - 12) undo-box | |
undo-box: 0x0 | |
] | |
mad-man/offset: undo-man | |
] | |
at 80x0 btn "Retry" [init-world] | |
at 120x0 btn "About" [about-win/offset: none view about-win] | |
at 0x20 base map-img | |
mad-man: base transparent 30x30 rate 6 now on-time [ | |
judge: not judge | |
mad-man/image: pick man-img judge | |
] | |
style txt: text 85x20 black font-size 10 font-color white bold | |
style num: text 15x20 black font-size 10 font-color white bold | |
at 0x420 txt "your move: " | |
at 85x420 move-txt: num "0" | |
at 100x420 txt " best move: " | |
at 185x420 best-move-txt: num "0" | |
at 200x420 txt " your level: " | |
at 285x420 level-txt: num "1" | |
] | |
is-best?: func [/local bt mt][ | |
mt: move-txt/data | |
bt: best-move-txt/data | |
either bt = 0 [ | |
moves-file/:level: mt | |
][ | |
if bt > mt [ | |
moves-file/:level: mt | |
] | |
] | |
write %moves.ini mold moves-file | |
] | |
turn: func [value [word!] /local box c-pos b-pos bp pb next-box][ | |
undo-box: 0x0 | |
undo-man: mad-man/offset | |
c-pos: mad-man/offset + dir-to-pos value | |
b-pos: find boxes c-pos | |
either b-pos [ | |
bp: index? b-pos | |
pb: bp + 12 | |
box-index: :pb | |
undo-box: c-pos | |
next-box: c-pos + dir-to-pos value | |
if all [can-move? value c-pos next-is-box? next-box][ | |
move-txt/data: 1 + move-txt/data | |
box-world/pane/:pb/offset: next-box | |
boxes/:bp: box-world/pane/:pb/offset | |
mad-man/offset: c-pos | |
if check-win? [ | |
joypad/show-win | |
if level = 100 [ | |
alert-win/pane/1/text: "Victory!" | |
] | |
alert-win/offset: none | |
view/flags alert-win 'modal | |
level: level + 1 | |
init-world | |
] | |
] | |
][ | |
if can-move? value mad-man/offset [ | |
mad-man/offset: c-pos | |
] | |
] | |
] | |
level-choose: layout [ | |
title "red-box" | |
text bold "please enter the level that you want" return | |
pad 60x0 fld: field 60x20 return | |
pad 60x0 button bold "ok" [ | |
level: to-integer fld/text | |
init-world | |
unview | |
] | |
] | |
next-is-box?: func [pos [pair!]][ | |
none? find boxes pos | |
] | |
init-world: func [][ | |
undo-box: 0x0 | |
move-txt/data: 0 | |
system/view/auto-sync?: no | |
clear boxes | |
clear targets | |
clear skip box-world/pane 12 | |
draw-map | |
draw-boxes | |
show box-world | |
system/view/auto-sync?: yes | |
] | |
alert-win: layout [ | |
title "red-box" | |
text center 200x20 "you have done a good job!" return | |
pad 70x0 button "ok" [ | |
is-best? | |
unview | |
] | |
] | |
about-win: layout [ | |
title "red-box" | |
image center credits return | |
text center 400x20 bold "Original game by Jeng-Long Jiang (1992)" return | |
text center 400x20 bold "Rebol port done by Nenad Rakocevic (2001)" return | |
text center 400x20 bold "Red port done by Yongzhao Huang (2018)" return | |
] | |
dispatch-move: func [key [word!]][ | |
switch key [ | |
up [man-img/1: u1 man-img/2: u2] | |
down [man-img/1: d1 man-img/2: d2] | |
left [man-img/1: l1 man-img/2: l2] | |
right [man-img/1: r1 man-img/2: r2] | |
] | |
turn key | |
] | |
box-world/actors: make object! [ | |
on-key-down: func [face [object!] event [event!]][dispatch-move event/key] | |
] | |
check-win?: has [win? box a i pb][ | |
win?: yes | |
i: 1 | |
foreach box boxes [ | |
a: find targets box | |
pb: 12 + i | |
either a [box-world/pane/:pb/image: box2][box-world/pane/:pb/image: box1] | |
win?: all [win? a] | |
i: i + 1 | |
] | |
win? | |
] | |
draw-map: has [tile lx ly][ | |
map-img/rgb: black | |
level-data: maps/:level | |
level-txt/data: :level | |
best-move-txt/data: pick moves-file :level | |
man-pos: undo-man: mad-man/offset: level-data/start * 30 + 0x20 | |
for-pair pos 0x0 15x13 [ | |
tile: 0 | |
unless zero? tile: tile-type? pos [ | |
if 3 = tile [ | |
append targets pos * 30 + 0x20 | |
] | |
tile: decode-tile tile | |
change-image tile map-img pos * 30 | |
] | |
] | |
] | |
draw-boxes: has [bx pos pb][ | |
foreach pos level-data/boxes [ | |
pb: pos * 30 + 0x20 | |
append box-world/pane bx: make face![type: 'base size: 30x30 offset: pb image: box1] | |
append boxes pb | |
] | |
] | |
change-image: function [src [image!] dst [image!] pos [pair!]][ | |
sx: src/size/x | |
dx: dst/size/x | |
sy: src/size/y | |
px: pos/x | |
py: pos/y | |
repeat y sy [ | |
xs: y - 1 * sx + 1 | |
xd: y + py - 1 * dx + 1 + px | |
repeat l sx [ | |
dst/:xd: src/:xs | |
xd: xd + 1 | |
xs: xs + 1 | |
] | |
] | |
] | |
joypad: context [ | |
mapping: [ | |
16 down 20 up | |
17 left 21 right | |
] | |
row: [(id) state: #[false] direction: (direction)] | |
table: collect [ | |
foreach [id direction] mapping [keep compose row] | |
] | |
pins: extract table length? row | |
port: none | |
acquire: has [pin][ | |
port: open gpio:// | |
foreach pin pins [ | |
insert port [ | |
set-mode pin in | |
pull-down pin | |
] | |
] | |
insert port [ | |
set-mode 18 out | |
set-mode 4 out | |
set 4 on | |
] | |
] | |
pressed?: function [][ | |
foreach pin pins [ | |
entry: find table pin | |
old: entry/state | |
insert port [get pin] | |
entry/state: make logic! port/data | |
;-- detect 0-to-1 transition only, to avoid auto-firing | |
if all [not old entry/state][return entry/direction] | |
] | |
none | |
] | |
show-win: does [insert port [set 18 on]] | |
release: does [ | |
insert port [ | |
set 4 off | |
set 18 off | |
] | |
close port | |
] | |
] | |
start-rebox: function [][ | |
joypad/acquire | |
draw-map | |
draw-boxes | |
view/no-wait box-world | |
until [ | |
if key: joypad/pressed? [dispatch-move key] | |
none? do-events/no-wait | |
] | |
joypad/release | |
] | |
start-rebox | |
] |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment