 Notice. New forum software under development. It's going to miss a few functions and look a bit ugly for a while, but I'm working on it full time now as the old forum was too unstable. Couple days, all good. If you notice any issues, please contact me. |
Forum Index : Microcontroller and PC projects : Come in and find out
Page 1 of 3   |
|||||
| Author | Message | ||||
Martin H. Guru  Joined: 04/06/2022 Location: GermanyPosts: 1193 |
PicoMite 3D Maze My little weekend project also for ILI9341 LCDPANEL all thats missing is the Monster   'Maze Game by Mart!n Herhaus 2022 'Init, switch to 16 Col 320x240 Screen If MM.Device$="PicoMiteVGA" Then MODE 2:Font 1 cw%=RGB(white):WallC1%=0:WallC2%=RGB(RED):cP%=RGB(green) 'Read the XY-Coordinates of the Wall Elements Corners Dim Wall%(6,4,2) For N%=0 To 5 'Walls For C%=0 To 3 '4 Corners For F%=0 To 1 '2 Coordinates (X,Y) Read Wall%(N%,C%,F%) Next Next Next MazeW%=24:MazeH%=24 ' create array and fill Dim Maze$(MazeW%,MazeH%) length 1 restart: For x% = 0 To MazeW% For y% = 0 To MazeH% Maze$(x%, y%) = "#" Next :Next 'generate random Maze generator MovDir$=Chr$(146)+Chr$(148)+Chr$(147)+Chr$(149) Map%=0:CLS cw% 'place Player PlrX%=MazeW%-1:PlrY%=MazeH%-1:PD%=3 'place Exit Ex_X%=2:Ex_Y%=0:If Maze$(Ex_X%,1)="#" Then Inc Ex_X% Maze$(Ex_X%,Ex_Y%)="E" If map% Then Box 243+Ex_X%*3,3+Ex_Y%*3,3,3,,WallC2%,WallC2% Colour 0,cw% Text 244,98,"D X Y" Text 244,130,"KEYS:" Text 244,140,"W:FORWARD" Text 244,150,"A:TURN L." Text 244,160,"D:TURN R." Text 244,190,"M:SHOW/ " Text 244,204," HIDE MAP" ' --- Game Loop --- Do Text 244,110,Mid$(MovDir$,PD%+1,1)+" "+Str$(PlrX%)+" "+Str$(PlrY%)+" " Draw_3D Select Case PD% Case 0:XS%=0 :YS%=-1 Case 1:XS%=1 :YS%=0 Case 2:XS%=0 :YS%=1 Case 3:XS%=-1:YS%=0 End Select If map% Then Box 243+PlrX%*3,3+PlrY%*3,3,3,,cp%,cp% Key$="" Do :Key$=Inkey$:Loop While Key$="" Key$=UCase$(Key$) Select Case Key$ Case "A" Inc PD%,-1:Inc PD%,4*(PD%=-1) Case "D" Inc PD%:PD%=PD% And 3 Case "W" OX%=PlrX%:OY%=PlrY% Inc PlrX%,XS%:Inc PlrY%,YS% If Maze$(PlrX%,PlrY%)="#" Then PlrX%=OX%:PlrY%=OY% If Map% Then Box 243+ox%*3,3+oy%*3,3,3,,cw%,cw% Case "M" Map%=1*(Map%=0) If Map% Then Box 243,3,76,76,,cw%,cw% Show_Maze Box 243+Ex_X%*3,3+Ex_Y%*3,3,3,,255.255 Else Box 243,3,76,76,,cw%,cw% EndIf End Select If PlrX%=Ex_X% And PlrY%=Ex_Y% Then Exit Loop Text 64,50,Chr$(151)+" WELL DONE! "+Chr$(151) Text 60,85,"PRESS Q TO QUIT" Text 60,105,"OR ANY OTHER KEY" Text 60,115," TO TRY ANOTHER" Text 64,125," MAZE" Do :Key$=Inkey$:Loop While Key$="" If Key$="q" Then CLS 0:End GoTo restart '---------------------------- Sub draw_3d Box 0,0,241,240,,cw%,cw% Select Case PD% Case 0 For f%=0 To 5 If PlrY%-f%<0 Then Exit For If Maze$(PlrX%-1,PlrY%-f%)="#" Then Draw_Element f%,0,0 Else Draw_Element f%,0,1 If Maze$(PlrX%+1,PlrY%-f%)="#" Then Draw_Element f%,1,0 Else Draw_Element f%,1,1 If Maze$(PlrX%,PlrY%-f%)="#" Then Draw_Element f%,1,2:Exit For Next f% Case 1 For f%=0 To 5 If PlrX%+f%>MazeW% Then Exit For If Maze$(PlrX%+f%,PlrY%-1)="#" Then Draw_Element f%,0,0 Else Draw_Element f%,0,1 If Maze$(PlrX%+f%,PlrY%+1)="#" Then Draw_Element f%,1,0 Else Draw_Element f%,1,1 If Maze$(PlrX%+f%,PlrY%)="#" Then Draw_Element f%,1,2:Exit For Next f% Case 2 For f%=0 To 5 If PlrY%+f%>MazeH% Then Exit For If Maze$(PlrX%+1,PlrY%+f%)="#" Then Draw_Element f%,0,0 Else Draw_Element f%,0,1 If Maze$(PlrX%-1,PlrY%+f%)="#" Then Draw_Element f%,1,0 Else Draw_Element f%,1,1 If Maze$(PlrX%,PlrY%+f%)="#" Then Draw_Element f%,1,2:Exit For Next f% Case 3 For f%=0 To 5 If PlrX%-f%<0 Then Exit For If Maze$(PlrX%-f%,PlrY%+1)="#" Then Draw_Element f%,0,0 Else Draw_Element f%,0,1 If Maze$(PlrX%-f%,PlrY%-1)="#" Then Draw_Element f%,1,0 Else Draw_Element f%,1,1 If Maze$(PlrX%-f%,PlrY%)="#" Then Draw_Element f%,1,2:Exit For Next f% End Select End Sub 'draw the elements Sub Draw_Element nr%,mir%,Gap% Local x1%,y1%,x2%,y2%,x3%,y3%,x4%,y4% x1%=Wall%(nr%,0,0):y1%=Wall%(nr%,0,1) x2%=Wall%(nr%,1,0):y2%=Wall%(nr%,1,1) x3%=Wall%(nr%,2,0):y3%=Wall%(nr%,2,1) x4%=Wall%(nr%,3,0):y4%=Wall%(nr%,3,1) If mir% Then x1%=240-x1%:x2%=240-x2%:x3%=240-x3%:x4%=240-x4% WallC1%=RGB(0,64,0):WallC2%=RGB(0,128,0) If Not Gap% Then 'Wall Triangle x1%,y1%,x2%,y2%,x4%,y4%,WallC1%,WallC1% Triangle x1%,y1%,x3%,y3%,x4%,y4%,WallC1%,WallC1% ElseIf Gap%=1 Then 'Gap Triangle x1%,y3%,x3%,y3%,x4%,y4%,WallC2%,WallC2% Triangle x1%,y4%,x1%,y3%,x4%,y4%,WallC2%,WallC2% Else 'Blocker Triangle x1%,y1%,240-x1%,y1%,240-x1%,y2%,WallC2%,WallC2% Triangle x1%,y1%,240-x1%,y2%,x1%,y2%,WallC2%,WallC2% EndIf EndIf End Sub Sub show_maze For y% = 0 To MazeH% For x% = 0 To MazeW% If Maze$(x%,y%)="#" Then Box 243+x%*3,3+y%*3,3,3,,0,0 Next x% Next y% End Sub ' --- 2D Maze generator --- ' algorithmen based on ' https://rosettacode.org/wiki/Maze_generation#BASIC256 ' -------------------------- Sub generator Local done%,i%,CurX%,CurY%,OldX%,OldY%,x%,y% ' initial start location CurX%=Int(Rnd * (MazeW% - 1)) CurY%=Int(Rnd * (MazeH% - 1)) ' value must be odd If CurX% Mod 2=0 Then Inc CurX% If CurY% Mod 2=0 Then Inc CurY% Maze$(CurX%, CurY%) = " " ' generate maze done%=0 Do While done%=0 For i% = 0 To 99 OldX%=CurX% OldY%=CurY% ' move in random direction Select Case Int(Rnd*4) Case 0 If CurX%+2<MazeW% Then Inc CurX%,2 Case 1 If CurY%+2<MazeH% Then Inc CurY%,2 Case 2 If CurX%-2>0 Then Inc CurX%,-2 Case 3 If CurY%-2>0 Then Inc CurY%,-2 End Select ' if cell is unvisited then connect it If Maze$(CurX%,CurY%)="#" Then Maze$(CurX%,CurY%)=" " Maze$(Int((CurX%+OldX%)/2),((CurY%+OldY%)/2))=" " EndIf Next i% ' check if all cells are visited done%=1 For x%=1 To MazeW%-1 Step 2 For y%=1 To MazeH%-1 Step 2 If Maze$(x%,y%)="#" Then done%=0 Next y% Next x% Loop End Sub ' --- WallData --- Data 0,0,0,239,10,10,10,229 Data 11,11,11,228,50,50,50,189 Data 51,51,51,188,80,80,80,159 Data 81,81,81,158,100,100,100,139 Data 101,101,101,138,110,110,110,129 Data 111,111,111,128,120,120,120,120 Cheers Mart!n Edited 2022-11-01 23:31 by Martin H. 'no comment |
||||
| Amnesie Guru Joined: 30/06/2020 Location: GermanyPosts: 529 |
Really impressive! Tested this a few minutes ago. Every time inspiring what can be done with BASIC on the pico! :) Greetings Daniel |
||||
stanleyella Guru Joined: 25/06/2022 Location: United KingdomPosts: 2394 |
I have not tried to code this but it looks very good from your pictures. I would have thought filled triangles slow but maybe filled boxes, circles are optimised functions. nice job... remember comment everything to share. |
||||
| Martin H. Guru Joined: 04/06/2022 Location: GermanyPosts: 1193 |
I tested it also on an ILI9341 LCD. The only drawback is that the image of the labyrinth is a little to small for my old eyes on the 2.8 inch display this makes it hard to see the little green dot.  '----- Since the walls on the sides are trapezoidal, I can't use the box function (x1,Y1) ...... | ..... | ....(X3,Y3) | | | | | | | | | ....(X4,Y4) | ..... (X2,Y2) ...... I draw one triagngle connecting the Corners 1->3->4->1 and the second triangle 1->2->4->1 As I used the same for the Gaps and the Wall in Front because the parameters of the BOX command are different (X,Y,W,H). I didn't feel like converting the coordinates again  and the triagngle command is fast enough.  This isn't animation in the proper sense, so the refresh rate doesn't really matter. Cheers Mart!n Edited 2022-11-02 02:03 by Martin H. 'no comment |
||||
| Martin H. Guru Joined: 04/06/2022 Location: GermanyPosts: 1193 |
Hey Daniel, The Idea came after stanleyella posted a Screenshot of ZX81 3D MonsterMaze. This Program is more like the Listings in the 80th Computer-Magazines. Sadly I could'nt get Raycasting running yet But I've done it ~25 Years ago in GFA Basic on the Atari ST. Maybee I find my old SourceCode Greetings Mart!n Edited 2022-11-02 02:19 by Martin H. 'no comment |
||||
Plasmamac Guru Joined: 31/01/2019 Location: GermanyPosts: 572 |
Like it Plasma |
||||
Mixtel90 Guru Joined: 05/10/2019 Location: United KingdomPosts: 7515 |
Sheesh - I've just thrown out my copy of GFA BASIC for the ST. I had to get rid of a load of stuff quickly so there's a load of ST software (and some ball-type mice) at the bottom of a skip. Mick Zilog Inside! nascom.info for Nascom & Gemini Preliminary MMBasic docs & my PCB designs |
||||
| stanleyella Guru Joined: 25/06/2022 Location: United KingdomPosts: 2394 |
I get RUN [26] generatorcc Error : Unknown command > |
||||
| Martin H. Guru Joined: 04/06/2022 Location: GermanyPosts: 1193 |
there is no generatorcc in the Code abov.  Maybee you had some errors while Copy&Paste it or something you 've changed?  Line 23 (Not 26) calls the Sub, named generator but no"cc" in there.. so, I have no idea what went wrong Edited 2022-11-02 04:47 by Martin H. 'no comment |
||||
| stanleyella Guru Joined: 25/06/2022 Location: United KingdomPosts: 2394 |
It must be a copy from forum to mmedit. I get an image but no keyboard so will try touch to simulate keyboard. This is interesting.  |
||||
| stanleyella Guru Joined: 25/06/2022 Location: United KingdomPosts: 2394 |
I had to remove 'OPTION EXPLICIT to get your code to run. If I convert this to touch then maybe click on screen W:FORWARD A:TURN L Select Case Key$ Case "A" Inc PD%,-1:Inc PD%,4*(PD%=-1) Case "D" Inc PD%:PD%=PD% And 3 Case "W" OX%=PlrX%:OY%=PlrY% Inc PlrX%,XS%:Inc PlrY%,YS% If Maze$(PlrX%,PlrY%)="#" Then PlrX%=OX%:PlrY%=OY% If Map% Then Box 243+ox%*3,3+oy%*3,3,3,,cw%,cw% Case "M" Map%=1*(Map%=0) If Map% Then Box 243,3,76,76,,cw%,cw% Show_Maze Box 243+Ex_X%*3,3+Ex_Y%*3,3,3,,255.255 Else Box 243,3,76,76,,cw%,cw% EndIf End Select Edited 2022-11-02 05:42 by stanleyella |
||||
| Volhout Guru Joined: 05/03/2018 Location: NetherlandsPosts: 4857 |
Martin, This is great stuff.... Volhout PicomiteVGA PETSCII ROBOTS |
||||
| stanleyella Guru Joined: 25/06/2022 Location: United KingdomPosts: 2394 |
True. Someone into graphics. |
||||
TassyJim Guru Joined: 07/08/2011 Location: AustraliaPosts: 6221 |
For the little LCD, I find that "pink" is a better colour for the position marker. Still not easy to see. I also added the direction arrows to the movement keys. It's more what I am used to. Case "A",chr$(130) Inc PD%,-1:Inc PD%,4*(PD%=-1) Case "D",chr$(131) Inc PD%:PD%=PD% And 3 Case "W",chr$(128) I did find an extra Endif in the Draw_Element sub. Not causing a problem because it is at the end of the sub. @stan While OPTION EXPLICIT is strongly recommended (and why it is the default starting point for new files in MMEdit), you should start with what choice the originator when with. Jim VK7JH MMedit |
||||
| Martin H. Guru Joined: 04/06/2022 Location: GermanyPosts: 1193 |
Hi Jim, Good extension to add the Cursor Keys, I will add that  the first Endif belongs to the Else if statement, The second belongs to the enclosing IF query  but there is no particular reason why I solved it that way. You can also solve it with individual IF querys or use Select case. Mart!n Edited 2022-11-02 15:46 by Martin H. 'no comment |
||||
| JohnS Guru Joined: 18/11/2011 Location: United KingdomPosts: 3998 |
It looks like the code has ElseIf where it should be Else If Or, drop an EndIf John |
||||
| Martin H. Guru Joined: 04/06/2022 Location: GermanyPosts: 1193 |
When I moved from ST to PC, my Wife and I had most of the Programs and Files still just for ST,but the space on the desk was too small for 2 computers. So I had to copy the Atari ST HardDisk to the PC and used an Emulator to be able to continue use the programs. And when I built a new PC, the personal files were always copied to the new PC. It is thanks to this fortunate circumstance that I still have access to my old files. Edited 2022-11-02 17:58 by Martin H. 'no comment |
||||
| Mixtel90 Guru Joined: 05/10/2019 Location: United KingdomPosts: 7515 |
I no longer had my STFM and STe - they were lost due to smoke damage in a fire some years ago (they never came back from the cleaning company, along with quite a bit of other stuff). Consequently I couldn't use the software - I was just hanging onto it. I considered putting what was saleable on ebay but probably wouldn't have got much for it so not worth the hassle. I still have a couple of external floppy drives as I thought the cases might come in useful. Mick Zilog Inside! nascom.info for Nascom & Gemini Preliminary MMBasic docs & my PCB designs |
||||
| TassyJim Guru Joined: 07/08/2011 Location: AustraliaPosts: 6221 |
ELSE IF and ELSEIF are interchangeable in MMBasic you would need separate lines: ELSE IF for Martins extra ENDIF to be functional. Jim VK7JH MMedit |
||||
| Martin H. Guru Joined: 04/06/2022 Location: GermanyPosts: 1193 |
the oldest piece of my software that still exists in the world is a small demo from 1986. Little Dragon 32 Demo. After watching the video, I found, that the Programm was shared on a spanish PD Disk back then. However, there is no source code, because I assembled it on paper at that time 'no comment |
||||
| Page 1 of 3 |
|||||
 Print this page |
 |
The Back Shed's forum code is written, and hosted, in Australia. | © JAQ Software 2025 |
