Code archives/Algorithms/Pac Man Editor
This code has been declared by its author to be Public Domain code.
Download source code
| |||||
Design a level for Pac Man (also available in the code archives). The program will pre-calculate the path that the ghosts need to take back to the pen when chomped, and save that in bits 8-12, along with the walls and pill information (bits 0 to 7). You can save the map for reloading later, or export it as data statements for inclusion in the game. Draw lines with the LMB to define where the walls are - RMB to delete. Left-click on a pill to change its type. Middle-mouse button to view the hex value (in the DebugLog) of the square clicked on. Won't allow you to put walls or pills where they shouldn't be - or erase permanent walls. Takes about a minute to design a level. | |||||
;Harlequin Software 2007 ;Design a level for Pac Man, which pre-calculates the path that ;ghosts must take to get back to the ghost pen after being ;chomped. Const SAVEFILE$="PacLevel.dat" Const DATANAME$="PacLevel.txt" ;compass directions serve 2 purposes ;1. the bit set in an array element means there is a wall there ;2. they indicate ghosts and pac man's direction Const NORTH=1, EAST=2, SOUTH=4, WEST=8 ;ghost pen bit - so ghost knows it's home, and pill bits Const GHOSTPEN=$10, PILL=$20, POWERPILL=$40, ABOVEPEN=$80 Const ANY_PILLS=$60 ;NOT directions so can lose walls if user erases them by ANDing with array element Const NOT_NORTH=$FFFFFE, NOT_EAST=$FFFFFD, NOT_SOUTH=$FFFFFB, NOT_WEST=$FFFFF7 ;diagonal directions so can draw a pixel in corner if no walls Const NORTHEAST=$3, SOUTHEAST=$6, SOUTHWEST=$C, NORTHWEST=$9 ;bits set in array elements as directions for ghost to get back to pen Const PEN_NORTH = NORTH Shl 8 Const PEN_EAST = EAST Shl 8 Const PEN_SOUTH = SOUTH Shl 8 Const PEN_WEST = WEST Shl 8 ;PAVED to test if any of above bits set - so don't need to set if there is ;NOT_PAVED to clear above bits Const PAVED=$F00, NOT_PAVED=$FFF0FF ;LOCED walls - ghost pen and outer edges of level - so user can't change Const NORTH_LOCKED = NORTH Shl 12 Const EAST_LOCKED = EAST Shl 12 Const SOUTH_LOCKED = SOUTH Shl 12 Const WEST_LOCKED = WEST Shl 12 ;warp - bit set to indicate off screen through exit Const WARP=$10000 ;illegal - bit set to indicte array element outside level, and not WARP Const ILLEGAL=$20000 ;these next few just speed up the ghost pen pathfinding ;when checking to see whether to make an adjacent square ;point to the current square we need to know: ;1. is there a wall between the two squares ;2. is the square already paved ;3. is the square outside the level ;e.g. If (level(x+1,y) and WESTorPAVEDorILLEGAL)=false - then make it point to x,y etc. Const NORTHorPAVEDorILLEGAL = NORTH Or PAVED Or ILLEGAL Const EASTorPAVEDorILLEGAL = EAST Or PAVED Or ILLEGAL Const SOUTHorPAVEDorILLEGAL = SOUTH Or PAVED Or ILLEGAL Const WESTorPAVEDorILLEGAL = WEST Or PAVED Or ILLEGAL ;this one is for when you try to change a pill - not allowed in these ;if Not(level(x,y) and GHOSTPENorILLEGALorWARP) then can change pill type Const GHOSTPENorILLEGALorWARP = GHOSTPEN Or ILLEGAL Or WARP ;----------------------------------------------------- Const QUIT=1, RESTART=2, DONE=4 Const FINISHED=QUIT Or RESTART ;for checksum in save file Const RANDLOW=$1234, RANDHIGH=$56789ABC ;keys Const F1=59, F2=60, F3=61, XKEY=45, YKEY=21, F10=68 ;cursor colour when line drawing Const WHITE=0, GREEN=1, RED=2 Global action, pills_on, Xsymmetry_on, Ysymmetry_on Global mx, my, omx, omy Global mbutton, redraw AppTitle "Pac Man Editor" Graphics 384,320 Global pills=CreateImage(8,8,2) Global cursor=CreateImage(8,8,3) Type square ;used for flood-filling paths used by ghosts to get back to Field x, y, count ;ghost pen after being chomped End Type Dim level(11,9) Dim help$(6) Restore helpstrings For action=0 To 6 Read help$(action) Next create_tiles() SetBuffer BackBuffer() Xsymmetry_on=True: Ysymmetry_on=False load_level() Repeat pills_on=False: mbutton=False: action=False: redraw=True mx=MouseX(): my=MouseY() Repeat Delay 1 If (mx <> MouseX()) Or (my <> MouseY()) mx = MouseX(): my = MouseY() If ((mx And $1E0) <> omx) Or ((my And $1E0) <> omy) omx=mx And $1E0: omy=my And $1E0 redraw=True EndIf EndIf If MouseHit(1) Then mbutton=1 If MouseHit(2) Then mbutton=2 If MouseHit(3) Then DebugLog Hex$(level(mx Shr 5,my Shr 5)) If mbutton If pills_on If mbutton=1 Then do_pills(omx Shr 5, omy Shr 5) Else do_walls() EndIf redraw=True mbutton=False EndIf If KeyHit(XKEY) Then Xsymmetry_on=Not(Xsymmetry_on): redraw=True If KeyHit(YKEY) Then Ysymmetry_on=Not(Ysymmetry_on): redraw=True If KeyHit(F1) Then pills_on=Not(pills_on): redraw=True If redraw draw_level() DrawImage cursor, (omx-4)+(pills_on Shl 4), (omy-4)+(pills_on Shl 4),WHITE Flip False redraw=False EndIf If KeyHit(F2) Then save_level() If KeyHit(F3) Then export_level() If KeyHit(F10) Then action=RESTART If KeyHit(QUIT) Then action=QUIT Until action And FINISHED If action<>QUIT Then setup_array() Until action = QUIT End ;#################################### Function create_tiles() SetBuffer ImageBuffer(pills,0) Color 128,255,128 Oval 2,2,4,4,True SetBuffer ImageBuffer(pills,1) Color 255,128,128 Oval 0,0,8,8,True SetBuffer ImageBuffer(cursor,WHITE) Color 255,255,255 Rect 0,0,8,8,False SetBuffer ImageBuffer(cursor,GREEN) Color 0,255,0 Rect 0,0,8,8,False SetBuffer ImageBuffer(cursor,RED) Color 255,0,0 Rect 0,0,8,8,False Return End Function ;#################################### Function do_paths() Local x, y, numsquares action=0 For y=0 To 9 For x=0 To 11 level(x,y)=level(x,y) And NOT_PAVED Next Next level(5,3)=level(5,3) Or PEN_EAST level(6,3)=level(6,3) Or PEN_WEST squares.square=New square squares\x=5 squares\y=3 squares.square=New square squares\x=6 squares\y=3 numsquares=2 Repeat squares.square=First square x=squares\x: y=squares\y Delete squares numsquares=numsquares-1 ;test square above this one If (level(x,y-1) And SOUTHorPAVEDorILLEGAL)=False level(x,y-1)=level(x,y-1) Or PEN_SOUTH squares.square=New square squares\x=x squares\y=y-1 numsquares=numsquares+1 EndIf ;test square to left of this one If x>0 If (level(x-1,y) And EASTorPAVEDorILLEGAL)=False level(x-1,y)=level(x-1,y) Or PEN_EAST squares.square=New square squares\x=x-1 squares\y=y numsquares=numsquares+1 EndIf Else If level(x,y) And WARP If (level(11,4) And PAVED)=False level(11,4)=level(11,4) Or PEN_EAST squares.square=New square squares\x=11 squares\y=4 numsquares=numsquares+1 EndIf EndIf EndIf ;test square below this one If (level(x,y+1) And NORTHorPAVEDorILLEGAL)=False level(x,y+1)=level(x,y+1) Or PEN_NORTH squares.square=New square squares\x=x squares\y=y+1 numsquares=numsquares+1 EndIf ;test square to right of this one If x<11 If (level(x+1,y) And WESTorPAVEDorILLEGAL)=False level(x+1,y)=level(x+1,y) Or PEN_WEST squares.square=New square squares\x=x+1 squares\y=y numsquares=numsquares+1 EndIf Else If level(x,y) And WARP If (level(0,4) And PAVED)=False level(0,4)=level(0,4) Or PEN_WEST squares.square=New square squares\x=0 squares\y=4 numsquares=numsquares+1 EndIf EndIf EndIf If numsquares=0 Then action=DONE If KeyHit(QUIT) Then action=QUIT Until action And (DONE Or QUIT) If action=QUIT For squares.square=Each square Delete squares Next EndIf Return End Function ;#################################### Function do_pills(x, y) If Not( level(x, y) And GHOSTPENorILLEGALorWARP) level(x, y)=level(x, y) Xor ANY_PILLS If Xsymmetry_on Then level(11-x,y)=level(11-x,y) Xor ANY_PILLS If Ysymmetry_on Then level(x, 9-y)=level(x, 9-y) Xor ANY_PILLS If (Xsymmetry_on And Ysymmetry_on) Then level(11-x, 9-y)=level(11-x, 9-y) Xor ANY_PILLS EndIf Return End Function ;#################################### Function do_walls() Local startx, starty, mouseover If (omx<32) Or (omy<32) Or (omx>352) Or (omy>288) Then Return mouseover=True DrawBlock cursor, omx-4, omy-4,mbutton Flip False startx=omx: starty=omy Repeat Delay 1 If (mx <> MouseX()) Or (my <> MouseY()) mx=MouseX(): my=MouseY() If ((mx And $FE0) <> omx) Or ((my And $FE0) <> omy) draw_level() omx=mx And $FE0: omy=my And $FE0 If (omx>31) And (omx<384) And (omy>31) And (omy<320) DrawBlock cursor, startx-4, starty-4,mbutton DrawBlock cursor, omx-4, omy-4,mbutton If (startx<>omx) Or (starty<>omy) If (startx=omx) Or (starty=omy) Color (mbutton=2) * 255,(mbutton=1) * 255,0 Line startx,starty,omx,omy EndIf EndIf Flip False mouseover=True Else Flip False mouseover=False EndIf EndIf EndIf Until Not(MouseDown(mbutton)) If mouseover If (startx<>omx) Or (starty<>omy) If (startx=omx) Or (starty=omy) update_level(startx Shr 5, omx Shr 5, starty Shr 5, omy Shr 5) If Xsymmetry_on Then update_level(12-(startx Shr 5), 12-(omx Shr 5), starty Shr 5, omy Shr 5) If Ysymmetry_on Then update_level(startx Shr 5, omx Shr 5, 10-(starty Shr 5), 10-(omy Shr 5)) If Xsymmetry_on And Ysymmetry_on update_level(12-(startx Shr 5), 12-(omx Shr 5), 10-(starty Shr 5), 10-(omy Shr 5)) EndIf EndIf EndIf EndIf Return End Function ;#################################### Function draw_level() Local x, y, tile, xpos, ypos Cls Color 255,255,255 Text 4,0,help$(pills_on) Text 4,290,help$(Xsymmetry_on + 3) Text 4,306,help$(Ysymmetry_on + 5) Text 4,14,help$(2) For y=1 To 8 ypos=y Shl 5 For x=0 To 11 tile=level(x,y) If Not(tile And ILLEGAL) xpos=x Shl 5 If tile And NORTH Then Line xpos,ypos,xpos+31,ypos If tile And EAST Then Line xpos+31,ypos,xpos+31,ypos+31 If tile And SOUTH Then Line xpos,ypos+31,xpos+31,ypos+31 If tile And WEST Then Line xpos,ypos,xpos,ypos+31 If Not(tile And NORTHEAST) Then WritePixel xpos+31,ypos,$FFFFFF If Not(tile And SOUTHEAST) Then WritePixel xpos+31,ypos+31,$FFFFFF If Not(tile And SOUTHWEST) Then WritePixel xpos,ypos+31,$FFFFFF If Not(tile And NORTHWEST) Then WritePixel xpos,ypos,$FFFFFF If pills_on If tile And ANY_PILLS Then DrawBlock pills,xpos+12,ypos+12,(tile Shr 6) And 1 EndIf EndIf Next Next Return End Function ;#################################### Function export_level() Local file, x, y, datastring$ do_paths() If map_ok() file=WriteFile(DATANAME$) If file WriteLine file,"REMEMBER TO CHANGE NUM_MAPS CONSTANT IN PAC MAN" For y=0 To 9 datastring$="Data $" For x=0 To 11 datastring$=datastring$+Right$(Hex$((level(x,y) And $F0FFF)),5) If x<11 Then datastring$=datastring$+",$" Next WriteLine file,datastring$ Next CloseFile file Notify "Level exported as data statements"+Chr$(13)+Chr$(10)+"to PacLevel.txt" Else Notify "Couldn't save text file" EndIf Else Notify "All pills must be accessible by Pac Man" EndIf Return End Function ;#################################### Function load_level() Local checksum ,x ,y, file, randnum checksum=0 file=ReadFile(SAVEFILE$) If file For y=0 To 9 For x=0 To 11 level(x,y)=ReadInt(file) Next Next randnum=ReadInt(file) CloseFile file For y=0 To 9 For x=0 To 11 checksum=checksum Xor level(x,y) Next Next SeedRnd checksum checksum=Rand(RANDLOW,RANDHIGH) If checksum<>randnum Then RuntimeError "Checksum Error in file" Else setup_array() EndIf Return End Function ;#################################### Function map_ok() Local x, y, notpavedcount notpavedcount=-2 ;for 2 ghostpen squares For y=1 To 8 For x=1 To 10 If Not(level(x,y) And PAVED) Then notpavedcount=notpavedcount+1 Next Next Return notpavedcount=0 End Function ;#################################### Function save_level() Local file, x, y, checksum file=WriteFile(SAVEFILE$) If file checksum=0 For y=0 To 9 For x=0 To 11 checksum=checksum Xor level(x,y) WriteInt file,level(x,y) Next Next SeedRnd checksum checksum=Rand(RANDLOW,RANDHIGH) WriteInt file,checksum CloseFile file Notify "Level saved - will be reloaded"+Chr$(13)+Chr$(10)+"on next startup" Else Notify "Couldn't save level" EndIf Return End Function ;#################################### Function setup_array() Local x, y Restore startlevel For y=0 To 9 For x=0 To 11 Read level(x,y) Next Next Return End Function ;#################################### Function update_level(sx, fx, sy, fy) Local row, column, x1, y1, x2, y2 If sx > fx Then x1=fx: x2=sx Else x1=sx: x2=fx If sy > fy Then y1=fy: y2=sy Else y1=sy: y2=fy If mbutton=1 If x1=x2 For row=y1 To y2-1 If Not(level(x1-1,row) And EAST_LOCKED) Then level(x1-1,row)=level(x1-1,row) Or EAST If Not(level(x1,row) And WEST_LOCKED) Then level(x1,row)=level(x1,row) Or WEST Next Else For column=x1 To x2-1 If Not(level(column,y1-1) And SOUTH_LOCKED) Then level(column,y1-1)=level(column,y1-1) Or SOUTH If Not(level(column,y1) And NORTH_LOCKED) Then level(column,y1)=level(column,y1) Or NORTH Next EndIf Else If x1=x2 For row=y1 To y2-1 If Not(level(x1-1,row) And EAST_LOCKED) Then level(x1-1,row)=level(x1-1,row) And NOT_EAST If Not(level(x1,row) And WEST_LOCKED) Then level(x1,row)=level(x1,row) And NOT_WEST Next Else For column=x1 To x2-1 If Not(level(column,y1-1) And SOUTH_LOCKED) Then level(column,y1-1)=level(column,y1-1) And NOT_SOUTH If Not(level(column,y1) And NORTH_LOCKED) Then level(column,y1)=level(column,y1) And NOT_NORTH Next EndIf EndIf Return End Function ;#################################### .startlevel ;individual hex digits read from right to left ;1. Walls (1=N, 2=E, 4=S, 8=W) ;2. Ghostpen or pills (1=GP, 2=Pill, 4=Power Pill) ;3. Directions for ghost to get back to pen (1=N, 2=E, 4=S, 8=W) - only the two squares above pen set at start ;4. Walls LOCKED - can't be drawn over/erased - (1=N, 2=E, 4=S, 8=W) - not exported in data statements ;5. These indicate array element is off edges of level (1=WARP, 2=ILLEGAL) Data $20000,$20000,$20000,$20000,$20000,$20000,$20000,$20000,$20000,$20000,$20000,$20000 Data $20000,$9049,$1021,$1021,$1021,$1021,$1021,$1021,$1021,$1021,$3043,$20000 Data $20000,$8028,$0020,$0020,$0020,$0020,$0020,$0020,$0020,$0020,$2022,$20000 Data $20000,$8028,$0020,$0020,$0020,$64A4,$C4A4,$0020,$0020,$0020,$2022,$20000 Data $1F00D,$8020,$0020,$0020,$2022,$F01D,$F017,$8028,$0020,$0020,$2020,$1F007 Data $20000,$8028,$0020,$0020,$0020,$3021,$9021,$0020,$0020,$0020,$2022,$20000 Data $20000,$8028,$0020,$0020,$0020,$0020,$0020,$0020,$0020,$0020,$2022,$20000 Data $20000,$8028,$0020,$0020,$0020,$0020,$0020,$0020,$0020,$0020,$2022,$20000 Data $20000,$C04C,$4024,$4024,$4024,$4024,$4024,$4024,$4024,$4024,$6046,$20000 Data $20000,$20000,$20000,$20000,$20000,$20000,$20000,$20000,$20000,$20000,$20000,$20000 .helpstrings Data "LMB - Draw RMB - Erase F1 Switch to pills" Data "LMB - Change pill-type F1 Switch to walls" Data "F2 Save for reloading F3 Export Data as Txt" Data "X-symmetry OFF (press X)" Data "X-symmetry ON (press X)" Data "Y-symmetry OFF (press Y) F10 - Restart" Data "Y-symmetry ON (press Y) F10 - Restart" |
Comments
None.
Code Archives Forum