We just released a Feb. 5 '89 prototype of DuckTales for the NES!
If you'd like to support our preservation efforts (and this wasn't cheap), please consider donating or supporting us on Patreon. Thank you!
If you'd like to support our preservation efforts (and this wasn't cheap), please consider donating or supporting us on Patreon. Thank you!
Filetto
Jump to navigation
Jump to search
|
|
| Filetto |
|---|
|
Developer:
Novarmatic
|
Uncompiled Source Code
Starting at 0x601 in m3.u4 is a lot of uncompiled source code.
GER, OFFORI() AS INTEGER, OFFSIN() AS INTEGER, OFFDES() AS INTEGER
'14300 REM cancella DIM per strategie
ERASE RIGHEVER%, RIGHEORI%, RIGHESIN%, RIGHEDES%
ERASE OFFVER%, OFFORI%, OFFSIN%, OFFDES%
END SUB
SUB CanSimbolo (X AS INTEGER, Y AS INTEGER)
SHARED a3() AS INTEGER
'10300 REM cancella simbolo
REM simbolo a partire da coordinate X,Y
PUT (ConvXL(X), ConvYH(Y)), a3, PSET
END SUB
SUB CentriSchermo
'13500 REM fai centri sullo schermo al posto dei simboli
FOR X = 1 TO XM
FOR Y = 1 TO YM
CALL StampaCentro(X, Y)
NEXT Y
NEXT X
END SUB
SUB Clock (X AS STRING, C AS INTEGER)
'24000 REM clock
T2$ = MID$(TIME$, 7, 2)
IF T2$ = X$ THEN 24060
C = C - 1
X$ = T2$
24060 REM
END SUB
SUB ConfrontaStringa (E AS INTEGER, j AS INTEGER, Z AS INTEGER, STRA() AS SINGLE, XA AS STRING)
SHARED NUMSIMB AS INTEGER, CERCA() AS STRING, CODCERCA() AS SINGLE
'22800 REM confronta XA$ con CERCA$(I,J) [J --> giocatore]
REM esce con E = 1 se trovato vincitore, Z offset
REM incrementa punteggio
E = 0
STRA(j) = 0
REM
FOR i = 2 TO 2 ^ NUMSIMB
Z = INSTR(1, XA$, CERCA$(i, j))
WHILE Z <> 0
IF CODCERCA(i) > STRA(j) THEN STRA(j) = CODCERCA(i)
Z = INSTR(Z + 1, XA$, CERCA$(i, j))
WEND
NEXT i
REM ricerca eventuale vincitore
Z = INSTR(XA$, CERCA$(i - 1, j))
IF Z > 0 THEN E = 1: ' vittoria !
END SUB
SUB ConfrontaStringaVer (E AS INTEGER, j AS INTEGER, Z AS INTEGER, STRA() AS SINGLE, XA AS STRING)
SHARED NUMSIMB AS INTEGER, CERCA() AS STRING, CODCERCA() AS SINGLE
REM confronta XA$ con CERCA$(I,J) [J --> giocatore]
REM esce con E = 1 se trovato vincitore, Z offset
REM incrementa punteggio
E = 0
i = 1
STRA(j) = 0
REM
FOR N = 1 TO NUMSIMB
i = i * 2
Z = INSTR(1, XA$, CERCA$(i, j))
WHILE Z <> 0
IF CODCERCA(i) > STRA(j) THEN STRA(j) = CODCERCA(i)
Z = INSTR(Z + 1, XA$, CERCA$(i, j))
WEND
NEXT N
REM ricerca eventuale vincitore
Z = INSTR(XA$, CERCA$(i, j))
IF Z > 0 THEN E = 1: ' vittoria !
END SUB
SUB ConvScala (Z AS STRING)
SHARED VSCALa() AS STRING, VSCAL() AS INTEGER
'36600 REM scala 1:2 in orizzontale
Z$ = Z$ + " "
U$ = ""
FOR II = 1 TO 5 STEP 2
FOR i = 1 TO 4
IF INSTR(II, Z$, VSCALa$(i)) = II THEN 36680
NEXT i
STOP
36680 U$ = U$ + CHR$(VSCAL(i))
NEXT II
REM
Z$ = U$
END SUB
FUNCTION ConvXL (X AS INTEGER)
'10500 REM trasforma coordinate X,Y in L,h
ConvXL = OFL + (X - 1) * (DL + MARL)
END FUNCTION
FUNCTION ConvYH (Y AS INTEGER)
'10500 REM trasforma coordinate X,Y in L,h
ConvYH = OFH + (Y - 1) * (DH + MARH)
END FUNCTION
FUNCTION CooCentroH (h AS INTEGER)
'10600 REM modifica coordinate L,H per centri dei simboli
REM uscita sempre L,H
CooCentroH = h + DH / 2
END FUNCTION
FUNCTION CooCentroL (L AS INTEGER)
'10600 REM modifica coordinate L,H per centri dei simboli
REM uscita sempre L,H
CooCentroL = L + DL / 2
END FUNCTION
SUB CreditiParz (i AS INTEGER)
STATIC creparz AS INTEGER
creparz = creparz + 1
IF creparz >= 2 THEN
i = i + 1
creparz = 0
END IF
END SUB
SUB DataScritte (colfore() AS INTEGER, colback() AS INTEGER, coox() AS INTEGER, COOY() AS INTEGER, mss() AS STRING, i AS INTEGER, PAG AS INTEGER)
'5600 REM leggi
READ colfore(i, PAG), colback(i, PAG)
READ coox(i, PAG), COOY(i, PAG)
READ mss$(i, PAG)
IF coox(i, PAG) <> 0 THEN 5670
REM stampa centrata
coox(i, PAG) = (40 - LEN(mss$(i, PAG))) / 2
5670 REM
END SUB
SUB DefGio (X AS INTEGER, Y AS INTEGER)
'24700 REM definizione numero giocatori
X = 2
Y = 1: ' giocatore attuale
END SUB
SUB Difficol (E, Z, R, X, Y, PLIB(), mosse())
SHARED DIFF AS INTEGER, GIO AS INTEGER, NGIO AS INTEGER, LIVATT AS INTEGER
X = 0
IF NGIO = 2 OR LIVATT <= 1 THEN 10
CALL ScegliDiff(X)
IF X = 0 THEN 10 ' caso percentuale difficolt…
Y = 1 ' prima riga
IF GIO = 1 THEN GIO = 2 ELSE GIO = 1
CALL SimboliMovim(E, Z, R, X, Y, PLIB(), mosse()) ' fai uscire mossa
IF GIO = 1 THEN GIO = 2 ELSE GIO = 1
10
END SUB
SUB EsceCasualm (X AS INTEGER, PRFV AS INTEGER, PRFN AS INTEGER)
SHARED PLIB() AS INTEGER
'28700 REM esce casualmente per tempo a disposizione finito
REM prfv = posizione freccia (vecchia)
REM controlla anche PLIB() per vedere se c'e' ancora posto nella fila
WHILE PLIB(PRFV) = YM
IF RND >= .5 THEN X = 1 ELSE X = -1
PRFN = PRFN + X
IF PRFN < 1 THEN PRFN = XM ELSE IF PRFN > XM THEN PRFN = 1
CALL PosFreccia(PRFV) ' aggiorna freccia
WEND
X = PRFV
END SUB
SUB FaiFreccia (COL AS INTEGER)
SHARED L1() AS INTEGER, H1() AS INTEGER, cl() AS INTEGER
'22400 REM fai freccia
i = 1
WHILE L1(i + 1) <> 0 AND H1(i + 1) <> 0
LINE (L1(i), H1(i))-(L1(i + 1), H1(i + 1)), cl(COL)
i = i + 1
WEND
PAINT (L1(1), H1(1) + 1), cl(COL)
END SUB
SUB FaiNumGraf (C AS INTEGER)
' c = set caratteri salvati in alpha() dentro rettangolo tempo
'14400 REM scrivi numeri grafici in "tempo" grafico
REM
h = G0Y + INT(STO - CARY) / 2: ' centratura numero grafico
FOR k = 1 TO TEM
X$ = STR$(COSTPUNT * (TEM - k + 1))
X$ = RIGHT$(X$, LEN(X$) - 1)
L = G0X + 10
CALL StringaOri(X$, L, h, C) ' stampa alfanumerici da X$ in L,H C = set
h = h + STO
NEXT k
END SUB
SUB FaiSimbolo (X AS INTEGER)
SHARED LL() AS INTEGER, HH() AS INTEGER, cl() AS INTEGER
'20210 REM fai il simbolo
i = 1
WHILE LL(i + 1) <> 0 AND HH(i + 1) <> 0
LINE (LL(i), HH(i))-(LL(i + 1), HH(i + 1)), cl(X)
i = i + 1
WEND
PAINT (OFL + DL / 2, OFH + DH / 2), cl(X)
END SUB
SUB FaiTempoGraf (X AS INTEGER, Y AS INTEGER)
' x colore fondo, y = colore bordo
SHARED cl() AS INTEGER
'25100 REM fai tempo grafico
LINE (G0X, G0Y)-(GX, GY), cl(X), BF
LINE (G0X - 1, G0Y - 1)-(GX + 1, GY + 1), cl(Y), B
CALL FaiNumGraf(X) ' scrivi numeri grafici in "tempo" grafico
END SUB
SUB Gestdes1 (X AS INTEGER, Z AS INTEGER)
'20500 REM freccia destra KEY(13) PRIMO GIOCATORE
X = X + 1
IF X > Z THEN X = 1
REM
END SUB
SUB Gestdes2 (X AS INTEGER, Z AS INTEGER)
'20750 REM freccia destra KEY(7) SECONDO GIOCATORE
X = X + 1
IF X > Z THEN X = 1
END SUB
'
SUB Gestpul1 (X AS INTEGER)
'20600 REM scelta colonna PRIMO GIOCATORE
X = 1 ' premuto pulsante
IF PLAY(N) > 0 THEN 20635
PLAY "mbo5g16"
20635 REM [LABEL]
END SUB
SUB Gestpul2 (X AS INTEGER)
'20800 REM scelta colonna SECONDO GIOCATORE
X = 1 ' segnala premuto pulsante2
IF PLAY(N) > 0 THEN 20855
PLAY "mbo5g16"
20855 REM [LABEL]
END SUB
SUB Gestsin1 (X AS INTEGER, Z AS INTEGER)
'20420 REM freccia sinistra KEY(12) PRIMO GIOCATORE
X = X - 1
IF X < 1 THEN X = Z
END SUB
SUB Gestsin2 (X AS INTEGER, Z AS INTEGER)
'20700 REM freccia sinistra KEY(6) SECONDO GIOCATORE
X = X - 1
IF X < 1 THEN X = Z
END SUB
SUB GiocPerdente (E AS INTEGER)
SHARED GIO AS INTEGER, cre AS INTEGER
'29300 REM pagina crediti per prosecuzione partita giocatore perdente
CLS
LOCATE 7, 4, 0
COLOR 23, 0
PRINT "GIOCATORE ";
COLOR 6, 0
PRINT GIO;
COLOR 7, 0
PRINT "se vuoi continuare,"
COLOR 5, 0
LOCATE 12, 4, 0
PRINT "dai almeno ";
COLOR 22, 0
PRINT "UN CREDITO"
COLOR 7, 0
CALL StampaCrediti
E = -1: ' per start KEY(9) e KEY(10)
CLK = TEMPERD
T1$ = MID$(TIME$, 7, 2)
COLOR 7, 0
WHILE CLK > 0 AND E = -1
CALL Clock(T1$, CLK)
SELECT CASE PC
CASE 1
KEY(1) STOP
CASE 0
STRIG(0) STOP
END SELECT
COLOR 2, 0
LOCATE 20, 1, 0
PRINT "Tempo rimanente =";
PRINT USING "###"; CLK;
PRINT " sec"
COLOR 7, 0
SELECT CASE PC
CASE 1
KEY(1) ON
CASE 0
STRIG(0) ON
END SELECT
IF cre > 0 THEN
CALL Letturadip(E) ' aspetta selezione giocatore
IF E <> GIO THEN
E = -1 ' per start (era 29800)
END IF
END IF
WEND
END SUB
SUB Inialfabeto (alfabeto() AS STRING)
'17200 REM inizializza alfabeto$() per nome record
FOR i = 1 TO LENALFABASE
alfabeto$(i) = CHR$(ASC("A") + i - 1)
NEXT i
RESTORE 17330
FOR j = i TO i + LENALFAEXTRA - 1
READ alfabeto$(j)
NEXT j
END SUB
SUB IniCerca (CERCA() AS STRING, CODCERCA() AS SINGLE)
SHARED VA() AS STRING, NUMSIMB AS INTEGER
'22500 REM inizializzazione CERCA$(i,1-2) per strategia
XA$ = STRING$(NUMSIMB, AMMESSA$)
FOR i = 1 TO 2 ^ NUMSIMB
CERCA$(i, 1) = XA$
CERCA$(i, 2) = XA$
CODCERCA(i) = 0
NEXT i
REM
FOR i = 1 TO NUMSIMB
Z = 2 ^ (i - 1)
FOR j = Z + 1 TO 2 ^ NUMSIMB STEP Z * 2
FOR k = 1 TO Z
MID$(CERCA$(j + k - 1, 1), i) = VA$(1)
MID$(CERCA$(j + k - 1, 2), i) = VA$(2)
CODCERCA(j + k - 1) = CODCERCA(j + k - 1) + 1
NEXT k
NEXT j
NEXT i
REM carica valori per strategia 10 exp N
FOR i = 2 TO 2 ^ NUMSIMB
j = CODCERCA(i) - 1
CODCERCA(i) = 10 ^ j
NEXT i
END SUB
SUB IniFreccia (A() AS INTEGER, b() AS INTEGER)
SHARED L1() AS INTEGER, H1() AS INTEGER
'22000 REM inizializzazione freccia
REM
L1(1) = OFL + DL / 2: H1(1) = OFH
L1(2) = L1(1) + DL / 4: H1(2) = H1(1) + DH / 3
L1(3) = L1(1) + DL / 10: H1(3) = H1(2)
L1(4) = L1(3): H1(4) = H1(1) + DH
L1(5) = L1(1) - DL / 10: H1(5) = H1(4)
L1(6) = L1(5): H1(6) = H1(2)
L1(7) = L1(1) - DL / 4: H1(7) = H1(2)
L1(8) = L1(1): H1(8) = H1(1)
L1(9) = 0: H1(9) = 0
CLS
REM fai freccia
CALL FaiFreccia(3)
GET (OFL, OFH)-(OFL + MARL + DL, OFH + DH + MARH), A
REM freccia per cancellazione
CALL FaiFreccia(0)
GET (OFL, OFH)-(OFL + MARL + DL, OFH + DH + MARH), b
END SUB
SUB IniGenTab STATIC
'variabili modificate
SHARED RVER() AS STRING, RORI() AS STRING, RSIN() AS STRING, RDES() AS STRING
SHARED LRSIN AS INTEGER, LRDES AS INTEGER
SHARED RIGHEVER() AS INTEGER, RIGHEORI() AS INTEGER, RIGHESIN() AS INTEGER, RIGHEDES() AS INTEGER
SHARED OFFVER() AS INTEGER, OFFORI() AS INTEGER, OFFSIN() AS INTEGER, OFFDES() AS INTEGER
'17900 REM inizializzazione RIGHEXXX(x,y) OFFXXX(x,y) RXXX(i)
CALL CancellaDim ' erase per RIGHEXXX%() e OFFXXX%()
CALL IniTabVer(RVER(), RIGHEVER(), OFFVER())' inizializzazione conv verticali
CALL IniTabOri(RORI(), RIGHEORI(), OFFORI()) ' inizializzazione conv orizzontali
CALL IniTabInclSin(RSIN(), LRSIN, RIGHESIN(), OFFSIN()) ' inizializzazione conv \ sinistra
CALL IniTabInclDes(RDES(), LRDES, RIGHEDES(), OFFDES()) ' inizializzazione conv / destra
END SUB
SUB IniLampFila (A() AS INTEGER, R AS INTEGER, X AS INTEGER, Y AS INTEGER)
SHARED NUMSIMB AS INTEGER
'28000 REM caricamento fila da lampeggiare
FOR i = 1 TO NUMSIMB
A(i, 1) = X
A(i, 2) = Y
SELECT CASE R
CASE 1
REM caso verticale
Y = Y + 1
CASE 2
REM caso orizzontale
X = X + 1
CASE 3
REM caso inclinata a sinistra \
X = X + 1
Y = Y + 1
CASE 4
REM caso inclinata a destra /
X = X - 1
Y = Y + 1
END SELECT
NEXT i
END SUB
SUB IniMusiche (Z AS INTEGER, M() AS STRING)
'41200 REM inizializzazione musiche
RESTORE 40000
Z = 1
ON PLAY(3) GOSUB 41000
READ NMOTIV: ' numero motivetti
FOR j = 1 TO NMOTIV
READ NDTAMUS
FOR i = 1 TO NDTAMUS
READ M$(i, j)
NEXT i
NEXT j
END SUB
DEFSNG A-Z
SUB Ininumgraf (A() AS INTEGER)
DEFINT A-Z
SHARED cl() AS INTEGER
DIM CA(KGRAF) AS INTEGER, CARG(KGRAF) AS INTEGER
'13800 REM inizializza caratteri numerici grafici
REM numero byte =4 + INT((x * bitsperpixel + 7)/8)*y
REM inizializza alfanumerico grafico
FOR i = 1 TO NUMCARGRAF
LOCATE 1, 1
PRINT CHR$(ASC("0") + i - 1)
GET (0, 0)-(CARX, CARY), CARG%
FOR Z = 1 TO 2
LINE (0, 0)-(CARX, CARY), cl(Z), BF
PUT (0, 0), CARG%, AND
GET (0, 0)-(CARX, CARY), CA%
FOR j = 0 TO NUMBYTE / 2 - 1
A(j, i, Z) = CA%(j)
NEXT j
NEXT Z
NEXT i
END SUB
SUB IniperStrat (LINPARZ AS INTEGER, LININTERE AS INTEGER) STATIC
SHARED NUMSIMB AS INTEGER
' le variabili sotto sono modificate
SHARED RVER() AS STRING, RORI() AS STRING, RSIN() AS STRING, RDES() AS STRING, LRSIN AS INTEGER, LRDES AS INTEGER
SHARED CERCA() AS STRING, CODCERCA() AS SINGLE
SHARED STRA() AS SINGLE, STRAVER() AS SINGLE, STRAORI() AS SINGLE, STRASIN() AS SINGLE, STRADES() AS SINGLE
SHARED PLIB() AS INTEGER
'14600 REM inizializzazioni per strategia (ad ogni inizio partita)
LININTERE = ABS(XM - YM) + 1
IF XM > YM THEN
LINPARZ = YM - NUMSIMB
ELSE LINPARZ = XM - NUMSIMB
END IF
CALL IniGenTab ' inizializzazione RIGHE OFF R ecc
CALL IniCerca(CERCA$(), CODCERCA()) ' inizializzazione di CERCA$(i,1-2)
REM inizializza posizioni permesse
CALL IniPosPermesse(RVER(), RORI(), RSIN(), RDES())' inizializza posizioni permesse
CALL AggPuntGen(STRA(), STRAVER(), STRAORI(), STRASIN(), STRADES())' aggiorna punteggio tutte le righe
CALL ZeroPLib(PLIB()) ' PLIB(0) <- 0
END SUB
SUB IniPosPermesse (RVER() AS STRING, RORI() AS STRING, RSIN() AS STRING, RDES() AS STRING)
'23000 REM inizializza posizioni permesse
FOR j = 1 TO XM
CALL Scrive4Stri(RVER(), RORI(), RSIN(), RDES(), AMMESSA$, j, 1)' XA$ --> X,Y in tutte le righe passanti da x,y
NEXT j
END SUB
DEFSNG A-Z
SUB Inirecord (v1() AS STRING, v2() AS INTEGER, v3() AS INTEGER)
DEFINT X
'12700 REM inizializzazione pagina record
FOR X = 1 TO NUMREC
v1(X) = ININOMEREC$
v2(X) = INIQPUNTREC
v3(X) = INILIVREC
NEXT X
END SUB
DEFINT A-W, Y-Z
SUB IniScala (A() AS STRING, b() AS STRING, C() AS STRING, X() AS INTEGER)
'36800 REM inizializza per riduzione scala
RESTORE 35000
FOR i = 1 TO 7
READ A$(i)
NEXT i
FOR i = 1 TO 7
READ b$(i)
NEXT i
FOR i = 1 TO 4
READ C$(i), X(i)
NEXT i
END SUB
SUB IniScritte (colfore() AS INTEGER, colback() AS INTEGER, coox() AS INTEGER, COOY() AS INTEGER, mss() AS STRING, PAG AS INTEGER, nummss() AS INTEGER)
'5500 REM inizializza scritte PAG=x
i = 1
CALL DataScritte(colfore(), colback(), coox(), COOY(), mss(), i, PAG)
WHILE colfore(i, PAG) <> 0 OR colback(i, PAG) <> 0
i = i + 1
CALL DataScritte(colfore(), colback(), coox(), COOY(), mss(), i, PAG)
WEND
nummss(PAG) = i - 1
END SUB
SUB IniSimbolo (A() AS INTEGER, b() AS INTEGER, C() AS INTEGER)
SHARED LL() AS INTEGER, HH() AS INTEGER
'20000 REM inizializzazione simboli
REM attenzione!! per il primo punto occhio al PAINT
LL(1) = OFL
HH(1) = OFH
LL(2) = OFL + DL / 4
HH(2) = OFH + 3
LL(3) = OFL + DL / 2
HH(3) = OFH + 4
LL(4) = OFL + DL * 3 / 4
HH(4) = OFH + 3
LL(5) = OFL + DL
HH(5) = OFH
LL(6) = OFL + DL - 3
HH(6) = OFH + DH / 4
LL(7) = OFL + DL - 4
HH(7) = OFH + DH / 2
LL(8) = OFL + DL - 3
HH(8) = OFH + DH * 3 / 4
LL(9) = OFL + DL
HH(9) = OFH + DH
LL(10) = LL(4)
HH(10) = OFH + DH - 3
LL(11) = LL(3)
HH(11) = OFH + DH - 4
LL(12) = LL(2)
HH(12) = OFH + DH - 3
LL(13) = OFL
HH(13) = OFH + DH
LL(14) = OFL + 3
HH(14) = HH(8)
LL(15) = OFL + 4
HH(15) = HH(7)
LL(16) = OFL + 3
HH(16) = HH(6)
LL(17) = LL(1)
HH(17) = HH(1)
LL(18) = 0
HH(18) = 0
CALL FaiSimbolo(1) 'fai il simbolo 1
GET (OFL, OFH)-(OFL + DL + MARL, OFH + DH + MARH), A
CALL FaiSimbolo(2) 'fai il simbolo 2
GET (OFL, OFH)-(OFL + DL + MARL, OFH + DH + MARH), b
CALL FaiSimbolo(0) 'cancella simbolo
GET (OFL, OFH)-(OFL + DL + MARL, OFH + DH + MARH), C
END SUB
SUB IniTabInclDes (RDES() AS STRING, LRDES AS INTEGER, RIGHEDES() AS INTEGER, OFFDES() AS INTEGER)
SHARED NUMSIMB AS INTEGER, LINPARZ AS INTEGER, LININTERE AS INTEGER
'19000 REM routine inizializzazione tabella conversione
REM coordinate righe inclinate a destra
REM in [RIGHEDES%(x,y)] --> indice righe da sinistra a destra crescente
REM in [OFFDES%(x,y)] ----> offset rispetto inizio riga
REM in [rdes$(i)] -------> stringa immagine del video
REM
VETT = 1
LUNG = NUMSIMB
REM linee di lunghezza inferiore al lato minore (sopra)
j = NUMSIMB
FOR Z = 1 TO LINPARZ
Y = 1
X = j
FOR i = 1 TO LUNG
RIGHEDES%(X, Y) = VETT
OFFDES%(X, Y) = i
X = X - 1
Y = Y + 1
NEXT i
RDES$(VETT) = STRING$(LUNG, NONAMMESSA$)
j = j + 1
VETT = VETT + 1
LUNG = LUNG + 1
NEXT Z
REM linee di lunghezza uguale al lato minore
IF XM > YM THEN X = XM - LININTERE + 1 ELSE X = XM
Y = 1
FOR Z = 1 TO LININTERE
xx = X
yy = Y
FOR i = 1 TO LUNG
RIGHEDES%(xx, yy) = VETT
OFFDES%(xx, yy) = i
xx = xx - 1
yy = yy + 1
NEXT i
RDES$(VETT) = STRING$(LUNG, NONAMMESSA$)
VETT = VETT + 1
IF XM > YM THEN X = X + 1 ELSE Y = Y + 1
NEXT Z
REM linee di lunghezza inferiore al lato minore (sotto)
X = XM
IF XM > YM THEN Y = 1 ELSE Y = LININTERE
FOR Z = 1 TO LINPARZ
Y = Y + 1
LUNG = LUNG - 1
xx = X
yy = Y
FOR i = 1 TO LUNG
RIGHEDES%(xx, yy) = VETT
OFFDES%(xx, yy) = i
xx = xx - 1
yy = yy + 1
NEXT i
RDES$(VETT) = STRING$(LUNG, NONAMMESSA$)
VETT = VETT + 1
NEXT Z
LRDES = VETT - 1
END SUB
SUB IniTabInclSin (RSIN() AS STRING, LRSIN AS INTEGER, RIGHESIN() AS INTEGER, OFFSIN() AS INTEGER)
SHARED NUMSIMB AS INTEGER, LINPARZ AS INTEGER, LININTERE AS INTEGER
'18400 REM routine inizializzazione tabella conversione
REM coordinate righe inclinate a sinistra
REM in [RIGHESIN%(x,y)] --> indice righe da destra a sinistra crescente
REM in [OFFSIN%(x,y)] ----> offset rispetto inizio riga
REM in [rsin$(i)] -------> stringa immagine del video
REM
VETT = 1
LUNG = NUMSIMB
REM linee di lunghezza inferiore al lato minore (sopra)
j = XM - NUMSIMB
FOR Z = 1 TO LINPARZ
Y = 1
X = j + 1
FOR i = 1 TO LUNG
RIGHESIN%(X, Y) = VETT
OFFSIN%(X, Y) = i
X = X + 1
Y = Y + 1
NEXT i
RSIN$(VETT) = STRING$(LUNG, NONAMMESSA$)
j = j - 1
VETT = VETT + 1
LUNG = LUNG + 1
NEXT Z
REM linee di lunghezza uguale al lato minore
IF XM > YM THEN X = LININTERE ELSE X = 1
Y = 1
FOR Z = 1 TO LININTERE
xx = X
yy = Y
FOR i = 1 TO LUNG
RIGHESIN%(xx, yy) = VETT
OFFSIN%(xx, yy) = i
xx = xx + 1
yy = yy + 1
NEXT i
RSIN$(VETT) = STRING$(LUNG, NONAMMESSA$)
VETT = VETT + 1
IF XM > YM THEN X = X - 1 ELSE Y = Y + 1
NEXT Z
REM linee di lunghezza inferiore al lato minore (sotto)
X = 1
IF XM > YM THEN Y = 1 ELSE Y = LININTERE
FOR Z = 1 TO LINPARZ
Y = Y + 1
LUNG = LUNG - 1
xx = X
yy = Y
FOR i = 1 TO LUNG
RIGHESIN%(xx, yy) = VETT
OFFSIN%(xx, yy) = i
xx = xx + 1
yy = yy + 1
NEXT i
RSIN$(VETT) = STRING$(LUNG, NONAMMESSA$)
VETT = VETT + 1
NEXT Z
LRSIN = VETT - 1
END SUB
SUB IniTabOri (RORI() AS STRING, RIGHEORI() AS INTEGER, OFFORI() AS INTEGER)
'18200 REM routine inizializzazione tabella conversione
REM coordinate righe orizzontali
REM in [RIGHEORI%(x,y)] --> indice righe dall'alto al basso crescente
REM in [OFFORI%(x,y)] ----> offset rispetto inizio riga
REM in [rori$(i)] -------> stringa immagine del video
REM
LUNG = XM
REM Y <-- VETT
FOR VETT = 1 TO YM
FOR X = 1 TO LUNG
RIGHEORI%(X, VETT) = VETT
OFFORI%(X, VETT) = X
NEXT X
RORI$(VETT) = STRING$(LUNG, NONAMMESSA$)
NEXT VETT
END SUB
SUB IniTabVer (RVER() AS STRING, RIGHEVER() AS INTEGER, OFFVER() AS INTEGER)
'18000 REM routine inizializzazione tabella conversione
REM coordinate righe verticali
REM in [RIGHEVER%(x,y)] --> indice righe da sinistra a destra crescente
REM in [OFFVER%(x,y)] ----> offset rispetto inizio riga
REM in [rver$(i)] -------> stringa immagine del video
REM
LUNG = YM
REM X <-- VETT
FOR VETT = 1 TO XM
FOR Y = 1 TO LUNG
RIGHEVER%(VETT, Y) = VETT
OFFVER%(VETT, Y) = Y
NEXT Y
RVER$(VETT) = STRING$(LUNG, NONAMMESSA$)
NEXT VETT
END SUB
SUB IniTempo (A() AS INTEGER, b() AS INTEGER)
'25200 REM inizializza array tempo grafico
CALL FaiTempoGraf(1, 3) ' tempo grafico
GET (G0X - 1, G0Y - 1)-(GX + 1, GY + 1), A
CALL FaiTempoGraf(2, 3) ' tempo grafico
GET (G0X - 1, G0Y - 1)-(GX + 1, GY + 1), b
END SUB
SUB LampFila (A() AS INTEGER, G AS INTEGER)
SHARED NUMSIMB AS INTEGER
'29000 REM LAMPEGGIA - cancella fila
FOR i = 1 TO NUMSIMB
CALL CanSimbolo(A(i, 1), A(i, 2))
NEXT i
REM ritardo
FOR i = 1 TO RITLAMP
REM
NEXT i
REM accendi fila
FOR i = 1 TO NUMSIMB
CALL Simbolo(A(i, 1), A(i, 2), G)
NEXT i
REM ritardo
FOR i = 1 TO RITLAMP
REM
NEXT i
END SUB
SUB LampVittoria (R AS INTEGER, X AS INTEGER, Y AS INTEGER, G AS INTEGER)
DIM ve(11, 2) AS INTEGER ' per lampeggio
'5300 REM vittoria in presentazione ed in partita
CALL IniLampFila(ve(), R, X, Y) ' caricamento fila da far lampeggiare
FOR Z = 1 TO PRESLAMP - 1
CALL LampFila(ve(), G) ' lampeggia solo
NEXT Z
END SUB
SUB LeggiDip (i AS INTEGER)
i = StatoDip(1)
END SUB
DEFSNG A-Z
SUB Letturadip (X AS INTEGER)
DEFINT A-Z
'51000 REM lettura ingressi dip
i = INP(DIP)
IF PC = 1 THEN CALL Tspost(i)' per PC
IF (i OR START1) <> CHECKPORT THEN X = 1
IF (i OR START2) <> CHECKPORT THEN X = 2
END SUB
DEFSNG A-Z
SUB Letturaing (X AS INTEGER, Y AS INTEGER, Z AS INTEGER)
DEFINT A-Z
STATIC ULT
SHARED SIMUL AS INTEGER, GIO AS INTEGER
'50000 REM controllo ingressi alla 12455 (**)
IF SIMUL = 1 THEN 50050
i = INP(SPOST)
IF PC = 1 THEN CALL Tspost(i) ' per PC
IF ULT = i THEN 50050
ULT = i
SELECT CASE GIO
CASE 2
50100 IF (i OR SIN1) <> &HFF THEN CALL Gestsin1(X, Z): ' premuto sin primo gio
IF (i OR DES1) <> &HFF THEN CALL Gestdes1(X, Z): ' premuto des primo gio
IF (i OR PUL1) <> &HFF THEN CALL Gestpul1(Y): ' premuto pul primo gio
CASE 1
50200 IF (i OR SIN2) <> &HFF THEN CALL Gestsin2(X, Z): ' premuto sin secondo gio
IF (i OR DES2) <> &HFF THEN CALL Gestdes2(X, Z): ' premuto des secondo gio
IF (i OR PUL2) <> &HFF THEN CALL Gestpul2(Y): ' premuto pul secondo gio
END SELECT
50050
END SUB
SUB MettiMossaGIO (E AS INTEGER, Z AS INTEGER, R AS INTEGER, X AS INTEGER, Y AS INTEGER, GIO AS INTEGER) STATIC
'variabili modificate
SHARED RVER() AS STRING, RORI() AS STRING, RSIN() AS STRING, RDES() AS STRING
SHARED STRA() AS SINGLE
SHARED STRAVER() AS SINGLE, STRAORI() AS SINGLE, STRASIN() AS SINGLE, STRADES() AS SINGLE
'variabili non modificate
SHARED PLIB() AS INTEGER, VA() AS STRING
'30500 REM metti mossa giocatore GIO
CALL Scrive4Stri(RVER(), RORI(), RSIN(), RDES(), VA$(GIO), X, Y)' XA$ a (X,Y) nei quattro tipi di righe
CALL AggPunt4Righe(R, E, X, Y, Z, STRA(), STRAVER(), STRAORI(), STRASIN(), STRADES())' agg punteggio 4 righe per X,Y Z=off vinc.. IF E = 1 THEN 30610: ' vittoria.. IF Y = YM THEN 30610.. Y = PLIB(X) + 1.. CALL Scrive4Stri(RVER(), RORI(), RSIN(), RDES(), AMMESSA$, X, Y)' XA$ a (X,Y) nei quattro tipi di righe.. CALL AggPunt4Righe(R, E, X, Y, Z, STRA(), STRAVER(), STRAORI(), STRASIN(), STRADES())' agg punteggio 4 righe per X,Y Z=off vinc.. Y = PLIB(X)..30610 REM [LABEL]....END SUB....SUB MossaCalc (E AS INTEGER, Z AS INTEGER, R AS INTEGER, X AS INTEGER, Y AS INTEGER, PLIB() AS INTEGER, GIO AS INTEGER, mosse() AS INTEGER)....'14800 REM *************************************..' REM * strategia + mossa solo NGIO = 1 *..' REM *************************************.. CALL MossaMigliore(E, Z, R, X, Y) ' patta se E = 2 sceglie mossa migliore.. IF E = 2 THEN 14860.. REM.. IF GIO = 1 THEN GIO = 2 ELSE GIO = 1.. CALL SimboliMovim(E, Z, R, X, Y, PLIB(), mosse()) ' fai uscire mossa
IF GIO = 1 THEN GIO = 2 ELSE GIO = 1
14860 REM [LABEL]
IF E = 1 THEN E = 3: ' vittoria calc @@@@@@@@@@@@@@@@@@@@@@@@@
END SUB
SUB MossaMigliore (E AS INTEGER, Z AS INTEGER, R AS INTEGER, X AS INTEGER, Y AS INTEGER) STATIC
'variabili modificate
SHARED TOTSTRA() AS SINGLE, STRA() AS SINGLE
SHARED STRAVER() AS SINGLE, STRAORI() AS SINGLE, STRASIN() AS SINGLE, STRADES() AS SINGLE
SHARED RVER() AS STRING, RORI() AS STRING, RSIN() AS STRING, RDES() AS STRING
'variabili non modificate
SHARED NUMSIMB AS INTEGER, PLIB() AS INTEGER, VA() AS STRING
'27000 REM ***************
' REM * STRATEGIA *
' REM ***************
REM esegue mosse prova e calcolo relativi punteggi
FOR X = 1 TO XM
TOTSTRA(X, 1) = 0
TOTSTRA(X, 2) = 0
NEXT X
REM
FOR X = 1 TO XM
conta = 0
i = PLIB(X)
IF i >= YM THEN STRA(1) = 10 ^ (NUMSIMB - 1) - 1: GOTO 27280: ' riga verticale tutta piena
Y = i + 1
conta = conta + 1
CALL UserStrat(X, Y, 0, conta)' salva STRA???(i,1->2) [strategie] relative a X,Y
REM metti mossa prova
CALL Scrive4Stri(RVER(), RORI(), RSIN(), RDES(), VA$(2), X, Y)' XA$ a (X,Y) nei quattro tipi di righe
CALL AggPunt4Righe(R, E, X, Y, Z, STRA(), STRAVER(), STRAORI(), STRASIN(), STRADES())' agg punteggio 4 righe per X,Y Z=off vinc
REM metti mossa possibile dopo prova
IF Y >= YM THEN 27260: ' riga verticale tutta piena
Y = Y + 1
conta = conta + 1
CALL UserStrat(X, Y, 0, conta)' salva STRA???(i,1->2) [strategie] relative a X,Y
CALL Scrive4Stri(RVER(), RORI(), RSIN(), RDES(), AMMESSA$, X, Y)' XA$ a (X,Y) nei quattro tipi di righe
CALL AggPunt4Righe(R, E, X, Y, Z, STRA(), STRAVER(), STRAORI(), STRASIN(), STRADES())' agg punteggio 4 righe per X,Y Z=off vinc
27260 REM [LABEL]
CALL PuntStrat(STRA()) ' calcolo punteggio per ogni gio (posizione attuale)
27280 FOR j = 1 TO 2: ' [LABEL].. TOTSTRA(X, j) = STRA(j)
NEXT j
FOR i = conta TO 1 STEP -1
CALL UserStrat(X, Y, 1, i)' riprendi strategie salvate
NEXT i
NEXT X
CALL StratMossa(X, E, TOTSTRA())' scegli mossa con migliore differenza fra gio1 e gio2
END SUB
SUB MossaPresent (PRFN AS INTEGER, SEL AS INTEGER, CLK AS INTEGER, PRFV AS INTEGER)
SHARED RIT() AS INTEGER, PASSO AS INTEGER
SHARED RIGA() AS INTEGER
'5200 REM uscita automatica dello schermo
SEL = 0
IF CLK > RIT(PASSO) THEN 5270
REM caso tempo giusto - sposta freccia se necessario
IF TEST = 1 THEN LOCATE 20, 20: PRINT USING "##"; RIGA(PASSO); PRFV; PRFN; PASSO: CALL StopSoftware
IF RIGA(PASSO) = PRFV THEN SEL = 1: GOTO 5270
IF RIGA(PASSO) > PRFV THEN PRFN = PRFN + 1 ELSE PRFN = PRFN - 1
REM
5270 REM
END SUB
SUB NomeRecord (X AS STRING, CNTBUFF AS INTEGER)
SHARED alfabeto() AS STRING
'16500 REM routine ingresso nome record
xx = SCRIVIX: ' coordinate primo carattere nome record
yy = SCRIVIY: ' coordinate primo carattere nome record
j = 1: ' contatore lettere inserite
CLK = TEMREC
T1$ = MID$(TIME$, 7, 2)
SEL = 0
PRFN = 1
PRFV = 0
X$ = "": ' accumula nome record
k = XM
ULT = 0: ' (**)
WHILE j <= LNOMEREC AND CLK > 0
CALL Clock(T1$, CLK)
CALL Letturaing(PRFN, SEL, LENALFA): ' (**) ingressi
IF PRFN = PRFV THEN 16710
REM caso variazione lettera (premuto spostamenti 1^ o 2^)
CALL Stampalfacol(PRFN, xx, yy, CSCRIVI1) ' stampa lettera alfabeto(), xx, yy, col
PRFV = PRFN
16710 REM [LABEL]
IF SEL = 0 THEN 16830
REM caso confermato lettera (premuto selezione 1^ o 2^)
IF PRFN = LENALFA THEN CLK = 0: GOTO 16830: ' fine inserimento nome
CALL Stampalfacol(PRFN, xx, yy, CSCRIVI2) ' stampa lettera alfabeto(), xx, yy, colore c
xx = xx + 1
SEL = 0
X$ = X$ + alfabeto$(PRFN)
j = j + 1
PRFN = 1: PRFV = 0
CALL ScaricaTastiera(CNTBUFF) ' scarica buffer tastiera
16830 REM [LABEL]
COLOR 2, 0
LOCATE 20, 1, 0
PRINT "Tempo rimanente =";
PRINT USING "###"; CLK;
PRINT " sec"
WEND
END SUB
SUB PagNomeRec (QPUNTREC() AS INTEGER, LIVREC() AS INTEGER, NOMEREC() AS STRING, CNTBUFF AS INTEGER)
SHARED GIO AS INTEGER, QTOTPUNTI() AS INTEGER, LIVATT AS INTEGER
'17400 REM controlla se deve scrivere nome record
REM IF NGIO = 1 THEN 17430 :' caso un solo giocatore
REM IF QTOTPUNTI(1) >= QTOTPUNTI(2) THEN GIO = 1 ELSE GIO = 2
17430 REM LABEL
IF QTOTPUNTI(GIO) <= QPUNTREC(NUMREC) THEN 17820: ' non c'e' record
REM passa di qui se deve scrivere nome record
CALL AttivaMus(2) ' attiva brano 2=celestiale
i = 1
WHILE QTOTPUNTI(GIO) <= QPUNTREC(i)
i = i + 1
WEND
REM
POSGIO = i
REM
FOR i = NUMREC - 1 TO POSGIO STEP -1
QPUNTREC(i + 1) = QPUNTREC(i)
LIVREC(i + 1) = LIVREC(i)
NOMEREC(i + 1) = NOMEREC(i)
NEXT i
REM
QPUNTREC(POSGIO) = QTOTPUNTI(GIO)
LIVREC(POSGIO) = LIVATT - 1
REM
REM prepara per ingresso nome record
CLS
LOCATE 3, 1, 0
COLOR 1, 0
PRINT "Giocatore";
COLOR 16 + 7, 0
PRINT GIO;
COLOR 1, 0
PRINT " sei il numero";
COLOR 16 + 6, 0
PRINT POSGIO;
COLOR 1, 0
PRINT "di oggi !!"
REM
LOCATE 5, 1
COLOR 10, 0
PRINT "SCRIVI IL TUO NOME !"
LOCATE 23, 12
COLOR 7, 0
PRINT "'@' per finire"
REM
CALL NomeRecord(NOMEREC(POSGIO), CNTBUFF) ' ingresso nome record
COLOR 7, 0
17820 REM LABEL
END SUB
SUB PagRecord
SHARED NOMEREC() AS STRING, QPUNTREC() AS INTEGER, LIVREC() AS INTEGER
'8300 REM stampa pagina RECORD
SCREEN 0
LOCATE 1, 14
COLOR 2, 0
PRINT "R E C O R D S"
REM
FOR i = 1 TO NUMREC
LOCATE i * 2 + 3, 8
COLOR 4, 0
PRINT NOMEREC(i);
PRINT TAB(20);
COLOR 1, 0
CALL StampaXY(POS(X), CSRLIN, "###", QPUNTREC(i), 1)
PRINT SPC(3);
PRINT USING "###"; LIVREC(i);
COLOR 3, 0
NEXT i
LOCATE 1, 1, 0
COLOR 7, 0
CALL RitDCLK(RITRECORD)
END SUB
SUB Partita (E AS INTEGER, R AS INTEGER, X AS INTEGER, Y AS INTEGER, QPUNTI() AS INTEGER) STATIC
'variabili non modificate
SHARED SIMUL AS INTEGER, NGIO AS INTEGER
'variabli modificate
SHARED cntmosse() AS INTEGER, PLIB() AS INTEGER, PRFN AS INTEGER, PRFV AS INTEGER
SHARED CNTBUFF AS INTEGER, CLK AS INTEGER, PASSO AS INTEGER, GIO AS INTEGER
SHARED mosse() AS INTEGER
30000 REM partita
CALL StTempoGraf ' stampa tempo grafico
CALL ScorreTempo(PRFN, PRFV, E, X, CNTBUFF, CLK)' scorrere tempo + selezione colonna verticale con freccia IN PRESENTAZIONE selezione automatica
IF E = 1 THEN
CALL VertPiena
CALL EsceCasualm(X, PRFV, PRFN)
BEEP
' tempo finito [goto 30240]
END IF
IF SIMUL = 1 THEN PASSO = PASSO + 1
REM in X riga sulla quale far uscire il simbolo
REM puo' venire dalla 12400 (scelta) o fine tempo casuale (EsceCasualm - 28700)
CALL SimboliMovim(E, Z, R, X, Y, PLIB(), mosse())' stampa simbolo su scelta colonna verticale
CALL PunteggioTempo(QPUNTI()) ' calcolo punti vinti
CALL StPunteggio(GIO)
cntmosse(GIO) = cntmosse(GIO) + 1
IF E = 1 THEN 30400: ' E da 25500 SimboliMovim (vittoria !)
IF NGIO = 1 THEN
CALL MossaCalc(E, Z, R, X, Y, PLIB(), GIO, mosse()) ' mossa calcolatore
cntmosse(2) = cntmosse(2) + 1
END IF
IF E = 3 THEN 30400: ' vittoria calcolatore
IF cntmosse(1) + cntmosse(2) >= XM * YM THEN
E = 2
GOTO 30400 ' patta
END IF
CALL CambioGioc(GIO) ' cambio giocatore attuale
GOTO 30000: ' aspetta altra mossa
30400 REM [LABEL]
CALL TrasfCoo(R, Z, X, Y) ' trasforma per lampeggio
END SUB
SUB Patta
'5400 REM patta in presentazione
LOCATE YMESS, XMESS
PRINT PARI$
CALL RitDCLK(RITPATTA)
END SUB
SUB Perso (R AS INTEGER, X AS INTEGER, Y AS INTEGER, G AS INTEGER)
SHARED GIO AS INTEGER
'7000 REM perso giocatore (caso NGIO = 1)
CALL AttivaMus(3) ' attiva musica 3=marcia funebre
LOCATE YMESS, XMESS
PRINT MessPerso$
IF GIO = 1 THEN G = 2 ELSE G = 1
CALL LampVittoria(R, X, Y, G) ' lampeggio fila vincente
END SUB
SUB PosFreccia (P AS INTEGER)
SHARED PRFN AS INTEGER, CFRECCIA() AS INTEGER, FRECCIA() AS INTEGER
'24200 REM caso cambio posizione freccia
IF PRFN = P THEN 24310
PUT (ConvXL(P), ConvYH(YM + 1) + YFRECCIA), CFRECCIA, PSET
PUT (ConvXL(PRFN), ConvYH(YM + 1) + YFRECCIA), FRECCIA, PSET
P = PRFN
24310 REM
END SUB
SUB Presentazione
SHARED PASSO AS INTEGER, QPUNTI() AS INTEGER
SHARED E AS INTEGER, R AS INTEGER, X AS INTEGER, Y AS INTEGER, GIO AS INTEGER
'6000 REM ***********************
' REM * presentazione gioco *
' REM ***********************
SCREEN 0
COLOR 3, 0
CALL StringaScala("filetto", 10, 3) ' stampa grande
CALL StampaPagRit(1, RITSPIEG) ' pagina spiegazioni in presentazione
SCREEN 1
COLOR 0, 0
PASSO = 1: ' inizializza lettura passi casuali
CALL StPlayer ' stampa player, tempo e crediti
CALL CentriSchermo ' stampa centri dei simboli
CALL Partita(E, R, X, Y, QPUNTI()) ' partita
SELECT CASE E
CASE 1
CALL LampVittoria(R, X, Y, GIO)
CASE 2
CALL Patta
END SELECT
REM fai pagina RECORD in presentazione
CALL PagRecord ' pagina RECORD
END SUB
SUB PunteggioTempo (Q() AS INTEGER)
SHARED GIO AS INTEGER, CLK AS INTEGER
'12000 REM calcolo punteggio sulla base del tempo
Q(GIO) = Q(GIO) + CLK
END SUB
SUB PuntStrat (STRA() AS SINGLE)
SHARED STRAVER() AS SINGLE, STRAORI() AS SINGLE, STRASIN() AS SINGLE, STRADES() AS SINGLE
SHARED LRSIN AS INTEGER, LRDES AS INTEGER
'26000 REM calcolo punteggio per ogni giocatore con la attuale posizione
REM dei pezzi
FOR j = 1 TO 2
STRA(j) = 0
REM verticali
FOR k = 1 TO XM
STRA(j) = STRA(j) + STRAVER(k, j)
NEXT k
REM orizzontali
FOR k = 1 TO YM
STRA(j) = STRA(j) + STRAORI(k, j)
NEXT k
REM inclinate sinistra \
FOR k = 1 TO LRSIN
STRA(j) = STRA(j) + STRASIN(k, j)
NEXT k
REM inclinate destra /
FOR k = 1 TO LRDES
STRA(j) = STRA(j) + STRADES(k, j)
NEXT k
NEXT j
END SUB
FUNCTION RigDES% (X AS INTEGER, Y AS INTEGER)
SHARED RIGHEDES() AS INTEGER
RigDES% = RIGHEDES(X, Y)
END FUNCTION
FUNCTION RigORI% (X AS INTEGER, Y AS INTEGER)
SHARED RIGHEORI() AS INTEGER
RigORI% = RIGHEORI(X, Y)
END FUNCTION
FUNCTION RigSIN% (X AS INTEGER, Y AS INTEGER)
SHARED RIGHESIN() AS INTEGER
RigSIN% = RIGHESIN(X, Y)
END FUNCTION
FUNCTION RigVER% (X AS INTEGER, Y AS INTEGER)
SHARED RIGHEVER() AS INTEGER
RigVER% = RIGHEVER(X, Y)
END FUNCTION
SUB Ritardo (v AS STRING, i AS INTEGER)
'15900 REM ritardo
N$ = MID$(TIME$, 7, 2)
IF N$ = v$ THEN 15950
i = i - 1
v$ = N$
15950 REM
END SUB
SUB RitDCLK (i AS INTEGER)
'5900 REM routine ritardo
v$ = MID$(TIME$, 10, 1)
WHILE i <> 0
CALL Ritardo(v$, i)
WEND
END SUB
SUB SalvaMosse (pmosse AS INTEGER, mosse() AS INTEGER, X AS INTEGER)
SHARED cntmosse() AS INTEGER, GIO AS INTEGER, SIMUL AS INTEGER
'34000 REM salva mosse
IF SIMUL = 1 THEN 34110
pmosse = pmosse + 1
IF pmosse >= lmosse THEN pmosse = 0
mosse(pmosse) = GIO
pmosse = pmosse + 1
IF pmosse >= lmosse THEN pmosse = 0
mosse(pmosse) = cntmosse(GIO)
pmosse = pmosse + 1
IF pmosse >= lmosse THEN pmosse = 0
mosse(pmosse) = X
34110 REM [LABEL]
END SUB
SUB ScaricaTastiera (C AS INTEGER)
'21000 REM SCARICA BUFFER TASTIERA
21020 IF INKEY$ <> "" THEN C = C + 1: GOTO 21020
END SUB
SUB ScegliDiff (i AS INTEGER)
SHARED DIFF AS INTEGER
SELECT CASE DIFF
CASE 1
IF INT(RND * 100) + 1 > 100 THEN ' probabilit… di mossa al calc
j = 0 ' caso prima mossa al giocatore
ELSE
j = 1 ' caso prima mossa al calcolatore
END IF
CASE ELSE
j = 0
END SELECT
i = (INT(RND * XM) + 1) * j
END SUB
SUB SchermoPres (RIT() AS INTEGER, RIGA() AS INTEGER)
'5100 REM inizializza schermo di presentazione
FOR i = 1 TO XM * YM
RIT(i) = TEM - INT(LIMRIT * RND) - OFFRIT
RIGA(i) = INT(XM * RND) + 1
NEXT i
END SUB
SUB ScorreTempo (PRFN AS INTEGER, PRFV AS INTEGER, E AS INTEGER, X AS INTEGER, CNTBUFF AS INTEGER, CLK AS INTEGER)
SHARED SIMUL AS INTEGER, PLIB() AS INTEGER
'12400 REM scorrere tempo + selezione colonna verticale con freccia
REM IN PRESENTAZIONE selezione automatica
REM NO BEEP IN SIMULAZIONE (SIMUL = 1)
OCLK = 0
CLK = TEM
T1$ = MID$(TIME$, 7, 2)
SEL = 0: ' inizializzazione per selezione colonna
ULT = 0: ' (**)
CALL ScaricaTastiera(CNTBUFF) ' scarica buffer tastiera (**)
WHILE CLK <> 0
CALL Letturaing(PRFN, SEL, XM): ' (**) ingressi
CALL Clock(T1$, CLK)
CALL SecGioco(OCLK, CLK) ' aggiorna tempo di gioco
CALL PosFreccia(PRFV) ' aggiorna freccia
IF SIMUL = 1 THEN CALL MossaPresent(PRFN, SEL, CLK, PRFV)' presentazione
IF SEL = 0 THEN 12550: ' salta se non ha selezionato
SEL = 0: ' caso SEL=1 premuto selezione PF5-8 (azzera flag)
X = PRFN
IF PLIB(X) = YM THEN CALL VertPiena: GOTO 12545: ' vert piena
E = 0
GOTO 12620: ' caso scelta carattere corretto di fila verticale
12545 REM **IF gio = 1 THEN KEY(5) ON ELSE IF gio = 2 THEN KEY(8) ON
12550 REM
WEND
E = 1
12620 REM
END SUB
SUB Scrive4Stri (RVER() AS STRING, RORI() AS STRING, RSIN() AS STRING, RDES() AS STRING, XA AS STRING, X AS INTEGER, Y AS INTEGER) STATIC
'variabili non modificate
SHARED OFFVER() AS INTEGER, OFFORI() AS INTEGER, OFFSIN() AS INTEGER, OFFDES() AS INTEGER
'19600 REM scrive XA$ nelle quattro stringhe di rappresentazione delle
REM linee che passano da coordinate X,Y
REM XA$ --> lunghezza 1
REM verticale
i = RigVER(X, Y)
IF i <> 0 THEN
MID$(RVER$(i), OFFVER%(X, Y)) = XA$
END IF
'19670 REM orizzontale LABEL
i = RigORI(X, Y)
IF i <> 0 THEN
MID$(RORI$(i), OFFORI%(X, Y)) = XA$
END IF
'19710 REM inclinata a sinistra \ LABEL
i = RigSIN(X, Y)
IF i <> 0 THEN
MID$(RSIN$(i), OFFSIN%(X, Y)) = XA$
END IF
'19750 REM inclinata a destra / LABEL
i = RigDES(X, Y)
IF i <> 0 THEN
MID$(RDES$(i), OFFDES%(X, Y)) = XA$
END IF
'19790 REM
END SUB
SUB SecGioco (C AS INTEGER, CLK AS INTEGER)
SHARED SIMUL AS INTEGER
'24500 REM secondi di gioco
IF CLK = C THEN 24570
T = TEM - CLK - 1
IF T < 0 THEN 24550
LINE (G0X, G0Y + T * STO)-(GX, G0Y + (T + 1) * STO), 0, BF
IF SIMUL = 0 AND PLAY(N) = 0 THEN PLAY STEMPO$
24550 C = CLK
24570 REM
END SUB
SUB SimboliMovim (E AS INTEGER, Z AS INTEGER, R AS INTEGER, X AS INTEGER, Y AS INTEGER, PLIB() AS INTEGER, mosse() AS INTEGER)
SHARED GIO AS INTEGER, SIMUL AS INTEGER
'25500 REM simboli in movimento
CALL SalvaMosse(pmosse, mosse(), X) ' salva mossa (per debug)
REM
PLIB(X) = PLIB(X) + 1
FOR G = YM TO PLIB(X) STEP -1
Y = G
CALL Simbolo(X, Y, GIO)
IF SIMUL = 0 AND PLAY(N) = 0 THEN PLAY ssimb$
IF G = YM THEN
GOTO 25600
ELSE
Y = G + 1
CALL CanSimbolo(X, Y)
CALL StampaCentro(X, Y)
END IF
25600 NEXT G
Y = PLIB(X)
REM
CALL MettiMossaGIO(E, Z, R, X, Y, GIO) ' mossa
END SUB
SUB Simbolo (X AS INTEGER, Y AS INTEGER, G AS INTEGER)
SHARED a1() AS INTEGER, a2() AS INTEGER
'10000 REM stampa simbolo a partire da coordinate X,Y
SELECT CASE G
CASE 1
10100 REM stampa simbolo 1
PUT (ConvXL(X), ConvYH(Y)), a1, PSET
CASE 2
10200 REM stampa simbolo 2
PUT (ConvXL(X), ConvYH(Y)), a2, PSET
CASE ELSE
STOP
END SELECT
END SUB
SUB StampaCarGraf (A AS STRING, X AS INTEGER, Y AS INTEGER, E AS INTEGER)
'36000 REM stampa:
A$ = UCASE$(A$)
E = 0
SELECT CASE A$
CASE "A" TO "Z"
CALL StampaLett(A$, X, Y) ' stlettera
CASE "0" TO "9"
CALL StampaNum(A$, X, Y) 'stnumero
CASE ELSE
E = 1
END SELECT
'36060 REM esci:
END SUB
SUB StampaCentro (X AS INTEGER, Y AS INTEGER)
'14000 REM stampa centro dei simboli (matrice vuota)
L = CooCentroL(ConvXL(X))
h = CooCentroH(ConvYH(Y))
REM fai centri
LINE (L - CROCE / 2, h)-(L + CROCE / 2, h), COLCENTRI
LINE (L, h - CROCE / 2)-(L, h + CROCE / 2), COLCENTRI
END SUB
SUB StampaCrediti
SHARED cre AS INTEGER
'21300 REM stampa crediti
X = POS(0)
Y = CSRLIN
FOR i = 1 TO LEN(MCRE$ + STR$(cre))
LOCATE YCRE - 1 + i, XCRE
PRINT MID$(MCRE$ + STR$(cre), i, 1)
NEXT i
LOCATE Y, X, 0
END SUB
SUB StampaLett (A AS STRING, X AS INTEGER, Y AS INTEGER)
SHARED lett() AS STRING
'36200 REM stlettera:
FOR j = 1 TO 7
LOCATE Y + j - 1, X
Z$ = MID$(lett$(j), (ASC(A$) - ASC("A")) * 5 + 1, 5)
CALL ConvScala(Z$) ' converti z$
PRINT Z$
NEXT j
END SUB
SUB Stampalfacol (i AS INTEGER, X AS INTEGER, Y AS INTEGER, C AS INTEGER)
SHARED alfabeto() AS STRING
'17000 REM scrivi lettera a coordinate xx, yy
REM colore c
REM da alfabeto$()
REM indice lettera i
REM
COLOR C, 0
LOCATE Y, X, 0
PRINT alfabeto$(i)
END SUB
SUB StampaNum (A AS STRING, X AS INTEGER, Y AS INTEGER)
SHARED num() AS STRING
'36300 REM stnumero
FOR j = 1 TO 7
LOCATE Y + j - 1, X
Z$ = MID$(num$(j), (ASC(A$) - ASC("A")) * 5 + 1, 5)
CALL ConvScala(Z$) ' converti z$
PRINT Z$
NEXT j
END SUB
SUB StampaPagRit (j AS INTEGER, Z AS INTEGER)
SHARED nummss() AS INTEGER, colfore() AS INTEGER, colback() AS INTEGER, COOY() AS INTEGER, coox() AS INTEGER, mss() AS STRING
'5700 REM stampa
REM
LOCATE 1, 1, 0
FOR i = 1 TO nummss(j)
COLOR colfore(i, j), colback(i, j)
LOCATE COOY(i, j), coox(i, j)
PRINT mss$(i, j)
NEXT i
CALL RitDCLK(Z)
COLOR 7, 0
END SUB
SUB StampaVarPag3 (X AS INTEGER, Q() AS INTEGER, QT() AS INTEGER)
SHARED QPUNTREC() AS INTEGER, COOY() AS INTEGER, NGIO AS INTEGER, LIVATT AS INTEGER
'16000 REM stampa parte variabile pagina 3
REM pagina dopo conclusione partita (DCLK = ritardo)
REM
REM punteggio giocatore1
CALL StampaXY(12, COOY(4, 3), "######", Q(1), 1)
IF NGIO = 1 THEN 16120
REM punteggio giocatore2
CALL StampaXY(34, COOY(4, 3), "######", Q(2), 1)
16120 REM [LABEL]
CALL StampaXY(22, COOY(2, 3), "######", QPUNTREC(1), 1)
REM
CALL StampaXY(20, COOY(5, 3), "#", LIVATT, 0)
REM
FOR i = 1 TO 2
QT(i) = QT(i) + Q(i)
Q(i) = 0
NEXT i
CALL RitDCLK(X)
END SUB
SUB StampaXY (X AS INTEGER, Y AS INTEGER, QLEN AS STRING, QVAR AS INTEGER, A AS INTEGER)
'15800 REM stampa variabile 6 cifre a coordinate
REM QVAR = variabile
REM QLEN = lunghezza var 'USING'
REM XX = coo x
REM YY = coo y
REM
LOCATE Y, X, 0
SELECT CASE A
CASE 0
PRINT USING QLEN$; QVAR;
CASE 1
IF QVAR = 0 THEN
PRINT USING QLEN$; QVAR;
ELSE
PRINT USING LEFT$(QLEN$, LEN(COSTZERO$)); QVAR;
PRINT COSTZERO$;
END IF
END SELECT
END SUB
FUNCTION StatoDip (i AS INTEGER)
StatoDip = (2 ^ (i - 1) AND INP(DIP%)) / 2 ^ (i - 1)
END FUNCTION
SUB StopSoftware
'9800 REM stop software
IF TEST = 0 THEN 9860
LOCATE 21, 20
PRINT "stop"
Y$ = INPUT$(1)
LOCATE 21, 20
PRINT " "
9860 REM
END SUB
SUB StParGioco
SHARED LIVATT AS INTEGER, NUMSIMB AS INTEGER
'21500 REM stampa parametri di gioco
REM
LOCATE YPAR, XPAR
PRINT "LIV";
PRINT USING "##"; LIVATT;
PRINT " SERIE"; NUMSIMB
END SUB
SUB StPlayer
SHARED XGIO() AS INTEGER, YGIO() AS INTEGER, PL() AS STRING, NGIO AS INTEGER
'24800 REM stampa player
FOR G = 1 TO NGIO
h = (YGIO(G) - 1) * 8
L = (XGIO(G) - 1) * 8
CALL StringaOri(PL$(G), L, h, G) ' stampa alfanumerico grafico
CALL StPunteggio(G)
NEXT G
CALL StampaCrediti
CALL StParGioco ' stampa parametri
END SUB
SUB StPunteggio (G AS INTEGER)
SHARED QPUNTI() AS INTEGER
'11500 REM stampa punteggio
SELECT CASE G
CASE 1
X = XPUN1: Y = YPUN1
CASE 2
X = XPUN2: Y = YPUN2
END SELECT
CALL StampaXY(X, Y, "######", QPUNTI(G), 1) ' 1 stampa + COSTZERO$
END SUB
SUB StratMossa (X AS INTEGER, E AS INTEGER, TOTSTRA() AS SINGLE)
SHARED PLIB() AS INTEGER, NUMSIMB AS INTEGER
DEFSNG M
'27500 REM STRATEGIA scelta mosse
REM se ci sono mosse che danno un vantaggio effettivo (potenza del
REM dieci superiore)) prendi quella che fra queste da anche il
REM minimo punteggio al gio1, indipendentemente da gio2
E = 0
MOSSVINC = NUMSIMB - 1: ' mossa vincente
INDI = 0: ' indice per salvare pos mossa migliore
REM MAX2 = TOTSTRA(1, 2): ' punteggio gio2 iniziale
MIN1 = TOTSTRA(1, 1): ' punteggio gio1 iniziale
MAXDIFF = 1
FOR i = 1 TO XM
CALL CalcoloLog(Z, i, 1) ' log10(TOTstra(i,j)) --> z
k = Z: ' log gio1
CALL CalcoloLog(Z, i, 2) ' log10(TOTstra(i,j)) --> z
IF Z = MOSSVINC THEN X = i: GOTO 27800
IF Z - k >= MAXDIFF AND TOTSTRA(i, 1) <= MIN1 THEN INDI = i: MIN1 = TOTSTRA(i, 1): MAXDIFF = Z - k
NEXT i
IF INDI > 0 THEN X = INDI: GOTO 27800
REM impedisce mosse impossibili (oltre YM)
j = 0
FOR i = 1 TO XM
IF PLIB(i) = YM THEN TOTSTRA(i, 2) = TOTSTRA(i, 2) - 1: j = j + 1
NEXT i
IF j = XM THEN E = 2: ' patta!
REM scegli mossa con migliore differenza fra gio1 e gio2
M1 = TOTSTRA(1, 2) - TOTSTRA(1, 1)
k = 1
M2 = TOTSTRA(1, 1)
FOR X = 2 TO XM
M3 = TOTSTRA(X, 2) - TOTSTRA(X, 1)
IF M3 >= M1 AND TOTSTRA(X, 1) <= M2 THEN k = X: M1 = M3: M2 = TOTSTRA(X, 1)
NEXT X
REM
X = k
27800 ' [LABEL]
END SUB
DEFINT M
SUB StringaOri (S AS STRING, L AS INTEGER, h AS INTEGER, C AS INTEGER)
SHARED alpha() AS INTEGER
DIM k(KGRAF) AS INTEGER
'11800 REM Scrive in orizzontale stringa in S$ a coo L,H in alfanumerico grafico
REM SOLO MAIUSCOLE colore (1,2) in C
j = 1
WHILE MID$(S$, j, 1) <> ""
i = ASC(MID$(S$, j, 1)) - ASC("0") + 1
IF i < 1 OR i > NUMCARGRAF THEN 11900
FOR Z = 0 TO NUMBYTE / 2 - 1
k(Z) = alpha%(Z, i, C)
NEXT Z
PUT (L, h), k
11900 L = L + CARX + 1
j = j + 1
WEND
END SUB
SUB StringaScala (A AS STRING, X AS INTEGER, Y AS INTEGER)
'36500 REM stringa:
FOR i = 1 TO LEN(A$)
CALL StampaCarGraf(MID$(A$, i, 1), X, Y, E) ' stampa
X = X + 3
NEXT i
END SUB
SUB StTempoGraf
SHARED GIO AS INTEGER, TGRAF1() AS INTEGER, TGRAF2() AS INTEGER
'25000 REM stampa tempo grafico
SELECT CASE GIO
CASE 1
PUT (G0X - 1, G0Y - 1), TGRAF1, PSET
CASE 2
PUT (G0X - 1, G0Y - 1), TGRAF2, PSET
END SELECT
END SUB
SUB SuonoGett
'15700 REM suono gettoniera
IF PLAY(N) > 0 THEN 15720
PLAY "mbo0b32o4f32"
15720 REM [LABEL]
END SUB
SUB TrasfCoo (R AS INTEGER, Z AS INTEGER, X AS INTEGER, Y AS INTEGER) STATIC
' variabili non modificate
SHARED OFFVER() AS INTEGER, OFFORI() AS INTEGER, OFFSIN() AS INTEGER, OFFDES() AS INTEGER
'25700 REM trasforma coordinate ultima mossa vincente
REM in X,Y del primo simbolo della riga vincente
REM J = codice vincitore Z = offset vincitore (dalla 23100 - AggPunt4Righe)
SELECT CASE R' ON R GOSUB 25760, 25810, 25860, 25920
CASE 1
'25760 REM verticale
k = OFFVER%(X, Y)
Y = Y - (k - 1) + (Z - 1)
CASE 2
'25810 REM orizzontale
k = OFFORI%(X, Y)
X = X - (k - 1) + (Z - 1)
CASE 3
'25860 REM sinistra
k = OFFSIN%(X, Y)
X = X - (k - 1) + (Z - 1)
Y = Y - (k - 1) + (Z - 1)
CASE 4
'25920 REM destra
k = OFFDES%(X, Y)
X = X + (k - 1) - (Z - 1)
Y = Y - (k - 1) + (Z - 1)
END SELECT
END SUB
SUB Tspost (j AS INTEGER)
G$ = UCASE$(INKEY$)
SELECT CASE G$
CASE "S"
j = SIN1
CASE "D"
j = DES1
CASE "X"
j = PUL1
CASE "J"
j = SIN2
CASE "K"
j = DES2
CASE "M"
j = PUL2
CASE "1"
j = START1
CASE "2"
j = START2
CASE ELSE
j = CHECKPORT
END SELECT
END SUB
SUB UserStrat (X AS INTEGER, Y AS INTEGER, i AS INTEGER, k AS INTEGER) STATIC
'I=1 riprende
'I=0 salva
SHARED STRAVER() AS SINGLE, STRAORI() AS SINGLE, STRASIN() AS SINGLE, STRADES() AS SINGLE
SHARED RVER() AS STRING, RORI() AS STRING, RSIN() AS STRING, RDES() AS STRING
DIM SS1(2, 2) AS SINGLE, SS2(2, 2) AS SINGLE, SS3(2, 2) AS SINGLE, SS4(2, 2) AS SINGLE
DIM T1(2) AS STRING, T2(2) AS STRING, T3(2) AS STRING, T4(2) AS STRING
DIM I1(2) AS INTEGER, I2(2) AS INTEGER, I3(2) AS INTEGER, I4(2) AS INTEGER
SELECT CASE i
CASE 0 'salva
I1(k) = RigVER(X, Y)
I2(k) = RigORI(X, Y)
I3(k) = RigSIN(X, Y)
I4(k) = RigDES(X, Y)
FOR j = 1 TO 2
SS1(j, k) = STRAVER(I1(k), j)
SS2(j, k) = STRAORI(I2(k), j)
SS3(j, k) = STRASIN(I3(k), j)
SS4(j, k) = STRADES(I4(k), j)
NEXT j
T1$(k) = RVER$(I1(k))
T2$(k) = RORI$(I2(k))
T3$(k) = RSIN$(I3(k))
T4$(k) = RDES$(I4(k))
CASE 1 ' riprendi
FOR j = 1 TO 2
STRAVER(I1(k), j) = SS1(j, k)
STRAORI(I2(k), j) = SS2(j, k)
STRASIN(I3(k), j) = SS3(j, k)
STRADES(I4(k), j) = SS4(j, k)
NEXT j
RVER$(I1(k)) = T1$(k)
RORI$(I2(k)) = T2$(k)
RSIN$(I3(k)) = T3$(k)
RDES$(I4(k)) = T4$(k)
END SELECT
END SUB
SUB VertPiena
SHARED SIMUL AS INTEGER
'9900 REM
IF SIMUL = 0 THEN BEEP
END SUB
SUB Vittoria (R AS INTEGER, X AS INTEGER, Y AS INTEGER)
SHARED GIO AS INTEGER
'21800 REM qualcuno ha vinto
LOCATE YMESS, XMESS
PRINT "BRAVO ! Giocatore"; GIO
CALL LampVittoria(R, X, Y, GIO) ' lampeggio fila vincente (stessa present)
END SUB
SUB Voce (N AS INTEGER)
' numero della voce
SELECT CASE N
CASE 1
v$ = "00000"
CASE 2
v$ = "10100"
CASE 3
v$ = "01010"
CASE 4
v$ = "11110"
CASE 5
v$ = "00001"
CASE 6
v$ = "10101"
CASE 7
v$ = "01011"
CASE 8
v$ = "11111"
END SELECT
FOR i = 1 TO 5
A = (i + 1) * 2 + VAL(MID$(v$, i, 1))
OUT addreg, A
NEXT i
OUT startvoce, 0
END SUB
SUB ZeroPLib (A() AS INTEGER)
'15000 REM inizializza a() <- 0
FOR i = 1 TO XM
A(i) = 0
NEXT i
END SUB
(Source: Ferrox)
