Reorganized files. Modernized documentation.
[qbasicapps.git] / misc / passw.bas
diff --git a/misc/passw.bas b/misc/passw.bas
new file mode 100644 (file)
index 0000000..651e73a
--- /dev/null
@@ -0,0 +1,175 @@
+' Svjatoslav Agejenko svjatoslav@svjatoslav.eu year:2002\r
+' See or modify "passwd.dat" for password.\r
+' Is useful when compiled into EXE, and put into AUTOEXEC.BAT\r
+\r
+CHDIR ".\qbasicapps\unsorted"\r
+\r
+\r
+DECLARE SUB check (a$)\r
+DECLARE SUB start ()\r
+DECLARE SUB mkv (s%, C%)\r
+DECLARE SUB box (x1%, y1%, x2%, y2%)\r
+\r
+DIM SHARED cha\r
+DIM SHARED pwd$\r
+\r
+start\r
+\r
+x = 25\r
+x2 = 10\r
+x3 = 0\r
+B$ = ""\r
+1\r
+x = x + xs\r
+IF x > 0 THEN xs = xs - .5\r
+IF x < 0 THEN xs = xs + .5\r
+xs = xs - (xs / 8)\r
+IF x2 > 100 THEN x2 = 10\r
+LINE (x2, 10)-(x2, 60), 0\r
+PSET (x2, x + 35), 10\r
+IF x2 < 99 THEN LINE (x2 + 1, 10)-(x2 + 1, 60), 3\r
+x2 = x2 + 1\r
+x3 = x3 + 1\r
+IF x3 > 40 THEN x3 = 0: xs = xs - 5: SOUND 1000, 1\r
+\r
+SOUND 0, .5\r
+\r
+a$ = INKEY$\r
+IF a$ = CHR$(13) THEN\r
+check B$\r
+B$ = ""\r
+GOTO 2\r
+END IF\r
+IF a$ <> "" THEN\r
+IF a$ = CHR$(8) THEN\r
+IF LEN(B$) > 0 THEN B$ = LEFT$(B$, LEN(B$) - 1): GOTO 2\r
+GOTO 2\r
+END IF\r
+B$ = B$ + a$\r
+IF LEN(B$) > 10 THEN B$ = LEFT$(B$, 10)\r
+2\r
+FOR a = 1 TO 10\r
+IF a <= LEN(B$) THEN C = 5 ELSE C = 1\r
+CIRCLE (a * 15 + 20, 150), 6, C\r
+PAINT (a * 15 + 20, 150), C\r
+NEXT a\r
+END IF\r
+GOTO 1\r
+\r
+DEFINT A-Z\r
+SUB box (x1, y1, x2, y2)\r
+LINE (x1 + 1, y1 + 1)-(x2 - 1, y2 - 1), 0, BF\r
+LINE (x1, y1)-(x2, y2), 10, B\r
+LINE (x1, y1)-(x2, y1 - 9), 14, BF\r
+LINE (x1, y1)-(x2, y1 - 9), 10, B\r
+\r
+LINE (x2 - 2, y1 - 2)-(x2 - 7, y1 - 7), 7, BF\r
+LINE (x2 - 9, y1 - 2)-(x2 - 14, y1 - 7), 7, BF\r
+\r
+LINE (x2 - 2, y1 - 2)-(x2 - 7, y1 - 7), 0\r
+LINE (x2 - 2, y1 - 7)-(x2 - 7, y1 - 2), 0\r
+\r
+LINE (x2 - 10, y1 - 3)-(x2 - 13, y1 - 3), 0\r
+END SUB\r
+\r
+DEFSNG A-Z\r
+SUB check (a$)\r
+cha = cha - 1\r
+\r
+IF a$ = pwd$ THEN CLS : SCREEN 2: SYSTEM\r
+\r
+DIM buf(1 TO 3000)\r
+\r
+GET (79, 80)-(241, 141), buf(1)\r
+\r
+box 80, 90, 240, 140\r
+LOCATE 14, 14\r
+COLOR 12\r
+PRINT "Wrong passworD"\r
+COLOR 5\r
+\r
+LOCATE 16, 13\r
+PRINT STR$(cha) + " chanses left"\r
+\r
+FOR a = 1 TO 30\r
+SOUND 0, 1\r
+NEXT a\r
+\r
+IF cha = 0 THEN\r
+DIM buf2(1000)\r
+GET (79, 138)-(241, 140), buf2\r
+FOR a = 1 TO 40\r
+PUT (79, 138 + a), buf2, PSET\r
+SOUND 0, .5\r
+NEXT a\r
+\r
+LOCATE 19, 14\r
+COLOR 12\r
+PRINT "SYSTEM HALTED"\r
+LOCATE 21, 14\r
+PRINT "SUCESSFULLY!!"\r
+3\r
+GOTO 3\r
+END IF\r
+\r
+\r
+PUT (79, 80), buf(1), PSET\r
+\r
+\r
+END SUB\r
+\r
+DEFINT A-Z\r
+SUB mkv (s, C)\r
+FOR x = 160 TO 319 STEP s\r
+LINE (x, 0)-(x, 199), C\r
+LINE (320 - x, 0)-(320 - x, 199), C\r
+NEXT x\r
+\r
+FOR y = 100 TO 199 STEP s\r
+LINE (0, y)-(319, y), C\r
+LINE (0, 200 - y)-(319, 200 - y), C\r
+NEXT y\r
+\r
+END SUB\r
+\r
+DEFSNG A-Z\r
+SUB start\r
+\r
+OPEN "passw.dat" FOR INPUT AS #1\r
+LINE INPUT #1, pwd$\r
+CLOSE #1\r
+\r
+SCREEN 13\r
+\r
+cha = 3\r
+\r
+s = 2\r
+FOR C = 16 TO 31\r
+s = s * 1.4\r
+mkv INT(s), INT(C)\r
+NEXT C\r
+mkv INT(s), 0\r
+\r
+\r
+box 70, 20, 270, 90\r
+\r
+COLOR 5\r
+LOCATE 8, 10\r
+PRINT "           stack dump:"\r
+LOCATE 9, 10\r
+PRINT "010010010010010010010100"\r
+\r
+LOCATE 10, 10\r
+PRINT "Running rocket ground"\r
+LOCATE 11, 10\r
+PRINT "control system..."\r
+\r
+box 9, 9, 101, 61\r
+\r
+box 20, 130, 300, 190\r
+\r
+LOCATE 18, 5\r
+PRINT "ENTER PASSWORD:"\r
+\r
+END SUB\r
+\r