'Quad Atari XL game - clear field from boxes
'controls: cursor, space, Esc-quit, Enter - continue game after win
Option default integer
Dim px,py As integer
Dim bf(10,10)
Randomize timer'&H123456
Dim iny(8)=(-1,-1,-1,0,1,1,1,0,0)
Dim inx(8)=(-1,0,1,1,1,0,-1,-1,0)
start_game:
px=1
py=1
countm=0'counter
CLS
For i=0 To 9
For j=0 To 9
bf(i,j)=0
Next j
Next i
'generate field
For i=0 To 14'44 for hardcore
xx=1+Int(7*Rnd())
yy=1+Int(7*Rnd())
invf(xx,yy)
Next i
'draw
For i=0 To 9
For j=0 To 9
If (px=j) And (py=i) Then
bc=&h00ff00
Else
bc=0
EndIf
If bf(j,i) Then
fc=&Hff0000
Else
fc=0
EndIf
Box j*32,i*32,31,31,1,bc,fc
Next j
Next i
'Save image "quad.bmp"
game_loop:
Do
k$=Inkey$
Loop Until k$<>""
If k$=Chr$(128) Then'up
If py>1 Then
py=py-1
drawp(px,py+1)
drawp(px,py)
EndIf
EndIf
If k$=Chr$(129) Then'down
If py<7 Then
py=py+1
drawp(px,py-1)
drawp(px,py)
EndIf
EndIf
If k$=Chr$(130) Then'left
If px>1 Then
px=px-1
drawp(px+1,py)
drawp(px,py)
EndIf
EndIf
If k$=Chr$(131) Then'right
If px<7 Then
px=px+1
drawp(px-1,py)
drawp(px,py)
EndIf
EndIf
If k$=Chr$(32) Then'inverse
invf px,py
countm=countm+1
'For dy=-1 To 1
'For dx=-1 To 1
For i=0 To 8
drawp(px+inx(i),py+iny(i))
Pause 100
Next i
'Next dx
'Next dy
'Check if done
couf=0
For y=0 To 9
For x=0 To 9
couf=couf Or bf(x,y)
Next x
Next y
If couf=0 Then
Font 1,2
Color &Hffffff
Print @(144,144) Str$(countm)
Do
Loop Until Inkey$=Chr$(13)
GoTo start_game
EndIf
EndIf
If k$<>Chr$(27) Then GoTo game_loop
Sub drawp x,y
If x>=0 And x<=9 And y>=0 And y<9 Then
If (px=x) And (py=y) Then
bc=&h00ff00
Else
bc=0
EndIf
If bf(x,y) Then
fc=&Hff0000
Else
fc=0
EndIf
Box x*32,y*32,31,31,1,bc,fc
EndIf
End Sub
Sub invf x,y
For dx=-1 To 1
For dy=-1 To 1
ix=x+dx
iy=y+dy
If ix>=0 And ix<=9 And iy>=0 And iy<=9 Then
bf(ix,iy)=bf(ix,iy) Xor 1
EndIf
Next dy
Next dx
End Sub
1 Like
'100! big number
CLS
Option default integer
Dim string s
Dim a(200)
For i=0 To 199
a(i)=0
Next i
a(0)=1
c=0
For n=100 To 2 Step -1
t=0
For i=0 To c
t=t+a(i)*n
a(i)=t Mod 10
t=Int(t/10)
Next i
Do While t>0
c=c+1
a(c)=t Mod 10
t=Int(t/10)
Loop
Next n
s=""
For i=c To 0 Step -1
s=s+Str$(a(i))
Next i
Print s
2 Likes
Simple memory browser (: with ad=0 working fine, but picomite crashes with ad=12800. Wonder why?
CLS
ad%=0
For x=0 To 39
For y=0 To 319
b%=PEEK(BYTE ad%)
'Print b;
w%=128
For i=0 To 7
If b% And w% Then
Pixel x*8+i,y,&Hffffff
EndIf
w%=w%/2
Next i
ad%=ad%+1
Next y
Next x
'pseudo haiku, space to repeat, Esc-exit
CLS
Randomize timer'&H1234567
Dim w1(5) As string
Dim w2(5) As string
Dim w3(6) As string
Dim w4(5) As string
Dim w5(8) As string
Dim w6(5) As string
Dim w7(4) As string
Restore wordlist
For i=0 To 4
Read w1(i)
Next i
For i=0 To 4
Read w2(i)
Next i
For i=0 To 5
Read w3(i)
Next i
For i=0 To 4
Read w4(i)
Next i
For i=0 To 7
Read w5(i)
Next i
For i=0 To 4
Read w6(i)
Next i
For i=0 To 3
Read w7(i)
Next i
Do
r1=Int(5*Rnd())
r2=Int(5*Rnd())
r3=Int(6*Rnd())
r4=Int(5*Rnd())
r5=Int(8*Rnd())
r6=Int(5*Rnd())
r7=Int(4*Rnd())
Print w1(r1);" ";w2(r2)
Print w3(r3);" ";w4(r4);" ";w5(r5)
Print w6(r6);" ";w7(r7)
Print
k$=""
Do While k$=""
k$=Inkey$
Loop
Loop Until k$=Chr$(27)
wordlist:
Data "Enchanting","Amazing"
Data "Colourful","Delightful"
Data "Delicate"
Data "vision","distance"
Data "conscience"
Data "process","chaos"
Data "superstitous","continous"
Data "graceful","inviting"
Data "contradicting"
Data "overwhelming"
Data "true","dark","cold"
Data "warm","great"
Data "scenery","season"
Data "colours","lights"
Data "Spring","Winter"
Data "Summer","Auumn"
Data "undeniable","beautiful"
Data "irreplaceable"
Data "unbelievable"
Data "irrevocable"
Data "nspiration"
Data "imagination","wisdom"
Data "thoughts"
'
1 Like