Created a nice software using SpiderBasic ? Post you link here !
User avatar
Charlie
 
Posts: 46
Joined: Thu Jan 10, 2019 1:54 am
Location: New Brunswick, Canada

A Mazing Program (now "printable" + "playable")

by Charlie Fri Jan 10, 2020 4:17 am

2020-01-17 Update:
  • basic printing of maze
  • basic playing of maze (move the dot with cursor keys)
----
G'day,

Very humble beginning, not particularly fancy, but I'm still finding it pretty cool: A Mazing Program, hosted on Neocities.

I had intended on building a SpiderBasic version of the vintage game amazing.bas ("amazing program"), but I quickly got frazzled by the GOTO's in that old code. Although impressed by what had been done, I just could not handle all the jumping around.

Searching the web, I found out about the Randomized Prim's algorithm (Wikipedia), but I didn't really understand the algorithm until I looked over the example and the two demos in Maze Generation: Prim's Algorithm, an old blog entry on "The Bucklog, assorted ramblings by Jamis Buck."

At the moment, I'm just using unicode block characters to build a maze in an Editor Gadget. I'm surprised at how fast that is.

I hope to get something fancy working, i.e.: full-screen maze that can be printed and, maybe, ability to "play" the maze on screen. Not sure if I have the stomach for it, but I might be tempted to also setup some kind of "video game" out of it. Might be a fun way to figure out Sprites.

Anyway, all of that aside, here's the messy starting source code for anybody interested:

Code: Select all

Global.i gAbout, gMain, gTip, gBuildMaze1, gBuildMaze2, gMaze, gFullScreen

Enumeration
    #BLANK
    #VISITED_CELL
    #CELL
    #PathCell
    #FrontierCell
    #FAKE
    #WALL
    #MAZE
EndEnumeration


Procedure CloseWindowHandler()
  CloseWindow(EventWindow())
  EndProcedure
 
  Procedure BuildMaze2()
    EndProcedure
 
Procedure ButtonHandler()
 
  Select EventGadget()
    Case gBuildMaze1
      DisableGadget(gBuildMaze1, 1)
      SetGadgetText(gMaze, "")
      gMazeHold = gMaze
      nWidth = 43
      nHeight = 22
      Dim nGridArray.i(nWidth+1, nHeight+1)
     
      ; FIRST: BUILD THE GRID
      For X = 1 To nWidth
        For Y = 1 To nHeight
          nGridArray(X,Y) = #BLANK
        Next Y
      Next
      temp1.f = Random(nWidth-1,2) / 2
      temp2.i = Round(temp1,#PB_Round_Down)*2
      nGridArray(temp2, 1) = #PathCell
     
      X = temp2
      Y = 2
      nGridArray(X, Y) = #PathCell
      Structure WallLoc
        X.i
        Y.i
      EndStructure
      NewList FrontierCellList.WallLoc()
      If X > 2
        AddElement(FrontierCellList())
        FrontierCellList()\X = X-2
        FrontierCellList()\Y = Y
        nGridArray(FrontierCellList()\X, FrontierCellList()\Y) = #FrontierCell
      EndIf
      AddElement(FrontierCellList())
      FrontierCellList()\X = X
      FrontierCellList()\Y = Y+2   
      nGridArray(FrontierCellList()\X, FrontierCellList()\Y) = #FrontierCell
      If X < nWidth - 2
        AddElement(FrontierCellList())
        FrontierCellList()\X = X+2
        FrontierCellList()\Y = Y
        nGridArray(FrontierCellList()\X, FrontierCellList()\Y) = #FrontierCell
      EndIf
     
      T = 0
      While ListSize(FrontierCellList()) > 0 And T < 1000
        SetGadgetText(gMaze, GetGadgetText(gMaze) + ".")
        ThisFrontierCell = Random(ListSize(FrontierCellList())-1, 0)
        SelectElement(FrontierCellList(), ThisFrontierCell)
        ThisX = FrontierCellList()\X : ThisY = FrontierCellList()\Y
       
        nGridArray(ThisX, ThisY) = #PathCell
        If ThisX > 2  And nGridArray(ThisX-2, ThisY) = #BLANK
          AddElement(FrontierCellList())
          FrontierCellList()\X = ThisX-2  :  FrontierCellList()\Y = ThisY
          nGridArray(FrontierCellList()\X, FrontierCellList()\Y) = #FrontierCell
        EndIf
        If ThisX < nWidth - 2  And nGridArray(ThisX+2, ThisY) = #BLANK
          AddElement(FrontierCellList())
          FrontierCellList()\X = ThisX+2  :  FrontierCellList()\Y = ThisY
          nGridArray(FrontierCellList()\X, FrontierCellList()\Y) = #FrontierCell
        EndIf
        If Y > 2  And nGridArray(ThisX, ThisY-2) = #BLANK
          AddElement(FrontierCellList())
          FrontierCellList()\X = ThisX    :  FrontierCellList()\Y = ThisY-2
          nGridArray(FrontierCellList()\X, FrontierCellList()\Y) = #FrontierCell
        EndIf
        If Y < nWidth - 2  And nGridArray(ThisX, ThisY+2) = #BLANK
          AddElement(FrontierCellList())
          FrontierCellList()\X = ThisX    :  FrontierCellList()\Y = ThisY+2
          nGridArray(FrontierCellList()\X, FrontierCellList()\Y) = #FrontierCell
        EndIf
 ;       Debug "Current Wall " + ThisFrontierCell + " of " + ListSize(FrontierCellList())
       
        CHOICES$ = "1234"
        LoopCount = 0
        While Len(CHOICES$) > 0 And LoopCount < 4
          CHOICE$ = Mid(CHOICES$, Random(Len(CHOICES$),1), 1)
          If CHOICE$ = "1" And nGridArray(ThisX+2,ThisY) = #PathCell
            nGridArray(ThisX+1, ThisY) = #PathCell
            CHOICES$ = ""
          ElseIf CHOICE$ = "2" And nGridArray(ThisX-2,ThisY) = #PathCell
            nGridArray(ThisX-1, ThisY) = #PathCell
            CHOICES$ = ""
          ElseIf CHOICE$ = "3" And nGridArray(ThisX,ThisY+2) = #PathCell
            nGridArray(ThisX, ThisY+1) = #PathCell
            CHOICES$ = ""
          ElseIf CHOICE$ = "4" And nGridArray(ThisX,ThisY-2) = #PathCell
            nGridArray(ThisX, ThisY-1) = #PathCell
            CHOICES$ = ""
          Else
            CHOICES$ = RemoveString(CHOICES$, CHOICE$)
          EndIf
          LoopCount = LoopCount + 1
        Wend
          nGridArray(ThisX, ThisY) = #PathCell
        SelectElement(FrontierCellList(), ThisFrontierCell)
        DeleteElement(FrontierCellList())
        T = T + 1
      Wend
      Debug "T=" + T
      FreeList(FrontierCellList())
      SetGadgetText(gMaze, "")
      For Y = 1 To nHeight
        For X = 1 To nWidth
          If nGridArray(X,Y) = #CELL
            MazeSpot$ = "C"
          ElseIf nGridArray(X,Y) = #VISITED_CELL
            MazeSpot$ = "V"
          ElseIf nGridArray(X,Y) = #PathCell
            MazeSpot$ = " "
          ElseIf nGridArray(X,Y) = #WALL
            MazeSpot$ = "█"
          ElseIf nGridArray(X,Y) = #BLANK
            MazeSpot$ = "█"
          ElseIf nGridArray(X,Y) = #FrontierCell
            MazeSpot$ = "f"
          Else
            MazeSpot$ = "?"
          EndIf
          SetGadgetText(gMaze, GetGadgetText(gMaze) + MazeSpot$)
        Next
        If Y < nHeight
          SetGadgetText(gMaze, GetGadgetText(gMaze) + Chr(10))
        EndIf
      Next
      SetGadgetText(gMaze, GetGadgetText(gMaze) + Chr(10) + RSet("", nWidth, "█"))
      gMaze = gMazeHold
      DisableGadget(gBuildMaze1, 0)
     
    Case gAbout
      OpenWindow(#PB_Any, 0, 0, 700, 600, "About Amazing Program.SB", #PB_Window_ScreenCentered )
      WebGadget(#PB_Any, 1, 1, 698, 598, "https://forums.spiderbasic.com/viewtopic.php?f=12&t=1805")
    EndSelect
   
EndProcedure

Procedure DesktopSizeHandler()
 
  ResizeWindow(gMain, 1, 1, #PB_Ignore, #PB_Ignore)
 
EndProcedure

Q=100

gMain = OpenWindow(#PB_Any, 0, 0, 380, 710, "Amazing Program.SB", #PB_Window_ScreenCentered )

gAbout = ButtonGadget(#PB_Any, 10, 05, 360, 20, "ABOUT (click for more info)")
GadgetToolTip(gAbout, "SpiderBasic version, by CJ Veniot, of the vintage BASIC game.")
TextGadget(#PB_Any, 10, 30, 360, 20, "AMAZING PROGRAM", #PB_Text_Center)
TextGadget(#PB_Any, 10, 50, 360, 20, "CREATIVE COMPUTING  MORRISTOWN, NEW JERSEY", #PB_Text_Center)


;TextGadget(#PB_Any, 10, 120, 60, 50, "WIDTH:", #PB_Text_VerticalCenter)
;TextGadget(#PB_Any, 190, 120, 60, 50, "Height:", #PB_Text_VerticalCenter)

gBuildMaze1 = ButtonGadget(#PB_Any, 10, 190, 160, 50, "Tiny Maze")
;gBuildMaze2 = ButtonGadget(#PB_Any, 210, 190, 160, 50, "Big Maze")

gMaze = EditorGadget(#PB_Any, 10, 250, 360, 360, #PB_Editor_ReadOnly)

gTip = TextGadget(#PB_Any, 0, 625, 380, 90, "Should you find this app worth a tiny tip, please click on the link below and thank-you very much for your support !", #PB_Text_Center)
SetGadgetColor(gTip, #PB_Gadget_BackColor, RGB(100, 100, 100))
SetGadgetColor(gTip, #PB_Gadget_FrontColor, RGB(255, 255, 255))
gTip = WebGadget(#PB_Any, 110, 658, 160, 45, "https://cjveniot.neocities.org/SB/tip_link.html")
SetGadgetColor(gTip, #PB_Gadget_BackColor, RGB(255, 255, 255))

LoadFont(0, "arial", 18, #PB_Font_Bold)
SetGadgetFont(gBuildMaze1, FontID(0))

BindGadgetEvent(gBuildMaze1, @ButtonHandler())
BindGadgetEvent(gAbout, @ButtonHandler())
BindEvent(#PB_Event_SizeDesktop, @DesktopSizeHandler() )
BindEvent(#PB_Event_CloseWindow, @CloseWindowHandler())

Last edited by Charlie on Sat Jan 18, 2020 3:03 am, edited 3 times in total.
Huge fan of SpiderBasic, and very passionate about these other personal projects:
Dirk Geppert
 
Posts: 180
Joined: Fri Sep 22, 2017 7:02 am

Re: A Mazing Program

by Dirk Geppert Fri Jan 10, 2020 7:53 am

Hi, Charlie, interesting example. Thanks for that. I'm curious to see what else you make of it. :)

Ciao Dirk
User avatar
Charlie
 
Posts: 46
Joined: Thu Jan 10, 2019 1:54 am
Location: New Brunswick, Canada

Re: A Mazing Program

by Charlie Tue Jan 14, 2020 3:06 am

A Mazing Program, hosted on Neocities.

New version is still clunky, but allows building really big "ascii-blocks-based" mazes for printing.

Next, re-organize/modularize my code so that same code can handle "ascii-blocks-based" and canvas-drawing mazes for printing.

Good times !
Huge fan of SpiderBasic, and very passionate about these other personal projects:
User avatar
Charlie
 
Posts: 46
Joined: Thu Jan 10, 2019 1:54 am
Location: New Brunswick, Canada

Re: A Mazing Program (now "playable")

by Charlie Sat Jan 18, 2020 2:15 am

Decided to hold-off on pretty maze creation (canvas drawing, sprites), and instead focused on making the mazes (at whatever size) somewhat printable.

I also wanted to setup very basic play of the maze by moving a dot with cursor keys.

I'm thinking next on the menu: show the maze progressively as travelling around. Good times !
Huge fan of SpiderBasic, and very passionate about these other personal projects:
Return to Showcase

Who is online

Users browsing this forum: No registered users and 2 guests