Немного программ для PicoCalc

 Долго разбирался, как переносить файлы с PicoCalc - не было кабеля, не нашелся адаптер для SD. Сегодня осилил задачу - подцепил к лаптопу и на счастье Windows 10 определила этот самый порт, который не запускался на Windows 7. Скачал Tera Term и после нескольких попыток получил файлы. Причина глюков - настройки:


Набрал команду XMODEM SEND "blt.bas", в программе выбрал команду меню File->Transfer->XMODEM->Recieve..., указал расположение файла и стал ждать.


Классический эффект Insult MegaDemo. Заморочка в том, что обращение к памяти LCD медленное, поэтому создаются буферы, на которых можно рисовать и копировать  данные в видеопамять. Но все равно выходит медленно :(

CLS
FRAMEBUFFER LAYER
FRAMEBUFFER WRITE L
Dim integer t(256)
For i=0 To 255
t(i)=Int(64+63*Sin(i*Pi/128))
Next i
Dim a0 As integer
Dim b0 As integer
Dim a As integer
Dim b As integer
For i=0 To 319
y1=Int(80+80*Sin(Pi*i/160))
y2=Int(80+40*Sin(Pi*i/160*1.7))
Line i,y1,i,y2,,&Hffffff)
Next i
FRAMEBUFFER WRITE N
CLS
Do
a=a0
b=b0
For y=0 To 319
h=t(a)+t(b)
Blit FRAMEBUFFER L,N,0,h,0,y,320,1
a=(a+3) And 255
b=(b+2) And 255
Next y
a0=(a0+3) And 255
b0=(b0+5) And 255
Loop Until Inkey$=Chr$(27)

Здесь у каждого буфера есть свой код: N-экран, L-созданный(хз почему такое имя)

Еще один классический алгоритм называется Space Invaders Fractal. Рисуется медленно
Randomize &h12345
Dim integer w(8)
'precalc
For i=0 To 7
b1%=1
b2%=16
v%=i
For j=0 To 2
If (v% And b1%) Then v%=(v% Or b2%)
b1%=b1%+b1%
b2%=b2%/2
Next j
w(i)=v%
'Print i,v%
Next i

CLS

For x1=0 To 39
For y1=0 To 39

Do
co=Rnd()*&hffffff
Loop Until co

For yy=0 To 4
s%=Int(7*Rnd())
b1%=16
s%=w(s%)
For xx=0 To 4
If (s% And b1%) Then
Pixel x1*8+xx,y1*8+yy,co'&hffffff
EndIf
b1%=b1%/2
Next xx
Next yy
Next y1
Next x1


Не дождался, когда картинка нарисуется, вышел еще один тормозной эффект

y%=0
Do
Blit 0,1,0,0,320,319
For x=0 To 319
If (x Xor y%) Mod 9 <>0 Then
c=0
Else
c=&hffffff
EndIf
Pixel x,319,c
Next x
y%=y%+1
Loop Until Inkey$=Chr$(27)

Пока нет идеи, как ускорить работу, но я надеюсь на чудо (:

Продолжение следует.

Дополнение 14.03.2025. На форуме выложили другой вариант картинки. Надо разбираться.

Option default integer
y=0
Dim px(319),py(319),c(319)
For i=0 To 319
  px(i)=i
  py(i)=319
Next
FRAMEBUFFER create
FRAMEBUFFER write f
Do
Sprite scroll 0,1
For x=0 To 319
c(x)=Choice((x Xor y) Mod 9,0,&HFFFFFF)
Next
Inc y
Pixel px(),py(),c()
FRAMEBUFFER copy f,n
Loop Until Inkey$=Chr$(27)
'chaos game
CLS
Dim x(4),y(4)
For i=0 To 4
x(i)=160*Cos((54+i*72)*Pi/180)
y(i)=160*Sin((54+i*72)*Pi/180)

Next i
xx=160
yy=160
Randomize &H123456
Do
i=Int(Rnd()*5)
xx=(xx+x(i))/2.5
yy=(yy+y(i))/2.5
Pixel xx+160,yy+160,&Hff0000
Loop Until Inkey$=Chr$(27)

'truchet tile
CLS
DefineFont #8
 02410808
 03040808 101020c0 c0201010 08080403
 End DefineFont

 Font 8,1
For i=1 To 1600
 Print Chr$(65+Rnd());
 Next i

Do While Inkey$="":Loop

Font 1

Нашел утилиту-редактор шрифтов. Она входит в состав Picomite_Firmware.

Дополнение 16.03.2026. Еще пара программ, над которыми долго помаялся. Увидел в интернетах  программы, рисующие треугольник Пенроуза, решил переписать по-своему

'tribar aka Penrose triangle

Dim x1%(5)=(137,184,320,98,121,247)
Dim y1%(5)=(0,0,235,235,194,194)

Dim x2%(5)=(320,295,25,137,160,98)
Dim y2%(5)=(235,276,276,85,126,235)

Dim x3%(5)=(137,247,198,137,25,0)
Dim y3%(5)=(0,194,194,85,276,235)
CLS
Polygon 6,x1%(),y1%(),&Hff0000,&hff0000)
Polygon 6,x2%(),y2%(),&H00ff00,&h00ff00)
Polygon 6,x3%(),y3%(),&H0000ff,&h0000ff)

Еще одна - кельтский узел. Оригинальный код легко перенес с justBASIC, и застрял с программой, потому что сделал много опечаток в коде. Начал писать программу вечером и получил глючную картинку. Ночью снились всевозможные решения в коде, проснулся рано и три часа мучался над исправлениями.


'celtic knot from just basic
CLS
Option angle radians
th%=14
xc%=160
yc%=160
d%=th%*5
r%=th%*4
r1%=th%*3
hex!=Pi/3
hd2!=hex!/2
Color &Hffffff
For nh%=1 To 6
x0%=xc%+d%*Cos(nh%*hex!-hd2!)
y0%=yc%+d%*Sin(nh%*hex!-hd2!)
s!=nh%*hex!
'outer radius
arc_ x0%,y0%,r%,s!-0.37,s!+1.2
arc_ x0%,y0%,r%,s!+1.47,s!+2.77
'inner eye
arc_ x0%,y0%,r%,s!+3.05,s!+4.3
arc_ x0%,y0%,r%,s!+4.55,s!+5.6
'inner radius
arc_ x0%,y0%,r1%,s!-0.1,s!+1.15
arc_ x0%,y0%,r1%,s!+1.51,s!+2.73
'inner eye
arc_ x0%,y0%,r1%,s!+3.1,s!+4.25
arc_ x0%,y0%,r1%,s!+4.58,s!+5.32
'outside origins
x0%=xc%+(2*d%-1.5*th%)*Cos(s!)
y0%=yc%+(2*d%-1.5*th%)*Sin(s!)
'outer radius
arc_ x0%,y0%,r%,s!+1.68,s!+3.25

arc_ x0%,y0%,r%,s!+3.51,s!+4.6
'inner radius
arc_ x0%,y0%,r1%,s!+1.98,s!+3.2
arc_ x0%,y0%,r1%,s!+3.56,s!+4.3
Next nh%

Sub arc_  x%,y%,r%,start!,stop!
If stop!<0 Then stop!=stop!+2*Pi
If start!<0 Then start!=start!+2*Pi
If stop!<start! Then
t!=stop!
stop!=start!
start!=t!
End If
ast!=10*Pi/(r%*r%*(stop!-start!))

a!=start!
Do While a!<stop!
 Pixel x%+r%*Cos(a!),y%+r%*Sin(a!)
a!=a!+ast!
Loop
End Sub

Дополнение 22.03.2026

Решил разобраться с рекурсией, получилось не сразу. MMBasic поддерживает до 50 вызовов процедуры, к тому же нужно объявлять переменные, используемые в процедуре локальными. Картинка вышла так себе, так как оригинальная программа рассчитана на другое разрешение окна.



'tripple tree
Option angle radians
Const l=240
Const a=120
CLS
Color &Hffff
'For i=0 To 360
drw_ 160,160,l,1,0
'Next i

Sub drw_ x!,y!,r!,ang!,ro!
Local i,j,r2!,xp!,yp!,ang1!
steps%=Int(360/a)-1
For i=0 To steps%
If i*a<>ang! Then
ang1!=(a*i+ro!)*Pi/180
Line Int(x!),Int(y!),Int(x!+r!*Cos(ang1!)),Int(y!+r!*Sin(ang1!))
End If
Next i

For j=0 To steps%
r2!=r!/2
ang1!=(a*j+ro!)*Pi/180
xp!=x!+r2!*Cos(ang1!)
yp!=y!+r2!*Sin(ang1!)
 If r!>=1 Then
 drw_ xp!,yp!,r2!-10,j*a,ro!
 End If
Next j
End Sub


Код известной программы подготовил на пейси и перенес на Picocalc
CLS
For t!=0 To 2*Pi Step 1/300
    x!=0-721/4*Sin(t!)+196/3*Sin(2*t!)-86/3*Sin(3*t!)-131/2*Sin(4*t!)
    x!=x!+477/14 *Sin(5 *t!) + 27 *Sin(6 *t!) - 29/2 *Sin(7 *t!) + 68/5 *Sin(8*t!)
    x!=x!+1/10 *Sin(9 *t!) + 23/4 *Sin(10 *t!) - 19/2 *Sin(12 *t!) - 85/21 *Sin(13 *t!)
    x!=x!+2/3*Sin(14*t!)+27/5*Sin(15*t!)+7/4*Sin(16*t!)+17/9*Sin(17*t!)
    x!=x!-4*Sin(18*t!)-1/2*Sin(19*t!)+1/6*Sin(20*t!)+6/7*Sin(21*t!)
    x!=x!-1/8*Sin(22*t!)+1/3*Sin(23*t!)+3/2*Sin(24*t!)+13/5*Sin(25*t!)
    x!=x!+Sin(26*t!)-2*Sin(27*t!)+3/5*Sin(28*t!)-1/5*Sin(29*t!)
    x!=x!+1/5*Sin(30*t!)+(2337*Cos(t!))/8-43/5*Cos(2*t!)+322/5*Cos(3*t!)
    x!=x!-117/5*Cos(4*t!)-26/5*Cos(5*t!)-23/3*Cos(6*t!)+143/4*Cos(7*t!)
    x!=x!-11/4*Cos(8*t!)-31/3*Cos(9*t!)-13/4*Cos(10*t!)-9/2*Cos(11*t!)
    x!=x!+41/20*Cos(12*t!)+8*Cos(13*t!)+2/3*Cos(14*t!)+6*Cos(15*t!)
    x!=x!+17/4*Cos(16*t!)-3/2*Cos(17*t!)-29/10*Cos(18*t!)+11/6*Cos(19*t!)
    x!=x!+12/5*Cos(20*t!)+3/2*Cos(21*t!)+11/12*Cos(22*t!)-4/5*Cos(23*t!)
    x!=x!+Cos(24*t!)+17/8*Cos(25*t!)-7/2*Cos(26*t!)-5/6*Cos(27*t!)
    x!=x!-11/10*Cos(28*t!)+1/2*Cos(29*t!)-1/5*Cos(30*t!)

    y! =  -(637 * Sin(t!)) / 2 - 188 / 5 * Sin(2 * t!) - 11 / 7 * Sin(3 * t!)
    y!=y!- 12 / 5 * Sin(4 * t!) + 11 / 3 * Sin(5 * t!) - 37 / 4 * Sin(6 * t!)
    y!=y!+ 8 / 3 * Sin(7 * t!) + 65 / 6 * Sin(8 * t!) - 32 / 5 * Sin(9 * t!)
    y!=y!- 41 / 4 * Sin(10 * t!) - 38 / 3 * Sin(11 * t!) - 47 / 8 * Sin(12 * t!)
    y!=y!+ 5 / 4 * Sin(13 * t!) - 41 / 7 * Sin(14 * t!) - 7 / 3 * Sin(15 * t!)
    y!=y!- 13 / 7 * Sin(16 * t!) + 17 / 4 * Sin(17 * t!) - 9 / 4 * Sin(18 * t!)
    y!=y!+ 8 / 9 * Sin(19 * t!) + 3 / 5 * Sin(20 * t!) - 2 / 5 * Sin(21 * t!)
    y!=y!+ 4 / 3 * Sin(22 * t!) + 1 / 3 * Sin(23 * t!) + 3 / 5 * Sin(24 * t!)
    y!=y!- 3 / 5 * Sin(25 * t!) + 6 / 5 * Sin(26 * t!) - 1 / 5 * Sin(27 * t!)
    y!=y!+ 10 / 9 * Sin(28 * t!) + 1 / 3 * Sin(29 * t!) - 3 / 4 * Sin(30 * t!)
    y!=y!- (125 * Cos(t!)) / 2 - 521 / 9 * Cos(2 * t!) - 359 / 3 * Cos(3 * t!)
    y!=y!+ 47 / 3 * Cos(4 * t!) - 33 / 2 * Cos(5 * t!) - 5 / 4 * Cos(6 * t!)
    y!=y!+ 31 / 8 * Cos(7 * t!) + 9 / 10 * Cos(8 * t!) - 119 / 4 * Cos(9 * t!)
    y!=y!- 17 / 2 * Cos(10 * t!) + 22 / 3 * Cos(11 * t!) + 15 / 4 * Cos(12 * t!)
    y!=y!- 5 / 2 * Cos(13 * t!) + 19 / 6 * Cos(14 * t!) + 7 / 4 * Cos(15 * t!)
    y!=y!+ 31 / 4 * Cos(16 * t!) - Cos(17 * t!) + 11 / 10 * Cos(18 * t!)
    y!=y!- 2 / 3 * Cos(19 * t!) + 13 / 3 * Cos(20 * t!) - 5 / 4 * Cos(21 * t!)
    y!=y!+ 2 / 3 * Cos(22 * t!) + 1 / 4 * Cos(23 * t!) + 5 / 6 * Cos(24 * t!)
    y!=y!+ 3 / 4 * Cos(26 * t!) - 1 / 2 * Cos(27 * t!) - 1 / 10 * Cos(28 * t!)
    y!=y!- 1 / 3 * Cos(29 * t!) - 1 / 19 * Cos(30 * t!)

    Pixel x!/3+160,160-y!/3,&HFFFFFF
Next t!

Порт программы с TIC-80
'dancing circles, TIC-80
Option default integer
n=6
Dim ang(n)
For i=1 To n-1
ang(i)=0
Next i
w=25

FRAMEBUFFER create
FRAMEBUFFER write f
Do
CLS

x=160
y=160
Circle x,y,n*w,1,1,&Hffffff,0
For i=1 To n-1
x=x+w*Cos(ang(i)/30)
y=y+w*Sin(ang(i)/30)
Circle x,y,(n-i)*w,1,1,&Hffffff,0
ang(i)=ang(i)+i
Next i
FRAMEBUFFER wait
FRAMEBUFFER copy f,n
Loop Until Inkey$=Chr$(27)


Эта моя старая идея. Просто перенес код
'polar rose
a0%=0
b0%=0
cc!=Pi/180
FRAMEBUFFER create
FRAMEBUFFER write f

Do
CLS
FRAMEBUFFER wait
a0%=a0%+5
b0%=b0%+3
For j=0 To 2
a%=a0%+j*120
For i=0 To 20
r%=100*Sin((a%+i)*3*cc!)
x%=r%*Cos((a%+i+b0%)*cc!)+160
y%=r%*Sin((a%+i+b0%)*cc!)+160
Circle x%,y%,i>>1,1,1,&Hffffff,&Hffffff)
Next i
Next j
FRAMEBUFFER copy f,n
Loop Until Inkey$=Chr$(27)
'framebufer close f

Не помню, где нашел сам алгоритм на QBasic, который переносил не один раз.

'DLA
CLS
Randomize &H123478
Option default integer
Dim s(319),c(319)
d=1
m=14
For i=0 To 319
s(i)=0
c(i)=0
Next i

Do While d<=319
x=1+Int(Rnd()*318)
f=x
If s(f)<s(x-1) Then f=x-1
If s(f)<s(x+1) Then f=x+1

If Int(Rnd()*2)=1 And s(f)=s(x+1) Then f=x+1
s(x)=s(f)
c(x)=c(f)

If c(x)=0 Then c(x)=1+(x Mod 14)
cc=c(x)
br=Choice(cc And 8,255,127)
rr=Choice(cc And 1,br,0)
gg=Choice(cc And 2,br,0)
bb=Choice(cc And 4,br,0)

Pixel x,319-s(x),RGB(rr,gg,bb)
s(x)=s(x)+1
If s(x)=d Then d=d+1
Loop

Дополнение 25.03.2026
очень медленный алгоритм spigot. Так и не дождался результата. На форуме предложили другие варианты форматирования строки, поэтому часть кода закомментирована.
Вот эти функции:
str$(v,4,0,"0")
right$(str$(v+1000000),4)
format$(v,”%04g”)
'ZX spigot
z$=""
a=10000
n=6525
Dim r(n)
For i=1 To n
r(i)=2000
Next i
r(n-1)=0
c=0
For k=n-1 To 1 Step -14
d=0
i=k
For j=i To 1 Step -1
d=d+r(j)*a
b=2*j-1
r(j)=d-Int(d/b)*b
d=Int(d/b)
If j>1 Then d=d*(j-1)
Next j
v=c+Int(d/a)
c=d-Int(d/a)*a
'If v<10 Then Print "000";:GoTo l270
'If v<100 Then Print "00";:GoTo l270
'If v<1000 Then Print "0";:GoTo l270
'l270:
'Print v;
z$=z$+Format$(v,"%04g")
Print @(0,0) z$
Next k

Пара кривых заимствована из программы на QB:
'sin paths
CLS
df%=0
Option angle radians


For th!=0 To 2*Pi Step 0.015
rad!=-(0.5*Sin(5*th!))*(0.5*Cos(4*th!))*600
an!=th!+Sin(rad!/60)
xp%=Int(160+rad!*Cos(an!))
yp%=Int(160+rad!*Sin(an!))

If df%=1 Then
Line x0%,y0%,xp%,yp%,1,&Hffffff
x0%=xp%
y0%=yp%
Else
df%=1
x0%=xp%
y0%=yp%
End If
Next th!
'sin paths
CLS
df%=0
Option angle radians


For th!=0 To 4*Pi Step 0.04
rad!=(1.05+Sin(th!*4.5))*80
an!=th!-Cos(th!*10)/8
xp%=Int(160+rad!*Cos(an!))
yp%=Int(160+rad!*Sin(an!))

If df%=1 Then
Line x0%,y0%,xp%,yp%,1,&Hffffff
x0%=xp%
y0%=yp%
Else
df%=1
x0%=xp%
y0%=yp%
End If
Next th!

На этом пора переходить к программированию игры Pipes!


Комментарии

Отправить комментарий