REM placka22.bas - doplněná verze
REM vytvořeny vlastní fonty pro správné zobrazování češtiny v DOSBoxu
REM oddělena DATA od zdrojového kódu - načítání ze souboru
REM přidány čtyři nové kombinace a melodie
REM hlášení ukončení při chybě načítání
REM 2010-04-10 - 2010-04-18
start:
DEFINT A-Z
SCREEN 12, 0, 0
COLOR 15
fonttype = 0
ON ERROR GOTO nejsouData
OPEN "placka.dat" FOR INPUT AS #1
ON ERROR GOTO vadnaData
LINE (0, 0)-(639, 239), 1, BF
LOCATE 2, 13: PRINT " Nahrávám data! "
DIM text$(34)
LOCATE 4, 6: PRINT " Texty: ";
FOR i = 0 TO 33
PRINT ".";
INPUT #1, text$(i)
NEXT i
DIM font(223, 7, 2)
LOCATE 6, 6: PRINT " Fonty: ";
FOR f = 0 TO 1
FOR r = 0 TO 223
IF r MOD 8 = 0 THEN PRINT ".";
FOR s = 0 TO 7
INPUT #1, font(r, s, f)
NEXT s, r, f
DIM m(1 TO 35)
DIM m$(1 TO 35, 1 TO 215)
LOCATE 8, 6: PRINT " Hudba: ";
FOR a = 1 TO 35
PRINT ".";
INPUT #1, m(a)
FOR b = 1 TO m(a)
INPUT #1, m$(a, b)
NEXT b, a
DIM asm AS STRING * 54
LOCATE 10, 5: PRINT " Driver: ";
FOR a = 1 TO 54
PRINT ".";
INPUT #1, a$
MID$(asm, a) = CHR$(VAL("&H" + a$))
NEXT a
DIM kombr(14)
DIM kombs(14)
DIM komb(14, 3, 6)
LOCATE 12, 2: PRINT " Kombinace: ";
FOR a = 1 TO 14
INPUT #1, kombr(a)
INPUT #1, kombs(a)
FOR b = 0 TO 3
PRINT ".";
FOR c = 0 TO 6 STEP 2
INPUT #1, komb(a, b, c)
NEXT c, b, a
DIM testr(35, 4, 3)
DIM tests(35, 4, 3)
LOCATE 14, 5: PRINT " Vzorky: ";
FOR a = 1 TO 35
PRINT ".";
FOR b = 1 TO 4
FOR c = 0 TO 3
INPUT #1, testr(a, b, c)
INPUT #1, tests(a, b, c)
NEXT c, b, a
CLOSE #1
ON ERROR GOTO chybaProgramu
DEF fns (t) = 41 - (LEN(text$(t)) \ 2)
GOSUB uvod
RANDOMIZE TIMER
GOSUB mouseInit
DATA 5,5,5,5,5,6,6,5,3,6,5,8,5,6,5,5
DATA 6,6,6,6,3,6,6,8,3,3,5,3,3,6,8,3
DATA 3,8,3,8,3,8,5,3,8,6,8,8,3,8,8,8
cekani1:
a$ = ""
WHILE a$ = ""
a$ = INKEY$
IF a$ = "f" OR a$ = "F" THEN
fonttype = 1 - fonttype
GOSUB uvod
a$ = ""
END IF
GOSUB mouseStatus
IF mb = 1 THEN a$ = "b"
WEND
COLOR 15
CLS
priprava:
RESTORE priprava
t = 25: radek = 2: sloupec = fns(t): GOSUB text
t = 26: radek = 3: sloupec = fns(t): GOSUB text
t = 27: radek = 30: sloupec = fns(t): GOSUB text
DIM p(4, 4)
DIM c(1 TO 4)
t = 34
FOR a = 1 TO 4
text$(t) = CHR$(64 + a): radek = a * 5 + 4: sloupec = 18: GOSUB text
text$(t) = CHR$(68 + a): radek = a * 5 + 4: sloupec = 63: GOSUB text
text$(t) = MID$(STR$(a), 2, 1): radek = 5: sloupec = a * 10 + 16: GOSUB text
text$(t) = MID$(STR$(a + 4), 2, 1): radek = 28: sloupec = a * 10 + 16: GOSUB text
FOR b = 1 TO 4
losovani:
c = INT(RND * 4) + 1
IF c(c) = 4 THEN GOTO losovani
p(a, b) = c
c(c) = c(c) + 1
NEXT b, a
melodie:
REM "Anděl"-6
REM "Batalion"-8
REM "Bedna od whisky"-5
REM "Bratříčku, zavírej vrátka"-5
REM "Dokud se zpívá"-6
REM "Ej, od Buchlova"-6
REM "Holubí dům"-7
REM "Hudsonské šífy"-7
REM "Chlupatý kaktus"-7
REM "Kdyby tady byla taková panenka"-4
REM "Když mě brali za vojáka"-5
REM "Kočka na okně"-6
REM "Krajina posedlá tmou"-6
REM "Motýl"-10
REM "Náhrobní kámen"-5
REM "Něco o lásce"-10
REM "Okno mé lásky"-5
REM "Po starých zámeckých schodech"-7
REM "Pramínek vlasů"-10
REM "Pravda a lež"-9
REM "Prídi ty, šuhajko"-8
REM "Purpura"-6
REM "Santa Lucia"-7
REM "Rikatado"-7
REM "Rosa na kolejích"-9
REM "Řeka hučí"-9
REM "Třešně zrály"-7
REM "Tři kríže"-8
REM "Už se ten Tálínskej rybník nahání"-5
REM "Veď mě dál, cesto má"-8
REM "Zelené pláně"-10
REM "Náš kraj"-7
REM "Dorogoj dlinnoju"-8
REM "Stěnka Razin"-8
REM "Million alych roz"-8
paleta:
FOR a = 1 TO 4
READ c(a)
NEXT a
DATA 1,12,10,15
sipky:
FOR a = 1 TO 4
LINE (a * 80 + 103, 78)-(a * 80 + 143, 78)
LINE (a * 80 + 143, 78)-(a * 80 + 123, 58)
LINE (a * 80 + 123, 58)-(a * 80 + 103, 78)
LINE (a * 80 + 103, 431)-(a * 80 + 143, 431)
LINE (a * 80 + 143, 431)-(a * 80 + 123, 451)
LINE (a * 80 + 123, 451)-(a * 80 + 103, 431)
LINE (146, a * 80 + 35)-(146, a * 80 + 75)
LINE (146, a * 80 + 75)-(126, a * 80 + 55)
LINE (126, a * 80 + 55)-(146, a * 80 + 35)
LINE (492, a * 80 + 35)-(492, a * 80 + 75)
LINE (492, a * 80 + 75)-(512, a * 80 + 55)
LINE (512, a * 80 + 55)-(492, a * 80 + 35)
NEXT a
kombinace:
FOR a = 1 TO 14
FOR b = 0 TO 3
FOR c = 0 TO 6 STEP 2
LOCATE kombr(a) + b, kombs(a) + c
COLOR komb(a, b, c)
PRINT "██";
NEXT c, b, a
COLOR 15
LINE (158, 94)-(480, 416), 14, B
GOSUB mouseShow
GOSUB maluj
klavesa:
a$ = INKEY$
GOSUB mouseStatus
IF a$ = "" THEN GOTO klavesa
posun:
IF a$ < "a" OR a$ > "h" THEN
IF a$ < "1" OR a$ > "8" THEN
IF a$ = CHR$(27) THEN
GOTO konec
ELSE
GOTO klavesa
END IF
ELSE
IF a$ > "4" THEN
a = VAL(a$) - 4
p(0, a) = p(4, a)
FOR b = 4 TO 1 STEP -1
p(b, a) = p(b - 1, a)
NEXT b
ELSE
a = VAL(a$)
FOR b = 0 TO 3
p(b, a) = p(b + 1, a)
NEXT b
p(4, a) = p(0, a)
END IF
END IF
ELSE
IF a$ > "d" THEN
a = ASC(a$) - 100
p(a, 0) = p(a, 4)
FOR b = 4 TO 1 STEP -1
p(a, b) = p(a, b - 1)
NEXT b
ELSE
a = ASC(a$) - 96
FOR b = 0 TO 3
p(a, b) = p(a, b + 1)
NEXT b
p(a, 4) = p(a, 0)
END IF
END IF
test:
PLAY "t255o3l64cde"
GOSUB maluj
FOR a = 1 TO 35
f = 1
FOR b = 1 TO 4
FOR c = 1 TO 3
IF p(testr(a, b, c - 1), tests(a, b, c - 1)) <> p(testr(a, b, c), tests(a, b, c)) THEN f = 0
NEXT c, b
IF f THEN GOTO hudba
NEXT a
delay:
a$ = INKEY$
GOSUB mouseStatus
IF LEN(a$) THEN GOTO delay
GOTO klavesa | |
konec:
LINE (160, 16)-(471, 47), 0, BF
t = 28: radek = 2: sloupec = fns(t): GOSUB text
t = 29: radek = 3: sloupec = fns(t): GOSUB text
PLAY "t255o4l2c"
cekani2:
a$ = INPUT$(1)
IF a$ = "a" OR a$ = "A" OR a$ = CHR$(13) THEN GOTO ven
IF a$ = "n" OR a$ = "N" OR a$ = CHR$(27) THEN
LINE (160, 16)-(471, 47), 0, BF
t = 25: radek = 2: sloupec = fns(t): GOSUB text
t = 26: radek = 3: sloupec = fns(t): GOSUB text
GOTO klavesa
END IF
GOTO cekani2 |
ven:
CLS
t = 30: radek = 12: sloupec = fns(t): GOSUB text
t = 31: radek = 13: sloupec = fns(t): GOSUB text
t = 32: radek = 14: sloupec = fns(t): GOSUB text
t = 33: radek = 15: sloupec = fns(t): GOSUB text
t = 30: radek = 16: sloupec = fns(t): GOSUB text
SLEEP 3
SCREEN 0, 0, 0
SYSTEM |
maluj:
GOSUB mouseHide
FOR a = 1 TO 4
FOR b = 1 TO 4
LINE (b * 80 + 80, a * 80 + 16)-(b * 80 + 158, a * 80 + 94), c(p(a, b)), BF
NEXT b, a
GOTO mouseShow
RETURN |
hudba:
f = 1
GOSUB mouseHide
FOR b = 1 TO m(a)
IF LEN(INKEY$) THEN f = 0
IF f THEN PLAY m$(a, b)
NEXT b
GOSUB mouseShow
GOTO delay |
mouseInit:
ax = 0
GOSUB driver
RETURN |
mouseShow:
ax = 1
GOSUB driver
RETURN |
mouseHide:
ax = 2
GOSUB driver
RETURN |
mouseStatus:
ax = 3
GOSUB driver
IF mb = 1 THEN
IF mx < 120 OR mx > 518 OR my < 56 OR my > 454 THEN RETURN
mx = mx - 80
my = my - 16
r = my \ 80
s = mx \ 80
IF r = 0 OR r = 5 THEN
IF s > 0 AND s < 5 THEN
a = s
IF r = 5 THEN a = a + 4
a$ = RIGHT$(STR$(a), 1)
END IF
END IF
IF s = 0 OR s = 5 THEN
IF r > 0 AND r < 5 THEN
a = r
IF s = 5 THEN a = a + 4
a$ = RIGHT$(CHR$(a + 96), 1)
END IF
END IF
END IF
RETURN |
driver:
DEF SEG = VARSEG(asm)
CALL Absolute(ax, mb, mx, my, VARPTR(asm))
RETURN |
|
uvod:
COLOR 15
CLS
LINE (0, 0)-(639, 479), , B
LINE (1, 1)-(638, 478), , B
LINE (3, 3)-(636, 476), , B
RESTORE
FOR a = 4 TO 28
t = a - 4: radek = a: sloupec = 41 - LEN(text$(a - 4)) \ 2: GOSUB text
NEXT a
FOR a = 12 TO 15
FOR b = 37 TO 43 STEP 2
READ c
LOCATE a, b - 12
COLOR c
PRINT "██"
READ c
LOCATE a, b
COLOR c
PRINT "██"
READ c
LOCATE a, b + 12
COLOR c
PRINT "██"
NEXT b, a
RETURN |
text:
FOR i = 1 TO LEN(text$(t))
znak = ASC(MID$(text$(t), i, 1))
FOR j = 0 TO 7
LINE (sloupec * 8 - 8 + j, radek * 16 - 16)-(sloupec * 8 - 8 + j, radek * 16 - 1), , , font(znak - 32, j, fonttype)
NEXT j
sloupec = sloupec + 1
IF sloupec > 80 THEN sloupec = 1: radek = radek + 1
IF radek > 30 THEN radek = 1
NEXT i
RETURN |
nejsouData:
LINE (171, 159)-(451, 303), 14, BF
LINE (175, 163)-(447, 299), 4, BF
LOCATE 13, 31
PRINT " Nenalezen soubor "
LOCATE 15, 32
PRINT ">> PLACKA.DAT <<"
LOCATE 17, 28
PRINT " program nelze spustit! "
GOTO ukoncit |
vadnaData:
LINE (171, 159)-(451, 303), 14, BF
LINE (175, 163)-(447, 299), 4, BF
LOCATE 13, 31
PRINT " Chyba v souboru "
LOCATE 15, 32
PRINT ">> PLACKA.DAT <<"
LOCATE 17, 28
PRINT " program nelze spustit! "
GOTO ukoncit |
chybaProgramu:
LINE (171, 159)-(451, 303), 14, BF
LINE (175, 163)-(447, 299), 4, BF
LOCATE 14, 32
PRINT " Chyba programu "
LOCATE 16, 28
PRINT " zkus ho znovu spustit! "
ukoncit:
PLAY "t200o4l8cbcbcbl4cp1p2"
FOR i = 0 TO 96
time! = TIMER
LINE (171 + i, 159 + i / 1.5)-(451 - i, 303 - i / 1.5), 0, B
WHILE time! = TIMER: WEND
NEXT i
SLEEP 1
SCREEN 0, 0, 0
SYSTEM |
| |
