Home
JAQForum Ver 24.01
Log In or Join  
Active Topics
Local Time 07:40 25 Nov 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 : On the Road again

     Page 2 of 4    
Author Message
Nimue

Guru

Joined: 06/08/2020
Location: United Kingdom
Posts: 367
Posted: 10:15am 13 Oct 2022
Copy link to clipboard 
Print this post

  Martin H. said  
That gives me the idea to write a "ASCII ART Version" for VT 100 Terminal.
Somehow ZX81 like but with Colors


Excited / inspired - but I dont need another side project battling with the day job ;-)

N
Entropy is not what it used to be
 
stanleyella

Guru

Joined: 25/06/2022
Location: United Kingdom
Posts: 2125
Posted: 01:48pm 13 Oct 2022
Copy link to clipboard 
Print this post

 
stanleyella

Guru

Joined: 25/06/2022
Location: United Kingdom
Posts: 2125
Posted: 02:43pm 13 Oct 2022
Copy link to clipboard 
Print this post

@ Martin H. char set for graphics? nostalgia?
 
Martin H.

Guru

Joined: 04/06/2022
Location: Germany
Posts: 1113
Posted: 03:17pm 13 Oct 2022
Copy link to clipboard 
Print this post

3D Monster Mace   ... The problem is, that on VT100, you have not charset with those "Quarterpixels" like the ZX 81 had
'no comment
 
Martin H.

Guru

Joined: 04/06/2022
Location: Germany
Posts: 1113
Posted: 03:33am 14 Oct 2022
Copy link to clipboard 
Print this post

More Like this:

For PicoMite nonVGA in Terminal..
(runs on a bare Raspberry Pico with MMBasic in VT100 Terminal)
CPUSPEED (KHz) 252000 (13.8 FPS @ 127000 KHz)

(will also run on PicomiteVGA in Terminal but much slower when the Line "Option Display SH%/8,SW%/4" is deleted and Prints garbage on the VGA Screen because it cannot process the VT100 escape sequences)


realy Nightly Build, as i woke Up at 3 AM
quick and dirty translated to VT100, sure there is room for improvements and optimizations  
'VT_Road
Cur_off
Dim FC$(8),BC$(8),Xofs%(160)
Option Break 4: On Key 3, on_break
'SH% and SW% Displayresolution
SH%=240:SW%=320
dist%=0:Speed%=4:E$=Chr$(27)+"["
For f%=0To 7
FC$(f%)=E$+Str$(30+f%)+"m":BC$(f%)=E$+Str$(40+f%)+"m"
Next
'Precalculate the Curve
For f%=0 To 159:Xofs%(159-f%)=((160*Exp(f%/50))/20)-8:Next
'
Option Display SH%/8,SW%/4:' delete this Line on PicomiteVGA
Print BC$(4);:TCLS
HW%=SW%/2:HH%=SH%/2
'-----endless loop -----------------------
'b1x% left x position of the left Border
'b2x% right x position of the left Border and left x position of the street
'b3x% right x position of the street and left x position of the right Border
'b4x% right x position of the right Border
'BB% Border broad
'bc% Border Color (red or white) calculated over Sinus Function
'HH% Half Screen y-Res  HW% Half Screen x-Res
'xofs%() Pre calculated Curve over Exponetial function
'ofsx% how much has the Curve to be bended
Do
t%=Timer
'bend right
For n%=1 To 1000 Step Speed%
  For F%=8 To HH% Step 8
    bdc%=7-6*((Sin((((120-f%)/40)^3)+dist%))>0)
    ofs%=xofs%(f%)*n%/1000
    y%=hh%+f%
    BB%=Int(f%/4)
    b1X%=HW%-F%-bb%+ofs%:b2x%=HW%-F%+ofs%
    b3x%=HW%-F%+ofs%+2*f%:b4x%=b1x%+(2*bb%+2*f%)
    L$=bc$(2)+String$(b1X%/4,32)+bc$(bdc%)+String$((B2x%-B1x%)/4,32)+BC$(0)
    L$=L$+String$((b3x%-B2x%)/4,32)+bc$(bdc%)+String$((B2x%-B1x%)/4,32)
    If b3x%<sw% Then L$=L$+bc$(2)+String$(b1X%/4,32)
    at f%/8+14,1:Print Left$(l$,sw%/3);
  Next
  Inc dist%
 Next
'bend back
For n%=1000 To 1 Step -speed%
  For F%=8 To HH% step 8
      bdc%=7-6*((Sin((((120-f%)/40)^3)+dist%))>0)
    ofs%=xofs%(f%)*n%/1000
    y%=hh%+f%
    BB%=Int(f%/4)
    b1X%=HW%-F%-bb%+ofs%:b2x%=HW%-F%+ofs%
    b3x%=HW%-F%+ofs%+2*f%:b4x%=b1x%+(2*bb%+2*f%)
L$=bc$(2)+String$(b1X%/4,32)+bc$(bdc%)+String$((B2x%-B1x%)/4,32)+BC$(0)
    L$=L$+String$((b3x%-B2x%)/4,32)+bc$(bdc%)+String$((B2x%-B1x%)/4,32)
    If b3x%<sw% Then L$=L$+bc$(2)+String$(b1X%/4,32)
    at f%/8+14,1:Print Left$(l$,sw%/3);
  Next
  Inc dist%
Next
'bend left
For n%=1 To 950 Step Speed%
 For F%=8 To HH% step 8
      bdc%=7-6*((Sin((((120-f%)/40)^3)+dist%))>0)
    ofs%=xofs%(f%)*n%/1000
    y%=hh%+f%:BB%=Int(f%/4)
    b1X%=HW%-F%-bb%-ofs%:b2x%=HW%-F%-ofs%
    b3x%=HW%-F%-ofs%+2*f%:b4x%=b1x%+(2*bb%+2*f%)
L$=bc$(2)+String$(b1X%/4,32)+bc$(bdc%)+String$((B2x%-B1x%)/4,32)+BC$(0)
    L$=L$+String$((b3x%-B2x%)/4,32)+bc$(bdc%)+String$((B2x%-B1x%)/4,32)
    If b3x%<sw% Then L$=L$+bc$(2)+String$(b1X%/4,32)
    at f%/8+14,1:Print Left$(l$,sw%/3);
  Next
 Inc dist%
Next
'bend back
For n%=950 To 1 Step -Speed%
  For F%=8 To HH%  Step 8
     bdc%=7-6*((Sin((((120-f%)/40)^3)+dist%))>0)
    ofs%=xofs%(f%)*n%/1000
    y%=hh%+f%:BB%=Int(f%/4)
    b1X%=HW%-F%-bb%-ofs%:b2x%=HW%-F%-ofs%
    b3x%=HW%-F%-ofs%+2*f%:b4x%=b1x%+(2*bb%+2*f%)
L$=bc$(2)+String$(b1X%/4,32)+bc$(bdc%)+String$((B2x%-B1x%)/4,32)+BC$(0)
    L$=L$+String$((b3x%-B2x%)/4,32)+bc$(bdc%)+String$((B2x%-B1x%)/4,32)
    If b3x%<sw% Then L$=L$+bc$(2)+String$(b1X%/4,32)
    at f%/8+14,1:Print Left$(l$,sw%/3);
  Next
  Inc dist%
Next
dist%=dist% And 255
t%=(Timer-t%)
t%=t%/1000
at 0,0:Print 900/t%
Loop
'------------------------------
Sub on_break
cur_on : Print BC$(0);:Option Break 3
End
End Sub


Sub TCLS
' clear Terminal Screen
Print Chr$(27);"[2J";
 HOME
 End Sub

 Sub HOME
 ' Cursor top left
  Print Chr$(27);"[H";
  End Sub

  Sub AT Row,Col
  Print Chr$(27);"[";Str$(Row);"H";Chr$(27);"[";Str$(Col);"G";
  End Sub

  Sub cur_off
  Print Chr$(27);"[?25l";
  End Sub

  Sub cur_on
  Print Chr$(27);"[?25h";
  End Sub                                                  

Edited 2022-10-14 15:55 by Martin H.
'no comment
 
Martin H.

Guru

Joined: 04/06/2022
Location: Germany
Posts: 1113
Posted: 07:37am 14 Oct 2022
Copy link to clipboard 
Print this post

back to the original listing.
The empty road is a little boring.
For this reason I've done some Pixelwork and designed a car which can be integrated into the original listing.





Data uncompressed for better readability


MODE 2
Dim Col%(15):Restore colors:For f%=1 To 15:Read Col%(f%):Next f%
Print @(0,80)
read_sprites
Do
Box 0,0,56,32,,0,0
Sprite write #1,0,0
Sprite write #1,28,0,1
Pause 50
Do : Loop Until GetScanLine >100
Box 0,0,56,32,,0,0
Sprite write #2,0,0,1
Sprite write #2,28,0
Pause 50
Do : Loop Until GetScanLine >100
Loop
Sub read_Sprites
 Local nr%,p%,n%,byt$,m$
 '--- Read/Create Sprites
 Restore car
  For p%=1 To 31
   Read Byt$:Byt$=expand$(Byt$)
   For n%=1 To Len(Byt$)
    m$=Mid$(Byt$,n%,1)
    Pixel n%-1,p%,COL%(Val("&H"+m$))
   Next
  Next
 Sprite read #1,0,0,28,32
 Sprite read #2,28,0,28,32
End Sub
Function expand$(pxl$)
 Local n%,nmb%,tmp$,co$
 For n%=1 To Len(pxl$)
   If Asc(Mid$(pxl$,n%,1))< 71 Then
     tmp$=tmp$+Mid$(pxl$,n%,1)
   Else
     co$=Hex$(Asc(Mid$(pxl$,n%,1))-71)
     Inc n%:nmb%=Val("&H"+Mid$(pxl$,n%,1)):tmp$=tmp$+String$(nmb%+1,co$)
   EndIf
 Next
 expand$=tmp$
End Function


car:
Data "00000000000000000000000000000000000000000000000000000000"
Data "00000000000000000000000000000000000000000000000000000000"
Data "00000000000000000000000000999900000000000000000000000000"
Data "00000000000000000000000009177190000000000000000000000000"
Data "00000000077770000000000091333319000000000007777000000000"
Data "00000000788087000000EECF11666611FCEE00000078088700000000"
Data "000000078FF00800FDCFC48F11666611F84CFCDF0000000070000000"
Data "00000007000000DD4EEEC4B1076666701B4CEEE4DD000FF070000000"
Data "0000000700000EEEEEEEC4B1076666701B4CEEEEEEE0000070000000"
Data "000000070000EEEEEEEEEAB1EEEEEEEE1BAEEEEEEEEE000070000000"
Data "00000007000EEE4CEEEEEAAEEEEEEEEEEAAEEEEEC4EEE00070000000"
Data "0000000700EEEE4444444444444444444444444444EEEE0070000000"
Data "00777777EEEEEE4888888888888888888888888884EEEEEE77777700"
Data "077880000000EE4444444444444444444444444444EE000000088770"
Data "0780000000000E4888888888888448888888888884E0000000000070"
Data "0700FF0FFFF00144444444444E4444E4444444444410000000000070"
Data "070000000000014111111111114444111111111114100FFFF0FF0070"
Data "070000000000014019BBB55911444411955BBB910410000000000070"
Data "07000000000005119BBB5559114444119555BBB91150000000000770"
Data "0700000000000551BBBB5559114444119555BBBB1550000000000770"
Data "070000000000055555555559FFFFFFFF955555555550000000000770"
Data "077000000000055555555559FFFFFFFF955555555550000000000070"
Data "0770000000000551BBBB5559B8BBBB8B9555BBBB1550000000000770"
Data "0770000000000519BBBB5559B891198B9555BBBB9150000000000770"
Data "0700000000000919BB911159B891198B951119BB9190000000000070"
Data "0700000000000791BB111119B8BBBB8B911111BB1970000000000070"
Data "070000000000070819111119B8BBBB8B911111918070000000000070"
Data "07000000000007000111118988888888881111110070000000000070"
Data "07800000000087000001110000000000001110000078000000000870"
Data "07780000000877000000000000000000000000000077800000008770"
Data "00777777777770000000000000000000000000000007777777777700"

colors:
'--Colorscheme accordung to matherp
Data RGB(BLUE),RGB(GREEN),RGB(CYAN),RGB(RED),RGB(MAGENTA),RGB(YELLOW),RGB(WHITE)
Data RGB(MYRTLE),RGB(COBALT),RGB(MIDGREEN),RGB(CERULEAN),RGB(RUST),RGB(FUCHSIA)
Data RGB(BROWN),RGB(LILAC)                                                                                                


Edited 2022-10-14 17:55 by Martin H.
'no comment
 
stanleyella

Guru

Joined: 25/06/2022
Location: United Kingdom
Posts: 2125
Posted: 02:47pm 14 Oct 2022
Copy link to clipboard 
Print this post

Sprite read needs to be blit read for non vga mmb. I will try but it is a big sprite.
 
Martin H.

Guru

Joined: 04/06/2022
Location: Germany
Posts: 1113
Posted: 03:14pm 14 Oct 2022
Copy link to clipboard 
Print this post

  stanleyella said  Sprite read needs to be blit read for non vga mmb. I will try but it is a big sprite.

actually this are 2 Sprites in one... The right Side is a little different from the left Side.
Since the car is symmetrical, I only read half of the car with each sprite and then draw them once mirrored and once normal
I was too lazy to draw the sprite 2 times

Both Programs in combination it looks like this


Edited 2022-10-15 06:41 by Martin H.
'no comment
 
Martin H.

Guru

Joined: 04/06/2022
Location: Germany
Posts: 1113
Posted: 04:34pm 21 Oct 2022
Copy link to clipboard 
Print this post

next evolution  
added the Car and painted a Background

CPUSPEED 378000








Dim Col%(15),Xofs%(2,160)
Restore colors:For f%=1 To 15:Read Col%(f%):Next f%
'SH% and SW% Displayresolution
SH%=240:SW%=320
dist%=0:Speed%=20
Option Break 4: On Key 3, on_break
MODE 2
FRAMEBUFFER create
FRAMEBUFFER WRITE F
read_sprites
'Precalc the Curve
For f%=0 To 159:Xofs%(1,159-f%)=((160*Exp(f%/50))/20)-8
Xofs%(2,159-f%)=-Xofs%(1,159-f%)
Next
'Precalc the Bordercolors
Dim Bcol%(6,120)
For dst%=1 To 6:For f%=0 To 120
 bcol%(dst%,f%)=col%(7-3*((Sin((((120-f%)/40)^3)+dst%))>0))
Next :Next :dst%=1
'
CLS COL%(1):Load image "sky.bmp"
HW%=SW%/2:HH%=SH%/2
'-------endless loop -----------------------
Do
t%=Timer
 For n=0.001 To 1 Step Speed%/1000 'bend right
   do_bg -1:do_car:Mov_sky 1:FRAMEBUFFER COPY F,N
 Next
 For n=1 To 0.001 Step -Speed%/1000 'bend back
   do_bg -1:do_car:Mov_sky 1:FRAMEBUFFER COPY F,N
 Next
 For n=0.001 To 1 Step Speed%/1000 'bend left
  do_bg 1:do_car:Mov_sky -1:FRAMEBUFFER COPY F,N
 Next
 For n=1 To 0.001 Step -Speed%/1000 'bend back
   do_bg 1:do_car:Mov_sky -1:FRAMEBUFFER COPY F,N
 Next
 t%=(Timer-t%)
 t%=t%/1000
 Text 1,1,Str$((1000/(speed%/4))/t%,3,3)
Loop

'------------------------------
'b1x% left x position of the left Border
'b2x% right x position of the left Border and left x position of the street
'b3x% right x position of the street and left x position of the right Border
'b4x% right x position of the right Border
'BB% Border broad
'bc% Border Color (red or white) calculated over Sinus Function
'HH% Half Screen y-Res  HW% Half Screen x-Res
'xofs%() Pre calculated Curve over Exponetial function
'ofsx% how much has the Curve to be bended
Sub do_bg dir%
 Box 0,hh%+2,SW%,hh%-2,,COL%(2),COL%(2)
 For F%=2 To HH%
   bc%=bcol%(dst%,f%):ofs%=xofs%(2,f%)*n*dir%:y%=hh%+f%:BB%=f%/4
   b1X%=HW%-F%-bb%+ofs%:b2x%=HW%-F%+ofs%
   b3x%=HW%-F%+ofs%+2*f%:b4x%=b1x%+(2*bb%+2*f%)
   Line b1x%,y%,b4x%,y%,,bcol%(dst%,f%)
   Line b2x%,y%,b3x%,y%,,0
 Next
 Inc dst%:If dst%>6 Then dst%=1
End Sub
'--- Moves the Background while driving a curve
Sub Mov_sky dir%
Local mv1%=1,mv2%=2
If dir%>0 Then
 Sprite read #31,0,28,mv2%,22
 Sprite Mv2%,28,0,28,320-mv2%,22
 Sprite write #31,320-mv2%,28

 Sprite read #31,0,50,mv2%,22
 Sprite Mv1%,50,0,50,320-mv1%,22
 Sprite write #31,320-mv1%,50

 Sprite read #30,0,102,mv2%,10
 Sprite Mv2%,102,0,102,320-mv2%,10
 Sprite write #30,320-mv2%,102
Else
 Sprite read #31,320-mv2%,28,mv2%,22
 Sprite 0,28,mv2%,28,320-mv2%,22
 Sprite write #31,0,28

 Sprite read #31,320-mv2%,50,mv2%,22
 Sprite 0,50,mv1%,50,320-mv1%,22
 Sprite write #31,0-mv1%,50

 Sprite read #30,320-mv2%,102,mv2%,10
 Sprite 0,102,mv2%,102,320-mv2%,10
 Sprite write #30,0,102
EndIf
'Sprite CLOSE 31
End Sub
Sub do_car
 If dist% Mod 2 Then
    Sprite write #1,132,200
    Sprite write #1,160,200,1
 Else
    Sprite write #2,132,200,1
    Sprite write #2,160,200
 EndIf
End Sub
Sub read_Sprites
 Local nr%,p%,n%,byt$,m$
 '--- Read/Create Sprites
 Restore car
  For p%=1 To 31
   Read Byt$:Byt$=expand$(Byt$)
   For n%=1 To Len(Byt$)
    m$=Mid$(Byt$,n%,1)
    Pixel n%-1,p%,COL%(Val("&H"+m$))
   Next
  Next
 Sprite read #1,0,0,28,32
 Sprite read #2,28,0,28,32
End Sub
Function expand$(pxl$)
 Local n%,nmb%,tmp$,co$
 For n%=1 To Len(pxl$)
   If Asc(Mid$(pxl$,n%,1))< 71 Then
     tmp$=tmp$+Mid$(pxl$,n%,1)
   Else
     co$=Hex$(Asc(Mid$(pxl$,n%,1))-71)
     Inc n%:nmb%=Val("&H"+Mid$(pxl$,n%,1)):tmp$=tmp$+String$(nmb%+1,co$)
   EndIf
 Next
 expand$=tmp$
End Function
Sub on_break
 Sprite CLOSE all: FRAMEBUFFER CLOSE
 MODE 1: Option Break 3
 End
End Sub
colors:
'--Colorscheme accordung to matherp
Data RGB(BLUE),RGB(GREEN),RGB(CYAN),RGB(RED),RGB(MAGENTA),RGB(YELLOW),RGB(WHITE
)
Data RGB(MYRTLE),RGB(COBALT),RGB(MIDGREEN),RGB(CERULEAN),RGB(RUST),RGB(FUCHSIA)
Data RGB(BROWN),RGB(LILAC)

car:
Data "GFGFGFG7","GFGFGFG7","GFG9P3GFG9","GFG8917719GFG8","G8N3GA91J319GAN3G8"
Data "G7788087G5EECF11M311FCEEG5780887G7"
Data "G678FF00800FDCFC48F11M311F84CFCDFG77G6"
Data "G67G5DD4U2C4B107M3701B4CU24DDG2FF07G6","G67G4U6C4B107M3701B4CU6G47G6"
Data "G67G3U8AB1U71BAU8G37G6","G67G2U24CU4AAU9AAU4C4U2G27G6"
Data "G6700U3KFKBU3007G6","00N5U54OFO94U5N500","07788G6EEKFKBEEG688770"
Data "078G9E4OB44OB4EGA70","0700FF0V3001KAEK3EKA1GA70"
Data "07GA14HAK3HA4100V30FF0070","07GA14019R255911K311955R291041GA70"
Data "07GA5119R2L2911K3119L2R29115G9770","07GA551R3L2911K3119L2R3155G9770"
Data "07GAL99V79L9G9770","077G9L99V79L9GA70","077G9551R3L29B8R38B9L2R3155G9770"
Data "077G9519R3L29B891198B9L2R3915G9770"
Data "07GA919BB9H259B891198B95H29BB919GA70","07GA791BBH49B8R38B9H4BB197GA70"
Data "07GA70819H49B8R38B9H491807GA70","07GA7G2H489O9H5007GA70"
Data "078G887G4H2GBH2G478G8870","0778G6877GFGB778G68770","00NAGFGDNA00"


and the Backgroud image file( BMP must be stored in the same folder):

Sky.zip

have Fun
Mart!n
Edited 2022-10-22 03:05 by Martin H.
'no comment
 
stanleyella

Guru

Joined: 25/06/2022
Location: United Kingdom
Posts: 2125
Posted: 05:20pm 21 Oct 2022
Copy link to clipboard 
Print this post

I like the way you are going with this.
I knew some guys in the 80's doing it for zxspectrum.

 
stanleyella

Guru

Joined: 25/06/2022
Location: United Kingdom
Posts: 2125
Posted: 05:50pm 21 Oct 2022
Copy link to clipboard 
Print this post

Not easy to convert to lcd mmb but am trying.
 
Amnesie
Guru

Joined: 30/06/2020
Location: Germany
Posts: 396
Posted: 06:20am 22 Oct 2022
Copy link to clipboard 
Print this post

Hmm... can't get it to run...

"[3] Restore colors:For f%=1 To 15:Read Col%(f%):Next f%
Error : Expected closing bracket"
 
TassyJim

Guru

Joined: 07/08/2011
Location: Australia
Posts: 6098
Posted: 06:34am 22 Oct 2022
Copy link to clipboard 
Print this post

  Amnesie said  Hmm... can't get it to run...

"[3] Restore colors:For f%=1 To 15:Read Col%(f%):Next f%
Error : Expected closing bracket"


wordwrap in a DATA line
Data RGB(BLUE),RGB(GREEN),RGB(CYAN),RGB(RED),RGB(MAGENTA),RGB(YELLOW),RGB(WHITE
)


shift the ) to the end if the first line.

JIm
VK7JH
MMedit   MMBasic Help
 
Amnesie
Guru

Joined: 30/06/2020
Location: Germany
Posts: 396
Posted: 06:38am 22 Oct 2022
Copy link to clipboard 
Print this post

Ha! That was quick! Problem solved :) Pretty impressive!
 
Martin H.

Guru

Joined: 04/06/2022
Location: Germany
Posts: 1113
Posted: 07:25am 22 Oct 2022
Copy link to clipboard 
Print this post

  TassyJim said  
  Amnesie said  Hmm... can't get it to run...

"[3] Restore colors:For f%=1 To 15:Read Col%(f%):Next f%
Error : Expected closing bracket"


wordwrap in a DATA line
Data RGB(BLUE),RGB(GREEN),RGB(CYAN),RGB(RED),RGB(MAGENTA),RGB(YELLOW),RGB(WHITE
)


shift the ) to the end if the first line.

JIm

display error
Thank you Jim  
'no comment
 
stanleyella

Guru

Joined: 25/06/2022
Location: United Kingdom
Posts: 2125
Posted: 08:24pm 22 Oct 2022
Copy link to clipboard 
Print this post

I get errors like

RUN
[100] Blit write #2,132,200,1
Error : Syntax

when usibg blit instead of sprite.
The available commands are:
BLIT READ #b, x, y, w, h
BLIT WRITE #b, x, y, w, h
BLIT LOAD #b, f$, x, y, w, h
BLIT CLOSE #b
 
vegipete

Guru

Joined: 29/01/2013
Location: Canada
Posts: 1109
Posted: 08:33pm 22 Oct 2022
Copy link to clipboard 
Print this post

What fun!

Here's a modification to include a track.
At the very end is a data block that encodes the track. You can change it for any course you might like.

I'm not sure if I have the sky movement correct. I don't have an SD card connected, so I can't load the sky graphic to test.

autosave
Dim Col%(15),Xofs%(2,160)
Restore colors:For f%=1 To 15:Read Col%(f%):Next f%
'SH% and SW% Displayresolution
'SH%=240:SW%=320 - use MM.HRES and MM.VRES instead
dist%=0:Speed%=20
Option Break 4: On Key 3, on_break
MODE 2
FRAMEBUFFER create
FRAMEBUFFER WRITE F
read_sprites
'Precalc the Curve
For f%=0 To 159
  Xofs%(1,159-f%) = ((160*Exp(f%/50))/20)-8
  Xofs%(2,159-f%) = -Xofs%(1,159-f%)
Next
'Precalc the Bordercolors
Dim Bcol%(6,120)
For dst%=1 To 6:For f%=0 To 120
  bcol%(dst%,f%)=col%(7-3*((Sin((((120-f%)/40)^3)+dst%))>0))
Next :Next :dst%=1
'
CLS COL%(1): Load image "sky.bmp"
HW%=MM.HRES/2:HH%=MM.VRES/2
'-------endless loop -----------------------
' n is degree of bend
n%=0   ' current curvature - start off straight
t%=Timer:fcnt=0
Do
  Read turn%,dur%
  If dur% < 0 Then
    t%=(Timer-t%)/1000:Text 1,1,Str$(fcnt/t%,3,3) ' show framerate
    t%=Timer:fcnt=0
    Restore TrackData
    Continue Do ' restart the track
  EndIf
  If n% < turn% Then  ' adjust curvature towards left
    For i = n% to turn% Step Speed%/dur%*100
      DrawTrack i:do_car:Mov_sky -Sgn(i):FRAMEBUFFER COPY F,N:inc fcnt
    Next
    n%=turn%
  ElseIf n% > turn% Then  ' more to right
    For i = n% to turn% Step -Speed%/dur%*100
      DrawTrack i:do_car:Mov_sky -Sgn(i):FRAMEBUFFER COPY F,N:inc fcnt
    Next
    n%=turn%
  Else   ' continue along path
    For i = 1 to dur% 'Step -Speed%/dur%
      DrawTrack n%:do_car:Mov_sky -Sgn(n%):FRAMEBUFFER COPY F,N:inc fcnt
    Next
  EndIf
Loop

'------------------------------
'b1x% left x position of the left Border
'b2x% right x position of the left Border and left x position of the street
'b3x% right x position of the street and left x position of the right Border
'b4x% right x position of the right Border
'BB% Border broad
'bc% Border Color (red or white) calculated over Sinus Function
'HH% Half Screen y-Res  HW% Half Screen x-Res
'xofs%() Pre calculated Curve over Exponetial function
'ofsx% how much has the Curve to be bended
Sub DrawTrack curv
  Box 0,hh%+2,MM.HRES,hh%-2,,COL%(2),COL%(2)
  For F%=2 To HH%
    bc%=bcol%(dst%,f%):ofs%=xofs%(2,f%)*curv/100:y%=hh%+f%:BB%=f%/4
    b1X%=HW%-F%-bb%+ofs%:b2x%=HW%-F%+ofs%
    b3x%=HW%-F%+ofs%+2*f%:b4x%=b1x%+(2*bb%+2*f%)
    Line b1x%,y%,b4x%,y%,,bcol%(dst%,f%)
    Line b2x%,y%,b3x%,y%,,0
  Next
  Inc dst%:If dst%>6 Then dst%=1
End Sub

'--- Moves the Sky while driving a curve
Sub Mov_sky dir%
Local mv1%=1,mv2%=2
If dir%=0 then
  Exit Sub  ' driving straight so sky doesn't change
  ' need to adjust time to draw nothing
EndIf
If dir%>0 Then
  Sprite read #31,0,28,mv2%,22
  Sprite Mv2%,28,0,28,320-mv2%,22
  Sprite write #31,320-mv2%,28
 
  Sprite read #31,0,50,mv2%,22
  Sprite Mv1%,50,0,50,320-mv1%,22
  Sprite write #31,320-mv1%,50
 
  Sprite read #30,0,102,mv2%,10
  Sprite Mv2%,102,0,102,320-mv2%,10
  Sprite write #30,320-mv2%,102
Else
  Sprite read #31,320-mv2%,28,mv2%,22
  Sprite 0,28,mv2%,28,320-mv2%,22
  Sprite write #31,0,28
 
  Sprite read #31,320-mv2%,50,mv2%,22
  Sprite 0,50,mv1%,50,320-mv1%,22
  Sprite write #31,0-mv1%,50
 
  Sprite read #30,320-mv2%,102,mv2%,10
  Sprite 0,102,mv2%,102,320-mv2%,10
  Sprite write #30,0,102
EndIf
'Sprite CLOSE 31
End Sub

Sub do_car
  If dist% Mod 2 Then
     Sprite write #1,132,200
     Sprite write #1,160,200,1
  Else
     Sprite write #2,132,200,1
     Sprite write #2,160,200
  EndIf
End Sub

Sub read_Sprites
  Local nr%,p%,n%,byt$,m$
  '--- Read/Create Sprites
  Restore car
    For p%=1 To 31
      Read Byt$:Byt$=expand$(Byt$)
      For n%=1 To Len(Byt$)
        m$=Mid$(Byt$,n%,1)
        Pixel n%-1,p%,COL%(Val("&H"+m$))
      Next
    Next
  Sprite read #1,0,0,28,32
  Sprite read #2,28,0,28,32
End Sub

Function expand$(pxl$)
  Local n%,nmb%,tmp$,co$
  For n%=1 To Len(pxl$)
    If Asc(Mid$(pxl$,n%,1))< 71 Then   ' asc("G") = 71
      tmp$=tmp$+Mid$(pxl$,n%,1)
    Else
      ' run length encoded - 1st char is pixel colour+71, 2nd is count-1
      co$=Hex$(Asc(Mid$(pxl$,n%,1))-71)
      Inc n%:nmb%=Val("&H"+Mid$(pxl$,n%,1)):tmp$=tmp$+String$(nmb%+1,co$)
    EndIf
  Next
  expand$=tmp$
End Function

Sub on_break
  Sprite CLOSE all: FRAMEBUFFER CLOSE
  MODE 1: Option Break 3
  End
End Sub

colors:
'--Colorscheme accordung to matherp
Data RGB(BLUE),RGB(GREEN),RGB(CYAN),RGB(RED)
Data RGB(MAGENTA),RGB(YELLOW),RGB(WHITE)
Data RGB(MYRTLE),RGB(COBALT),RGB(MIDGREEN),RGB(CERULEAN)
Data RGB(RUST),RGB(FUCHSIA),RGB(BROWN),RGB(LILAC)

car:
Data "GFGFGFG7","GFGFGFG7","GFG9P3GFG9","GFG8917719GFG8","G8N3GA91J319GAN3G8"
Data "G7788087G5EECF11M311FCEEG5780887G7"
Data "G678FF00800FDCFC48F11M311F84CFCDFG77G6"
Data "G67G5DD4U2C4B107M3701B4CU24DDG2FF07G6","G67G4U6C4B107M3701B4CU6G47G6"
Data "G67G3U8AB1U71BAU8G37G6","G67G2U24CU4AAU9AAU4C4U2G27G6"
Data "G6700U3KFKBU3007G6","00N5U54OFO94U5N500","07788G6EEKFKBEEG688770"
Data "078G9E4OB44OB4EGA70","0700FF0V3001KAEK3EKA1GA70"
Data "07GA14HAK3HA4100V30FF0070","07GA14019R255911K311955R291041GA70"
Data "07GA5119R2L2911K3119L2R29115G9770","07GA551R3L2911K3119L2R3155G9770"
Data "07GAL99V79L9G9770","077G9L99V79L9GA70","077G9551R3L29B8R38B9L2R3155G9770"
Data "077G9519R3L29B891198B9L2R3915G9770"
Data "07GA919BB9H259B891198B95H29BB919GA70","07GA791BBH49B8R38B9H4BB197GA70"
Data "07GA70819H49B8R38B9H491807GA70","07GA7G2H489O9H5007GA70"
Data "078G887G4H2GBH2G478G8870","0778G6877GFGB778G68770","00NAGFGDNA00"

TrackData:
' encoded track
' first value is amount of curve, negative = right, 100 is just off screen
' second value is duration of segment, negative = end of track, restart
Data    0,200   ' straight for a bit
Data   50,500   ' start turn to the left
Data   50, 50   ' hold turn to the left
Data    0,400   ' return to straight
Data    0, 30   ' straight for a bit
Data -100,1000  ' turn to right
Data -200,500   ' turn even sharper to right
Data -100,300   ' reduce right turn
Data  -10,500   ' reduce turn even more
Data  -10, 25   ' hold gentle right turn
Data  200,250   ' turn hard left!
Data    0,200   ' return to straight
Data    0, 50   ' straight for a bit
Data  100,150   ' turn left - chicane
Data    0,100   ' return to straight
Data -100,100   ' turn right
Data    0,100   ' return to straight
Data    0,100   ' straight for a bit
Data   40,650   ' bend to the left
Data   40, 50   ' hold bend to the left
Data   75,250   ' more bend to the left - double apex
Data    0,400   ' return to straight
Data    0,-200  ' end of track

Visit Vegipete's *Mite Library for cool programs.
 
TassyJim

Guru

Joined: 07/08/2011
Location: Australia
Posts: 6098
Posted: 09:06pm 22 Oct 2022
Copy link to clipboard 
Print this post

  stanleyella said  I get errors like

RUN
[100] Blit write #2,132,200,1
Error : Syntax

when usibg blit instead of sprite.
The available commands are:
BLIT READ #b, x, y, w, h
BLIT WRITE #b, x, y, w, h
BLIT LOAD #b, f$, x, y, w, h
BLIT CLOSE #b


In the VGA firmware, you can flip the sprites. This is not available in the TFT version so you will have to create the flipped side of the car as an additional sprite.

Jim
VK7JH
MMedit   MMBasic Help
 
stanleyella

Guru

Joined: 25/06/2022
Location: United Kingdom
Posts: 2125
Posted: 12:16am 23 Oct 2022
Copy link to clipboard 
Print this post

  TassyJim said  
  stanleyella said  I get errors like

RUN
[100] Blit write #2,132,200,1
Error : Syntax

when usibg blit instead of sprite.
The available commands are:
BLIT READ #b, x, y, w, h
BLIT WRITE #b, x, y, w, h
BLIT LOAD #b, f$, x, y, w, h
BLIT CLOSE #b


In the VGA firmware, you can flip the sprites. This is not available in the TFT version so you will have to create the flipped side of the car as an additional sprite.

Jim

A lot more to do to convert to non vga but the road works and I can redo the car as any sprite.. sorry blit.
Nice road code. Lots of maths to learn. I am impressed.
My version of scrolling was slow using blit but that was lcd.
Using blit read blit write was faster than using blit x1,y1,x2,2,w,h

option DEFAULT INTEGER
OPTION EXPLICIT
dim counter
cls
'landscape
line 0,0,20,8
line 20,8,32,16
line 32,16,42,4
line 42,4,48,30
line 48,30,68,31
line 68,31,80,24
line 80,24,92,26
line 92,26,120,31
line 120,31,144,8
line 144,8,176,0
line 176,0,198,12
line 198,12,240,12
line 240,12,280,24
line 280,24,316,12
line 316,12,319,0

do
 for counter = 1 to 100
   scroll_left
 next counter
 
 for counter = 1 to 100
   scroll_right
 next counter
loop
'------
sub scroll_left
 blit read 1,0,0,4,32
 blit read 2,4,0,316,32
 blit write 2,0,0,316,32
 blit write 1,316,0,4,32
 blit close 2
 blit close 1
end sub

sub scroll_right
 blit read 1,316,0,4,32
 blit read 2,0,0,316,32
 blit write 2,4,0,316,32
 blit write 1,0,0,4,32
 blit close 2
 blit close 1  
end sub


Edited 2022-10-23 11:22 by stanleyella
 
Martin H.

Guru

Joined: 04/06/2022
Location: Germany
Posts: 1113
Posted: 04:52am 23 Oct 2022
Copy link to clipboard 
Print this post

Hi Stanley

  stanleyella said  I get errors like

RUN
[100] Blit write #2,132,200,1
Error : Syntax

when usibg blit instead of sprite.
The available commands are:
BLIT READ #b, x, y, w, h
BLIT WRITE #b, x, y, w, h
BLIT LOAD #b, f$, x, y, w, h
BLIT CLOSE #b

ok, if the Version cannot Flip the Sprite/Blit you can modify the Read procedure and Flip them while creating:

Sub read_Sprites
Local nr%,p%,n%,byt$,m$
'--- Read/Create Sprites
Restore car
 For p%=1 To 31
  Read Byt$:Byt$=expand$(Byt$)
  For n%=1 To Len(Byt$)/2
   m$=Mid$(Byt$,n%,1)
   Pixel n%-1,p%,COL%(Val("&H"+m$))
   Pixel 56-n%,p%,COL%(Val("&H"+m$))
   m$=Mid$(Byt$,Len(Byt$)-(n%-1),1)
   Pixel n%-1,32+p%,COL%(Val("&H"+m$))
   Pixel 56-n%,32+p%,COL%(Val("&H"+m$))
   Next
 Next
Sprite read #1,0,0,56,32:Sprite read #2,0,32,56,32
Pause 5000
End Sub

so you have 2 fullsize Sprites.
with little Changesin the do_car sub

Sub do_car
 If dist% Mod 2 Then
    Sprite write #1,132,200
 Else
    Sprite write #2,132,200
 EndIf

it should do the job  

Cheers
Mart!n
'no comment
 
     Page 2 of 4    
Print this page
© JAQ Software 2024