Home
JAQForum Ver 20.06
Log In or Join  
Active Topics
Local Time 04:00 27 Apr 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 : BASIC10Liners - challenge for CMM2

     Page 3 of 4    
Author Message
Paul_L
Guru

Joined: 03/03/2016
Location: United States
Posts: 769
Posted: 03:34pm 09 Feb 2021
Copy link to clipboard 
Print this post

  JohnS said  
  Paul_L said  It's sort of like Wayne Ratliff's idea to allow delimiting pairs to be (), {}, [], or even <> interchangeably. You can visually identify the pairs more reliably, and an interpreter, pre-processor or full compiler can identify the pairs more reliably, but it would not necessarily add to the size of any compiled or assembled code.

Paul in NY

Or the bracketed pairs in Algol68 LOL

John

What I didn't mention is that each additional pair would increase the number of tokens in MMBasic by two. I don't think there are any more slots available!

I think that a pre-processor, written in MMBasic, would probably work, but it would add steps (save prgram file, load preprocessor, run it pointing at the new program, load the preprocessed program) before running a program.

The choices of what to include in the token list necessarily leaves a lot of nice gadgets out.

Paul in NY
 
lizby
Guru

Joined: 17/05/2016
Location: United States
Posts: 3015
Posted: 06:54pm 11 Feb 2021
Copy link to clipboard 
Print this post

Re vegipete's repair of my compressed version of ChemiChaos, Pete didn't mention that the up and down arrows weren't appearing (or at least, they didn't on my CMM2 when I finally got to it). That was fixed by changing the color with which they were drawn from the non-transparent black, RGB(1,1,1) to RGB(gray).

mode 7,8:w=rgb(white):bk=rgb(gray):dim cr(5):cr(0)=rgb(green):
cr(1)=rgb(red):cr(2)=rgb(cyan):cr(3)=rgb(yellow):cr(4)=rgb(blue)
cls w:x=13:y=13:for i=0 to 4:circle x,y,12,,,cr(i),cr(i):y=y+26:next i
line 13,134,13,154,2,bk:line 13,134,4,143,,bk:line 14,134,22,142,,bk
line 13,160,13,180,2,bk:line 13,180,4,171,,bk:line 14,180,22,170,,bk
line 30,2,72,2,2,bk:line 34,4,34,112,2,bk:line 67,4,67,112,2,bk:
circle 51,112,17,,,bk:circle 51,112,16,,,bk:box 36,90,31,22,,w,w
for i=1 to 9: on error skip: blit close i: next i
r=w:x=0:y=0:w=26:For i=1 To 8:Blit read i,x,y,w,w:y=y+w:Next i
Blit read 9,w+3,0,45,130:
x=37:y=16:for i=1 to 4:blit write i,x,y:y=y+w:next i:v=5:b=4:CLS r:
d$="ChemiChaos/5 Vials vegipete/lizby":text 160,0,d$,c,1,,rgb(red),r:
d$="1=L,2=R;' '=pick/put,r=reload,x=next":text 160,10,d$,c,1,,rgb(red),r:
For j=0 To 4:Blit write 9,j*50,100,0:next j:dim t(5,4):restore g:
Do:d$="":For i=0 To 3:read l:h$=Str$(l):d$=d$+h$:if l=0 then:cls r:font 5:
s$="S A F E !":text 60,100,s$,,,,rgb(green),r:do:loop:endif:next i:
e: k=1:x=10:For i=0 To 3:h$=mid$(d$,i*4+1,4):for j=1 to b:
c$=mid$(h$,j,1):l=val(c$):t(k,j)=l:t(5,j)=0:blit write l,i*50+10,82+j*w
next j:k=k+1:Next i:blit write 6,9,70:p=1:u=0:do:do:c$=inkey$:
loop until c$<>"":if c$="1" then:if x>50 then: blit x,44,x-50,44,26,52:
box x,44,26,52,0,r,r:x=x-50:p=p-1:endif:elseif c$="2" then:
if x<200 then: blit x,44,x+50,44,26,52:box x,44,26,52,0,r,r:x=x+50:p=p+1:endif
elseif c$="r" then:box 0,44,320,52,,r,r:box 210,108,w,w*4,0,r,r:goto e:
elseif c$="x" then:box 0,44,320,w*2,0,r,r:box 210,108,w,w*4,0,r,r: exit :
elseif c$=" " then:if u then:for i=1 to b:n=t(p,i):if n>0 then:exit for:endif:
next i:if n=z or i=5 then:i=i-1: if i>0 then:t(p,i)=z:blit write z,x,82+i*w
blit write 8,x,44: blit write 6,x,70:u=0:endif:endif:else:for i=1 to b:
z=t(p,i):if z<>0 then:t(p,i)=0:x=(p-1)*50+10:blit write z,x,44:
blit write 7,x,70:blit write 8,x,82+i*w:u=1:exit for:endif:next i:endif:
endif:loop:loop:
g: Data 2321,1412,4412,4333,4232,5235,2443,3554,3124,2121,2444,3331,1224,4232
Data 4311,4133,2141,4333,3242,4121,1314,3424,3231,2142,3233,4141,1241,2243
Data 3324,4421,1123,2431,4552,2444,3255,3332,2422,1434,3313,1241,0

I don't understand why I could see the arrows drawn with rgb(1,1,1), could BLIT READ and then BLIT WRITE them, but after CLS(white), BLIT WRITE didn't show them.

This above, though, works for me, and is easier than having to guess where the arrow is for picking a ball.
PicoMite, Armmite F4, SensorKits, MMBasic Hardware, Games, etc. on fruitoftheshed
 
vegipete

Guru

Joined: 29/01/2013
Location: Canada
Posts: 1082
Posted: 01:38am 12 Feb 2021
Copy link to clipboard 
Print this post

  lizby said  Pete didn't mention that the up and down arrows weren't appearing (or at least, they didn't on my CMM2 when I finally got to it)

That's why I wrote:
  Quote  Any reference to BLIT WRITE 6,7 and 9 needs an extra parameter ",0"

Visit Vegipete's *Mite Library for cool programs.
 
lizby
Guru

Joined: 17/05/2016
Location: United States
Posts: 3015
Posted: 02:05am 12 Feb 2021
Copy link to clipboard 
Print this post

Ah, thanks. I'm a version behind on the manual, and that parameter isn't shown. Updated now.

"Default value is 4": &B100 = don't copy transparent pixels

So 0 is "do copy transparent pixels". I'm still not sure I fully understand. If I did BLIT WRITE 6,x,y on the screen from which I did the BLIT READ 6, everything looked good even without transparency disabled. But after a CLS RGB(white), BLIT WRITE 6 showed nothing.

And I had thought that with RGB(1,1,1) instead of RBG(black) I was avoiding the transparency issue. But RGB(gray) works, and looks to me to be close enough to black (and the color doesn't really matter as long as the arrows appear).
PicoMite, Armmite F4, SensorKits, MMBasic Hardware, Games, etc. on fruitoftheshed
 
vegipete

Guru

Joined: 29/01/2013
Location: Canada
Posts: 1082
Posted: 03:25am 12 Feb 2021
Copy link to clipboard 
Print this post

Yes, I often struggle with 'black' too.

Black is considered transparent. Trouble is, if we specify RGB(1,1,1), the firmware has to translate that to one of the available colours - and it picks ... BLACK ... as the closest one.

I wish we could specify palette number to draw with. Then we could map a particular colour number other than zero to RGB(0,0,0) and then draw with that colour number when we want a solid black, and not with the default one.

Adds to the fun!

I think in the case of the arrows and test tubes, when you BLIT from the white source, the black pixels allow the white background to show through, resulting in nothing displayed.

Test with different RGB(x,x,x) to find the darkest that works.
Maybe RGB(20,20,20)?  Maybe RGB(10,10,10)?
Visit Vegipete's *Mite Library for cool programs.
 
jirsoft

Guru

Joined: 18/09/2020
Location: Czech Republic
Posts: 532
Posted: 11:43am 12 Feb 2021
Copy link to clipboard 
Print this post

And the RGB(NOTBLACK) isn't working for you? I'm using it almost everywhere...
Jiri
Napoleon Commander and SimplEd for CMM2 (GitHub),  CMM2.fun
 
Turbo46

Guru

Joined: 24/12/2017
Location: Australia
Posts: 1593
Posted: 07:13am 13 Feb 2021
Copy link to clipboard 
Print this post

vegipete,

Is it possible that you could post an uncompressed version of your "In Defense of the Green Hills of Earth" program?

I'd like to be able to understand it and perhaps modify it.

Bill

PS maybe that should have been a stipulation of the contest.
Keep safe. Live long and prosper.
 
thwill

Guru

Joined: 16/09/2019
Location: United Kingdom
Posts: 3840
Posted: 11:49am 13 Feb 2021
Copy link to clipboard 
Print this post

  Turbo46 said  PS maybe that should have been a stipulation of the contest.


It was a consideration Bill and their are points for clarity, but ultimately we wanted to reduce the barriers to entry. I'm sure that most authors will happily clean up their code if interest is expressed, if not then I don't mind looking at doing so myself.

Best wishes,

Tom
Game*Mite, CMM2 Welcome Tape, Creaky old text adventures
 
Turbo46

Guru

Joined: 24/12/2017
Location: Australia
Posts: 1593
Posted: 12:35pm 13 Feb 2021
Copy link to clipboard 
Print this post

Hi Tom,

I did try to re-format the program and ended up with over 200 lines. But failed. It didn't work properly.

I would have thought that someone would start out with a readable program and continually whittle it down to something incomprehensible and the original version would still be available.

Never mind.

Bill
Keep safe. Live long and prosper.
 
vegipete

Guru

Joined: 29/01/2013
Location: Canada
Posts: 1082
Posted: 05:21pm 13 Feb 2021
Copy link to clipboard 
Print this post

You are assuming there was an uncompressed version of "In Defense of the Green Hills of Earth".  

The first half was written right from the start at 50-75% compressed, to test if it was remotely possible. There was even a major internal re-write, changing the alien formation from 2 arrays of strings to arrays of relative x and y coordinates. (I was quite surprised when the rewrite worked perfectly first time.)

The rest of the program was embellishments, added as space allowed. A new routine may have been written mostly expanded, then squashed mercilessly. Sometimes preexisting sections were expanded somewhat to slide in new functionality, or modified.

However, I will post a properly formatted version, with comments and all. Might be a day or two...
Visit Vegipete's *Mite Library for cool programs.
 
lizby
Guru

Joined: 17/05/2016
Location: United States
Posts: 3015
Posted: 06:17pm 15 Feb 2021
Copy link to clipboard 
Print this post

  jirsoft said  And the RGB(NOTBLACK) isn't working for you? I'm using it almost everywhere...


Sorry to be late replying. Yes, RGB(NOTBLACK) does work. (I had forgotten about that, but mistakenly thought that RGB(1,1,1) would handle the issue, not thinking through the vagaries of what it might mean in different modes.)

Idle musing: what manner of beast is NOTBLACK? It isn't a variable, because you can't set it. It isn't quite a constant because its value depends on the mode. Is it a "variable" constant? Or a pseudo-constant? Similar to but not the same as mm.FontHeight.
PicoMite, Armmite F4, SensorKits, MMBasic Hardware, Games, etc. on fruitoftheshed
 
jirsoft

Guru

Joined: 18/09/2020
Location: Czech Republic
Posts: 532
Posted: 06:34pm 15 Feb 2021
Copy link to clipboard 
Print this post

I think RGB(NOTBLACK) is simply wired into MMBasic, same-way as other color constants. And it simply choses for current MODE color with most black but not BLACK and no transparency (for me mostly &hF002000). But Peter can answer it better...
Jiri
Napoleon Commander and SimplEd for CMM2 (GitHub),  CMM2.fun
 
Volhout
Guru

Joined: 05/03/2018
Location: Netherlands
Posts: 3527
Posted: 10:41am 07 Mar 2021
Copy link to clipboard 
Print this post

OK here is my entry for the BASIC 10 liners.
I simply loved this challenge. And since I use a CMM1 I cannot really compete with the  100x48 challenge on CMM2. A CMM1 basic is simply cannot match up to CMM2 basic.

My entry:             TLS = Ten Line Sokoban

It runs on a CMM1 on MMBasic V4.5c. MMBasic on the CMM1 is much older than the current 5.0x versions running on CMM2 and micromites. And it has some very strange limitations.

1/ Although DO can be anywhere on a multi statement line, LOOP must be at the beginning of a line.
2/ Same for FOR and NEXT
3/ There is no RESTORE nn (restore data read pointer to a certain location)
4/ There is no MIN/MAX
5/ No select/case

Originally I wanted to put TETRIS in 10 lines, but that simply would not fit (not with my programming capabilities). Hence Sokoban.

Sokoban is a game where a warehouse guy (yellow circle) has to push boxes (green blocks) from their current location to the destination (blue field).Once he completes the task, you get a new level.
Pushing the "r" (lower case) will let you redo the game.

Here is the Sokoban game in 10 lines
s=13:Dim f(s,s),t(s,s):Do:Mode 4:z=9:Read x,y:For i=1To s:Read a$:l=Val("&h"+a$)
For j=1To s:w=2^((j-1)*2):m=3*w:f(i,j)=(l And m)/w:If f(i,j)<2Then t(i,j)=f(i,j)
Next j,i:Print @(99,10)"TLS":f(x,y)=4:Do:If a$="r"Then:Restore:Exit Do:EndIf:d=1
For i=1To s:For j=1To s:k=f(i,j):If k=1Then:d=0:EndIf:o=120+z*(i-6):p=100+z*(j-6)
Line(o,p)-(o+z-2,p+z-2),3And k,BF:If k=4Then Circle(o+z/2-1,p+z/2-1),3,6,,F:EndIf
Next j,i:If d=1Then:Exit Do:EndIf:Do:a$=Inkey$:Loop While a$="":n=3And Asc(a$)
If n<2Then:b=0:c=n*2-1:Else:b=n*2-5:c=0:EndIf:e=x+b:f=y+c:If f(e,f)=2Then
If f(e+b,f+c)=<1Then:f(e,f)=0+t(e,f):f(e+b,f+c)=2:Else:b=0:c=0:EndIf
ElseIf f(e,f)=3Then:b=0:c=0:EndIf:f(x,y)=t(x,y):x=x+b:y=y+c:f(x,y)=4
Loop:Loop:Data 2,2,FFFF,D5F3,CBC3,C023,C3CF,EC0F,C0FF,FFFF,0,0,0,0,0


For those who want to understand what the above does, here is some explanation of all these single character variables.
' TLS = ten line sokoban

' control by cursor keys-128 (128,129,130,131 => 0,1,2,3 => ^ V < >)
' playfield values 0=empty, 1=target, 2=block, 3=wall

'z   = size block
'x,y = position human
'e,f = new position human
'o,p = position onscreen
'n   = ascii value key
'b,c = direction human
'd   = done
'a$  = key pressed
'w   = dummy
'l,m = vars for decoding rooms
'i,j = counters
'k   = value field (i,j)
'f() = playing field
't() = target locations for the boxes
's   = size playfield (sxs)


When you look at the code, you see that s=13, meaning you can have a playfield that are 13x13 in size. I took the included level and additional levels from internet, and translated them into hexadecimal numbers using above legend and 2 bits for each cell

Here are some additional levels:
First 2 fields are start location guy (x,y), then the playfield
If your playfield is smaller, simply add 0's until you have 13.
'--------------extra data-------------
'simple 8x8
'Data 2,2,FFFF,D003,FF03,C003,C083,C003,C003,FFFF,0,0,0,0,0
'8x8 field
Data 5,2,FF0,C3F,FC03,C273,CE23,C44F,FF0C,3FC,0,0,0,0,0
Data 2,2,FFFF,C303,C0B3,DA13,CDEF,C10C,FFFC,0,0,0,0
'11x11 field
Data 2,3,FFC,3FC0C,30C8C,300BF,37F23,37203,3703F,37230,37F30,30030,3FFF0,0,0


Happy sokobanning....

Volhout

P.S. due to the lack of "RESTORE nn" when you restart one of the added levels, you restart to level 1
Edited 2021-03-08 01:33 by Volhout
PicomiteVGA PETSCII ROBOTS
 
vegipete

Guru

Joined: 29/01/2013
Location: Canada
Posts: 1082
Posted: 07:16pm 07 Mar 2021
Copy link to clipboard 
Print this post

Ten Line Sokoban. Nice.

I had to fire up my original Colour Maximite to give it a test. Wow! That's pretty awesome! I wrote a Sokoban clone for the CMM2 a while back and it took me considerably more than 10 lines to do it, so I had to see what cool tricks you used. Your legal move evaluator algorithm is way more elegant than mine. I have discovered thought that I can cheat and stand on the last target instead of pushing the last block in to place.
Visit Vegipete's *Mite Library for cool programs.
 
TassyJim

Guru

Joined: 07/08/2011
Location: Australia
Posts: 5903
Posted: 09:32pm 07 Mar 2021
Copy link to clipboard 
Print this post

  Volhout said  OK here is my entry for the BASIC 10 liners.
I simply loved this challenge. And since I use a CMM1 I cannot really compete with the  100x48 challenge on CMM2. A CMM1 basic is simply cannot match up to CMM2 basic.

My entry:             TLS = Ten Line Sokoban


The only change I had to make to the program to run it on a CMM2 was add
OPTION LEGACY ON
to the beginning and change variable f to g
You can not have a simple variable with the same name as an array.
I think you should be allowed the extra line for OPTION LEGACY ON
OPTION LEGACY ON
s=13:Dim f(s,s),t(s,s):Do:Mode 4:z=9:Read x,y:For i=1To s:Read a$:l=Val("&h"+a$)
For j=1To s:w=2^((j-1)*2):m=3*w:f(i,j)=(l And m)/w:If f(i,j)<2Then t(i,j)=f(i,j)
Next j,i:Print @(99,10)"TLS":f(x,y)=4:Do:If a$="r"Then:Restore:Exit Do:EndIf:d=1
For i=1To s:For j=1To s:k=f(i,j):If k=1Then:d=0:EndIf:o=120+z*(i-6):p=100+z*(j-6)
Line(o,p)-(o+z-2,p+z-2),3And k,BF:If k=4Then Circle(o+z/2-1,p+z/2-1),3,6,,F:EndIf
Next j,i:If d=1Then:Exit Do:EndIf:Do:a$=Inkey$:Loop While a$="":n=3And Asc(a$)
If n<2Then:b=0:c=n*2-1:Else:b=n*2-5:c=0:EndIf:e=x+b:g=y+c:If f(e,g)=2Then
If f(e+b,g+c)=<1Then:f(e,g)=0+t(e,g):f(e+b,g+c)=2:Else:b=0:c=0:EndIf
ElseIf f(e,g)=3Then:b=0:c=0:EndIf:f(x,y)=t(x,y):x=x+b:y=y+c:f(x,y)=4
Loop:Loop:Data 2,2,FFFF,D5F3,CBC3,C023,C3CF,EC0F,C0FF,FFFF,0,0,0,0,0


I did expand the program into something readable to find the same name bug but it does run in the compressed mode.

Jim
VK7JH
MMedit   MMBasic Help
 
Volhout
Guru

Joined: 05/03/2018
Location: Netherlands
Posts: 3527
Posted: 08:26am 08 Mar 2021
Copy link to clipboard 
Print this post

  vegipete said  I have discovered thought that I can cheat and stand on the last target instead of pushing the last block in to place.


Good find, I missed that one.

  TassyJim said  The only change I had to make to the program to run it on a CMM2 was add
OPTION LEGACY ON
to the beginning and change variable f to g
You can not have a simple variable with the same name as an array.


I knew about the limitation for CMM2, and thought I fixed them all, but missed the double use of f as variable and as array.

Thank you for reviewing. I really appreciate you took the time to play with this baby, since it took quite some time to make. This is a very good reward !!

I'll see if I can fix vegipete's cheat within the 10 lines. There is still room....
I even saw I can remove 2 more characters.


Edited 2021-03-08 18:28 by Volhout
PicomiteVGA PETSCII ROBOTS
 
vegipete

Guru

Joined: 29/01/2013
Location: Canada
Posts: 1082
Posted: 06:44pm 08 Mar 2021
Copy link to clipboard 
Print this post

The following should give you a bunch more space:

A section of the code now is: (expanded)
   d = 1
   ' Draw the playfield
   For i = 1 To s
     For j = 1 To s
       k = f(i,j)  ' playfield values 0=empty, 1=target, 2=block, 3=wall
       If k = 1 Then
         d = 0
       EndIf
       o = 120+z*(i-6)
       p = 100+z*(j-6)
       Line(o,p)-(o+z-2,p+z-2),3 And k,BF
       If k = 4 Then
         Circle(o+z/2-1,p+z/2-1),3,6,,F
       EndIf
   Next j,i
   If d = 1 Then   ' done if no target cells visible
     Exit Do
   EndIf

I think this can be changed to:
   d = 0  <######## change this line>
   ' Draw the playfield
   For i = 1 To s
     For j = 1 To s
       k = f(i,j)  ' playfield values 0=empty, 1=target, 2=block, 3=wall

       'If k = 1 Then  <######## change these    >
       '  d = 0        <######## three lines     >
       'EndIf          <######## to the following>
       d = d+(k=1)

       o = 120+z*(i-6)
       p = 100+z*(j-6)
       Line(o,p)-(o+z-2,p+z-2),3 And k,BF
       If k = 4 Then
         Circle(o+z/2-1,p+z/2-1),3,6,,F
       EndIf
   Next j,i
   If d=0 Then   ' done if no target cells visible <######## change
     Exit Do
   EndIf

However, this is deep in the heart of the end-of-level detection, so some extra logic will be required. The following checks if player is standing on an empty cell and seems to work:
If d=0 and (t(x,y)=0) Then   ' done if no target cells visible <######## change

Visit Vegipete's *Mite Library for cool programs.
 
Volhout
Guru

Joined: 05/03/2018
Location: Netherlands
Posts: 3527
Posted: 08:40pm 08 Mar 2021
Copy link to clipboard 
Print this post

Wauw Vegipete,

Never knew that worked, the a=(b=1) boolean function. I used it immediately in several locations.
I also fixed the human on target bug
And another bug where a target on level 1 would copy over to level 2 if it was precise under a box.
I copied TassyJims fix that prevents double use of the f variable.

So here is the new code (for CMM2 users OPTION LEGACY ON first)

s=13:Dim f(s,s),t(s,s):Do:Mode 4:z=9:Read x,y:For i=1To s:Read a$:l=Val("&h"+a$)
For j=1To s:w=2^((j-1)*2):m=3*w:f(i,j)=(l And m)/w:t(i,j)=(f(i,j)=1)
Next j,i:Print @(99,10)"TLS":f(x,y)=4:Do:d=0:If a$="r"Then:Restore:Exit Do:EndIf
For i=1To s:For j=1To s:k=f(i,j):d=d+(k=1):o=120+z*(i-6):p=99+z*(j-6)
Line(o,p)-(o+z-2,p+z-2),3And k,BF:If k=4Then Circle(o+z/2-1,p+z/2-1),3,6,,F:EndIf
Next j,i:If d+q=0Then:Exit Do:EndIf:Do:a$=Inkey$:Loop While a$="":n=3And Asc(a$)
If n<2Then:b=0:c=n*2-1:Else:b=n*2-5:c=0:EndIf:e=x+b:g=y+c:If f(e,g)=3Then:b=0:c=0
ElseIf f(e,g)=2Then:If f(e+b,g+c)<2Then:f(e,g)=t(e,g):f(e+b,g+c)=2:Else:b=0:c=0
EndIf:EndIf:f(x,y)=t(x,y):x=x+b:y=y+c:f(x,y)=4:q=t(x,y)
Loop:Loop:Data 2,2,FFFF,D5F3,CBC3,C023,C3CF,EC0F,C0FF,FFFF,0,0,0,0,0


If it where not for the LOOP and NEXT that need to be at beginning of a line, I would even be able to add a whole level in 10 lines...

Thank you for all your help, I (again) learned a lot.

Happy Sokobanning
PicomiteVGA PETSCII ROBOTS
 
TassyJim

Guru

Joined: 07/08/2011
Location: Australia
Posts: 5903
Posted: 09:36pm 08 Mar 2021
Copy link to clipboard 
Print this post

Make 2 changes.
Line 5
you are missing then ':' after THEN
Line 6
remove the first 'DO' so you just have 'EXIT' instead of 'EXIT DO'.
In this case, you can get away with it but not something that will always work.
(Not sure if it is the same on the CMM1)

Jim
VK7JH
MMedit   MMBasic Help
 
vegipete

Guru

Joined: 29/01/2013
Location: Canada
Posts: 1082
Posted: 12:57am 09 Mar 2021
Copy link to clipboard 
Print this post

What an awesome 10 lines of program!

If you change the level decoding from (in line 2)
w=2^((j-1)*2):m=3*w:f(i,j)=(l And m)/w
to
f(i,j)=l And 3:l=l\4

you can gain enough space to add data for a second level:
s=13:Dim f(s,s),t(s,s):Do:Mode 4:z=9:Read x,y:For i=1To s:Read a$:l=Val("&h"+a$)
For j=1To s:f(i,j)=l And 3:l=l\4:t(i,j)=(f(i,j)=1):Data 2,2,FFFF,D5F3,CBC3,C023
Next j,i:Print @(99,10)"TLS":f(x,y)=4:Do:d=0:If a$="r"Then:Restore:Exit Do:EndIf
For i=1To s:For j=1To s:k=f(i,j):d=d+(k=1):o=120+z*(i-6):p=99+z*(j-6):Data C3CF
Line(o,p)-(o+z-2,p+z-2),3And k,BF:If k=4Then Circle(o+z/2-1,p+z/2-1),3,6,,F:EndIf
Next j,i:If d+q=0Then:Exit Do:EndIf:Do:a$=Inkey$:Loop While a$="":n=3And Asc(a$)
If n<2Then:b=0:c=n*2-1:Else:b=n*2-5:c=0:EndIf:e=x+b:g=y+c:If f(e,g)=3Then:b=0:c=0
ElseIf f(e,g)=2Then:If f(e+b,g+c)<2Then:f(e,g)=t(e,g):f(e+b,g+c)=2:Else:b=0:c=0
EndIf:EndIf:f(x,y)=t(x,y):x=x+b:y=y+c:f(x,y)=4:q=t(x,y):Data EC0F,C0FF,FFFF,0,0
Loop:Loop:Data 0,0,0,5,2,FF0,C3F,FC03,C273,CE23,C44F,FF0C,3FC,0,0,0,0,0

Jamming data statements in the little gaps at the ends of lines works great.

Some might object to lines 5 and 7 being 1 character too long.
You could fix line 5 by changing
If k=4Then Circle(o+z/2-1,p+z/2-1),3,6,,F:EndIf
to
Circle(o+z/2-1,p+z/2-1),3*(k=4),6,,F

Visit Vegipete's *Mite Library for cool programs.
 
     Page 3 of 4    
Print this page
© JAQ Software 2024