Script Library: 1238 scripts
  • Home
  • Script library
  • AltME Archive
  • Mailing list
  • Articles Index
  • Site search
 

Archive version of: cbh.r ... version: 1 ... arnold 26-Aug-2012

Amendment note: new script || Publicly available? Yes

REBOL [ Title: "Chess board handler"
        File: %cbh.r
        Date: 7-aug-2012
        Author: "Arnold van Hofwegen"
        Purpose: "Function as a chess board interface."
]
;**********
; Constants
;**********
grootte: 40 ;-- field size on the GUI
transplborder: 0.0.255.128 ; blue
transplfill: 164.200.255.128 ; sky
do %chessimage.r
do %chessmoves.r
;**********
; Variables
;**********
board-line-width: 1
pen-board: Black
pen-legal-move: Blue
;*******************************************************************************
; Functions
;*******************************************************************************
;*******************
; Initialize screens
;*******************
init-draw-board-box: func [/local n m x y adder field-shape] [
    draw-board-box: copy []
    draw-board-box: append draw-board-box reduce ['pen 'black 'fill-pen 'silver 'line-width board-line-width]
    draw-board-box: append draw-board-box compose [line 0x0 (to-pair reduce [0 8 * grootte])]
    draw-board-box: append draw-board-box compose [line 0x0 (to-pair reduce [8 * grootte 0])]
    draw-board-box: append draw-board-box compose [line (to-pair reduce [0 8 * grootte]) (to-pair reduce [8 * grootte 8 * grootte])]
    draw-board-box: append draw-board-box compose [line (to-pair reduce [8 * grootte 0]) (to-pair reduce [8 * grootte 8 * grootte])]
    
    for m 0 7 1 [
        for n 0 3 1 [
            ; donkere velden, bepaal begin punt en teken een vierkant
            adder: either odd? m [0][1]
            x: (n * 2 + adder) * grootte
            y: m * grootte
            draw-board-box: append draw-board-box compose [shape]
            field-shape: copy []
            field-shape: append field-shape compose [move (as-pair x y)]
            field-shape: append field-shape compose ['hline (grootte)]
            field-shape: append field-shape compose ['vline (grootte)]
            field-shape: append field-shape compose ['hline (- grootte)]
            field-shape: append field-shape compose ['vline (- grootte)]
            draw-board-box: append/only draw-board-box field-shape
        ]
    ]
]

init-board-box: func [] [
    init-draw-board-box
]

init-draw-legal-moves: func [/local x y t field-shape] [
    draw-legal-moves-box: copy []
	legal-moves-box/effect: reduce ['draw draw-legal-moves-box]
	show legal-moves-box
]

make-draw-legal-moves: func [fieldnr /local x y t field-shape] [
    draw-legal-moves-box: copy []
    ;draw-legal-moves-box: append draw-legal-moves-box reduce ['pen 'blue 'fill-pen 'sky 'line-width board-line-width]
    draw-legal-moves-box: append draw-legal-moves-box reduce ['pen 'transplborder 'fill-pen 'transplfill 'line-width board-line-width]
    destinations: select from-to-fields fieldnr
	if  not none = destinations [
	    foreach field destinations [
	        x: grootte * to-integer field - 1 / 8
            t: (field - 1) // 8 + 1
            y: 8 - t * grootte
            draw-legal-moves-box: append draw-legal-moves-box compose [shape]
	    	field-shape: copy []
	    	field-shape: append field-shape compose [move (as-pair x y)]
	    	field-shape: append field-shape compose ['hline (grootte)]
	    	field-shape: append field-shape compose ['vline (grootte)]
	    	field-shape: append field-shape compose ['hline (- grootte)]
	    	field-shape: append field-shape compose ['vline (- grootte)]
	    	draw-legal-moves-box: append/only draw-legal-moves-box field-shape
	    ]
	]
	legal-moves-box/effect: reduce ['draw draw-legal-moves-box]
	show legal-moves-box
]

place-pieces-init: func [/local piece-order kleur n img-piece] [
  piece-order: "RNBQKBNR"
  kleur: "-white"
  for n 1 8 1 [
      img-piece: to-word rejoin ["img-" pick piece-order n kleur]
      pieces/pane/:n/image: get img-piece
      pieces/pane/:n/size: 41x41
      pieces/pane/:n/offset: as-pair n - 1 * grootte 7 * grootte
  ]
  for n 9 16 1 [
      pieces/pane/:n/image: img-P-white
      pieces/pane/:n/size: 41x41
      pieces/pane/:n/offset: as-pair n - 9 * grootte 6 * grootte
  ]  
  kleur: "-black"
  for n 17 24 1 [
      pieces/pane/:n/image: img-P-black
      pieces/pane/:n/size: 41x41
      pieces/pane/:n/offset: as-pair n - 17 * grootte grootte
  ]
  for n 25 32 1 [
      img-piece: to-word rejoin ["img-" pick piece-order n - 24 kleur]
      pieces/pane/:n/image: get img-piece
      pieces/pane/:n/size: 41x41
      pieces/pane/:n/offset: as-pair n - 25 * grootte 0
  ]  
  show pieces
]

pieceval-to-letter: func [piece [integer!]] [
    switch piece [
          4   5   6   7 [return "P"]
        128 129 130 131 [return "K"]
         32  33  34  35 [return "R"]
         16  17  18  19 [return "B"]
          8   9  10  11 [return "N"]
         64  65  66  67 [return "Q"]
    ]
]

field-as-offset: func [n /local x y ] [
    x: grootte * to-integer n - 1 / 8
    y: 7 - (n - 1 // 8) * grootte
    return as-pair x y
]

place-pieces: func [/local n piecenr thispiece letter kleur img-piece] [
    ;-- use the generated block from the chess-move generator to place the pieces on the board
    ; This block looks like:
    ; [128 [3] 64 [20 21]] or something like that
    ;-- first clear old images from the board
    for n 1 32 1 [pieces/pane/:n/offset: -200x-200]
    ;-- 
    piecenr: 1
    for n 1 64 1 [
        thispiece: game-board/(n)
        if  0 < thispiece [
            letter: pieceval-to-letter game-board/(n)
            kleur: either odd? thispiece ["-black"]["-white"]
            img-piece: to-word rejoin ["img-" letter kleur]
            pieces/pane/:piecenr/image: get img-piece
            pieces/pane/:piecenr/offset: field-as-offset n
            piecenr: piecenr + 1
        ]
    ]        
]

compute-offset-field: func [xy [pair!]
    /local rij kol veldpaar] [
    rij: to-integer (xy/2 / grootte) + 1
    kol: to-integer (xy/1 / grootte) + 1
    veldpaar: as-pair kol rij 
]

xy-to-field: func [xy [pair!] /local t] [
    t: xy/1 - 1 * 8 + 9 - xy/2
]

validate-moving: func [from-field destination [pair!] /fieldnr] [
    ;-- use the generated block from-to-fields from the chessmoves.r 
    ;   generator to determine the valid destination fields of the 
    ;   selected piece
    ; This block looks like:
    ; [1 [2 3] 64 [20 21]]
    destinations: select from-to-fields from-field
    ;-- Start by checking inside the board boundaries
    either all [destination/1 > 0
        destination/1 < 9
        destination/2 > 0
        destination/2 < 9] [
        fieldnr: xy-to-field destination
        if  none = destinations [return false]
        if  found? find destinations fieldnr [return true]
        return false
    ][ 
        return false
    ]
]
;--------------
; Button actions
action-import-position: func [] [
    importstring: copy new-white-pos/text
    importstring: append importstring new-black-pos/text
    wb: either check-move/data [1][0]
    ; this is a function from %chessmoves.r
    import-position importstring wb
    either error-in-position [
        print error-description
    ][   
        init-influence 
        fill-influence
    ]
    fill-pieces
]

action-take-back-move: func [] [
	; call function from %chessmoves.r
	;print "action-take-back-move"
	take-move-back
	update-interface
	show pieces
]

action-help: func [] [
    alert "Sorry, not implemented at this moment."
]
;---------------------------------------------------
; Move the selected piece to the "end" of the layout 
; effectively to the top of the z-index
;-- function copied from %display-chess-board.r from rebol.org by Sunanda
move-to-top: func [series item /local item-index item-value] [
    item-index: find series item
    item-value: first item-index
    remove item-index
 
    append series item-value
    show last series
    show item-value
    
]

update-interface: func [] [
    hintbox/color: either white-to-move [white][black]
	who-is-to-move-txt/text: either white-to-move ["White"]["Black"]
	show hintbox
	show who-is-to-move-txt
	list-played/data: played-moves
	show list-played
	init-influence 
	fill-influence
	make-moves
	place-pieces
	list-legal/data: legal-moves
	show list-legal
	txt-number-legal/text: length? legal-moves
	show txt-number-legal
	txt-information/text: either 0 = length? info-txt ["Message area"][info-txt]
	show txt-information
]

movestyle: [
    engage: func [face action event] [
        if  action = 'down [
            position: face/offset
            startfield: compute-offset-field face/offset + event/offset
            fieldfrom: startfield/1 - 1 * 8 + 9 - startfield/2
            move-to-top pieces/pane face
            make-draw-legal-moves fieldfrom
            start: event/offset
            ]
        if  find [over away] action [
            face/offset: face/offset + event/offset - start
            show face
        ]
        if  action = 'up [
            fieldto: compute-offset-field face/offset + event/offset           
            either validate-moving fieldfrom fieldto [
                face/offset: 0x0 + as-pair fieldto/1 - 1 * grootte  fieldto/2 - 1 * grootte
                ; give move to the chessmoves module
                perform-move fieldfrom xy-to-field fieldto
                update-interface
            ][
                face/offset: position
            ]
            init-draw-legal-moves
            show face
        ]
    ]
]

piece-styles: stylize [
    apiece: image red-pixel feel movestyle
]
;**********************************************************
; Layout applicationscreen
;**********************************************************
main: layout [
    ;size 800x700
    below
    styles piece-styles
    hier: at
    at hier + 0x50
    board-box: box " " 320x320 white 
    txt-information: text teal ivory 320 center "Message area"
    across
    btn-back: button 100 "Undo move" [action-take-back-move]
    text 130 "Player to move next:"
    who-is-to-move-txt: text "White"
    hintbox: box 20x20 white
    return
    thispos: text "Input your gameposition" 
    return
    text "White pieces (KE1Dd2RA1Rh4Bc1Bf1Nb1Ng1Pa2 etc):" 
    return
    new-white-pos: field 300 ""
    return
    text "Black pieces (KE8Dd5RA8Rh6Bc8Bf8Nb8Ng8Pa7 etc):" 
    return
    new-black-pos: field 300 ""
    return
    check-move: check false [either check-move/data [move-for-txt/text: "Black to move"] 
                                                    [move-for-txt/text: "White to move"] 
                             show move-for-txt]
    move-for-txt: text "White to move"
    return
    last-move-txt: text 80 "Last move"
    last-move: field 100 "" 
    btn-import: button 90 "Import Pos." [action-import-position]
    btn-help: button 50 "Help" [action-help]
    at hier + 0x50
    legal-moves-box: box " " 1x1 white
    at hier + 0x50
    pieces: panel [below size 320x320
        apiece apiece apiece apiece apiece apiece apiece apiece
        apiece apiece apiece apiece apiece apiece apiece apiece
        apiece apiece apiece apiece apiece apiece apiece apiece
        apiece apiece apiece apiece apiece apiece apiece apiece        
    ]
    at 380x20
    vh2 "Legal moves list:"
    at 380x50
    list-legal: text-list 150x500 ""
    at 380x560
    txt-number-legal: text 60 teal ivory "Number"
    at 540x20
    vh2 "Played moves:"
    at 540x50
    list-played: text-list 150x500 ""
    across
    at hier
    btn-debug:         button "Debug draw" [print hier]
    btn-inform:         button "Info" [i: to-image main save/png %screenshot.png i]
    btn-herstart: button "Herstart" [unview/all do %cbh.r]   
]

;**********************************************************
; Program
;**********************************************************
;box-size: to-pair reduce [8 * grootte + 1 8 * grootte + 1]
box-size: to-pair reduce [8 * grootte  8 * grootte]
board-box/size: box-size
legal-moves-box/size: box-size
legal-moves-box/color: none
pieces/size: box-size

init-board-box
board-box/effect: reduce ['draw draw-board-box]
place-pieces-init
init-standard-position
update-interface

view main
Notes