Hi all,
Here's a fun little Tetris clone that can be played in the console =20 versions of Rebol. I documented it's creation as a case study in my =20 little tutorial ( http://musiclessonz.com/rebol_tutorial.html ). Save =20 it to a .r file, and enjoy! - Nick Antonaccio P.S. - thank you Ingo for your original TUI dialect :) Rebol [Title: "Textris"] tui: func [commands [block!]] [ string: copy "" cmd: func [s][join "^(1B)[" s] arg: parse commands [ any [ 'clear (append string cmd "J") | 'up set arg integer! (append string cmd [ arg "A"]) | 'down set arg integer! (append string cmd [ arg "B"]) | 'right set arg integer! (append string cmd [ arg "C"]) | 'left set arg integer! (append string cmd [ arg "D"]) | 'at set arg pair! (append string cmd [ arg/x ";" arg/y "H" ]) | set arg string! (append string arg) ] end ] string ] shape: [ ["####"] ["#" down 1 left 1 "#" down 1 left 1 "#" down 1 left 1 "#"] ["###" down 1 left 2 "#"] [right 1 "#" down 1 left 2 "##" down 1 left 1 "#"] [right 1 "#" down 1 left 2 "###"] ["#" down 1 left 1 "##" down 1 left 2 "#"] ["###" down 1 left 3 "#"] ["##" down 1 left 1 "#" down 1 left 1 "#"] [right 2 "#" down 1 left 3 "###"] ["#" down 1 left 1 "#" down 1 left 1 "##"] ["###" down 1 left 1 "#"] [right 1 "#" down 1 left 1 "#" down 1 left 2 "##"] ["#" down 1 left 1 "###"] ["##" down 1 left 2 "#" down 1 left 1 "#"] ["##" down 1 left 1 "##"] [right 1 "#" down 1 left 2 "##" down 1 left 2 "#"] [right 1 "##" down 1 left 3 "##"] ["#" down 1 left 1 "##" down 1 left 1 "#"] ["##" down 1 left 2 "##"] ; [" "] [" " down 1 left 1 " " down 1 left 1 " " down 1 left 1 " "] [" " down 1 left 2 " "] [right 1 " " down 1 left 2 " " down 1 left 1 " "] [right 1 " " down 1 left 2 " "] [" " down 1 left 1 " " down 1 left 2 " "] [" " down 1 left 3 " "] [" " down 1 left 1 " " down 1 left 1 " "] [right 2 " " down 1 left 3 " "] [" " down 1 left 1 " " down 1 left 1 " "] [" " down 1 left 1 " "] [right 1 " " down 1 left 1 " " down 1 left 2 " "] [" " down 1 left 1 " "] [" " down 1 left 2 " " down 1 left 1 " "] [" " down 1 left 1 " "] [right 1 " " down 1 left 2 " " down 1 left 2 " "] [right 1 " " down 1 left 3 " "] [" " down 1 left 1 " " down 1 left 1 " "] [" " down 1 left 2 " "] ] floor: [ 21x5 21x6 21x7 21x8 21x9 21x10 21x11 21x12 21x13 21x14 21x15 ] oc: [ [0x0 0x1 0x2 0x3] [0x0 1x0 2x0 3x0] [0x0 0x1 0x2 1x1] [0x1 1x0 1x1 2x1] [0x1 1x0 1x1 1x2] [0x0 1x0 1x1 2x0] [0x0 0x1 0x2 1x0] [0x0 0x1 1x1 2x1] [0x2 1x0 1x1 1x2] [0x0 1x0 2x0 2x1] [0x0 0x1 0x2 1x2] [0x1 1x1 2x0 2x1] [0x0 1x0 1x1 1x2] [0x0 0x1 1x0 2x0] [0x0 0x1 1x1 1x2] [0x1 1x0 1x1 2x0] [0x1 0x2 1x0 1x1] [0x0 1x0 1x1 2x1] [0x0 0x1 1x0 1x1] ] width: [4 1 3 2 3 2 3 2 3 2 3 2 3 2 3 2 3 2 2] score: 0 prin tui [clear] a-line: copy [] loop 11 [append a-line " "] a-line: rejoin [" |" to-string a-line "|"] loop 20 [print a-line] prin " " loop 13 [prin "+"] print "" print tui compose [ at 4x21 "TEXTRIS" at 5x21 "-------" at 7x20 "'K' =3D left" at 8x20 "'L' =3D right" at 9x20 "'O' =3D spin" at 10x20 "'P' =3D pause" at 12x21 "Score:" at 14x21 (to-string score) ] keys: open/binary/no-wait [scheme: 'console] forever [ random/seed now r: random 19 xpos: 9 for i 1 20 1 [ pos: to-pair rejoin [i "x" xpos] do compose/deep [prin tui [at (pos)] print tui shape/(r)] old-r: r old-xpos: xpos if not none? wait/all [keys :00:00.30] [ keystroke: to-string to-char to-integer copy keys switch/default keystroke [ "p" [ print tui [ at 23x0 "Press [Enter] to continue" ] ask "" print tui [ at 24x0 " " at 23x0 " " ] ] "k" [if (xpos > 5) [ xpos: xpos - 1 ]] "l" [if (xpos < (16 - compose width/(r))) [ xpos: xpos + 1 ]] "o" [if (xpos < (16 - compose width/(r))) [ switch to-string r [ "1" [r: 2] "2" [r: 1] "3" [r: 6] "4" [r: 3] "5" [r: 4] "6" [r: 5] "7" [r: 10] "8" [r: 7] "9" [r: 8] "10" [r: 9] "11" [r: 14] "12" [r: 11] "13" [r: 12] "14" [r: 13] "15" [r: 16] "16" [r: 15] "17" [r: 18] "18" [r: 17] "19" [r: 19] ] ] ] ] [] ] do compose/deep [ prin tui [at (pos)] print tui shape/(old-r + 19) ] stop: false foreach po compose oc/(r) [ foreach coord floor [ floor-y: to-integer first coord floor-x: to-integer second coord oc-y: i + to-integer first po oc-x: xpos + to-integer second po if (oc-y =3D (floor-y - 1)) and (floor-x =3D oc-x) [ stop-shape-num: r stop: true break ] ] ] foreach po compose oc/(old-r) [ foreach coord floor [ floor-y: to-integer first coord floor-x: to-integer second coord oc-y: i + to-integer first po oc-x: old-xpos + to-integer second po if (oc-y =3D (floor-y - 1)) and (floor-x =3D oc-x) [ stop-shape-num: old-r stop: true break ] ] ] if stop =3D true [ left-col: second pos width-of-shape: length? compose oc/(stop-shape-num) right-col: left-col + width-of-shape - 1 counter: 1 for current-column left-col right-col 1 [ add-coord: compose oc/(stop-shape-num)/(counter) new-floor-coord: (pos + add-coord) append floor new-floor-coord counter: counter + 1 ] break ] ] do compose/deep [prin tui [at (pos)] print tui shape/(old-r)] if (first pos) < 2 [ prin tui [at 23x0] print " GAME OVER!!!^/^/" halt ] score: score + 10 print tui compose [at 14x21 (to-string score)] for row 1 20 1 [ line-is-full: true for colmn 5 15 1 [ each-coord: to-pair rejoin [row "x" colmn] if not find floor each-coord [ line-is-full: false break ] ] if line-is-full =3D true [ remove-each cor floor [(first cor) =3D row] new-floor: copy [ 21x5 21x6 21x7 21x8 21x9 21x10 21x11 21x12 21x13 21x14 21x15 ] foreach cords floor [ either ((first cords) < row) [ append new-floor (cords + 1x0) ][ append new-floor cords ] ] floor: copy unique new-floor score: score + 1000 prin tui [clear] loop 20 [print a-line] prin " " loop 13 [prin "+"] print "" print tui compose [ at 4x21 "TEXTRIS" at 5x21 "-------" at 7x20 "'K' =3D left" at 8x20 "'L' =3D right" at 9x20 "'O' =3D spin" at 10x20 "'P' =3D pause" at 12x21 "Score:" at 14x21 (to-string score) ] foreach was-here floor [ if not ((first was-here) =3D 21) [ prin tui compose [at (was-here)] prin "#" ] ] ] ] ] -- To unsubscribe from the list, just send an email to lists at rebol.com with unsubscribe as the subject.
