Reorganized files. Modernized documentation.

[qbasicapps.git] / misc / lightpe2.bas

diff --git a/misc/lightpe2.bas b/misc/lightpe2.bas
new file mode 100644 (file)
index 0000000..db871bf
--- /dev/null
+++ b/misc/lightpe2.bas
@@ -0,0 +1,97 @@
+' Svjatoslav Agejenko 2003.03\r
+' light pen test\r
+\r
+DECLARE SUB miniscan (x1%, y1%, xn%, yn%)\r
+DECLARE SUB getxy (x%, y%)\r
+DECLARE SUB scan (x%, y%)\r
+DECLARE SUB start ()\r
+DEFINT A-Z\r
+DIM SHARED prt, prt2\r
+DIM SHARED wai, wai2\r
+DIM SHARED mins, minl\r
+wai = 4000\r
+wai2 = 5000\r
+mins = 20\r
+minl = 8\r
+\r
+DIM SHARED px(1 TO 500)\r
+DIM SHARED py(1 TO 500)\r
+DIM SHARED mitup\r
+\r
+mitup = 1\r
+start\r
+\r
+x = 160\r
+y = 100\r
+px(1) = x\r
+py(1) = y\r
+\r
+1\r
+getxy x, y\r
+REM CIRCLE (x, y), 30, 14\r
+IF (px(mitup) <> x) OR py(mitup) <> y THEN mitup = mitup + 1\r
+px(mitup) = x\r
+py(mitup) = y\r
+\r
+FOR a = 1 TO mitup - 1\r
+LINE (px(a), py(a))-(px(a + 1), py(a + 1)), 15\r
+NEXT a\r
+GOTO 1\r
+\r
+SUB getxy (x, y)\r
+\r
+miniscan x + (mins / 4), y + (mins / 4), xn, yn\r
+IF xn <> -1 THEN x = xn\r
+IF yn <> -1 THEN y = yn\r
+\r
+LOCATE 1, 1\r
+PRINT SPACE$(40)\r
+LOCATE 1, 1\r
+PRINT x, y\r
+END SUB\r
+\r
+SUB miniscan (x1, y1, xn, yn)\r
+cd = INP(prt2)\r
+\r
+xn = -1\r
+yn = -1\r
+\r
+LINE (x1 - mins, y1 - mins)-(x1 + mins, y1 + mins), 0, BF\r
+\r
+FOR x = x1 - mins TO x1 + mins\r
+LINE (x, y1 - mins)-(x, y1 + mins), 15\r
+LINE (x - minl, y1 - mins)-(x - minl, y1 + mins), 0\r
+FOR a = 0 TO wai2\r
+NEXT a\r
+c = INP(prt2)\r
+IF c <> cd THEN xn = x: GOTO 4\r
+NEXT x\r
+4\r
+LINE (x1 - mins, y1 - mins)-(x1 + mins, y1 + mins), 0, BF\r
+\r
+FOR y = y1 - mins TO y1 + mins\r
+LINE (x1 - mins, y)-(x1 + mins, y), 15\r
+LINE (x1 - mins, y - minl)-(x1 + mins, y - minl), 0\r
+FOR a = 0 TO wai2\r
+NEXT a\r
+c = INP(prt2)\r
+IF c <> cd THEN yn = y: GOTO 5\r
+NEXT y\r
+5\r
+LINE (x1 - mins, y1 - mins)-(x1 + mins, y1 + mins), 0, BF\r
+IF xn < -1 THEN xn = -1\r
+IF yn < -1 THEN yn = -1\r
+\r
+END SUB\r
+\r
+SUB start\r
+CLS\r
+SCREEN 13\r
+\r
+prt = &H378\r
+prt2 = &H379\r
+\r
+OUT prt, 255\r
+\r
+END SUB\r
+\r