DECLARE FUNCTION test%(l%,c%,pct%,dir%)
DECLARE SUB Inverte(i%)
DECLARE SUB DoPict(l%,c%,pct%,dir%,f%)
DEFINT A-Z
CONST PiFactor#=1.570796326794896#
TYPE Coord
Lin AS INTEGER
Col AS INTEGER
END TYPE
TYPE Coord2
Lin AS INTEGER
Col AS INTEGER
dir AS INTEGER
END TYPE
DIM SHARED Pict(1 TO 12,1 TO 5)AS Coord,Inv(1 TO 12)
DIM Posit(1 TO 12)AS Coord2
FOR i=1 TO 12
FOR j=1 TO 5
READ Pict(i,j).Lin,Pict(i,j).Col
NEXT
Inv(i)=1
Posit(i).Lin=5*((i-1)\4)+6
Posit(i).Col=10*((i-1)MOD 4)+5
Posit(i).dir=0
NEXT
3 WIDTH 40
CLS
?"Pentamino'1.0"
?"1-Simples"
?"2-Bloco"
?"3-Triplo"
?"0-Sair"
?"- - - - - -"
modo=VAL(INPUT$(1))
SELECT CASE modo
CASE 0:WIDTH 80:SYSTEM
CASE 2
?"-Bloco"
INPUT "Tamanho (3,4,5,6,10,12,15,20) :",x
IF x<3 OR x>20 THEN x=5
IF 60 MOD x=0 THEN y=60\x ELSE x=5:y=12
IF x>y THEN SWAP x,y
CASE 3
?"-Triplo"
?"Tecle <espaco> p/ mudar"
?"      <enter> p/ escolher"
s=1
DO
DoPict 15,20,s,0,1
SELECT CASE INPUT$(1)
CASE " ":DoPict 15,20,s,0,0:s=s MOD 12+1
CASE CHR$(13):EXIT DO
END SELECT
LOOP
END SELECT
COLOR 7,1
CLS
item=1
FOR l=1 TO 25
LOCATE l,1
IF l<3 OR l>23 THEN ?STRING$(40,219);ELSE ?"лл";SPC(36);"лл";
NEXT
teste=0
DO
2 FOR i=1 TO 12
IF i=item THEN COLOR 15,1 ELSE COLOR 7,1
DoPict Posit(i).Lin,Posit(i).Col,i,Posit(i).dir,1
NEXT
COLOR 7,1
SELECT CASE modo
CASE 2
teste=-1
FOR i=3 TO 2+x
FOR j=3 TO 2+y
p=SCREEN(i,j)
teste=teste AND p=8
IF p=32 THEN LOCATE i,j:?"#";
NEXT
NEXT
CASE 3
teste=-1
FOR k=1 TO 5
li=Pict(s,k).Lin
co=Pict(s,k).Col
FOR i=12+3*li TO 14+3*li
FOR j=19+3*co TO 21+3*co
p=SCREEN(i,j)
teste=teste AND p=8
IF p=32 THEN LOCATE i,j:?"#";
NEXT
NEXT
NEXT
END SELECT
l=Posit(item).Lin:c=Posit(item).Col:d=Posit(item).dir
al=l:ac=c:ad=d
1 k$=INKEY$
IF teste AND PLAY(0)=0 THEN PLAY "MBo4l12cdefgabp4"
SELECT CASE k$
CASE "":GOTO 1
CASE CHR$(0)+";" TO CHR$(0)+"D":item=ASC(RIGHT$(k$,1))-58:GOTO 2
CASE CHR$(0)+CHR$(133),CHR$(0)+CHR$(134):item=ASC(RIGHT$(k$,1))-122:GOTO 2
CASE CHR$(0)+"G":l=l-1
CASE CHR$(0)+"O":l=l+1
CASE CHR$(0)+"S":c=c-1
CASE CHR$(0)+"Q":c=c+1
CASE CHR$(0)+"I":d=(d+1)MOD 4
CASE " ":item=item MOD 12+1:GOTO 2
CASE CHR$(9):Inv=-1
CASE CHR$(27):EXIT DO
END SELECT
DoPict al,ac,item,ad,0
IF Inv THEN Inv(item)=-Inv(item)
IF test(l,c,item,d)THEN Posit(item).Lin=l:Posit(item).Col=c:Posit(item).dir=d ELSE IF Inv THEN Inv(item)=-Inv(item)
Inv=0
LOOP
COLOR 7,0
WIDTH 80
?"Continua [S/N] ? ";
DO:a$=UCASE$(INPUT$(1)):LOOP UNTIL a$="S" OR a$="N"
?a$
IF a$="S" THEN 3
SYSTEM
'ўўў
'ў ў
DATA 0,-1,0,0,0,1,1,1,1,-1
'ўўўўў
DATA 0,-2,0,-1,0,0,0,1,0,2
'ўўўў
'ў
DATA 0,-2,0,-1,0,0,0,1,1,1
'ўўўў
'ў
DATA 0,-2,0,-1,0,0,0,1,1,0
'ў
'ўўў
'ў
DATA 0,-1,0,0,0,1,1,1,-1,1
'ў
'ўўў
'ў
DATA 0,-1,0,0,0,1,1,0,-1,0
'ў
'ўўў
'ў
DATA 0,-1,0,0,0,1,1,1,-1,0
'ў
'ўўў
'ў
DATA 0,-1,0,0,0,1,1,1,-1,-1
'ўўў
'ўў
DATA 0,-1,0,0,0,1,1,1,1,0
'ўў
'ўў
'ў
DATA-1,-1,-1,0,0,0,0,1,1,1
'ўў
'ўўў
DATA-1,-2,-1,-1,0,-1,0,0,0,1
'ўўў
'ў
'ў
DATA-1,-1,-1,0,-1,1,0,1,1,1
SUB DoPict(l,c,pct,dir,f)
alfa=FIX(COS(dir*PiFactor#))
beta=FIX(SIN(dir*PiFactor#))
z$=CHR$(32-24*f)
sg=Inv(pct)
FOR i=1 TO 5
li=Pict(pct,i).Lin
co=Pict(pct,i).Col*sg
LOCATE l+li*alfa+co*beta,c+li*-beta+co*alfa
?z$;
NEXT
END SUB
FUNCTION test(l,c,pct,dir)
alfa=FIX(COS(dir*PiFactor#))
beta=FIX(SIN(dir*PiFactor#))
n=-1
sg=Inv(pct)
FOR i=1 TO 5
li=Pict(pct,i).Lin
co=Pict(pct,i).Col*sg
n=n AND(SCREEN(l+li*alfa+co*beta,c+li*-beta+co*alfa)<>219)
NEXT
test=n
END FUNCTION