X-Git-Url: http://www2.svjatoslav.eu/gitweb/?p=qbasicapps.git;a=blobdiff_plain;f=graphics%2Fpresentations%2FKHK%20j%C3%B5ulud%2Fray.bas;fp=graphics%2Fpresentations%2FKHK%20j%C3%B5ulud%2Fray.bas;h=cf8a8b165b7815cbb3b3dfe7dc903381152ce5ec;hp=0000000000000000000000000000000000000000;hb=8d86b3981cd6ccb427dc8fd428a34313f5b55fe2;hpb=e7f38776527012dce956d07ae54b749c50671110

diff --git "a/graphics/presentations/KHK j\303\265ulud/ray.bas" "b/graphics/presentations/KHK j\303\265ulud/ray.bas"
new file mode 100755
index 0000000..cf8a8b1
--- /dev/null
+++ "b/graphics/presentations/KHK j\303\265ulud/ray.bas"	
@@ -0,0 +1,318 @@
+DECLARE SUB dispimg ()
+DECLARE SUB updateland ()
+DECLARE SUB makeland ()
+DECLARE FUNCTION getcol! (r!, g!, b!)
+DEFINT A-Y
+DECLARE SUB traceline (x%, y%, xl)
+DECLARE SUB dispframe ()
+DECLARE SUB tower (x%, y%)
+DECLARE SUB square (x1%, y1%, x2%, y2%, c%, h%)
+DECLARE SUB displand ()
+DECLARE SUB start ()
+DECLARE SUB setupal ()
+
+DIM SHARED landh(0 TO 180, 0 TO 180)
+DIM SHARED landc(0 TO 180, 0 TO 180)
+
+DIM SHARED zmyx, zmyy, zmyz
+DIM SHARED myx, myy, myz
+DIM SHARED zmyan, myan2
+DIM SHARED ste, stem, dist
+DIM SHARED tim$, frm, frmrate
+DIM SHARED pi
+DIM SHARED white
+
+sky = getcol(100, 100, 255)
+pi = 3.141592
+
+frmrate = 10    ' Desired framerate.
+                ' Lower framerate, better quality
+
+start
+makeland
+
+'displand
+'a$ = INPUT$(1)
+myan2 = 2
+OPEN "cat.i01" FOR INPUT AS #1
+INPUT #1, pictxw
+INPUT #1, pictyw
+INPUT #1, pictx
+INPUT #1, picty
+
+
+1
+x1 = RND * 160
+y1 = RND * 160
+x2 = x1 + RND * 10 + 1
+y2 = y1 + RND * 10 + 1
+
+IF (frm > 50) AND (frm < 250) THEN square x1, y1, x2, y2, RND * 200, RND * 10
+IF (frm > 250) AND (picty < 177) THEN
+ 
+  FOR ff = 1 TO 180 * 2
+    INPUT #1, c
+    landc(pictx, picty) = c
+    landh(pictx, picty) = 0
+    pictx = pictx + 1
+    IF pictx >= pictxw THEN pictx = 0: picty = picty + 1
+    IF picty >= pictyw THEN picty = 0
+  NEXT ff
+END IF
+
+IF frm = 430 THEN dispimg
+LOCATE 1, 30
+'PRINT frm
+
+updateland
+dispframe
+GOTO 1
+CLOSE #1
+
+SUB dispframe
+
+l = 0
+zst = -.0031 * ste
+FOR z = .5 TO -.5 STEP zst
+traceline SIN(zmyan + z) * dist + myx, COS(zmyan + z) * dist + myy, l
+l = l + ste
+NEXT z
+
+END SUB
+
+SUB dispimg
+
+CLOSE #1
+
+
+OPEN "cat.i01" FOR INPUT AS #1
+INPUT #1, pictxw
+INPUT #1, pictyw
+
+FOR y = 0 TO pictyw - 1
+FOR x = 0 TO pictxw - 1
+INPUT #1, c
+PSET (x + 50, 150 - y), c
+NEXT x
+NEXT y
+
+CLOSE #1
+
+
+FOR a = 1 TO 50
+  SOUND 0, 1
+NEXT a
+CHAIN "KHKDEMO2.BAS"
+
+END SUB
+
+SUB displand
+
+
+FOR z = 0 TO 180
+zs = 1
+IF z > 120 THEN zs = .7
+IF z > 160 THEN zs = .6
+FOR zx = 0 TO 180 STEP zs
+y1 = landh(zx, z) - 80
+zx1 = zx - 90
+z1 = 300 - z
+zx2 = zx1 / z1 * 190
+zy2 = y1 / z1 * 190
+
+LINE (zx2 + 160, 40 - zy2)-(zx2 + 160, 200), landc(zx, z)
+NEXT zx
+NEXT z
+
+LOCATE 1, 1
+PRINT "Press any key to continue..."
+
+END SUB
+
+DEFSNG A-Y
+FUNCTION getcol (r, g, b)
+IF r < 0 THEN r = 0
+IF g < 0 THEN g = 0
+IF b < 0 THEN b = 0
+IF r > 255 THEN r = 255
+IF g > 255 THEN g = 255
+IF b > 255 THEN b = 255
+getcol = INT(r / 43) * 36 + INT(g / 43) * 6 + INT(b / 43)
+END FUNCTION
+
+DEFINT A-Y
+SUB makeland
+
+square 0, 0, 180, 180, 15, 0
+
+FOR y = 0 TO 180
+FOR x = 0 TO 180
+x1 = (x \ 10) MOD 2
+y1 = (y \ 10) MOD 2
+c = (x1 + y1) MOD 2
+IF c = 0 THEN
+  landc(x, y) = getcol(250, 250, 250)
+ELSE
+  landc(x, y) = getcol(250, 50, 50)
+END IF
+NEXT x
+NEXT y
+
+FOR y = 10 TO 90
+FOR x = 90 TO 170
+v = SQR((ABS(50 - y)) ^ 2 + (ABS(130 - x)) ^ 2)
+h = SQR((60 - v) * (60 + v)) - 35
+IF h > 0 THEN landh(x, y) = h
+NEXT x
+NEXT y
+
+tower 20, 20
+tower 60, 20
+tower 40, 150
+
+
+FOR za = 0 TO 20 STEP .1
+x = SIN(za) * (1 + (za * 2)) + 100
+y = COS(za) * (1 + (za * 2)) + 100
+landc(x, y) = getcol(20, RND * 200, 20)
+landc(x + 1, y) = getcol(20, RND * 200, 20)
+landc(x, y + 1) = getcol(20, RND * 200, 20)
+landc(x + 1, y + 1) = getcol(20, RND * 200, 20)
+NEXT za
+
+END SUB
+
+SUB setupal
+c = 0
+FOR r = 0 TO 5
+FOR g = 0 TO 5
+FOR b = 0 TO 5
+OUT &H3C8, c
+c = c + 1
+OUT &H3C9, r * 12
+OUT &H3C9, g * 12
+OUT &H3C9, b * 12
+NEXT b
+NEXT g
+NEXT r
+END SUB
+
+SUB square (x1, y1, x2, y2, c, h)
+
+FOR y = y1 TO y2
+FOR x = x1 TO x2
+landh(x, y) = h
+landc(x, y) = c
+NEXT x
+NEXT y
+
+END SUB
+
+SUB start
+SCREEN 13
+'PRINT "please wait..."
+
+setupal
+
+zmyan = 4.14
+myan2 = 100
+ste = 1
+stem = ste - 1
+dist = 190
+tim$ = TIME$
+zmyx = 170
+zmyy = 170
+zmyz = 20
+
+END SUB
+
+SUB tower (x, y)
+
+FOR a = 10 TO 0 STEP -1
+square x - a, y - a, x + a, y + a, getcol(100, 0, a * 20), 20 - a
+NEXT a
+
+square x - 11, y - 11, x - 9, y - 9, getcol(255, 0, 0), 20
+square x + 9, y - 11, x + 11, y - 9, getcol(0, 255, 0), 20
+square x - 11, y + 9, x - 9, y + 11, getcol(0, 0, 255), 20
+square x + 9, y + 9, x + 11, y + 11, getcol(255, 255, 0), 20
+
+
+END SUB
+
+SUB traceline (x, y, xl)
+
+IF x < 0 THEN
+zpr = myx / (myx - x)
+x = 0
+y = myy - ((myy - y) * zpr)
+END IF
+
+IF y < 0 THEN
+zpr = myy / (myy - y)
+y = 0
+x = myx - ((myx - x) * zpr)
+END IF
+
+IF x > 180 THEN
+zpr = (180 - myx) / (x - myx)
+x = 180
+y = myy - ((myy - y) * zpr)
+END IF
+
+IF y > 180 THEN
+zpr = (180 - myy) / (y - myy)
+y = 180
+x = myx - ((myx - x) * zpr)
+END IF
+
+lp = SQR(ABS(myx - x) ^ 2 + ABS(myy - y) ^ 2)
+
+xp = x - myx
+yp = y - myy
+
+yo = 200
+
+FOR a = 1 TO lp
+  cx = xp * a / lp + myx
+  cy = yp * a / lp + myy
+  yn = myan2 - ((landh(cx, cy) - myz) * 300) / a
+  IF yn < yo THEN LINE (xl, yn)-(xl + stem, yo - 1), landc(cx, cy), BF: yo = yn
+NEXT a
+LINE (xl, yo - 1)-(xl + stem, 0), sky, BF
+
+END SUB
+
+SUB updateland
+
+frm = frm + 1
+ste = 4
+stem = ste - 1
+
+
+zmyan = frm / 15 + pi
+'myan2 = myan2 + 5
+'zmyx = SIN(zmyan) * 3 + zmyx
+'zmyy = COS(zmyan) * 3 + zmyy
+'zmyzs = 2
+
+zmyx = 90 - SIN(zmyan) * 91
+zmyy = 90 - COS(zmyan) * 91
+
+IF zmyx > 170 THEN zmyx = 170
+IF zmyy > 170 THEN zmyy = 170
+IF zmyx < 10 THEN zmyx = 10
+IF zmyy < 10 THEN zmyy = 10
+
+zmyz = SIN(zmyan / 2) * 4 + 4
+zmyz = SIN(zmyan / 2) * 50 + 50
+myan2 = -SIN(zmyan / 2) * 120 + 121
+myan2 = -(SIN(zmyan / 2) * 10 + 10)
+IF zmyz < landh(myx, myy) + 10 THEN zmyz = landh(myx, myy) + 10: zmyzs = (zmyzs / 2) + .2
+
+myz = zmyz
+myy = zmyy
+myx = zmyx
+
+END SUB
+