ZAPIS,ZAPIS3R 0.4 - record and read dots ,quite nice graphics

Zapis,from Bulgarian - record . The first one ZAPIS can record and write in a file dots using the mouse (so you've got to start it with quicklibrary on (run "qb.exe /l") . The second one ZAPIS3R is a program that makes quite nice 3D graphics in which you can move in all directions - works with the GRAVITY3D fine ,not bug free but good enough :) .Just correct the file paths to your own ,I get lazy too you know... Knock yourselfs out :

=============================================================
ZAPIS
=============================================================
DECLARE SUB GetMCoords (O5!, x1!, y1!, x2!, y2!)
DECLARE SUB Coords (O5!, x1!, y1!, x2!, y2!)
DECLARE SUB Scales (O5!, n!, m!) ' the scales ot the left and the bottom ,and the indicators for the position of the object on them
DECLARE SUB DelScales (O5!, n!, m!)'deleting the old indicator
DECLARE FUNCTION dottodot (x!, y!, x1!, y1!)
DECLARE SUB prenesi (x!, y!, x1!, y1!, x2!, y2!, x3!, y3!)'moves a line setting its new start
DECLARE SUB MouseRoutine (ax, bx, cx, dx)

OPEN "E:\QBasic\Dots.txt" FOR OUTPUT AS #6 'change the path to your own

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

TYPE Dot
x AS INTEGER
y AS INTEGER
END TYPE

DIM SHARED T AS Dot
DIM SHARED Regs AS RegType
DIM SHARED r AS INTEGER

SCREEN 12
COLOR 2

2 :
CLS
PRINT "PROGRAM FOR RECORDING DOTS (POSITIONS IN 2D)"

PRINT ""

PRINT "To exit hit Q"
PRINT "Press enter to start"
SLEEP

O5 = 20

CALL Scales(O5, 0, 0)

TIMER ON

CALL MouseRoutine(0, z, x, y)
CALL MouseRoutine(1, z, x, y)


FOR i = 1 TO 255

key$ = INKEY$
IF key$ = "q" THEN SYSTEM

h = TIMER + 2

CALL GetMCoords(O5, x1, y1, x2, y2)
IF z = 0 THEN EXIT FOR

WRITE #6, x2, y2

LINE (x1, y1)-(x2, y2), 0, BF
CIRCLE (x1, y1), r, 0

x1 = x2
y1 = y2

NEXT i

7 :

CLS

i = 0

CLOSE #6
OPEN "E:\QBasic\Dots.txt" FOR INPUT AS #6

WHILE (NOT EOF(6))

i = i + 1
INPUT #6, p, p1

WEND

PRINT "There are"; i; "points"
INPUT "Continue?(1=ne):", o
IF o = 1 THEN GOTO 5

CLOSE #6
OPEN "E:\QBasic\Dots.txt" FOR INPUT AS #6

FOR i = 1 TO i

INPUT #6, T.x, T.y
CIRCLE (T.x, T.y), 5

NEXT i

CALL MouseRoutine(2, p, p1, p2)

5 :

INPUT "To restart enter 1:", o

IF o = 1 THEN GOTO 2

SUB DelScales (O5, n, m)

LINE (n, 480)-(n, 480 - (O5 / 5 + 3)), 0, BF
LINE (0, m)-(O5 / 5 + 3, m), 0, BF

END SUB

FUNCTION dottodot (x, y, x1, y1)

xn! = x1 - x
yn! = y1 - y

dottodot = SQR(xn ^ 2 + yn ^ 2)

END FUNCTION

SUB GetMCoords (O5, x1, y1, x2, y2)

ON KEY(1) GOSUB 7

DO

CALL MouseRoutine(3, z, x2, y2)
IF TIMER > h THEN EXIT DO

LOOP UNTIL z = 0

h = TIMER + 10

DO

FOR u = 1 TO 60000 'for smooth scale circle

NEXT u

r1 = r
x21 = x2
y21 = y2

r = dottodot(x1, y1, x2, y2)
CALL MouseRoutine(3, z, x2, y2)

CIRCLE (x1, y1), r1, 0
CALL DelScales(O5, x21, y21)
LINE (x1, y1)-(x21, y21), 0, BF

CALL Scales(O5, x2, y2)
LINE (x1, y1)-(x2, y2)
CIRCLE (x1, y1), r

IF TIMER > h THEN EXIT DO
LOOP UNTIL z > 0

END SUB

SUB LINE1 (x, y, x1, y1, xm, ym)

LINE (x + xm, ABS(480 - (y + ym)))-(x1 + xm, ABS(480 - (y1 + ym)))

END SUB

SUB MouseRoutine (ax, bx, cx, dx)
Regs.ax = ax
CALL INTERRUPT(&H33, Regs, Regs)
LET ax = Regs.ax
LET bx = Regs.bx
LET cx = Regs.cx
LET dx = Regs.dx
END SUB

SUB prenesi (x, y, x1, y1, x2, y2, x3, y3)

x3 = x2 - (x1 - x)
y3 = y2 - (y1 - y)

END SUB

SUB Scales (O5, n, m)

xe = 640 / O5
ye = 480 / O5

O6 = 0

FOR xe = 1 TO xe

O6 = O6 + O5
LINE (O6, 480)-(O6, 480 - O5 / 5)

NEXT xe

O6 = 0

FOR ye = 1 TO ye

O6 = O6 + O5
LINE (0, O6)-(O5 / 5, O6)

NEXT ye

LINE (n, 480)-(n, 480 - (O5 / 5 + 3))
LINE (0, m)-(O5 / 5 + 3, m)

END SUB
========================================================================
ZAPIS3R
========================================================================
DECLARE SUB Coords (O5!, x1!, y1!, x2!, y2!)
DECLARE SUB Scales (O5!, n!, m!)
DECLARE SUB DelScales (O5!, n!, m!)
DECLARE FUNCTION dottodot (x!, y!, x1!, y1!)
DECLARE SUB prenesi (x!, y!, x1!, y1!, x2!, y2!, x3!, y3!)
DECLARE SUB MouseRoutine (ax, bx, cx, dx)

OPEN "E:\QBasic\Dots.txt" FOR OUTPUT AS #6

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

TYPE Dot
x AS SINGLE
y AS SINGLE
z AS SINGLE
END TYPE

DIM SHARED T AS Dot
DIM SHARED Regs AS RegType
DIM SHARED r AS INTEGER

SCREEN 12
COLOR 2
2 :

INPUT "Enter a file from E:\Qbasic", file$
file$ = "E:\Qbasic\" + file$
CLS

i = 0

CLOSE #6
OPEN file$ FOR INPUT AS #6

WHILE (NOT EOF(6))

i = i + 1
INPUT #6, p, p1, p2

WEND

PRINT "To move use:"
PRINT "u and j for right/left"
PRINT "i and k for up/down"
PRINT "o and l for forward/backward"

PRINT "There are"; i; "points"
PRINT "Press enter to continue"
sleep
IF o = 1 THEN GOTO 5

TIMER ON
h = TIMER
CONST pi = 3.1415
DO
g = g + 1
'IF TIMER > h + 20 THEN EXIT DO

CLOSE #6
OPEN file$ FOR INPUT AS #6
key$ = ""
key$ = INKEY$

IF key$ = "w" THEN a = a + 1
IF key$ = "s" THEN a = a - 1
IF key$ = "a" THEN c = c + 1
IF key$ = "d" THEN c = c - 1
IF key$ = "u" THEN rl = rl + 1
IF key$ = "j" THEN rl = rl - 1
IF key$ = "i" THEN fb = up + 1
IF key$ = "k" THEN fb = fb - 1
IF key$ = "o" THEN up = up + 1
IF key$ = "l" THEN up = up - 1
IF key$ = "q" THEN EXIT DO

6 :

a1 = a * 5

IF a1 <= -360 OR a1 >= 360 THEN
a = 0
GOTO 6
END IF
IF a1 < 0 THEN a1 = 360 + a1

c1 = c * 5

IF c1 <= -360 OR c1 >= 360 THEN
c = 0
GOTO 6
END IF
IF c1 < 0 THEN c1 = 360 + c1

o = 0
CLS
FOR i = 1 TO i - 1

INPUT #6, T.x, T.y, T.z

T.x = T.x + rl
T.y = T.y + up
T.z = T.z + fb

ab1 = SQR(T.z ^ 2 + ABS(320 - T.x) ^ 2)
ad1 = SQR(T.z ^ 2 + ABS(240 - T.y) ^ 2)

b1a = ABS(320 - T.x) / ab1 * COS(c1 * pi / 180)
d1a = ABS(240 - T.y) / ad1 * COS(a1 * pi / 180)

b1b = T.z * SIN(c1 * pi / 180) / SQR(T.z ^ 2 + ABS(320 - T.x) ^ 2)
d1b = T.z * SIN(a1 * pi / 180) / SQR(T.z ^ 2 + ABS(240 - T.y) ^ 2)

b1 = (b1a + b1b) * ab1
d1 = (d1a + d1b) * ad1
g1 = SQR(SQR(T.z ^ 2 + ABS(320 - T.x) ^ 2) ^ 2 - b1 ^ 2)

b = 240 + b1
d = 320 + d1

IF o < 1 THEN
x = b
y = d
END IF
o = o + 1

LINE (x, y)-(b, d)
CIRCLE (b, d), 8 * 56 / g1
x = b
y = d
NEXT i

LOOP
PRINT a, a1, b, b1, b1a, b1b, c, c1, d, d1, d1a, d1b, g, T.x, T.y, T.z


5 :

INPUT "Za restartirane vyvedi 1:", o

IF o = 1 THEN GOTO 2

SUB DelScales (O5, n, m)

LINE (n, 480)-(n, 480 - (O5 / 5 + 3)), 0, BF
LINE (0, m)-(O5 / 5 + 3, m), 0, BF

END SUB

FUNCTION dottodot (x, y, x1, y1)

xn! = x1 - x
yn! = y1 - y

dottodot = SQR(xn ^ 2 + yn ^ 2)

END FUNCTION

SUB LINE1 (x, y, x1, y1, xm, ym)

LINE (x + xm, ABS(480 - (y + ym)))-(x1 + xm, ABS(480 - (y1 + ym)))

END SUB

SUB prenesi (x, y, x1, y1, x2, y2, x3, y3)

x3 = x2 - (x1 - x)
y3 = y2 - (y1 - y)

END SUB

SUB Scales (O5, n, m)

xe = 640 / O5
ye = 480 / O5

O6 = 0

FOR xe = 1 TO xe

O6 = O6 + O5
LINE (O6, 480)-(O6, 480 - O5 / 5)

NEXT xe

O6 = 0

FOR ye = 1 TO ye

O6 = O6 + O5
LINE (0, O6)-(O5 / 5, O6)

NEXT ye

LINE (n, 480)-(n, 480 - (O5 / 5 + 3))
LINE (0, m)-(O5 / 5 + 3, m)

END SUB
=====================================================================