Code archives/Miscellaneous/Map Generator
This code has been declared by its author to be Public Domain code.
Download source code
| |||||
This was made to create maps for a pen and paper RPG I wrote, Legends of Arthonia. It was a learning experience for me, using the GUI elements and such, and it has some other aspects that might be of interest to a beginner. Basically, it creates a ten by ten printer friendly map and allows the user to export it as a .bmp file for printing. It's pretty user friendly and doesn't take long to figure it out. | |||||
AppTitle "Legends of Arthonia Map Generator v1.0" Graphics 640,480,32,2 Dim terrain$(6) terrain$(1)="FOREST" terrain$(2)="MOUNTS" terrain$(3)="WATER" terrain$(4)="PlAINS" terrain$(5)="SWAMP" terrain$(6)="DESERT" Global x=24 Global y=24 Global back=CreateImage(481,481,1) SetBuffer ImageBuffer(back) Color 255,255,255 Rect 0,0,480,480,1 Color 0,0,0 Rect 0,0,481,481,0 For t=1 To 10 Line 0,48*t,480,48*t Next For u=1 To 10 Line 48*u,0,48*u,480 Next MaskImage back,255,0,0 SetBuffer BackBuffer() While Not KeyHit(1) ClsColor 255,255,255 Color 0,0,0 DrawImage back,0,0 Text 490,0,"Editor Key:" Text 490,12,"-Terrain" Text 490,24,"1=Woods" Text 490,36,"2=Rocks" Text 490,48,"3=Water" Text 490,60,"4=Grass" Text 490,72,"5=Swamp" Text 490,84,"6=Sand" Text 490,108,"-Walls/Unwalkable" Text 490,120,"7=Horizontal" Text 490,132,"8=Vertical" Text 490,144,"9=Corner" Text 490,156,"0=Unwalkable" Text 490,180,"-Custom" Text 490,192,"BACK=New custom" Text 490,204,"Z=Custom" Text 490,228,"-Height" Text 490,240,"F1=1" Text 490,252,"F2=2" Text 490,264,"F3=3" Text 490,276,"F4=4" Text 490,288,"F5=5" Text 490,300,"F6=6" Text 490,324,"-Other" Text 490,336,"SPACE=delete" Text 490,348,"S=save" Text 490,360,"L=Load" Text 490,372,"H=Help" ;///////////////////////////// Color 128,128,128 Text x,y,"X" If KeyHit(203) x=x-48 If x<=24 x=24 EndIf EndIf If KeyHit(205) x=x+48 If x>=456 x=456 EndIf EndIf If KeyHit(200) y=y-48 If y<=24 y=24 EndIf EndIf If KeyHit(208) y=y+48 If y>=456 y=456 EndIf EndIf ;/////////////////////////////// ;TEXT key=GetKey() If key>48 And key<55 SetBuffer ImageBuffer(back) Color 0,0,0 Text x-24,y,terrain(key-48) SetBuffer BackBuffer() EndIf ;WALLS, DELETE, UNWALKABLE If key=32 SetBuffer ImageBuffer(back) Color 255,255,255 Rect x-23,y-23,47,47,1 SetBuffer BackBuffer() EndIf If key=48 SetBuffer ImageBuffer(back) Color 0,0,0 Rect x-23,y-23,46,46,1 SetBuffer BackBuffer() EndIf If key=55 SetBuffer ImageBuffer(back) Color 0,0,0 Rect x-23,y-5,47,10 SetBuffer BackBuffer() EndIf If key=56 SetBuffer ImageBuffer(back) Color 0,0,0 Rect x-5,y-23,10,47 SetBuffer BackBuffer() EndIf If key=57 SetBuffer ImageBuffer(back) Color 0,0,0 Rect x-5,y-23,10,47 Rect x-23,y-5,47,10 SetBuffer BackBuffer() EndIf ;LEVEL If KeyHit(59) SetBuffer ImageBuffer(back) Color 128,128,128 Text x-23,y-23,"1" SetBuffer BackBuffer() EndIf If KeyHit(60) SetBuffer ImageBuffer(back) Color 128,128,128 Text x-23,y-23,"2" SetBuffer BackBuffer() EndIf If KeyHit(61) SetBuffer ImageBuffer(back) Color 128,128,128 Text x-23,y-23,"3" SetBuffer BackBuffer() EndIf If KeyHit(62) SetBuffer ImageBuffer(back) Color 128,128,128 Text x-23,y-23,"4" SetBuffer BackBuffer() EndIf If KeyHit(63) SetBuffer ImageBuffer(back) Color 128,128,128 Text x-23,y-23,"5" SetBuffer BackBuffer() EndIf If KeyHit(64) SetBuffer ImageBuffer(back) Color 128,128,128 Text x-23,y-23,"6" SetBuffer BackBuffer() EndIf ;CUSTOM If KeyHit(14) custom=CreateWindow("New Custom Label",100,100,230,150,gamewindow,1) customname=CreateTextField(10,40,200,20,custom) CreateLabel("Enter custom entry (max. 6 characters)",10,10,200,20,custom) okbutton=CreateButton("OK",72,75,85,25,custom,1) ActivateGadget customname Repeat If WaitEvent()=$401 If EventSource()=okbutton customstring$=Upper$(Left$(TextFieldText$(customname),6)) SetBuffer ImageBuffer(back) Text x-23,y,customstring$ FreeGadget custom SetBuffer BackBuffer() Exit EndIf EndIf If WaitEvent()=$803 FreeGadget custom Exit EndIf Forever EndIf If KeyHit(44) SetBuffer ImageBuffer(back) Text x-23,y,customstring$ SetBuffer BackBuffer() EndIf ;SAVE AND LOAD If KeyHit(31) save=CreateWindow("Save File Name",100,100,230,150,gamewindow,1) savename=CreateTextField(10,40,200,20,save) CreateLabel("Enter the file name with suffix .bmp:",10,10,200,20,save) okbutton=CreateButton("OK",72,75,85,25,save,1) ActivateGadget savename Repeat If WaitEvent()=$401 If EventSource()=okbutton ok=SaveImage(back,"c:"+TextFieldText$(savename)) If ok=1 Notify "File '"+TextFieldText$(savename)+"' successfully saved." Else Notify "Save error.",True EndIf FreeGadget save Exit EndIf EndIf If WaitEvent()=$803 FreeGadget save Exit EndIf Forever EndIf If KeyHit(38) loadmap$=RequestFile("Load Map","bmp") If loadmap$<>"" back=LoadImage(loadmap$) MaskImage back,255,0,0 EndIf EndIf If KeyHit(35) help=CreateWindow("Help",100,100,400,400,gamewindow,1) helptext=CreateCanvas(0,0,400,400,help) SetBuffer CanvasBuffer(helptext) Color 128,128,128 Text 200,0,"Legends of Arthonia Map Generator",True,False Text 200,12,"By: Brian Sauer, 2008",True,False Text 200,36,"This utility is for the creation of maps",True,False Text 200,48,"for the use in the LEGENDS OF ARTHONIA",True,False Text 200,60,"RPG. Use the key on the left to add map",True,False Text 200,72,"characters. Maps can be saved and loaded",True,False Text 200,84,"as .bmp files.",True,False Text 200,108,"TIPS:",True,False Text 200,120,"-Use the UNWALKABLE surface to make ",True,False Text 200,132," dungeons and castle walls.",True,False Text 200,146,"-For shops, NPC's, and other specialty",True,False Text 200,158," characters, use the CUSTOM feature.",True,False Text 200,170,"-After creating maps, submit them to the",True,False Text 200,182," the DOF website for public display.",True,False Text 200,206,"If you have any questions, comments, or",True,False Text 200,218,"suggestions for this generator, please",True,False Text 200,230,"e-mail contact@dungeonsoffear.",True,False Text 200,254,"More Legends of Arthonia tools and game",True,False Text 200,266,"material at www.dungeonsoffear.com!",True,False FlipCanvas(helptext) SetBuffer BackBuffer() Repeat If WaitEvent()=$803 FreeGadget help Exit EndIf Forever EndIf Flip Cls Wend |
Comments
| ||
what is a pen and paper rpg? |
| ||
what is a pen and paper rpg? http://en.wikipedia.org/wiki/Tabletop_role-playing_game There are conventions for this or if you have watched The Big Bang Theory show they act or play it on some episodes |
Code Archives Forum