X-Git-Url: http://www2.svjatoslav.eu/gitweb/?p=qbasicapps.git;a=blobdiff_plain;f=misc%2Flightpe2.bas;fp=misc%2Flightpe2.bas;h=db871bf42e9e96870083e336dd654318a77016ed;hp=0000000000000000000000000000000000000000;hb=56bc2db75aaf0e1bd556677914988b3a02775ecd;hpb=7cc7a0518d1489b33de83466008cccba1725ce52

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