qi7.red

Red [
	Needs: 'View
]

system/view/debug?: yes

workstation?: system/view/platform/product = 1

print [
	"Windows" switch system/view/platform/version [
		10.0.0	[pick ["10"			 "10 Server"	 ] workstation?]
		6.3.0	[pick ["8.1"		 "Server 2012 R2"] workstation?]
		6.2.0	[pick ["8"			 "Server 2012"	 ] workstation?]
		6.1.0	[pick ["7"			 "Server 2008 R1"] workstation?]
		6.0.0	[pick ["Vista"		 "Server 2008"	 ] workstation?]
		5.2.0	[pick ["Server 2003" "Server 2003 R2"] workstation?]
		5.1.0	["XP"]
		5.0.0	["2000"]
	] 
	"build" system/view/platform/build
]


; Initialize board margin and field size
margin-board: margin-x: margin-y: 20
field-size: field-width: field-height: 40
image-size: 30
half-size: image-size / 2
half-offset: 0x0
half-offset/1: half-offset/2: half-size

win: make face! [
	type: 'window text: "Board View Test" offset: 500x500 size: 800x800
	active-elt: none
	active-offset: 0x0
		actors: object [
			on-down: func [face [object!] event [event!]][
				move-piece event/offset - half-offset
				win/active-elt: none
				win/active-offset: 0x0
			]
		]
]

set-active-elt: func [
	face [object!]
	return: [string!]
][
	face/id
]

set-active-offset: func [
	event [event!]
	return: [string!]
][
	event/offset
]

image-object-actors: object [
	on-down: func [face [object!] event [event!]][
		select-piece face/id
		win/active-elt: set-active-elt face
		win/active-offset: set-active-offset event
	]

]

; Pieces a base element to catch the events and the image on top of the canvas
; display and event are reverse ordered

white-king-base: make face! [
	type: 'base  offset: 320x15 size: 30x30
	id: "WK"
	actors: image-object-actors
]
		
white-king: make face! [
	type: 'image offset: 320x15 size: 30x30
	data: [%../project/gui/Xiangqi_General_TR.png]
	id: "WK"
]
comment {
white-horse-1-base: make face! [
	type: 'base  offset: 320x15 size: 30x30
	id: "BH1"
	actors: image-object-actors
]
		
white-horse-1: make face! [
	type: 'image offset: 320x15 size: 30x30
	data: [%../project/gui/Xiangqi_Horse_TR.png]
	id: "BH1"
]

white-horse-2-base: make face! [
	type: 'base  offset: 320x15 size: 30x30
	id: "BH2"
	actors: image-object-actors
]
		
white-horse-2: make face! [
	type: 'image offset: 320x15 size: 30x30
	data: [%../project/gui/Xiangqi_Horse_TR.png]
	id: "BH2"
]
}
black-king-base: make face! [
	type: 'base  offset: 320x15 size: 30x30
	id: "BK"
	actors: image-object-actors
]
		
black-king: make face! [
	type: 'image offset: 320x15 size: 30x30
	data: [%../project/gui/Xiangqi_General_TB.png]
	id: "BK"
]
comment {
black-horse-1-base: make face! [
	type: 'base  offset: 320x15 size: 30x30
	id: "BH1"
	actors: image-object-actors
]
		
black-horse-1: make face! [
	type: 'image offset: 320x15 size: 30x30
	data: [%../project/gui/Xiangqi_Horse_TB.png]
	id: "BH1"
]

black-horse-2-base: make face! [
	type: 'base  offset: 320x15 size: 30x30
	id: "BH2"
	actors: image-object-actors
]
		
black-horse-2: make face! [
	type: 'image offset: 320x15 size: 30x30
	data: [%../project/gui/Xiangqi_Horse_TB.png]
	id: "BH2"
]
}
pieces-state: reduce [
;-- piece id   selected?		piece            base
	"WK"			no			white-king       white-king-base    
;	"WH1"			no			white-horse-1    white-horse-1-base 
;	"WH2"			no			white-horse-2    white-horse-2-base 
	"BK"			no			black-king       black-king-base    
;	"BH1"			no			black-horse-1    black-horse-1-base 
;	"BH2"			no			black-horse-2    black-horse-2-base 
]

saved-piece-offset: 0x0

select-piece: func [id [string!]][
	foreach [p s o b] pieces-state [		;-- reset all pieces-state
		pieces-state/(p): no
	]
	pieces-state/(id): yes
]

deselect-pieces: func [][
	foreach [p s o b] pieces-state [		;-- reset all pieces-state
		pieces-state/(p): no
	]
]

move-piece: func [offset [pair!]][
	foreach [id selected? piece base] pieces-state [
		if selected? [
			base/offset: offset
			piece/offset: offset
			show base
			show piece
			pieces-state/(id): no
		]
	]
	;probe pieces-state
]

win/pane: reduce [
	make face! [ ; text or label
		type: 'text text: "Board" offset: 100x50 size: 70x24
	]
	
	white-king-base
;	white-horse-1-base
;	white-horse-2-base
	black-king-base	
;	black-horse-1-base
;	black-horse-2-base
		
	canvas: make face! [
		type: 'base text: "canvas" offset: 100x100 size: 360x400 color: silver
		draw: [
			dummy draw contents
		]
		actors: object [
			on-down: func [face [object!] event [event!]][
				move-piece (face/offset + event/offset - half-offset)
				deselect-pieces
			]
		]
	]

	white-king
;	white-horse-1
;	white-horse-2
	black-king	
;	black-horse-1
;	black-horse-2

	make face! [ ; Quit button
		type: 'button text: "Quit" offset: 500x440 size: 60x24
		actors: object [
			on-click: func [face [object!] event [event!]][
				unview/all
			]
		]
	]
]

; Start drawing board on the canvas
canvas/draw: [
	line-cap round
	pen black
]

; Set canvas size (360x400)
canvas/size/1: 2 * margin-board + ( 8 * field-size )
canvas/size/2: 2 * margin-board + ( 9 * field-size )

; Draw outline
p1: p2: p3: p4: 0x0
p1/1: p1/2: p2/2: p4/1: margin-board
p2/1: p3/1: 8 * field-size + margin-board
p3/2: p4/2: 9 * field-size + margin-board

append canvas/draw reduce ['line p1 p2 p3 p4 p1] 

; Draw top vertical lines
p1: p2: 0x0
p1/2: margin-board
p2/2: field-size * 4 + margin-board 

repeat count 7 [
	vert: count * field-size + margin-board
	p1/1: vert
	p2/1: vert
	append canvas/draw reduce ['line p1 p2] 
]

; Draw bottom vertical lines
p1: p2: 0x0
p1/2: 5 * field-size + margin-board ; 220
p2/2: 9 * field-size + margin-board ; 380

repeat count 7 [
	vert: count * field-size + margin-board
	p1/1: vert
	p2/1: vert
	append canvas/draw reduce ['line p1 p2] 
]

; Draw horizontal lines
p1: p2: 0x0
p1/1: margin-board
p2/1: field-size * 8 + margin-board

repeat count 3 [
	vert: count * field-size + margin-board
	p1/2: vert
	p2/2: vert
	append canvas/draw reduce ['line p1 p2] 
]
; We skip the river, this is done later in blue
repeat count 3 [
	vert: count + 5 * field-size + margin-board ; count + 5 is calculated first!
	p1/2: vert
	p2/2: vert
	append canvas/draw reduce ['line p1 p2] 
]

; Draw the dots
dot-size: 4
p1/1: p1/2: margin-board

append canvas/draw [
	pen black
	fill-pen black
]

board-dots: [
	0x3 1x2 2x3 4x3 6x3 7x2 8x3
	0x6 1x7 2x6 4x6 6x6 7x7 8x6
]

foreach board-dot board-dots [
	append canvas/draw reduce [
		'circle board-dot * field-size + p1 dot-size
	]
]

; Draw the palace crosses
cross-points: [
	3x0 5x2
	5x0 3x2
	3x9 5x7
	5x9 3x7
]

foreach [p2 p3] cross-points [
	append canvas/draw reduce [
		'line p2 * field-size + p1 p3 * field-size + p1
	]
]

; Draw 'the river' in blue
append canvas/draw [
	pen blue
]

river-points: [
	0x4 8x4
	0x5 8x5
]

foreach [p2 p3] river-points [
	append canvas/draw reduce [
		'line p2 * field-size + p1 p3 * field-size + p1
	]
]

; Place the images where they belong

white-king/offset/1: 4 * field-size + margin-board - half-size
white-king/offset/2: 9 * field-size + margin-board - half-size
white-king/offset: white-king/offset + canvas/offset
white-king-base/offset: white-king/offset
comment {
white-horse-1/offset/1: field-size + margin-board - half-size
white-horse-1/offset/2: 9 * field-size + margin-board - half-size
white-horse-1/offset: white-horse-1/offset + canvas/offset
white-horse-1-base/offset: white-horse-1/offset

white-horse-2/offset/1: 7 * field-size + margin-board - half-size
white-horse-2/offset/2: 9 * field-size + margin-board - half-size
white-horse-2/offset: white-horse-2/offset + canvas/offset
white-horse-2-base/offset: white-horse-2/offset
}
black-king/offset/1: 4 * field-size + margin-board - half-size
black-king/offset/2: margin-board - half-size
black-king/offset: black-king/offset + canvas/offset
black-king-base/offset: black-king/offset
comment {
black-horse-1/offset/1: field-size + margin-board - half-size
black-horse-1/offset/2: margin-board - half-size
black-horse-1/offset: black-horse-1/offset + canvas/offset
black-horse-1-base/offset: black-horse-1/offset

black-horse-2/offset/1: 7 * field-size + margin-board - half-size
black-horse-2/offset/2: margin-board - half-size
black-horse-2/offset: black-horse-2/offset + canvas/offset
black-horse-2-base/offset: black-horse-2/offset
}

show win

do-events

qi8.red

Red [
	Needs: 'View
]

system/view/debug?: yes

workstation?: system/view/platform/product = 1

print [
	"Windows" switch system/view/platform/version [
		10.0.0	[pick ["10"			 "10 Server"	 ] workstation?]
		6.3.0	[pick ["8.1"		 "Server 2012 R2"] workstation?]
		6.2.0	[pick ["8"			 "Server 2012"	 ] workstation?]
		6.1.0	[pick ["7"			 "Server 2008 R1"] workstation?]
		6.0.0	[pick ["Vista"		 "Server 2008"	 ] workstation?]
		5.2.0	[pick ["Server 2003" "Server 2003 R2"] workstation?]
		5.1.0	["XP"]
		5.0.0	["2000"]
	] 
	"build" system/view/platform/build
]


; Initialize board margin and field size
margin-board: margin-x: margin-y: 20
field-size: field-width: field-height: 40
image-size: 30
half-size: image-size / 2
half-offset: 0x0
half-offset/1: half-offset/2: half-size

win: make face! [
	type: 'window text: "Board View Test" offset: 500x500 size: 800x800
		actors: object [
			on-down: func [face [object!] event [event!]][
				move-piece event/offset - half-offset
			]
		]
]

image-object-actors: object [
	on-down: func [face [object!] event [event!]][
		select-piece face/id
	]

]

; Pieces a base element to catch the events and the image on top of the canvas
; display and event are reverse ordered

white-king-base: make face! [
	type: 'base  offset: 320x15 size: 30x30
	id: "WK"
	actors: image-object-actors
]
		
white-king: make face! [
	type: 'image offset: 320x15 size: 30x30
	data: [%../project/gui/Xiangqi_General_TR.png]
	id: "WK"
]
comment {
white-horse-1-base: make face! [
	type: 'base  offset: 320x15 size: 30x30
	id: "BH1"
	actors: image-object-actors
]
		
white-horse-1: make face! [
	type: 'image offset: 320x15 size: 30x30
	data: [%../project/gui/Xiangqi_Horse_TR.png]
	id: "BH1"
]

white-horse-2-base: make face! [
	type: 'base  offset: 320x15 size: 30x30
	id: "BH2"
	actors: image-object-actors
]
		
white-horse-2: make face! [
	type: 'image offset: 320x15 size: 30x30
	data: [%../project/gui/Xiangqi_Horse_TR.png]
	id: "BH2"
]
}
black-king-base: make face! [
	type: 'base  offset: 320x15 size: 30x30
	id: "BK"
	actors: image-object-actors
]
		
black-king: make face! [
	type: 'image offset: 320x15 size: 30x30
	data: [%../project/gui/Xiangqi_General_TB.png]
	id: "BK"
]
comment {
black-horse-1-base: make face! [
	type: 'base  offset: 320x15 size: 30x30
	id: "BH1"
	actors: image-object-actors
]
		
black-horse-1: make face! [
	type: 'image offset: 320x15 size: 30x30
	data: [%../project/gui/Xiangqi_Horse_TB.png]
	id: "BH1"
]

black-horse-2-base: make face! [
	type: 'base  offset: 320x15 size: 30x30
	id: "BH2"
	actors: image-object-actors
]
		
black-horse-2: make face! [
	type: 'image offset: 320x15 size: 30x30
	data: [%../project/gui/Xiangqi_Horse_TB.png]
	id: "BH2"
]
}
pieces-state: reduce [
;-- piece id   selected?		piece            base
	"WK"			no			white-king       white-king-base    
;	"WH1"			no			white-horse-1    white-horse-1-base 
;	"WH2"			no			white-horse-2    white-horse-2-base 
	"BK"			no			black-king       black-king-base    
;	"BH1"			no			black-horse-1    black-horse-1-base 
;	"BH2"			no			black-horse-2    black-horse-2-base 
]

saved-piece-offset: 0x0

select-piece: func [id [string!]][
	foreach [p s o b] pieces-state [		;-- reset all pieces-state
		pieces-state/(p): no
	]
	pieces-state/(id): yes
]

deselect-pieces: func [][
	foreach [p s o b] pieces-state [		;-- reset all pieces-state
		pieces-state/(p): no
	]
]

move-piece: func [offset [pair!]][
	foreach [id selected? piece base] pieces-state [
		if selected? [
			base/offset: offset
			piece/offset: offset
			show base
			show piece
			pieces-state/(id): no
		]
	]
	;probe pieces-state
]

win/pane: reduce [
	make face! [ ; text or label
		type: 'text text: "Board" offset: 100x50 size: 70x24
	]
	
	white-king-base
;	white-horse-1-base
;	white-horse-2-base
	black-king-base	
;	black-horse-1-base
;	black-horse-2-base
		
	canvas: make face! [
		type: 'base text: "canvas" offset: 100x100 size: 360x400 color: silver
		draw: [
			dummy draw contents
		]
		actors: object [
			on-down: func [face [object!] event [event!]][
				move-piece (face/offset + event/offset - half-offset)
				deselect-pieces
			]
		]
	]

	white-king
;	white-horse-1
;	white-horse-2
	black-king	
;	black-horse-1
;	black-horse-2

	make face! [ ; Quit button
		type: 'button text: "Quit" offset: 500x440 size: 60x24
		actors: object [
			on-click: func [face [object!] event [event!]][
				unview/all
			]
		]
	]
]

; Start drawing board on the canvas
canvas/draw: [
	line-cap round
	pen black
]

; Set canvas size (360x400)
canvas/size/1: 2 * margin-board + ( 8 * field-size )
canvas/size/2: 2 * margin-board + ( 9 * field-size )

; Draw outline
p1: p2: p3: p4: 0x0
p1/1: p1/2: p2/2: p4/1: margin-board
p2/1: p3/1: 8 * field-size + margin-board
p3/2: p4/2: 9 * field-size + margin-board

append canvas/draw reduce ['line p1 p2 p3 p4 p1] 

; Draw top vertical lines
p1: p2: 0x0
p1/2: margin-board
p2/2: field-size * 4 + margin-board 

repeat count 7 [
	vert: count * field-size + margin-board
	p1/1: vert
	p2/1: vert
	append canvas/draw reduce ['line p1 p2] 
]

; Draw bottom vertical lines
p1: p2: 0x0
p1/2: 5 * field-size + margin-board ; 220
p2/2: 9 * field-size + margin-board ; 380

repeat count 7 [
	vert: count * field-size + margin-board
	p1/1: vert
	p2/1: vert
	append canvas/draw reduce ['line p1 p2] 
]

; Draw horizontal lines
p1: p2: 0x0
p1/1: margin-board
p2/1: field-size * 8 + margin-board

repeat count 3 [
	vert: count * field-size + margin-board
	p1/2: vert
	p2/2: vert
	append canvas/draw reduce ['line p1 p2] 
]
; We skip the river, this is done later in blue
repeat count 3 [
	vert: count + 5 * field-size + margin-board ; count + 5 is calculated first!
	p1/2: vert
	p2/2: vert
	append canvas/draw reduce ['line p1 p2] 
]

; Draw the dots
dot-size: 4
p1/1: p1/2: margin-board

append canvas/draw [
	pen black
	fill-pen black
]

board-dots: [
	0x3 1x2 2x3 4x3 6x3 7x2 8x3
	0x6 1x7 2x6 4x6 6x6 7x7 8x6
]

foreach board-dot board-dots [
	append canvas/draw reduce [
		'circle board-dot * field-size + p1 dot-size
	]
]

; Draw the palace crosses
cross-points: [
	3x0 5x2
	5x0 3x2
	3x9 5x7
	5x9 3x7
]

foreach [p2 p3] cross-points [
	append canvas/draw reduce [
		'line p2 * field-size + p1 p3 * field-size + p1
	]
]

; Draw 'the river' in blue
append canvas/draw [
	pen blue
]

river-points: [
	0x4 8x4
	0x5 8x5
]

foreach [p2 p3] river-points [
	append canvas/draw reduce [
		'line p2 * field-size + p1 p3 * field-size + p1
	]
]

; Place the images where they belong

white-king/offset/1: 4 * field-size + margin-board - half-size
white-king/offset/2: 9 * field-size + margin-board - half-size
white-king/offset: white-king/offset + canvas/offset
white-king-base/offset: white-king/offset
comment {
white-horse-1/offset/1: field-size + margin-board - half-size
white-horse-1/offset/2: 9 * field-size + margin-board - half-size
white-horse-1/offset: white-horse-1/offset + canvas/offset
white-horse-1-base/offset: white-horse-1/offset

white-horse-2/offset/1: 7 * field-size + margin-board - half-size
white-horse-2/offset/2: 9 * field-size + margin-board - half-size
white-horse-2/offset: white-horse-2/offset + canvas/offset
white-horse-2-base/offset: white-horse-2/offset
}
black-king/offset/1: 4 * field-size + margin-board - half-size
black-king/offset/2: margin-board - half-size
black-king/offset: black-king/offset + canvas/offset
black-king-base/offset: black-king/offset
comment {
black-horse-1/offset/1: field-size + margin-board - half-size
black-horse-1/offset/2: margin-board - half-size
black-horse-1/offset: black-horse-1/offset + canvas/offset
black-horse-1-base/offset: black-horse-1/offset

black-horse-2/offset/1: 7 * field-size + margin-board - half-size
black-horse-2/offset/2: margin-board - half-size
black-horse-2/offset: black-horse-2/offset + canvas/offset
black-horse-2-base/offset: black-horse-2/offset
}

show win

do-events

result of qi8.red.txt

Windows 7 build 7601
*** Script error: path none is not valid for integer type
*** Where: eval-set-path
*** Stack: repeat eval-set-path