' ' プチコンワールド 365 ' ' © 2020 rtanpo440 ' option strict if button(0,#B_L1) then pushkey &h10058 const #FinitiFile="TXT:finiti" const #FinitiSlot=5 dim blockCount=0 dim quadCount=0 dim oldButtons dim currentButtons dim pressedButtons dim hand=@Grass acls Xscreen 960,540,1,0 dim loaded=LoadFiniti() loadg "TEXTURE.GRP",4 GenerateTexture &h00 GenerateTexture &h20 GenerateTexture &h21 GenerateTexture &h22 GenerateTexture &h40 LoadFromdata @Empty LoadFromdata @Player LoadFromdata @Cursor LoadFromdata @SoilQuad LoadFromdata @GrassQuad LoadFromdata @SandQuad LoadFromdata @GlassQuad LoadFromdata @BrickQuad PlayGame end '  ' Finiti '  '============================ ' '============================ common def LoadFiniti() if !chkfile(#FinitiFile) then return #false endif load #FinitiFile,#FinitiSlot EXEC #FinitiSlot offscreen_culling #on nearby_culling #on nearby_culling_distance 0.000008 sprite_mapping #on return #true end '============================ ' '============================ common def LoadFromdata name if chklabel(name,#true) then model_load name,name else LoadFromdata name+"1" LoadFromdata name+"2" LoadFromdata name+"3" LoadFromdata name+"4" LoadFromdata name+"5" LoadFromdata name+"6" endif end '============================ ' '============================ common def GenerateTexture definition dim old1,old2 dim new1,new2 dim compare texture_generate definition out new1,new2 dim file1=format$("DAT:%04X_1.TEX",definition) if chkfile(file1) then loadv file1 out old1 compare=array#(len(old1)) aryop #aopsub,compare,new1,old1 if min(compare) || max(compare) then savev file1,new1 endif else savev file1,new1 endif dim file2=format$("DAT:%04X_2.TEX",definition) if chkfile(file2) then loadv file2 out old2 compare=array#(len(old2)) aryop #aopsub,compare,new2,old2 if min(compare) || max(compare) then savev file2,new2 endif else savev file2,new2 endif end '  ' '  '============================ ' '============================ common def PlayGame tscreen 8,16 color #C_black spset 0,5716 spofs 0,480,270,-4095 InitSpace GenerateTerrain dim player=SummonPlayer() loop oldButtons=currentButtons currentButtons=BUTTON(0,-1) pressedButtons=currentButtons and oldButtons xor currentButtons cls ? "cubes ";blockCount ? "quads ";quadCount;",";blockCount*6;" (";quadCount*100 div (blockCount*6);"%)" Control player,"Common" Control player,"User" Control player,"Dig" SeeFrom player if pressedButtons and 1<<#B_X then linput "Item name:";hand endif scene_render vsync endloop end '  ' ブロック '  '============================ ' '============================ common def InitSpace backcolor &hff00ffff ' loadg "jpg:space1.jpg",2 ' loadg "jpg:space2.jpg",3 ' restore @Layers ' dim scale=1000 ' dim i ' for i=0 to 5 ' dim sprite=i+1 ' spset sprite,i mod 2*1024,i div 2 mod 2*1024,1024,1024 ' sppage sprite,i div 4+2 ' sphome sprite,512,512 ' splayer sprite,i+1 ' dim position[3],angle[3] ' read position[0],position[1],position[2] ' read angle [0],angle [1],angle [2] ' aryop #aopmul,position,position,scale ' layer_transform i+1 ' layer_scale i+1,scale ' layer_move i+1,position[0],position[1],position[2] ' layer_rotate i+1,angle [0],angle [1],angle [2] ' next light_ambient_color &hff080808 light_move 0,-8,0 ' @Layers ' data 00,-32, 00 ,270,000,000 ' data 32, 00, 00 ,270,000,090 ' data 00, 32, 00 ,270,000,180 ' data -32, 00, 00 ,270,000,270 ' data 00, 00, 32 ,180,000,000 ' data 00, 00,-32 ,000,000,090 end '============================ ' '============================ common def GenerateTerrain dim w=7,h=7 dim c0=0,c1=3,c2=0 for c0=-int(w/2-.5) to int(w/2) for c2=-int(h/2-.5) to int(h/2) SetBlock Coord(c0,c1,c2),@Grass next next end '  ' Coord '  '============================ ' '============================ common def Coord(c0,c1,c2) dim newCoord[]=[c0,c1,c2] return newCoord end '============================ ' '============================ common def AddCoord(oldCoord,d0,d1,d2) dim newCoord[]=[oldCoord[0]+d0,oldCoord[1]+d1,oldCoord[2]+d2] return newCoord end '============================ ' '============================ common def AddCoords(coordA,coordB) dim newCoord[3] aryop #aopadd,newCoord,coordA,coordB return newCoord end '  ' mob '  '============================ ' '============================ common def Summon(model) dim mob=object_set(model) object_move mob,0,0,0 return mob end '============================ ' '============================ common def SummonPlayer() dim player=Summon(@Player) object_move player,0,-1,0 return player end '============================ ' '============================ common def Control target,control dim position[3] dim angle [3] dim move [3] dim bounds [3]=[0.9,1.6,0.9] object_move target out position[0],position[1],position[2] object_home target out move [0],move [1],move [2] object_rotate target out angle [0],angle [1],angle [2] dim previous=copy(position) call control+"Controller",target,position,angle,move,bounds aryop #aopadd,position,position,move position=CorrectPosition(position,previous,move,bounds) object_move target,position[0],position[1],position[2] object_home target,move [0],move [1],move [2] object_rotate target,angle [0],angle [1],angle [2] end '============================ ' '============================ common def CommonController target,position,angle,move,bounds if Ground(position,bounds) then move[1]=0 else inc move[1],0.003 endif move[1]=move[1]*0.98 move[0]=move[0]*0.5 move[2]=move[2]*0.5 end '============================ ' '============================ common def UserController target,position,angle,move,bounds dim left [2] dim right[2] stick 0,0 out left [0],left [1] stick 0,1 out right[0],right[1] inc move[0],(cos(rad(-angle[1]))*left[0]-sin(rad(-angle[1]))*left[1])*.02 inc move[2],(sin(rad(-angle[1]))*left[0]+cos(rad(-angle[1]))*left[1])*.02 inc angle[0],right[1]*5 dec angle[1],right[0]*5 if Ground(position,bounds) then if button(0,#B_B,0) then move[1]=-0.0665 endif endif end '============================ ' '============================ common def DigController target,position,angle,move,bounds position=AddCoords(position,GetCameraOffset()) dim hit,coord,offset Cast position,angle out hit,coord,offset if hit then if pressedButtons and 1<<#B_R2 then SoundDig SetBlock coord,@Empty endif if pressedButtons and 1<<#B_L2 then SoundPut coord=AddCoords(coord,offset) SetBlock coord,hand endif endif end '============================ ' '============================ common def SeeFrom target dim position[3] dim angle [3] object_move target out position[0],position[1],position[2] object_rotate target out angle [0],angle [1],angle [2] position=AddCoords(position,GetCameraOffset()) camera_offset 0 camera_move position[0],position[1],position[2] camera_angle angle [0],angle [1],angle [2] dim hit,coord,offset Cast position,angle out hit,coord,offset DrawCursor hit,coord end '============================ ' '============================ common def GetCameraOffset() return Coord(0,-0.8,0) end '============================ ' '============================ common def CorrectPosition(position,previous,move,bounds) dim hit=#false dim changed0[3]=[position[0],previous[1],previous[2]] dim changed1[3]=[previous[0],position[1],previous[2]] dim changed2[3]=[previous[0],previous[1],position[2]] if Hit(changed0,bounds) then position[0]=previous[0]:move[0]=0:hit=#true if Hit(changed1,bounds) then position[1]=previous[1]:move[1]=0:hit=#true if Hit(changed2,bounds) then position[2]=previous[2]:move[2]=0:hit=#true return position end '============================ ' '============================ common def Hit(position,bounds) dim E=0.01 dim half1[3]=[-bounds[0]*.5+E,-bounds[1]*.5+E,-bounds[2]*.5+E] dim half2[3]=[ bounds[0]*.5 ,-bounds[1]*.5+E,-bounds[2]*.5+E] dim half3[3]=[-bounds[0]*.5+E,-bounds[1]*.5+E, bounds[2]*.5 ] dim half4[3]=[ bounds[0]*.5 ,-bounds[1]*.5+E, bounds[2]*.5 ] dim half5[3]=[-bounds[0]*.5+E, bounds[1]*.5 ,-bounds[2]*.5+E] dim half6[3]=[ bounds[0]*.5 , bounds[1]*.5 ,-bounds[2]*.5+E] dim half7[3]=[-bounds[0]*.5+E, bounds[1]*.5 , bounds[2]*.5 ] dim half8[3]=[ bounds[0]*.5 , bounds[1]*.5 , bounds[2]*.5 ] dim position1[3],position2[3],position3[3],position4[3] dim position5[3],position6[3],position7[3],position8[3] aryop #aopadd,position1,position,half1 aryop #aopadd,position2,position,half2 aryop #aopadd,position3,position,half3 aryop #aopadd,position4,position,half4 aryop #aopadd,position5,position,half5 aryop #aopadd,position6,position,half6 aryop #aopadd,position7,position,half7 aryop #aopadd,position8,position,half8 if HasBlock(position1) then return #true if HasBlock(position2) then return #true if HasBlock(position3) then return #true if HasBlock(position4) then return #true if HasBlock(position5) then return #true if HasBlock(position6) then return #true if HasBlock(position7) then return #true if HasBlock(position8) then return #true return #false end '============================ ' '============================ common def Ground(position,bounds) dim E=0.01 dim half1[3]=[-bounds[0]*.5+E,bounds[1]*.5+E,-bounds[2]*.5+E] dim half2[3]=[ bounds[0]*.5 ,bounds[1]*.5+E, bounds[2]*.5 ] dim position1[3],position2[3] aryop #aopadd,position1,position,half1 aryop #aopadd,position2,position,half2 return HasBlock(position1) || HasBlock(position2) end '  ' ブロック '  '============================ ' '============================ common def SetBlock coord,name dim empty=HasBlock(coord) if empty!=(name!=@Empty) then dim block=GetQuad(coord,0) if name!=@Empty then object_set block,name+"Quad1" object_move block,coord[0],coord[1],coord[2] object_hide block inc blockCount else object_clear block dec blockCount endif XorQuad coord,1,name XorQuad coord,2,name XorQuad coord,3,name XorQuad AddCoord(coord,1,0,0),4,name XorQuad AddCoord(coord,0,1,0),5,name XorQuad AddCoord(coord,0,0,1),6,name endif end '============================ ' '============================ common def HasBlock(coord) return object_used(GetQuad(coord,0)) end '============================ ' '============================ common def IsTranslucentBlock(name) dim colors edit_reset edit_model name+"Quad1" edit_tris out ,,,colors,,, return ((colors[0]>>24) and &hff)==&hff end '  ' 面 '  '============================ ' '============================ common def XorQuad putCoord,putSide,name dim destroy=(name==@Empty) dim getCoord=copy(putCoord) dim getSide =putSide if object_used(GetQuad(getCoord,getSide)) then DestroyQuad putCoord,putSide else putSide=((putSide-1)+destroy*3) mod 6+1 if destroy then dec getCoord[(getSide-1) mod 3],(putSide-1) div 3 if object_used(GetQuad(getCoord,0)) then name=object_model(GetQuad(getCoord,0)) name=left$(name,len(name)-5) endif endif CreateQuad putCoord,putSide,name endif end '============================ ' '============================ common def CreateQuad coord,side,name dim quad=GetQuad(coord,side) object_set quad,name+"Quad"+str$(side) object_move quad,coord[0],coord[1],coord[2] case side when 1:object_rotate quad,-90,-90, 0 when 3:object_rotate quad, 90, 0, 0 when 4:object_rotate quad,-90, 90, 0:object_move quad,coord[0]-1,coord[1] ,coord[2] when 5:object_rotate quad, 0, 0,180:object_move quad,coord[0] ,coord[1]-1,coord[2] when 6:object_rotate quad,-90, 0, 0:object_move quad,coord[0] ,coord[1] ,coord[2]-1 endcase inc quadCount end '============================ ' '============================ common def DestroyQuad coord,side dim quad=GetQuad(coord,side) object_clear quad dec quadCount end '============================ ' '============================ common def GetQuad(coord,side) dim quad=0 quad=quad or ((round(coord[2]+256) and &h1ff)<< 2) quad=quad or ((round(coord[0]+256) and &h1ff)<<11) quad=quad or ((round(coord[1]+256) and &h1ff)<<20) quad=quad or (((side-1) mod 3+1)<<29) return quad end '============================ ' '============================ common def GetCursor() return 1 end '============================ ' '============================ common def DrawCursor hit,position dim cursor=GetCursor() object_clear cursor if !hit then return endif object_set cursor,@Cursor object_move cursor,position[0],position[1],position[2] end '============================ ' '============================ common def Cast position,angle out hit,coord,offset hit =#false coord =Coord(0,0,0) offset=Coord(0,0,0) dim distance dim farestDistance=4 dim stepDistance =0.2 dim move[3] move[0]=stepDistance*abs(cos(rad(angle[0])))*-sin(rad(angle[1])) move[2]=stepDistance*abs(cos(rad(angle[0])))*-cos(rad(angle[1])) move[1]=stepDistance*sin(rad(angle[0])) dim current=position dim previous=copy(current) dim corner[3] dim cornerAngle[3] for distance=0 to farestDistance step stepDistance aryop #aopadd,current,current,move coord[0]=round(current[0]) coord[1]=round(current[1]) coord[2]=round(current[2]) if coord[0]!=previous[0]||coord[1]!=previous[1]||coord[2]!=previous[2] then if HasBlock(coord) then hit=#true copy corner,coord dec corner[0],sgn(move[0])*.5 dec corner[1],sgn(move[1])*.5 dec corner[2],sgn(move[2])*.5 cornerAngle[1]=deg(atan(corner[0]-position[0],corner[2]-position[2])) offset[0]=sgn(sin(rad(cornerAngle[1]))) offset[2]=sgn(cos(rad(cornerAngle[1]))) offset[1]=-sgn(rad(angle[0])) dim i=(((cornerAngle[1]>angle[1])+(move[0]>0)+(move[2]>0)) and 1)*2 cornerAngle[0]=deg(atan(corner[1]-position[1],abs(corner[i]-position[i]))) if (abs(angle[0])-abs(cornerAngle[0]))>0 then i=1 endif offset[0]=offset[0]*(i==0) offset[1]=offset[1]*(i==1) offset[2]=offset[2]*(i==2) return endif endif copy previous,coord next end '  ' SE '  '============================ ' '============================ common def SoundPut beep 95,200 end '============================ ' '============================ common def SoundDig beep 95,-600 end '  ' モデル '  @Empty data "E" @Player data "E" data "PT",-0.1, 0.8,-0.1 data "PT",-0.1, 0.8, 0.1 data "PT",-0.1,-0.8,-0.1 data "PT",-0.1,-0.8, 0.1 data "PT", 0.1, 0.8,-0.1 data "PT", 0.1, 0.8, 0.1 data "PT", 0.1,-0.8,-0.1 data "PT", 0.1,-0.8, 0.1 data "C" ,&hff00ffff data "Q" ,1,3,2,4 data "Q" ,3,7,4,8 data "Q" ,7,5,8,6 data "Q" ,5,1,6,2 data "Q" ,3,1,7,5 data "Q" ,8,6,4,2 data "E" @Cursor data "PT", 0.51, 0.51, 0.51 data "PT",-0.51, 0.51, 0.51 data "PT", 0.51,-0.51, 0.51 data "PT",-0.51,-0.51, 0.51 data "PT", 0.51, 0.51,-0.51 data "PT",-0.51, 0.51,-0.51 data "PT", 0.51,-0.51,-0.51 data "PT",-0.51,-0.51,-0.51 data "C" ,&hffffff00 data "L" ,1,2 data "L" ,2,6 data "L" ,6,5 data "L" ,5,1 data "L" ,3,4 data "L" ,4,8 data "L" ,8,7 data "L" ,7,3 data "L" ,1,3 data "L" ,2,4 data "L" ,5,7 data "L" ,6,8 'data "C" ,&h80ffffff 'data "TX","0000_1" 'data "T" ,1,2,3 'data "T" ,1,5,2 'data "T" ,1,3,5 'data "T" ,7,8,5 'data "T" ,4,8,3 'data "T" ,6,8,2 'data "TX","0000_2" 'data "T" ,4,3,2 'data "T" ,6,2,5 'data "T" ,7,5,3 'data "T" ,6,5,8 'data "T" ,7,3,8 'data "T" ,4,2,8 data "E" @Quad data "PT",-0.5,-0.5,-0.5 data "PT",-0.5,-0.5, 0.5 data "PT", 0.5,-0.5,-0.5 data "PT", 0.5,-0.5, 0.5 data "E" @Tri1 data "T",1,3,2 data "E" @Tri2 data "T",4,2,3 data "E" @SoilQuad1 @SoilQuad2 @SoilQuad3 @SoilQuad4 @SoilQuad5 @SoilQuad6 @GrassQuad1 @GrassQuad3 @GrassQuad4 @GrassQuad5 @GrassQuad6 data "B" ,@Quad data "TX","0020_1","B",@Tri1 data "TX","0020_2","B",@Tri2 data "E" @GrassQuad2 data "B" ,@Quad data "TX","0021_1","B",@Tri1 data "TX","0021_2","B",@Tri2 data "E" @SandQuad1 @SandQuad2 @SandQuad3 @SandQuad4 @SandQuad5 @SandQuad6 data "B" ,@Quad data "TX","0022_1","B",@Tri1 data "TX","0022_2","B",@Tri2 data "E" @GlassQuad1 @GlassQuad2 @GlassQuad3 @GlassQuad4 @GlassQuad5 @GlassQuad6 data "B" ,@Quad data "DS" data "C" ,&h80ffffff data "TX","0000_1","B",@Tri1 data "TX","0000_2","B",@Tri2 data "E" @BrickQuad1 @BrickQuad2 @BrickQuad3 @BrickQuad4 @BrickQuad5 @BrickQuad6 data "B" ,@Quad data "DS" data "TX","0040_1","B",@Tri1 data "TX","0040_2","B",@Tri2 data "E"