Inizializza:
   TYPE RegType
      AX AS INTEGER
      BX AS INTEGER
      CX AS INTEGER
      DX AS INTEGER
      BP AS INTEGER
      SI AS INTEGER
      di AS INTEGER
      FLAGS AS INTEGER
   END TYPE
   DIM SHARED BS%(37), BL%(38), Reg AS RegType
   DECLARE SUB Absolute (Segment AS INTEGER, OffSet AS INTEGER, Address AS INTEGER)
   DECLARE SUB Ambiente ()
   DECLARE SUB ASCIICodesLoading ()
   DECLARE SUB AskAgain ()
   DECLARE SUB BuildChain1 ()
   DECLARE SUB BuildChain2 ()
   DECLARE SUB CaricaMatrice ()
   DECLARE SUB CatturaVideata ()
   DECLARE SUB CaricaVideata ()
   DECLARE SUB DialogBox ()
   DECLARE SUB DifferentiateInput (Limite, Inf, Sup, YYY, XXX, Colore, Activ)
   DECLARE SUB DosEnvironment ()
   DECLARE SUB DosShell ()
   DECLARE SUB ElaboraFile ()
   DECLARE SUB Fading (Delay AS INTEGER)
   DECLARE SUB GetKey (EV1, EVX, EVY, EVC, Posiz)
   DECLARE SUB Immissione ()
   DECLARE SUB Interrupt (IntNum AS INTEGER, InReg AS RegType, OutReg AS RegType)
   DECLARE SUB LightArrow (Arrow)
   DECLARE SUB MirrorMemory (FlagX)
   DECLARE SUB MouseClicked ()
   DECLARE SUB PageEjecting ()
   DECLARE SUB Presentazione ()
   DECLARE SUB Quitting ()
   DECLARE SUB Salvataggio ()
   DECLARE SUB SalvaVideata ()
   DECLARE SUB WaitKey (Activ)
   DECLARE FUNCTION ExePath$ ()
   Fading 250
   SCREEN 12
   ON ERROR GOTO ControlloErrori
   Origin$ = CURDIR$
   IF ENVIRON$("BUFFER") <> "" THEN
      Work$ = ENVIRON$("BUFFER")
   ELSE
      Work$ = ExePath$
   END IF

Test:
   Ind$ = LEFT$(Work$, 2)
   Urka = 1
   CHDRIVE Ind$
   CHDIR Work$
   Urka = 0
   Urka1 = 1
   OPEN "~Buffer.Tmp" FOR OUTPUT AS #1: CLOSE
   KILL "~Buffer.Tmp"
   Urka1 = 0
   KEY 15, CHR$(&H8) + CHR$(&H10)
   KEY(15) ON
   ON KEY(15) GOSUB Interruzione
   KEY 16, CHR$(&H8) + CHR$(&H12)
   KEY(16) ON
   ON KEY(16) GOSUB Ambiente
   KEY 17, CHR$(&H8) + CHR$(&H20)
   KEY(17) ON
   ON KEY(17) GOSUB DOS
   KEY 18, CHR$(&H8) + CHR$(&H2D)
   KEY(18) ON
   ON KEY(18) GOSUB SalvaSchermata
   DEF SEG = 0
   KeyFlags = PEEK(1047)
   POKE 1047, PEEK(1047) AND NOT 112
   DEF SEG
   RESTORE SaveImage
   DEF SEG = VARSEG(BS%(0))
   OPEN "SaveImg.Bin" FOR OUTPUT AS #1
      FOR I% = 0 TO 74
         READ Byte$
         POKE VARPTR(BS%(0)) + I%, VAL("&H" + Byte$)
         PRINT #1, CHR$(VAL("&H" + Byte$));
      NEXT
   CLOSE #1
   DEF SEG
   DEF SEG = VARSEG(BL%(0))
   OPEN "LoadImg.Bin" FOR OUTPUT AS #1
      FOR I% = 0 TO 75
         READ Byte$
         POKE VARPTR(BL%(0)) + I%, VAL("&H" + Byte$)
         PRINT #1, CHR$(VAL("&H" + Byte$));
      NEXT
   CLOSE #1
   DEF SEG

MenuGenerale:
   Presentazione
   LOCATE 12, 26: COLOR 15: PRINT "Nome file da caricare: ";
   DifferentiateInput 8, 48, 254, 12, 49, 15, 14
   File$ = Unit$
   Rec = 0
   IF File$ <> "" THEN
      Rec = 1
      File$ = File$ + ".ADV"
      GetKey 6, 13, 26, 15, 1
      GOSUB Manda
      GOTO MenuGenerale
   ELSE
      GOSUB InterfacciaInput
      LINE (0, 432)-(210, 477), 9, B
      LOCATE 29, 3: COLOR 11: PRINT "Premere ESC per uscire";
      DO
         WaitKey 14
      LOOP UNTIL Wait$ = CHR$(27)
      Quitting
      END
   END IF

Manda:
   ON Men GOSUB InterfacciaInput, InizializzaOutput, OrdinaFile, GeneraSequenze, RicercaOggetti, FineSessione
   RETURN

InterfacciaInput:
   Ambiente
   REDIM SHARED D(Item - 1, 6), Comm$(Item - 1)
   Immissione
   Salvataggio
   RETURN

InizializzaOutput:
   REDIM SHARED Num$(499), D$(499, 6)
   LOCATE 12, 26: PRINT SPACE$(32);
   LOCATE 12, 26: COLOR 13: PRINT "Attendere prego..."
   CaricaMatrice
   JumpNum = 0
   LOCATE 12, 26: PRINT SPACE$(18);
   LOCATE 12, 26: COLOR 15: PRINT "Numero da estrarre: ";
   DO WHILE JumpNum < 1 OR JumpNum > Num + 1
      LOCATE 12, 46: PRINT SPACE$(3)
      DifferentiateInput 3, 48, 57, 12, 46, 15, 14
      JumpNum = VAL(Unit$)
   LOOP

InterfacciaOutput:
   CLS : LINE (26, 161)-(615, 320), 9, B
   GetKey 4, 13, 11, 14, 2
   ON Men GOSUB Vedi1, Stampa1, Vedi2, Stampa2
   RETURN

Vedi1:
   DialogBox
   LOCATE 7, 8: PRINT "Numeri che compongono l'ultima generazione di numeri concatenanti"
   Address = 1: COLOR 15
   FOR K = 0 TO Num
      FOR S = 1 TO 5
         IF VAL(D$(K, S)) = JumpNum THEN
            LOCATE 13 + Address, 6 - LEN(D$(K, 0))
            PRINT D$(K, 0); CHR$(32);
            IF LEN(D$(K, 6)) > 28 THEN
               PRINT LEFT$(D$(K, 6), 23) + "[...]";
            ELSE
               PRINT D$(K, 6);
            END IF
            Address = Address + 1
            IF Address = 17 THEN
               Address = 1
               WaitKey 0
               Wait$ = ""
               LINE (2, 194)-(285, 477), 0, BF
            END IF
         END IF
      NEXT
   NEXT
   WaitKey 0
   Wait$ = ""
   GOSUB Richiedi

Vedi2:
   DialogBox
   LOCATE 7, 9: PRINT "Numeri che compongono la prima generazione di numeri concatenati"
   COLOR 15: Address = 1
   DO WHILE LEFT$(D$(JumpNum - 1, Address), 1) <> CHR$(48) AND Address <= 5
      LOCATE 13 + Address, 6 - LEN(D$(JumpNum - 1, Address))
      PRINT D$(JumpNum - 1, Address); CHR$(32);
      IF LEN(D$(VAL(D$(JumpNum - 1, Address)) - 1, 6)) > 28 THEN
         PRINT LEFT$(D$(VAL(D$(JumpNum - 1, Address)) - 1, 6), 23) + "[...]";
      ELSE
         PRINT D$(VAL(D$(JumpNum - 1, Address)) - 1, 6);
      END IF
      Address = Address + 1
   LOOP
   WaitKey 0
   Wait$ = ""
   GOSUB Richiedi

Stampa1:
   RESTORE CodiciStampa1
   ASCIICodesLoading
   LPRINT "Titolo del libro game: _______________________________________________________"
   LPRINT "Elenco dei paragrafi che concatenano il n."; JumpNum
   RESTORE CodiciStampa2
   ASCIICodesLoading
   FOR K = 0 TO Num
      FOR S = 1 TO 5
         IF VAL(D$(K, S)) = JumpNum THEN
            Check = 1
            LPRINT D$(K, 0); CHR$(32); D$(K, 6)
         END IF
      NEXT
   NEXT
   IF Check = 0 THEN
      LPRINT "Il n."; JumpNum; "non Š concatenato da nessun paragrafo."
   ELSE
      Check = 0
   END IF
   RESTORE CodiciStampa1
   ASCIICodesLoading
   LPRINT
   LPRINT "Number Linker Vers. 1.18 - Copyright (C) 1993/94"
   LPRINT "Pietro M. Picca, Giuseppe Ficara, Daniele Suppo & Paolo Simonotti"
   LPRINT
   PageEjecting
   GOSUB Richiedi

Stampa2:
   RESTORE CodiciStampa1
   ASCIICodesLoading
   LPRINT "Titolo del libro game: _______________________________________________________"
   LPRINT "Elenco dei paragrafi concatenati dal n."; JumpNum
   RESTORE CodiciStampa2
   ASCIICodesLoading
   Address = 1
   DO WHILE LEFT$(D$(JumpNum - 1, Address), 1) <> CHR$(48)
      Check = 1
      LPRINT D$(JumpNum - 1, Address); CHR$(32); D$(VAL(D$(JumpNum - 1, Address)) - 1, 6)
      Address = Address + 1
   LOOP
   IF Check = 0 THEN
      LPRINT "Il n."; JumpNum; "non concatena nessun paragrafo."
   ELSE
      Check = 0
   END IF
   RESTORE CodiciStampa1
   ASCIICodesLoading
   LPRINT
   LPRINT "Number Linker Vers. 1.18 - Copyright (C) 1993/94"
   LPRINT "Pietro M. Picca, Giuseppe Ficara, Daniele Suppo & Paolo Simonotti"
   LPRINT
   PageEjecting
   GOSUB Richiedi

Richiedi:
   AskAgain
   IF Nul = 0 THEN
      RETURN InterfacciaOutput
   ELSE
      RETURN Ritorna
   END IF

Ritorna:
   RETURN MenuGenerale

OrdinaFile:
   REDIM SHARED Num$(499), D$(499, 6), Num(499, 5)
   LOCATE 12, 26: PRINT SPACE$(32);
   LOCATE 12, 26: COLOR 13: PRINT "Attendere prego..."
   CaricaMatrice
   FOR L = 0 TO Num - 1
      FOR I = 1 TO 5
         Num(L, I) = VAL(D$(L, I))
      NEXT
   NEXT
   OPEN File$ FOR OUTPUT AS #1
      FOR L = 0 TO Num - 1
         FOR I = 1 TO 4
            FOR J = 1 TO 5 - I
               IF Num(L, J) > Num(L, J + 1) THEN SWAP Num(L, J), Num(L, J + 1)
            NEXT
         NEXT
         Zeri = 0
         FOR I = 1 TO 5
            IF Num(L, I) = 0 THEN Zeri = Zeri + 1
         NEXT
         FOR I = 1 TO 5
            IF I + Zeri < 6 THEN Num(L, I) = Num(L, I + Zeri)
            IF I + Zeri > 5 THEN Num(L, I) = 0
         NEXT
         FOR K = 1 TO 5
            D$(L, K) = STR$(Num(L, K))
         NEXT K
         Num$(L) = CHR$(32)
         FOR J = 0 TO 5
            Num$(L) = Num$(L) + D$(L, J)
         NEXT
         Num$(L) = Num$(L) + CHR$(32) + D$(L, 6)
         PRINT #1, Num$(L)
      NEXT
      PRINT #1, "Number Linker Vers. 1.18 - Copyright (C) 1993/94"
      PRINT #1, "Pietro M. Picca, Giuseppe Ficara, Daniele Suppo & Paolo Simonotti"
   CLOSE #1
   SOUND 6000, 5
   RETURN

GeneraSequenze:
   Flag1 = 1
   OPEN File$ FOR INPUT AS #1
   CLOSE #1
   Form = 1
   OPEN "ChainGen.Exe" FOR INPUT AS #1
   CLOSE #1
   Form = 0
   KEY(15) OFF: KEY(16) OFF: KEY(17) OFF
   Fading 150
   SCREEN 0
   SHELL "ChainGen.Exe" + CHR$(32) + File$
   Wait$ = INPUT$(1)
   SCREEN 12
   RETURN MenuGenerale

RicercaOggetti:
   REDIM SHARED Num$(499), D$(499, 6)
   LOCATE 12, 26: PRINT SPACE$(32);
   LOCATE 12, 26: COLOR 13: PRINT "Attendere prego..."
   CaricaMatrice
   DialogBox
   LOCATE 7, 5: PRINT "Paragrafi nei quali si trovano oggetti importanti ai fini dell'avventura"
   Address = 1: COLOR 15
   FOR I = 0 TO Num - 1
      IF LEFT$(D$(I, 6), 1) = CHR$(42) AND RIGHT$(D$(I, 6), 1) = CHR$(42) THEN
         LOCATE 13 + Address, 6 - LEN(D$(I, 0))
         PRINT D$(I, 0); CHR$(32);
         IF LEN(D$(I, 6)) > 28 THEN
            PRINT LEFT$(D$(I, 6), 23) + "[...]";
         ELSE
            PRINT D$(I, 6);
         END IF
         Address = Address + 1
         IF Address = 17 THEN
            Address = 1
            WaitKey 0
            Wait$ = ""
            LINE (2, 194)-(285, 477), 0, BF
         END IF
      END IF
   NEXT
   WaitKey 0
   Wait$ = ""
   RETURN MenuGenerale

Interruzione:
   KEY(15) OFF: KEY(16) OFF: KEY(17) OFF
   SalvaVideata
   CLS : SOUND 6000, 5
   LINE (0, 0)-(639, 479), 13, B
   LOCATE 15, 26: COLOR 11: PRINT "Sei sicuro di voler uscire? _";
   DO
      WaitKey 0
      Again$ = Wait$
      Wait$ = ""
   LOOP UNTIL LCASE$(Again$) = CHR$(110) OR LCASE$(Again$) = CHR$(115)
   LOCATE 15, 54: PRINT Again$;
   IF LCASE$(Again$) = CHR$(110) THEN
      CaricaVideata
      KEY(15) ON: KEY(16) ON: KEY(17) ON
      RETURN
   ELSE
      Control = 1
      KILL TmpPath$
      MirrorMemory 1
      RETURN FineSessione
   END IF

Ambiente:
   KEY(15) OFF: KEY(16) OFF: KEY(17) OFF
   SalvaVideata
   DosEnvironment
   CaricaVideata
   KEY(15) ON: KEY(16) ON: KEY(17) ON
   RETURN
   
DOS:
   KEY(15) OFF: KEY(16) OFF: KEY(17) OFF
   SalvaVideata
   Fading 150
   SCREEN 0
   SHELL
   Fading 150
   CHDRIVE Ind$
   CHDIR Work$
   SCREEN 12
   CaricaVideata
   KEY(15) ON: KEY(16) ON: KEY(17) ON
   RETURN

SalvaSchermata:
   KEY OFF
   Control = 1
   CatturaVideata
   MirrorMemory 2
   RETURN FineSessione

FineSessione:
   Quitting
   END

ControlloErrori:
   IF Urka = 1 THEN
      SOUND 6000, 5
      LOCATE 14, 7: COLOR 10: PRINT "La variabile d'ambiente BUFFER contiene un percorso inutilizzabile."
      IF LEN(ExePath$) > 25 THEN
         LOCATE 15, 14: PRINT "Verr… utilizzato come directory di lavoro il percorso:"
         LOCATE 16, INT((80 - LEN(ExePath$)) / 2) + 1: PRINT UCASE$(ExePath$)
      ELSE
         LOCATE 15, INT((25 - LEN(ExePath$)) / 2) + 1: PRINT "Verr… utilizzato il percorso "; UCASE$(ExePath$); " come directory di lavoro."
      END IF
      Work$ = ExePath$
      WaitKey 0
      RESUME Test
   END IF
   IF Urka1 = 1 THEN
      SOUND 6000, 5
      LOCATE 15, 14: COLOR 10: PRINT "Errore di creazione di file nel percorso specificato!"
      LOCATE 16, 8: PRINT "Se si tratta di un floppy disk drive, assicurarsi che il dischetto"
      LOCATE 17, 26: PRINT "non sia protetto da scrittura!"
      WaitKey 0
      CHDRIVE LEFT$(Origin$, 2)
      CHDIR Origin$
      END
   END IF
   IF ERR = 53 AND Form = 1 THEN
      SOUND 6000, 5
      CLS : LOCATE 16, 20: COLOR 10: PRINT "Impossibile trovare il file ChainGen.Exe!"
      LINE (0, 0)-(639, 479), 13, B
      Form = 0
      WaitKey 0
      Wait$ = ""
      RESUME MenuGenerale
   END IF
   IF ERR = 53 AND Flag1 = 0 THEN
      Flag = 0
      RESUME NEXT
   END IF
   SOUND 6000, 5
   IF ERR = 53 AND Flag1 = 1 THEN
      Error$ = "File " + UCASE$(File$) + " non trovato!"
      CLS : LOCATE 15, INT((80 - LEN(Error$)) / 2) + 1: COLOR 13: PRINT Error$
      WaitKey 0
      Wait$ = ""
      RESUME MenuGenerale
   END IF
   IF ERR = 25 OR ERR = 27 THEN
      CLS : LOCATE 15, 25: COLOR 13: PRINT "La stampante non Š disponibile!"
      LOCATE 16, 12: PRINT "Selezionare PRONTA sul pannello di controllo e riprovare."
      WaitKey 0
      Wait$ = ""
      RESUME MenuGenerale
   END IF
   IF ERR >= 62 AND Control = 0 THEN
      CLS : LOCATE 15, 13: COLOR 13: PRINT "Nome di file scorretto o device di I/O non disponibile!"
      WaitKey 0
      Wait$ = ""
      KEY(20) ON
      RESUME MenuGenerale
   ELSE
      CLS : LOCATE 15, 30: COLOR 13: PRINT "Errore irreversibile!"
      LOCATE 16, 30: PRINT "Codice dell'errore:"; ERR
      WaitKey 0
      Wait$ = ""
      IF Control = 1 THEN RESUME NEXT
      GOTO FineSessione
   END IF

LeggiMenu:
   DATA "1. Immetti nuovi dati","2. Estrai un numero","3. Riordina il file","4. Genera sequenze","5. Ricerca gli oggetti","6. Fine della sessione"

LeggiVedi:
   DATA "1. Visualizza l'ultima serie di paragrafi concatenanti","2. Invia l'elenco dei paragrafi concatenanti alla stampante"
   DATA "3. Visualizza la prima serie di paragrafi concatenati","4. Invia l'elenco dei paragrafi concatenati alla stampante"

SaveImage:
   DATA 55, 8B, EC, 57, 56, 1E, B8, 00, A0, 8E, C0, 8B, 76, 06, 8B, 14
   DATA 8B, 76, 08, 8B, 04, 8E, D8, B4, 3C, B9, 00, 00, CD, 21, 8B, F0
   DATA 06, 1F, BF, 03, 00, BA, CE, 03, 8B, C7, 8A, E0, B0, 04, EF, B9
   DATA 00, 96, 8B, DE, BA, 00, 00, B4, 40, CD, 21, 4F, 79, E7, B4, 3E
   DATA 8B, DE, CD, 21, 1F, 5E, 5F, 5D, CA, 02, 00

LoadImage:
   DATA 55, 8B, EC, 57, 56, 1E, B8, 00, A0, 8E, C0, 8B, 76, 06, 8B, 14
   DATA 8B, 76, 08, 8B, 04, 8E, D8, B4, 3D, B0, 00, CD, 21, 8B, F0, 06
   DATA 1F, BF, 03, 00, BA, C4, 03, 8B, CF, B4, 01, D2, E4, B0, 02, EF
   DATA B9, 00, 96, 8B, DE, BA, 00, 00, B4, 3F, CD, 21, 4F, 79, E5, B4
   DATA 3E, 8B, DE, CD, 21, 1F, 5E, 5F, 5D, CA, 02, 00

CodiciStampa1:
   DATA 27, 38, 108, 48, 79: REM Orientamento
   DATA 27, 38, 108, 52, 68: REM Interlinea
   DATA 27, 40, 49, 48, 85: REM Set di caratteri
   DATA 27, 40, 115, 49, 80: REM Spaziatura
   DATA 27, 40, 115, 49, 52, 86: REM Corpo
   DATA 27, 40, 115, 49, 83: REM Stile
   DATA 27, 40, 115, 48, 66: REM Tratto
   DATA 27, 40, 115, 52, 49, 48, 49, 84: REM Carattere tipografico
   DATA 27, 40, 115, 50, 81: REM Qualit…

CodiciStampa2:
   DATA 27, 38, 108, 48, 79: REM Orientamento
   DATA 27, 38, 108, 49, 48, 68: REM Interlinea
   DATA 27, 40, 49, 48, 85: REM Set di caratteri
   DATA 27, 40, 115, 49, 80: REM Spaziatura
   DATA 27, 40, 115, 56, 86: REM Corpo
   DATA 27, 40, 115, 48, 83: REM Stile
   DATA 27, 40, 115, 48, 66: REM Tratto
   DATA 27, 40, 115, 52, 49, 48, 49, 84: REM Carattere tipografico
   DATA 27, 40, 115, 50, 81: REM Qualit…

SUB Ambiente
   SHARED Limite, Inf, Sup, YYY, XXX, Colore, Item, Unit$

   CLS : COLOR 13: LINE (0, 0)-(183, 45), , B
   LOCATE 2, 3: PRINT "Numero di item: ";
   DifferentiateInput 3, 48, 57, 2, 19, 13, 0
   Item = VAL(Unit$)
   DO WHILE Item < 1 OR Item > 500
      LOCATE 2, 19: PRINT SPACE$(3)
      DifferentiateInput 3, 48, 57, 2, 19, 13, 0
      Item = VAL(Unit$)
   LOOP
   COLOR 11: LOCATE 6, 3: PRINT "Item n.": LOCATE 6, 15: PRINT "Descrizione"; SPACE$(22); "Concatenamenti"
   LINE (90, 100)-(90, 410)
   LINE (0, 100)-(639, 410), , B
   FOR L = 1 TO 5
      LINE (303 + (56 * L), 100)-(303 + (56 * L), 410)
   NEXT
   LINE (455, 432)-(639, 477), 14, B

END SUB

SUB ASCIICodesLoading

   FOR I = 1 TO 49
      READ ASCII
      LPRINT CHR$(ASCII);
   NEXT

END SUB

SUB AskAgain
   SHARED Limite, Sup, Inf, YYY, XXX, Colore, JumpNum, Unit$, Nul, Num, Wait$

   CLS : COLOR 10: LINE (198, 207)-(416, 272), 13, B
   LOCATE 15, 28: PRINT "Altro numero? _";
   DO
      WaitKey 0
      Again$ = Wait$
      Wait$ = ""
   LOOP UNTIL LCASE$(Again$) = CHR$(110) OR LCASE$(Again$) = CHR$(115)
   LOCATE 15, 42: PRINT Again$
   IF LCASE$(Again$) = CHR$(115) THEN
      JumpNum = 0
      LOCATE 16, 28: PRINT "Numero da estrarre: ";
      DO WHILE JumpNum < 1 OR JumpNum > Num + 1
         LOCATE 16, 48: PRINT SPACE$(3)
         DifferentiateInput 3, 48, 57, 16, 48, 10, 0
         JumpNum = VAL(Unit$)
      LOOP
      Nul = 0
   ELSE
      Nul = 1
   END IF

END SUB

SUB CaricaMatrice
   SHARED File$, Num$, D$, Num, Flag1

   Num = -1
   Flag1 = 1
   OPEN File$ FOR INPUT AS #1
      DO
         Num = Num + 1
         LINE INPUT #1, Num$(Num)
         IF LEFT$(Num$(Num), 1) = CHR$(32) THEN Num$(Num) = MID$(Num$(Num), 2)
      LOOP UNTIL Num$(Num) = "Number Linker Vers. 1.18 - Copyright (C) 1993/94"
   CLOSE #1
Scomponi:
   FOR I = 0 TO Num
      Counter = 0
      D$(I, Counter) = ""
      FOR J = 0 TO LEN(Num$(I)) - 1
         Tmp$ = MID$(Num$(I), J + 1, 1)
         IF Tmp$ <> CHR$(32) AND Counter <= 6 THEN
            D$(I, Counter) = D$(I, Counter) + Tmp$
         ELSE
            Counter = Counter + 1
            IF Counter > 6 THEN
               Counter = 6
               D$(I, Counter) = D$(I, Counter) + Tmp$
            END IF
         END IF
      NEXT
   NEXT

END SUB

SUB CaricaVideata
   SHARED BL%, TmpPath$, Path$, Segment%, OffSet%, Address%

   DEF SEG = VARSEG(BL%(0))
   Absolute SSEG(Path$), SADD(Path$), VARPTR(BL%(0))
   DEF SEG
   KILL TmpPath$

END SUB

SUB CatturaVideata
   SHARED BS%, Segment%, OffSet%, Address%, Control

   TmpPath$ = "Session.Sav"
   OPEN TmpPath$ FOR OUTPUT AS #1
   CLOSE #1
   Path$ = TmpPath$ + CHR$(0)
   SOUND 6000, 5
   DEF SEG = VARSEG(BS%(0))
   Absolute SSEG(Path$), SADD(Path$), VARPTR(BS%(0))
   DEF SEG
   CLS : LOCATE 15, 7: COLOR 10: PRINT "Il programma Š stato interrotto. E' stata salvata l'ultima schermata"
   LOCATE 16, 30: PRINT "nel file SESSION.SAV."
   WaitKey 0

END SUB

SUB DialogBox

   CLS : COLOR 11: LINE (0, 192)-(287, 479), , B
   LOCATE 29, 39: PRINT "Premere un tasto";
   LOCATE 30, 39: PRINT "per continuare";

END SUB

SUB DifferentiateInput (Limite, Inf, Sup, YYY, XXX, Colore, Activ)
   SHARED Unit$

Limita:
   Unit$ = ""
   DO
Aspetta:
      LOCATE YYY, XXX + LEN(Unit$): COLOR Colore: PRINT CHR$(95);
      DO
         Temp$ = INKEY$
         IF Activ THEN COLOR Activ: LOCATE 29, 60: PRINT MID$(DATE$, 4, 3) + LEFT$(DATE$, 3) + RIGHT$(DATE$, 4) + CHR$(32) + TIME$;
      LOOP UNTIL Temp$ <> ""
      IF ASC(Temp$) = 27 THEN
         LOCATE YYY, XXX: PRINT SPACE$(Limite);
         GOTO Limita
      END IF
      IF ASC(Temp$) = 8 THEN
         LOCATE YYY, XXX + LEN(Unit$) - 1: PRINT SPACE$(2);
         Cif = LEN(Unit$) - 1
         IF Cif > -1 THEN Unit$ = LEFT$(Unit$, Cif)
      END IF
      IF (ASC(Temp$) < Inf OR ASC(Temp$) > Sup) AND ASC(Temp$) <> 13 THEN
         LOCATE YYY, XXX + LEN(Unit$): PRINT CHR$(32);
         GOTO Aspetta
      ELSE
         IF ASC(Temp$) <> 13 THEN
            LOCATE YYY, XXX + LEN(Unit$): COLOR Colore: PRINT LCASE$(Temp$);
            Unit$ = Unit$ + Temp$
         ELSE
            LOCATE YYY, XXX + LEN(Unit$): PRINT CHR$(32);
            EXIT SUB
        END IF
      END IF
   LOOP UNTIL LEN(Unit$) = Limite
Pazienta:
   Invio$ = INKEY$
   IF Activ THEN COLOR Activ: LOCATE 29, 60: PRINT MID$(DATE$, 4, 3) + LEFT$(DATE$, 3) + RIGHT$(DATE$, 4) + CHR$(32) + TIME$;
   IF Invio$ <> CHR$(13) THEN
      IF Invio$ = CHR$(27) THEN
         LOCATE YYY, XXX: PRINT SPACE$(Limite);
         GOTO Limita
      ELSE
         IF Invio$ = CHR$(8) THEN
            LOCATE YYY, XXX + LEN(Unit$) - 1: PRINT CHR$(32);
            Unit$ = LEFT$(Unit$, LEN(Unit$) - 1)
            GOTO Aspetta
         ELSE
            GOTO Pazienta
         END IF
      END IF
   END IF
Continua:

END SUB

SUB DosEnvironment

   CLS : Par = 0
   DO
      Par = Par + 1
   LOOP UNTIL ENVIRON$(Par) = ""
   IF Par / 2 <> INT(Par / 2) THEN Y = (31 - Par) / 2 + 1 ELSE Y = INT((31 - Par) / 2)
   LOCATE Y, 1
   FOR J = 1 TO Par - 1
      IF J / 2 <> INT(J / 2) THEN COLOR 14 ELSE COLOR 11
      PRINT ENVIRON$(J)
   NEXT
   WaitKey 0
   Wait$ = ""

END SUB

FUNCTION ExePath$

   Reg.AX = &H6200
   Interrupt &H21, Reg, Reg
   DEF SEG = Reg.BX
   DEF SEG = PEEK(&H2C) + PEEK(&H2D) * 256
   DO
      Scan$ = CHR$(PEEK(I)) + CHR$(PEEK(I + 1)) + CHR$(PEEK(I + 2)) + CHR$(PEEK(I + 3))
      I = I + 1
   LOOP UNTIL Scan$ = CHR$(0) + CHR$(0) + CHR$(1) + CHR$(0)
   Init = I + 3: I = I + 3
   DO
      I = I + 1
   LOOP UNTIL PEEK(I) = 0
   Alt = I - 1
   Temp$ = SPACE$(Alt - Init + 1)
   FOR I = Init TO Alt
      MID$(Temp$, I - Init + 1, 1) = CHR$(PEEK(I))
   NEXT
   FOR I = 1 TO LEN(Temp$)
      IF MID$(Temp$, LEN(Temp$) - I + 1, 1) = CHR$(92) THEN EXIT FOR
   NEXT
   Temp$ = LEFT$(Temp$, LEN(Temp$) - I)
   IF LEN(Temp$) = 2 THEN Temp$ = Temp$ + CHR$(92)
   DEF SEG
   ExePath$ = Temp$

END FUNCTION

SUB Fading (Delay AS INTEGER)

   DIM Temp(1 TO 3) AS INTEGER
   FOR I% = 1 TO 64
      FOR J% = 1 TO Delay%: NEXT
      FOR J% = 0 TO 255
         OUT &H3C7, J%
         FOR K% = 1 TO 3
            Temp%(K%) = INP(&H3C9)
            IF Temp%(K%) > 0 THEN Temp%(K%) = Temp%(K%) - 1
         NEXT
         OUT &H3C8, J%
         FOR K% = 1 TO 3
            OUT &H3C9, Temp%(K%)
         NEXT
      NEXT
   NEXT

END SUB

SUB GetKey (EV1, EVX, EVY, EVC, Posiz)
   SHARED Men, Arrow

   KEY(15) OFF: KEY(16) OFF: KEY(17) OFF
   REDIM Men$(EV1 - 1)
   IF Posiz = 1 THEN RESTORE LeggiMenu ELSE RESTORE LeggiVedi
   FOR Men = 1 TO EV1
      READ Men$(Men - 1)
      LOCATE EVX + Men, EVY: PRINT Men$(Men - 1)
      COLOR 11: LOCATE EVX + 1, EVY: PRINT Men$(0): COLOR EVC
   NEXT Men
   LightArrow 1
   Men = 1
Ripercorri:
   Nul = 1: LL$ = INKEY$
   IF Posiz = 1 THEN
      COLOR 14: LOCATE 29, 60
      PRINT MID$(DATE$, 4, 3) + LEFT$(DATE$, 3) + RIGHT$(DATE$, 4) + CHR$(32) + TIME$;
      COLOR EVC
   END IF
   MouseClicked
   IF Reg.BX THEN LL$ = CHR$(13)
   IF LL$ = "" THEN GOTO Ripercorri
   IF ASC(LL$) = 13 THEN ERASE Men$: GOTO Main
TornaQui:
   LightArrow 0
   IF LL$ = CHR$(&H0) + CHR$(&H48) THEN
      LOCATE EVX + Men, EVY: PRINT Men$(Men - 1)
      Men = Men - 1
      IF Men < 1 THEN Men = EV1
   END IF
   IF LL$ = CHR$(&H0) + CHR$(&H50) THEN
      LOCATE EVX + Men, EVY: PRINT Men$(Men - 1)
      Men = Men + 1
      IF Men > EV1 THEN Men = 1
   END IF
   IF ASC(LL$) >= 49 AND ASC(LL$) <= ASC(RIGHT$(STR$(EV1), 1)) THEN
      COLOR EVC: LOCATE EVX + Men, EVY: PRINT Men$(Men - 1): COLOR 11
      LOCATE EVX + VAL(CHR$(ASC(LL$))), EVY: PRINT Men$(VAL(CHR$(ASC(LL$))) - 1)
      Men = VAL(CHR$(ASC(LL$)))
   END IF
   COLOR 11: LOCATE EVX + Men, EVY: PRINT Men$(Men - 1): COLOR EVC
   LightArrow 1
   GOTO Ripercorri
Main:
   LightArrow 0
   KEY(15) ON: KEY(16) ON: KEY(17) ON

END SUB

SUB Immissione
   SHARED Item, Limite, Inf, Sup, YYY, XXX, Colore, Unit$, D, Comm$

   FOR I = 0 TO Item - 1
      COLOR 15: LOCATE 8 + (I MOD 18), 10 - LEN(STR$(I + 1)): PRINT I + 1
      D(I, 0) = I + 1
      DifferentiateInput 28, 32, 254, 8 + (I MOD 18), 15, 15, 14
      Comm$(I) = Unit$
      FOR U = 1 TO 5
Ripeti:
         DifferentiateInput 3, 48, 57, 8 + (I MOD 18), 41 + U * 7, 15, 14
         C$ = Unit$
         IF C$ = "" THEN GOTO R100
         Dupl = 0
         FOR W = 1 TO U - 1
            IF D(I, W) = VAL(C$) THEN Dupl = 1
         NEXT
         IF VAL(C$) > Item OR VAL(C$) = D(I, 0) OR Dupl = 1 THEN
            LOCATE 8 + (I MOD 18), 41 + U * 7
            PRINT SPACE$(4)
            GOTO Ripeti
         END IF
         D(I, U) = VAL(C$)
      NEXT
R100:
   IF I MOD 18 = 17 THEN
      LINE (2, 102)-(88, 408), 0, BF
      LINE (92, 102)-(357, 408), 0, BF
      FOR ML = 1 TO 5
         LINE (305 + 56 * ML, 102)-(301 + 56 * (ML + 1), 408), 0, BF
      NEXT
   END IF
   NEXT

END SUB

SUB LightArrow (Arrow)
   
   IF Arrow = 1 THEN Reg.AX = 1 ELSE Reg.AX = 2
   Interrupt &H33, Reg, Reg

END SUB

SUB MirrorMemory (FlagX)
   SHARED Unit$, Wait$

   IF FlagX = 1 THEN
      XXX = 5: YYY = 16
   ELSE
      CLS : XXX = 1: YYY = 30
   END IF
   LOCATE YYY, XXX: PRINT "Vuoi salvare il contenuto del segmento corrente di memoria in un file? _"
   DO
      WaitKey 0
      Again$ = Wait$
      Wait$ = ""
   LOOP UNTIL LCASE$(Again$) = CHR$(110) OR LCASE$(Again$) = CHR$(115)
   LOCATE YYY, XXX + 71: PRINT Again$;
   IF LCASE$(Again$) = CHR$(115) THEN
      IF FlagX = 2 THEN
         CLS : LOCATE 30, 1
      ELSE
         LOCATE 17, 23
      END IF
      PRINT "Immettere il nome del file: ";
      IF FlagX = 1 THEN
         DifferentiateInput 8, 97, 122, 17, 51, 11, 0
      ELSE
         DifferentiateInput 8, 97, 122, 30, 29, 10, 0
      END IF
      IF Unit$ = "" THEN Unit$ = "Mirror"
      BSAVE Unit$ + ".IMG", 0, &HFFFF
      Reg.AX = &H6200
      Interrupt &H21, Reg, Reg
      DEF SEG = Reg.BX
      OPEN "PSP.Img" FOR OUTPUT AS #1
         FOR I = 0 TO 255
            PRINT #1, CHR$(PEEK(I));
         NEXT
      CLOSE #1
   END IF

END SUB

SUB MouseClicked

    Reg.AX = 5
    Interrupt &H33, Reg, Reg

END SUB

SUB PageEjecting
   SHARED Wait$
  
   CLS : LOCATE 30, 1: COLOR 10: PRINT "Emissione carta? _";
   DO
      WaitKey 0
      Again$ = Wait$
      Wait$ = ""
   LOOP UNTIL LCASE$(Again$) = CHR$(110) OR LCASE$(Again$) = CHR$(115)
   IF LCASE$(Again$) = CHR$(115) THEN
      LPRINT CHR$(27); CHR$(38); CHR$(108); CHR$(48); CHR$(72)
   ELSE
      RESTORE CodiciStampa1
      ASCIICodesLoading
      LPRINT
   END IF

END SUB

SUB Presentazione
   SHARED Wait$

   CLS : LINE (0, 0)-(639, 479), 10, B
   LOCATE 2, 3: COLOR 12: PRINT "Number Linker Vers. 1.18 - Copyright (C) 1993/94"
   LOCATE 3, 3: PRINT "Pietro M. Picca, Giuseppe Ficara, Daniele Suppo & Paolo Simonotti"
   DO
      WaitKey 14
   LOOP UNTIL Wait$ = CHR$(32)

END SUB

SUB Quitting
   SHARED KeyFlags, Wait$, Ind$, Control, Origin$
  
   KEY OFF
   CLS : LOCATE 30, 1: COLOR 10: PRINT "Vuoi cancellare i files binari? _";
   DO
      WaitKey 0
      Again$ = Wait$
      Wait$ = ""
   LOOP UNTIL LCASE$(Again$) = CHR$(110) OR LCASE$(Again$) = CHR$(115)
   LOCATE 30, 33: PRINT Again$
   Control = 1
   IF LCASE$(Again$) = CHR$(115) THEN
      KILL Ind$ + "SaveImg.Bin"
      KILL Ind$ + "LoadImg.Bin"
   END IF
   Fading 250
   DEF SEG = 0
   POKE 1047, KeyFlags
   DEF SEG
   CHDRIVE LEFT$(Origin$, 2)
   CHDIR Origin$

END SUB

SUB Salvataggio
   SHARED Item, Rec, Flag, Flag1, File$, D, Comm$, Wait$

   IF Rec = 1 THEN
      Flag = 1: Flag1 = 0
      OPEN File$ FOR INPUT AS #1
      CLOSE #1
      IF Flag = 1 THEN
         LINE (0, 432)-(258, 477), 9, B
         LOCATE 29, 3: COLOR 11: PRINT "Vuoi sovrascrivere i dati? _";
         DO
            WaitKey 0
            Over$ = Wait$
            Wait$ = ""
         LOOP UNTIL LCASE$(Over$) = CHR$(110) OR LCASE$(Over$) = CHR$(115)
         LOCATE 29, 30: PRINT Over$;
         IF LCASE$(Over$) = CHR$(115) THEN
            OPEN File$ FOR OUTPUT AS #1
         ELSE
            OPEN File$ FOR APPEND AS #1
         END IF
      ELSE
         OPEN File$ FOR OUTPUT AS #1
      END IF
         FOR R = 0 TO Item - 1
            PRINT #1, STR$(D(R, 0)) + STR$(D(R, 1)) + STR$(D(R, 2)) + STR$(D(R, 3)) + STR$(D(R, 4)) + STR$(D(R, 5)) + CHR$(32) + Comm$(R)
         NEXT
         PRINT #1, "Number Linker Vers. 1.18 - Copyright (C) 1993/94"
         PRINT #1, "Pietro M. Picca, Giuseppe Ficara, Daniele Suppo & Paolo Simonotti"
      CLOSE #1
   END IF

END SUB

SUB SalvaVideata
   SHARED BS%, TmpPath$, Path$, Segment%, OffSet%, Address%

   TmpPath$ = "Screen.Sav"
   OPEN TmpPath$ FOR OUTPUT AS #1
   CLOSE #1
   Path$ = TmpPath$ + CHR$(0)
   DEF SEG = VARSEG(BS%(0))
   Absolute SSEG(Path$), SADD(Path$), VARPTR(BS%(0))
   DEF SEG
   
END SUB

SUB WaitKey (Activ)
   SHARED Wait$

   DO
      Wait$ = INKEY$
      IF Activ THEN COLOR Activ: LOCATE 29, 60: PRINT MID$(DATE$, 4, 3) + LEFT$(DATE$, 3) + RIGHT$(DATE$, 4) + CHR$(32) + TIME$;
   LOOP UNTIL Wait$ <> ""

END SUB