home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
ARM Club 3
/
TheARMClub_PDCD3.iso
/
programs
/
comms_networking
/
netreact
/
!NetReact
/
!RunImage
(
.txt
)
< prev
next >
Wrap
RISC OS BBC BASIC V Source
|
1998-03-07
|
17KB
|
699 lines
><NetReact$Dir>.!RunImage
NetReaction
By Robert Hampton / FABsoft
NetGame is (C) Justin Fletcher
This version has better redraw!
testing%=
"<BasicLibrary$File>":
initlibrary
"<HeapLibrary$File>":
initheap
"<NetGameLibrary$File>"
closemessages:
eerror:
testing%=
("Spool"):
testing%=
*Spool Spooled
testing%=
Appname$ is used for task manager & Appname$Dir
shortname$ is used for iconbar name and should usually be null
longname$ is used for info window
AppURL$ is used to for clicks on the version icon
5Appname$="NetReact":version$="0.52 (27 Feb 1998)"
&shortname$="":longname$="Reaction"
'Appdir$=
systemvar(Appname$+"$Dir")
JAppURL$="http://www.argonet.co.uk/users/fabland/fabsoft/netreact.html"
initwimp:
initprog
quit%=
:init%=
error
init%
go$=
GetEnv:init%=
go$<>""
loadfile(go$,
filetype(go$))
quit%=
"Wimp_CloseDown"
closemessages
netgame_final
testing%=
*SPOOL
quit%=-1 for user quit, -2 for taskmanager quit
"OS_ReadMonotonicTime"
"Wimp_Poll",0,b%
reason%
reason%
Null poll
netgame_poll:
Check if there is something to do
,$
checking%=
check_board
redrawwindow(b%):
1 = Redraw window
"Wimp_OpenWindow",,b%
"Wimp_CloseWindow",,b%
mouseclick(b%!0,b%!4,b%!8,b%!12,b%!16)
7 = Drag box dropped on another task
processkey(b%!0,b%!4,b%!24)
menuchoice
17,18:
receive(b%!16)
receiveack(b%!16)
redrawwindow(b%)
x0%,y0%,x1%,y1%,scx%,scy%,bx%,by%,lx%,ly%,c%,sprite$
b%!0=boardwin%
"Wimp_RedrawWindow",,b%
more%
draw_board(b%,more%)
The whole redraw routine is sort of fixed.
draw_board(b%,m%)
lx%,ly%
vars(b%)
coord_realtowin(boardwin%,redraw_minx%,redraw_miny%)
coord_realtowin(boardwin%,redraw_maxx%,redraw_maxy%)
lx%=0
J'
(lx%/2)=
(lx%/2)
c%=1
c%=2
ly%=0
c%+=1:
c%>2
c%=1
coord_rec_overlap(lx%*100-4,-ly%*100-4,lx%*100+104,-ly%*100-104,redraw_minx%,redraw_miny%,redraw_maxx%,redraw_maxy%)
NZ
sprite_plot("c"+
(c%)+"back",bx%+boardleft%+(lx%)*100,by%+boardtop%-(ly%+1)*100)
O@
boardcounter%(lx%,ly%)>0
boardcounter%(lx%,ly%)<5
sprite_plot("c"+
(boardcounter%(lx%,ly%))+col$(boardcolour%(lx%,ly%)),bx%+boardleft%+(lx%)*100,by%+boardtop%-(ly%+1)*100)
R$
bangx%=lx%
bangy%=ly%
S]
sprite_plot("explosion",bx%+boardleft%+(bangx%)*100,by%+boardtop%-(bangy%+1)*100)
U
"Wimp_GetRectangle",,b%
sprite_plot(sprite$,x%,y%)
(x%>x0%-100
x%<x1%+100)
(y%>y0%-100
y%<y1%+100)
"Wimp_ReadPixTrans",&100,sprites%,sprite$,,,,sscale%,strans%
"OS_SpriteOp",308,sprites%,sprite$,x%,y%,8,sscale%,strans%
boardclick(xpos%,ypos%)
sx%,sy%
checking%=
screentowin(boardwin%,xpos%,ypos%)
sx%=xpos%
sx%>7
sx%=7
sx%<0
sx%=0
sy%=-ypos%
sy%>7
sy%=7
sy%<0
sy%=0
placecounter(sx%,sy%)
placecounter(sx%,sy%)
boardcolour%(sx%,sy%)=player%
boardcolour%(sx%,sy%)=-1
t# boardcolour%(sx%,sy%)=player%
boardcounter%(sx%,sy%)+=1
updatesquare(sx%,sy%)
3,-15,&7000,0
checking%=
:turns%+=1
player%=us%
z(
netgame_send("G"+
(sx%)+
(sy%))
check_board
lx%,ly%
checking%=
lx%=0
ly%=0
boardcounter%(lx%,ly%)>boardmaxno%(lx%,ly%)
9 boardcounter%(lx%,ly%)=0:boardcolour%(lx%,ly%)=-1
bang(lx%,ly%)
updatesquare(lx%,ly%)
lx%>0
% boardcounter%(lx%-1,ly%)+=1
) boardcolour%(lx%-1,ly%)=player%
"
updatesquare(lx%-1,ly%)
checking%=
lx%<7
& boardcounter%(lx%+1,ly%)+=1
) boardcolour%(lx%+1,ly%)=player%
"
updatesquare(lx%+1,ly%)
checking%=
ly%>0
% boardcounter%(lx%,ly%-1)+=1
) boardcolour%(lx%,ly%-1)=player%
"
updatesquare(lx%,ly%-1)
checking%=
ly%<7
% boardcounter%(lx%,ly%+1)+=1
) boardcolour%(lx%,ly%+1)=player%
"
updatesquare(lx%,ly%+1)
checking%=
checking%=
ly%=7:lx%=7:
very bad form!
ly%:
checking%=
player%=pblue%
player%=pgreen%
player%=pblue%
bangclear:
count
updatetitle
count
lx%,ly%
pbluesc%=0:pgreensc%=0
lx%=0
ly%=0
boardcolour%(lx%,ly%)=pblue%
pbluesc%+=boardcounter%(lx%,ly%)
boardcolour%(lx%,ly%)=pgreen%
pgreensc%+=boardcounter%(lx%,ly%)
ly%:
pbluesc%=0
turns%>1
pwon%=pgreen%
pgreensc%=0
turns%>1
pwon%=pblue%
seticontext(boardwin%,5,
(pbluesc%))
seticontext(boardwin%,7,
(pgreensc%))
pwon%<>-1
gameover
gameover
dummy%
pwon%=us%
2 dummy%=
errorbox(">Message",">WinUs",%10001)
4 dummy%=
errorbox(">Message",">WinThem",%10001)
bang(sx%,sy%)
bangclear
bangx%=sx%:bangy%=sy%
updatesquare(bangx%,bangy%)
2,-15,&3500,0
bangclear
tempx%,tempy%
tempx%=bangx%:tempy%=bangy%
bangx%=-1:bangy%=-1
updatesquare(tempx%,tempy%)
board_clear(notify%)
sx%,sy%
sx%=0
sy%=0
9 boardcounter%(sx%,sy%)=0:boardcolour%(sx%,sy%)=-1
redrawicon(boardwin%,3)
;turns%=0:pbluesc%=0:pgreensc%=0:player%=pblue%:pwon%=-1
seticontext(boardwin%,5,
(pbluesc%))
seticontext(boardwin%,7,
(pgreensc%))
updatetitle
notify%=
netgame_send("C")
updatetitle
pwon%=-1
player%=us%
4
windowtitle(boardwin%,">Us:"+col$(player%))
6
windowtitle(boardwin%,">Them:"+col$(player%))
pwon%=us%
(
windowtitle(boardwin%,">WinUs")
*
windowtitle(boardwin%,">WinThem")
updatesquare(sx%,sy%)
left%,top%,right%,bottom%,more%
left%=boardleft%+sx%*100
top%=boardtop%-sy%*100
right%=left%+100
bottom%=top%-100
b%!0=boardwin%
b%!4=left%:b%!8=bottom%
b%!12=right%:b%!16=top%
"Wimp_UpdateWindow",,b%
more%
draw_board(b%,more%)
vars(B%)
?x0%=B%!4:y0%=B%!8:x1%=B%!12:y1%=B%!16:scx%=B%!20:scy%=B%!24
bx%=x0%-scx%:by%=y1%-scy%
redraw_minx%=B%!28
redraw_miny%=B%!32
redraw_maxx%=B%!36
redraw_maxy%=B%!40
Buttons : 1 = Adjust, 2 = Menu, 4 = Select
mouseclick(x,y,but,win,icon)
win
but
ibmenu
1,4:
Select or adjust
netgame_connected
openwin(boardwin%)
0
openconnect:
Open the connect window
boardwin%
icon
but=2
menu(boardmenu%,-1,0)
board_clear(
but=1
but=4
openwin(sendwin%)
but=1
but=4
disconnect
but=2
menu(boardmenu%,-1,0)
,
but=4
netgame_connected
;
pwon%=-1
player%=us%
boardclick(x,y)
infobox%
icon
!#
testing%=
showfree
"H
FetchPage("http://www.argonet.co.uk/users/fabland/fabsoft/")
FetchPage(AppURL$)
connectwin%
icon
'7
menu(
netgame_sitesmenu,-1,-1):
Sites list
tryconnect
sendwin%
icon
,*
Cancel - clear text and close
-#
seticontext(sendwin%,0,"")
closewin(sendwin%)
Send
sendmessage
msgwin%
icon
Reply
openreply
closewin(win)
boardwin%
icon
Message
openwin(sendwin%)
=
setcaretend(sendwin%,0)
greyouticons_cos_disconnected
iconshade(boardwin%,0,1)
iconshade(boardwin%,1,1)
and menus too!
menushade(boardmenu%,1,1)
menushade(boardmenu%,2,1)
ungreyouticons_cos_connected
iconshade(boardwin%,0,0)
iconshade(boardwin%,1,0)
and menus too!
menushade(boardmenu%,1,0)
menushade(boardmenu%,2,0)
processkey(win,icon,key)
keydone:keydone=
win
connectwin%
key
W#
Escape - close window
closewin(connectwin%)
Return
tryconnect:keydone=
sendwin%
key
^#
Escape - close window
_%
closewin(sendwin%):keydone=
Return
sendmessage:keydone=
keydone
"Wimp_ProcessKey",key
menuchoice
"Wimp_GetPointerInfo",,message_buffer%:mbut%=message_buffer%!8
curmenu%
netgame_sitesmenu:
The sites menu, so select it
netgame_selectsite(!b%,connectwin%,1,3,-1)
l@ curmenu%=
netgame_sitesmenu:
In case it's been re-created
ibmenu%
!b%
2:quit%=
p7
netgame_editsites(bestport%):
Editing time
boardmenu%
!b%
disconnect
u&
board_clear(
tell them
(mbut%
1)=1
recreatemenu
curmenu%=-1
disconnect
greyouticons_cos_disconnected
netgame_disconnect
updatetitle
receive(mess)
mess
&400C1 = mode change
&400C2 = task start up
&400C3 = task shut down
&90281:
Sites file has been updated
netgame_readsites
0:quit%=
&502:
Help(b%!32,b%!36,b%!4)
desktopsave(b%!20)
receiveack(mess)
mess
desktopsave(file%)
b%!12=b%!8:
"Wimp_SendMessage",19,b%,b%!4:
The above line acknowledges the message if an error occurs
aborting the desktop save.
#file%,"Run "+Appdir$
loadfile(file$,type)
type
Any messages to be received MUST be noted
initwimp
messagelist% 256:messptr%=0
notemessage(&502):
notemessage(10):
notemessage(&90281)
notemessage(0)
"Wimp_Initialise",310,&4B534154,Appname$,messagelist%
wimpversion,taskhandle
Gindl%=1024:menul%=1024:
b% 2048,ind% indl%,menu% menul%,wspc% &800
curmenu%=-1
openmessages
-sprites%=
loadsprites(Appdir$+".Sprites")
$infobox%=
loadtemplate("Info",1)
*connectwin%=
loadtemplate("connect",1)
$sendwin%=
loadtemplate("send",1)
&msgwin%=
loadtemplate("message",1)
&boardwin%=
loadtemplate("Board",1)
b%!0=boardwin%:b%!4=3
"Wimp_GetIconState",,b%
+boardleft%=(b%!8)+4:boardtop%=(b%!20)-4
seticontext(infobox%,1,Appname$)
seticontext(infobox%,2,longname$+" (port xxxx)")
seticontext(infobox%,4,version$)
:ibhandle=
CreateIconBarIcon("!"+Appname$,shortname$,1)
Aibmenu%=
createmenu(Appname$+"|Info]>infobox%|Sites...|Quit")
Mboardmenu%=
createmenu(Appname$+"|Info]>infobox%|Clear Board|Disconnect")
iboptions%=options%
initprog
x%,y%
Initialise the network game library
bestport% is the port we listen on by default
bestport%=4000
/port=
netgame_init(bestport%):
Port number
Ensure that everything went ok
port=-1
6 reply=
errorbox(">Message",">CouldntInit",%10001)
"Wimp_CloseDown"
closemessages
seticontext(infobox%,2,">Info:"+
port)
Mark the correct site in the connect window
seticontext(connectwin%,3,
port)
Read the sites from the file
netgame_readsites
sscale% 16:
strans% 16:
for Wimp_ReadPixTrans call
wins%(1),boardcounter%(7,7),boardcolour%(7,7),col$(1)
!boardcolour%()=-1:checking%=
boardmaxno%(7,7)
x%=0
y%=0
boardmaxno%(x%,y%)=3
(
x%*y%=0
boardmaxno%(x%,y%)=2
%
x%=7
boardmaxno%(x%,y%)=2
%
y%=7
boardmaxno%(x%,y%)=2
,
x%=0
y%=0
boardmaxno%(x%,y%)=1
,
x%=0
y%=7
boardmaxno%(x%,y%)=1
,
x%=7
y%=0
boardmaxno%(x%,y%)=1
,
x%=7
y%=7
boardmaxno%(x%,y%)=1
;pblue%=0:pgreen%=1:col$()="blue","green":player%=pblue%
@bangx%=-1:bangy%=-1:pbluesc%=0:pgreensc%=0:pwon%=-1:turns%=0
load sound samples
*ChannelVoice 2 ReactBang
*ChannelVoice 3 ReactPlip
Help(win,icon,to)
readhelp(win,icon,to)
Windows
infobox%,">HInfobox"
3,">HInfobox3"
4,">HInfobox4"
sendwin%,">HSendwin"
2,">HSCancel"
3,">HSSend"
msgwin%,">HMsgwin"
2,">HReply"
1,">HOk"
connectwin%,">HConnectwin"
4,">HCOk"
boardwin%,">HBoardwin"
0,">HBWDisconnect"
1,">HBWMessage"
3,">HBWBoard"
5,">HBWBlue"
7,">HBWGreen"
-2,">HIconbar"
-1,-1
Menus
ibmenu%,-1,-1,-1
0,-1,-1,">HMInfo"
1,-1,-1,">HMSites"
2,-1,-1,">HMQuit"
boardmenu%,-1,-1,-1
0,-1,-1,">HMInfo"
1,-1,-1,">HMClear"
2,-1,-1,">HMDisconnect"
-2,-2,-2,-2
FetchPage(f$)
XURI_Dispatch - this protocol is still being decided !
&6E381,%000,f$+
******************** NetGame routines ******************
They've gone, so we'd better tell them
disconnected(type)
reply
type
ngs_dead:
Bad little boy, dropped connection
2 reply=
errorbox(">Message",">Closed",%10001)
ngs_going:
Mr Flibble says 'Game Over', boys
4 reply=
errorbox(">Message",">GameOver",%10001)
ngs_failed:
Couldn't get a connection
5 reply=
errorbox(">Message",">NoConnect",%10001)
openconnect
theirhost$=""
greyouticons_cos_disconnected
We've got a connection
type = ngs_originate if we connected to them
ngs_answer if they connected to us
connected(host$,type)
theirhost$=host$
type=ngs_originate
%C us%=pblue%:them%=pgreen%:
we initiated connection, we go 1st
'D us%=pgreen%:them%=pblue%:
they initiated connection, them 1st
)+player%=pblue%:
blue always goes first
board_clear(
don't tell them
closewin(connectwin%):
Close the connect window
We should open a window or something
ungreyouticons_cos_connected
openwin(boardwin%)
Message has arrived from them - try not to create a loop
'cos that is kinda silly...
incoming(msg$)
If it's a user message we should put it in the message window
with PROCgotmessage(msg$), otherwise it's a 'go' so we need
to process it
msg$,1)="M"
gotmessage(
msg$,2))
msg$,1)="G"
G = Go - Player has placed a counter
If we get a message and it's our go then they're cheating!
player%=us%
checking%=
disconnect
theirhost$=""
If we're still checking then finish PDQ!
checking%=
check_board:
C' x%=
msg$,2,1)):y%=
msg$,3,1))
placecounter(x%,y%)
msg$,1)="C"
board_clear(
don't tell them: They already know!
********************** Other routines **********************
Attempt a connection using the 'connect' window as host
tryconnect
host$,port
P5host$=
geticontext(connectwin%,1):
Read the host
host$=""
Read the service number
S?port=
inet_getservbyname(
geticontext(connectwin%,3),"tcp")
Now do the connection
U#ok=
netgame_connect(host$,port)
We couldn't connect so tell them
X4 reply=
errorbox(">Message",">NoConnect",%10001)
closewin(connectwin%)
We've got a message from them so lets stick it on the screen
gotmessage(msg$)
seticontext(msgwin%,0,
msg$,39)):
Fit it to the icon
openwin(msgwin%):
Open the window
Send the message in the 'send' window
sendmessage
a$:a$=
geticontext(sendwin%,0)
Send the message
You need to put some code here :
like PROCnetgame_send(a$)
Clear the text and close the window
netgame_send("M"+a$)
seticontext(sendwin%,0,"")
closewin(sendwin%)
Open the 'connect' window
openconnect
openwincentre(connectwin%)
setcaretend(connectwin%,1)
Open the 'reply' window
openreply
closewin(msgwin%)
openwin(sendwin%)
setcaretend(sendwin%,0)
screentowin(window%,
!b%=window%:
&400CB,,b%
&x%=x%+b%!20-b%!4:y%=y%+b%!24-b%!16
---- BLIbII ----
coord_rec_overlap(x%,y%,X%,Y%,a%,b%,A%,B%)
x%<a%
X%<a%
x%>A%
X%>A%
y%<b%
Y%<b%
y%>B%
Y%>B%
coord_realtowin(W%,
B%:B%=b%
!B%=W%:
&400CB,,B%
&X%=X%+B%!20-B%!4:Y%=Y%+B%!24-B%!16
coord_wintoreal(W%,
B%:B%=b%
!B%=W%:
&400CB,,B%
&X%=X%-B%!20+B%!4:Y%=B%!16-B%!24+Y%