Controls:
- Mouse click on tile to rotate tile
- Mouse click on arrow to rotate a row / column
- Escape key to quit
Code: Select all
const SCREEN_W = 640, SCREEN_H = 480
const IMG_SIZE = 400
const IMG_XO = (SCREEN_W - IMG_SIZE) \ 2 '120
const IMG_YO = (SCREEN_H - IMG_SIZE) \ 2 '40
const as ulong WHITE = rgb(255, 255, 255)
const as ulong GREEN = rgb(0, 200, 0)
const as ulong RED = rgb(255, 0, 0)
const as ulong YELLOW = rgb(255, 255, 0)
const as ulong BLUE = rgb(0, 0, 255)
const as ulong BROWN = rgb(150, 75, 0)
const as ulong LGREY = rgb(191, 191, 191)
const as ulong GREY = rgb(127, 127, 127)
const as ulong DGREY = rgb(63, 63, 63)
const as ulong BLACK = rgb(0, 0, 0)
const as ulong MAGENTA = rgb(255, 0, 255)
const as single PI = atn(1) * 4
const DIR_RI = 0, DIR_DN = 1, DIR_LE = 2, DIR_UP = 3
const NUM_DIR = 4
const NUM_TILES_XY = 5
const NUM_TILES = NUM_TILES_XY * NUM_TILES_XY
const TILE_SIZE = IMG_SIZE \ NUM_TILES_XY
'--------------------------- TYPES & ROUTINES ----------------------------------
type grid_type
dim as integer tileID, tileDir
end type
type int2d
dim as integer x, y
end type
'vector add
operator + (a as int2d, b as int2d) as int2d
return type(a.x + b.x, a.y + b.y)
end operator
type mouse_type
dim as integer res
dim as int2d p 'position
dim as integer wheel, clip
union
dim as integer buttons
type
lb : 1 as integer
rb : 1 as integer
mb : 1 as integer
end type
end union
end type
union rgba_union
dim as ulong value
type
dim as ubyte b, g, r, a
end type
end union
sub clearScreen(c as ulong)
line(0, 0)-(SCREEN_W - 1, SCREEN_H - 1), c, bf
end sub
sub thickline(pTarget as any ptr, p1 as int2d, p2 as int2d, c as ulong)
for x as integer = -1 to +1
for y as integer = -1 to +1
line pTarget, (p1.x + x, p1.y + y)-step(p2.x, p2.y), c
next
next
end sub
sub pointyline(pTarget as any ptr, p1 as int2d, p2 as int2d, c as ulong)
for x as integer = -1 to +1
for y as integer = -1 to +1
line pTarget, (p1.x + x, p1.y + y)-(p1.x + p2.x, p1.y + p2.y), c
next
next
end sub
sub drawLeaf(pTarget as any ptr, p0 as int2d, dp1 as int2d, dp2 as int2d, c as ulong)
thickline(pTarget, p0, dp1, c)
pointyline(pTarget, p0 + dp1, dp2, c)
end sub
sub createScene(pImg as any ptr)
const NUM_LEAVES = 6, NUM_STEMS = 5
dim as integer i, x, y, r
dim as ulong c
dim as int2d root = type(IMG_SIZE \ 2, IMG_SIZE - 20)
dim as int2d dp1, dp2, flower
dim as int2d leafNodes(NUM_LEAVES - 1, 0 to 1) = { _
{ type(80, -30), type(70, +20) }, _
{ type(60, -40), type(60, +40) }, _
{ type(20, -30), type(20, -10) }, _
{ type(-70, -40), type(-90, +30) }, _
{ type(-40, -30), type(-100, +30) }, _
{ type(-30, -10), type(-20, +10) }}
dim as int2d stemNodes(NUM_STEMS - 1, 0 to 1) = { _
{ type(-20, -70), type(-50, -140) }, _
{ type(-40, -80), type(-50, -70) }, _
{ type(-10, -150), type(-20, -120) }, _
{ type(+20, -140), type(+20, -90) }, _
{ type(+30, -80), type(+40, -50) } }
'blue sky
line pImg, (0, 0)-step(IMG_SIZE - 1, IMG_SIZE - 1), rgb(70, 70, 255), bf
line pImg, (0, 85)-step(IMG_SIZE - 1, IMG_SIZE - 1), rgb(50, 50, 255), bf
line pImg, (0, 110)-step(IMG_SIZE - 1, IMG_SIZE - 1), rgb(0, 0, 255), bf
line pImg, (0, 200)-step(IMG_SIZE - 1, IMG_SIZE - 1), rgb(40, 40, 255), bf
'mountains
for i = 0 to 2
circle pImg, (IMG_SIZE \ 2 - 300 - i * 10, IMG_SIZE + 70 + i * 10), 500, rgb(180 - i * 10, 170 - i * 10, 180 - i * 20),,, 0.6 , f
next
for i = 0 to 2
circle pImg, (IMG_SIZE \ 2 + 350 + i * 30, IMG_SIZE + 80 + i * 20), 500, rgb(127 - i * 10, 127 - i * 20, 127 - i * 20),,, 0.7, f
next
for i = 0 to 2
circle pImg, (IMG_SIZE \ 2 - 350 - i * 30, IMG_SIZE + 100 + i * 20), 500, rgb(127 - i * 10, 127 - i * 10, 80 - i * 20),,, 0.6 , f
next
'brown ground
for i = 0 to 2
circle pImg, (root.x, root.y + i * 10), 400 - i * 40, rgb(150 - i * 20, 75 - i * 10, 0),,, 0.2 + i / 40, f
next
'ground leaves
for i = 0 to NUM_LEAVES - 1
drawLeaf(pImg, root, leafNodes(i, 0), leafNodes(i, 1), GREEN)
next
'flower stems
for i = 0 to NUM_STEMS - 1
drawLeaf(pImg, root, stemNodes(i, 0), stemNodes(i, 1), GREEN)
flower = root + stemNodes(i, 0) + stemNodes(i, 1)
for j as integer = 0 to 6
x = cos((j / 7) * PI * 2) * 25
y = sin((j / 7) * PI * 2) * 25
pointyline(pImg, flower, type(x, y), rgb(255, 200, 0))
circle pImg, (flower.x + x, flower.y + y), 10, RED,,,,f
next
circle pImg, (flower.x, flower.y), 10, YELLOW,,,,f
next
'clouds
randomize 123
for i = 0 to 19
x = rnd * IMG_SIZE
y = rnd * 20
r = rnd * (40 - i) + 40
dim as ubyte comp = rnd * 50 + 200
c = rgb(comp, comp, comp)
circle pImg, (x, y), r, c, ,, rnd / 2 + 0.3, f
next
end sub
function toChar(value as single) as ubyte
if value > 255 then return 255
if value < 0 then return 0
return cint(value)
end function
function colorMix(c1 as ulong, c2 as ulong, factor as single) as ulong
dim as rgba_union cu1, cu2, ret
dim as single r, g, b
cu1.value = c1
cu2.value = c2
ret.r = toChar(csng(cu1.r) * (1 - factor) + csng(cu2.r) * factor)
ret.g = toChar(csng(cu1.g) * (1 - factor) + csng(cu2.g) * factor)
ret.b = toChar(csng(cu1.b) * (1 - factor) + csng(cu2.b) * factor)
return ret.value
end function
sub rotateImage(pImgSrc as any ptr, pImgDst as any ptr)
dim as integer wSrc, hSrc, wDst, hDst
imageinfo(pImgSrc, wSrc, hSrc)
imageinfo(pImgDst, wDst, hDst)
if pImgSrc = pImgDst then exit sub
if wSrc <> hDst then exit sub
if hSrc <> wDst then exit sub
for x as integer = 0 to wDst - 1
for y as integer = 0 to hDst - 1
pset pImgDst, (x, y), point(y, (hSrc - 1) - x, pImgSrc)
next
next
end sub
sub dimEdges(pImg as any ptr, dimColor as ulong, dimFactor as single)
dim as integer w, h
imageinfo(pImg, w, h)
dim as ulong c
for x as integer = 0 to w - 1
c = point (x, 0, pImg)
pset pImg, (x, 0), colorMix(c, dimColor, dimFactor)
c = point (x, h - 1, pImg)
pset pImg, (x, h - 1), colorMix(c, dimColor, dimFactor)
next
for y as integer = 0 to h - 1
c = point (0, y, pImg)
pset pImg, (0, y), colorMix(c, dimColor, dimFactor)
c = point (w - 1, y, pImg)
pset pImg, (w - 1, y), colorMix(c, dimColor, dimFactor)
next
end sub
sub createTiles(pImg as any ptr, pTile() as any ptr)
dim as integer iTile = 0
for y as integer = 0 to NUM_TILES_XY - 1
for x as integer = 0 to NUM_TILES_XY - 1
for iDir as integer = 0 to NUM_DIR - 1
pTile(iTile, iDir) = imagecreate(TILE_SIZE, TILE_SIZE)
if iDir = 0 then
get pImg, (x * TILE_SIZE, y * TILE_SIZE)-step(TILE_SIZE - 1,TILE_SIZE - 1), pTile(iTile, iDir)
dimEdges(pTile(iTile, iDir), BLACK, 0.25)
else
rotateImage(pTile(iTile, iDir - 1), pTile(iTile, iDir))
end if
next
iTile += 1
next
next
end sub
sub showTiles(grid() as grid_type, pTile() as any ptr)
for y as integer = 0 to NUM_TILES_XY - 1
for x as integer = 0 to NUM_TILES_XY - 1
dim as integer iTile = grid(x, y).tileId
dim as integer iDir = grid(x, y).tileDir
put (IMG_XO + x * TILE_SIZE, IMG_YO + y * TILE_SIZE), pTile(iTile, iDir), pset
next
next
end sub
sub createButton(pImg as any ptr, cFg as ulong, cBg as ulong)
dim as integer w, h
imageinfo(pImg, w, h)
dim as int2d p1, p2, p3, p4
p1 = type(5, 11) 'left top
p2 = type(w - 6, h \ 2) 'arrow point
p3 = type(5, h - 11) 'left bottom
p4 = type(w \ 2, h \ 2) 'center
line pImg, (0, 0)-step(w - 1, h - 1), cBg, bf
line pImg, (p1.x, p1.y)-(p2.x, p2.y), cFg
line pImg, (p2.x, p2.y)-(p3.x, p3.y), cFg
line pImg, (p3.x, p3.y)-(p1.x, p1.y), cFg
paint pImg, (p4.x, p4.y), cFg
dimEdges(pImg, BLACK, 0.25)
end sub
sub createButtons(pButImg() as any ptr)
pButImg(DIR_RI) = imagecreate(TILE_SIZE \ 2, TILE_SIZE)
pButImg(DIR_LE) = imagecreate(TILE_SIZE \ 2, TILE_SIZE)
pButImg(DIR_DN) = imagecreate(TILE_SIZE, TILE_SIZE \ 2)
pButImg(DIR_UP) = imagecreate(TILE_SIZE, TILE_SIZE \ 2)
createButton(pButImg(DIR_RI), DGREY, GREY)
rotateImage(pButImg(DIR_RI), pButImg(DIR_DN))
rotateImage(pButImg(DIR_DN), pButImg(DIR_LE))
rotateImage(pButImg(DIR_LE), pButImg(DIR_UP))
end sub
sub showButtons(pButImg() as any ptr)
for i as integer = 0 to NUM_TILES_XY - 1
put (IMG_XO + IMG_SIZE, IMG_YO + i * TILE_SIZE), pButImg(DIR_RI), pset
put (IMG_XO - TILE_SIZE \ 2, IMG_YO + i * TILE_SIZE), pButImg(DIR_LE), pset
put (IMG_XO + i * TILE_SIZE, IMG_YO + IMG_SIZE), pButImg(DIR_DN), pset
put (IMG_XO + i * TILE_SIZE, IMG_YO - TILE_SIZE \ 2), pButImg(DIR_UP), pset
next
end sub
'rci = row or column index depending on direction
sub rotateGrid(grid() as grid_type, rci as integer, direction as integer)
dim as integer ubx = ubound(grid, 1)
dim as integer uby = ubound(grid, 2)
dim as grid_type tempTile
select case direction
case DIR_RI
tempTile = grid(ubx, rci)
for x as integer = ubx to 1 step -1
grid(x, rci) = grid(x - 1, rci)
next
grid(0, rci) = tempTile
case DIR_DN
tempTile = grid(rci, uby)
for y as integer = uby to 1 step -1
grid(rci, y) = grid(rci, y - 1)
next
grid(rci, 0) = tempTile
case DIR_LE
tempTile = grid(0, rci)
for x as integer = 1 to ubx
grid(x - 1, rci) = grid(x, rci)
next
grid(ubx, rci) = tempTile
case DIR_UP
tempTile = grid(rci, 0)
for y as integer = 1 to uby
grid(rci, y - 1) = grid(rci, y)
next
grid(rci, uby) = tempTile
end select
end sub
sub initGrid(grid() as grid_type)
for y as integer = 0 to NUM_TILES_XY - 1
for x as integer = 0 to NUM_TILES_XY - 1
grid(x, y).tileId = y * NUM_TILES_XY + x
grid(x, y).tileDir = 0
next
next
end sub
function checkGrid(grid() as grid_type) as integer
dim as integer countOk = 0
for y as integer = 0 to NUM_TILES_XY - 1
for x as integer = 0 to NUM_TILES_XY - 1
if grid(x, y).tileId = y * NUM_TILES_XY + x then
if grid(x, y).tileDir = 0 then countOk += 1
end if
next
next
return countOk
end function
sub rotateTile(x as integer, y as integer, grid() as grid_type, clockDir as integer)
if clockDir = 1 then
grid(x, y).tileDir += 1
if grid(x, y).tileDir >= NUM_DIR then grid(x, y).tileDir = 0
else
grid(x, y).tileDir -= 1
if grid(x, y).tileDir < 0 then grid(x, y).tileDir = NUM_DIR - 1
end if
end sub
sub mutateGrid(grid() as grid_type)
if rnd > 0.5 then
rotateGrid(grid(), int(rnd * NUM_TILES_XY), int(rnd * NUM_DIR))
else
dim as integer x = int(rnd * NUM_TILES_XY)
dim as integer y = int(rnd * NUM_TILES_XY)
rotateTile(x, y, grid(), 1) 'clockwise only
end if
end sub
function getGridIndex(mPos as int2d) as int2d
dim as int2d tilePos
dim as integer dx = mPos.x - IMG_XO
tilePos.x = iif(dx > 0, dx \ TILE_SIZE, (dx \ TILE_SIZE) - 1)
dim as integer dy = mPos.y - IMG_YO
tilePos.y = iif(dy > 0, dy \ TILE_SIZE, (dy \ TILE_SIZE) - 1)
return tilePos
end function
function validTilePos(gridPos as int2d) as integer
if gridPos.x >=0 and gridPos.x <= NUM_TILES_XY - 1 then
if gridPos.y >=0 and gridPos.y <= NUM_TILES_XY - 1 then
return 1
end if
end if
return 0
end function
sub printText(byval x as integer, byval y as integer, text as string, cFg as ulong, cBg as ulong, center as integer)
if center = 1 then
x -= len(text) * 4
y -= 8
end if
draw string (x - 1, y), text, cBg
draw string (x + 1, y), text, cBg
draw string (x, y - 1), text, cBg
draw string (x, y + 1), text, cBg
draw string (x, y), text, cFg
end sub
'------------------------------ MAIN -------------------------------------------
screenres SCREEN_W, SCREEN_H, 32
width SCREEN_W \ 8, SCREEN_H \ 16
dim as any ptr pImg = imagecreate(IMG_SIZE, IMG_SIZE)
dim as any ptr pTile(NUM_TILES - 1, NUM_DIR - 1)
dim as any ptr pButImg(0 to 3)
dim as grid_type grid(NUM_TILES_XY - 1, NUM_TILES_XY - 1)
clearScreen(LGREY)
createScene(pImg)
createTiles(pImg, pTile())
createButtons(pButImg())
initGrid(grid())
showTiles(grid(), pTile())
for i as integer = -1 to +1
printText(SCREEN_W \ 2, SCREEN_H \ 2 + i * 16, str(2 - i), YELLOW, BLACK, 1)
sleep 1000, 1
next
'Random shuffle & tile rotation
for i as integer = 0 to 99
mutateGrid(grid())
showTiles(grid(), pTile())
sleep 15
next
showButtons(pButImg())
printText(SCREEN_W \ 2, SCREEN_H \ 2, "GOOD LUCK", YELLOW, BLACK, 1)
sleep 1000, 1
showTiles(grid(), pTile())
dim as string key
dim as mouse_type m, mPrev
dim as int2d gridPos
dim as integer quit = 0
while quit = 0
mPrev = m
m.res = getmouse (m.p.x, m.p.y , m.wheel, m.buttons, m.clip)
if m.res <> 0 then
m = mPrev
else
gridPos = getGridIndex(m.p)
if (mPrev.lb = 1 and m.lb = 0) then 'MOUSE_LB_RELEASED
'rotate tile clockwise
if validTilePos(gridPos) then
rotateTile(gridPos.x, gridPos.y, grid(), +1)
end if
'check buttons left / right
if gridPos.y >= 0 and gridPos.y <= NUM_TILES_XY - 1 then
if gridPos.x = -1 then
rotateGrid(grid(), gridPos.y, DIR_LE)
end if
if gridPos.x = NUM_TILES_XY then
rotateGrid(grid(), gridPos.y, DIR_RI)
end if
end if
'check buttons up / down
if gridPos.x >= 0 and gridPos.x <= NUM_TILES_XY - 1 then
if gridPos.y = -1 then
rotateGrid(grid(), gridPos.x, DIR_UP)
end if
if gridPos.y = NUM_TILES_XY then
rotateGrid(grid(), gridPos.x, DIR_DN)
end if
end if
end if
if (mPrev.rb = 1 and m.rb = 0) then 'MOUSE_RB_RELEASED
'rotate tile counter-clock
if validTilePos(gridPos) then
rotateTile(gridPos.x, gridPos.y, grid(), -1)
end if
end if
end if
showTiles(grid(), pTile())
if checkGrid(grid()) = NUM_TILES then quit = 2
key = inkey
if key = chr(27) then quit = 1
sleep 1
wend
select case quit
case 1
printText(SCREEN_W \ 2, SCREEN_H \ 2, "QUIT BY USER", YELLOW, BLACK, 1)
case 2
put (IMG_XO, IMG_YO), pImg, pset
printText(SCREEN_W \ 2, SCREEN_H \ 2, "WELL DONE", YELLOW, BLACK, 1)
end select
sleep
'todo: image cleanup
Edit: Full image displayed on completion.