If you appreciate the work done within the wiki, please consider supporting The Cutting Room Floor on Patreon. Thanks for all your support!
Filetto
Jump to navigation
Jump to search
Cleanup > Pages missing date references
Cleanup > Pages missing developer references
Cleanup > Pages missing publisher references
Games > Games by content > Games with uncompiled source code
Games > Games by developer > Games developed by Novarmatic
Games > Games by platform > Arcade games
Games > Games by publisher > Games published by Novarmatic
Games > Games by release date > Games released in 1990
Games > Games by release date > Games released in October
Filetto |
---|
Developer: Novarmatic This game has uncompiled source code. |
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)
Cleanup > Pages missing date references
Cleanup > Pages missing developer references
Cleanup > Pages missing publisher references
Games > Games by content > Games with uncompiled source code
Games > Games by developer > Games developed by Novarmatic
Games > Games by platform > Arcade games
Games > Games by publisher > Games published by Novarmatic
Games > Games by release date > Games released in 1990
Games > Games by release date > Games released in October