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