TheBackShed.com

Forum Index : Microcontroller and PC projects : ecological simulation on picomite and cmm2

Page 1 of 2

Author

Message

hhtg1968
Senior Member

Joined: 25/05/2023
Location: Germany
Posts: 123

Posted: 06:07pm 09 Jun 2023

Copy link to clipboard

Print this post

Hi from Germany.

Since a few days i convert an old Basic program from the 80s. During school i programmed a bological/ oekological simulation on my amstrad cpc 464 for computer science. i conbverted it later for the colour maximite 1 and 2.
i cannot test it on my picomites cause my interface for vga is still not ready (i am waiting for the sub-d vga adapter) but i tried to use commands for the picomite basic. i think you have to use the command mode 2 (instead of mode 7 on cmm2) for 320x240 resolution, i test the system variable mm.device$.

the progeram use pixels as plants or animals. black is nothing or desert. green is gras. white is sheep. red is wolfe. blue is water. and magenta is poison.

water helps to erase poisened areas. wolfes need sheeps, sheeps need gras etc.

you can press "h" for help. "q" for quit. with keys you can insert wolfes and sheeps, you can make rain. poisoned rain and you can use an atomic bomb.

i do not know why the save image command is so slow. i use it for caching the screen during help. perhaps i should use kind of framebuffer.

i will add several functions the next weeks. so i want to code a gui to change the q

i would be happy if someone tests it on the picomiteVGA.

screenshots will follow...

yours hhtg.

LIFEPX3c2.BAS.zip

hhtg1968
Senior Member

Joined: 25/05/2023
Location: Germany
Posts: 123

Posted: 06:11pm 09 Jun 2023

Copy link to clipboard

Print this post

dim string k$=mm.device$
if k$="Colour Maximite 2" then mode 7
if k$="PicoMiteVGA" then mode 2
option explicit
Cls
Colour rgb(magenta)
Print"LIFEpx3c2 v4.0.1 for "k$
Print
print"converted from my version for the amstrad cpc 464"
print
print"from 1985!"
print
Colour rgb(white)
Print"(c) hhtg. 09-06-2023 21h00"
Print
Print"press a key or wait a little bit..."
dim z(321,2)
dim integer n,mx,my,sw,gruen,blau,rot,lila,weiss,dx,dy,s,j,x,y,o,u,l,r,t,cx,cy
dim integer maxx=800, maxy=600
For n=0 To 4999999
k$=Inkey$
If k$<>"" Then Exit For
Next n
mx=320
my=240

sw=0
gruen=65280
blau=255
rot=16711680
lila=16711935
weiss=16777215

cls

rem If k$="n" Then Cls:Input"x:",mx:Input"y:",my

start:
If mx>maxx Then mx=maxx
If mx<15 Then mx=15
If my>maxy Then my=maxy
If my<15 Then my=15
dx=mx
dy=my
s=dx*dy

rem dim integer z(mx+1,2)

rem print mx,my
rem waitkey

mode 7:rem 30x240
rem Mode 6,8:rem standard 256x240

For n=0 To Sqr(s)
Pixel 2+(dx-6)*Rnd,2+(dy-4)*Rnd,rgb(green)
Next n
For n=0 To Sqr(s)/4
Pixel 2+(dx-6)*Rnd,2+(dy-4)*Rnd),rgb(blue)
Next n
i_schaf
i_wolf
j=1

again:
Line 0,0,dx-1,0,,rgb(blue)
Line 0,0,0,dy-1,,rgb(blue)
Line 0,dy-1,dx-1,dy-1,,rgb(blue)
Line dx-1,dy-1,dx-1,0,,rgb(blue)
For y=1 To dy-2
rem Pixel 0,y+1,rgb(blue)
rem Pixel dx-1,y+1,rgb(blue)
For x=1 To dx-2
o=Pixel(x,y+1)
u=Pixel(x,y-1)
r=Pixel(x+1,y)
l=Pixel(x-1,y)
t=Pixel(x,y)
If t>sw Then GoTo wasser
If (o=gruen Or u=gruen Or r=gruen Or l=gruen) and rnd>0.3 Then t=rgb(green):GoTo draw
if (o=blau or u=blau or r=blau or l=blau) and rnd>0.7 then t=rgb(blue):goto draw
If (o=lila Or u=lila Or r=lila Or l=lila) And Rnd>0.5 Then t=rgb(magenta):goto draw
if rnd>0.999 then t=rgb(green)
GoTo draw
wasser:
If t<>blau Then GoTo gras
If (o=gruen Or u=gruen Or r=gruen Or l=gruen) And Rnd>0.9 Then t=rgb(green)
if rnd>0.999 then t=rgb(green)
GoTo draw
gras:
If t<>gruen Then GoTo schaf
If (o=weiss Or u=weiss Or r=weiss Or l=weiss) and rnd>0.1 Then t=rgb(white)
if (o=lila or u=lila or r=lila or l=lila) and rnd>0.6 then t=rgb(magenta)
GoTo draw
schaf:
If t<>weiss Then GoTo wolf
t=sw
if o=gruen or u=gruen or r=gruen or l=gruen then t=rgb(white)
If (o=rot Or u=rot Or r=rot Or l=rot) and rnd>0.2 Then t=rgb(red)
GoTo draw
wolf:
If t<>rot Then GoTo poison
t=sw
rem If o=weiss Or u=weiss Or r=weiss Or l=weiss Then t=rgb(red)
GoTo draw
poison:
If t<>lila Then GoTo nada
If o=blau Or u=blau Or r=blau Or l=blau Then If Rnd>0.2 Then t=rgb(blue)
If o=gruen Or u=gruen Or r=gruen Or l=gruen Then If Rnd>0.93 Then t=rgb(green)
goto draw
nada:
rem print @(2,100)"Nada!"rnd
draw:
z(x,y Mod 3)=t
Next x
rem Pixel 0,y+1,rgb(blue)
rem Pixel dx-1,y+1,rgb (blue)
if y>2 then line 1,y-1,mx-2,y-1,,rgb(yellow)

If y>2 Then For x=1 To dx-2:Pixel x,y-2,z(x,(1+y Mod 3) Mod 3):Next x

k$=Inkey$
If k$="" Then GoTo nxt
if k$="A" then cls
If k$="r" Then Run
If k$="n" Then Cls:Input"x:",mx:Input"y:",my:GoTo start
If k$="q" Then Cls:Mode 1:End
If k$="c" Then r=Rnd*dy/4:cx=r+Rnd*dy/2:cy=r+Rnd*dy/2:Circle cx,cy,r,,,rgb(blue)
If k$="C" Then r=Rnd*dy/4:cx=r+Rnd*dy/2:cy=r+Rnd*dy/2:Circle cx,cy,r,,,rgb(blue),rgb(blue)
If k$="k" Then r=Rnd*dy/4:cx=r+Rnd*dy/2:cy=r+Rnd*dy/2:Circle cx,cy,r,,,rgb(black)
If k$="K" Then r=Rnd*dy/4:cx=r+Rnd*dy/2:cy=r+Rnd*dy/2:Circle cx,cy,r,,,rgb(black),rgb(black)
If k$="g" Then r=Rnd*dy/4:cx=r+Rnd*dy/2:cy=r+Rnd*dy/2:Circle cx,cy,r,,,rgb(green)
If k$="G" Then r=Rnd*dy/4:cx=r+Rnd*dy/2:cy=r+Rnd*dy/2:Circle cx,cy,r,,,rgb(green),rgb(green)
If k$="p" Then r=Rnd*dy/4:cx=r+Rnd*dy/2:cy=r+Rnd*dy/2:Circle cx,cy,r,,,rgb(magenta)
If k$="P" Then r=Rnd*dy/8:cx=r+Rnd*dy/2:cy=r+Rnd*dy/2:Circle cx,cy,r,,,rgb(magenta),rgb(magenta)
If k$="w" Then i_wolf
If k$="s" Then i_schaf
If k$="x" Then For n=0 To 127:Pixel 2+(dx-4)*Rnd,2+(dy-4)*Rnd,rgb(magenta):Next n
If k$="W" Then For n=0 To 127:Pixel 2+(dx-4)*Rnd,2+(dy-4)*Rnd,rgb(blue):Next n
If k$="S" Then Save image "lifepx3.bmp"
If k$="L" Then Load bmp "lifepx3.bmp"
If k$="h" Or k$="?" Then hilfe
nxt:
Next y
For x=1 To dx-2:Pixel x,y-2,z(x,(1+y Mod 3) Mod 3):Next x
rem For x=1 To dx-2:Pixel x,y-2,rgb(red)
rem line 1,y+1,mx-2,y+1,,rgb(yellow)
y=y+1
For x=1 To dx-2:Pixel x,y-2,z(x,(1+y Mod 3) Mod 3):Next x
j=j+1
GoTo again

Sub hilfe
Save image "buffer.bmp"
Cls
Print"keys:"
print"A - atomic bomb!"
Print"r - run n - new params q - quit"
Print"c - circle water C - filled"
Print"k - circle clean K - filled"
Print"g - circle grass G - filled"
Print"p - circle poison P - filled"
Print"w - insert wolfs s - insert sheeps"
Print"W - rain/water x - poisened rain!"
Print"L - load landscape S - save"
Print
Print"h or ? - this help page"
Print
Colour rgb(green)
Print". grass ";
Colour rgb(blue)
Print". water ";
Colour rgb(white)
Print". sheep ";
Colour rgb(red)
Print". wolfe ";
Colour rgb(magenta)
Print". poison"
Colour rgb(white)
Print
Print"year: ";j;" calculations: ";(j-1)*s+y*(dx-2)
Print
Print"press a key..."
do
loop until Inkey$<>""
Load bmp "buffer.bmp"
End Sub

Sub i_wolf
Local x,y,a
For n=0 To Sqr(s)/8
a=0
Do
x=2+(dx-6)*Rnd
y=2+(dy-4)*Rnd
o=Pixel(x,y+1)
u=Pixel(x,y-1)
r=Pixel(x+1,y)
l=Pixel(x-1,y)
a=a+1
Loop Until o=weiss Or u=weiss Or r=weiss Or l=weiss Or a>1023
Pixel x,y,rgb(red)
Next n
End Sub

Sub i_schaf
Local x,y,a
For n=0 To Sqr(s)/4
a=0
Do
x=2+(dx-6)*Rnd
y=2+(dy-4)*Rnd
o=Pixel(x,y+1)
u=Pixel(x,y-1)
r=Pixel(x+1,y)
l=Pixel(x-1,y)
a=a+1
Loop Until o=gruen Or u=gruen Or r=gruen Or l=gruen Or a>1023
Pixel x,y,rgb(white)
Pixel x+1,y,rgb(white)
Pixel x,y+1,rgb(white)
Next n
End Sub

sub waitkey
do
loop until inkey$<>""
end sub

hhtg1968
Senior Member

Joined: 25/05/2023
Location: Germany
Posts: 123

Posted: 06:12pm 09 Jun 2023

Copy link to clipboard

Print this post

sorry, i posted via paste into this text window...

NPHighview

Senior Member

Joined: 02/09/2020
Location: United States
Posts: 200

Posted: 10:11pm 09 Jun 2023

Copy link to clipboard

Print this post

Greetings, hhtg -

I just tried porting your program to the PicoW, using a WaveShare Pico-Eval-Board (480x320 ILI9488W LCD display) and firmware version 5.07.08b1, and the following declaration for the display:

OPTION LCDPANEL ILI9488W, RPORTRAIT,GP8,GP15,GP9,GP13

Without any changes in logic (but a little reformatting), I ran into a problem, getting this message on the terminal after lots of green pixels are displayed:

LIFEpx3c2 v4.0.1 FOR WebMite

converted from my version FOR the amstrad cpc 464

from 1985!

(c) hhtg. 09-06-2023 21h00

press a key OR wait a little bit...
i_schaf: [ 217, 194]
[218] o = Pixel(x, y + 1)

This is unexpected; the WebMite manual, page 133, says that the PIXEL function works for ILI9488 displays.

(I added the PRINT statement within i_schaf to see if the coordinates are outside of the screen; they're not)

Here is my slight reformatting of your code:

REM Port of a 1980s biological / ecological program to MMBasic AND the WaveShare P-E-B
REM Port by hhtg1968; adaptation to PicoW AND P-E-B by NPHighview
REM See The Back Shed Forum https://www.thebackshed.com/forum/ViewTopic.php?FID=16&TID=16001

DIM string k$ = mm.device$
DIM z(321, 2)
DIM integer n, mx, my, sw, green, blue, red, lilac, white, dx, dy, s, j, x, y, o, u, l, r, t, cx, cy
DIM integer maxx = 240, maxy = 320

IF k$ = "COLOUR Maximite 2" THEN mode 7
IF k$ = "PicoMiteVGA" THEN mode 2
OPTION explicit
CLS
COLOUR RGB(magenta)
PRINT "LIFEpx3c2 v4.0.1 FOR "k$
PRINT : PRINT "converted from my version FOR the amstrad cpc 464"
PRINT : PRINT "from 1985!" : PRINT
COLOUR RGB(white)

PRINT "(c) hhtg. 09-06-2023 21h00"
PRINT
PRINT "press a key OR wait a little bit..."

FOR n = 0 To 4999999
k$ = Inkey$
IF k$ <> "" THEN Exit For
NEXT n

mx = 240
my = 320

sw = 0
green = 65280
blue = 255
red = 16711680
lilac = 16711935
white = 16777215

CLS

REM IF k$ = "n" THEN CLS : Input"x : ", mx : Input"y : ", my

start :
IF mx>maxx THEN mx = maxx
IF mx<15 THEN mx = 15
IF my>maxy THEN my = maxy
IF my<15 THEN my = 15
dx = mx
dy = my
s = dx*dy

REM DIM integer z(mx + 1, 2)

REM PRINT mx, my
REM waitkey

REM mode 7 : REM 30x240
REM Mode 6, 8 : REM standard 256x240

FOR n = 0 To Sqr(s)
PIXEL 2 + (dx-6)*RND, 2 + (dy-4)*RND, RGB(green)
NEXT n
FOR n = 0 To Sqr(s)/4
PIXEL 2 + (dx-6)*RND, 2 + (dy-4)*RND), RGB(blue)
NEXT n
i_schaf
i_wolf
j = 1

again :
LINE 0, 0, dx-1, 0, , RGB(blue)
LINE 0, 0, 0, dy-1, , RGB(blue)
LINE 0, dy-1, dx-1, dy-1, , RGB(blue)
LINE dx-1, dy-1, dx-1, 0, , RGB(blue)
FOR y = 1 To dy-2
REM PIXEL 0, y + 1, RGB(blue)
REM PIXEL dx-1, y + 1, RGB(blue)
FOR x = 1 To dx-2
o = PIXEL(x, y + 1)
u = PIXEL(x, y-1)
r = PIXEL(x + 1, y)
l = PIXEL(x-1, y)
t = PIXEL(x, y)
IF t>sw THEN GoTo wasser
IF (o = green OR u = green OR r = green OR l = green) AND RND>0.3 THEN t = RGB(green) : GoTo draw
IF (o = blue OR u = blue OR r = blue OR l = blue) AND RND>0.7 THEN t = RGB(blue) : goto draw
IF (o = lilac OR u = lilac OR r = lilac OR l = lilac) AND RND>0.5 THEN t = RGB(magenta) : goto draw
IF RND>0.999 THEN t = RGB(green)
GoTo draw

wasser :
IF t <> blue THEN GoTo gras
IF (o = green OR u = green OR r = green OR l = green) AND RND>0.9 THEN t = RGB(green)
IF RND>0.999 THEN t = RGB(green)
GoTo draw

gras :
IF t <> green THEN GoTo schaf
IF (o = white OR u = white OR r = white OR l = white) AND RND>0.1 THEN t = RGB(white)
IF (o = lilac OR u = lilac OR r = lilac OR l = lilac) AND RND>0.6 THEN t = RGB(magenta)
GoTo draw

schaf :
IF t <> white THEN GoTo wolf
t = sw
IF o = green OR u = green OR r = green OR l = green THEN t = RGB(white)
IF (o = red OR u = red OR r = red OR l = red) AND RND>0.2 THEN t = RGB(red)
GoTo draw

wolf :
IF t <> red THEN GoTo poison
t = sw
REM IF o = white OR u = white OR r = white OR l = white THEN t = RGB(red)
GoTo draw

poison :
IF t <> lilac THEN GoTo nada
IF o = blue OR u = blue OR r = blue OR l = blue THEN IF RND>0.2 THEN t = RGB(blue)
IF o = green OR u = green OR r = green OR l = green THEN IF RND>0.93 THEN t = RGB(green)
goto draw

nada :
REM PRINT @(2, 100)"Nada!"RND

draw :
z(x, y MOD 3) = t
NEXT x
REM PIXEL 0, y + 1, RGB(blue)
REM PIXEL dx-1, y + 1, rgb (blue)
IF y>2 THEN LINE 1, y-1, mx-2, y-1, , RGB(yellow)

IF y>2 THEN FOR x = 1 To dx-2 : PIXEL x, y-2, z(x, (1 + y MOD 3) MOD 3) : NEXT x

k$ = Inkey$
IF k$ = "" THEN GoTo nxt
IF k$ = "A" THEN CLS
IF k$ = "r" THEN Run
IF k$ = "n" THEN CLS : Input"x : ", mx : Input"y : ", my : GoTo start
IF k$ = "q" THEN CLS : Mode 1 : END
IF k$ = "c" THEN r = RND*dy/4 : cx = r + RND*dy/2 : cy = r + RND*dy/2 : CIRCLE cx, cy, r, , , RGB(blue)
IF k$ = "C" THEN r = RND*dy/4 : cx = r + RND*dy/2 : cy = r + RND*dy/2 : CIRCLE cx, cy, r, , , RGB(blue), RGB(blue)
IF k$ = "k" THEN r = RND*dy/4 : cx = r + RND*dy/2 : cy = r + RND*dy/2 : CIRCLE cx, cy, r, , , RGB(black)
IF k$ = "K" THEN r = RND*dy/4 : cx = r + RND*dy/2 : cy = r + RND*dy/2 : CIRCLE cx, cy, r, , , RGB(black), RGB(black)
IF k$ = "g" THEN r = RND*dy/4 : cx = r + RND*dy/2 : cy = r + RND*dy/2 : CIRCLE cx, cy, r, , , RGB(green)
IF k$ = "G" THEN r = RND*dy/4 : cx = r + RND*dy/2 : cy = r + RND*dy/2 : CIRCLE cx, cy, r, , , RGB(green), RGB(green)
IF k$ = "p" THEN r = RND*dy/4 : cx = r + RND*dy/2 : cy = r + RND*dy/2 : CIRCLE cx, cy, r, , , RGB(magenta)
IF k$ = "P" THEN r = RND*dy/8 : cx = r + RND*dy/2 : cy = r + RND*dy/2 : CIRCLE cx, cy, r, , , RGB(magenta), RGB(magenta)
IF k$ = "w" THEN i_wolf
IF k$ = "s" THEN i_schaf
IF k$ = "x" THEN FOR n = 0 To 127 : PIXEL 2 + (dx-4)*RND, 2 + (dy-4)*RND, RGB(magenta) : NEXT n
IF k$ = "W" THEN FOR n = 0 To 127 : PIXEL 2 + (dx-4)*RND, 2 + (dy-4)*RND, RGB(blue) : NEXT n
IF k$ = "S" THEN SAVE IMAGE "lifepx3.bmp"
IF k$ = "L" THEN Load bmp "lifepx3.bmp"
IF k$ = "h" OR k$ = "?" THEN hilfe
nxt :
NEXT y

FOR x = 1 To dx-2 : PIXEL x, y-2, z(x, (1 + y MOD 3) MOD 3) : NEXT x
REM FOR x = 1 To dx-2 : PIXEL x, y-2, RGB(red)
REM LINE 1, y + 1, mx-2, y + 1, , RGB(yellow)
y = y + 1

FOR x = 1 To dx-2 : PIXEL x, y-2, z(x, (1 + y MOD 3) MOD 3) : NEXT x
j = j + 1
GoTo again

Sub hilfe
SAVE IMAGE "buffer.bmp"
CLS
PRINT "keys : "
PRINT "A - atomic bomb!"
PRINT "r - run n - new params q - quit"
PRINT "c - CIRCLE water C - filled"
PRINT "k - CIRCLE clean K - filled"
PRINT "g - CIRCLE grass G - filled"
PRINT "p - CIRCLE poison P - filled"
PRINT "w - insert wolfs s - insert sheeps"
PRINT "W - rain/water x - poisened rain!"
PRINT "L - load landscape S - save"
PRINT
PRINT "h OR ? - this help page"
PRINT
COLOUR RGB(green) : PRINT ". grass ";
COLOUR RGB(blue) : PRINT ". water ";
COLOUR RGB(white) : PRINT ". sheep ";
COLOUR RGB(red) : PRINT ". wolfe ";
COLOUR RGB(magenta) : PRINT ". poison"
COLOUR RGB(white) : PRINT : PRINT "year : ";j; " calculations : "; (j-1)*s + y*(dx-2)
PRINT
PRINT "press a key..."
DO
LOOP until Inkey$ <> ""
Load bmp "buffer.bmp"
END Sub

Sub i_wolf
LOCAL x, y, a
FOR n = 0 To Sqr(s)/8
a = 0
DO
x = 2 + (dx-6)*RND
y = 2 + (dy-4)*RND
o = PIXEL(x, y + 1)
u = PIXEL(x, y-1)
r = PIXEL(x + 1, y)
l = PIXEL(x-1, y)
a = a + 1
LOOP Until o = white OR u = white OR r = white OR l = white OR a>1023
PIXEL x, y, RGB(red)
NEXT n
END Sub

Sub i_schaf
LOCAL x, y, a
FOR n = 0 To Sqr(s)/4
a = 0
DO
x = 2 + (dx-6)*RND
y = 2 + (dy-4)*RND
o = PIXEL(x, y + 1)
u = PIXEL(x, y-1)
r = PIXEL(x + 1, y)
l = PIXEL(x-1, y)
a = a + 1
LOOP Until o = green OR u = green OR r = green OR l = green OR a>1023
PIXEL x, y, RGB(white)
PIXEL x + 1, y, RGB(white)
PIXEL x, y + 1, RGB(white)
NEXT n
END Sub

sub waitkey
DO
LOOP until inkey$ <> ""
END sub

Edited 2023-06-10 08:15 by NPHighview

Live in the Future. It's Just Starting Now!

phil99

Guru

Joined: 11/02/2018
Location: Australia
Posts: 2137

Posted: 10:41pm 09 Jun 2023

Copy link to clipboard

Print this post

The Pixel function will work on most ILI9488 panels if MISO is not shared with any other device. eg Touch and SD card.
If shared it can be made to work with a hardware modification.

Some WaveShare boards with 480x320 ILI9488W LCD display do not have LCD_SDO and so do not support any function that reads data from the display.

hhtg1968
Senior Member

Joined: 25/05/2023
Location: Germany
Posts: 123

Posted: 04:16am 10 Jun 2023

Copy link to clipboard

Print this post

better version. get the number of the colours itself.

life_pmVGA.bas.zip

i will check the "corrected" version these days...

hhtg1968
Senior Member

Joined: 25/05/2023
Location: Germany
Posts: 123

Posted: 04:22am 10 Jun 2023

Copy link to clipboard

Print this post

the new version has variables for the probabilities. in future the user will be able to change this parameters. now you can see the params by pressing "o".

i hope to upload screenshots today...

hhtg1968
Senior Member

Joined: 25/05/2023
Location: Germany
Posts: 123

Posted: 04:38am 10 Jun 2023

Copy link to clipboard

Print this post

new version...

life_pmVGA_4_1_1.bas.zip

hhtg1968
Senior Member

Joined: 25/05/2023
Location: Germany
Posts: 123

Posted: 07:22am 10 Jun 2023

Copy link to clipboard

Print this post

two screenshots and one small movie...

screen3.mp4.zip

hhtg1968
Senior Member

Joined: 25/05/2023
Location: Germany
Posts: 123

Posted: 07:31am 10 Jun 2023

Copy link to clipboard

Print this post

the copyright is a joke. everybody can use or change it.

hhtg1968
Senior Member

Joined: 25/05/2023
Location: Germany
Posts: 123

Posted: 09:55am 10 Jun 2023

Copy link to clipboard

Print this post

newer version

lifepx4.bas.zip

hhtg1968
Senior Member

Joined: 25/05/2023
Location: Germany
Posts: 123

Posted: 05:04pm 10 Jun 2023

Copy link to clipboard

Print this post

newer version.

for australia:

standard ground is now yellow like desert (instead of black). better key commands. use of blit an framebuffer instead of save to flash memory...

i tried to difference between cmm2 and picomitevga, but i cannot test the picomite version. i think that monday oder tuesday will arrive the electronic parts to connect a vga screen to picomite...

lifepx4.bas.zip

hhtg1968
Senior Member

Joined: 25/05/2023
Location: Germany
Posts: 123

Posted: 05:07pm 10 Jun 2023

Copy link to clipboard

Print this post

dim string k$,v$=mm.device$
if v$="Colour Maximite 2" then mode 7
if v$="PicoMiteVGA" then mode 2
option explicit
Cls
Colour rgb(magenta)
Print"LIFEpx4 v4.2.4 for "v$
Print
print"converted from my version for the amstrad cpc 464"
print
print"from 1985!"
print
Colour rgb(white)
Print"(c) hhtg. 10-06-2023 15h38"
Print
Print"press a key ..."

dim z(321,2)
dim integer n,mx,my,sw,gruen,blau,rot,lila,weiss,dx,dy,s,j,x,y,o,u,l,r,t,cx,cy,jj
dim float grw=0.3,grw2=0.999,gww=0.9,ggw=0.6,waw=0.7,waw2=0.999,wow,scw=0.1,sww=0.1,pow=0.8,wgw=0.2
dim float ggw1=0.93
dim integer maxx=800, maxy=600

rem waitkey

do
loop until inkey$=""
for n=0 to 1999999
if inkey$<>"" then exit for
next n

mx=320
my=240

pixel 0,0,rgb(yellow)
sw=pixel(0,0)
rem gruen=65280
pixel 0,0,rgb(green):gruen=pixel(0,0)
rem blau=255
pixel 0,0,rgb(blue):blau=pixel(0,0)
rem rot=16711680
pixel 0,0,rgb(red):rot=pixel(0,0)
rem lila=16711935
pixel 0,0,rgb(magenta):lila=pixel(0,0)
rem weiss=16777215
pixel 0,0,rgb(white):weiss=pixel(0,0)

cls rgb(yellow)

start:
If mx>maxx Then mx=maxx
If mx<15 Then mx=15
If my>maxy Then my=maxy
If my<15 Then my=15
dx=mx
dy=my
s=dx*dy

For n=0 To Sqr(s)
Pixel 2+(dx-6)*Rnd,2+(dy-4)*Rnd,rgb(green)
Next n
For n=0 To Sqr(s)/4
Pixel 2+(dx-6)*Rnd,2+(dy-4)*Rnd),rgb(blue)
Next n
i_schaf
i_wolf
j=1

again:
Line 0,0,dx-1,0,,rgb(blue)
Line 0,0,0,dy-1,,rgb(blue)
Line 0,dy-1,dx-1,dy-1,,rgb(blue)
Line dx-1,dy-1,dx-1,0,,rgb(blue)
For y=1 To dy-2
For x=1 To dx-2
o=Pixel(x,y+1)
u=Pixel(x,y-1)
r=Pixel(x+1,y)
l=Pixel(x-1,y)
t=Pixel(x,y)
If t<>sw Then GoTo wasser
If (o=gruen Or u=gruen Or r=gruen Or l=gruen) and rnd>grw Then t=rgb(green):GoTo draw
if (o=blau or u=blau or r=blau or l=blau) and rnd>waw then t=rgb(blue):goto draw
If (o=lila Or u=lila Or r=lila Or l=lila) And Rnd>pow Then t=rgb(magenta):goto draw
if rnd>grw2 then t=rgb(green)
GoTo draw
wasser:
If t<>blau Then GoTo gras
If (o=gruen Or u=gruen Or r=gruen Or l=gruen) And Rnd>gww Then t=rgb(green)
if rnd>waw2 then t=rgb(green)
GoTo draw
gras:
If t<>gruen Then GoTo schaf
If (o=weiss Or u=weiss Or r=weiss Or l=weiss) and rnd>scw Then t=rgb(white)
if (o=lila or u=lila or r=lila or l=lila) and rnd>ggw then t=rgb(magenta)
GoTo draw
schaf:
If t<>weiss Then GoTo wolf
t=sw
if o=gruen or u=gruen or r=gruen or l=gruen then t=rgb(white)
If (o=rot Or u=rot Or r=rot Or l=rot) and rnd>sww Then t=rgb(red)
GoTo draw
wolf:
If t<>rot Then GoTo poison
t=sw
rem If o=weiss Or u=weiss Or r=weiss Or l=weiss Then t=rgb(red)
GoTo draw
poison:
If t<>lila Then GoTo nada
If o=blau Or u=blau Or r=blau Or l=blau Then If Rnd>wgw Then t=rgb(blue)
If o=gruen Or u=gruen Or r=gruen Or l=gruen Then If Rnd>ggw1 Then t=rgb(green)
goto draw
nada:
rem unknown life form
draw:
z(x,y Mod 3)=t
Next x

k$=Inkey$
If k$="" Then GoTo nxt
if k$="A" then cls sw
If k$="r" Then Run
if k$="n" then count
rem If k$="n" Then Cls:Input"x:",mx:Input"y:",my:GoTo start
If k$="q" Then Cls:Mode 1:End
If k$="c" Then r=Rnd*dy/4:cx=r+Rnd*dy/2:cy=r+Rnd*dy/2:Circle cx,cy,r,,,rgb(blue)
If k$="C" Then r=Rnd*dy/4:cx=r+Rnd*dy/2:cy=r+Rnd*dy/2:Circle cx,cy,r,,,rgb(blue),rgb(blue)
If k$="k" Then r=Rnd*dy/4:cx=r+Rnd*dy/2:cy=r+Rnd*dy/2:Circle cx,cy,r,,,sw
If k$="K" Then r=Rnd*dy/4:cx=r+Rnd*dy/2:cy=r+Rnd*dy/2:Circle cx,cy,r,,,sw,sw
If k$="g" Then r=Rnd*dy/4:cx=r+Rnd*dy/2:cy=r+Rnd*dy/2:Circle cx,cy,r,,,rgb(green)
If k$="G" Then r=Rnd*dy/4:cx=r+Rnd*dy/2:cy=r+Rnd*dy/2:Circle cx,cy,r,,,rgb(green),rgb(green)
If k$="p" Then r=Rnd*dy/4:cx=r+Rnd*dy/2:cy=r+Rnd*dy/2:Circle cx,cy,r,,,rgb(magenta)
If k$="P" Then r=Rnd*dy/8:cx=r+Rnd*dy/2:cy=r+Rnd*dy/2:Circle cx,cy,r,,,rgb(magenta),rgb(magenta)
If k$="w" Then i_wolf
If k$="s" Then i_schaf
If k$="x" Then For n=0 To 127:Pixel 2+(dx-4)*Rnd,2+(dy-4)*Rnd,rgb(magenta):Next n
If k$="W" Then For n=0 To 127:Pixel 2+(dx-4)*Rnd,2+(dy-4)*Rnd,rgb(blue):Next n
If k$="S" Then
if y>2 then For x=1 To dx-2:Pixel x,y-2,z(x,(1+y Mod 3) Mod 3):Next x
save image "lifepx4.bmp",1,1,dx-2,dy-2
endif
If k$="L" Then Load bmp "lifepx4.bmp",1,1
if k$="o" then params
If k$="h" Or k$="?" Then hilfe

nxt:
if y>2 then
line 1,y-1,mx-2,y-1,,rgb(orange)
For x=1 To dx-2:Pixel x,y-2,z(x,(1+y Mod 3) Mod 3):Next x
endif

Next y
For x=1 To dx-2:Pixel x,y-2,z(x,(1+y Mod 3) Mod 3):Next x
y=y+1
For x=1 To dx-2:Pixel x,y-2,z(x,(1+y Mod 3) Mod 3):Next x

print@(2,231)str$(j);
inc j:rem j=j+1
jj=len(str$(j))*6+1
line 1,230,jj,230,,0
line jj,230,jj,239,,0
line 1,230,1,239,,0

GoTo again

sub params
rem save image "buffer.bmp"
rem blit read 1,0,0,dx,dy
cachescr
cls
print"parameters/ probabilities:"
print
print"in desert:"
print"random creation of grass:"(1-grw2)*100" %"
print"growth of grass"(1-grw)*100" %"
print"growth of poison"(1-pow)*100" %"
print"in water:"
print"growth of grass"(1-gww)*100" %"
print"creation of grass"(1-waw2)*100" %"
print"on grass:"
print"growth of sheeps:"(1-scw)*100" %"
print"growth of poison:"(1-ggw)*100" %"
rem print"at the sheeps:"
rem print"sheeps:"
print"at the sheeps:"
print"growth of wolfes:"(1-sww)*100" %"
print"in the poison:"
print"growth of water"(1-wgw)*100" %"
print"growth of grass"(1-ggw1)*100" %"
print
print"press a key..."
waitkey
rem load bmp "buffer.bmp"
rem blit write 1,0,0
popscr
end sub

Sub hilfe
rem Save image "buffer.bmp"
rem blit read 1,0,0,dx,dy
cachescr
Cls
Print"keys:"
print"A - atomic bomb!"
print"n - count the lifeforms"
Print"r - run n - new params q - quit"
Print"c - circle water C - filled"
Print"k - circle clean K - filled"
Print"g - circle grass G - filled"
Print"p - circle poison P - filled"
Print"w - insert wolfs s - insert sheeps"
Print"W - rain/water x - poisened rain!"
Print"L - load landscape S - save"
print" file: lifepx4.png"
print
print"o - show and change parameters"
Print
Print"h or ? - this help page"
Print
colour rgb(yellow)
print". desert ";
Colour rgb(green)
Print". grass ";
Colour rgb(blue)
Print". water ";
Colour rgb(white)
Print". sheep ";
Colour rgb(red)
Print". wolfe ";
Colour rgb(magenta)
Print". poison"
Colour rgb(white)
Print
Print"year: ";j;" calculations: ";(j-1)*s+y*(dx-2)
Print
Print"press a key..."
waitkey
popscr
rem blit write 1,0,0
rem Load bmp "buffer.bmp"
End Sub

Sub i_wolf
Local x,y,a
For n=0 To Sqr(s)/8
a=0
Do
x=2+(dx-6)*Rnd
y=2+(dy-4)*Rnd
o=Pixel(x,y+1)
u=Pixel(x,y-1)
r=Pixel(x+1,y)
l=Pixel(x-1,y)
a=a+1
Loop Until o=weiss Or u=weiss Or r=weiss Or l=weiss Or a>1023
Pixel x,y,rgb(red)
Next n
End Sub

Sub i_schaf
Local x,y,a
For n=0 To Sqr(s)/4
a=0
Do
x=2+(dx-6)*Rnd
y=2+(dy-4)*Rnd
o=Pixel(x,y+1)
u=Pixel(x,y-1)
r=Pixel(x+1,y)
l=Pixel(x-1,y)
a=a+1
Loop Until o=gruen Or u=gruen Or r=gruen Or l=gruen Or a>1023
Pixel x,y,rgb(white)
Pixel x+1,y,rgb(white)
Pixel x,y+1,rgb(white)
Next n
End Sub

sub waitkey
do
loop until inkey$<>""
end sub

sub count
local x,y,t,zn=0,zg=0,zwa=0,zs=0,zw=0,zp=0,za=0
for y=1 to dy-1
for x=1 to dx-1
t=pixel(x,y)
select case t
case sw
inc zn
case gruen
inc zg
case blau
inc zwa
case weiss
inc zs
case rot
inc zw
case lila
inc zp
case else
inc za
end select
next x
next y
cachescr
cls
colour rgb(white)
print"statistics in pixels:"
rem print
rem print"number of pixels"zn+zg+zs+zw+zp
print
colour rgb(yellow)
print"desert: "zn
print
colour rgb(green)
print"grass: "zg
print
colour rgb(blue)
print"water: "zwa
print
colour rgb(white)
print"sheeps: "zs
print
colour rgb(red)
print"wolfes: "zw
print
colour rgb(magenta)
print"poison: "zp
print
if za>0 then
rem print"alien: "za
rem print
endif
colour rgb(white)
print"press a key ..."
waitkey
popscr
end sub

sub cachescr
if v$="Colour Maximite 2" then blit read 1,0,0,dx,dy
if v$="PicoMiteVGA" then framebuffer copy N,F
end sub

sub popscr
if v$="Colour Maximite 2" then blit write 1,0,0
if v$="PicoMiteVGA" then framebuffer write N
end sub

hhtg1968
Senior Member

Joined: 25/05/2023
Location: Germany
Posts: 123

Posted: 08:48pm 10 Jun 2023

Copy link to clipboard

Print this post

version 5...

lifepx5.bas.zip

Turbo46

Guru

Joined: 24/12/2017
Location: Australia
Posts: 1611

Posted: 02:59am 11 Jun 2023

Copy link to clipboard

Print this post

I tried your program on MMB4W but it all happens too fast. I see no intro or menu screen.

do
loop until inkey$=""
for n=0 to 1999999
if inkey$<>"" then exit for
next n

Maybe the timer could be used here to provide a predictable delay? Or just wait for a keypress without a timeout.

Also in your code above you seem to be waiting for NO key press before starting. I have found this below to be more reliable. Sometimes there seems to be a keypress already in the buffer.

do : loop until inkey$=""
do : loop until inkey$<>""

My version of your waitkey sub:

' press any key to continue
' seems necessary to wait for key release on CMM2
sub any_key
print "press any key to continue"
do : loop until inkey$ = "" ' wait for keys to be released
do : loop until inkey$ <> "" ' wait for key to be pressed
end sub

The formatting needs to be changed a little for it to work on MMB4W and I don't know how the get to the menu screen. I'll have to try it on the CMM2 when I can.

Bill

Keep safe. Live long and prosper.

hhtg1968
Senior Member

Joined: 25/05/2023
Location: Germany
Posts: 123

Posted: 05:59am 11 Jun 2023

Copy link to clipboard

Print this post

press "h" or "?" for menu/ help...

does mmb4w have graphic capabilities?

hhtg1968
Senior Member

Joined: 25/05/2023
Location: Germany
Posts: 123

Posted: 06:05am 11 Jun 2023

Copy link to clipboard

Print this post

i made the for loop count to 19999999.

there is a loop because i want the program to start if anyone isn´t there to press a key.

new version...

lifepx5-11-06-2023 _08h02.bas.zip

Turbo46

Guru

Joined: 24/12/2017
Location: Australia
Posts: 1611

Posted: 06:53am 11 Jun 2023

Copy link to clipboard

Print this post

This is the sort of thing I meant with the timer:

dim integer maxx=800, maxy=600
timer = 0
do : loop until inkey$="" ' get rid of any earlier keypress
do
if timer => 5000 then exit do ' wait for 5 seconds
loop until inkey$<>""
pixel 0,0,rgb(yellow):sw=pixel(0,0)

The program will wait five seconds if no key is pressed.

Yes MMB4W does have graphics, this is a display:

It only displays on a small section of the screen. I've not tried it on the CMM2 yet.

I see that you are using a Mac so MMB4W is not so easy. The program just starts and it's not clear what is happening if you don't already know. If the start screen shows something like:

Press any key (H for help)

That would help

I also see that you use upper and lower case keys for selecting different things. If you could use a different key for each choice and use UCASE$ to allow the user to use either upper or lower case for "W" for instance that would help.

It looks interesting but I, for one, need more information about what is happening. I hope you can make it more informative that's all

Thank you for sharing.

Bill

Keep safe. Live long and prosper.

hhtg1968
Senior Member

Joined: 25/05/2023
Location: Germany
Posts: 123

Posted: 08:49am 11 Jun 2023

Copy link to clipboard

Print this post

ecological simulation. yellow is desert. green is grass. white is sheep. red is wolfe.

you can press h or ? for help. there are several functions: atomic bomb. poisoned rain etc. try the keys...

if you change mx and my (320x240 at this time - for the picomitevga and mode 2...) you can have a greater 8or smaller) area...

i will integrate the hint to help at the beginning...

hhtg1968
Senior Member

Joined: 25/05/2023
Location: Germany
Posts: 123

Posted: 09:00am 11 Jun 2023

Copy link to clipboard

Print this post

new version. i tried to learn from the hints from turbo46.

lifepx5_11-06-2023_10h56.bas.zip

Page 1 of 2

Print this page