Here's some
code golf code I wrote in DBP (
problem).
The code finds valid placements for tiles in the board game Carcassonne.
- map.png is the current state of the board
- next.png is the next tile to be placed (if it doesn't exist, uses a random tile 1-25.png)
- The tile is placed somewhere such that: (1) it touches at least one existing tile (2) the edges of all touching tiles match visually (3) if there is a move that does not cause an area of color on the board to be "closed off", that move is preferred
- The tile can be rotated
- map.png is overwritten with the result
I didn't count the #constants because they don't affect the line count, only the character count.
Media is attached.
#constant m memblock
#constant f function
#constant k endfunction
#constant z exitfunction
#constant i image
#constant e endif
#constant o or
#constant s paste image
#constant n next
#constant r for
global t,h,j,u,v,td:set i colorkey 0,20,0:load i "map.png",1:f$="next.png":if file exist(f$)=0:f$=str$(rnd(24)+1)+".png":e:load i f$,2:make m from i 1,1:make m from i 2,2:t=i width(2):h=i width(1):j=i height(1):u=h/t:v=j/t:td=t*2:create bitmap 2,h+td+1,j+td+1:r b=1 to 4
r xx=0 to u+1:r yy=0 to v+1:x=xx*t-1:y=yy*t-1:cls 5120:s 1,t,t,1:if (a(x+1,y) o a(x,y+1) o a(x-t,y) o a(x,y-t)) and a(x,y)=0:x1=t*xx:y1=t*yy:make i from m 2,2:s 2,x1,y1,1:cl=0:r fd=0 to 1:r x2=1 to t-2:r yt=0 to 1:y2=yt*t-yt:y3=yt*t+yt-1:aa=x2:ab=x2:ba=y2:bb=y3:t2=y1:r t3=0 to 1:p=point(x1+aa,y1+ba):q=point(x1+ab,y1+bb)
if p<>q and rgbg(q)<>20 and t2+b>0:goto fa:e:if fd and p<>0xFF0000:if l(x1+aa,y1+ba,p)=0:cl=1:e:e:aa=y2:ba=x2:bb=x2:ab=y3:t2=x1:n t3:n yt:n x2:n fd:dn=1:c=xx-1:g=yy-1:make i from m 3,2:if cl=0:goto dm:e:e
fa:
n y:n x:d=t/2:r x=0 to d:r y=0 to d-1:vx=t-1-x:vy=t-1-y:t1=rd(x,y):t2=rd(vy,x):wr(vy,x,t1):t1=rd(vx,vy):wr(vx,vy,t2):t2=rd(y,vx):wr(y,vx,t1):wr(x,y,t2):n x:n y:n b
dm:
if dn=0:report error "Not placed":e:p=c<0:q=g<0:t1=h+t*(p o c>=u):t2=j+t*(q o g>=v):cls 5120:p=t*p:q=t*q:s 1,p,q,1:s 3,c*t+p,g*t+q,1:get i 1,0,0,t1,t2,1:save i "map.png",1:end
f l(x,y,w):if x<0 o y<0 o x>=h+td o y>=j+td:z 1:e:p=point(x,y):if rgbg(p)=20:z 1:e:if p<>w:z 0:e:dot x,y,0xFF0000:rt=l(x+1,y,p) o l(x-1,y,p) o l(x,y+1,p) o l(x,y-1,p)
k rt:f rd(x,y):w=m dword(2,0):b=m dword(2,12+(y*w+x)*4)
k b:f wr(x,y,d):w=m dword(2,0):write m dword 2,12+(y*w+x)*4,d
k:f a(x,y):if x<0 o y<0 o x>=h o y>=j:z 0:e
b=m byte(1,15+(y*h+x)*4)
k b
Uncompressed but no less terrible:
//Carcassonne Tile Placer
//http://codegolf.stackexchange.com/questions/41249/place-a-carcassonne-tile
//b is local big loop
//d temp
//p temp
//q temp
//w local
//reserved globals:
//c =rX
//g =rY
//h =ix
//j =iy
//u =tx
//v =ty
#constant m memblock
#constant f function
#constant k endfunction
#constant z exitfunction
#constant i image
#constant e endif
#constant t then
#constant o or
#constant s paste image
#constant n next
#constant r for
set i colorkey 0,20,0
load i "map.png",1
f$="next.png"
if file exist(f$)=0 t f$=str$(rnd(24)+1)+".png"
load i f$,2
make m from i 1,1
make m from i 2,2
global ts,ix,iy,tx,ty,td
ts=i width(2)
ix=i width(1)
iy=i height(1)
tx=ix/ts
ty=iy/ts
td=ts*2
//+1s avoid an error check later when checking border matching
create bitmap 2,ix+td+1,iy+td+1
r b=1 to 4
r xx=0 to tx+1
r yy=0 to ty+1
x=xx*ts-1
y=yy*ts-1
cls 5120
s 1,ts,ts,1
//Valid if any adjacent is full and this is empty
if (a(x+1,y) o a(x,y+1) o a(x-ts,y) o a(x,y-ts)) and a(x,y)=0
x1=ts*xx
y1=ts*yy
make i from m 2,2
s 2,x1,y1,1
//Check if this is a closing move with flood-fills along each edge
cl=0
r fd=0 to 1 //we do a second pass for floodfill, otherwise it can wipe out differences
r x2=1 to ts-2
r yt=0 to 1
//For floodfill
y2=yt*ts-yt
y3=yt*ts+yt-1
aa=x2
ab=x2
ba=y2
bb=y3
t2=y1
r t3=0 to 1
p=point(x1+aa,y1+ba)
q=point(x1+ab,y1+bb)
if p<>q and rgbg(q)<>20 and t2+b>0 t goto fa
if fd and p<>0xFF0000
//stack overflows if outside this block
if l(x1+aa,y1+ba,p)=0 t cl=1
e
aa=y2
ba=x2
bb=x2
ab=y3
t2=x1
n t3
n yt
n x2
n fd
dn=1
rX=xx-1
rY=yy-1
//save the properly rotated image
make i from m 3,2
if cl=0 t goto dm
e
fa:
n y
n x
//Try rotating it
d=ts/2
r x=0 to d
r y=0 to d-1
vx=ts-1-x
vy=ts-1-y
t1=rd(x,y)
t2=rd(vy,x)
wr(vy,x,t1)
t1=rd(vx,vy)
wr(vx,vy,t2)
t2=rd(y,vx)
wr(y,vx,t1)
wr(x,y,t2)
n x
n y
n b
dm:
if dn=0 t report error "Not placed"
//Resize mem if necessary
p=rX<0
q=rY<0
//Paste and save
t1=ix+ts*(p o rX>=tx)
t2=iy+ts*(q o rY>=ty)
//create bitmap 1,t1,t2
cls 5120
p=ts*p
q=ts*q
s 1,p,q,1
s 3,rX*ts+p,rY*ts+q,1
get i 1,0,0,t1,t2,1
save i "map.png",1
end
f l(x,y,w)
if x<0 o y<0 o x>=ix+td o y>=iy+td t z 1
p=point(x,y)
if rgbg(p)=20 t z 1
if p<>w t z 0
dot x,y,0xFF0000
rt=l(x+1,y,p) o l(x-1,y,p) o l(x,y+1,p) o l(x,y-1,p)
k rt
f rd(x,y)
w=m dword(2,0):b=m dword(2,12+(y*w+x)*4)
k b
f wr(x,y,d)
w=m dword(2,0):write m dword 2,12+(y*w+x)*4,d
k
f a(x,y)
if x<0 o y<0 o x>=ix o y>=iy t z 0
b=m byte(1,15+(y*ix+x)*4)
//if rgbg(point(x+ts,y+ts))=20 t z 0
k b
On Steam!
