Hmm, not having much luck with posting code at the moment, will try again:
rem
rem Tyrant RPG Engine Tool
rem
rem Version 0.01
rem
rem Date Started 08/12/2002
rem
rem Maze Generator
rem
rem Mazes are an array of NumColsxNumRows Blocks
rem
rem 00 = Empty
rem 01 = Wall
rem 02 = Door
rem 03 = Chest
rem 04 = Trap
rem 05 = Entrance
rem 06 = Stairs Up
rem 07 = Stairs Down
rem 08 = Random Treasure
rem 100+n= Encounter Number, Where n=Encounter
rem
rem
rem Setup Variables
rem
SET TEXT FONT "Courier New"
SET TEXT SIZE 15
SET TEXT OPAQUE
#CONSTANT NumCols 20
#CONSTANT NumRows 20
` The Array containing all the maze data
DIM MazeArray(NumCols,NumRows)
` These are the offset for drawing the Grid for the top right hand corner
BaseGridX=150
BaseGridY=150
` These represent the Height and Width of each grid square to
` be drawn on screen.
GridSqHeight=20
GridSqWidth=20
` Set the Current square in the grid we are working on.
CurrentX=1
CurrentY=1
EldX=-1
EldY=-1
` Set the current Menu position To Empty space, plus set up menu vars.
CurrentMenu=1
FontHeight=TEXT HEIGHT("Random Treasure")
FontWidth=TEXT WIDTH("Random Treasure")
Offset=FontHeight*2
Option=-1
EldOption=-1
ObjectType=0
EldObjextType=1
` Blank out the Maze Array to Empty Spaces
FOR X=1 TO NumCols
FOR Y=1 TO NumRows
MazeArray(X,Y)=0
NEXT Y
NEXT X
` Setup the Menu text
DIM Menu$(13)
Menu$(0)=" Empty Space "
Menu$(1)=" Wall "
Menu$(2)=" Door "
Menu$(3)=" Chest "
Menu$(4)=" Trap "
Menu$(5)=" Entrance "
Menu$(6)=" Stairs Up "
Menu$(7)=" Stairs Down "
Menu$(8)="Random Treasure"
Menu$(9)=" Encounter "
Menu$(10)=" SAVE "
Menu$(11)=" LOAD "
Menu$(12)=" QUIT "
rem
rem Setup Screen
rem
GOSUB SetupScreen
rem
rem Main Program Loop
rem
DO
GOSUB CheckMouse
GOSUB ActionGrid
GOSUB ActionMenu
LOOP
rem
rem SUBROUTINES
rem
rem
rem Set up the screen for the initial display of the maze
rem
SetupScreen:
CLS
SET CURSOR 0,0
PRINT "Tyrant RPG Engine Maze Generator"
PRINT
PRINT Menu$(0)
INK RGB(150,150,150),0
FOR Lp=1 TO 12
PRINT Menu$(Lp)
NEXT Lp
` Drawer Menu Grid
FOR Lp=0 TO 12
YStart=Offset+(Lp*FontHeight)
YEnd =Offset+((Lp+1)*FontHeight)
Line 0,YStart,FontWidth,YStart
Line FontWidth,YStart,FontWidth,YEnd
LINE FontWidth,YEnd,0,YEnd
Line 0,YEnd,0,YStart
Next Lp
INK RGB(255,255,255),0
GOSUB RefreshMaze
RETURN
rem
rem fresh the maze Drawn on the screen
rem
RefreshMaze:
` Draw the Basic Grid on screen in dull colour first
INK RGB(150,150,150),0
FOR X=1 TO NumCols+1
` Calculate the Start and end of the line Plus the row,
XCoord=BaseGridX+(GridSqWidth*(X-1))
YStart=BaseGridY
YEnd =BaseGridY+(NumRows*GridSqHeight)
LINE XCoord,YStart,XCoord,YEnd
NEXT X
FOR Y=1 TO NumRows+1
` Calculate the Start and end of the line Plus the row,
XStart=BaseGridX
XEnd =BaseGridX+(NumCols*GridSqWidth)
YCoord=BaseGridY+(GridSqHeight*(Y-1))
LINE XStart,YCoord,XEnd,YCoord
NEXT Y
INK RGB(255,255,255),0
FOR DispX=0 TO NumCols-1
FOR DispY=0 TO NumRows-1
GOSUB DisplayGridObject
NEXT DispY
Next DispX
RETURN
rem Check to see if mouse is over a maze block.
CheckMouse:
XStart=BaseGridX
XEnd =BaseGridX+(NumCols*GridSqWidth)-1
YStart=BaseGridY
YEnd =BaseGridY+(NumRows*GridSqHeight)-1
Mx=MOUSEX()
My=MOUSEY()
Button=MOUSECLICK()
OverGrid=0
OverMenu=0
` If mouse is on the Grid then set the cordinates of the Grid that
` the mouse is over
IF Mx>=XStart AND Mx<=XEnd AND My>=YStart AND My<=YEnd
XCoord=Mx-XStart
YCoord=My-YStart
CurrentX=INT(XCoord/GridSqWidth)
CurrentY=INT(YCoord/GridSqHeight)
OverGrid=1
ELSE
CurrentX=-1
CurrentY=-1
MenuYStart=Offset
MenuYEnd =Offset+(13*FontHeight)
IF Mx<FontWidth AND My>=MenuYStart AND My<=MenuYEnd
Option=INT((My-Offset-1)/FontHeight)
OverMenu=1
ELSE
Option=-1
ENDIF
ENDIF
RETURN
rem Action Mouse for Grid
ActionGrid:
IF CurrentX<>EldX OR CurrentY<>EldY
GOSUB DrawEldGrid
GOSUB DrawGrid
EldX=CurrentX
EldY=CurrentY
ENDIF
IF OverGrid AND Button
IF ObjectType=9
SET CURSOR 250,100
INPUT "Enter Encounter Number>",EncNo
SET CURSOR 250,100
PRINT " "
ObjectType=199+EncNo
ENDIF
MazeArray(CurrentX,CurrentY)=ObjectType
IF ObjectType>=200 THEN ObjectType=9
DispX=CurrentX
DispY=CurrentY
GOSUB DisplayGridObject
ENDIF
RETURN
rem Action Mouse for Menu
ActionMenu:
IF EldOption<>Option
EldOpt=EldOption
GOSUB DrawEldMenu
GOSUB DrawMenu
EldOption=Option
ENDIF
IF OverMenu AND Button
IF Option>9
SELECT Option
CASE 10
GOSUB SaveMaze
ENDCASE
CASE 11
GOSUB LoadMaze
ENDCASE
CASE 12
END
ENDCASE
ENDSELECT
ELSE
ObjectType=Option
IF EldObjectType<>ObjectType
SET CURSOR 0,(2*FontHeight)+(EldObjectType*FontHeight)
INK RGB(150,150,150),0
Opt=EldObjectType
GOSUB DisplayMenuOption
EldOpt=EldObjectType
GOSUB DrawEldMenu
ENDIF
SET CURSOR 0,(2*FontHeight)+(ObjectType*FontHeight)
Opt=ObjectType
GOSUB DisplayMenuOption
GOSUB DrawMenu
EldObjectType=ObjectType
ENDIF
ENDIF
RETURN
rem Display the menu option
DisplayMenuOption:
PRINT Menu$(Opt)
RETURN
rem Display greyed out menu box
DrawEldMenu:
IF EldOpt>=0
INK RGB(150,150,150),0
YStart=Offset+(EldOpt*FontHeight)
YEnd =Offset+((EldOpt+1)*FontHeight)
LINE 0,YStart,FontWidth,YStart
LINE FontWidth,YStart,FontWidth,YEnd
LINE FontWidth,YEnd,0,YEnd
LINE 0,YEnd,0,YStart
INK RGB(255,255,255),0
ENDIF
RETURN
rem Display white menu box
DrawMenu:
IF Option>=0
YStart=Offset+(Option*FontHeight)
YEnd =Offset+((Option+1)*FontHeight)
LINE 0,YStart,FontWidth,YStart
LINE FontWidth,YStart,FontWidth,YEnd
LINE FontWidth,YEnd,0,YEnd
LINE 0,YEnd,0,YStart
ENDIF
RETURN
rem Display eld Grid Box
DrawEldGrid:
IF EldX>=0 OR EldY>=0
XStart=BaseGridX+(EldX*GridSqWidth)
XEnd =BaseGridX+((EldX+1)*GridSqWidth)
YStart=BaseGridY+(EldY*GridSqHeight)
YEnd =BaseGridY+((EldY+1)*GridSqHeight)
INK RGB(150,150,150),0
LINE XStart,YStart,XEnd,YStart
LINE XEnd,YStart,XEnd,YEnd
LINE XEnd,YEnd,XStart,YEnd
LINE XStart,YEnd,XStart,YStart
INK RGB(255,255,255),0
ENDIF
RETURN
rem Display Grid Box
DrawGrid:
IF CurrentX>=0 OR CurrentY>=0
XStart=BaseGridX+(CurrentX*GridSqWidth)
XEnd =BaseGridX+((CurrentX+1)*GridSqWidth)
YStart=BaseGridY+(CurrentY*GridSqHeight)
YEnd =BaseGridY+((CurrentY+1)*GridSqHeight)
LINE XStart,YStart,XEnd,YStart
LINE XEnd,YStart,XEnd,YEnd
LINE XEnd,YEnd,XStart,YEnd
LINE XStart,YEnd,XStart,YStart
ENDIF
RETURN
rem Display the Object Type at the CurrentX,CurrentY position.
DisplayGridObject:
GridObject=MazeArray(DispX,DispY)
XStart=BaseGridX+(DispX*GridSqWidth)
XEnd =BaseGridX+((DispX+1)*GridSqWidth)
YStart=BaseGridY+(DispY*GridSqHeight)
YEnd =BaseGridY+((DispY+1)*GridSqHeight)
SELECT GridObject
CASE 0
` Empty Space
INK RGB(255,255,255),0
BOX XStart,YStart,XEnd,YEnd
ENDCASE
CASE 1
` Wall
INK 0,0
BOX XStart,YStart,XEnd,YEnd
ENDCASE
CASE 2
` Door
INK RGB(150,150,150),0
BOX XStart,YStart,XEnd,YEnd
INK 0,0
SET TEXT TRANSPARENT
TEXT XStart+7,YStart+2,"D"
SET TEXT OPAQUE
ENDCASE
CASE 3
` Chest
INK RGB(0,150,0),0
BOX XStart,YStart,XEnd,YEnd
INK 0,0
SET TEXT TRANSPARENT
TEXT XStart+7,YStart+2,"C"
SET TEXT OPAQUE
ENDCASE
CASE 4
` Trap
INK RGB(150,0,0),0
BOX XStart,YStart,XEnd,YEnd
INK 0,0
SET TEXT TRANSPARENT
TEXT XStart+7,YStart+2,"T"
SET TEXT OPAQUE
ENDCASE
CASE 5
` Entrance
INK 0,0
SET TEXT TRANSPARENT
TEXT XStart+7,YStart+2,"e"
SET TEXT OPAQUE
ENDCASE
CASE 6
` Stairs Up
INK 0,0
SET TEXT TRANSPARENT
TEXT XStart+7,YStart+2,"^"
SET TEXT OPAQUE
ENDCASE
CASE 7
` Stairs Down
INK 0,0
SET TEXT TRANSPARENT
TEXT XStart+7,YStart+2,"v"
SET TEXT OPAQUE
ENDCASE
CASE 8
` Random Treasure
INK RGB(0,0,150),0
BOX XStart,YStart,XEnd,YEnd
INK RGB(255,255,255),0
SET TEXT TRANSPARENT
TEXT XStart+7,YStart+2,"£"
SET TEXT OPAQUE
ENDCASE
CASE DEFAULT
` Encounter
INK RGB(255,255,225),0
BOX XStart,YStart,XEnd,YEnd
INK 0,0
SET TEXT TRANSPARENT
IF GridObject<209
Enc$="0"+STR$(GridObject-199)
ELSE
Enc$=STR$(GridObject-199)
ENDIF
TEXT XStart+3,YStart+3,Enc$
SET TEXT OPAQUE
ENDCASE
ENDSELECT
INK RGB(150,150,150),0
LINE XStart,YStart,XEnd,YStart
LINE XEnd,YStart,XEnd,YEnd
LINE XEnd,YEnd,XStart,YEnd
LINE XStart,YEnd,XStart,YStart
INK RGB(255,255,255),0
RETURN
rem Save current maze.
SaveMaze:
IF FILE EXIST("level0") THEN DELETE FILE "level0"
OPEN TO WRITE 1,"level0"
FOR Xarr=0 TO NumCols-1
FOR Yarr=0 TO NumRows-1
WRITE BYTE 1,MazeArray(Xarr,Yarr)
NEXT Yarr
NEXT Xarr
CLOSE FILE 1
RETURN
rem Load maze.
LoadMaze:
IF FILE EXIST("level0")
ELSE
RETURN
ENDIF
OPEN TO READ 1,"level0"
FOR Xarr=0 TO NumCols-1
FOR Yarr=0 TO NumRows-1
READ BYTE 1,MazeArray(Xarr,Yarr)
NEXT Yarr
NEXT Xarr
CLOSE FILE 1
GOSUB RefreshMaze
RETURN
