DECLARE SUB Alku () DECLARE SUB LoadPic (File$) DECLARE SUB TyhjennaHurjanEfektinPuskuri () DECLARE SUB Credits () DECLARE SUB Ops.Ukko.Loppu () DECLARE SUB ValmistelePlasma () DECLARE SUB ValmistelePlasmanVari (Col%) DECLARE SUB Center (Text$, Row%) DECLARE SUB Pelu.Ruutu.Nuke () DECLARE SUB Kveik (Lines%) DECLARE SUB Ops.Ukko () DECLARE SUB Nuke.WinNuke () DECLARE SUB Nuke.Ruutu () DECLARE SUB KuulCLS2 (Lines%) DECLARE SUB KuulCLS (Lines%) DECLARE SUB ScreenOff () DECLARE SUB ScreenOn () DECLARE SUB Scroll (UpperRow%, LowerRow%, Columns%, Direction%) DECLARE SUB TeeHurjaEfekti2 () DECLARE SUB OvelaTeksti2 (Text$) DECLARE SUB OvelaTeksti (Text$) DECLARE SUB PrintFont (x%, Y%, Text$, Col%) DECLARE SUB LoadFont () DECLARE SUB Plasma (Init%) DECLARE SUB Ops.Ruutu.PrintText (Text$) DECLARE SUB Scroll.Down (Lines%, x1%, y1%, x2%, y2%, attrib%) DECLARE SUB TeeHurjaEfekti () DECLARE SUB ValmisteleHurjaEfekti () DECLARE SUB Ops.Ruutu () DECLARE SUB Gauge (xPos%, YPos%, XLen%, Value&, Max&, Char$) DECLARE SUB Pelu.Ruutu.DownLoad () DECLARE SUB Scroll.Up (Lines%, x1%, y1%, x2%, y2%, attrib%) DEFINT A-Z DECLARE FUNCTION Exist% (File$) DECLARE FUNCTION FixFileName$ (File$, Extension$) DECLARE FUNCTION Pack! (Archive$, Filename$, NoPrint!) DECLARE FUNCTION PackList! (Archive$) DECLARE FUNCTION PackOffset! (Archive$, Filename$, Length!) DECLARE FUNCTION Unpack! (Archive$, Filename$, NoPrint!) DECLARE SUB Pelu.Ruutu () DECLARE SUB Pelu.Ruutu.PrintText (Text$) '$DYNAMIC ON ERROR GOTO Virhe RANDOMIZE TIMER CONST False = 0 CONST True = NOT False DIM SHARED DataFile$ TYPE PakHeader Version AS STRING * 5 'Version Total AS STRING * 3 'Total files in archive END TYPE DataFile$ = "win8086.swp" IF COMMAND$ = "DEBUG" THEN Dummy = PackList(DataFile$) SYSTEM END IF DIM SHARED Ruutu& Address = PEEK(1040) AND 48 IF Address = 48 THEN Ruutu& = &HB000 'mono ELSE Ruutu& = &HB800 'color END IF DIM SHARED Font(1 TO 40, 0 TO 2) AS STRING * 3 DIM SHARED Ruutu%(80) DIM SHARED CurrentVersion AS STRING * 5 DIM SHARED sine1%(0 TO 360) DIM SHARED sine2%(0 TO 360) DIM SHARED sine3%(0 TO 360) DIM SHARED sine4%(0 TO 360) DIM SHARED ScreenB%(1 TO 80) DIM SHARED ScreenB2%(1 TO 80) DIM SHARED Cosinus(160) AS INTEGER DIM SHARED Rand(255) AS INTEGER DIM SHARED ColTable(0 TO 15) AS INTEGER Alku PRINT PRINT PRINT "Valmistellaan valmistelun valmistelemista..."; LoadFont ValmisteleHurjaEfekti TyhjennaHurjanEfektinPuskuri ValmistelePlasma ValmistelePlasmanVari 0 PRINT CLS CurrentVersion = "Pak10" 'Current version signature ValmistelePlasmanVari 0 OvelaTeksti "tm multi media esitys kertoo urheista yhteiskuntamme valio jsenist jotka suojelevat tavallista internet kyttj hnt terrorisoivilta lameri joukoilta" Ops.Ukko ValmistelePlasmanVari 3 OvelaTeksti "Nyt tutustumme yhteen kiljoonista lameri lajin edustajista ... pelu lamurantaan joka on jo pitkn riivannut mirc keskustelu verkkoa ..." ValmistelePlasmanVari 0 Pelu.Ruutu Ops.Ruutu Nuke.WinNuke Nuke.Ruutu ValmistelePlasmanVari 2 OvelaTeksti "Samaan aikaan pelu jatkaa mirkkailuaan tietmtt uhkaavasta vaarasta ..." Pelu.Ruutu.Nuke Ops.Ukko.Loppu Credits WIDTH 80, 25 COLOR 7, 0 PRINT "Skitsofrenia on sisist moniajoa."; COLOR 7 + 16, 0 PRINT "" COLOR 7 PLAY "mf o2 L8 f L16 c L16 c L8 d c P8 e f" SLEEP 1 SYSTEM Quotes.Freenet: DATA " Saako tlt knnykit?" DATA " mik on kytt jrjestelm?" DATA " teettek te knnykit?" DATA " SHOWDOWN!!!!!!!" DATA " #finfiles!!!!!!!" DATA " HURJAA!" DATA " Pelatkaa dukeeeeeeee!!!!!!!!!!1111111" DATA " TAKEOVERIT SUXXXX!!!" DATA " ????" DATA " QUAKEEEEEE" DATA " joo" DATA " niin" DATA " jopa" DATA " ehkp" DATA " tuskin" DATA " joo" DATA " niin" DATA " pWp rules" DATA " Unreal Voodoo rules" DATA " tAAt rules" DATA " ehkp" DATA " tuskin" DATA " NIRVANA!" DATA " COBAIN!" DATA " RULES!!!111" DATA " SUXXX!!!!11" DATA " DUKEA!!??!" DATA " DUGEA!!?=?!" DATA " JOOOO" DATA " WANNA SEE NUDE mIRC USERS??" DATA " GO TO WWW.NUDEMIRC.COM!!!!" DATA "*** DCC Send SCRIPT.INI from rizto" DATA " JUMALAN VIHA ON SUOMEN YLL!!!!" DATA " SUOMALAISET OVAT SATANISTEJA!!!!" DATA "*** DCC Send SCRIPT.INI from darkboy" DATA "*** DCC Send SCRIPT.INI from darkd00d" DATA " SATANISTIPURKKEJA INTERNETISS!!!!!" DATA " RAAMATTU ON SAATANASTA!!!" DATA "*** kikson_fr has been kicked off channel #freenet (laama)" DATA "*** rizto has been kicked off channel #freenet (flood)" DATA "*** C0sin has been kicked off channel #freenet (s vitutat)" DATA "*** kikson_fr has joined channel #freenet" DATA "*** heck has joined channel #freenet" DATA "*** hiteck has joined channel #freenet" DATA "*** viznut has joined channel #freenet" DATA "*** swap has joined channel #freenet" DATA "*** stickieee has joined channel #freenet" DATA "*** tonic has joined channel #freenet" DATA "*** rizto has joined channel #freenet" DATA "*** C0sin has joined channel #freenet" DATA "*** lazer has joined channel #freenet" Filenames: DATA "QUAKELEV.ZIP" DATA "DUKELEV.ZIP" DATA "PIKKU2.MP3" DATA "QBDEMO.BAS" DATA "MUMMO.JPG" DATA "HURJA.JPG" DATA "KARU.JPG" DATA "HASSU.BAS" DATA "ESTERI.JPG" DATA "HILDA.JPG" DATA "LEENA.GIF" DATA "ISI.ZIP" DATA "MBNET.FAQ" DATA "DUKE.FAQ" DATA "QUAKE.FAQ" DATA "MP3.ZIP" DATA "NAMELESS.ZIP" DATA "KOERA.GIF" Quotes.Pelu: DATA "mik on linux???!!!+" DATA "miksei kukaan pelaa dukee?????++" DATA "pelatkaa dukee!!!!" DATA "m oon meidn kyln quake mestari!!" DATA "mikrobitti on paras!!!1" DATA "mbnet on paras!!!1" DATA "QUAKE RULESS!!!!!!!!!!!!!!!!!!!" DATA "DUKE RULES!!!!!!!!!!!!!!!!" DATA "WINDOWS RULSS!!!!!!!!!!!!!!!!!" DATA "WIN95 RULZS!!!!!!!!!!!!!!!!!!!!!!" DATA "dossi on ihan huono kun ei oo kuvia" DATA "DOSSI SUX!!!!!!!!!!!!!!!!!!!!" DATA "KUKA ON MUN MIRC TYTT YSTV??????" DATA "m tein quikbasicilla matopelin!!!!" DATA "m tein kuupasicilla demon!!!!1" DATA "m tein quiskbasigilla intron!!" DATA "MEIDN GRUUPPI ON MAAILMAN HYVIN!!" DATA "JUTTU SEURAAAAAAAAAAAA?????????!!!" Font.Data: DATA "" DATA " " DATA "" DATA " " DATA " " DATA " " DATA "" DATA "" DATA "" DATA "" DATA " " DATA "" DATA " " DATA "" DATA " " DATA "" DATA "" DATA "" DATA "" DATA "" DATA "" DATA "" DATA " " DATA " " DATA "" DATA "" DATA "" DATA "" DATA "" DATA "" DATA "" DATA "" DATA " " DATA "" DATA "" DATA "" DATA "" DATA " " DATA "" DATA "" DATA " " DATA "" DATA "" DATA " " DATA "" DATA "" DATA " " DATA " " DATA "" DATA "" DATA "" DATA " " DATA "" DATA " " DATA " " DATA " " DATA " " DATA " " DATA " " DATA "" DATA " " DATA "" DATA " " DATA " " DATA " " DATA "" DATA "" DATA "" DATA " " DATA "" DATA " " DATA " " DATA "" DATA " " DATA "" DATA "" DATA "" DATA " " DATA "" DATA "" DATA "" DATA "" DATA "" DATA " " DATA "" DATA "" DATA "" DATA "" DATA " " DATA " " DATA " " DATA " " DATA "" DATA " " DATA " " DATA "" DATA " " DATA "" DATA "" DATA " " DATA " " DATA " " DATA " " DATA "" DATA " " DATA "" DATA "" DATA "" DATA " " DATA " " DATA " " DATA " " DATA " " DATA " " DATA " " DATA " " DATA " " DATA "" DATA " " DATA " " Virhe: WIDTH 80, 25 COLOR 7, 0 CLS PRINT "MAAILMANLOPPU TULLOO!!!!!! KAUHEE VIRHE TAPAHTU!!!!!!!!!:"; PRINT ERR PRINT SYSTEM REM $STATIC SUB Alku WIDTH 80, 25 LOCATE 1, 1, 0, 0, 0 LoadPic "logo.bsv" Start& = TIMER DO: LOOP UNTIL INKEY$ <> "" OR TIMER > Start& + 3 FOR i = 0 TO 13 Scroll.Up 1, 1, 1, 80, 25, 0 WAIT &H3DA, 8 NEXT COLOR 7, 0 LOCATE 18, 1 PRINT "Omistatko tietokoneeseen asennettavan Sound Blaster(tm)" PRINT "tai yhteensopivan nentulostuslaitteen? [Y/N] "; DO: Joo$ = UCASE$(INPUT$(1)): LOOP UNTIL Joo$ = "Y" OR Joo$ = "N" PRINT Joo$ PRINT PRINT IF Joo$ = "Y" THEN PRINT "NII MKIN!!!!!!!!1111" IF Joo$ = "N" THEN PRINT "MULLAPA ON!!!!!!!!111111" Start& = TIMER DO: LOOP UNTIL INKEY$ <> "" OR TIMER > Start& + 1 END SUB SUB Center (Text$, Row) LOCATE Row, 40 - LEN(Text$) \ 2: PRINT Text$ END SUB SUB Credits TyhjennaHurjanEfektinPuskuri ScreenOff WIDTH 80, 50 CLS ScreenOn Text$ = " KODE GFX IDEAZ: hiteck ... GREETSEJ LHTEE: pwp crew . taat . THP . stickieee . heck . ninza . vake . olkasalo . jaskab . rizto . pwp:n ihanat maskotit ." Text$ = Text$ + " ja kaikki GUAGE mestarit!!!! THE LOPPU! " COLOR 0, 7 FOR i = 1 TO 80 * 43 PRINT CHR$(RND * 120 + 127); NEXT COLOR 7, 0 Merkki = 0 DO TeeHurjaEfekti Scroll 47, 49, 1, -1 IF Merkki MOD 4 = 0 THEN PrintFont 75, 47, MID$(Text$, Merkki \ 4 + 21, 1), 10 END IF Merkki = Merkki + 1 WAIT &H3DA, 8 LOOP UNTIL Merkki \ 4 > LEN(Text$) OR INKEY$ <> "" KuulCLS2 50 END SUB DEFSNG A-Z FUNCTION Exist% (File$) '---------------------------------------------------------------------------- ' Checks if a file exists - Sami Kystil 1997 '---------------------------------------------------------------------------- ' ' File$ - File to check ' '---------------------------------------------------------------------------- ' Returns True if file exists, else False '---------------------------------------------------------------------------- IF File$ = "" THEN Exist = False: EXIT FUNCTION Checkfile = FREEFILE OPEN File$ FOR BINARY AS #Checkfile IF LOF(Checkfile) = 0 THEN Exist = False CLOSE #Checkfile KILL File$ ELSE Exist = True CLOSE #Checkfile END IF END FUNCTION FUNCTION FixFileName$ (File$, Extension$) '---------------------------------------------------------------------------- ' Fixes the filename extension '---------------------------------------------------------------------------- ' ' File$ - Filename ' Extension$ - Extension ' '---------------------------------------------------------------------------- ' ' If File$'s extension is different than Extension$, then it will be changed ' ' Example: ' ' File$ = "c:\temp\temp.abc" ' Extension$ = "exe" ' Returns: "c:\temp\temp.exe" ' '---------------------------------------------------------------------------- IF INSTR(File$, ".") > 0 AND INSTR(File$, ".") < LEN(File$) THEN IF RIGHT$(UCASE$(File$), LEN(Extension$)) <> UCASE$(Extension$) THEN File$ = LEFT$(File$, INSTR(File$, ".")) + Extension$ END IF ELSEIF INSTR(File$, ".") = LEN(File$) THEN File$ = File$ + Extension$ ELSE File$ = File$ + "." + Extension$ END IF FixFileName$ = File$ END FUNCTION DEFINT A-Z SUB Gauge (xPos, YPos, XLen, Value&, Max&, Char$) LOCATE YPos, xPos PRINT LEFT$(Char$, 1); PRINT STRING$(Value& / Max& * (XLen - 2), MID$(Char$, 3, 1)); PRINT STRING$((XLen - 2) - (Value& / Max& * (XLen - 2)), MID$(Char$, 2, 1)); PRINT MID$(Char$, 4, 1); END SUB SUB KuulCLS (Lines) COLOR 0, 0 FOR i& = 0 TO 10000 LOCATE (RND * (Lines - 1)) + 1, (RND * 79) + 1 PRINT " "; NEXT CLS END SUB SUB KuulCLS2 (Lines) FOR i = 1 TO Lines Scroll.Down 1, 1, 1, 80, Lines, 0 WAIT &H3DA, 8 WAIT &H3DA, 8, 8 NEXT END SUB SUB Kveik (Lines) FOR i = 0 TO 50 IF RND * 50 > 25 THEN IF RND * 50 > 25 THEN Scroll.Up 1, 1, 1, 80, Lines, 0 GOSUB Delay Scroll.Down 1, 1, 1, 80, Lines, 0 ELSE Scroll.Down 1, 1, 1, 80, Lines, 0 GOSUB Delay Scroll.Up 1, 1, 1, 80, Lines, 0 END IF ELSE IF RND * 50 > 25 THEN Scroll 1, Lines, 1, 0 GOSUB Delay Scroll 1, Lines, 1, -1 ELSE Scroll 1, Lines, 1, -1 GOSUB Delay Scroll 1, Lines, 1, 0 END IF END IF NEXT EXIT SUB Delay: FOR j = 0 TO 2 WAIT &H3DA, 8 WAIT &H3DA, 8, 8 NEXT RETURN END SUB SUB LoadFont RESTORE Font.Data FOR i = 1 TO 40 FOR j = 0 TO 2 READ Font(i, j) NEXT NEXT END SUB SUB LoadPic (File$) OPEN DataFile$ FOR BINARY AS #1 Offset& = PackOffset(DataFile$, File$, Length!) IF Offset& = -1 THEN WIDTH 80, 25 COLOR 7, 0 PRINT "MAAILMANLOPPU TULEE!!!!! TIEDOSTOA EI VOIDA AUKAISTA!!!!!!!!" SYSTEM END IF SEEK #1, Offset& + 7 t$ = SPACE$(Length!) GET #1, , t$ CLOSE #1 DEF SEG = Ruutu& FOR i& = 1 TO LEN(t$) POKE i& - 1, ASC(MID$(t$, i&, 1)) NEXT DEF SEG END SUB SUB Nuke.Ruutu ScreenOff WIDTH 80, 25 CLS LoadPic "nuke.bsv" ScreenOn Text$ = " [Newk'o'Matic]|| Initialized...|| Click here to|| NUUK the LLaMER!!" LOCATE 8, 26 Merkki = 1 COLOR 12 DO IF POS(1) < 26 THEN LOCATE , 26 IF MID$(Text$, Merkki, 1) = "|" THEN PRINT ELSE PRINT MID$(Text$, Merkki, 1); END IF Start! = TIMER: DO: LOOP UNTIL TIMER > Start! + .1 Merkki = Merkki + 1 LOOP UNTIL Merkki > LEN(Text$) Start! = TIMER: DO: LOOP UNTIL TIMER > Start! + .5 PrintFont 28, 22, "KLICK!", 14 Start! = TIMER: DO: LOOP UNTIL TIMER > Start! + .8 Kveik 25 KuulCLS 25 END SUB SUB Nuke.WinNuke ScreenOff WIDTH 80, 25 CLS LoadPic "winnuke.bsv" ScreenOn FOR i = 0 TO 15 PALETTE 0, 0 Start! = TIMER: DO: LOOP UNTIL TIMER > Start! + .05 PALETTE 0, 9 Start! = TIMER: DO: LOOP UNTIL TIMER > Start! + .05 NEXT PALETTE 0, 0 CLS END SUB SUB Ops.Ruutu DIM Merkki AS SINGLE ScreenOff WIDTH 80, 50 CLS LoadPic "monttu2.bsv" DIM Text$(0 TO 5) COLOR 12, 0 LOCATE 11, 8: PRINT "Code Red: Lameness overflow" LOCATE 12, 8: PRINT "detected in #freenet" LOCATE 13, 8: PRINT "(421 users, 412 lamers)" LOCATE 15, 8: PRINT "Please take preventive action or" LOCATE 16, 8: PRINT "prepare for global destruction." COLOR 10 LOCATE 18, 8: PRINT "Have a nice day!" COLOR 30, 0 LOCATE 11, 7: PRINT "" LOCATE 12, 7: PRINT "" LOCATE 13, 7: PRINT "" LOCATE 14, 7: PRINT "" LOCATE 15, 7: PRINT "" LOCATE 16, 7: PRINT "" LOCATE 11, 40: PRINT "" LOCATE 12, 40: PRINT "" LOCATE 13, 40: PRINT "" LOCATE 14, 40: PRINT "" LOCATE 15, 40: PRINT "" LOCATE 16, 40: PRINT "" Rivi = 0 Merkki = 1 Start& = TIMER ScreenOn DO IF RND * 100 > 95 THEN RESTORE Quotes.Pelu FOR i = 0 TO RND * 17 READ Pelu$ NEXT Ops.Ruutu.PrintText Pelu$ END IF TeeHurjaEfekti WAIT &H3DA, 8 WAIT &H3DA, 8, 8 LOOP UNTIL INKEY$ <> "" OR TIMER > Start& + 10 COLOR 0, 0 LOCATE 11, 7: PRINT "" LOCATE 12, 7: PRINT "" LOCATE 13, 7: PRINT "" LOCATE 14, 7: PRINT "" LOCATE 15, 7: PRINT "" LOCATE 16, 7: PRINT "" LOCATE 11, 40: PRINT "" LOCATE 12, 40: PRINT "" LOCATE 13, 40: PRINT "" LOCATE 14, 40: PRINT "" LOCATE 15, 40: PRINT "" LOCATE 16, 40: PRINT "" Text$ = " hmmmmmm...........tilanne vaikuttaa erittin uhkaavalta.......tm jtt meille vain yhden vaihtoehdon....." Merkki = 0 DO IF RND * 100 > 95 THEN RESTORE Quotes.Pelu FOR i = 0 TO RND * 17 READ Pelu$ NEXT Ops.Ruutu.PrintText Pelu$ END IF TeeHurjaEfekti Scroll 47, 50, 1, -1 IF Merkki MOD 4 = 0 THEN PrintFont 75, 48, MID$(Text$, Merkki \ 4 + 21, 1), 14 END IF Merkki = Merkki + 1 WAIT &H3DA, 8 WAIT &H3DA, 8, 8 LOOP UNTIL Merkki \ 4 > LEN(Text$) OR INKEY$ <> "" KuulCLS2 50 END SUB SUB Ops.Ruutu.PrintText (Text$) Scroll.Up 1, 45, 6, 76, 20, 0 LOCATE 20, 45 COLOR 4, 0 PRINT LEFT$(Text$, 32) FOR i& = 44 TO 75 IF ScreenB%(i&) = 5 THEN ScreenB%(i&) = 0 IF ScreenB%(i&) > 5 AND ScreenB%(i&) < 20 THEN ScreenB%(i&) = ScreenB%(i&) - 1 NEXT END SUB SUB Ops.Ukko ScreenOff WIDTH 80, 25 CLS LoadPic "pollari.bsv" ScreenOn Text$ = " me olemme internetin keskusteluverkon eliteist eliteimmt. jokainen laama vapisee kuullessaan handlemme. me olemme irkkipoliiseja. " Text$ = Text$ + "henkilkohtaisesti pidn tystni koska siihen sisltyy paljon tarpeetonta vkivaltaa. " Merkki = 0 DO Scroll 23, 25, 1, -1 IF Merkki MOD 4 = 0 THEN PrintFont 75, 23, MID$(Text$, Merkki \ 4 + 21, 1), 3 END IF Merkki = Merkki + 1 WAIT &H3DA, 8 WAIT &H3DA, 8, 8 LOOP UNTIL Merkki \ 4 > LEN(Text$) OR INKEY$ <> "" KuulCLS2 50 END SUB SUB Ops.Ukko.Loppu ScreenOff WIDTH 80, 25 CLS LoadPic "pollari.bsv" ScreenOn Text$ = " me saamme aina lamerimme!" Merkki = 0 DO Scroll 23, 25, 1, -1 IF Merkki MOD 4 = 0 THEN PrintFont 75, 23, MID$(Text$, Merkki \ 4 + 21, 1), 3 END IF Merkki = Merkki + 1 WAIT &H3DA, 8 WAIT &H3DA, 8, 8 LOOP UNTIL Merkki \ 4 > LEN(Text$) KuulCLS2 50 END SUB SUB OvelaTeksti (Text$) Words = 1 FOR i = 1 TO LEN(Text$) IF MID$(Text$, i, 1) = " " THEN Words = Words + 1 NEXT DIM Word$(1 TO Words) Num = 1 Temp$ = "" FOR i = 1 TO LEN(Text$) IF MID$(Text$, i, 1) = " " OR i = LEN(Text$) THEN IF i = LEN(Text$) THEN Temp$ = Temp$ + MID$(Text$, i, 1) Word$(Num) = Temp$ i = i + 1 Num = Num + 1 Temp$ = "" END IF Temp$ = Temp$ + MID$(Text$, i, 1) NEXT WIDTH 80, 50 'ValmistelePlasmanVari 0 Plasma 44 LOCATE 45, 1: PRINT SPACE$(80); LOCATE 46, 1: PRINT SPACE$(80); LOCATE 47, 1: PRINT SPACE$(80); LOCATE 48, 1: PRINT SPACE$(80); LOCATE 49, 1: PRINT SPACE$(80); FOR i = 1 TO Words FOR j = 0 TO 7 Plasma False PrintFont 40 - (LEN(Word$(i)) * 4 \ 2), 47, Word$(i), ColTable(j) WAIT &H3DA, 8 NEXT FOR j = 0 TO 3 Plasma False WAIT &H3DA, 8 WAIT &H3DA, 8, 8 NEXT FOR j = 7 TO 15 Plasma False PrintFont 40 - (LEN(Word$(i)) * 4 \ 2), 47, Word$(i), ColTable(j) WAIT &H3DA, 8 NEXT IF INKEY$ <> "" THEN EXIT FOR NEXT KuulCLS 50 END SUB SUB OvelaTeksti2 (Text$) Words = 1 FOR i = 1 TO LEN(Text$) IF MID$(Text$, i, 1) = " " THEN Words = Words + 1 NEXT DIM Word$(1 TO Words) Num = 1 Temp$ = "" FOR i = 1 TO LEN(Text$) IF MID$(Text$, i, 1) = " " OR i = LEN(Text$) THEN IF i = LEN(Text$) THEN Temp$ = Temp$ + MID$(Text$, i, 1) Word$(Num) = Temp$ i = i + 1 Num = Num + 1 Temp$ = "" END IF Temp$ = Temp$ + MID$(Text$, i, 1) NEXT WIDTH 80, 25 ValmistelePlasmanVari 1 COLOR 0, 0 FOR i = 1 TO 25 LOCATE i, 1: PRINT STRING$(80, ""); NEXT FOR i = 1 TO Words FOR j = 0 TO 7 TeeHurjaEfekti2 PrintFont 40 - (LEN(Word$(i)) * 4 \ 2), 22, Word$(i), ColTable(j) WAIT &H3DA, 8 NEXT FOR j = 0 TO 3 TeeHurjaEfekti2 WAIT &H3DA, 8 WAIT &H3DA, 8, 8 NEXT FOR j = 7 TO 15 TeeHurjaEfekti2 PrintFont 40 - (LEN(Word$(i)) * 4 \ 2), 22, Word$(i), ColTable(j) WAIT &H3DA, 8 NEXT NEXT TyhjennaHurjanEfektinPuskuri CLS END SUB DEFSNG A-Z FUNCTION Pack (Archive$, Filename$, NoPrint) '---------------------------------------------------------------------------- ' Packs files into an archive, binary or plain text - Sami Kystil 1997 '---------------------------------------------------------------------------- ' ' Archive$ - Filename of the archive, if the archive exists, then it will ' be appended. (Max number of files in an archive is 999) ' Filename$ - File to be added to archive. May include a path, but it will ' be stored without the path. (Max file size 999,999,999,999 ' bytes, should be enough :) ' NoPrint - If 1, then no text will be printed ' '---------------------------------------------------------------------------- ' Returned error codes '---------------------------------------------------------------------------- ' ' 1 = Input file not found ' 2 = Input file is already in archive ' '---------------------------------------------------------------------------- ' Archive structure '---------------------------------------------------------------------------- ' ' Header: ' ' Version (5 bytes) - "Pak10" ' Number of files in archive (3 bytes) - "001" ' ' Data: ' ' Filename (12 bytes) - "MYFILE.EXE " ' File size (12 bytes) - "000000001234" ' ... ' Data area (length indicated above) ' ... ' ' Next file data (header not repeated) ' '---------------------------------------------------------------------------- DIM Buffer AS STRING * 1000 BufferSize = LEN(Buffer) DIM byte AS STRING * 1 DIM Pak AS PakHeader IF NoPrint = 0 THEN CLS COLOR 8 PRINT STRING$(80, CHR$(196)) COLOR 7 PRINT " Pack/UnPack Freeware by "; COLOR 15 PRINT "Sami Kystil "; COLOR 7 PRINT "- 1997" PRINT " Version signature: "; COLOR 14 PRINT CurrentVersion COLOR 4 PRINT " Use this program as you wish, but give me some credit." COLOR 8 PRINT STRING$(80, CHR$(196)) COLOR 7 PRINT END IF IF Exist(Filename$) = False THEN Pack = 1: EXIT FUNCTION IF Exist(Archive$) = False THEN new = 1 f1 = FREEFILE OPEN Archive$ FOR BINARY AS #f1 PUT #f1, 1, CurrentVersion Dummy$ = "000" PUT #f1, , Dummy$ CLOSE #f1 new = 1 ELSE new = 0 END IF f1 = FREEFILE OPEN Archive$ FOR BINARY AS #f1 f2 = FREEFILE OPEN Filename$ FOR BINARY AS #f2 Row = CSRLIN + 1 FOR i = LEN(Filename$) TO 1 STEP -1 IF MID$(Filename$, i, 1) = "\" THEN Filename$ = MID$(Filename$, i + 1, 255) NEXT Filename$ = UCASE$(Filename$) IF NoPrint = 0 THEN IF new = 0 THEN PRINT " "; CHR$(254); " Appending to archive "; Archive$; " at position"; : COLOR 14: PRINT ; LOF(f1): COLOR 7 IF new = 1 THEN PRINT " "; CHR$(254); " Creating archive "; Archive$: COLOR 7 END IF IF PackOffset(Archive$, Filename$, -1) <> -1 THEN IF NoPrint = 0 THEN PRINT " "; CHR$(254); " "; Filename$; " is already in archive "; Archive$ Pack = 2 CLOSE #f1 CLOSE #f2 EXIT FUNCTION END IF GET #f1, 1, Pak TotalFiles = VAL(Pak.Total) TotalFiles = TotalFiles + 1 Total$ = STRING$(3 - LEN(LTRIM$(RTRIM$(STR$(TotalFiles)))), "0") + LTRIM$(RTRIM$(STR$(TotalFiles))) IF NoPrint = 0 THEN PRINT " Adding "; Filename$; "..."; PUT #f1, 6, Total$ Length$ = STRING$(12 - LEN(LTRIM$(RTRIM$(STR$(LOF(f2))))), "0") + LTRIM$(RTRIM$(STR$(LOF(f2)))) File2$ = Filename$ + STRING$(12 - LEN(Filename$), " ") CLOSE f1 OPEN Archive$ FOR BINARY AS #f1 SEEK #f1, LOF(f1) PUT #f1, SEEK(f1) + 1, File2$ PUT #f1, , Length$ PPos = POS(0) COLOR 14 FOR i! = 1 TO LOF(f2) STEP BufferSize GET #f2, , Buffer Clip! = LOF(f2) + 1 - i! IF Clip! <= BufferSize THEN Buffer2$ = LEFT$(Buffer, LOF(f2) + 1 - i!) PUT #f1, , Buffer2$ ELSE PUT #f1, , Buffer END IF IF NoPrint = 0 THEN IF i! \ BufferSize MOD 50 = 0 THEN LOCATE Row, PPos: PRINT LTRIM$(RTRIM$(STR$(INT((i! / LOF(f2)) * 100)))); "%" END IF NEXT IF NoPrint = 0 THEN LOCATE Row, PPos: COLOR 14: PRINT LTRIM$(STR$(LOF(f2))); : COLOR 7: PRINT " bytes" CLOSE #f1 CLOSE #f2 END FUNCTION FUNCTION PackList (Archive$) '---------------------------------------------------------------------------- ' List contents of an archive - Sami Kystil 1997 '---------------------------------------------------------------------------- ' ' Archive$ - The archive to be scanned ' '---------------------------------------------------------------------------- ' Returned error codes '---------------------------------------------------------------------------- ' ' 1 - Archive not found ' '---------------------------------------------------------------------------- DIM Pak AS PakHeader CLS COLOR 8 PRINT STRING$(80, CHR$(196)) COLOR 7 PRINT " Pack/UnPack Freeware by "; COLOR 15 PRINT "Sami Kystil "; COLOR 7 PRINT "- 1997" PRINT " Version signature: "; COLOR 14 PRINT CurrentVersion COLOR 4 PRINT " Use this program as you wish, but give me some credit." COLOR 8 PRINT STRING$(80, CHR$(196)) COLOR 7 PRINT IF Exist(Archive$) = False THEN PackList = 1: EXIT FUNCTION f1 = FREEFILE OPEN Archive$ FOR BINARY AS #f1 DIM byte AS STRING * 1 GET #f1, 1, Pak DIM File AS STRING * 12 DIM FileLen AS STRING * 12 Offset! = 9 CFile = 1 IF NoPrint = 0 THEN PRINT " - Archive version signature: ", COLOR 14 PRINT Pak.Version COLOR 7 PRINT " - Total files in archive: ", , COLOR 14 PRINT VAL(Pak.Total) COLOR 7 PRINT " - Archive size:", COLOR 14 PRINT USING " ###,###,###,###,###"; LOF(f1); PRINT " bytes" COLOR 7 PRINT " "; CHR$(254); " Contents of archive "; Archive$ END IF COLOR 9 PRINT " File Length Start End" COLOR 7 DO GET #f1, , File GET #f1, , FileLen Offset! = Offset! + 24 PRINT " "; File; CHR$(179); VAL(FileLen), ; CHR$(179); SEEK(f1), ; CHR$(179); SEEK(f1) + VAL(FileLen) CFile = CFile + 1 Offset! = Offset! + VAL(FileLen) SEEK #f1, Offset! IF CFile > VAL(Pak.Total) THEN EXIT DO LOOP CLOSE #f1 END FUNCTION FUNCTION PackOffset! (Archive$, Filename$, Length!) '---------------------------------------------------------------------------- ' Returns the offset of a file in an archive created by Pack - Sami Kystil ' Use this to find out where a file starts in an archive, so you can read it ' without extracting it first. '---------------------------------------------------------------------------- ' ' Archive$ - Filename of the archive ' Filename$ - Filename to search for ' Length - Returns the length of the file ' '---------------------------------------------------------------------------- ' Returned error codes '---------------------------------------------------------------------------- ' ' If returns -1, then the file has not been found in the archive ' '---------------------------------------------------------------------------- Filename$ = UCASE$(LTRIM$(RTRIM$(Filename$))) IF Exist(Archive$) = False THEN EXIT FUNCTION DIM Pak AS PakHeader f1 = FREEFILE OPEN Archive$ FOR BINARY AS #f1 DIM byte AS STRING * 1 DIM File AS STRING * 12 DIM FileLen AS STRING * 12 GET #f1, , Pak Offset! = 9 CFile = 1 DO GET #f1, , File GET #f1, , FileLen Offset! = Offset! + 24 IF Filename$ = RTRIM$(File) THEN EXIT DO CFile = CFile + 1 Offset! = Offset! + VAL(FileLen) SEEK #f1, Offset! IF CFile > VAL(Pak.Total) THEN Offset! = -1: EXIT DO LOOP CLOSE #f1 PackOffset! = Offset! Length! = VAL(FileLen) END FUNCTION SUB Pelu.Ruutu WIDTH 80, 50 ScreenOff CLS LoadPic "monttu.bsv" OnChannel = True Pelu$ = "" Text$ = " tss nemme satelliitill kaapatun kuvan pelun ATK nyttimest..." Text$ = Text$ + SPACE$(256) Text$ = Text$ + "tllainen lameus laukaisee varmasti irkkipoliisi setien multi media lameushlyttimen .... katsotaanpa .... " Merkki = 0 ScreenOn DO IF RND * 20 > 18 AND OnChannel THEN RESTORE Quotes.Freenet FOR i = 0 TO RND * 46 READ Quote$ NEXT Pelu.Ruutu.PrintText Quote$ END IF IF Pelu$ = "" AND RND * 80 > 60 THEN RESTORE Quotes.Pelu FOR i = 0 TO RND * 17 READ Pelu$ NEXT Pelu$ = LEFT$(Pelu$, 36) Temp$ = "" ELSE IF RND * 80 >= 70 THEN Temp$ = Temp$ + MID$(Pelu$, LEN(Temp$) + 1, 1) COLOR 15, 7 LOCATE 25, 8, 0 PRINT Temp$ IF LEN(Temp$) >= LEN(Pelu$) THEN Pelu$ = "" IF LEFT$(Temp$, 1) <> "/" THEN FOR i = 1 TO (RND * 2) + 1 Pelu.Ruutu.PrintText "> " + Temp$ NEXT ELSE Pelu$ = "MOI M TULIN TAKAS!!!!!!!!!!1" Temp$ = "" END IF OnChannel = True LOCATE 25, 8 PRINT SPACE$(36) END IF END IF END IF IF TIMER MOD 30 = 0 AND OnChannel = True THEN SOUND 1000, 1 COLOR 7, 7 LOCATE 25, 8 PRINT SPACE$(36) Pelu.Ruutu.PrintText "*** You have been kicked off channel #freenet" OnChannel = False Pelu$ = "/join #freenet" Temp$ = "" END IF Pelu.Ruutu.DownLoad WAIT &H3DA, 8 COLOR 7, 0 Scroll 47, 50, 1, -1 IF Merkki MOD 4 = 0 THEN PrintFont 75, 48, MID$(Text$, Merkki \ 4 + 21, 1), 11 END IF Merkki = Merkki + 1 'IF (Merkki \ 4 + 21) > LEN(Text$) THEN Merkki = LEN(Text$) * 4 + 21 LOOP UNTIL Merkki \ 4 + 21 > LEN(Text$) OR INKEY$ <> "" KuulCLS 50 END SUB DEFINT A-Z SUB Pelu.Ruutu.DownLoad STATIC Size&, Max& COLOR 0, 7 IF Size& >= Max& THEN Max& = (RND * 998) + 1 Size& = 0 RESTORE Filenames FOR i = 0 TO RND * 17 READ Filename$ NEXT LOCATE 5, 57 PRINT SPACE$(13) LOCATE 5, 57 PRINT Filename$ END IF LOCATE 6, 68 PRINT Size&; "k " Size& = Size& + 10 IF Size& > Max& THEN EXIT SUB COLOR 1, 7 Gauge 56, 6, 12, Size&, Max&, " " END SUB SUB Pelu.Ruutu.Nuke WIDTH 80, 50 ScreenOff CLS LoadPic "monttu.bsv" OnChannel = True Pelu$ = "" Start& = TIMER ScreenOn DO IF RND * 20 > 18 AND OnChannel THEN RESTORE Quotes.Freenet FOR i = 0 TO RND * 46 READ Quote$ NEXT Pelu.Ruutu.PrintText Quote$ END IF IF Pelu$ = "" AND RND * 80 > 60 THEN RESTORE Quotes.Pelu FOR i = 0 TO RND * 17 READ Pelu$ NEXT Pelu$ = LEFT$(Pelu$, 36) Temp$ = "" ELSE IF RND * 80 >= 70 THEN Temp$ = Temp$ + MID$(Pelu$, LEN(Temp$) + 1, 1) COLOR 15, 7 LOCATE 25, 8, 0 PRINT Temp$ IF LEN(Temp$) >= LEN(Pelu$) THEN Pelu$ = "" IF LEFT$(Temp$, 1) <> "/" THEN FOR i = 1 TO (RND * 2) + 1 Pelu.Ruutu.PrintText "> " + Temp$ NEXT ELSE Pelu$ = "MOI M TULIN TAKAS!!!!!!!!!!1" Temp$ = "" END IF OnChannel = True LOCATE 25, 8 PRINT SPACE$(36) END IF END IF END IF IF TIMER MOD 30 = 0 AND OnChannel = True THEN SOUND 1000, 1 COLOR 7, 7 LOCATE 25, 8 PRINT SPACE$(36) Pelu.Ruutu.PrintText "*** You have been kicked off channel #freenet" OnChannel = False Pelu$ = "/join #freenet" Temp$ = "" END IF Pelu.Ruutu.DownLoad WAIT &H3DA, 8 LOOP UNTIL TIMER > Start& + 5 OR INKEY$ <> "" Text$ = " ISIIII!!! MIT TAPAHTUU??? " Merkki = 0 WIDTH 80, 25 LoadPic "pox.bsv" Start! = TIMER: DO: LOOP UNTIL TIMER > Start! + .5 WIDTH 80, 50 Plasma 43 LoadPic "monttu.bsv" ValmistelePlasmanVari 1 COLOR 7, 0 DO Plasma False WAIT &H3DA, 8 Scroll 47, 50, 1, -1 IF Merkki MOD 4 = 0 THEN PrintFont 75, 48, MID$(Text$, Merkki \ 4 + 21, 1), 11 END IF Merkki = Merkki + 1 LOOP UNTIL Merkki \ 4 + 21 > LEN(Text$) LoadPic "monttu.bsv" FOR i = 0 TO 43 Scroll.Down 1, 2, 2, 79, 43, 16 + 7 WAIT &H3DA, 8 NEXT COLOR 1, 7 Center " Windows on havainnut muistipoikkeuksen 0E osoitteessa 0x3215:3215 ", 10 PRINT PRINT PRINT COLOR 7, 1 LOCATE , 10: PRINT "Tavut osoitteessa CS:IP:" PRINT PRINT LOCATE , 10: PRINT "29 24 74 34 32 2A 52 AF 22 42 78 65 AB AC DA D2 52" LOCATE , 10: PRINT "42 44 74 34 32 29 54 AF 42 42 94 65 A4 AC 42 22 56" LOCATE , 10: PRINT "29 53 74 54 A2 2A 82 BF 32 72 98 64 AB 77 DA 12 25" LOCATE , 10: PRINT "25 02 24 62 3A AA 54 AF 43 92 79 65 A4 AC 6A 42 42" LOCATE , 10: PRINT "2A 95 44 99 32 2A 82 BF 32 42 78 75 7B AC 6A D2 24" LOCATE , 10: PRINT "A5 53 74 33 37 35 54 4F 22 02 48 35 4B AC 64 12 12" LOCATE , 10: PRINT "2A 22 24 24 A2 26 92 BF 42 42 78 65 74 AC DA D2 52" LOCATE , 10: PRINT "25 24 74 54 32 28 82 00 00 00 00 65 AB AC 66 66 66" PRINT PRINT PRINT LOCATE , 10: PRINT "Toimintaa voidaan ehk jatkaa normaalisti." PRINT PRINT LOCATE , 10: PRINT "Paina Enter palataksesi Windowsiin tai" PRINT LOCATE , 10: PRINT "ESC kynnistksesi tietokone uudelleen." Start& = TIMER DO: LOOP UNTIL TIMER > Start& + 5 KuulCLS 50 END SUB DEFSNG A-Z SUB Pelu.Ruutu.PrintText (Text$) LOCATE 23, 8 Scroll.Up 1, 8, 11, 43, 23, 7 * 16 COLOR 0, 7 PRINT LEFT$(Text$, 36) END SUB DEFINT A-Z SUB Plasma (Init) DEF SEG = Ruutu& STATIC WaveSide1, WaveSide2, WaveSide3, r1, r2, r3, Wave1, Wave2, Wave3, Lines IF Init > 0 THEN WaveSide1 = 1 WaveSide2 = 3 WaveSide3 = 2 r1 = 1 r2 = 10 r3 = 20 Lines = Init IF Init = 25 OR Init = 50 THEN WIDTH 80, Init LOCATE 1, 1 FOR i = 1 TO Init LOCATE i, 1: PRINT STRING$(80, ""); NEXT EXIT SUB END IF Wave1 = Wave1 + WaveSide1 IF Wave1 >= 80 THEN Wave1 = 0 r1 = (r1 + 1) AND 255 WaveSide1 = Rand(r1) END IF Wave2 = Wave2 + WaveSide2 IF Wave2 >= 80 THEN Wave2 = 0 r2 = (r2 + 2) AND 255 WaveSide2 = Rand(r2) END IF Wave3 = Wave3 + WaveSide3 IF Wave3 >= 80 THEN Wave3 = 0 r3 = (r3 + 2) AND 255 WaveSide3 = Rand(r3) END IF position = 1 FOR Y = 0 TO Lines e = Cosinus(Y + Wave1) FOR x = 0 TO 79 Col = Cosinus(x + Wave2) + e + Cosinus(x + Wave3) + Cosinus(x + Y) IF Col > 127 THEN Col = 127 POKE position, ColTable(Col MOD 16) position = position + 2 NEXT NEXT DEF SEG END SUB SUB PrintFont (x, Y, Text$, Col) LOCATE Y, x COLOR Col FOR i = 1 TO LEN(Text$) Char$ = UCASE$(MID$(Text$, i, 1)) Offset = -1 IF Char$ = "" THEN Char$ = "A" IF Char$ = "" THEN Char$ = "A" IF Char$ = "" THEN Char$ = "O" IF Char$ = "" THEN Char$ = "O" IF Char$ >= "A" AND Char$ <= "Z" THEN Offset = ASC(Char$) - 54 IF Char$ >= "0" AND Char$ <= "9" THEN Offset = ASC(Char$) - 47 IF Char$ = "." THEN Offset = 37 IF Char$ = ":" THEN Offset = 38 IF Char$ = "!" THEN Offset = 39 IF Char$ = "?" THEN Offset = 40 Row = CSRLIN Column = POS(1) IF Offset > -1 THEN FOR j = 0 TO 2 LOCATE Row + j, Column: PRINT Font(Offset, j); NEXT END IF IF Column + 5 > 77 THEN EXIT FOR LOCATE Row, Column + 4 NEXT END SUB SUB ScreenOff OUT &H3C4, 1 OUT &H3C5, (INP(&H3C5) OR &H20) END SUB SUB ScreenOn OUT &H3C4, 1 OUT &H3C5, 0 END SUB SUB Scroll (UpperRow, LowerRow, Columns, Direction) DEF SEG = 0 Address = PEEK(1040) AND 48 IF Address = 48 THEN DEF SEG = &HB000 'mono ELSE DEF SEG = &HB800 'color END IF FOR x = 1 TO Columns IF Direction = 0 THEN 'Right FOR Column = 79 TO 1 STEP -1 'move everything FOR Row = UpperRow TO LowerRow Offset = ((Row - 1) * 80 + (Column - 1)) * 2 NewColumn = Column + 1 NewOffset = ((Row - 1) * 80 + (NewColumn - 1)) * 2 Char = PEEK(Offset) Attr = PEEK(Offset + 1) POKE NewOffset, Char POKE NewOffset + 1, Attr POKE Offset, 32 NEXT NEXT END IF IF Direction = -1 THEN 'Left FOR Column = 2 TO 80 'move everything FOR Row = UpperRow TO LowerRow Offset = ((Row - 1) * 80 + (Column - 1)) * 2 NewColumn = Column - 1 NewOffset = ((Row - 1) * 80 + (NewColumn - 1)) * 2 Char = PEEK(Offset) Attr = PEEK(Offset + 1) POKE NewOffset, Char POKE NewOffset + 1, Attr POKE Offset, 32 NEXT NEXT END IF NEXT DEF SEG END SUB DEFSNG A-Z SUB Scroll.Down (Lines%, x1%, y1%, x2%, y2%, attrib%) asm$ = "" asm$ = asm$ + CHR$(&H55) 'push bp asm$ = asm$ + CHR$(&H89) + CHR$(&HE5) 'mov bp, sp asm$ = asm$ + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H10) 'mov bx, [bp+10] asm$ = asm$ + CHR$(&H8B) + CHR$(&H7) 'mov ax, [bx] asm$ = asm$ + CHR$(&HB4) + CHR$(&H7) 'mvo ah, 07 asm$ = asm$ + CHR$(&H50) 'push ax asm$ = asm$ + CHR$(&H8B) + CHR$(&H5E) + CHR$(&HE) 'mov bx, [bp+0e] asm$ = asm$ + CHR$(&H8B) + CHR$(&H7) 'mov ax, [bx] asm$ = asm$ + CHR$(&HB1) + CHR$(&H8) 'mov cl, 08 asm$ = asm$ + CHR$(&HD3) + CHR$(&HE0) 'shl ax, cl asm$ = asm$ + CHR$(&H50) 'push ax, asm$ = asm$ + CHR$(&H8B) + CHR$(&H5E) + CHR$(&HC) 'mov bx, [bp+0c] asm$ = asm$ + CHR$(&H8B) + CHR$(&HF) 'mov cx, [bx] asm$ = asm$ + CHR$(&H8B) + CHR$(&H5E) + CHR$(&HA) 'mov bx, [bp+0a] asm$ = asm$ + CHR$(&H8B) + CHR$(&H17) 'mov dx, [bx] asm$ = asm$ + CHR$(&H88) + CHR$(&HCC) 'mov ah, cl asm$ = asm$ + CHR$(&H8B) + CHR$(&H5E) + CHR$(&HA) 'mov bx, [bp+0a] asm$ = asm$ + CHR$(&H8B) + CHR$(&H17) 'mov dx, [bx] asm$ = asm$ + CHR$(&H88) + CHR$(&HCC) 'mov ah, cl asm$ = asm$ + CHR$(&H88) + CHR$(&HD0) 'mov al, dl asm$ = asm$ + CHR$(&H50) 'push ax asm$ = asm$ + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H8) 'mov bx, [bp+08] asm$ = asm$ + CHR$(&H8B) + CHR$(&HF) 'mov cx, [bx] asm$ = asm$ + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H6) 'mov bx, [bp+06] asm$ = asm$ + CHR$(&H8B) + CHR$(&H17) 'mov dx, [bx] asm$ = asm$ + CHR$(&H88) + CHR$(&HCC) 'mov ah, cl asm$ = asm$ + CHR$(&H88) + CHR$(&HD0) 'mov al, dl asm$ = asm$ + CHR$(&H50) 'push ax asm$ = asm$ + CHR$(&H5A) 'pop dx asm$ = asm$ + CHR$(&H59) 'pop cx asm$ = asm$ + CHR$(&H5B) 'pop bx asm$ = asm$ + CHR$(&H58) 'pop ax asm$ = asm$ + CHR$(&HCD) + CHR$(&H10) 'int 10 asm$ = asm$ + CHR$(&H5D) 'pop bp asm$ = asm$ + CHR$(&HCB) 'retf asmseg% = VARSEG(asm$) asmoff% = SADD(asm$) DEF SEG = asmseg% CALL Absolute(Lines%, attrib%, y1% - 1, x1% - 1, y2% - 1, x2% - 1, asmoff%) DEF SEG END SUB SUB Scroll.Up (Lines%, x1%, y1%, x2%, y2%, attrib%) asm$ = "" asm$ = asm$ + CHR$(&H55) 'push bp asm$ = asm$ + CHR$(&H89) + CHR$(&HE5) 'mov bp, sp asm$ = asm$ + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H10) 'mov bx, [bp+10] asm$ = asm$ + CHR$(&H8B) + CHR$(&H7) 'mov ax, [bx] asm$ = asm$ + CHR$(&HB4) + CHR$(&H6) 'mvo ah, 06 asm$ = asm$ + CHR$(&H50) 'push ax asm$ = asm$ + CHR$(&H8B) + CHR$(&H5E) + CHR$(&HE) 'mov bx, [bp+0e] asm$ = asm$ + CHR$(&H8B) + CHR$(&H7) 'mov ax, [bx] asm$ = asm$ + CHR$(&HB1) + CHR$(&H8) 'mov cl, 08 asm$ = asm$ + CHR$(&HD3) + CHR$(&HE0) 'shl ax, cl asm$ = asm$ + CHR$(&H50) 'push ax, asm$ = asm$ + CHR$(&H8B) + CHR$(&H5E) + CHR$(&HC) 'mov bx, [bp+0c] asm$ = asm$ + CHR$(&H8B) + CHR$(&HF) 'mov cx, [bx] asm$ = asm$ + CHR$(&H8B) + CHR$(&H5E) + CHR$(&HA) 'mov bx, [bp+0a] asm$ = asm$ + CHR$(&H8B) + CHR$(&H17) 'mov dx, [bx] asm$ = asm$ + CHR$(&H88) + CHR$(&HCC) 'mov ah, cl asm$ = asm$ + CHR$(&H8B) + CHR$(&H5E) + CHR$(&HA) 'mov bx, [bp+0a] asm$ = asm$ + CHR$(&H8B) + CHR$(&H17) 'mov dx, [bx] asm$ = asm$ + CHR$(&H88) + CHR$(&HCC) 'mov ah, cl asm$ = asm$ + CHR$(&H88) + CHR$(&HD0) 'mov al, dl asm$ = asm$ + CHR$(&H50) 'push ax asm$ = asm$ + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H8) 'mov bx, [bp+08] asm$ = asm$ + CHR$(&H8B) + CHR$(&HF) 'mov cx, [bx] asm$ = asm$ + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H6) 'mov bx, [bp+06] asm$ = asm$ + CHR$(&H8B) + CHR$(&H17) 'mov dx, [bx] asm$ = asm$ + CHR$(&H88) + CHR$(&HCC) 'mov ah, cl asm$ = asm$ + CHR$(&H88) + CHR$(&HD0) 'mov al, dl asm$ = asm$ + CHR$(&H50) 'push ax asm$ = asm$ + CHR$(&H5A) 'pop dx asm$ = asm$ + CHR$(&H59) 'pop cx asm$ = asm$ + CHR$(&H5B) 'pop bx asm$ = asm$ + CHR$(&H58) 'pop ax asm$ = asm$ + CHR$(&HCD) + CHR$(&H10) 'int 10 asm$ = asm$ + CHR$(&H5D) 'pop bp asm$ = asm$ + CHR$(&HCB) 'retf asmseg% = VARSEG(asm$) asmoff% = SADD(asm$) DEF SEG = asmseg% CALL Absolute(Lines%, attrib%, y1% - 1, x1% - 1, y2% - 1, x2% - 1, asmoff%) DEF SEG END SUB DEFINT A-Z SUB TeeHurjaEfekti s1tmp% = sine1%(0) s3tmp% = sine3%(0) FOR x% = 0 TO 359 sine1%(x%) = sine1%(x% + 1) sine3%(x%) = sine3%(x% + 1) NEXT x% sine1%(360) = s1tmp% sine3%(360) = s3tmp% s2tmp% = sine2%(360) s4tmp% = sine4%(360) FOR x% = 360 TO 1 STEP -1 sine2%(x%) = sine2%(x% - 1) sine4%(x%) = sine4%(x% - 1) NEXT x% sine2%(0) = s2tmp% sine4%(0) = s4tmp% DEF SEG = Ruutu& FOR x% = 2 TO 77 Y% = (sine3%(x%) + sine4%(x%)) + 18 IF ScreenB(x%) > 0 THEN POKE (ScreenB(x%) * 80 + x%) * 2 + 1, PEEK((ScreenB(x%) * 80 + x%) * 2 + 1) - 16 END IF ScreenB2%(x%) = PEEK((Y% * 80 + x%) * 2 + 1) POKE (Y% * 80 + x%) * 2 + 1, PEEK((Y% * 80 + x%) * 2 + 1) + 16 ScreenB%(x%) = Y% NEXT x% DEF SEG END SUB SUB TeeHurjaEfekti2 s1tmp% = sine1%(0) s3tmp% = sine3%(0) FOR x% = 0 TO 359 sine1%(x%) = sine1%(x% + 1) sine3%(x%) = sine3%(x% + 1) NEXT x% sine1%(360) = s1tmp% sine3%(360) = s3tmp% s2tmp% = sine2%(360) s4tmp% = sine4%(360) FOR x% = 360 TO 1 STEP -1 sine2%(x%) = sine2%(x% - 1) sine4%(x%) = sine4%(x% - 1) NEXT x% sine2%(0) = s2tmp% sine4%(0) = s4tmp% DEF SEG = Ruutu& FOR x% = 2 TO 77 Y% = ((sine1%(x%) + sine2%(x%) + sine3%(x%) + sine4%(x%)) / 2) + 8 IF ScreenB(x%) > 0 THEN POKE (ScreenB(x%) * 80 + x%) * 2 + 1, 0 END IF IF Y% > 0 THEN POKE (Y% * 80 + x%) * 2 + 1, ColTable(Y% \ 2) ScreenB%(x%) = Y% NEXT x% DEF SEG END SUB SUB TyhjennaHurjanEfektinPuskuri FOR i = 1 TO 80 ScreenB(i) = -1 ScreenB2(i) = -1 NEXT END SUB DEFSNG A-Z FUNCTION Unpack (Archive$, Filename$, NoPrint) '---------------------------------------------------------------------------- ' UnPacks files from an archive created by Pack - Sami Kystil 1997 '---------------------------------------------------------------------------- ' ' Archive$ - Filename of the archive ' Filename$ - File to extracted from the archive. If includes a "*", then ' all files are extracted ' NoPrint - If 1, then no text will be printed and if a file exists, the ' process will be aborted automatically. ' '---------------------------------------------------------------------------- ' Returned error codes '---------------------------------------------------------------------------- ' ' 1 = File exists and NoPrint-mode on ' 2 = User abort ' 3 = Archive not found ' '---------------------------------------------------------------------------- DIM Buffer AS STRING * 1000 BufferSize = LEN(Buffer) IF NoPrint = 0 THEN CLS COLOR 8 PRINT STRING$(80, CHR$(196)) COLOR 7 PRINT " Pack/UnPack Freeware by "; COLOR 15 PRINT "Sami Kystil "; COLOR 7 PRINT "- 1997" PRINT " Version signature: "; COLOR 14 PRINT CurrentVersion COLOR 4 PRINT " Use this program as you wish, but give me some credit." COLOR 8 PRINT STRING$(80, CHR$(196)) COLOR 7 PRINT END IF IF Exist(Archive$) = False THEN Unpack = 3: EXIT FUNCTION f1 = FREEFILE OPEN Archive$ FOR BINARY AS #f1 DIM byte AS STRING * 1 GlobalYes = 0 IF INSTR(Filename$, "*") > 0 THEN All = 1 ELSE All = 0 DIM Pak AS PakHeader GET #f1, 1, Pak DIM File AS STRING * 12 DIM FileLen AS STRING * 12 Offset! = 9 CFile = 1 IF NoPrint = 0 THEN PRINT " - Archive version signature: ", COLOR 14 PRINT Pak.Version COLOR 7 PRINT " - Total files in archive: ", , COLOR 14 PRINT VAL(Pak.Total) COLOR 7 PRINT " - Archive size:", COLOR 14 PRINT USING " ###,###,###,###,###"; LOF(f1); PRINT " bytes" COLOR 7 PRINT " "; CHR$(254); " Unpacking archive "; Archive$ END IF IF All = 1 THEN DO GET #f1, , File GET #f1, , FileLen Offset! = Offset! + 24 IF Exist(RTRIM$(File)) = True THEN IF NoPrint = 1 THEN CLOSE #f1: CLOSE #f2: Unpack = 1: EXIT FUNCTION COLOR 4 PRINT " Overwrite "; RTRIM$(File); "? [Yes/No/All/Quit] "; COLOR 12 IF GlobalYes = 1 THEN PRINT "Yes": GOTO ProcessFile Again: k$ = UCASE$(INPUT$(1)) IF k$ <> "Y" AND k$ <> "N" AND k$ <> "Q" AND k$ <> "A" THEN GOTO Again IF k$ = "Q" THEN PRINT "Quit": CLOSE #f1: CLOSE #f2: Unpack = 2: EXIT FUNCTION IF k$ = "A" THEN PRINT "Yes": GlobalYes = 1: KILL RTRIM$(File) IF k$ = "Y" THEN PRINT "Yes": KILL RTRIM$(File) IF k$ = "N" THEN PRINT "No": GOTO NextFile END IF ProcessFile: Row = CSRLIN f2 = FREEFILE OPEN RTRIM$(File) FOR BINARY AS #f2 IF NoPrint = 0 THEN LOCATE Row, 1 COLOR 7 PRINT " "; CHR$(250); " Extracting file "; RTRIM$(File); "..."; END IF PPos = POS(0) COLOR 14 FOR i! = 1 TO VAL(FileLen) STEP BufferSize GET #f1, , Buffer Clip! = VAL(FileLen) + 1 - i! IF Clip! <= BufferSize THEN Buffer2$ = LEFT$(Buffer, VAL(FileLen) + 1 - i!) PUT #f2, , Buffer2$ ELSE PUT #f2, , Buffer END IF IF NoPrint = 0 THEN IF i! \ BufferSize MOD 50 = 0 THEN LOCATE Row, PPos: PRINT LTRIM$(RTRIM$(STR$(INT((i! / VAL(FileLen)) * 100)))); "%" END IF NEXT CLOSE f2 IF NoPrint = 0 THEN COLOR 14 LOCATE Row, PPos PRINT VAL(FileLen); COLOR 7 PRINT "bytes" END IF NextFile: CFile = CFile + 1 Offset! = Offset! + VAL(FileLen) SEEK #f1, Offset! IF CFile > VAL(Pak.Total) THEN EXIT DO LOOP ELSE File = UCASE$(Filename$) IF Exist(RTRIM$(File)) = True THEN IF NoPrint = 1 THEN CLOSE #f1: Unpack = 1: EXIT FUNCTION COLOR 4 PRINT " Overwrite "; RTRIM$(File); "? [Yes/No/Quit] "; COLOR 12 Again2: k$ = UCASE$(INPUT$(1)) IF k$ <> "Y" AND k$ <> "N" AND k$ <> "Q" THEN GOTO Again2 IF k$ = "Q" THEN PRINT "Quit": CLOSE #f1: CLOSE #f2: Unpack = 2: EXIT FUNCTION IF k$ = "Y" THEN PRINT "Yes": KILL RTRIM$(File) IF k$ = "N" THEN PRINT "No": CLOSE #f1: CLOSE #f2: Unpack = 2: EXIT FUNCTION END IF Row = CSRLIN f2 = FREEFILE OPEN RTRIM$(File) FOR BINARY AS #f2 SEEK #f1, PackOffset(Archive$, Filename$, Length!) IF NoPrint = 0 THEN LOCATE Row, 1 COLOR 7 PRINT " "; CHR$(250); " Extracting file "; RTRIM$(File); "..."; END IF PPos = POS(0) COLOR 14 FOR i! = 1 TO Length! STEP BufferSize GET #f1, , Buffer Clip! = Length! + 1 - i! IF Clip! <= BufferSize THEN Buffer2$ = LEFT$(Buffer, Length! + 1 - i!) PUT #f2, , Buffer2$ ELSE PUT #f2, , Buffer END IF IF NoPrint = 0 THEN IF i! \ BufferSize MOD 50 = 0 THEN LOCATE Row, PPos: PRINT LTRIM$(RTRIM$(STR$(INT((i! / Length!) * 100)))); "%" END IF NEXT CLOSE f2 IF NoPrint = 0 THEN COLOR 14 LOCATE Row, PPos PRINT Length!; COLOR 7 PRINT "bytes" END IF END IF CLOSE #f1 END FUNCTION DEFINT A-Z SUB ValmisteleHurjaEfekti rtd! = 3.141592654# / 180 FOR Y% = 0 TO 360 sine1%(Y%) = -(4 * SIN((Y% * 16) * rtd!)) sine2%(Y%) = -(9 * SIN((Y% * 6) * rtd!)) sine3%(Y%) = (10 * SIN((Y% * 13) * rtd!)) sine4%(Y%) = (6 * SIN((Y% * 5) * rtd!)) NEXT Y% END SUB SUB ValmistelePlasma CONST PI = 3.14159265358# FOR c = 0 TO 160 Cosinus(c) = COS(c * 2 * PI / 80) * 16 + 16 NEXT FOR c = 0 TO 255 Rand(c) = INT(RND * 4) + 1 NEXT END SUB SUB ValmistelePlasmanVari (Col) IF Col = 0 THEN ColTable(0) = 0 ColTable(1) = 1 ColTable(2) = 9 ColTable(3) = 3 ColTable(4) = 11 ColTable(5) = 15 ColTable(6) = 15 ColTable(7) = 15 ColTable(8) = 15 ColTable(9) = 11 ColTable(10) = 3 ColTable(11) = 9 ColTable(12) = 1 ColTable(13) = 1 ColTable(14) = 0 ColTable(15) = 0 ELSEIF Col = 1 THEN ColTable(0) = 0 ColTable(1) = 2 ColTable(2) = 10 ColTable(3) = 10 ColTable(4) = 14 ColTable(5) = 14 ColTable(6) = 15 ColTable(7) = 15 ColTable(8) = 15 ColTable(9) = 14 ColTable(10) = 14 ColTable(11) = 10 ColTable(12) = 10 ColTable(13) = 2 ColTable(14) = 0 ColTable(15) = 0 ELSE ColTable(0) = 0 ColTable(1) = 4 ColTable(2) = 12 ColTable(3) = 12 ColTable(4) = 14 ColTable(5) = 14 ColTable(6) = 15 ColTable(7) = 15 ColTable(8) = 15 ColTable(9) = 14 ColTable(10) = 14 ColTable(11) = 12 ColTable(12) = 12 ColTable(13) = 4 ColTable(14) = 0 ColTable(15) = 0 END IF END SUB