|
|
Post by Rod on Apr 6, 2022 6:19:50 GMT -5
On top of the corrupted screen display I find that drawing is not showing. I know from drawx.bas that the mouse actions are working but here the screen is not being updated. The code has been altered to bypass sort and playwave and drawimage instead of drawbmp. It tracks the code to the very first call to message where the message "Start Play" and the initial zero scores are supposed to display. Though it might be tracking the mouse events the tiles don't move.
Unfortunately you will need the previous .zip for all the resources involved.
'This is version 12 dated 9th Jan 2022
'this is version 13 dated 10th Jna 2022 multiplier can double or treble up
'nomainwin
'Anatoly's trick to find how much whitespace the windows scheme is taking
'knowing the centre we can work out the visible width then expand the
'window size to give us an exact visible screen area
'open a window of the same type you will use in the main program
WindowWidth = 200
WindowHeight = 200
open "Ajusting..." for graphics_nf_nsb as #1
#1 "home ; down ; posxy w h"
w=200-2*w : h = 200-2*h
close #1
'now expand the window so that we will see all of the 1175x736 pixels
WindowWidth = 1175+w
WindowHeight = 736+h
UpperLeftX = (DisplayWidth-WindowWidth)/2
UpperLeftY = (DisplayHeight-WindowHeight)/2
graphicbox #b.gb,770,242,371,440
loadbmp "board","board.bmp"
loadbmp "score","score.bmp"
loadbmp "hi","highlight.bmp"
loadbmp "p1","play1.bmp"
loadbmp "p2","play2.bmp"
loadbmp "p3","play3.bmp"
loadbmp "p4","play4.bmp"
loadbmp "np1","noplay1.bmp"
loadbmp "np2","noplay2.bmp"
loadbmp "np3","noplay3.bmp"
loadbmp "np4","noplay4.bmp"
open "Scrabble" for graphics_nf_nsb as #b
#b "down ; fill black"
#b "trapclose quit"
#b.gb "down ; drawbmp score 0 0 ; flush scr"
#b.gb "backcolor darkgreen ; color yellow ; font courier_new 24 bold"
global players,player,bag,tile,oldx,oldy,centre,score
players=2 '1-4
player=1 'who is playing
bag=1 'pointer for tile set
tile=0 'tile id of interest
oldx=0 'its original position
oldy=0 'its original position
centre=0 'the first play must cover the central tile
score=0 'score for the word just played
'set out the Word and Letter multipliers on the board
'after the word is played and assessed the multipliers are set back to 1
'tile,letter multiplier,word multiplier, status
dim b$(360,4)
for y = 0 to 14
for x = 0 to 14
read m
b=x+24*y
if m=1 then b$(b,2)="1" : b$(b,3)="1"
if m=2 then b$(b,2)="2" : b$(b,3)="1"
if m=3 then b$(b,2)="3" : b$(b,3)="1"
if m=4 then b$(b,2)="1" : b$(b,3)="2"
if m=5 then b$(b,2)="1" : b$(b,3)="3"
next
next
'create the tile array, sprite image and then shuffle the tiles
'id, sprite, asc, x, y, worth, rnd
dim t(100,7)
ti=1
while ti <101
read g$,n,w 'glyph,number,worth
loadbmp g$,g$+".bmp"
#b drawimage(g$,0,50)
#b "getbmp ";g$;" 0 0 50 100"
for i=1 to n
#b "addsprite t";ti;" ";g$
#b "spritexy t";ti;" -100 -100"
t(ti,1)=ti 'tile id
t(ti,2)=ti 'sprite id
t(ti,3)=asc(g$) 'glyph
t(ti,4)=0-100 'x
t(ti,5)=0-100 'y
t(ti,6)=w 'worth
t(ti,7)=rnd(0) 'random order
ti=ti+1
next
wend
'shuffle by sorting on rnd(0) column
'sort t(,1,100,7
'now re-number the tile ids
for i=1 to 100
t(i,1)=i
next
'we now have 100 tiles numbered 1 to 100 in random order
print "got to 1"
'deal first hand out the bag, bag is a pointer to our
'position in the bag of 100 tiles
'a player has 7 tiles until bag runs dry
'first player to use all his tiles ends game
'player number , tile in hand
dim hand(players,7)
for p=1 to players
call topuphand p
next
call showhand 1
print "got to 2"
call message "Start Play"
#b "when leftButtonDown gettile"
#b "background board"
#b "drawsprites"
wait
sub moveon
'score and move on or skip turn
'or simply cycle round same player if play was illegal and scored 0
if score >0 then
'legal scoring play
score(player)=score(player)+score
call topuphand player
'check for end of game
game=1
for i=1 to 7
if hand(player,i)>0 then game=0
next
if game then call gameover
'move on to next player
p=player+1
if p>players then p=1
call showhand p 'showhand changes player global to p
call message ""
score=0
end if
if score=-1 then
'skip turn
call topuphand player
p=player+1
if p>players then p=1
call showhand p 'showhand changes player global to p
call message ""
score=0
end if
#b "drawsprites"
#b "when leftButtonDown gettile"
end sub
sub topuphand p
'keep players hand at 7 tiles until tiles run out
for i=1 to 7
if hand(p,i)=0 and bag <=100 then
hand(p,i)=t(bag,1)
bag=bag+1
end if
next
end sub
sub showhand p
for i=1 to 7 'move old player's hand off board
if hand(player,i)<>0 then
x=int(t(hand(player,i),4)/49)
y=int(t(hand(player,i),5)/49)
'remove highlight sprite if it is currently on the board
if x>=0 and x<=14 and y>=0 and y<=14 then
#b "removesprite hi";hand(player,i)
end if
'remove tile id from board
if x>=0 and y>=0 then
b$(x+24*y,1)=""
end if
'move sprite off board
t(hand(player,i),4)=0-100
t(hand(player,i),5)=0-100
#b "spritexy t";t(hand(player,i),2);" -100 -100"
end if
next
'set new player's hand on the board, always in the tile rack
for i=1 to 7
if hand(p,i)<>0 then
t(hand(p,i),4)=736+i*49
t(hand(p,i),5)=49
b$(39+i,1)=right$("000"+str$(hand(p,i)),3)
#b "spritexy t";t(hand(p,i),2);" ";t(hand(p,i),4);" ";t(hand(p,i),5)
end if
next
'now we have moved old player off the board
'and placed new player on the board we can set global player to the new player number
player=p
end sub
sub gettile h$,x,y
'stop event tracking
#b "when leftButtonDown"
'see what hand the player has because thats the only tiles he can move
hand$=""
for i = 1 to 7
hand$=hand$+right$("000"+str$(hand(player,i)),3)+" "
next
'did we click a valid tile
x=int(x/49)
y=int(y/49)
if b$(x+24*y,1)<>"" and instr(hand$,b$(x+24*y,1),1)>0 then
tile=val(b$(x+24*y,1))
if x<=14 then #b "removesprite hi";tile
print "found tile ",tile
b$(x+24*y,1)=""
oldx=t(tile,4)
oldy=t(tile,5)
#b "when leftButtonMove trackit"
#b "when leftButtonUp dropit"
else
'did the player click the play button area
if x>=16 and x<=22 then
select case y
case 3
call play
case 4
score=-1
call moveon
case else
print "No tile"
tile=0
#b "when leftButtonDown gettile"
end select
else
print "No tile"
#b "when leftButtonDown gettile"
end if
end if
end sub
sub trackit h$,x,y
t(tile,4)=x-25
t(tile,5)=y-25
#b "spritexy t";t(tile,2);" ";t(tile,4);" ";t(tile,5)
#b "drawsprites"
end sub
sub dropit h$,x,y
#b "when leftButtonMove"
#b "when leftButtonUp"
x=int(x/49)
y=int(y/49)
'did we drop on a playing space?
if (x>=0 and x<=14 and y>=0 and y<=14) or (x>=16 and x<=22 and y>=1 and y<=2) then
select case b$(x+24*y,1)
case str$(tile) 'dropping back where we started
t(tile,4)=oldx
t(tile,5)=oldy
b$(x+24*y,1)=right$("000"+str$(tile),3)
case "" 'free square
t(tile,4)=x*49
t(tile,5)=y*49
b$(x+24*y,1)=right$("000"+str$(tile),3)
'if it is a space tile get letter via notice statement
if t(tile,3)=asc("b") then
prompt "Select letter for blank tile";l$
t(tile,3)=asc(upper$(l$))
print "Space tile named ";upper$(l$)
end if
case else
print "Illegal drop on existing tile"
'playwave "silence.wav",sync
'playwave "bump.wav"
t(tile,4)=oldx
t(tile,5)=oldy
x=int(oldx/49)
y=int(oldy/49)
b$(x+24*y,1)=right$("000"+str$(tile),3)
end select
else
print "Illegal drop not on board"
'playwave "silence.wav",sync
'playwave "bump.wav"
t(tile,4)=oldx
t(tile,5)=oldy
x=int(oldx/49)
y=int(oldy/49)
b$(x+24*y,1)=right$("000"+str$(tile),3)
end if
if x<=14 then
#b "addsprite hi";t(tile,1);" hi"
#b "spritexy hi";t(tile,1);" ";t(tile,4);" ";t(tile,5)
end if
#b "spritexy t";t(tile,2);" ";t(tile,4);" ";t(tile,5)
#b "drawsprites"
#b "when leftButtonDown gettile"
end sub
sub play
score=0
'see what hand the player has
print "checking hand"
hand$=""
for i = 1 to 7
hand$=hand$+right$("000"+str$(hand(player,i)),3)+" "
next
'check all squares to be sure a tile at least has been played
'record the x and y of the last found and number found
print "checking at least one tile played and centre played"
for y = 0 to 14
for x = 0 to 14
if instr(hand$,b$(x+24*y,1),1)>0 then
dx=x
dy=y
found=found+1
if x=7 and y=7 and centre=0 then centre=1
end if
next
next
if found=0 or centre=0 then goto [illegal]
if found=1 then
'if we only placed one tile check that it attaches to another tile and set dop
print "checking single play attaches to a tile"
x1=dx-1
x2=dx+1
y1=dy-1
y2=dy+1
select case
case x1>=0 and x1<=14 and b$(x1+24*dy,1)<>""
dop=1
deltax=0-1 'horz
deltay=0
case x2>=0 and x2<=14 and b$(x2+24*dy,1)<>""
dop=1
deltax=0-1 'horz
deltay=0
case y1>=0 and y1<=14 and b$(dx+24*y1,1)<>""
dop=0
deltax=0
deltay=0-1 'vert
case y2>=0 and y2<=14 and b$(dx+24*y2,1)<>""
dop=0
deltax=0
deltay=0-1 'vert
case else
goto [illegal]
end select
print "found tile played at ";dx,dy
'find the start of the word
x=dx
y=dy
do
x=x+deltax
y=y+deltay
if x<0 then exit do
if y<0 then exit do
loop while b$(x+24*y,1)<>""
x=x-deltax
y=y-deltay
print "found start of word at ";x,y
else
'if we played more than one tile check all x's or all y's are identical and set dop
print "checking multiple tiles are aligned"
horz=1
vert=1
for y = 0 to 14
for x = 0 to 14
if instr(hand$,b$(x+24*y,1),1)>0 and dx<>x then vert=0
if instr(hand$,b$(x+24*y,1),1)>0 and dy<>y then horz=0
next
next
if horz+vert=0 then goto [illegal]
if horz=1 then dop=1
if vert=1 then dop=0
'now find the top left tile on the board
f=0
for y = 0 to 14
for x = 0 to 14
if instr(hand$,b$(x+24*y,1),1)>0 then f=1 : exit for
next
if f then exit for
next
x1=x
y1=y
print "found tile played at ";x1,y1
'initially we will move backwards through the word to find the actual start
'as the player may have used tiles already on the board
if dop=1 then deltax=0-1 : deltay=0 else deltax=0 : deltay=0-1
'find the start of the word
x=x1
y=y1
do
x=x+deltax
y=y+deltay
if x<0 then exit do
if y<0 then exit do
loop while b$(x+24*y,1)<>""
x=x-deltax
y=y-deltay
print "found start of word at ";x,y
end if
'now run through main word calculating score and capture the word
'we will move forwards through the word so we change the delta
deltax=deltax*-1
deltay=deltay*-1
score=0 'main word cumulative score
cscore=0 'cross over word score
ccscore=0 'cross over word cumulative score
multi=1 'multiplier level *1=none *2,*3
w$=""
f=0
while b$(x+24*y,1)<>""
b=x+24*y
t=val(b$(b,1))'tile id
l=val(b$(b,2))'letter multiplier
if val(b$(b,3)) > 1 then multi = multi * val(b$(b,3))'word multiplier
if instr(hand$,b$(b,1),1)>0 then f=f+1 'to check we have used all letters played in this word
score=score+t(t,6)*l
w$=w$+chr$(t(t,3))
'now if the letter has been played by the player check the cross word it makes if any
if instr(hand$,b$(b,1),1)>0 then
'print "checking cross over word at ";x,y
if dop=1 then
'print "checking vert" 'vert crossover
'find start of word upwards
cy=y
do
cy=cy-1
if cy<0 then exit do
loop while b$(x+24*cy,1)<>""
cy=cy+1
'print "found start of vert cross word at ";x,cy
'loop and build word downwards adding score
cw$=""
cscore=0
cl=1
cmulti=1
while b$(x+24*cy,1)<>""
cb=x+24*cy
ct=val(b$(cb,1))'tile id
cl=val(b$(cb,2))'letter multiplier
if val(b$(cb,3)) > 1 then cmulti = cmulti * val(b$(b,3))'word multiplier
cscore=cscore+t(ct,6)*cl
cw$=cw$+chr$(t(ct,3))
cy=cy+1
if cy>14 then exit while
wend
'if only 1 in length no word 0 cscore
'if more than 1 in length check word is valid
if len(cw$)>1 then
if check(cw$)>0 then
ccscore=ccscore+cscore*cmulti
print "found cross over word ";cw$;" ";cscore
else
cscore=0
ccscore=0
goto [illegal]
end if
else
cscore=0
end if
else
'print "checking horz" 'horz crossover
'find start of word leftwards
cx=x
do
cx=cx-1
if cx<0 then exit do
loop while b$(cx+24*y,1)<>""
cx=cx+1
'print "found start of horz cross word at ";cx,y
'loop and build word rightwards adding score
cw$=""
cscore=0
cl=1
cmulti=1
while b$(cx+24*y,1)<>""
cb=cx+24*y
ct=val(b$(cb,1))'tile id
cl=val(b$(cb,2))'letter multiplier
if val(b$(cb,3)) > 1 then cmulti = cmulti * val(b$(b,3))'word multiplier
cscore=cscore+t(ct,6)*cl
cw$=cw$+chr$(t(ct,3))
cx=cx+1
if cx>14 then exit while
wend
'if only 1 in length no word
'if more than 1 in length check word is valid
if len(cw$)>1 then
if check(cw$)>0 then
ccscore=ccscore+cscore*cmulti
print "found cross over word ";cw$;" ";cscore
else
cscore=0
ccscore=0
goto [illegal]
end if
else
cscore=0
end if
end if
end if
'end checking cross word
x=x+deltax
y=y+deltay
if x<0 or x>14 or y<0 or y>14 then exit while
wend
print "checking all tiles played are in the word"
if found<>f then goto [illegal] 'letters must create a complete word
if found=7 then score=score+50 'played all letters
print "checking dict for ";w$
if check(w$)=0 then
goto [illegal]
else
print "main word score is ";score * multi
score = score * multi + ccscore
print "total word score is ";score
'as it is all legal we need to remove the tiles from the players hand
'remove the highlight and reset any multiplier used
for y=0 to 14
for x=0 to 14
b=x+24*y
if instr(hand$,b$(b,1),1)>0 then
t=val(b$(b,1))
#b "removesprite hi";t
b$(b,2)="1"
b$(b,3)="1"
for i=1 to 7
if hand(player,i)=t then hand(player,i)=0
next
end if
next
next
end if
goto [done]
[illegal]
score=0
call message "Illegal play."
print "Illegal play."
print "Playing player ";player
[done]
call moveon
end sub
sub gameover
notice "Game over"
'player has played all tiles available game stops
'player gets worth of tiles in others hands
'others get worth of tiles still held deducted
for pl= 1 to players
for h= 1 to 7
score(player)=score(player)+t(hand(pl,h),6)
score(pl)=score(pl)-t(hand(pl,h),6)
next
next
call message "Final Score"
wait
end sub
sub message m$
print "got to 3"
print m$
#b.gb "discard ; redraw scr"
if player=1 then #b.gb drawimage("p1",15,221) else #b.gb drawimage("np1",15,221)
if player=2 then #b.gb drawimage("p2",15,270) else #b.gb drawimage("np2",15,270)
if player=3 then #b.gb drawimage("p3",15,319) else #b.gb drawimage("np3",15,319)
if player=4 then #b.gb drawimage("p4",15,368) else #b.gb drawimage("np4",15,368)
#b.gb "place 100 100 ;\";m$
#b.gb "place 80 255 ;\";score(1)
#b.gb "place 80 304 ;\";score(2)
#b.gb "place 80 353 ;\";score(3)
#b.gb "place 80 402 ;\";score(4)
end sub
function check(w$)
open "dict.txt" for input as #1
open "index.txt" for input as #2
i$=left$(w$,2)
line input #2,ii$
while eof(#2)=0 and left$(ii$,2)<>i$
line input #2,ii$
wend
if eof(#2)=0 then
seek #1,val(word$(ii$,2," "))
line input #1,ii$
while eof(#1)=0 and left$(word$(ii$,1,chr$(9)),2)=i$
if word$(ii$,1,chr$(9))=w$ then found=1 : exit while
line input #1,ii$
wend
if found then
print "found ";word$(ii$,1,chr$(9))
print "meaning ";word$(ii$,2,chr$(9))
check=1
else
print "Not found"
check=0
end if
else
print "Not found"
check=0
end if
close #1
close #2
end function
sub quit h$
close #b
end
end sub
data 5,1,1,2,1,1,1,5,1,1,1,2,1,1,5 '5=triple word
data 1,4,1,1,1,3,1,1,1,3,1,1,1,4,1 '4=double word
data 1,1,4,1,1,1,2,1,2,1,1,1,4,1,1 '3=triple letter
data 2,1,1,4,1,1,1,2,1,1,1,4,1,1,2 '2=double letter
data 1,1,1,1,4,1,1,1,1,1,4,1,1,1,1 '1=single letter
data 1,3,1,1,1,3,1,1,1,3,1,1,1,3,1
data 1,1,2,1,1,1,2,1,2,1,1,1,2,1,1
data 5,1,1,2,1,1,1,4,1,1,1,2,1,1,5
data 1,1,2,1,1,1,2,1,2,1,1,1,2,1,1
data 1,3,1,1,1,3,1,1,1,3,1,1,1,3,1
data 1,1,1,1,4,1,1,1,1,1,4,1,1,1,1
data 2,1,1,4,1,1,1,2,1,1,1,4,1,1,2
data 1,1,4,1,1,1,2,1,2,1,1,1,4,1,1
data 1,4,1,1,1,3,1,1,1,3,1,1,1,4,1
data 5,1,1,2,1,1,1,5,1,1,1,2,1,1,5
data "blank",2,0 'glyph,number,worth, lower case b is a blank
data "A",9,1
data "B",2,3
data "C",2,3
data "D",4,2
data "E",12,1
data "F",2,4
data "G",3,2
data "H",2,4
data "I",9,1
data "J",1,8
data "K",1,5
data "L",4,1
data "M",2,3
data "N",6,1
data "O",8,1
data "P",2,3
data "Q",1,10
data "R",6,1
data "S",4,1
data "T",6,1
data "U",4,1
data "V",2,4
data "W",2,4
data "X",1,8
data "Y",2,4
data "Z",1,10
|
|
