rem ================================================================== rem Tilemap library. rem rem By Marcus. rem ================================================================== constant: TM_LEFT 0 TM_RIGHT 1 TM_UP 2 TM_DOWN 3 TM_IMAGE 1000 TM_X 0 TM_Y 1 TM_FLAG 2 visible: rem Map. tm_MapW tm_MapH tm_Map[][] tm_OnlyDown[] tm_Flags[][] tm_Obstacle[] tm_LoaderFlags[][] rem View. tm_ViewX tm_ViewY tm_ViewW tm_ViewH rem Image. tm_Image tm_TileW tm_TileH tm_WorldW tm_WorldH tm_CamX tm_CamY tm_LeftWall = true tm_RightWall = true tm_TopWall = true tm_BottomWall = true tm_CollisionInfo[4] hidden: rem ================================================================== rem rem ================================================================== procedure TM_InitMap(w, h) tm_MapW = w tm_MapH = h tm_Map[tm_MapW][tm_MapH] for y = 0 to tm_MapH - 1 for x = 0 to tm_MapW - 1 tm_Map[x][y] = -1 next next tm_Flags[tm_MapW][tm_MapH] if image(tm_Image) tm_WorldW = w*width(tm_Image) tm_WorldH = h*height(tm_Image) endif endproc rem ================================================================== rem rem ================================================================== procedure TM_SetImage(img) tm_Image = img tm_TileW = width(img) tm_TileH = height(img) if sizeof(tm_Map) > 0 tm_WorldW = tm_MapW*tm_TileW tm_WorldH = tm_MapH*tm_TileH endif tm_Obstacle[cels(img)] tm_OnlyDown[cels(img)] endproc procedure TM_SetObstacle(cell, value) tm_Obstacle[cell] = value endproc procedure TM_SetOnlyDown(cell, value) tm_OnlyDown[cell] = value endproc procedure TM_SetBorder(l, r, t, b) tm_LeftWall = l tm_RightWall = r tm_TopWall = t tm_BottomWall = b endproc function TM_MapWidth() return tm_MapW endfunc function TM_MapHeight() return tm_MapH endfunc rem ================================================================== rem rem ================================================================== procedure TM_SetCel(x, y, cel) if x < 0 or x >= tm_MapW then return if y < 0 or y >= tm_MapH then return tm_Map[x][y] = cel endproc rem ================================================================== rem rem ================================================================== procedure TM_SetFlag(x, y, flag) if x < 0 or x >= tm_MapW then return if y < 0 or y >= tm_MapH then return tm_Flags[x][y] = flag endproc rem ================================================================== rem rem ================================================================== function TM_GetCel(x, y) if x < 0 or x >= tm_MapW then return -1 if y < 0 or y >= tm_MapH then return -1 return tm_Map[x][y] endfunc function TM_GetCelAt(x, y) x = x/tm_TileW y = y/tm_TileH return TM_GetCel(x, y) endfunc rem ================================================================== rem rem ================================================================== function TM_GetFlag(x, y) if x < 0 or x >= tm_MapW then return 0 if y < 0 or y >= tm_MapH then return 0 return tm_Flags[x][y] endfunc function TM_GetFlagAt(x, y) x = x/tm_TileW y = y/tm_TileH return TM_GetFlag(x, y) endfunc rem ================================================================== rem rem ================================================================== procedure TM_SetView(x, y, w, h) tm_ViewX = x tm_ViewY = y tm_ViewW = w tm_ViewH = h endproc rem ================================================================== rem Set camera world position. rem ================================================================== procedure TM_SetCamera(x, y) if x < 0 x = 0 elseif x + tm_ViewW > tm_WorldW x = tm_WorldW - tm_ViewW endif if y < 0 y = 0 elseif y + tm_ViewH > tm_WorldH y = tm_WorldH - tm_ViewH endif tm_CamX = x tm_CamY = y endproc function TM_Obstacle(cel) if cel < 0 or cel >= cels(tm_Image) then return false return tm_Obstacle[cel] endfunc function TM_ToTile[](x, y) return [x/tm_TileW, y/tm_TileH] endfunc function TM_GetImage() return tm_Image endfunc rem ================================================================== rem rem ================================================================== function TM_CameraX() return tm_CamX endfunc rem ================================================================== rem rem ================================================================== function TM_CameraY() return tm_CamY endfunc rem ================================================================== rem Render. rem ================================================================== procedure TM_Render() set clip rect tm_ViewX, tm_ViewY, tm_ViewW, tm_ViewH set color 255, 255, 255 xs = tm_CamX/tm_TileW ys = tm_CamY/tm_TileH offsx = tm_CamX%tm_TileW offsy = tm_CamY%tm_TileH xe = min(xs + tm_ViewW/tm_TileW, tm_MapW - 1) ye = min(ys + tm_ViewH/tm_TileH, tm_MapH - 1) for y = ys to ye for x = xs to xe if tm_Map[x][y] >= 0 draw image tm_Image, tm_ViewX + (x - xs)*tm_TileW - offsx, tm_ViewY + (y - ys)*tm_TileH - offsy, tm_Map[x][y] endif next next set clip rect 0, 0, width(primary), height(primary) endproc rem ================================================================== rem Convert coordinates from screen to world. rem ================================================================== function TM_ToWorld[](x, y) return [x + tm_CamX - tm_ViewX, y + tm_CamY - tm_ViewY ] endfunc function TM_ToWorldF#[](x#, y#) return [x + float(tm_CamX - tm_ViewX), y + float(tm_CamY - tm_ViewY)] endfunc rem ================================================================== rem Convert x from screen to world. rem ================================================================== function TM_ToWorldX(x) return x + tm_CamX - tm_ViewX endfunc function TM_ToWorldXF#(x#) return x# + float(tm_CamX - tm_ViewX) endfunc rem ================================================================== rem Convert y from screen to world. rem ================================================================== function TM_ToWorldY(y) return y + tm_CamY - tm_ViewY endfunc function TM_ToWorldYF#(y#) return y# + float(tm_CamY - tm_ViewY) endfunc rem ================================================================== rem Convert coordinates from world to screen. rem ================================================================== function TM_ToScreen[](x, y) return [x - tm_CamX + tm_ViewX, y - tm_CamY + tm_ViewY] endfunc function TM_ToScreenF#[](x#, y#) return [x - float(tm_CamX + tm_ViewX), y - float(tm_CamY + tm_ViewY)] endfunc rem ================================================================== rem Convert x from world to screen. rem ================================================================== function TM_ToScreenX(x) return x - tm_CamX + tm_ViewX endfunc function TM_ToScreenXF#(x#) return x - float(tm_CamX + tm_ViewX) endfunc rem ================================================================== rem Convert y from world to screen. rem ================================================================== function TM_ToScreenY(y) return y - tm_CamY + tm_ViewY endfunc function TM_ToScreenYF#(y#) return y - float(tm_CamY + tm_ViewY) endfunc rem ================================================================== rem Return true if image is visible on screen. rem ================================================================== function TM_Visible(img, x, y) sx = x - tm_CamX + tm_ViewX sy = y - tm_CamY + tm_ViewY if sx > tm_ViewW then return false if sy > tm_ViewH then return false if sx + width(img) < 0 then return false if sy + height(img) < 0 then return false return true endfunc rem ================================================================== rem rem ================================================================== function TM_Move[](img, imgx, imgy, dx, dy) w = width(img) h = height(img) tm_CollisionInfo[0] = false tm_CollisionInfo[1] = false tm_CollisionInfo[2] = false tm_CollisionInfo[3] = false ys = max(min(imgy/tm_TileH, tm_MapH - 1), 0) ye = max(min((imgy + h - 1)/tm_TileH, tm_MapH - 1), 0) dstx = imgx + dx if dx < 0 if imgx + dx < 0 if tm_LeftWall dstx = 0 tm_CollisionInfo[TM_LEFT] = true else tm_CollisionInfo[TM_LEFT] = false endif else tilex = max((imgx/tm_TileW) - 1, 0) colx = tilex*tm_TileW + tm_TileW if colx >= imgx + dx for tiley = ys to ye t = tm_Map[tilex][tiley] if t >= 0 if tm_Obstacle[t] and not tm_OnlyDown[t] dstx = colx tm_CollisionInfo[TM_LEFT] = true break endif endif next endif endif elseif dx > 0 if imgx + w + dx >= tm_WorldW if tm_RightWall dstx = tm_WorldW - w - 1 tm_CollisionInfo[TM_RIGHT] = true else tm_CollisionInfo[TM_RIGHT] = false endif else if 0 = (imgx + w)%tm_TileW tilex = (imgx + w)/tm_TileW else tilex = (imgx + w)/tm_TileW + 1 endif colx = tilex*tm_TileW if colx < imgx + w + dx for tiley = ys to ye t = tm_Map[tilex][tiley] if t >= 0 if tm_Obstacle[t] and not tm_OnlyDown[t] dstx = colx - w tm_CollisionInfo[TM_RIGHT] = true break endif endif next endif endif endif imgx = dstx xs = max(min(imgx/tm_TileW, tm_MapW - 1), 0) xe = max(min((imgx + w - 1)/tm_TileW, tm_MapW - 1), 0) dsty = imgy + dy if dy < 0 if imgy + dy < 0 if tm_TopWall dsty = 0 tm_CollisionInfo[TM_UP] = true else tm_CollisionInfo[TM_UP] = false endif else tiley = max((imgy/tm_TileH) - 1, 0) coly = tiley*tm_TileH + tm_TileH if coly >= imgy + dy for tilex = xs to xe t = tm_Map[tilex][tiley] if t >= 0 if tm_Obstacle[t] and not tm_OnlyDown[t] dsty = coly tm_CollisionInfo[TM_UP] = true break endif endif next endif endif elseif dy > 0 if imgy + h + dy >= tm_WorldH if tm_BottomWall dsty = tm_WorldH - h - 1 tm_CollisionInfo[TM_DOWN] = true else tm_CollisionInfo[TM_DOWN] = false endif else if 0 = (imgy + h)%tm_TileH tiley = (imgy + h)/tm_TileH else tiley = (imgy + h)/tm_TileH + 1 endif coly = tiley*tm_TileH if coly < imgy + h + dy for tilex = xs to xe t = tm_Map[tilex][tiley] if t >= 0 if tm_Obstacle[t] dsty = coly - h tm_CollisionInfo[TM_DOWN] = true break endif endif next endif endif endif imgy = dsty return [imgx, imgy] endfunc function TM_MoveRect[](imgx, imgy, w, h, dx, dy) tm_CollisionInfo[0] = false tm_CollisionInfo[1] = false tm_CollisionInfo[2] = false tm_CollisionInfo[3] = false ys = max(min(imgy/tm_TileH, tm_MapH - 1), 0) ye = max(min((imgy + h - 1)/tm_TileH, tm_MapH - 1), 0) dstx = imgx + dx if dx < 0 if imgx + dx < 0 if tm_LeftWall dstx = 0 tm_CollisionInfo[TM_LEFT] = true else tm_CollisionInfo[TM_LEFT] = false endif else tilex = max((imgx/tm_TileW) - 1, 0) colx = tilex*tm_TileW + tm_TileW if colx >= imgx + dx for tiley = ys to ye t = tm_Map[tilex][tiley] if t >= 0 if tm_Obstacle[t] and not tm_OnlyDown[t] dstx = colx tm_CollisionInfo[TM_LEFT] = true break endif endif next endif endif elseif dx > 0 if imgx + w + dx >= tm_WorldW if tm_RightWall dstx = tm_WorldW - w - 1 tm_CollisionInfo[TM_RIGHT] = true else tm_CollisionInfo[TM_RIGHT] = false endif else if 0 = (imgx + w)%tm_TileW tilex = (imgx + w)/tm_TileW else tilex = (imgx + w)/tm_TileW + 1 endif colx = tilex*tm_TileW if colx < imgx + w + dx for tiley = ys to ye t = tm_Map[tilex][tiley] if t >= 0 if tm_Obstacle[t] and not tm_OnlyDown[t] dstx = colx - w tm_CollisionInfo[TM_RIGHT] = true break endif endif next endif endif endif imgx = dstx xs = max(min(imgx/tm_TileW, tm_MapW - 1), 0) xe = max(min((imgx + w - 1)/tm_TileW, tm_MapW - 1), 0) dsty = imgy + dy if dy < 0 if imgy + dy < 0 if tm_TopWall dsty = 0 tm_CollisionInfo[TM_UP] = true else tm_CollisionInfo[TM_UP] = false endif else tiley = max((imgy/tm_TileH) - 1, 0) coly = tiley*tm_TileH + tm_TileH if coly >= imgy + dy for tilex = xs to xe t = tm_Map[tilex][tiley] if t >= 0 if tm_Obstacle[t] and not tm_OnlyDown[t] dsty = coly tm_CollisionInfo[TM_UP] = true break endif endif next endif endif elseif dy > 0 if imgy + h + dy >= tm_WorldH if tm_BottomWall dsty = tm_WorldH - h - 1 tm_CollisionInfo[TM_DOWN] = true else tm_CollisionInfo[TM_DOWN] = false endif else if 0 = (imgy + h)%tm_TileH tiley = (imgy + h)/tm_TileH else tiley = (imgy + h)/tm_TileH + 1 endif coly = tiley*tm_TileH if coly < imgy + h + dy for tilex = xs to xe t = tm_Map[tilex][tiley] if t >= 0 if tm_Obstacle[t] dsty = coly - h tm_CollisionInfo[TM_DOWN] = true break endif endif next endif endif endif imgy = dsty return [imgx, imgy] endfunc rem ================================================================== rem rem ================================================================== function TM_MoveF#[](img, imgx#, imgy#, dx#, dy#) tm_CollisionInfo[0] = false tm_CollisionInfo[1] = false tm_CollisionInfo[2] = false tm_CollisionInfo[3] = false w# = float(width(img)) h# = float(height(img)) ys = max(min(int(imgy)/tm_TileH, tm_MapH - 1), 0) ye = max(min(int(imgy + h - 1.0)/tm_TileH, tm_MapH -1), 0) dstx# = imgx + dx if dx < 0.0 if imgx + dx < 0.0 if tm_LeftWall dstx = 0.0 tm_CollisionInfo[TM_LEFT] = true endif else tilex = max(int(imgx)/tm_TileW - 1, 0) colx# = float(tilex*tm_TileW + tm_TileW) if colx >= imgx + dx for tiley = ys to ye t = tm_Map[tilex][tiley] if t >= 0 if tm_Obstacle[t] dstx = colx tm_CollisionInfo[TM_LEFT] = true break endif endif next endif endif elseif dx > 0.0 if imgx + w + dx >= float(tm_WorldW) if tm_RightWall dstx = float(tm_WorldW) - w - 1.0 tm_CollisionInfo[TM_RIGHT] = true endif else tilex = int(imgx + w - 1.0)/tm_TileW + 1 colx# = float(tilex*tm_TileW) if colx < imgx + w + dx for tiley = ys to ye t = tm_Map[tilex][tiley] if t >= 0 if tm_Obstacle[t] dstx = colx - w tm_CollisionInfo[TM_RIGHT] = true break endif endif next endif endif endif imgx = dstx xs = max(min(int(imgx)/tm_TileW, tm_MapW - 1), 0) xe = max(min(int(imgx + w - 1.0)/tm_TileW, tm_MapW -1), 0) dsty# = imgy + dy if dy < 0.0 if imgy + dy < 0.0 if tm_TopWall dsty = 0.0 tm_CollisionInfo[TM_UP] = true endif else tiley = max(int(imgy)/tm_TileH - 1, 0) coly# = float(tiley*tm_TileH + tm_TileH) if coly >= imgy + dy for tilex = xs to xe t = tm_Map[tilex][tiley] if t >= 0 if tm_Obstacle[t] dsty = coly tm_CollisionInfo[TM_UP] = true break endif endif next endif endif elseif dy > 0.0 if imgy + h + dy >= float(tm_WorldH) if tm_BottomWall dsty = float(tm_WorldH) - h - 1.0 tm_CollisionInfo[TM_DOWN] = true endif else tiley = int(imgy + h - 1.0)/tm_TileH + 1 coly# = float(tiley*tm_TileH) if coly < imgy + h + dy for tilex = xs to xe t = tm_Map[tilex][tiley] if t >= 0 if tm_Obstacle[t] dsty = coly - h tm_CollisionInfo[TM_DOWN] = true break endif endif next endif endif endif imgy = dsty return [imgx, imgy] endfunc rem ================================================================== rem rem ================================================================== function TM_GetCollisionInfo[]() return tm_CollisionInfo; endfunc rem ================================================================== rem rem ================================================================== function TM_CollisionLeft() return tm_CollisionInfo[TM_LEFT] endfunc rem ================================================================== rem rem ================================================================== function TM_CollisionRight() return tm_CollisionInfo[TM_RIGHT] endfunc rem ================================================================== rem rem ================================================================== function TM_CollisionDown() return tm_CollisionInfo[TM_DOWN] endfunc rem ================================================================== rem rem ================================================================== function TM_CollisionUp() return tm_CollisionInfo[TM_UP] endfunc rem ================================================================== rem rem ================================================================== function TM_LoadMap(filename$) open file 0, filename$ if not file(0) then return false fn$ = TM_GetPath(filename) + read$(0) load image TM_IMAGE, fn if not image(TM_IMAGE) free file 0 return false endif set image grid TM_IMAGE, read(0), read(0) ck = read(0) ckr = read(0) ckg = read(0) ckb = read(0) if ck then set image colorkey TM_IMAGE, ckr, ckg, ckb proc TM_SetImage TM_IMAGE for i = 0 to cels(TM_IMAGE) - 1 proc TM_SetObstacle i, read(0) next proc TM_InitMap read(0), read(0) for y = 0 to tm_MapH - 1 for x = 0 to tm_MapW - 1 proc TM_SetCel x, y, read(0) - 1 next next for y = 0 to tm_MapH - 1 for x = 0 to tm_MapW - 1 proc TM_SetFlag x, y, read(0) next next lflags = 0 flags[tm_MapW][tm_MapH] for y = 0 to tm_MapH - 1 for x = 0 to tm_MapW - 1 flags[x][y] = read(0) if flags[x][y] <> 0 then lflags = lflags + 1 next next free file 0 if lflags = 0 tm_LoaderFlags[][] else tm_LoaderFlags[lflags][3] flag = 0 for y = 0 to tm_MapH - 1 for x = 0 to tm_MapW - 1 if flags[x][y] <> 0 tm_LoaderFlags[flag][0] = x tm_LoaderFlags[flag][1] = y tm_LoaderFlags[flag][2] = flags[x][y] flag = flag + 1 endif next next endif return true endfunc function TM_GetLoaderFlags[][]() return tm_LoaderFlags endfunc function TM_GetPath$(filename$) for i = len(filename) - 1 downto 0 if mid$(filename, i) = "/" pos = i + 1 break endif next return left$(filename, pos) endfunc function TM_WorldWidth() return tm_WorldW endfunc function TM_WorldHeight() return tm_WorldH endfunc function TM_ImageCol(img0, x0, y0, img1, x1, y1) if x0 + width(img0) < x1 then return false if y0 + height(img0) < y1 then return false if x1 + width(img1) < x0 then return false if y1 + height(img1) < y0 then return false return true endfunc