Home
JAQForum Ver 20.06
Log In or Join  
Active Topics
Local Time 16:43 29 Mar 2024 Privacy Policy
Jump to

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: Germany
Posts: 871
Posted: 06:31am 01 Nov 2022
Copy link to clipboard 
Print this post

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: Germany
Posts: 367
Posted: 02:49pm 01 Nov 2022
Copy link to clipboard 
Print this post

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 Kingdom
Posts: 1567
Posted: 03:03pm 01 Nov 2022
Copy link to clipboard 
Print this post

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: Germany
Posts: 871
Posted: 03:40pm 01 Nov 2022
Copy link to clipboard 
Print this post

  stanleyella said  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.

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: Germany
Posts: 871
Posted: 04:16pm 01 Nov 2022
Copy link to clipboard 
Print this post

  Amnesie said  Really impressive! Tested this a few minutes ago. Every time inspiring what can be done with BASIC on the pico! :)

Greetings
Daniel

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: Germany
Posts: 500
Posted: 04:40pm 01 Nov 2022
Copy link to clipboard 
Print this post

Like it
Plasma
 
Mixtel90

Guru

Joined: 05/10/2019
Location: United Kingdom
Posts: 5648
Posted: 04:48pm 01 Nov 2022
Copy link to clipboard 
Print this post

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 Kingdom
Posts: 1567
Posted: 06:21pm 01 Nov 2022
Copy link to clipboard 
Print this post

I get
RUN
[26] generatorcc
Error : Unknown command
>
 
Martin H.

Guru

Joined: 04/06/2022
Location: Germany
Posts: 871
Posted: 06:31pm 01 Nov 2022
Copy link to clipboard 
Print this post

  stanleyella said  I get
RUN
[26] generatorcc
Error : Unknown command
>

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 Kingdom
Posts: 1567
Posted: 07:18pm 01 Nov 2022
Copy link to clipboard 
Print this post

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 Kingdom
Posts: 1567
Posted: 07:40pm 01 Nov 2022
Copy link to clipboard 
Print this post

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: Netherlands
Posts: 3422
Posted: 08:19pm 01 Nov 2022
Copy link to clipboard 
Print this post

Martin,

This is great stuff....

Volhout
PicomiteVGA PETSCII ROBOTS
 
stanleyella

Guru

Joined: 25/06/2022
Location: United Kingdom
Posts: 1567
Posted: 08:38pm 01 Nov 2022
Copy link to clipboard 
Print this post

  Volhout said  Martin,

This is great stuff....

Volhout

True. Someone into graphics.
 
TassyJim

Guru

Joined: 07/08/2011
Location: Australia
Posts: 5867
Posted: 08:50pm 01 Nov 2022
Copy link to clipboard 
Print this post

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
  Quote  I had to remove 'OPTION EXPLICIT to get your code to run.

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   MMBasic Help
 
Martin H.

Guru

Joined: 04/06/2022
Location: Germany
Posts: 871
Posted: 04:43am 02 Nov 2022
Copy link to clipboard 
Print this post

  TassyJim said  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.

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 Kingdom
Posts: 3641
Posted: 07:43am 02 Nov 2022
Copy link to clipboard 
Print this post

  Martin H. said  the first Endif  belongs to the Else if statement,
The second belongs to the enclosing IF query

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: Germany
Posts: 871
Posted: 07:54am 02 Nov 2022
Copy link to clipboard 
Print this post

  Mixtel90 said  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.


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 Kingdom
Posts: 5648
Posted: 08:11am 02 Nov 2022
Copy link to clipboard 
Print this post

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: Australia
Posts: 5867
Posted: 08:50am 02 Nov 2022
Copy link to clipboard 
Print this post

  JohnS said  
It looks like the code has
ElseIf
where it should be
Else If

John


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   MMBasic Help
 
Martin H.

Guru

Joined: 04/06/2022
Location: Germany
Posts: 871
Posted: 08:54am 02 Nov 2022
Copy link to clipboard 
Print this post

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
© JAQ Software 2024