mirror of
https://github.com/DualBrain/QB64.git
synced 2023-11-19 13:10:13 +00:00
Updated 'samples' and experimental 'QBjs' support.
This commit is contained in:
Cory Smith
parent
9dcddedd68
commit
684f0cc36e
84
samples.md
84
samples.md
|
|
@ -3,69 +3,122 @@
|
|||
## SAMPLES
|
||||
|
||||
- **[3D Cube](samples/3d-cube/index.md)** • [Relsoft](samples/relsoft.md) <span style="float: right;">[3d](samples/3d.md), [cube](samples/cube.md)</span>
|
||||
- **[3D Engine Prototypes](samples/3d-engine-prototypes/index.md)** • [STxAxTIC](samples/stxaxtic.md) <span style="float: right;">[3d](samples/3d.md), [graph](samples/graph.md)</span>
|
||||
- **[3D Grapher](samples/3d-grapher/index.md)** • [Ashish Kushwaha](samples/ashish-kushwaha.md) • [STxAxTIC](samples/stxaxtic.md) <span style="float: right;">[3d](samples/3d.md), [gl](samples/gl.md)</span>
|
||||
- **[3DS Viewer](samples/3ds-viewer/index.md)** • [*missing*](samples/author-missing.md) <span style="float: right;">[3d](samples/3d.md), [wireframe](samples/wireframe.md), [legacy](samples/legacy.md)</span>
|
||||
- **[Abacus](samples/abacus/index.md)** • [Bob Seguin](samples/bob-seguin.md) <span style="float: right;">[abacus](samples/abacus.md), [arithmetic](samples/arithmetic.md)</span>
|
||||
- **[Amongst](samples/amongst/index.md)** • [Fellippe Heitor](samples/fellippe-heitor.md) <span style="float: right;">[game](samples/game.md), [multiplayer](samples/multiplayer.md)</span>
|
||||
- **[Animax](samples/animax/index.md)** • [Bob Seguin](samples/bob-seguin.md) <span style="float: right;">[art](samples/art.md), [drawing](samples/drawing.md)</span>
|
||||
- **[Arc Demo](samples/arc-demo/index.md)** • [Tsiplacov Sergey](samples/tsiplacov-sergey.md) <span style="float: right;">[game](samples/game.md), [platformer](samples/platformer.md)</span>
|
||||
- **[Assault](samples/assault/index.md)** • [Glenn Powell](samples/glenn-powell.md) <span style="float: right;">[game](samples/game.md)</span>
|
||||
- **[Bad Box Revenge](samples/bad-box-revenge/index.md)** • [Terry Ritchie](samples/terry-ritchie.md) <span style="float: right;">[game](samples/game.md), [bad boxes](samples/bad-boxes.md)</span>
|
||||
- **[Bad Boxes](samples/bad-boxes/index.md)** • [Terry Ritchie](samples/terry-ritchie.md) <span style="float: right;">[game](samples/game.md), [bad boxes](samples/bad-boxes.md)</span>
|
||||
- **[Bar Demo](samples/bar-demo/index.md)** • [Douglas Park](samples/douglas-park.md) <span style="float: right;">[tui](samples/tui.md), [dos world](samples/dos-world.md)</span>
|
||||
- **[Beatdown](samples/beatdown/index.md)** • [Brian Murphy](samples/brian-murphy.md) <span style="float: right;">[game](samples/game.md), [legacy](samples/legacy.md)</span>
|
||||
- **[Bezier](samples/bezier/index.md)** • [Rho Sigma](samples/rho-sigma.md) <span style="float: right;">[screenblanker](samples/screenblanker.md)</span>
|
||||
- **[Binary Clock](samples/binary-clock/index.md)** • [RhoSigma](samples/rhosigma.md) <span style="float: right;">[screenblanker](samples/screenblanker.md)</span>
|
||||
- **[Binary Clock](samples/binary-clock/index.md)** • [Rho Sigma](samples/rho-sigma.md) <span style="float: right;">[screenblanker](samples/screenblanker.md)</span>
|
||||
- **[Binary Counter](samples/binary-counter/index.md)** • [rpgfan3233](samples/rpgfan3233.md) <span style="float: right;">[binary](samples/binary.md), [counter](samples/counter.md)</span>
|
||||
- **[Biorhythm Chart](samples/biorhythm-chart/index.md)** • [Bob Seguin](samples/bob-seguin.md) <span style="float: right;">[biorhythms](samples/biorhythms.md)</span>
|
||||
- **[Blockout](samples/blockout/index.md)** • [Fellippe Heitor](samples/fellippe-heitor.md) <span style="float: right;">[game](samples/game.md), [breakout](samples/breakout.md)</span>
|
||||
- **[Breakout](samples/breakout/index.md)** • [kinem](samples/kinem.md) <span style="float: right;">[game](samples/game.md), [breakout](samples/breakout.md)</span>
|
||||
- **[Calc](samples/calc/index.md)** • [William Loughner](samples/william-loughner.md) <span style="float: right;">[calculator](samples/calculator.md), [dos world](samples/dos-world.md)</span>
|
||||
- **[Calendar](samples/calendar/index.md)** • [A&A De Pasquale](samples/a&a-de-pasquale.md) <span style="float: right;">[calendar](samples/calendar.md), [pdf](samples/pdf.md), [dos world](samples/dos-world.md)</span>
|
||||
- **[Cant Contain Me](samples/cant-contain-me/index.md)** • [Fellippe Heitor](samples/fellippe-heitor.md) <span style="float: right;">[game](samples/game.md)</span>
|
||||
- **[Castle](samples/castle/index.md)** • [Microsoft](samples/microsoft.md) <span style="float: right;">[game](samples/game.md), [2 player](samples/2-player.md)</span>
|
||||
- **[Chaotic Scattering](samples/chaotic-scattering/index.md)** • [vince](samples/vince.md) <span style="float: right;">[ray tracing](samples/ray-tracing.md), [reflections](samples/reflections.md)</span>
|
||||
- **[Chess](samples/chess/index.md)** • [Richard Frost](samples/richard-frost.md) <span style="float: right;">[game](samples/game.md), [chess](samples/chess.md)</span>
|
||||
- **[Circle Intersecting Circle](samples/circle-intersecting-circle/index.md)** • [bplus](samples/bplus.md) • [STxAxTIC](samples/stxaxtic.md) <span style="float: right;">[geometry](samples/geometry.md), [intersections](samples/intersections.md)</span>
|
||||
- **[Circle Intersecting Line](samples/circle-intersecting-line/index.md)** • [bplus](samples/bplus.md) <span style="float: right;">[geometry](samples/geometry.md), [intersections](samples/intersections.md)</span>
|
||||
- **[Cloned Shades](samples/cloned-shades/index.md)** • [Fellippe Heitor](samples/fellippe-heitor.md) <span style="float: right;">[game](samples/game.md)</span>
|
||||
- **[Colliding Ball Simulation](samples/colliding-ball-simulation/index.md)** • [Timothy Baxendale](samples/timothy-baxendale.md) <span style="float: right;">[physics](samples/physics.md), [collisions](samples/collisions.md)</span>
|
||||
- **[Colors](samples/colors/index.md)** • [Hardin Brothers](samples/hardin-brothers.md) <span style="float: right;">[color picker](samples/color-picker.md), [dos world](samples/dos-world.md)</span>
|
||||
- **[Connect Circles](samples/connect-circles/index.md)** • [bplus](samples/bplus.md) <span style="float: right;">[screensaver](samples/screensaver.md), [mosaic](samples/mosaic.md)</span>
|
||||
- **[Convert BMP to Dominoes](samples/convert-bmp-to-dominoes/index.md)** • [Richard Frost](samples/richard-frost.md) <span style="float: right;">[image processing](samples/image-processing.md)</span>
|
||||
- **[Conways Game of Life](samples/conways-game-of-life/index.md)** • [Luke](samples/luke.md) <span style="float: right;">[automata](samples/automata.md), [conway](samples/conway.md)</span>
|
||||
- **[Cram](samples/cram/index.md)** • [Hardin Brothers](samples/hardin-brothers.md) <span style="float: right;">[game](samples/game.md), [dos world](samples/dos-world.md)</span>
|
||||
- **[Curve Smoother](samples/curve-smoother/index.md)** • [STxAxTIC](samples/stxaxtic.md) • [Fellippe Heitor](samples/fellippe-heitor.md) <span style="float: right;">[curve](samples/curve.md), [interpolation](samples/interpolation.md)</span>
|
||||
- **[Darokin](samples/darokin/index.md)** • [darokin](samples/darokin.md) <span style="float: right;">[screensaver](samples/screensaver.md), [starfield](samples/starfield.md)</span>
|
||||
- **[Dec to Frac](samples/dec-to-frac/index.md)** • [A&A De Pasquale](samples/a&a-de-pasquale.md) <span style="float: right;">[math](samples/math.md), [dos world](samples/dos-world.md)</span>
|
||||
- **[Diamond Pong](samples/diamond-pong/index.md)** • [John Wolfskill](samples/john-wolfskill.md) <span style="float: right;">[game](samples/game.md), [pong](samples/pong.md), [dos world](samples/dos-world.md)</span>
|
||||
- **[Didris](samples/didris/index.md)** • [Dietmar Moritz](samples/dietmar-moritz.md) <span style="float: right;">[game](samples/game.md), [tetris](samples/tetris.md)</span>
|
||||
- **[Double Pendulum](samples/double-pendulum/index.md)** • [*missing*](samples/author-missing.md) <span style="float: right;">[physics](samples/physics.md), [pendulum](samples/pendulum.md)</span>
|
||||
- **[Dragon Warrior](samples/dragon-warrior/index.md)** • [Cobalt](samples/cobalt.md) <span style="float: right;">[game](samples/game.md), [rpg](samples/rpg.md)</span>
|
||||
- **[Dropping Balls](samples/dropping-balls/index.md)** • [bplus](samples/bplus.md) <span style="float: right;">[gravity](samples/gravity.md), [collisions](samples/collisions.md)</span>
|
||||
- **[Eliza](samples/eliza/index.md)** • [*missing*](samples/author-missing.md) <span style="float: right;">[ai](samples/ai.md), [eliza](samples/eliza.md)</span>
|
||||
- **[Ellipse Intersecting Line](samples/ellipse-intersecting-line/index.md)** • [STxAxTIC](samples/stxaxtic.md) <span style="float: right;">[geometry](samples/geometry.md), [intersections](samples/intersections.md)</span>
|
||||
- **[Fibonacci Variations](samples/fibonacci-variations/index.md)** • [STxAxTIC](samples/stxaxtic.md) <span style="float: right;">[fibonacci](samples/fibonacci.md)</span>
|
||||
- **[Fibonacci Variations](samples/fibonacci-variations/index.md)** • [STxAxTIC](samples/stxaxtic.md) <span style="float: right;">[fibonacci](samples/fibonacci.md), [spiral](samples/spiral.md)</span>
|
||||
- **[Filled Circles and Ellipses](samples/filled-circles-and-ellipses/index.md)** • [QB64 Team 2018](samples/qb64-team-2018.md) <span style="float: right;">[filled circle](samples/filled-circle.md), [ellipse](samples/ellipse.md)</span>
|
||||
- **[Fire](samples/fire/index.md)** • [*missing*](samples/author-missing.md) <span style="float: right;">[fire](samples/fire.md), [graphics](samples/graphics.md)</span>
|
||||
- **[Fire 13](samples/fire-13/index.md)** • [*missing*](samples/author-missing.md) <span style="float: right;">[fire](samples/fire.md), [graphics](samples/graphics.md)</span>
|
||||
- **[Fire Demo](samples/fire-demo/index.md)** • [harixxx](samples/harixxx.md) <span style="float: right;">[graphics](samples/graphics.md), [fire](samples/fire.md)</span>
|
||||
- **[Flappy Bird](samples/flappy-bird/index.md)** • [Terry Ritchie](samples/terry-ritchie.md) <span style="float: right;">[game](samples/game.md), [flappy bird](samples/flappy-bird.md)</span>
|
||||
- **[Floormaper](samples/floormaper/index.md)** • [Antoni Gual](samples/antoni-gual.md) <span style="float: right;">[graphics](samples/graphics.md), [floorscape](samples/floorscape.md)</span>
|
||||
- **[Four Player Pong](samples/four-player-pong/index.md)** • [Matthew](samples/matthew.md) <span style="float: right;">[game](samples/game.md), [pong](samples/pong.md)</span>
|
||||
- **[Fractal](samples/fractal/index.md)** • [RhoSigma](samples/rhosigma.md) <span style="float: right;">[screenblanker](samples/screenblanker.md)</span>
|
||||
- **[Fractal Art](samples/fractal-art/index.md)** • [Zom-B](samples/zom-b.md) <span style="float: right;">[fractal](samples/fractal.md), [art](samples/art.md)</span>
|
||||
- **[Fractal Fern](samples/fractal-fern/index.md)** • [*missing*](samples/author-missing.md) <span style="float: right;">[fractal](samples/fractal.md), [fern](samples/fern.md)</span>
|
||||
- **[Frogger](samples/frogger/index.md)** • [Matt Bross](samples/matt-bross.md) <span style="float: right;">[game](samples/game.md), [frogger](samples/frogger.md)</span>
|
||||
- **[Frostbite](samples/frostbite/index.md)** • [Fellippe Heitor](samples/fellippe-heitor.md) <span style="float: right;">[game](samples/game.md), [frostbite](samples/frostbite.md)</span>
|
||||
- **[Future Blocks](samples/future-blocks/index.md)** • [Michael Fogleman](samples/michael-fogleman.md) <span style="float: right;">[game](samples/game.md), [tetris](samples/tetris.md)</span>
|
||||
- **[Ghost Wizard](samples/ghost-wizard/index.md)** • [Zack Johnson](samples/zack-johnson.md) <span style="float: right;">[game](samples/game.md), [roguelike](samples/roguelike.md)</span>
|
||||
- **[Globe](samples/globe/index.md)** • [Jeh](samples/jeh.md) • [Yu](samples/yu.md) <span style="float: right;">[3d](samples/3d.md), [sphere](samples/sphere.md)</span>
|
||||
- **[Gorillas](samples/gorillas/index.md)** • [Microsoft](samples/microsoft.md) <span style="float: right;">[game](samples/game.md), [artillery](samples/artillery.md)</span>
|
||||
- **[Gujero2](samples/gujero2/index.md)** • [Antoni Gual](samples/antoni-gual.md) <span style="float: right;">[screensaver](samples/screensaver.md), [tunnel](samples/tunnel.md)</span>
|
||||
- **[Hangman](samples/hangman/index.md)** • [A&A De Pasquale](samples/a&a-de-pasquale.md) <span style="float: right;">[game](samples/game.md), [hangman](samples/hangman.md), [dos world](samples/dos-world.md)</span>
|
||||
- **[Helicopter Rescue](samples/helicopter-rescue/index.md)** • [TrialAndTerror](samples/trialandterror.md) <span style="float: right;">[game](samples/game.md), [3d](samples/3d.md), [flight](samples/flight.md)</span>
|
||||
- **[Hunter](samples/hunter/index.md)** • [Microsoft](samples/microsoft.md) <span style="float: right;">[game](samples/game.md), [maze](samples/maze.md)</span>
|
||||
- **[Hunters Revenge](samples/hunters-revenge/index.md)** • [Ashish Kushwaha](samples/ashish-kushwaha.md) <span style="float: right;">[game](samples/game.md), [shooter](samples/shooter.md)</span>
|
||||
- **[Integrators](samples/integrators/index.md)** • [STxAxTIC](samples/stxaxtic.md) <span style="float: right;">[physics](samples/physics.md), [simulation](samples/simulation.md)</span>
|
||||
- **[Inverse Julia Fractal Explorer](samples/inverse-julia-fractal-explorer/index.md)** • [Zom-B](samples/zom-b.md) <span style="float: right;">[fractal](samples/fractal.md), [julia set](samples/julia-set.md)</span>
|
||||
- **[Jpeg Maker](samples/jpeg-maker/index.md)** • [Artelius](samples/artelius.md) <span style="float: right;">[jpeg](samples/jpeg.md), [image manipulation](samples/image-manipulation.md)</span>
|
||||
- **[Julia Rings](samples/julia-rings/index.md)** • [Relsoft](samples/relsoft.md) <span style="float: right;">[fractal](samples/fractal.md), [julia set](samples/julia-set.md)</span>
|
||||
- **[Kaleidoscope](samples/kaleidoscope/index.md)** • [Rho Sigma](samples/rho-sigma.md) <span style="float: right;">[screenblanker](samples/screenblanker.md)</span>
|
||||
- **[Kaleidoscope 3D](samples/kaleidoscope-3d/index.md)** • [qbguy](samples/qbguy.md) <span style="float: right;">[3d](samples/3d.md), [art](samples/art.md)</span>
|
||||
- **[Kaleidoscope Doodler](samples/kaleidoscope-doodler/index.md)** • [qbguy](samples/qbguy.md) <span style="float: right;">[art](samples/art.md), [drawing](samples/drawing.md)</span>
|
||||
- **[Kaleidoscope Mill](samples/kaleidoscope-mill/index.md)** • [Rho Sigma](samples/rho-sigma.md) <span style="float: right;">[screenblanker](samples/screenblanker.md)</span>
|
||||
- **[Lightning One](samples/lightning-one/index.md)** • [RhoSigma](samples/rhosigma.md) <span style="float: right;">[screenblanker](samples/screenblanker.md)</span>
|
||||
- **[Lightning Two](samples/lightning-two/index.md)** • [RhoSigma](samples/rhosigma.md) <span style="float: right;">[screenblanker](samples/screenblanker.md)</span>
|
||||
- **[Lens Simulator](samples/lens-simulator/index.md)** • [STxAxTIC](samples/stxaxtic.md) <span style="float: right;">[2d](samples/2d.md), [ray tracer](samples/ray-tracer.md)</span>
|
||||
- **[Letter Blast](samples/letter-blast/index.md)** • [A&A De Pasquale](samples/a&a-de-pasquale.md) <span style="float: right;">[game](samples/game.md), [letter](samples/letter.md), [dos world](samples/dos-world.md)</span>
|
||||
- **[Lightning One](samples/lightning-one/index.md)** • [Rho Sigma](samples/rho-sigma.md) <span style="float: right;">[screenblanker](samples/screenblanker.md)</span>
|
||||
- **[Lightning Two](samples/lightning-two/index.md)** • [Rho Sigma](samples/rho-sigma.md) <span style="float: right;">[screenblanker](samples/screenblanker.md)</span>
|
||||
- **[LightsOn](samples/lightson/index.md)** • [Fellippe Heitor](samples/fellippe-heitor.md) <span style="float: right;">[game](samples/game.md), [lights](samples/lights.md)</span>
|
||||
- **[Lines Intersecting](samples/lines-intersecting/index.md)** • [STxAxTIC](samples/stxaxtic.md) <span style="float: right;">[geometry](samples/geometry.md), [intersections](samples/intersections.md)</span>
|
||||
- **[Lisp Interpreter](samples/lisp-interpreter/index.md)** • [qbguy](samples/qbguy.md) <span style="float: right;">[interpreter](samples/interpreter.md), [lisp](samples/lisp.md)</span>
|
||||
- **[Lissajous Curve Table](samples/lissajous-curve-table/index.md)** • [Fellippe Heitor](samples/fellippe-heitor.md) <span style="float: right;">[graphics](samples/graphics.md), [trigonometry](samples/trigonometry.md)</span>
|
||||
- **[Lissajous Screensaver](samples/lissajous-screensaver/index.md)** • [Antoni Gual](samples/antoni-gual.md) <span style="float: right;">[screensaver](samples/screensaver.md), [9 lines](samples/9-lines.md)</span>
|
||||
- **[Loan Amortization](samples/loan-amortization/index.md)** • [Alan Zeichick](samples/alan-zeichick.md) <span style="float: right;">[finance](samples/finance.md), [dos world](samples/dos-world.md)</span>
|
||||
- **[Lorenz Attractor](samples/lorenz-attractor/index.md)** • [Vince](samples/vince.md) <span style="float: right;">[lorenz](samples/lorenz.md), [rotations](samples/rotations.md)</span>
|
||||
- **[Lucid Drawing](samples/lucid-drawing/index.md)** • [Lucid](samples/lucid.md) <span style="float: right;">[2d](samples/2d.md), [draw](samples/draw.md)</span>
|
||||
- **[Manadla](samples/manadla/index.md)** • [Antoni Gual](samples/antoni-gual.md) <span style="float: right;">[screensaver](samples/screensaver.md), [9 lines](samples/9-lines.md)</span>
|
||||
- **[Mandelbrot Animator](samples/mandelbrot-animator/index.md)** • [*missing*](samples/author-missing.md) <span style="float: right;">[fractal](samples/fractal.md), [mandelbrot](samples/mandelbrot.md)</span>
|
||||
- **[Mandelbrot Set 2003](samples/mandelbrot-set-2003/index.md)** • [Antoni Gual](samples/antoni-gual.md) <span style="float: right;">[fractal](samples/fractal.md), [mandelbrot](samples/mandelbrot.md), [9 lines](samples/9-lines.md)</span>
|
||||
- **[Mandelbrot Set 2008](samples/mandelbrot-set-2008/index.md)** • [qbguy](samples/qbguy.md) <span style="float: right;">[fractal](samples/fractal.md), [mandelbrot](samples/mandelbrot.md)</span>
|
||||
- **[Mandelbrot Zoomer](samples/mandelbrot-zoomer/index.md)** • [*missing*](samples/author-missing.md) <span style="float: right;">[fractal](samples/fractal.md), [mandelbrot](samples/mandelbrot.md)</span>
|
||||
- **[Mandelbrot Spiral](samples/mandelbrot-spiral/index.md)** • [qbguy](samples/qbguy.md) <span style="float: right;">[fractal](samples/fractal.md), [mandelbrot](samples/mandelbrot.md)</span>
|
||||
- **[Mandelbrot Zoomer](samples/mandelbrot-zoomer/index.md)** • [Tor Myklebust](samples/tor-myklebust.md) <span style="float: right;">[fractal](samples/fractal.md), [mandelbrot](samples/mandelbrot.md)</span>
|
||||
- **[Maptriangle in 3D](samples/maptriangle-in-3d/index.md)** • [Petr](samples/petr.md) <span style="float: right;">[3d](samples/3d.md), [maptriangle](samples/maptriangle.md)</span>
|
||||
- **[Matrix Effect](samples/matrix-effect/index.md)** • [TylerDarko](samples/tylerdarko.md) <span style="float: right;">[ascii](samples/ascii.md), [matrix](samples/matrix.md)</span>
|
||||
- **[Mazes of Misery](samples/mazes-of-misery/index.md)** • [Steve M.](samples/steve-m..md) <span style="float: right;">[game](samples/game.md), [maze](samples/maze.md)</span>
|
||||
- **[Measure](samples/measure/index.md)** • [A&A De Pasquale](samples/a&a-de-pasquale.md) <span style="float: right;">[measure](samples/measure.md), [dos world](samples/dos-world.md)</span>
|
||||
- **[Mini Clock](samples/mini-clock/index.md)** • [Folker Fritz](samples/folker-fritz.md) <span style="float: right;">[clock](samples/clock.md), [desktop](samples/desktop.md)</span>
|
||||
- **[Money](samples/money/index.md)** • [Microsoft](samples/microsoft.md) <span style="float: right;">[data management](samples/data-management.md)</span>
|
||||
- **[Moon Lander](samples/moon-lander/index.md)** • [Richard Frost](samples/richard-frost.md) <span style="float: right;">[game](samples/game.md), [lander](samples/lander.md)</span>
|
||||
- **[Multi-Mill](samples/multi-mill/index.md)** • [RhoSigma](samples/rhosigma.md) <span style="float: right;">[screenblanker](samples/screenblanker.md)</span>
|
||||
- **[Mystify](samples/mystify/index.md)** • [RhoSigma](samples/rhosigma.md) <span style="float: right;">[screenblanker](samples/screenblanker.md)</span>
|
||||
- **[MS Phone](samples/ms-phone/index.md)** • [Microsoft](samples/microsoft.md) <span style="float: right;">[data management](samples/data-management.md)</span>
|
||||
- **[Multi-Mill](samples/multi-mill/index.md)** • [Rho Sigma](samples/rho-sigma.md) <span style="float: right;">[screenblanker](samples/screenblanker.md)</span>
|
||||
- **[MyCraft](samples/mycraft/index.md)** • [Galleon](samples/galleon.md) <span style="float: right;">[game](samples/game.md), [minecraft](samples/minecraft.md)</span>
|
||||
- **[Mystify](samples/mystify/index.md)** • [Rho Sigma](samples/rho-sigma.md) <span style="float: right;">[screenblanker](samples/screenblanker.md)</span>
|
||||
- **[Names](samples/names/index.md)** • [David Bannon](samples/david-bannon.md) <span style="float: right;">[data management](samples/data-management.md), [dos world](samples/dos-world.md)</span>
|
||||
- **[Nibbles](samples/nibbles/index.md)** • [Microsoft](samples/microsoft.md) <span style="float: right;">[game](samples/game.md), [snake](samples/snake.md)</span>
|
||||
- **[Parabolas](samples/parabolas/index.md)** • [STxAxTIC](samples/stxaxtic.md) <span style="float: right;">[zen](samples/zen.md)</span>
|
||||
- **[Particle Fountain](samples/particle-fountain/index.md)** • [bplus](samples/bplus.md) <span style="float: right;">[particles](samples/particles.md)</span>
|
||||
- **[Pattern](samples/pattern/index.md)** • [Antoni Gual](samples/antoni-gual.md) <span style="float: right;">[screensaver](samples/screensaver.md), [9 lines](samples/9-lines.md)</span>
|
||||
- **[Pendulum Game](samples/pendulum-game/index.md)** • [Fellippe Heitor](samples/fellippe-heitor.md) <span style="float: right;">[game](samples/game.md), [pendulum](samples/pendulum.md)</span>
|
||||
- **[Phone](samples/phone/index.md)** • [Microsoft](samples/microsoft.md) <span style="float: right;">[data management](samples/data-management.md)</span>
|
||||
- **[Phone](samples/phone/index.md)** • [Hardin Brothers](samples/hardin-brothers.md) <span style="float: right;">[data management](samples/data-management.md), [dos world](samples/dos-world.md)</span>
|
||||
- **[Pipes Puzzle](samples/pipes-puzzle/index.md)** • [Dav](samples/dav.md) <span style="float: right;">[game](samples/game.md), [puzzle](samples/puzzle.md)</span>
|
||||
- **[PixelPlus](samples/pixelplus/index.md)** • [Chris Chadwick](samples/chris-chadwick.md) <span style="float: right;">[graphics](samples/graphics.md), [bitmap](samples/bitmap.md)</span>
|
||||
- **[Plasma Effect](samples/plasma-effect/index.md)** • [Cyperium](samples/cyperium.md) <span style="float: right;">[graphics](samples/graphics.md), [plasma](samples/plasma.md)</span>
|
||||
- **[Plasma Non-Pal](samples/plasma-non-pal/index.md)** • [Relsoft](samples/relsoft.md) <span style="float: right;">[screensaver](samples/screensaver.md), [plasma](samples/plasma.md)</span>
|
||||
- **[Platform](samples/platform/index.md)** • [Fellippe Heitor](samples/fellippe-heitor.md) <span style="float: right;">[game](samples/game.md), [platform](samples/platform.md)</span>
|
||||
- **[QB Clock](samples/qb-clock/index.md)** • [Alan Zeichick](samples/alan-zeichick.md) <span style="float: right;">[clock](samples/clock.md)</span>
|
||||
- **[QB Tank Commander](samples/qb-tank-commander/index.md)** • [Matthew River Knight](samples/matthew-river-knight.md) <span style="float: right;">[game](samples/game.md), [tank](samples/tank.md)</span>
|
||||
- **[QB-NVentory](samples/qb-nventory/index.md)** • [Nathan Thomas](samples/nathan-thomas.md) <span style="float: right;">[data management](samples/data-management.md)</span>
|
||||
- **[QBAscii](samples/qbascii/index.md)** • [Jeremy Munn](samples/jeremy-munn.md) <span style="float: right;">[drawing](samples/drawing.md), [ascii](samples/ascii.md)</span>
|
||||
- **[QBlocks](samples/qblocks/index.md)** • [Microsoft](samples/microsoft.md) <span style="float: right;">[game](samples/game.md), [tetris](samples/tetris.md)</span>
|
||||
- **[QBricks](samples/qbricks/index.md)** • [Microsoft](samples/microsoft.md) <span style="float: right;">[game](samples/game.md), [breakout](samples/breakout.md)</span>
|
||||
|
|
@ -77,10 +130,16 @@
|
|||
- **[QSynth](samples/qsynth/index.md)** • [Microsoft](samples/microsoft.md) <span style="float: right;">[sound](samples/sound.md), [music](samples/music.md)</span>
|
||||
- **[QTrek](samples/qtrek/index.md)** • [Philipp Strathausen](samples/philipp-strathausen.md) <span style="float: right;">[game](samples/game.md), [space shooter](samples/space-shooter.md)</span>
|
||||
- **[Rattler](samples/rattler/index.md)** • [Bob Seguin](samples/bob-seguin.md) <span style="float: right;">[game](samples/game.md), [snake](samples/snake.md)</span>
|
||||
- **[Ray Tracer Z](samples/ray-tracer-z/index.md)** • [Zom-B](samples/zom-b.md) <span style="float: right;">[3d](samples/3d.md), [ray tracer](samples/ray-tracer.md)</span>
|
||||
- **[RayCaster](samples/raycaster/index.md)** • [Antoni Gual](samples/antoni-gual.md) <span style="float: right;">[3d](samples/3d.md), [raycaster](samples/raycaster.md)</span>
|
||||
- **[Relief 3D](samples/relief-3d/index.md)** • [Danilin](samples/danilin.md) <span style="float: right;">[graphics](samples/graphics.md), [isometric](samples/isometric.md)</span>
|
||||
- **[Reversi](samples/reversi/index.md)** • [Microsoft](samples/microsoft.md) <span style="float: right;">[game](samples/game.md)</span>
|
||||
- **[Ripples](samples/ripples/index.md)** • [Antoni Gual](samples/antoni-gual.md) <span style="float: right;">[image processing](samples/image-processing.md), [ripple](samples/ripple.md)</span>
|
||||
- **[Robo Raider](samples/robo-raider/index.md)** • [Kevin](samples/kevin.md) <span style="float: right;">[game](samples/game.md)</span>
|
||||
- **[Rockets](samples/rockets/index.md)** • [*missing*](samples/author-missing.md) <span style="float: right;">[screensaver](samples/screensaver.md), [particles](samples/particles.md)</span>
|
||||
- **[Rotozoomer](samples/rotozoomer/index.md)** • [Antoni Gual](samples/antoni-gual.md) <span style="float: right;">[screensaver](samples/screensaver.md), [9 lines](samples/9-lines.md)</span>
|
||||
- **[Saver](samples/saver/index.md)** • [David Ferrier](samples/david-ferrier.md) <span style="float: right;">[screensaver](samples/screensaver.md), [dos world](samples/dos-world.md)</span>
|
||||
- **[Schemat](samples/schemat/index.md)** • [Leif J. Burrow](samples/leif-j.-burrow.md) <span style="float: right;">[circuits](samples/circuits.md), [schematics](samples/schematics.md)</span>
|
||||
- **[Set Fire to Rain](samples/set-fire-to-rain/index.md)** • [Fellippe Heitor](samples/fellippe-heitor.md) <span style="float: right;">[game](samples/game.md), [zen](samples/zen.md)</span>
|
||||
- **[Shooter](samples/shooter/index.md)** • [*missing*](samples/author-missing.md) <span style="float: right;">[game](samples/game.md), [shooter](samples/shooter.md)</span>
|
||||
- **[Sine Wave Explorer](samples/sine-wave-explorer/index.md)** • [*missing*](samples/author-missing.md) <span style="float: right;">[trigonometry](samples/trigonometry.md)</span>
|
||||
|
|
@ -93,13 +152,20 @@
|
|||
- **[Splines](samples/splines/index.md)** • [Rho Sigma](samples/rho-sigma.md) <span style="float: right;">[screenblanker](samples/screenblanker.md)</span>
|
||||
- **[Starfield](samples/starfield/index.md)** • [Antoni Gual](samples/antoni-gual.md) <span style="float: right;">[starfield](samples/starfield.md), [9 lines](samples/9-lines.md)</span>
|
||||
- **[Starfield Torus](samples/starfield-torus/index.md)** • [JKC](samples/jkc.md) <span style="float: right;">[starfield](samples/starfield.md)</span>
|
||||
- **[Stock Watcher](samples/stock-watcher/index.md)** • [*missing*](samples/author-missing.md) <span style="float: right;">[money](samples/money.md), [stocks](samples/stocks.md)</span>
|
||||
- **[Super Mario Jump](samples/super-mario-jump/index.md)** • [Terry Ritchie](samples/terry-ritchie.md) <span style="float: right;">[game](samples/game.md), [mario](samples/mario.md)</span>
|
||||
- **[Texel Raytracer](samples/texel-raytracer/index.md)** • [Antoni Gual](samples/antoni-gual.md) <span style="float: right;">[3d](samples/3d.md), [ray tracing](samples/ray-tracing.md)</span>
|
||||
- **[Tic Tac Toe](samples/tic-tac-toe/index.md)** • [Paul Meyer](samples/paul-meyer.md) <span style="float: right;">[game](samples/game.md), [tic tac toe](samples/tic-tac-toe.md)</span>
|
||||
- **[Tic Tac Toe 3D](samples/tic-tac-toe-3d/index.md)** • [qbguy](samples/qbguy.md) <span style="float: right;">[game](samples/game.md), [tic tac toe](samples/tic-tac-toe.md)</span>
|
||||
- **[Tic Tac Toe Rings](samples/tic-tac-toe-rings/index.md)** • [Fellippe Heitor](samples/fellippe-heitor.md) <span style="float: right;">[game](samples/game.md), [tic tac toe rings](samples/tic-tac-toe-rings.md)</span>
|
||||
- **[Torus Demo](samples/torus-demo/index.md)** • [Microsoft](samples/microsoft.md) <span style="float: right;">[geometry](samples/geometry.md), [torus](samples/torus.md)</span>
|
||||
- **[Tower of Hanoi](samples/tower-of-hanoi/index.md)** • [*missing*](samples/author-missing.md) <span style="float: right;">[game](samples/game.md), [tower](samples/tower.md)</span>
|
||||
- **[Trig Demo](samples/trig-demo/index.md)** • [STxAxTIC](samples/stxaxtic.md) <span style="float: right;">[trigonometry](samples/trigonometry.md)</span>
|
||||
- **[TUI](samples/tui/index.md)** • [Fellippe Heitor](samples/fellippe-heitor.md) <span style="float: right;">[interface](samples/interface.md), [tui](samples/tui.md)</span>
|
||||
- **[Turtle Graphics](samples/turtle-graphics/index.md)** • [triggered](samples/triggered.md) <span style="float: right;">[fractal](samples/fractal.md), [turtle graphics](samples/turtle-graphics.md)</span>
|
||||
- **[Twirl](samples/twirl/index.md)** • [Antoni Gual](samples/antoni-gual.md) <span style="float: right;">[screensaver](samples/screensaver.md), [9 lines](samples/9-lines.md)</span>
|
||||
- **[Vector Field](samples/vector-field/index.md)** • [STxAxTIC](samples/stxaxtic.md) <span style="float: right;">[2d](samples/2d.md), [vectors](samples/vectors.md)</span>
|
||||
- **[Vortex](samples/vortex/index.md)** • [Antoni Gual](samples/antoni-gual.md) <span style="float: right;">[screensaver](samples/screensaver.md), [9 lines](samples/9-lines.md)</span>
|
||||
- **[Water](samples/water/index.md)** • [*missing*](samples/author-missing.md) <span style="float: right;">[wave motion](samples/wave-motion.md)</span>
|
||||
- **[Worms](samples/worms/index.md)** • [Rho Sigma](samples/rho-sigma.md) <span style="float: right;">[screenblanker](samples/screenblanker.md)</span>
|
||||
- **[XE Hex Editor](samples/xe-hex-editor/index.md)** • [Dav](samples/dav.md) <span style="float: right;">[editor](samples/editor.md), [hex](samples/hex.md)</span>
|
||||
|
|
|
|||
21
samples/2d.md
Normal file
21
samples/2d.md
Normal file
|
|
@ -0,0 +1,21 @@
|
|||
[Home](https://qb64.com) • [News](../news.md) • [GitHub](../github.md) • [Wiki](../wiki.md) • [Samples](../samples.md) • [Media](../media.md) • [Community](../community.md) • [Rolodex](../rolodex.md) • [More...](../more.md)
|
||||
|
||||
## SAMPLES: 2D
|
||||
|
||||
**[Lens Simulator](lens-simulator/index.md)**
|
||||
|
||||
[🐝 STxAxTIC](stxaxtic.md) 🔗 [2d](2d.md), [ray tracer](ray-tracer.md)
|
||||
|
||||
This program simulates light rays passing through a lens with a given index of refraction and con...
|
||||
|
||||
**[Lucid Drawing](lucid-drawing/index.md)**
|
||||
|
||||
[🐝 Lucid](lucid.md) 🔗 [2d](2d.md), [draw](draw.md)
|
||||
|
||||
Drawing program by Lucid.
|
||||
|
||||
**[Vector Field](vector-field/index.md)**
|
||||
|
||||
[🐝 STxAxTIC](stxaxtic.md) 🔗 [2d](2d.md), [vectors](vectors.md)
|
||||
|
||||
Vector field demonstration.
|
||||
|
|
@ -22,9 +22,9 @@ Relsoft 2003
|
|||
|
||||
> Please note that QBjs is still in early development and support for these examples is extremely experimental (meaning will most likely not work). With that out of the way, give it a try!
|
||||
|
||||
* [LOAD "3dcube25.bas"](https://v6p9d9t4.ssl.hwcdn.net/html/5953810/index.html?src=https://qb64.com/samples/3d-cube/src/3dcube25.bas)
|
||||
* [RUN "3dcube25.bas"](https://v6p9d9t4.ssl.hwcdn.net/html/5953810/index.html?mode=auto&src=https://qb64.com/samples/3d-cube/src/3dcube25.bas)
|
||||
* [PLAY "3dcube25.bas"](https://v6p9d9t4.ssl.hwcdn.net/html/5953810/index.html?mode=play&src=https://qb64.com/samples/3d-cube/src/3dcube25.bas)
|
||||
* [LOAD "3dcube25.bas"](https://v6p9d9t4.ssl.hwcdn.net/html/5963335/index.html?src=https://qb64.com/samples/3d-cube/src/3dcube25.bas)
|
||||
* [RUN "3dcube25.bas"](https://v6p9d9t4.ssl.hwcdn.net/html/5963335/index.html?mode=auto&src=https://qb64.com/samples/3d-cube/src/3dcube25.bas)
|
||||
* [PLAY "3dcube25.bas"](https://v6p9d9t4.ssl.hwcdn.net/html/5963335/index.html?mode=play&src=https://qb64.com/samples/3d-cube/src/3dcube25.bas)
|
||||
|
||||
### File(s)
|
||||
|
||||
|
|
|
|||
BIN
samples/3d-engine-prototypes/img/3dengineqb.png
Normal file
BIN
samples/3d-engine-prototypes/img/3dengineqb.png
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 79 KiB |
BIN
samples/3d-engine-prototypes/img/3dengineqb2.png
Normal file
BIN
samples/3d-engine-prototypes/img/3dengineqb2.png
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 44 KiB |
26
samples/3d-engine-prototypes/index.md
Normal file
26
samples/3d-engine-prototypes/index.md
Normal file
|
|
@ -0,0 +1,26 @@
|
|||
[Home](https://qb64.com) • [News](../../news.md) • [GitHub](../../github.md) • [Wiki](../../wiki.md) • [Samples](../../samples.md) • [Media](../../media.md) • [Community](../../community.md) • [Rolodex](../../rolodex.md) • [More...](../../more.md)
|
||||
|
||||
## SAMPLE: 3D ENGINE PROTOTYPES
|
||||
|
||||
|
||||
|
||||
### Author
|
||||
|
||||
[🐝 STxAxTIC](../stxaxtic.md)
|
||||
|
||||
### Description
|
||||
|
||||
```text
|
||||
Various experiments in software 3D graphics. Warning: Uses no functions or subs!
|
||||
```
|
||||
|
||||
### File(s)
|
||||
|
||||
* [3dctrwgraph_fb64.bas](src/3dctrwgraph_fb64.bas)
|
||||
* [3dctrwgraph_fb64.zip](src/3dctrwgraph_fb64.zip)
|
||||
|
||||
### Additional Image(s)
|
||||
|
||||
|
||||
|
||||
🔗 [3d](../3d.md), [graph](../graph.md)
|
||||
6455
samples/3d-engine-prototypes/src/3dctrwgraph_fb64.bas
Normal file
6455
samples/3d-engine-prototypes/src/3dctrwgraph_fb64.bas
Normal file
File diff suppressed because it is too large
Load diff
BIN
samples/3d-engine-prototypes/src/3dctrwgraph_fb64.zip
Normal file
BIN
samples/3d-engine-prototypes/src/3dctrwgraph_fb64.zip
Normal file
Binary file not shown.
BIN
samples/3d-grapher/img/screenshot.png
Normal file
BIN
samples/3d-grapher/img/screenshot.png
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 136 KiB |
26
samples/3d-grapher/index.md
Normal file
26
samples/3d-grapher/index.md
Normal file
|
|
@ -0,0 +1,26 @@
|
|||
[Home](https://qb64.com) • [News](../../news.md) • [GitHub](../../github.md) • [Wiki](../../wiki.md) • [Samples](../../samples.md) • [Media](../../media.md) • [Community](../../community.md) • [Rolodex](../../rolodex.md) • [More...](../../more.md)
|
||||
|
||||
## SAMPLE: 3D GRAPHER
|
||||
|
||||
|
||||
|
||||
### Authors
|
||||
|
||||
[🐝 Ashish Kushwaha](../ashish-kushwaha.md) [🐝 STxAxTIC](../stxaxtic.md)
|
||||
|
||||
### Description
|
||||
|
||||
```text
|
||||
3D Grapher made in QB64.
|
||||
```
|
||||
|
||||
### File(s)
|
||||
|
||||
* [3d-grapher---legacy.bas](src/3d-grapher---legacy.bas)
|
||||
* [3d-grapher---parametric.bas](src/3d-grapher---parametric.bas)
|
||||
* [3d-grapher.zip](src/3d-grapher.zip)
|
||||
|
||||
🔗 [3d](../3d.md), [gl](../gl.md)
|
||||
|
||||
|
||||
<sub>Reference: [github.com](https://github.com/AshishKingdom/3D-Grapher) </sub>
|
||||
714
samples/3d-grapher/src/3d-grapher---legacy.bas
Normal file
714
samples/3d-grapher/src/3d-grapher---legacy.bas
Normal file
|
|
@ -0,0 +1,714 @@
|
|||
'##############################################################################
|
||||
'3D Grapher in QB64 using OpenGL
|
||||
'
|
||||
'Contributors:
|
||||
' Ashish Kushwaha (primary)
|
||||
' FellipeHeitor
|
||||
' STxAxTIC
|
||||
'
|
||||
'See README.bm.
|
||||
|
||||
OPTION _EXPLICIT
|
||||
|
||||
REM $INCLUDE: 'sxript.bi'
|
||||
REM $Include: 'sxmath.bi'
|
||||
|
||||
DO UNTIL _SCREENEXISTS: LOOP
|
||||
_TITLE "3D Grapher"
|
||||
|
||||
SCREEN _NEWIMAGE(600, 600, 32)
|
||||
|
||||
DECLARE LIBRARY
|
||||
SUB gluLookAt (BYVAL eyeX#, BYVAL eyeY#, BYVAL eyeZ#, BYVAL centerX#, BYVAL centerY#, BYVAL centerZ#, BYVAL upX#, BYVAL upY#, BYVAL upZ#)
|
||||
END DECLARE
|
||||
|
||||
' Types.
|
||||
TYPE rgb
|
||||
r AS SINGLE
|
||||
g AS SINGLE
|
||||
b AS SINGLE
|
||||
END TYPE
|
||||
|
||||
' Master switch for SUB _GL().
|
||||
DIM SHARED glAllow AS INTEGER
|
||||
|
||||
' Plot structure.
|
||||
DIM SHARED mainEquation AS STRING
|
||||
DIM SHARED shadeMap(100, 100) AS rgb
|
||||
DIM SHARED vert(100, 100)
|
||||
|
||||
' Plot settings.
|
||||
DIM SHARED stepFactor AS DOUBLE
|
||||
DIM SHARED zStretch AS DOUBLE
|
||||
|
||||
' Camera settings.
|
||||
DIM SHARED xRot AS DOUBLE
|
||||
DIM SHARED yRot AS DOUBLE
|
||||
DIM SHARED zoomFactor
|
||||
|
||||
' Render settings.
|
||||
DIM SHARED graph_render_mode
|
||||
|
||||
' Initialize.
|
||||
CALL setShades
|
||||
stepFactor = .1
|
||||
zStretch = 5
|
||||
zoomFactor = 1.0
|
||||
mainEquation = "sin((x^2)-(y^2))"
|
||||
|
||||
IF (COMMAND$ <> "") THEN
|
||||
OPEN COMMAND$ FOR INPUT AS #1
|
||||
INPUT #1, mainEquation
|
||||
CLOSE #1
|
||||
ELSE
|
||||
CALL getEquation
|
||||
END IF
|
||||
|
||||
' Prime main loop.
|
||||
CALL initSequence
|
||||
|
||||
' Main loop.
|
||||
DO
|
||||
CALL mouseProcess
|
||||
IF (glAllow = 0) THEN
|
||||
CALL getEquation
|
||||
CALL initSequence
|
||||
END IF
|
||||
CALL keyProcess
|
||||
_LIMIT 60
|
||||
LOOP
|
||||
|
||||
END
|
||||
|
||||
SUB _GL () STATIC
|
||||
IF (glAllow = 0) THEN EXIT SUB
|
||||
|
||||
DIM x AS INTEGER
|
||||
DIM z AS INTEGER
|
||||
|
||||
' Environment.
|
||||
_glClear _GL_COLOR_BUFFER_BIT OR _GL_DEPTH_BUFFER_BIT
|
||||
_glEnable _GL_DEPTH_TEST
|
||||
_glEnable _GL_BLEND
|
||||
_glMatrixMode _GL_PROJECTION
|
||||
|
||||
_gluPerspective 50, 1, 0.1, 40
|
||||
_glMatrixMode _GL_MODELVIEW
|
||||
|
||||
_glLoadIdentity
|
||||
|
||||
gluLookAt 0, 7, 15, 0, 0, 0, 0, 1, 0
|
||||
|
||||
' Set camera angle.
|
||||
_glRotatef xRot, 1, 0, 0
|
||||
_glRotatef yRot, 0, 1, 0
|
||||
|
||||
' Set camera zoom.
|
||||
_glScalef zoomFactor, zoomFactor, zoomFactor
|
||||
|
||||
' Draw axes.
|
||||
_glBegin _GL_LINES
|
||||
_glLineWidth 2.0
|
||||
' x-axis
|
||||
_glColor3f 1, 0, 0
|
||||
_glVertex3f -5, 0, 0
|
||||
_glVertex3f 5, 0, 0
|
||||
' z-axis
|
||||
_glColor3f 0, 1, 0
|
||||
_glVertex3f 0, -5, 0
|
||||
_glVertex3f 0, 5, 0
|
||||
' y-axis
|
||||
_glColor3f 0, 0, 1
|
||||
_glVertex3f 0, 0, -5
|
||||
_glVertex3f 0, 0, 5
|
||||
_glEnd
|
||||
|
||||
' Draw the surface.
|
||||
FOR z = -50 TO 49
|
||||
FOR x = -50 TO 49
|
||||
|
||||
' Each square patch is really two triangles.
|
||||
|
||||
IF (graph_render_mode = 1) THEN _glBegin _GL_TRIANGLE_STRIP ELSE _glBegin _GL_LINE_STRIP
|
||||
_glColor4f shadeMap(x + 50, z + 50).r, shadeMap(x + 50, z + 50).g, shadeMap(x + 50, z + 50).b, 0.7
|
||||
_glLineWidth 1.0
|
||||
_glVertex3f x, vert(x + 50, z + 50), z
|
||||
_glVertex3f x + 1, vert(x + 51, z + 50), z
|
||||
_glVertex3f x, vert(x + 50, z + 51), z + 1
|
||||
_glEnd
|
||||
|
||||
IF (graph_render_mode = 1) THEN _glBegin _GL_TRIANGLE_STRIP ELSE _glBegin _GL_LINE_STRIP
|
||||
_glColor4f shadeMap(x + 50, z + 50).r, shadeMap(x + 50, z + 50).g, shadeMap(x + 50, z + 50).b, 0.7
|
||||
_glLineWidth 1.0
|
||||
_glVertex3f x + 1, vert(x + 51, z + 51), z + 1
|
||||
_glVertex3f x + 1, vert(x + 51, z + 50), z
|
||||
_glVertex3f x, vert(x + 50, z + 51), z + 1
|
||||
_glEnd
|
||||
|
||||
NEXT
|
||||
NEXT
|
||||
|
||||
END SUB
|
||||
|
||||
'By Fellipe Heitor
|
||||
FUNCTION INPUTBOX (tTitle$, tMessage$, InitialValue AS STRING, NewValue AS STRING, Selected)
|
||||
'INPUTBOX ---------------------------------------------------------------------
|
||||
'Show a dialog and allow user input. Returns 1 = OK or 2 = Cancel. '
|
||||
' '
|
||||
'- tTitle$ is the desired dialog title. If not provided, it'll be "Input" '
|
||||
' '
|
||||
'- tMessage$ is the prompt that'll be shown to the user. You can show '
|
||||
' a multiline message by adding line breaks with CHR$(10). '
|
||||
' '
|
||||
' - InitialValue can be passed both as a string literal or as a variable. '
|
||||
' '
|
||||
'- Actual user input is returned by altering NewValue, so it must be '
|
||||
' passed as a variable. '
|
||||
' '
|
||||
'- Selected indicates wheter the initial value will be preselected when the '
|
||||
' dialog is first shown. -1 preselects the whole text; positive values '
|
||||
' select only part of the initial value (from the character position passed '
|
||||
' to the end of the initial value). '
|
||||
' '
|
||||
'Intended for use with 32-bit screen modes. '
|
||||
'------------------------------------------------------------------------------
|
||||
|
||||
'Variable declaration:
|
||||
DIM Message$, Title$, CharW AS INTEGER, MaxLen AS INTEGER
|
||||
DIM lineBreak AS INTEGER, totalLines AS INTEGER, prevlinebreak AS INTEGER
|
||||
DIM Cursor AS INTEGER, Selection.Start AS INTEGER, InputViewStart AS INTEGER
|
||||
DIM FieldArea AS INTEGER, DialogH AS INTEGER, DialogW AS INTEGER
|
||||
DIM DialogX AS INTEGER, DialogY AS INTEGER, InputField.X AS INTEGER
|
||||
DIM TotalButtons AS INTEGER, B AS INTEGER, ButtonLine$
|
||||
DIM cb AS INTEGER, DIALOGRESULT AS INTEGER, i AS INTEGER
|
||||
DIM message.X AS INTEGER, SetCursor#, cursorBlink%
|
||||
DIM DefaultButton AS INTEGER, k AS LONG
|
||||
DIM shiftDown AS _BYTE, ctrlDown AS _BYTE, Clip$
|
||||
DIM FindLF%, s1 AS INTEGER, s2 AS INTEGER
|
||||
DIM Selection.Value$
|
||||
DIM prevCursor AS INTEGER, ss1 AS INTEGER, ss2 AS INTEGER, mb AS _BYTE
|
||||
DIM mx AS INTEGER, my AS INTEGER, nmx AS INTEGER, nmy AS INTEGER
|
||||
DIM FGColor AS LONG, BGColor AS LONG
|
||||
|
||||
'Data type used for the dialog buttons:
|
||||
TYPE BUTTONSTYPE
|
||||
ID AS LONG
|
||||
CAPTION AS STRING * 120
|
||||
X AS INTEGER
|
||||
Y AS INTEGER
|
||||
W AS INTEGER
|
||||
END TYPE
|
||||
|
||||
'Color constants. You can customize colors by changing these:
|
||||
CONST TitleBarColor = _RGB32(0, 178, 179)
|
||||
CONST DialogBGColor = _RGB32(255, 255, 255)
|
||||
CONST TitleBarTextColor = _RGB32(0, 0, 0)
|
||||
CONST DialogTextColor = _RGB32(0, 0, 0)
|
||||
CONST InputFieldColor = _RGB32(200, 200, 200)
|
||||
CONST InputFieldTextColor = _RGB32(0, 0, 0)
|
||||
CONST SelectionColor = _RGBA32(127, 127, 127, 100)
|
||||
|
||||
'Initial variable setup:
|
||||
Message$ = tMessage$
|
||||
Title$ = RTRIM$(LTRIM$(tTitle$))
|
||||
IF Title$ = "" THEN Title$ = "Input"
|
||||
NewValue = RTRIM$(LTRIM$(InitialValue))
|
||||
DefaultButton = 1
|
||||
|
||||
'Save the current drawing page so it can be restored later:
|
||||
FGColor = _DEFAULTCOLOR
|
||||
BGColor = _BACKGROUNDCOLOR
|
||||
PCOPY 0, 1
|
||||
|
||||
'Figure out the print width of a single character (in case user has a custom font applied)
|
||||
CharW = _PRINTWIDTH("_")
|
||||
|
||||
'Place a color overlay over the old screen image so the focus is on the dialog:
|
||||
LINE (0, 0)-STEP(_WIDTH - 1, _HEIGHT - 1), _RGBA32(170, 170, 170, 170), BF
|
||||
|
||||
'Message breakdown, in case CHR$(10) was used as line break:
|
||||
REDIM MessageLines(1) AS STRING
|
||||
MaxLen = 1
|
||||
DO
|
||||
lineBreak = INSTR(lineBreak + 1, Message$, CHR$(10))
|
||||
IF lineBreak = 0 AND totalLines = 0 THEN
|
||||
totalLines = 1
|
||||
MessageLines(1) = Message$
|
||||
MaxLen = LEN(Message$)
|
||||
EXIT DO
|
||||
ELSEIF lineBreak = 0 AND totalLines > 0 THEN
|
||||
totalLines = totalLines + 1
|
||||
REDIM _PRESERVE MessageLines(1 TO totalLines) AS STRING
|
||||
MessageLines(totalLines) = RIGHT$(Message$, LEN(Message$) - prevlinebreak + 1)
|
||||
IF LEN(MessageLines(totalLines)) > MaxLen THEN MaxLen = LEN(MessageLines(totalLines))
|
||||
EXIT DO
|
||||
END IF
|
||||
IF totalLines = 0 THEN prevlinebreak = 1
|
||||
totalLines = totalLines + 1
|
||||
REDIM _PRESERVE MessageLines(1 TO totalLines) AS STRING
|
||||
MessageLines(totalLines) = MID$(Message$, prevlinebreak, lineBreak - prevlinebreak)
|
||||
IF LEN(MessageLines(totalLines)) > MaxLen THEN MaxLen = LEN(MessageLines(totalLines))
|
||||
prevlinebreak = lineBreak + 1
|
||||
LOOP
|
||||
|
||||
Cursor = LEN(NewValue)
|
||||
Selection.Start = 0
|
||||
InputViewStart = 1
|
||||
FieldArea = _WIDTH \ CharW - 4
|
||||
IF FieldArea > 62 THEN FieldArea = 62
|
||||
IF Selected > 0 THEN Selection.Start = Selected: Selected = -1
|
||||
|
||||
'Calculate dialog dimensions and print coordinates:
|
||||
DialogH = _FONTHEIGHT * (6 + totalLines) + 10
|
||||
DialogW = (CharW * FieldArea) + 10
|
||||
IF DialogW < MaxLen * CharW + 10 THEN DialogW = MaxLen * CharW + 10
|
||||
|
||||
DialogX = _WIDTH / 2 - DialogW / 2
|
||||
DialogY = _HEIGHT / 2 - DialogH / 2
|
||||
InputField.X = (DialogX + (DialogW / 2)) - (((FieldArea * CharW) - 10) / 2) - 4
|
||||
|
||||
'Calculate button's print coordinates:
|
||||
TotalButtons = 2
|
||||
DIM Buttons(1 TO TotalButtons) AS BUTTONSTYPE
|
||||
B = 1
|
||||
Buttons(B).ID = 1: Buttons(B).CAPTION = "< OK >": B = B + 1
|
||||
Buttons(B).ID = 2: Buttons(B).CAPTION = "< Cancel >": B = B + 1
|
||||
ButtonLine$ = " "
|
||||
FOR cb = 1 TO TotalButtons
|
||||
ButtonLine$ = ButtonLine$ + RTRIM$(LTRIM$(Buttons(cb).CAPTION)) + " "
|
||||
Buttons(cb).Y = DialogY + 5 + _FONTHEIGHT * (5 + totalLines)
|
||||
Buttons(cb).W = _PRINTWIDTH(RTRIM$(LTRIM$(Buttons(cb).CAPTION)))
|
||||
NEXT cb
|
||||
Buttons(1).X = _WIDTH / 2 - _PRINTWIDTH(ButtonLine$) / 2
|
||||
FOR cb = 2 TO TotalButtons
|
||||
Buttons(cb).X = Buttons(1).X + _PRINTWIDTH(SPACE$(INSTR(ButtonLine$, RTRIM$(LTRIM$(Buttons(cb).CAPTION)))))
|
||||
NEXT cb
|
||||
|
||||
'Main loop:
|
||||
DIALOGRESULT = 0
|
||||
_KEYCLEAR
|
||||
DO: _LIMIT 500
|
||||
'Draw the dialog.
|
||||
LINE (DialogX, DialogY)-STEP(DialogW - 1, DialogH - 1), DialogBGColor, BF
|
||||
LINE (DialogX, DialogY)-STEP(DialogW - 1, _FONTHEIGHT + 1), TitleBarColor, BF
|
||||
COLOR TitleBarTextColor
|
||||
_PRINTSTRING (_WIDTH / 2 - _PRINTWIDTH(Title$) / 2, DialogY + 1), Title$
|
||||
|
||||
COLOR DialogTextColor, _RGBA32(0, 0, 0, 0)
|
||||
FOR i = 1 TO totalLines
|
||||
message.X = _WIDTH / 2 - _PRINTWIDTH(MessageLines(i)) / 2
|
||||
_PRINTSTRING (message.X, DialogY + 5 + _FONTHEIGHT * (i + 1)), MessageLines(i)
|
||||
NEXT i
|
||||
|
||||
'Draw the input field
|
||||
LINE (InputField.X - 2, DialogY + 3 + _FONTHEIGHT * (3 + totalLines))-STEP(FieldArea * CharW, _FONTHEIGHT + 4), InputFieldColor, BF
|
||||
COLOR InputFieldTextColor
|
||||
_PRINTSTRING (InputField.X, DialogY + 5 + _FONTHEIGHT * (3 + totalLines)), MID$(NewValue, InputViewStart, FieldArea)
|
||||
|
||||
'Selection highlight:
|
||||
GOSUB SelectionHighlight
|
||||
|
||||
'Cursor blink:
|
||||
IF TIMER - SetCursor# > .4 THEN
|
||||
SetCursor# = TIMER
|
||||
IF cursorBlink% = 1 THEN cursorBlink% = 0 ELSE cursorBlink% = 1
|
||||
END IF
|
||||
IF cursorBlink% = 1 THEN
|
||||
LINE (InputField.X + (Cursor - (InputViewStart - 1)) * CharW, DialogY + 5 + _FONTHEIGHT * (3 + totalLines))-STEP(0, _FONTHEIGHT), _RGB32(0, 0, 0)
|
||||
END IF
|
||||
|
||||
'Check if buttons have been clicked or are being hovered:
|
||||
GOSUB CheckButtons
|
||||
|
||||
'Draw buttons:
|
||||
FOR cb = 1 TO TotalButtons
|
||||
_PRINTSTRING (Buttons(cb).X, Buttons(cb).Y), RTRIM$(LTRIM$(Buttons(cb).CAPTION))
|
||||
IF cb = DefaultButton THEN
|
||||
COLOR _RGB32(255, 255, 0)
|
||||
_PRINTSTRING (Buttons(cb).X, Buttons(cb).Y), "<" + SPACE$(LEN(RTRIM$(LTRIM$(Buttons(cb).CAPTION))) - 2) + ">"
|
||||
COLOR _RGB32(0, 178, 179)
|
||||
_PRINTSTRING (Buttons(cb).X - 1, Buttons(cb).Y - 1), "<" + SPACE$(LEN(RTRIM$(LTRIM$(Buttons(cb).CAPTION))) - 2) + ">"
|
||||
COLOR _RGB32(0, 0, 0)
|
||||
END IF
|
||||
NEXT cb
|
||||
|
||||
_DISPLAY
|
||||
|
||||
'Process input:
|
||||
k = _KEYHIT
|
||||
IF k = 100303 OR k = 100304 THEN shiftDown = -1
|
||||
IF k = -100303 OR k = -100304 THEN shiftDown = 0
|
||||
IF k = 100305 OR k = 100306 THEN ctrlDown = -1
|
||||
IF k = -100305 OR k = -100306 THEN ctrlDown = 0
|
||||
|
||||
SELECT CASE k
|
||||
CASE 13: DIALOGRESULT = 1
|
||||
CASE 27: DIALOGRESULT = 2
|
||||
CASE 32 TO 126 'Printable ASCII characters
|
||||
IF k = ASC("v") OR k = ASC("V") THEN 'Paste from clipboard (Ctrl+V)
|
||||
IF ctrlDown THEN
|
||||
Clip$ = _CLIPBOARD$
|
||||
FindLF% = INSTR(Clip$, CHR$(13))
|
||||
IF FindLF% > 0 THEN Clip$ = LEFT$(Clip$, FindLF% - 1)
|
||||
FindLF% = INSTR(Clip$, CHR$(10))
|
||||
IF FindLF% > 0 THEN Clip$ = LEFT$(Clip$, FindLF% - 1)
|
||||
IF LEN(RTRIM$(LTRIM$(Clip$))) > 0 THEN
|
||||
IF NOT Selected THEN
|
||||
IF Cursor = LEN(NewValue) THEN
|
||||
NewValue = NewValue + Clip$
|
||||
Cursor = LEN(NewValue)
|
||||
ELSE
|
||||
NewValue = LEFT$(NewValue, Cursor) + Clip$ + MID$(NewValue, Cursor + 1)
|
||||
Cursor = Cursor + LEN(Clip$)
|
||||
END IF
|
||||
ELSE
|
||||
s1 = Selection.Start
|
||||
s2 = Cursor
|
||||
IF s1 > s2 THEN SWAP s1, s2
|
||||
NewValue = LEFT$(NewValue, s1) + Clip$ + MID$(NewValue, s2 + 1)
|
||||
Cursor = s1 + LEN(Clip$)
|
||||
Selected = 0
|
||||
END IF
|
||||
END IF
|
||||
k = 0
|
||||
END IF
|
||||
ELSEIF k = ASC("c") OR k = ASC("C") THEN 'Copy selection to clipboard (Ctrl+C)
|
||||
IF ctrlDown THEN
|
||||
_CLIPBOARD$ = Selection.Value$
|
||||
k = 0
|
||||
END IF
|
||||
ELSEIF k = ASC("x") OR k = ASC("X") THEN 'Cut selection to clipboard (Ctrl+X)
|
||||
IF ctrlDown THEN
|
||||
_CLIPBOARD$ = Selection.Value$
|
||||
GOSUB DeleteSelection
|
||||
k = 0
|
||||
END IF
|
||||
ELSEIF k = ASC("a") OR k = ASC("A") THEN 'Select all text (Ctrl+A)
|
||||
IF ctrlDown THEN
|
||||
Cursor = LEN(NewValue)
|
||||
Selection.Start = 0
|
||||
Selected = -1
|
||||
k = 0
|
||||
END IF
|
||||
END IF
|
||||
|
||||
IF k > 0 THEN
|
||||
IF NOT Selected THEN
|
||||
IF Cursor = LEN(NewValue) THEN
|
||||
NewValue = NewValue + CHR$(k)
|
||||
Cursor = Cursor + 1
|
||||
ELSE
|
||||
NewValue = LEFT$(NewValue, Cursor) + CHR$(k) + MID$(NewValue, Cursor + 1)
|
||||
Cursor = Cursor + 1
|
||||
END IF
|
||||
IF Cursor > FieldArea THEN InputViewStart = (Cursor - FieldArea) + 2
|
||||
ELSE
|
||||
s1 = Selection.Start
|
||||
s2 = Cursor
|
||||
IF s1 > s2 THEN SWAP s1, s2
|
||||
NewValue = LEFT$(NewValue, s1) + CHR$(k) + MID$(NewValue, s2 + 1)
|
||||
Selected = 0
|
||||
Cursor = s1 + 1
|
||||
END IF
|
||||
END IF
|
||||
CASE 8 'Backspace
|
||||
IF LEN(NewValue) > 0 THEN
|
||||
IF NOT Selected THEN
|
||||
IF Cursor = LEN(NewValue) THEN
|
||||
NewValue = LEFT$(NewValue, LEN(NewValue) - 1)
|
||||
Cursor = Cursor - 1
|
||||
ELSEIF Cursor > 1 THEN
|
||||
NewValue = LEFT$(NewValue, Cursor - 1) + MID$(NewValue, Cursor + 1)
|
||||
Cursor = Cursor - 1
|
||||
ELSEIF Cursor = 1 THEN
|
||||
NewValue = RIGHT$(NewValue, LEN(NewValue) - 1)
|
||||
Cursor = Cursor - 1
|
||||
END IF
|
||||
ELSE
|
||||
GOSUB DeleteSelection
|
||||
END IF
|
||||
END IF
|
||||
CASE 21248 'Delete
|
||||
IF NOT Selected THEN
|
||||
IF LEN(NewValue) > 0 THEN
|
||||
IF Cursor = 0 THEN
|
||||
NewValue = RIGHT$(NewValue, LEN(NewValue) - 1)
|
||||
ELSEIF Cursor > 0 AND Cursor <= LEN(NewValue) - 1 THEN
|
||||
NewValue = LEFT$(NewValue, Cursor) + MID$(NewValue, Cursor + 2)
|
||||
END IF
|
||||
END IF
|
||||
ELSE
|
||||
GOSUB DeleteSelection
|
||||
END IF
|
||||
CASE 19200 'Left arrow key
|
||||
GOSUB CheckSelection
|
||||
IF Cursor > 0 THEN Cursor = Cursor - 1
|
||||
CASE 19712 'Right arrow key
|
||||
GOSUB CheckSelection
|
||||
IF Cursor < LEN(NewValue) THEN Cursor = Cursor + 1
|
||||
CASE 18176 'Home
|
||||
GOSUB CheckSelection
|
||||
Cursor = 0
|
||||
CASE 20224 'End
|
||||
GOSUB CheckSelection
|
||||
Cursor = LEN(NewValue)
|
||||
END SELECT
|
||||
|
||||
'Cursor adjustments:
|
||||
GOSUB CursorAdjustments
|
||||
LOOP UNTIL DIALOGRESULT > 0
|
||||
|
||||
_KEYCLEAR
|
||||
INPUTBOX = DIALOGRESULT
|
||||
|
||||
'Restore previous display:
|
||||
PCOPY 1, 0
|
||||
COLOR FGColor, BGColor
|
||||
EXIT SUB
|
||||
|
||||
CursorAdjustments:
|
||||
IF Cursor > prevCursor THEN
|
||||
IF Cursor - InputViewStart + 2 > FieldArea THEN InputViewStart = (Cursor - FieldArea) + 2
|
||||
ELSEIF Cursor < prevCursor THEN
|
||||
IF Cursor < InputViewStart - 1 THEN InputViewStart = Cursor
|
||||
END IF
|
||||
prevCursor = Cursor
|
||||
IF InputViewStart < 1 THEN InputViewStart = 1
|
||||
RETURN
|
||||
|
||||
CheckSelection:
|
||||
IF shiftDown = -1 THEN
|
||||
IF Selected = 0 THEN
|
||||
Selected = -1
|
||||
Selection.Start = Cursor
|
||||
END IF
|
||||
ELSEIF shiftDown = 0 THEN
|
||||
Selected = 0
|
||||
END IF
|
||||
RETURN
|
||||
|
||||
DeleteSelection:
|
||||
NewValue = LEFT$(NewValue, s1) + MID$(NewValue, s2 + 1)
|
||||
Selected = 0
|
||||
Cursor = s1
|
||||
RETURN
|
||||
|
||||
SelectionHighlight:
|
||||
IF Selected THEN
|
||||
s1 = Selection.Start
|
||||
s2 = Cursor
|
||||
IF s1 > s2 THEN
|
||||
SWAP s1, s2
|
||||
IF InputViewStart > 1 THEN
|
||||
ss1 = s1 - InputViewStart + 1
|
||||
ELSE
|
||||
ss1 = s1
|
||||
END IF
|
||||
ss2 = s2 - s1
|
||||
IF ss1 + ss2 > FieldArea THEN ss2 = FieldArea - ss1
|
||||
ELSE
|
||||
ss1 = s1
|
||||
ss2 = s2 - s1
|
||||
IF ss1 < InputViewStart THEN ss1 = 0: ss2 = s2 - InputViewStart + 1
|
||||
IF ss1 > InputViewStart THEN ss1 = ss1 - InputViewStart + 1: ss2 = s2 - s1
|
||||
END IF
|
||||
Selection.Value$ = MID$(NewValue, s1 + 1, s2 - s1)
|
||||
|
||||
LINE (InputField.X + ss1 * CharW, DialogY + 5 + _FONTHEIGHT * (3 + totalLines))-STEP(ss2 * CharW, _FONTHEIGHT), _RGBA32(255, 255, 255, 150), BF
|
||||
END IF
|
||||
RETURN
|
||||
|
||||
CheckButtons:
|
||||
'Hover highlight:
|
||||
WHILE _MOUSEINPUT: WEND
|
||||
mb = _MOUSEBUTTON(1): mx = _MOUSEX: my = _MOUSEY
|
||||
FOR cb = 1 TO TotalButtons
|
||||
IF (mx >= Buttons(cb).X) AND (mx <= Buttons(cb).X + Buttons(cb).W) THEN
|
||||
IF (my >= Buttons(cb).Y) AND (my < Buttons(cb).Y + _FONTHEIGHT) THEN
|
||||
LINE (Buttons(cb).X, Buttons(cb).Y)-STEP(Buttons(cb).W, _FONTHEIGHT - 1), _RGBA32(230, 230, 230, 235), BF
|
||||
END IF
|
||||
END IF
|
||||
NEXT cb
|
||||
|
||||
IF mb THEN
|
||||
IF mx >= InputField.X AND my >= DialogY + 3 + _FONTHEIGHT * (3 + totalLines) AND mx <= InputField.X + (FieldArea * CharW - 10) AND my <= DialogY + 3 + _FONTHEIGHT * (3 + totalLines) + _FONTHEIGHT + 4 THEN
|
||||
'Clicking inside the text field positions the cursor
|
||||
WHILE _MOUSEBUTTON(1)
|
||||
_LIMIT 500
|
||||
mb = _MOUSEINPUT
|
||||
WEND
|
||||
Cursor = ((mx - InputField.X) / CharW) + (InputViewStart - 1)
|
||||
IF Cursor > LEN(NewValue) THEN Cursor = LEN(NewValue)
|
||||
Selected = 0
|
||||
RETURN
|
||||
END IF
|
||||
|
||||
FOR cb = 1 TO TotalButtons
|
||||
IF (mx >= Buttons(cb).X) AND (mx <= Buttons(cb).X + Buttons(cb).W) THEN
|
||||
IF (my >= Buttons(cb).Y) AND (my < Buttons(cb).Y + _FONTHEIGHT) THEN
|
||||
DefaultButton = cb
|
||||
WHILE _MOUSEBUTTON(1): _LIMIT 500: mb = _MOUSEINPUT: WEND
|
||||
mb = 0: nmx = _MOUSEX: nmy = _MOUSEY
|
||||
IF nmx = mx AND nmy = my THEN DIALOGRESULT = cb
|
||||
RETURN
|
||||
END IF
|
||||
END IF
|
||||
NEXT cb
|
||||
END IF
|
||||
RETURN
|
||||
END FUNCTION
|
||||
|
||||
FUNCTION hsb~& (__H AS _FLOAT, __S AS _FLOAT, __B AS _FLOAT, A AS _FLOAT)
|
||||
'method adapted form http://stackoverflow.com/questions/4106363/converting-rgb-to-hsb-colors
|
||||
DIM H AS _FLOAT, S AS _FLOAT, B AS _FLOAT
|
||||
|
||||
H = map(__H, 0, 255, 0, 360)
|
||||
S = map(__S, 0, 255, 0, 1)
|
||||
B = map(__B, 0, 255, 0, 1)
|
||||
|
||||
IF S = 0 THEN
|
||||
hsb~& = _RGBA32(B * 255, B * 255, B * 255, A)
|
||||
EXIT FUNCTION
|
||||
END IF
|
||||
|
||||
DIM fmx AS _FLOAT, fmn AS _FLOAT
|
||||
DIM fmd AS _FLOAT, iSextant AS INTEGER
|
||||
DIM imx AS INTEGER, imd AS INTEGER, imn AS INTEGER
|
||||
|
||||
IF B > .5 THEN
|
||||
fmx = B - (B * S) + S
|
||||
fmn = B + (B * S) - S
|
||||
ELSE
|
||||
fmx = B + (B * S)
|
||||
fmn = B - (B * S)
|
||||
END IF
|
||||
|
||||
iSextant = INT(H / 60)
|
||||
|
||||
IF H >= 300 THEN
|
||||
H = H - 360
|
||||
END IF
|
||||
|
||||
H = H / 60
|
||||
H = H - (2 * INT(((iSextant + 1) MOD 6) / 2))
|
||||
|
||||
IF iSextant MOD 2 = 0 THEN
|
||||
fmd = (H * (fmx - fmn)) + fmn
|
||||
ELSE
|
||||
fmd = fmn - (H * (fmx - fmn))
|
||||
END IF
|
||||
|
||||
imx = _ROUND(fmx * 255)
|
||||
imd = _ROUND(fmd * 255)
|
||||
imn = _ROUND(fmn * 255)
|
||||
|
||||
SELECT CASE INT(iSextant)
|
||||
CASE 1
|
||||
hsb~& = _RGBA32(imd, imx, imn, A)
|
||||
CASE 2
|
||||
hsb~& = _RGBA32(imn, imx, imd, A)
|
||||
CASE 3
|
||||
hsb~& = _RGBA32(imn, imd, imx, A)
|
||||
CASE 4
|
||||
hsb~& = _RGBA32(imd, imn, imx, A)
|
||||
CASE 5
|
||||
hsb~& = _RGBA32(imx, imn, imd, A)
|
||||
CASE ELSE
|
||||
hsb~& = _RGBA32(imx, imd, imn, A)
|
||||
END SELECT
|
||||
END FUNCTION
|
||||
|
||||
SUB getEquation
|
||||
DIM inputStatus AS INTEGER
|
||||
CLS
|
||||
inputStatus = INPUTBOX("Equation Editor", "Enter the expression for z = (ex. x*y)", mainEquation, mainEquation, -1)
|
||||
IF (inputStatus = 2) THEN END
|
||||
END SUB
|
||||
|
||||
SUB initSequence
|
||||
CLS
|
||||
PRINT "Generating..."
|
||||
_DISPLAY
|
||||
CALL generatePlot(mainEquation)
|
||||
CLS , 1
|
||||
COLOR , 1
|
||||
PRINT "z = " + mainEquation
|
||||
_DISPLAY
|
||||
_GLRENDER _BEHIND
|
||||
graph_render_mode = 1 ' 1=solid surface, -1=lines
|
||||
glAllow = 1
|
||||
END SUB
|
||||
|
||||
SUB mouseProcess
|
||||
DIM x AS DOUBLE
|
||||
DIM y AS DOUBLE
|
||||
WHILE _MOUSEINPUT
|
||||
IF (zoomFactor > 0.1) THEN
|
||||
zoomFactor = zoomFactor + _MOUSEWHEEL * 0.05
|
||||
ELSE
|
||||
zoomFactor = 0.11
|
||||
END IF
|
||||
WEND
|
||||
IF (_MOUSEBUTTON(1)) THEN
|
||||
x = _MOUSEX
|
||||
y = _MOUSEY
|
||||
WHILE _MOUSEBUTTON(1)
|
||||
WHILE _MOUSEINPUT: WEND
|
||||
yRot = yRot + (_MOUSEX - x)
|
||||
xRot = xRot + (_MOUSEY - y)
|
||||
x = _MOUSEX
|
||||
y = _MOUSEY
|
||||
WEND
|
||||
END IF
|
||||
IF (_MOUSEBUTTON(2)) THEN
|
||||
glAllow = 0
|
||||
END IF
|
||||
END SUB
|
||||
|
||||
SUB keyProcess
|
||||
DIM k AS INTEGER
|
||||
k = _KEYHIT
|
||||
IF (k = ASC(" ")) THEN graph_render_mode = graph_render_mode * -1
|
||||
_KEYCLEAR
|
||||
END SUB
|
||||
|
||||
SUB generatePlot (TheExpression AS STRING)
|
||||
DIM x AS INTEGER
|
||||
DIM z AS INTEGER
|
||||
DIM i AS INTEGER
|
||||
DIM ca AS STRING
|
||||
DIM ex AS STRING
|
||||
FOR x = -50 TO 50
|
||||
FOR z = -50 TO 50
|
||||
ex = ""
|
||||
FOR i = 1 TO LEN(TheExpression)
|
||||
ca = MID$(TheExpression, i, 1)
|
||||
IF (LCASE$(ca) = "x") THEN ca = _TRIM$("(" + STR$(x * stepFactor) + ")")
|
||||
IF (LCASE$(ca) = "y") THEN ca = _TRIM$("(" + STR$(z * stepFactor) + ")")
|
||||
ex = ex + ca
|
||||
NEXT
|
||||
vert(x + 50, z + 50) = zStretch * VAL(SxriptEval(ex))
|
||||
NEXT
|
||||
NEXT
|
||||
END SUB
|
||||
|
||||
SUB setShades
|
||||
DIM x AS INTEGER
|
||||
DIM z AS INTEGER
|
||||
DIM c AS _UNSIGNED LONG
|
||||
FOR x = -50 TO 50
|
||||
FOR z = -50 TO 50
|
||||
c = hsb(map(z, -50, 50, 0, 255), 255, 128, 255)
|
||||
shadeMap(x + 50, z + 50).r = _RED(c) / 255
|
||||
shadeMap(x + 50, z + 50).g = _GREEN(c) / 255
|
||||
shadeMap(x + 50, z + 50).b = _BLUE(c) / 255
|
||||
NEXT
|
||||
NEXT
|
||||
END SUB
|
||||
|
||||
FUNCTION map! (value!, minRange!, maxRange!, newMinRange!, newMaxRange!)
|
||||
map! = ((value! - minRange!) / (maxRange! - minRange!)) * (newMaxRange! - newMinRange!) + newMinRange!
|
||||
END FUNCTION
|
||||
|
||||
REM $INCLUDE: 'sxript.bm'
|
||||
REM $Include: 'sxmath.bm'
|
||||
770
samples/3d-grapher/src/3d-grapher---parametric.bas
Normal file
770
samples/3d-grapher/src/3d-grapher---parametric.bas
Normal file
|
|
@ -0,0 +1,770 @@
|
|||
'##############################################################################
|
||||
'3D Grapher in QB64 using OpenGL
|
||||
'
|
||||
'Contributors:
|
||||
' Ashish Kushwaha
|
||||
' FellipeHeitor
|
||||
' STxAxTIC
|
||||
'
|
||||
'See README.bm.
|
||||
|
||||
OPTION _EXPLICIT
|
||||
|
||||
REM $INCLUDE: 'sxript.bi'
|
||||
REM $Include: 'sxmath.bi'
|
||||
|
||||
DO UNTIL _SCREENEXISTS: LOOP
|
||||
_TITLE "3D Grapher"
|
||||
|
||||
_ACCEPTFILEDROP
|
||||
|
||||
SCREEN _NEWIMAGE(600, 600, 32)
|
||||
|
||||
DECLARE LIBRARY
|
||||
SUB gluLookAt (BYVAL eyeX#, BYVAL eyeY#, BYVAL eyeZ#, BYVAL centerX#, BYVAL centerY#, BYVAL centerZ#, BYVAL upX#, BYVAL upY#, BYVAL upZ#)
|
||||
END DECLARE
|
||||
|
||||
' Types.
|
||||
TYPE rgb
|
||||
r AS SINGLE
|
||||
g AS SINGLE
|
||||
b AS SINGLE
|
||||
END TYPE
|
||||
|
||||
TYPE vector
|
||||
x AS DOUBLE
|
||||
y AS DOUBLE
|
||||
z AS DOUBLE
|
||||
END TYPE
|
||||
|
||||
TYPE paraSpec
|
||||
p AS INTEGER
|
||||
i AS STRING
|
||||
x AS STRING
|
||||
y AS STRING
|
||||
z AS STRING
|
||||
END TYPE
|
||||
|
||||
' Master switch for SUB _GL().
|
||||
DIM SHARED glAllow AS INTEGER
|
||||
|
||||
' Plot structure.
|
||||
DIM SHARED mainEquation AS paraSpec
|
||||
DIM SHARED paraVert1(2500) AS vector
|
||||
DIM SHARED paraVert2(50, 50) AS vector
|
||||
DIM SHARED paraShade1(2500) AS rgb
|
||||
DIM SHARED paraShade2(50, 50) AS rgb
|
||||
|
||||
' Camera settings.
|
||||
DIM SHARED xRot AS DOUBLE
|
||||
DIM SHARED yRot AS DOUBLE
|
||||
DIM SHARED zoomFactor
|
||||
|
||||
' Render settings.
|
||||
DIM SHARED graph_render_mode
|
||||
|
||||
' Initialize.
|
||||
zoomFactor = 1.0
|
||||
CALL setShade
|
||||
|
||||
' Sphere
|
||||
mainEquation.p = 2
|
||||
mainEquation.i = "<let(theta,(3.14159/(50-1))*([u]-1)),let(phi,(2*3.14159/(50-1))*[v])>"
|
||||
mainEquation.x = "15 * sin([theta]) * cos([phi])"
|
||||
mainEquation.y = "15 * sin([theta]) * sin([phi])"
|
||||
mainEquation.z = "15 * cos([theta])"
|
||||
|
||||
IF (COMMAND$ <> "") THEN
|
||||
OPEN COMMAND$ FOR INPUT AS #1
|
||||
INPUT #1, mainEquation.p ' number of parameters
|
||||
LINE INPUT #1, mainEquation.i ' helper calcuations
|
||||
LINE INPUT #1, mainEquation.x ' x-equation
|
||||
LINE INPUT #1, mainEquation.y ' y-equation
|
||||
LINE INPUT #1, mainEquation.z ' z-equation
|
||||
CLOSE #1
|
||||
END IF
|
||||
|
||||
' Prime main loop.
|
||||
CALL initSequence
|
||||
|
||||
' Main loop.
|
||||
DO
|
||||
CALL mouseProcess
|
||||
CALL keyProcess
|
||||
CALL CheckFile
|
||||
_LIMIT 60
|
||||
LOOP
|
||||
|
||||
END
|
||||
|
||||
SUB _GL () STATIC
|
||||
IF (glAllow = 0) THEN EXIT SUB
|
||||
|
||||
' Environment.
|
||||
_glClear _GL_COLOR_BUFFER_BIT OR _GL_DEPTH_BUFFER_BIT
|
||||
_glEnable _GL_DEPTH_TEST
|
||||
_glEnable _GL_BLEND
|
||||
_glMatrixMode _GL_PROJECTION
|
||||
|
||||
_gluPerspective 50, 1, 0.1, 40
|
||||
_glMatrixMode _GL_MODELVIEW
|
||||
|
||||
_glLoadIdentity
|
||||
|
||||
gluLookAt 0, 7, 15, 0, 0, 0, 0, 1, 0
|
||||
|
||||
' Set camera angle.
|
||||
_glRotatef xRot, 1, 0, 0
|
||||
_glRotatef yRot, 0, 1, 0
|
||||
|
||||
' Set camera zoom.
|
||||
_glScalef zoomFactor, zoomFactor, zoomFactor
|
||||
|
||||
' Draw axes.
|
||||
_glBegin _GL_LINES
|
||||
_glLineWidth 2.0
|
||||
' x-axis
|
||||
_glColor3f 1, 0, 0
|
||||
_glVertex3f -5, 0, 0
|
||||
_glVertex3f 5, 0, 0
|
||||
' z-axis
|
||||
_glColor3f 0, 1, 0
|
||||
_glVertex3f 0, -5, 0
|
||||
_glVertex3f 0, 5, 0
|
||||
' y-axis
|
||||
_glColor3f 0, 0, 1
|
||||
_glVertex3f 0, 0, -5
|
||||
_glVertex3f 0, 0, 5
|
||||
_glEnd
|
||||
|
||||
' Draw the surface.
|
||||
DIM k1 AS INTEGER
|
||||
DIM k2 AS INTEGER
|
||||
IF (mainEquation.p = 1) THEN
|
||||
FOR k1 = 1 TO 2500 - 1
|
||||
_glBegin _GL_LINE_STRIP
|
||||
_glColor4f paraShade1(k1).r, paraShade1(k1).g, paraShade1(k1).b, 1
|
||||
_glLineWidth 1.0
|
||||
_glVertex3f paraVert1(k1).x, paraVert1(k1).z, paraVert1(k1).y
|
||||
_glVertex3f paraVert1(k1 + 1).x, paraVert1(k1 + 1).z, paraVert1(k1 + 1).y
|
||||
_glEnd
|
||||
NEXT
|
||||
END IF
|
||||
IF (mainEquation.p = 2) THEN
|
||||
FOR k1 = 1 TO 50 - 1
|
||||
FOR k2 = 1 TO 50 - 1
|
||||
IF (graph_render_mode = 1) THEN _glBegin _GL_TRIANGLE_STRIP ELSE _glBegin _GL_LINE_STRIP
|
||||
_glColor4f paraShade2(k1, k2).r, paraShade2(k1, k2).g, paraShade2(k1, k2).b, 1
|
||||
_glLineWidth 1.0
|
||||
_glVertex3f paraVert2(k1, k2).x, paraVert2(k1, k2).z, paraVert2(k1, k2).y
|
||||
_glVertex3f paraVert2(k1 + 1, k2).x, paraVert2(k1 + 1, k2).z, paraVert2(k1 + 1, k2).y
|
||||
_glVertex3f paraVert2(k1 + 1, k2 + 1).x, paraVert2(k1 + 1, k2 + 1).z, paraVert2(k1 + 1, k2 + 1).y
|
||||
_glEnd
|
||||
|
||||
IF (graph_render_mode = 1) THEN _glBegin _GL_TRIANGLE_STRIP ELSE _glBegin _GL_LINE_STRIP
|
||||
_glColor4f paraShade2(k1, k2).r, paraShade2(k1, k2).g, paraShade2(k1, k2).b, 1
|
||||
_glLineWidth 1.0
|
||||
_glVertex3f paraVert2(k1, k2).x, paraVert2(k1, k2).z, paraVert2(k1, k2).y
|
||||
_glVertex3f paraVert2(k1, k2 + 1).x, paraVert2(k1, k2 + 1).z, paraVert2(k1, k2 + 1).y
|
||||
_glVertex3f paraVert2(k1 + 1, k2 + 1).x, paraVert2(k1 + 1, k2 + 1).z, paraVert2(k1 + 1, k2 + 1).y
|
||||
_glEnd
|
||||
NEXT
|
||||
NEXT
|
||||
END IF
|
||||
END SUB
|
||||
|
||||
SUB initSequence
|
||||
CLS
|
||||
PRINT "Generating..."
|
||||
_DISPLAY
|
||||
CALL generatePlot
|
||||
CLS , 1
|
||||
COLOR , 1
|
||||
'PRINT "(params) = " + mainEquation.i
|
||||
PRINT "x = " + mainEquation.x
|
||||
PRINT "y = " + mainEquation.y
|
||||
PRINT "z = " + mainEquation.z
|
||||
_DISPLAY
|
||||
_GLRENDER _BEHIND
|
||||
graph_render_mode = -1 ' 1=solid surface, -1=lines
|
||||
glAllow = 1
|
||||
END SUB
|
||||
|
||||
SUB mouseProcess
|
||||
DIM x AS DOUBLE
|
||||
DIM y AS DOUBLE
|
||||
WHILE _MOUSEINPUT
|
||||
IF (zoomFactor > 0.1) THEN
|
||||
zoomFactor = zoomFactor + _MOUSEWHEEL * 0.05
|
||||
ELSE
|
||||
zoomFactor = 0.11
|
||||
END IF
|
||||
WEND
|
||||
IF (_MOUSEBUTTON(1)) THEN
|
||||
x = _MOUSEX
|
||||
y = _MOUSEY
|
||||
WHILE _MOUSEBUTTON(1)
|
||||
WHILE _MOUSEINPUT: WEND
|
||||
yRot = yRot + (_MOUSEX - x)
|
||||
xRot = xRot + (_MOUSEY - y)
|
||||
x = _MOUSEX
|
||||
y = _MOUSEY
|
||||
WEND
|
||||
END IF
|
||||
END SUB
|
||||
|
||||
SUB keyProcess
|
||||
DIM k AS INTEGER
|
||||
k = _KEYHIT
|
||||
IF (k = ASC(" ")) THEN graph_render_mode = graph_render_mode * -1
|
||||
_KEYCLEAR
|
||||
END SUB
|
||||
|
||||
SUB CheckFile
|
||||
DIM theFile AS STRING
|
||||
IF (_TOTALDROPPEDFILES > 0) THEN
|
||||
IF (_FILEEXISTS(_DROPPEDFILE$(1))) THEN
|
||||
glAllow = 0
|
||||
theFile = _DROPPEDFILE$(1)
|
||||
OPEN theFile FOR INPUT AS #1
|
||||
INPUT #1, mainEquation.p
|
||||
LINE INPUT #1, mainEquation.i
|
||||
LINE INPUT #1, mainEquation.x
|
||||
LINE INPUT #1, mainEquation.y
|
||||
LINE INPUT #1, mainEquation.z
|
||||
CLOSE #1
|
||||
CALL initSequence
|
||||
glAllow = 1
|
||||
END IF
|
||||
_FINISHDROP
|
||||
END IF
|
||||
END SUB
|
||||
|
||||
SUB generatePlot
|
||||
DIM a AS STRING
|
||||
DIM k1 AS INTEGER
|
||||
DIM k2 AS INTEGER
|
||||
IF (mainEquation.p = 1) THEN
|
||||
FOR k1 = 1 TO 2500
|
||||
a = SxriptEval$("let(u," + STR$(k1) + ")")
|
||||
a = SxriptEval$(mainEquation.i)
|
||||
paraVert1(k1).x = VAL(SxriptEval$(mainEquation.x))
|
||||
paraVert1(k1).y = VAL(SxriptEval$(mainEquation.y))
|
||||
paraVert1(k1).z = VAL(SxriptEval$(mainEquation.z))
|
||||
NEXT
|
||||
END IF
|
||||
IF (mainEquation.p = 2) THEN
|
||||
FOR k1 = 1 TO 50
|
||||
FOR k2 = 1 TO 50
|
||||
a = SxriptEval$("let(u," + STR$(k1) + ")")
|
||||
a = SxriptEval$("let(v," + STR$(k2) + ")")
|
||||
a = SxriptEval$(mainEquation.i)
|
||||
paraVert2(k1, k2).x = VAL(SxriptEval$(mainEquation.x))
|
||||
paraVert2(k1, k2).y = VAL(SxriptEval$(mainEquation.y))
|
||||
paraVert2(k1, k2).z = VAL(SxriptEval$(mainEquation.z))
|
||||
NEXT
|
||||
NEXT
|
||||
END IF
|
||||
END SUB
|
||||
|
||||
SUB setShade
|
||||
DIM k1 AS INTEGER
|
||||
DIM k2 AS INTEGER
|
||||
FOR k1 = 1 TO 2500
|
||||
paraShade1(k1).r = 1 - k1 / 2500
|
||||
paraShade1(k1).g = .25
|
||||
paraShade1(k1).b = k1 / 2500
|
||||
NEXT
|
||||
FOR k1 = 1 TO 50
|
||||
FOR k2 = 1 TO 50
|
||||
paraShade2(k1, k2).r = .1 + .9 * SIN(3.14159 * k1 / 50) ^ 2
|
||||
paraShade2(k1, k2).g = 0
|
||||
paraShade2(k1, k2).b = 1 - .9 * SIN(3.14159 * k2 / 50) ^ 2
|
||||
NEXT
|
||||
NEXT
|
||||
END SUB
|
||||
|
||||
REM $INCLUDE: 'sxript.bm'
|
||||
REM $Include: 'sxmath.bm'
|
||||
|
||||
''' LEGACY CODE
|
||||
|
||||
''By Fellipe Heitor
|
||||
'FUNCTION INPUTBOX (tTitle$, tMessage$, InitialValue AS STRING, NewValue AS STRING, Selected)
|
||||
' 'INPUTBOX ---------------------------------------------------------------------
|
||||
' 'Show a dialog and allow user input. Returns 1 = OK or 2 = Cancel. '
|
||||
' ' '
|
||||
' '- tTitle$ is the desired dialog title. If not provided, it'll be "Input" '
|
||||
' ' '
|
||||
' '- tMessage$ is the prompt that'll be shown to the user. You can show '
|
||||
' ' a multiline message by adding line breaks with CHR$(10). '
|
||||
' ' '
|
||||
' ' - InitialValue can be passed both as a string literal or as a variable. '
|
||||
' ' '
|
||||
' '- Actual user input is returned by altering NewValue, so it must be '
|
||||
' ' passed as a variable. '
|
||||
' ' '
|
||||
' '- Selected indicates wheter the initial value will be preselected when the '
|
||||
' ' dialog is first shown. -1 preselects the whole text; positive values '
|
||||
' ' select only part of the initial value (from the character position passed '
|
||||
' ' to the end of the initial value). '
|
||||
' ' '
|
||||
' 'Intended for use with 32-bit screen modes. '
|
||||
' '------------------------------------------------------------------------------
|
||||
|
||||
' 'Variable declaration:
|
||||
' DIM Message$, Title$, CharW AS INTEGER, MaxLen AS INTEGER
|
||||
' DIM lineBreak AS INTEGER, totalLines AS INTEGER, prevlinebreak AS INTEGER
|
||||
' DIM Cursor AS INTEGER, Selection.Start AS INTEGER, InputViewStart AS INTEGER
|
||||
' DIM FieldArea AS INTEGER, DialogH AS INTEGER, DialogW AS INTEGER
|
||||
' DIM DialogX AS INTEGER, DialogY AS INTEGER, InputField.X AS INTEGER
|
||||
' DIM TotalButtons AS INTEGER, B AS INTEGER, ButtonLine$
|
||||
' DIM cb AS INTEGER, DIALOGRESULT AS INTEGER, i AS INTEGER
|
||||
' DIM message.X AS INTEGER, SetCursor#, cursorBlink%
|
||||
' DIM DefaultButton AS INTEGER, k AS LONG
|
||||
' DIM shiftDown AS _BYTE, ctrlDown AS _BYTE, Clip$
|
||||
' DIM FindLF%, s1 AS INTEGER, s2 AS INTEGER
|
||||
' DIM Selection.Value$
|
||||
' DIM prevCursor AS INTEGER, ss1 AS INTEGER, ss2 AS INTEGER, mb AS _BYTE
|
||||
' DIM mx AS INTEGER, my AS INTEGER, nmx AS INTEGER, nmy AS INTEGER
|
||||
' DIM FGColor AS LONG, BGColor AS LONG
|
||||
|
||||
' 'Data type used for the dialog buttons:
|
||||
' TYPE BUTTONSTYPE
|
||||
' ID AS LONG
|
||||
' CAPTION AS STRING * 120
|
||||
' X AS INTEGER
|
||||
' Y AS INTEGER
|
||||
' W AS INTEGER
|
||||
' END TYPE
|
||||
|
||||
' 'Color constants. You can customize colors by changing these:
|
||||
' CONST TitleBarColor = _RGB32(0, 178, 179)
|
||||
' CONST DialogBGColor = _RGB32(255, 255, 255)
|
||||
' CONST TitleBarTextColor = _RGB32(0, 0, 0)
|
||||
' CONST DialogTextColor = _RGB32(0, 0, 0)
|
||||
' CONST InputFieldColor = _RGB32(200, 200, 200)
|
||||
' CONST InputFieldTextColor = _RGB32(0, 0, 0)
|
||||
' CONST SelectionColor = _RGBA32(127, 127, 127, 100)
|
||||
|
||||
' 'Initial variable setup:
|
||||
' Message$ = tMessage$
|
||||
' Title$ = RTRIM$(LTRIM$(tTitle$))
|
||||
' IF Title$ = "" THEN Title$ = "Input"
|
||||
' NewValue = RTRIM$(LTRIM$(InitialValue))
|
||||
' DefaultButton = 1
|
||||
|
||||
' 'Save the current drawing page so it can be restored later:
|
||||
' FGColor = _DEFAULTCOLOR
|
||||
' BGColor = _BACKGROUNDCOLOR
|
||||
' PCOPY 0, 1
|
||||
|
||||
' 'Figure out the print width of a single character (in case user has a custom font applied)
|
||||
' CharW = _PRINTWIDTH("_")
|
||||
|
||||
' 'Place a color overlay over the old screen image so the focus is on the dialog:
|
||||
' LINE (0, 0)-STEP(_WIDTH - 1, _HEIGHT - 1), _RGBA32(170, 170, 170, 170), BF
|
||||
|
||||
' 'Message breakdown, in case CHR$(10) was used as line break:
|
||||
' REDIM MessageLines(1) AS STRING
|
||||
' MaxLen = 1
|
||||
' DO
|
||||
' lineBreak = INSTR(lineBreak + 1, Message$, CHR$(10))
|
||||
' IF lineBreak = 0 AND totalLines = 0 THEN
|
||||
' totalLines = 1
|
||||
' MessageLines(1) = Message$
|
||||
' MaxLen = LEN(Message$)
|
||||
' EXIT DO
|
||||
' ELSEIF lineBreak = 0 AND totalLines > 0 THEN
|
||||
' totalLines = totalLines + 1
|
||||
' REDIM _PRESERVE MessageLines(1 TO totalLines) AS STRING
|
||||
' MessageLines(totalLines) = RIGHT$(Message$, LEN(Message$) - prevlinebreak + 1)
|
||||
' IF LEN(MessageLines(totalLines)) > MaxLen THEN MaxLen = LEN(MessageLines(totalLines))
|
||||
' EXIT DO
|
||||
' END IF
|
||||
' IF totalLines = 0 THEN prevlinebreak = 1
|
||||
' totalLines = totalLines + 1
|
||||
' REDIM _PRESERVE MessageLines(1 TO totalLines) AS STRING
|
||||
' MessageLines(totalLines) = MID$(Message$, prevlinebreak, lineBreak - prevlinebreak)
|
||||
' IF LEN(MessageLines(totalLines)) > MaxLen THEN MaxLen = LEN(MessageLines(totalLines))
|
||||
' prevlinebreak = lineBreak + 1
|
||||
' LOOP
|
||||
|
||||
' Cursor = LEN(NewValue)
|
||||
' Selection.Start = 0
|
||||
' InputViewStart = 1
|
||||
' FieldArea = _WIDTH \ CharW - 4
|
||||
' IF FieldArea > 62 THEN FieldArea = 62
|
||||
' IF Selected > 0 THEN Selection.Start = Selected: Selected = -1
|
||||
|
||||
' 'Calculate dialog dimensions and print coordinates:
|
||||
' DialogH = _FONTHEIGHT * (6 + totalLines) + 10
|
||||
' DialogW = (CharW * FieldArea) + 10
|
||||
' IF DialogW < MaxLen * CharW + 10 THEN DialogW = MaxLen * CharW + 10
|
||||
|
||||
' DialogX = _WIDTH / 2 - DialogW / 2
|
||||
' DialogY = _HEIGHT / 2 - DialogH / 2
|
||||
' InputField.X = (DialogX + (DialogW / 2)) - (((FieldArea * CharW) - 10) / 2) - 4
|
||||
|
||||
' 'Calculate button's print coordinates:
|
||||
' TotalButtons = 2
|
||||
' DIM Buttons(1 TO TotalButtons) AS BUTTONSTYPE
|
||||
' B = 1
|
||||
' Buttons(B).ID = 1: Buttons(B).CAPTION = "< OK >": B = B + 1
|
||||
' Buttons(B).ID = 2: Buttons(B).CAPTION = "< Cancel >": B = B + 1
|
||||
' ButtonLine$ = " "
|
||||
' FOR cb = 1 TO TotalButtons
|
||||
' ButtonLine$ = ButtonLine$ + RTRIM$(LTRIM$(Buttons(cb).CAPTION)) + " "
|
||||
' Buttons(cb).Y = DialogY + 5 + _FONTHEIGHT * (5 + totalLines)
|
||||
' Buttons(cb).W = _PRINTWIDTH(RTRIM$(LTRIM$(Buttons(cb).CAPTION)))
|
||||
' NEXT cb
|
||||
' Buttons(1).X = _WIDTH / 2 - _PRINTWIDTH(ButtonLine$) / 2
|
||||
' FOR cb = 2 TO TotalButtons
|
||||
' Buttons(cb).X = Buttons(1).X + _PRINTWIDTH(SPACE$(INSTR(ButtonLine$, RTRIM$(LTRIM$(Buttons(cb).CAPTION)))))
|
||||
' NEXT cb
|
||||
|
||||
' 'Main loop:
|
||||
' DIALOGRESULT = 0
|
||||
' _KEYCLEAR
|
||||
' DO: _LIMIT 500
|
||||
' 'Draw the dialog.
|
||||
' LINE (DialogX, DialogY)-STEP(DialogW - 1, DialogH - 1), DialogBGColor, BF
|
||||
' LINE (DialogX, DialogY)-STEP(DialogW - 1, _FONTHEIGHT + 1), TitleBarColor, BF
|
||||
' COLOR TitleBarTextColor
|
||||
' _PRINTSTRING (_WIDTH / 2 - _PRINTWIDTH(Title$) / 2, DialogY + 1), Title$
|
||||
|
||||
' COLOR DialogTextColor, _RGBA32(0, 0, 0, 0)
|
||||
' FOR i = 1 TO totalLines
|
||||
' message.X = _WIDTH / 2 - _PRINTWIDTH(MessageLines(i)) / 2
|
||||
' _PRINTSTRING (message.X, DialogY + 5 + _FONTHEIGHT * (i + 1)), MessageLines(i)
|
||||
' NEXT i
|
||||
|
||||
' 'Draw the input field
|
||||
' LINE (InputField.X - 2, DialogY + 3 + _FONTHEIGHT * (3 + totalLines))-STEP(FieldArea * CharW, _FONTHEIGHT + 4), InputFieldColor, BF
|
||||
' COLOR InputFieldTextColor
|
||||
' _PRINTSTRING (InputField.X, DialogY + 5 + _FONTHEIGHT * (3 + totalLines)), MID$(NewValue, InputViewStart, FieldArea)
|
||||
|
||||
' 'Selection highlight:
|
||||
' GOSUB SelectionHighlight
|
||||
|
||||
' 'Cursor blink:
|
||||
' IF TIMER - SetCursor# > .4 THEN
|
||||
' SetCursor# = TIMER
|
||||
' IF cursorBlink% = 1 THEN cursorBlink% = 0 ELSE cursorBlink% = 1
|
||||
' END IF
|
||||
' IF cursorBlink% = 1 THEN
|
||||
' LINE (InputField.X + (Cursor - (InputViewStart - 1)) * CharW, DialogY + 5 + _FONTHEIGHT * (3 + totalLines))-STEP(0, _FONTHEIGHT), _RGB32(0, 0, 0)
|
||||
' END IF
|
||||
|
||||
' 'Check if buttons have been clicked or are being hovered:
|
||||
' GOSUB CheckButtons
|
||||
|
||||
' 'Draw buttons:
|
||||
' FOR cb = 1 TO TotalButtons
|
||||
' _PRINTSTRING (Buttons(cb).X, Buttons(cb).Y), RTRIM$(LTRIM$(Buttons(cb).CAPTION))
|
||||
' IF cb = DefaultButton THEN
|
||||
' COLOR _RGB32(255, 255, 0)
|
||||
' _PRINTSTRING (Buttons(cb).X, Buttons(cb).Y), "<" + SPACE$(LEN(RTRIM$(LTRIM$(Buttons(cb).CAPTION))) - 2) + ">"
|
||||
' COLOR _RGB32(0, 178, 179)
|
||||
' _PRINTSTRING (Buttons(cb).X - 1, Buttons(cb).Y - 1), "<" + SPACE$(LEN(RTRIM$(LTRIM$(Buttons(cb).CAPTION))) - 2) + ">"
|
||||
' COLOR _RGB32(0, 0, 0)
|
||||
' END IF
|
||||
' NEXT cb
|
||||
|
||||
' _DISPLAY
|
||||
|
||||
' 'Process input:
|
||||
' k = _KEYHIT
|
||||
' IF k = 100303 OR k = 100304 THEN shiftDown = -1
|
||||
' IF k = -100303 OR k = -100304 THEN shiftDown = 0
|
||||
' IF k = 100305 OR k = 100306 THEN ctrlDown = -1
|
||||
' IF k = -100305 OR k = -100306 THEN ctrlDown = 0
|
||||
|
||||
' SELECT CASE k
|
||||
' CASE 13: DIALOGRESULT = 1
|
||||
' CASE 27: DIALOGRESULT = 2
|
||||
' CASE 32 TO 126 'Printable ASCII characters
|
||||
' IF k = ASC("v") OR k = ASC("V") THEN 'Paste from clipboard (Ctrl+V)
|
||||
' IF ctrlDown THEN
|
||||
' Clip$ = _CLIPBOARD$
|
||||
' FindLF% = INSTR(Clip$, CHR$(13))
|
||||
' IF FindLF% > 0 THEN Clip$ = LEFT$(Clip$, FindLF% - 1)
|
||||
' FindLF% = INSTR(Clip$, CHR$(10))
|
||||
' IF FindLF% > 0 THEN Clip$ = LEFT$(Clip$, FindLF% - 1)
|
||||
' IF LEN(RTRIM$(LTRIM$(Clip$))) > 0 THEN
|
||||
' IF NOT Selected THEN
|
||||
' IF Cursor = LEN(NewValue) THEN
|
||||
' NewValue = NewValue + Clip$
|
||||
' Cursor = LEN(NewValue)
|
||||
' ELSE
|
||||
' NewValue = LEFT$(NewValue, Cursor) + Clip$ + MID$(NewValue, Cursor + 1)
|
||||
' Cursor = Cursor + LEN(Clip$)
|
||||
' END IF
|
||||
' ELSE
|
||||
' s1 = Selection.Start
|
||||
' s2 = Cursor
|
||||
' IF s1 > s2 THEN SWAP s1, s2
|
||||
' NewValue = LEFT$(NewValue, s1) + Clip$ + MID$(NewValue, s2 + 1)
|
||||
' Cursor = s1 + LEN(Clip$)
|
||||
' Selected = 0
|
||||
' END IF
|
||||
' END IF
|
||||
' k = 0
|
||||
' END IF
|
||||
' ELSEIF k = ASC("c") OR k = ASC("C") THEN 'Copy selection to clipboard (Ctrl+C)
|
||||
' IF ctrlDown THEN
|
||||
' _CLIPBOARD$ = Selection.Value$
|
||||
' k = 0
|
||||
' END IF
|
||||
' ELSEIF k = ASC("x") OR k = ASC("X") THEN 'Cut selection to clipboard (Ctrl+X)
|
||||
' IF ctrlDown THEN
|
||||
' _CLIPBOARD$ = Selection.Value$
|
||||
' GOSUB DeleteSelection
|
||||
' k = 0
|
||||
' END IF
|
||||
' ELSEIF k = ASC("a") OR k = ASC("A") THEN 'Select all text (Ctrl+A)
|
||||
' IF ctrlDown THEN
|
||||
' Cursor = LEN(NewValue)
|
||||
' Selection.Start = 0
|
||||
' Selected = -1
|
||||
' k = 0
|
||||
' END IF
|
||||
' END IF
|
||||
|
||||
' IF k > 0 THEN
|
||||
' IF NOT Selected THEN
|
||||
' IF Cursor = LEN(NewValue) THEN
|
||||
' NewValue = NewValue + CHR$(k)
|
||||
' Cursor = Cursor + 1
|
||||
' ELSE
|
||||
' NewValue = LEFT$(NewValue, Cursor) + CHR$(k) + MID$(NewValue, Cursor + 1)
|
||||
' Cursor = Cursor + 1
|
||||
' END IF
|
||||
' IF Cursor > FieldArea THEN InputViewStart = (Cursor - FieldArea) + 2
|
||||
' ELSE
|
||||
' s1 = Selection.Start
|
||||
' s2 = Cursor
|
||||
' IF s1 > s2 THEN SWAP s1, s2
|
||||
' NewValue = LEFT$(NewValue, s1) + CHR$(k) + MID$(NewValue, s2 + 1)
|
||||
' Selected = 0
|
||||
' Cursor = s1 + 1
|
||||
' END IF
|
||||
' END IF
|
||||
' CASE 8 'Backspace
|
||||
' IF LEN(NewValue) > 0 THEN
|
||||
' IF NOT Selected THEN
|
||||
' IF Cursor = LEN(NewValue) THEN
|
||||
' NewValue = LEFT$(NewValue, LEN(NewValue) - 1)
|
||||
' Cursor = Cursor - 1
|
||||
' ELSEIF Cursor > 1 THEN
|
||||
' NewValue = LEFT$(NewValue, Cursor - 1) + MID$(NewValue, Cursor + 1)
|
||||
' Cursor = Cursor - 1
|
||||
' ELSEIF Cursor = 1 THEN
|
||||
' NewValue = RIGHT$(NewValue, LEN(NewValue) - 1)
|
||||
' Cursor = Cursor - 1
|
||||
' END IF
|
||||
' ELSE
|
||||
' GOSUB DeleteSelection
|
||||
' END IF
|
||||
' END IF
|
||||
' CASE 21248 'Delete
|
||||
' IF NOT Selected THEN
|
||||
' IF LEN(NewValue) > 0 THEN
|
||||
' IF Cursor = 0 THEN
|
||||
' NewValue = RIGHT$(NewValue, LEN(NewValue) - 1)
|
||||
' ELSEIF Cursor > 0 AND Cursor <= LEN(NewValue) - 1 THEN
|
||||
' NewValue = LEFT$(NewValue, Cursor) + MID$(NewValue, Cursor + 2)
|
||||
' END IF
|
||||
' END IF
|
||||
' ELSE
|
||||
' GOSUB DeleteSelection
|
||||
' END IF
|
||||
' CASE 19200 'Left arrow key
|
||||
' GOSUB CheckSelection
|
||||
' IF Cursor > 0 THEN Cursor = Cursor - 1
|
||||
' CASE 19712 'Right arrow key
|
||||
' GOSUB CheckSelection
|
||||
' IF Cursor < LEN(NewValue) THEN Cursor = Cursor + 1
|
||||
' CASE 18176 'Home
|
||||
' GOSUB CheckSelection
|
||||
' Cursor = 0
|
||||
' CASE 20224 'End
|
||||
' GOSUB CheckSelection
|
||||
' Cursor = LEN(NewValue)
|
||||
' END SELECT
|
||||
|
||||
' 'Cursor adjustments:
|
||||
' GOSUB CursorAdjustments
|
||||
' LOOP UNTIL DIALOGRESULT > 0
|
||||
|
||||
' _KEYCLEAR
|
||||
' INPUTBOX = DIALOGRESULT
|
||||
|
||||
' 'Restore previous display:
|
||||
' PCOPY 1, 0
|
||||
' COLOR FGColor, BGColor
|
||||
' EXIT SUB
|
||||
|
||||
' CursorAdjustments:
|
||||
' IF Cursor > prevCursor THEN
|
||||
' IF Cursor - InputViewStart + 2 > FieldArea THEN InputViewStart = (Cursor - FieldArea) + 2
|
||||
' ELSEIF Cursor < prevCursor THEN
|
||||
' IF Cursor < InputViewStart - 1 THEN InputViewStart = Cursor
|
||||
' END IF
|
||||
' prevCursor = Cursor
|
||||
' IF InputViewStart < 1 THEN InputViewStart = 1
|
||||
' RETURN
|
||||
|
||||
' CheckSelection:
|
||||
' IF shiftDown = -1 THEN
|
||||
' IF Selected = 0 THEN
|
||||
' Selected = -1
|
||||
' Selection.Start = Cursor
|
||||
' END IF
|
||||
' ELSEIF shiftDown = 0 THEN
|
||||
' Selected = 0
|
||||
' END IF
|
||||
' RETURN
|
||||
|
||||
' DeleteSelection:
|
||||
' NewValue = LEFT$(NewValue, s1) + MID$(NewValue, s2 + 1)
|
||||
' Selected = 0
|
||||
' Cursor = s1
|
||||
' RETURN
|
||||
|
||||
' SelectionHighlight:
|
||||
' IF Selected THEN
|
||||
' s1 = Selection.Start
|
||||
' s2 = Cursor
|
||||
' IF s1 > s2 THEN
|
||||
' SWAP s1, s2
|
||||
' IF InputViewStart > 1 THEN
|
||||
' ss1 = s1 - InputViewStart + 1
|
||||
' ELSE
|
||||
' ss1 = s1
|
||||
' END IF
|
||||
' ss2 = s2 - s1
|
||||
' IF ss1 + ss2 > FieldArea THEN ss2 = FieldArea - ss1
|
||||
' ELSE
|
||||
' ss1 = s1
|
||||
' ss2 = s2 - s1
|
||||
' IF ss1 < InputViewStart THEN ss1 = 0: ss2 = s2 - InputViewStart + 1
|
||||
' IF ss1 > InputViewStart THEN ss1 = ss1 - InputViewStart + 1: ss2 = s2 - s1
|
||||
' END IF
|
||||
' Selection.Value$ = MID$(NewValue, s1 + 1, s2 - s1)
|
||||
|
||||
' LINE (InputField.X + ss1 * CharW, DialogY + 5 + _FONTHEIGHT * (3 + totalLines))-STEP(ss2 * CharW, _FONTHEIGHT), _RGBA32(255, 255, 255, 150), BF
|
||||
' END IF
|
||||
' RETURN
|
||||
|
||||
' CheckButtons:
|
||||
' 'Hover highlight:
|
||||
' WHILE _MOUSEINPUT: WEND
|
||||
' mb = _MOUSEBUTTON(1): mx = _MOUSEX: my = _MOUSEY
|
||||
' FOR cb = 1 TO TotalButtons
|
||||
' IF (mx >= Buttons(cb).X) AND (mx <= Buttons(cb).X + Buttons(cb).W) THEN
|
||||
' IF (my >= Buttons(cb).Y) AND (my < Buttons(cb).Y + _FONTHEIGHT) THEN
|
||||
' LINE (Buttons(cb).X, Buttons(cb).Y)-STEP(Buttons(cb).W, _FONTHEIGHT - 1), _RGBA32(230, 230, 230, 235), BF
|
||||
' END IF
|
||||
' END IF
|
||||
' NEXT cb
|
||||
|
||||
' IF mb THEN
|
||||
' IF mx >= InputField.X AND my >= DialogY + 3 + _FONTHEIGHT * (3 + totalLines) AND mx <= InputField.X + (FieldArea * CharW - 10) AND my <= DialogY + 3 + _FONTHEIGHT * (3 + totalLines) + _FONTHEIGHT + 4 THEN
|
||||
' 'Clicking inside the text field positions the cursor
|
||||
' WHILE _MOUSEBUTTON(1)
|
||||
' _LIMIT 500
|
||||
' mb = _MOUSEINPUT
|
||||
' WEND
|
||||
' Cursor = ((mx - InputField.X) / CharW) + (InputViewStart - 1)
|
||||
' IF Cursor > LEN(NewValue) THEN Cursor = LEN(NewValue)
|
||||
' Selected = 0
|
||||
' RETURN
|
||||
' END IF
|
||||
|
||||
' FOR cb = 1 TO TotalButtons
|
||||
' IF (mx >= Buttons(cb).X) AND (mx <= Buttons(cb).X + Buttons(cb).W) THEN
|
||||
' IF (my >= Buttons(cb).Y) AND (my < Buttons(cb).Y + _FONTHEIGHT) THEN
|
||||
' DefaultButton = cb
|
||||
' WHILE _MOUSEBUTTON(1): _LIMIT 500: mb = _MOUSEINPUT: WEND
|
||||
' mb = 0: nmx = _MOUSEX: nmy = _MOUSEY
|
||||
' IF nmx = mx AND nmy = my THEN DIALOGRESULT = cb
|
||||
' RETURN
|
||||
' END IF
|
||||
' END IF
|
||||
' NEXT cb
|
||||
' END IF
|
||||
' RETURN
|
||||
'END FUNCTION
|
||||
|
||||
'FUNCTION hsb~& (__H AS _FLOAT, __S AS _FLOAT, __B AS _FLOAT, A AS _FLOAT)
|
||||
' 'method adapted form http://stackoverflow.com/questions/4106363/converting-rgb-to-hsb-colors
|
||||
' DIM H AS _FLOAT, S AS _FLOAT, B AS _FLOAT
|
||||
|
||||
' H = map(__H, 0, 255, 0, 360)
|
||||
' S = map(__S, 0, 255, 0, 1)
|
||||
' B = map(__B, 0, 255, 0, 1)
|
||||
|
||||
' IF S = 0 THEN
|
||||
' hsb~& = _RGBA32(B * 255, B * 255, B * 255, A)
|
||||
' EXIT FUNCTION
|
||||
' END IF
|
||||
|
||||
' DIM fmx AS _FLOAT, fmn AS _FLOAT
|
||||
' DIM fmd AS _FLOAT, iSextant AS INTEGER
|
||||
' DIM imx AS INTEGER, imd AS INTEGER, imn AS INTEGER
|
||||
|
||||
' IF B > .5 THEN
|
||||
' fmx = B - (B * S) + S
|
||||
' fmn = B + (B * S) - S
|
||||
' ELSE
|
||||
' fmx = B + (B * S)
|
||||
' fmn = B - (B * S)
|
||||
' END IF
|
||||
|
||||
' iSextant = INT(H / 60)
|
||||
|
||||
' IF H >= 300 THEN
|
||||
' H = H - 360
|
||||
' END IF
|
||||
|
||||
' H = H / 60
|
||||
' H = H - (2 * INT(((iSextant + 1) MOD 6) / 2))
|
||||
|
||||
' IF iSextant MOD 2 = 0 THEN
|
||||
' fmd = (H * (fmx - fmn)) + fmn
|
||||
' ELSE
|
||||
' fmd = fmn - (H * (fmx - fmn))
|
||||
' END IF
|
||||
|
||||
' imx = _ROUND(fmx * 255)
|
||||
' imd = _ROUND(fmd * 255)
|
||||
' imn = _ROUND(fmn * 255)
|
||||
|
||||
' SELECT CASE INT(iSextant)
|
||||
' CASE 1
|
||||
' hsb~& = _RGBA32(imd, imx, imn, A)
|
||||
' CASE 2
|
||||
' hsb~& = _RGBA32(imn, imx, imd, A)
|
||||
' CASE 3
|
||||
' hsb~& = _RGBA32(imn, imd, imx, A)
|
||||
' CASE 4
|
||||
' hsb~& = _RGBA32(imd, imn, imx, A)
|
||||
' CASE 5
|
||||
' hsb~& = _RGBA32(imx, imn, imd, A)
|
||||
' CASE ELSE
|
||||
' hsb~& = _RGBA32(imx, imd, imn, A)
|
||||
' END SELECT
|
||||
'END FUNCTION
|
||||
|
||||
'SUB getEquation
|
||||
' DIM inputStatus AS INTEGER
|
||||
' CLS
|
||||
' inputStatus = INPUTBOX("Equation Editor", "Enter the expression for z = (ex. x*y)", mainEquation, mainEquation, -1)
|
||||
' IF (inputStatus = 2) THEN END
|
||||
'END SUB
|
||||
|
||||
'FUNCTION map! (value!, minRange!, maxRange!, newMinRange!, newMaxRange!)
|
||||
' map! = ((value! - minRange!) / (maxRange! - minRange!)) * (newMaxRange! - newMinRange!) + newMinRange!
|
||||
'END FUNCTION
|
||||
|
||||
BIN
samples/3d-grapher/src/3d-grapher.zip
Normal file
BIN
samples/3d-grapher/src/3d-grapher.zip
Normal file
Binary file not shown.
|
|
@ -8,6 +8,24 @@
|
|||
|
||||
3d cube polygon filled using paint. ;*) I could probably shorten the code in less than 20 lines b...
|
||||
|
||||
**[3D Engine Prototypes](3d-engine-prototypes/index.md)**
|
||||
|
||||
[🐝 STxAxTIC](stxaxtic.md) 🔗 [3d](3d.md), [graph](graph.md)
|
||||
|
||||
Various experiments in software 3D graphics. Warning: Uses no functions or subs!
|
||||
|
||||
**[3D Grapher](3d-grapher/index.md)**
|
||||
|
||||
[🐝 Ashish Kushwaha](ashish-kushwaha.md) [🐝 STxAxTIC](stxaxtic.md) 🔗 [3d](3d.md), [gl](gl.md)
|
||||
|
||||
3D Grapher made in QB64.
|
||||
|
||||
**[3DS Viewer](3ds-viewer/index.md)**
|
||||
|
||||
[🐝 *missing*](author-missing.md) 🔗 [3d](3d.md), [wireframe](wireframe.md), [legacy](legacy.md)
|
||||
|
||||
3D Grapher made in QB64.
|
||||
|
||||
**[Globe](globe/index.md)**
|
||||
|
||||
[🐝 Jeh](jeh.md) [🐝 Yu](yu.md) 🔗 [3d](3d.md), [sphere](sphere.md)
|
||||
|
|
@ -20,12 +38,24 @@ Glen Jeh, 8/12/1994, William Yu (05-28-96) '{A little rotating sphere, by Glen
|
|||
|
||||
================================================================================= H E L ...
|
||||
|
||||
**[Kaleidoscope 3D](kaleidoscope-3d/index.md)**
|
||||
|
||||
[🐝 qbguy](qbguy.md) 🔗 [3d](3d.md), [art](art.md)
|
||||
|
||||
Move mouse to rotate, escape to quit
|
||||
|
||||
**[Maptriangle in 3D](maptriangle-in-3d/index.md)**
|
||||
|
||||
[🐝 Petr](petr.md) 🔗 [3d](3d.md), [maptriangle](maptriangle.md)
|
||||
|
||||
A demo to show rotation in 3D using MAPTRIANGLE 3D, without direct OpenGL statements. Librarian'...
|
||||
|
||||
**[Ray Tracer Z](ray-tracer-z/index.md)**
|
||||
|
||||
[🐝 Zom-B](zom-b.md) 🔗 [3d](3d.md), [ray tracer](ray-tracer.md)
|
||||
|
||||
This is a ray tracer I've been working on for the past 6 years. Well, on and off of course :) It'...
|
||||
|
||||
**[RayCaster](raycaster/index.md)**
|
||||
|
||||
[🐝 Antoni Gual](antoni-gual.md) 🔗 [3d](3d.md), [raycaster](raycaster.md)
|
||||
|
|
|
|||
BIN
samples/3ds-viewer/img/screenshot.png
Normal file
BIN
samples/3ds-viewer/img/screenshot.png
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 4.7 KiB |
19
samples/3ds-viewer/index.md
Normal file
19
samples/3ds-viewer/index.md
Normal file
|
|
@ -0,0 +1,19 @@
|
|||
[Home](https://qb64.com) • [News](../../news.md) • [GitHub](../../github.md) • [Wiki](../../wiki.md) • [Samples](../../samples.md) • [Media](../../media.md) • [Community](../../community.md) • [Rolodex](../../rolodex.md) • [More...](../../more.md)
|
||||
|
||||
## SAMPLE: 3DS VIEWER
|
||||
|
||||
|
||||
|
||||
### Description
|
||||
|
||||
```text
|
||||
3D Grapher made in QB64.
|
||||
```
|
||||
|
||||
### File(s)
|
||||
|
||||
* [3dsviewer.bas](src/3dsviewer.bas)
|
||||
* [3dsviewer.zip](src/3dsviewer.zip)
|
||||
* [car.3ds](src/car.3ds)
|
||||
|
||||
🔗 [3d](../3d.md), [wireframe](../wireframe.md), [legacy](../legacy.md)
|
||||
447
samples/3ds-viewer/src/3dsviewer.bas
Normal file
447
samples/3ds-viewer/src/3dsviewer.bas
Normal file
|
|
@ -0,0 +1,447 @@
|
|||
'CHDIR ".\samples\n54\big\3dsviewer"
|
||||
|
||||
'----sub declarations
|
||||
'--file stuff
|
||||
DECLARE SUB ReadChunkInfo (ChunkInfoHolder AS ANY, BytePosition AS LONG)
|
||||
DECLARE SUB SkipChunk (ChunkInfoHolder AS ANY, BytePosition AS LONG)
|
||||
DECLARE SUB SearchForChunk (ChunkInfoHolder AS ANY)
|
||||
DECLARE SUB ReadObject ()
|
||||
'--3D engine stuff
|
||||
DECLARE SUB multiplyMatrices (matrixA(), matrixB(), result())
|
||||
DECLARE SUB getScalingMatrix (sX, sY, sZ, result())
|
||||
DECLARE SUB getRotationXMatrix (rX, result())
|
||||
DECLARE SUB getRotationYMatrix (rY, result())
|
||||
DECLARE SUB getRotationZMatrix (rZ, result())
|
||||
DECLARE SUB getTranslationMatrix (tX, tY, tZ, result())
|
||||
DECLARE SUB getCombinedMatrix (sX, sY, sZ, rX, rY, rZ, tX, tY, tZ, temp(), temp2(), result())
|
||||
DECLARE SUB getNewXYZ (X, Y, Z, combinedMatrix())
|
||||
DECLARE SUB getScreenXY (X, Y, Z)
|
||||
|
||||
'----global declarations
|
||||
Rem $DYNAMIC
|
||||
Dim Shared PointsArray(0, 0) As Single
|
||||
Dim Shared NewPointsArray(0, 0) As Long
|
||||
Dim Shared FaceArray(0, 0) As Integer
|
||||
Rem $STATIC
|
||||
Dim Shared numberVertices As Integer
|
||||
Dim Shared numberFaces As Integer
|
||||
Dim Shared CurrentBytePosition As Long
|
||||
Dim Shared FindChunk$
|
||||
|
||||
'----type definitions
|
||||
Type ChunkInfo
|
||||
ID As Integer
|
||||
Size As Long
|
||||
Position As Long
|
||||
End Type
|
||||
|
||||
'----open file
|
||||
Cls
|
||||
Print "Would you like to view car.3ds (y/n)?"
|
||||
Do
|
||||
k$ = InKey$
|
||||
Loop Until k$ <> ""
|
||||
If UCase$(k$) = "N" Then
|
||||
Input "Please input the file you wish to load:", fileName$
|
||||
Else
|
||||
fileName$ = "car.3ds"
|
||||
End If
|
||||
Open fileName$ For Binary As #1
|
||||
|
||||
'----initialise variables
|
||||
sX = 5
|
||||
sY = 5
|
||||
sZ = 5
|
||||
rX = 0
|
||||
rY = 0
|
||||
rZ = 0
|
||||
tX = 0
|
||||
tY = 0
|
||||
tZ = 500
|
||||
currentFrame = 0
|
||||
|
||||
'----allocate space for matrix calcs
|
||||
Dim temp(3, 3)
|
||||
Dim temp2(3, 3)
|
||||
Dim result(3, 3)
|
||||
|
||||
'----MAIN PROGRAM
|
||||
Cls
|
||||
Print "3DS Object Viewer 0.5"
|
||||
Print "---------------------"
|
||||
Print "By David Llewellyn"
|
||||
Print "24/10/2004"
|
||||
Print ""
|
||||
Call ReadObject
|
||||
Print ""
|
||||
Print "Press any key to continue"
|
||||
Do
|
||||
Loop Until InKey$ > Chr$(0)
|
||||
|
||||
'3D-Section
|
||||
Screen 7, , 0, 1
|
||||
Colour = 4
|
||||
oldTime = Timer
|
||||
|
||||
Do
|
||||
|
||||
Call getCombinedMatrix(sX, sY, sZ, rX, rY, rZ, tX, tY, tZ, temp(), temp2(), result())
|
||||
Cls
|
||||
|
||||
For i = 0 To numberVertices 'load screen coordinates into new array
|
||||
X = PointsArray(0, i)
|
||||
Y = PointsArray(1, i)
|
||||
Z = PointsArray(2, i)
|
||||
Call getNewXYZ(X, Y, Z, result())
|
||||
Call getScreenXY(X, Y, Z)
|
||||
NewPointsArray(0, i) = X
|
||||
NewPointsArray(1, i) = Y
|
||||
Next i 'load screen coordinates into new array
|
||||
|
||||
For i = 0 To numberFaces - 1 'draw faces
|
||||
'line from point 0 to 1
|
||||
Line (NewPointsArray(0, FaceArray(0, i)), NewPointsArray(1, FaceArray(0, i)))-(NewPointsArray(0, FaceArray(1, i)), NewPointsArray(1, FaceArray(1, i))), Colour
|
||||
'line from point 1 to 2
|
||||
Line (NewPointsArray(0, FaceArray(1, i)), NewPointsArray(1, FaceArray(1, i)))-(NewPointsArray(0, FaceArray(2, i)), NewPointsArray(1, FaceArray(2, i))), Colour
|
||||
'line from point 2 to 0
|
||||
Line (NewPointsArray(0, FaceArray(2, i)), NewPointsArray(1, FaceArray(2, i)))-(NewPointsArray(0, FaceArray(0, i)), NewPointsArray(1, FaceArray(0, i))), Colour
|
||||
Next i 'draw faces
|
||||
|
||||
PCopy 0, 1
|
||||
frames = frames + 1
|
||||
|
||||
A$ = InKey$
|
||||
rX = rX + .00065
|
||||
rY = rY + .00545
|
||||
If A$ = "=" Then tZ = tZ - 5
|
||||
If A$ = "-" Then tZ = tZ + 5
|
||||
|
||||
Loop Until A$ = Chr$(27)
|
||||
|
||||
newTime = Timer
|
||||
timeTaken = newTime - oldTime
|
||||
Screen 13
|
||||
Print Using "##.##"; frames / timeTaken
|
||||
Print "frames per second"
|
||||
Do
|
||||
Loop Until InKey$ > Chr$(0)
|
||||
|
||||
System
|
||||
|
||||
Sub getCombinedMatrix (sX, sY, sZ, rX, rY, rZ, tX, tY, tZ, temp(), temp2(), result())
|
||||
|
||||
Erase temp2
|
||||
Call getScalingMatrix(sX, sY, sZ, result())
|
||||
Call getRotationXMatrix(rX, temp())
|
||||
Call multiplyMatrices(result(), temp(), temp2()) 'combine with x rotation
|
||||
|
||||
Call getRotationYMatrix(rY, temp())
|
||||
Erase result
|
||||
Call multiplyMatrices(temp2(), temp(), result()) 'combine with y rotation
|
||||
|
||||
Call getRotationZMatrix(rZ, temp())
|
||||
Erase temp2
|
||||
Call multiplyMatrices(result(), temp(), temp2()) 'combine with z rotation
|
||||
|
||||
Call getTranslationMatrix(tX, tY, tZ, temp())
|
||||
Erase result
|
||||
Call multiplyMatrices(temp2(), temp(), result()) 'combine with translation
|
||||
|
||||
End Sub
|
||||
|
||||
Sub getNewXYZ (X, Y, Z, combinedMatrix())
|
||||
|
||||
newX = (combinedMatrix(0, 0) * X) + (combinedMatrix(0, 1) * Y) + (combinedMatrix(0, 2) * Z) + combinedMatrix(0, 3) 'new X point
|
||||
newY = (combinedMatrix(1, 0) * X) + (combinedMatrix(1, 1) * Y) + (combinedMatrix(1, 2) * Z) + combinedMatrix(1, 3) 'new Y point
|
||||
newZ = (combinedMatrix(2, 0) * X) + (combinedMatrix(2, 1) * Y) + (combinedMatrix(2, 2) * Z) + combinedMatrix(2, 3) 'new Z point
|
||||
|
||||
X = newX
|
||||
Y = newY
|
||||
Z = newZ
|
||||
|
||||
End Sub
|
||||
|
||||
Sub getRotationXMatrix (rX, result())
|
||||
|
||||
result(0, 0) = 1
|
||||
result(1, 0) = 0
|
||||
result(2, 0) = 0
|
||||
result(3, 0) = 0
|
||||
|
||||
result(0, 1) = 0
|
||||
result(1, 1) = Cos(rX)
|
||||
result(2, 1) = Sin(rX)
|
||||
result(3, 1) = 0
|
||||
|
||||
result(0, 2) = 0
|
||||
result(1, 2) = -Sin(rX)
|
||||
result(2, 2) = Cos(rX)
|
||||
result(3, 2) = 0
|
||||
|
||||
result(0, 3) = 0
|
||||
result(1, 3) = 0
|
||||
result(2, 3) = 0
|
||||
result(3, 3) = 1
|
||||
|
||||
End Sub
|
||||
|
||||
Sub getRotationYMatrix (rY, result())
|
||||
|
||||
result(0, 0) = Cos(rY)
|
||||
result(1, 0) = 0
|
||||
result(2, 0) = -Sin(rY)
|
||||
result(3, 0) = 0
|
||||
|
||||
result(0, 1) = 0
|
||||
result(1, 1) = 1
|
||||
result(2, 1) = 0
|
||||
result(3, 1) = 0
|
||||
|
||||
result(0, 2) = Sin(rY)
|
||||
result(1, 2) = 0
|
||||
result(2, 2) = Cos(rY)
|
||||
result(3, 2) = 0
|
||||
|
||||
result(0, 3) = 0
|
||||
result(1, 3) = 0
|
||||
result(2, 3) = 0
|
||||
result(3, 3) = 1
|
||||
|
||||
End Sub
|
||||
|
||||
Sub getRotationZMatrix (rZ, result())
|
||||
|
||||
result(0, 0) = Cos(rZ)
|
||||
result(1, 0) = Sin(rZ)
|
||||
result(2, 0) = 0
|
||||
result(3, 0) = 0
|
||||
|
||||
result(0, 1) = -Sin(rZ)
|
||||
result(1, 1) = Cos(rZ)
|
||||
result(2, 1) = 0
|
||||
result(3, 1) = 0
|
||||
|
||||
result(0, 2) = 0
|
||||
result(1, 2) = 0
|
||||
result(2, 2) = 1
|
||||
result(3, 2) = 0
|
||||
|
||||
result(0, 3) = 0
|
||||
result(1, 3) = 0
|
||||
result(2, 3) = 0
|
||||
result(3, 3) = 1
|
||||
|
||||
End Sub
|
||||
|
||||
Sub getScalingMatrix (sX, sY, sZ, result())
|
||||
|
||||
result(0, 0) = sX
|
||||
result(1, 0) = 0
|
||||
result(2, 0) = 0
|
||||
result(3, 0) = 0
|
||||
|
||||
result(0, 1) = 0
|
||||
result(1, 1) = sY
|
||||
result(2, 1) = 0
|
||||
result(3, 1) = 0
|
||||
|
||||
result(0, 2) = 0
|
||||
result(1, 2) = 0
|
||||
result(2, 2) = sZ
|
||||
result(3, 2) = 0
|
||||
|
||||
result(0, 3) = 0
|
||||
result(1, 3) = 0
|
||||
result(2, 3) = 0
|
||||
result(3, 3) = 1
|
||||
|
||||
End Sub
|
||||
|
||||
Sub getScreenXY (X, Y, Z)
|
||||
|
||||
If Z = 0 Then
|
||||
X = X * 280
|
||||
Y = Y * 240
|
||||
Else
|
||||
X = (X * 280) / Z
|
||||
Y = (Y * 240) / Z
|
||||
End If
|
||||
|
||||
X = Int(X + 160)
|
||||
Y = Int(Y + 100)
|
||||
|
||||
End Sub
|
||||
|
||||
Sub getTranslationMatrix (tX, tY, tZ, result())
|
||||
|
||||
result(0, 0) = 1
|
||||
result(1, 0) = 0
|
||||
result(2, 0) = 0
|
||||
result(3, 0) = 0
|
||||
|
||||
result(0, 1) = 0
|
||||
result(1, 1) = 1
|
||||
result(2, 1) = 0
|
||||
result(3, 1) = 0
|
||||
|
||||
result(0, 2) = 0
|
||||
result(1, 2) = 0
|
||||
result(2, 2) = 1
|
||||
result(3, 2) = 0
|
||||
|
||||
result(0, 3) = tX
|
||||
result(1, 3) = tY
|
||||
result(2, 3) = tZ
|
||||
result(3, 3) = 1
|
||||
|
||||
End Sub
|
||||
|
||||
Sub multiplyMatrices (matrixA(), matrixB(), result())
|
||||
|
||||
For i = 0 To 3
|
||||
For j = 0 To 3
|
||||
For k = 0 To 3
|
||||
result(j, i) = result(j, i) + (matrixB(j, k) * matrixA(k, i))
|
||||
Next k
|
||||
Next j
|
||||
Next i
|
||||
|
||||
End Sub
|
||||
|
||||
Sub ReadChunkInfo (ChunkInfoHolder As ChunkInfo, BytePosition As Long)
|
||||
|
||||
Get #1, BytePosition, ChunkInfoHolder.ID
|
||||
Get #1, BytePosition + 2, ChunkInfoHolder.Size
|
||||
ChunkInfoHolder.Position = BytePosition
|
||||
|
||||
End Sub
|
||||
|
||||
Sub ReadObject
|
||||
|
||||
Dim ChunkH As ChunkInfo
|
||||
CurrentBytePosition = 1 'start of file
|
||||
Call ReadChunkInfo(ChunkH, CurrentBytePosition)
|
||||
FindChunk$ = "3D3D"
|
||||
Call SearchForChunk(ChunkH) 'CBP should now be 3D3D(EDIT3DS)
|
||||
Call ReadChunkInfo(ChunkH, CurrentBytePosition)
|
||||
FindChunk$ = "4000"
|
||||
Call SearchForChunk(ChunkH) 'CBP should now be 4000(NAMED_OBJECT)
|
||||
'\/Read & display object name
|
||||
i = 0
|
||||
Do
|
||||
ObjectName$ = " "
|
||||
Get #1, CurrentBytePosition + 6 + i, ObjectName$
|
||||
i = i + 1
|
||||
Loop Until Asc(ObjectName$) = 0
|
||||
ObjectName$ = String$(i - 1, " ")
|
||||
Get #1, CurrentBytePosition + 6, ObjectName$
|
||||
Print "Object Name: "; ObjectName$
|
||||
'/\Read & display object name
|
||||
Call ReadChunkInfo(ChunkH, CurrentBytePosition)
|
||||
ChunkH.Position = CurrentBytePosition + i 'skip past name area
|
||||
ChunkH.Size = ChunkH.Size - i 'skip past name area
|
||||
FindChunk$ = "4100"
|
||||
Call SearchForChunk(ChunkH) 'CBP should now be 4100(OBJ_MESH)
|
||||
Call ReadChunkInfo(ChunkH, CurrentBytePosition)
|
||||
Dim BackupBytePosition As Long
|
||||
BackupBytePosition = CurrentBytePosition
|
||||
FindChunk$ = "4110"
|
||||
Call SearchForChunk(ChunkH) 'CBP should now be 4110(MESH_VERTICES)
|
||||
'\/Read & display vertices
|
||||
'Number of vertices
|
||||
CurrentBytePosition = CurrentBytePosition + 6
|
||||
Get #1, CurrentBytePosition, numberVertices
|
||||
Print "Number of vertices:"; numberVertices
|
||||
ReDim PointsArray(2, numberVertices) As Single 'allocate space for 3d points
|
||||
ReDim NewPointsArray(1, numberVertices) As Long 'allocate space for screen points
|
||||
CurrentBytePosition = CurrentBytePosition + 2
|
||||
'Actual vertice data
|
||||
Dim vertex As Single
|
||||
For i = 0 To numberVertices
|
||||
Get #1, CurrentBytePosition, vertex
|
||||
'PRINT "X-vertex"; vertex
|
||||
PointsArray(0, i) = vertex
|
||||
CurrentBytePosition = CurrentBytePosition + 4
|
||||
Get #1, CurrentBytePosition, vertex
|
||||
'PRINT "Y-vertex"; vertex
|
||||
PointsArray(1, i) = vertex
|
||||
CurrentBytePosition = CurrentBytePosition + 4
|
||||
Get #1, CurrentBytePosition, vertex
|
||||
'PRINT "Z-vertex"; vertex
|
||||
PointsArray(2, i) = vertex
|
||||
CurrentBytePosition = CurrentBytePosition + 4
|
||||
Next i
|
||||
'/\Read & display vertices
|
||||
Call ReadChunkInfo(ChunkH, BackupBytePosition) 'ChunkH should now be 4100(OBJ_MESH)
|
||||
FindChunk$ = "4120"
|
||||
Call SearchForChunk(ChunkH) 'CBP should now be 4120(MESH_FACES)
|
||||
'\/Read & display faces
|
||||
'Number of faces
|
||||
CurrentBytePosition = CurrentBytePosition + 6
|
||||
Get #1, CurrentBytePosition, numberFaces
|
||||
Print "Number of faces:"; numberFaces
|
||||
ReDim FaceArray(2, numberFaces) As Integer 'allocate space for face points
|
||||
CurrentBytePosition = CurrentBytePosition + 2
|
||||
'Actual face data
|
||||
Dim face As Integer
|
||||
For i = 0 To numberFaces
|
||||
Get #1, CurrentBytePosition, face
|
||||
'PRINT "Face-point 1:"; face
|
||||
FaceArray(0, i) = face
|
||||
CurrentBytePosition = CurrentBytePosition + 2
|
||||
Get #1, CurrentBytePosition, face
|
||||
'PRINT "Face-point 2:"; face
|
||||
FaceArray(1, i) = face
|
||||
CurrentBytePosition = CurrentBytePosition + 2
|
||||
Get #1, CurrentBytePosition, face
|
||||
'PRINT "Face-point 3:"; face
|
||||
FaceArray(2, i) = face
|
||||
CurrentBytePosition = CurrentBytePosition + 2
|
||||
Get #1, CurrentBytePosition, face
|
||||
'PRINT "Face-visibility:"; face
|
||||
CurrentBytePosition = CurrentBytePosition + 2
|
||||
Next i
|
||||
'\/Read & display faces
|
||||
|
||||
|
||||
End Sub
|
||||
|
||||
Sub SearchForChunk (ChunkInfoHolder As ChunkInfo)
|
||||
|
||||
Dim InnerBytePosition As Long
|
||||
Dim MaxBytePosition As Long
|
||||
InnerBytePosition = ChunkInfoHolder.Position + 6
|
||||
MaxBytePosition = ChunkInfoHolder.Position + ChunkInfoHolder.Size
|
||||
ChunkName$ = Hex$(ChunkInfoHolder.ID)
|
||||
|
||||
Found = 0
|
||||
|
||||
Do
|
||||
|
||||
Call ReadChunkInfo(ChunkInfoHolder, InnerBytePosition)
|
||||
|
||||
If FindChunk$ = Hex$(ChunkInfoHolder.ID) Then
|
||||
Found = 1
|
||||
Else
|
||||
Call SkipChunk(ChunkInfoHolder, InnerBytePosition)
|
||||
End If
|
||||
|
||||
Loop Until InnerBytePosition >= MaxBytePosition Or Found = 1 Or InKey$ = Chr$(27) Or ChunkInfoHolder.Size = 0
|
||||
|
||||
If Found = 0 Then
|
||||
Print ""
|
||||
Print FindChunk$; " was not found within "; ChunkName$; "!"
|
||||
Print ""
|
||||
System
|
||||
Else
|
||||
CurrentBytePosition = ChunkInfoHolder.Position
|
||||
End If
|
||||
|
||||
End Sub
|
||||
|
||||
Sub SkipChunk (ChunkInfoHolder As ChunkInfo, BytePosition As Long)
|
||||
|
||||
BytePosition = BytePosition + ChunkInfoHolder.Size
|
||||
|
||||
End Sub
|
||||
|
||||
BIN
samples/3ds-viewer/src/3dsviewer.zip
Normal file
BIN
samples/3ds-viewer/src/3dsviewer.zip
Normal file
Binary file not shown.
BIN
samples/3ds-viewer/src/car.3ds
Normal file
BIN
samples/3ds-viewer/src/car.3ds
Normal file
Binary file not shown.
33
samples/a&a-de-pasquale.md
Normal file
33
samples/a&a-de-pasquale.md
Normal file
|
|
@ -0,0 +1,33 @@
|
|||
[Home](https://qb64.com) • [News](../news.md) • [GitHub](../github.md) • [Wiki](../wiki.md) • [Samples](../samples.md) • [Media](../media.md) • [Community](../community.md) • [Rolodex](../rolodex.md) • [More...](../more.md)
|
||||
|
||||
## SAMPLES BY A&A DE PASQUALE
|
||||
|
||||
**[Calendar](calendar/index.md)**
|
||||
|
||||
[🐝 A&A De Pasquale](a&a-de-pasquale.md) 🔗 [calendar](calendar.md), [pdf](pdf.md), [dos world](dos-world.md)
|
||||
|
||||
' Antonio & Alfonso De Pasquale ' Copyright (C) 1993 DOS Resource Guide ' Published in Issue #8, ...
|
||||
|
||||
**[Dec to Frac](dec-to-frac/index.md)**
|
||||
|
||||
[🐝 A&A De Pasquale](a&a-de-pasquale.md) 🔗 [math](math.md), [dos world](dos-world.md)
|
||||
|
||||
' DEC_FRAC.BAS - Fraction/Decimal conversion functions ' and sample program ' b...
|
||||
|
||||
**[Hangman](hangman/index.md)**
|
||||
|
||||
[🐝 A&A De Pasquale](a&a-de-pasquale.md) 🔗 [game](game.md), [hangman](hangman.md), [dos world](dos-world.md)
|
||||
|
||||
' HANGMAN.BAS by Antonio & Alfonso De Pasquale ' Copyright (C) 1993, 1994 DOS Resource Guide ' ...
|
||||
|
||||
**[Letter Blast](letter-blast/index.md)**
|
||||
|
||||
[🐝 A&A De Pasquale](a&a-de-pasquale.md) 🔗 [game](game.md), [letter](letter.md), [dos world](dos-world.md)
|
||||
|
||||
' LETBLAST.BAS - Shoot the falling letters! ' by Antonio & Alfonso De Pasquale ' ' Copyr...
|
||||
|
||||
**[Measure](measure/index.md)**
|
||||
|
||||
[🐝 A&A De Pasquale](a&a-de-pasquale.md) 🔗 [measure](measure.md), [dos world](dos-world.md)
|
||||
|
||||
' MEASURE.BAS - A program for performing measurement conversions ' by Antonio & Alfonso De P...
|
||||
9
samples/ai.md
Normal file
9
samples/ai.md
Normal file
|
|
@ -0,0 +1,9 @@
|
|||
[Home](https://qb64.com) • [News](../news.md) • [GitHub](../github.md) • [Wiki](../wiki.md) • [Samples](../samples.md) • [Media](../media.md) • [Community](../community.md) • [Rolodex](../rolodex.md) • [More...](../more.md)
|
||||
|
||||
## SAMPLES: AI
|
||||
|
||||
**[Eliza](eliza/index.md)**
|
||||
|
||||
[🐝 *missing*](author-missing.md) 🔗 [ai](ai.md), [eliza](eliza.md)
|
||||
|
||||
The original chatbot, Eliza.
|
||||
15
samples/alan-zeichick.md
Normal file
15
samples/alan-zeichick.md
Normal file
|
|
@ -0,0 +1,15 @@
|
|||
[Home](https://qb64.com) • [News](../news.md) • [GitHub](../github.md) • [Wiki](../wiki.md) • [Samples](../samples.md) • [Media](../media.md) • [Community](../community.md) • [Rolodex](../rolodex.md) • [More...](../more.md)
|
||||
|
||||
## SAMPLES BY ALAN ZEICHICK
|
||||
|
||||
**[Loan Amortization](loan-amortization/index.md)**
|
||||
|
||||
[🐝 Alan Zeichick](alan-zeichick.md) 🔗 [finance](finance.md), [dos world](dos-world.md)
|
||||
|
||||
' Loan amortization program ' Alan Zeichick, March 16, 1993 ' Copyright (c) 1993 DOS Resource Gui...
|
||||
|
||||
**[QB Clock](qb-clock/index.md)**
|
||||
|
||||
[🐝 Alan Zeichick](alan-zeichick.md) 🔗 [clock](clock.md)
|
||||
|
||||
' Analog Clock for QBasic ' by Alan Zeichick copyright (c) 1986, 1992 ' Copyright (C) 1992 DOS Re...
|
||||
|
|
@ -13,3 +13,15 @@ A Graphics/Animation utility by Bob Seguin. NOTE: This game requires graphics f
|
|||
[🐝 Zom-B](zom-b.md) 🔗 [fractal](fractal.md), [art](art.md)
|
||||
|
||||
This is [...] a series of fractal artworks that I ported from Ultra Fractal to Quick Basic 4.5 wi...
|
||||
|
||||
**[Kaleidoscope 3D](kaleidoscope-3d/index.md)**
|
||||
|
||||
[🐝 qbguy](qbguy.md) 🔗 [3d](3d.md), [art](art.md)
|
||||
|
||||
Move mouse to rotate, escape to quit
|
||||
|
||||
**[Kaleidoscope Doodler](kaleidoscope-doodler/index.md)**
|
||||
|
||||
[🐝 qbguy](qbguy.md) 🔗 [art](art.md), [drawing](drawing.md)
|
||||
|
||||
Left-click to draw, right click or middle click to clear screen, escape to quit.
|
||||
|
|
|
|||
9
samples/artelius.md
Normal file
9
samples/artelius.md
Normal file
|
|
@ -0,0 +1,9 @@
|
|||
[Home](https://qb64.com) • [News](../news.md) • [GitHub](../github.md) • [Wiki](../wiki.md) • [Samples](../samples.md) • [Media](../media.md) • [Community](../community.md) • [Rolodex](../rolodex.md) • [More...](../more.md)
|
||||
|
||||
## SAMPLES BY ARTELIUS
|
||||
|
||||
**[Jpeg Maker](jpeg-maker/index.md)**
|
||||
|
||||
[🐝 Artelius](artelius.md) 🔗 [jpeg](jpeg.md), [image manipulation](image-manipulation.md)
|
||||
|
||||
'JPEG Encoder v2 by Artelius 'WARNING: OVERWRITES TEST.JPG
|
||||
|
|
@ -2,6 +2,12 @@
|
|||
|
||||
## SAMPLES: ARTILLERY
|
||||
|
||||
**[Gorillas](gorillas/index.md)**
|
||||
|
||||
[🐝 Microsoft](microsoft.md) 🔗 [game](game.md), [artillery](artillery.md)
|
||||
|
||||
Gorilla-based artillery game by Microsoft.
|
||||
|
||||
**[QShips](qships/index.md)**
|
||||
|
||||
[🐝 Microsoft](microsoft.md) 🔗 [game](game.md), [artillery](artillery.md)
|
||||
|
|
|
|||
15
samples/ashish-kushwaha.md
Normal file
15
samples/ashish-kushwaha.md
Normal file
|
|
@ -0,0 +1,15 @@
|
|||
[Home](https://qb64.com) • [News](../news.md) • [GitHub](../github.md) • [Wiki](../wiki.md) • [Samples](../samples.md) • [Media](../media.md) • [Community](../community.md) • [Rolodex](../rolodex.md) • [More...](../more.md)
|
||||
|
||||
## SAMPLES BY ASHISH KUSHWAHA
|
||||
|
||||
**[3D Grapher](3d-grapher/index.md)**
|
||||
|
||||
[🐝 Ashish Kushwaha](ashish-kushwaha.md) [🐝 STxAxTIC](stxaxtic.md) 🔗 [3d](3d.md), [gl](gl.md)
|
||||
|
||||
3D Grapher made in QB64.
|
||||
|
||||
**[Hunters Revenge](hunters-revenge/index.md)**
|
||||
|
||||
[🐝 Ashish Kushwaha](ashish-kushwaha.md) 🔗 [game](game.md), [shooter](shooter.md)
|
||||
|
||||
# Hunter-Revenge A shooting game created in QB64
|
||||
|
|
@ -2,4 +2,4 @@
|
|||
|
||||
## AUTHORS
|
||||
|
||||
[Microsoft:27](microsoft.md) • [Antoni Gual:25](antoni-gual.md) • [Fellippe Heitor:19](fellippe-heitor.md) • [*missing*:15](author-missing.md) • [RhoSigma:11](rhosigma.md) • [bplus:9](bplus.md) • [Rho Sigma:9](rho-sigma.md) • [Bob Seguin:5](bob-seguin.md) • [Relsoft:5](relsoft.md) • [STxAxTIC:5](stxaxtic.md) • [Richard Frost:3](richard-frost.md) • [vince:3](vince.md) • [Zom-B:3](zom-b.md) • [Chris Chadwick:1](chris-chadwick.md) • [Cobalt:1](cobalt.md) • [Cyperium:1](cyperium.md) • [darokin:1](darokin.md) • [Dav:1](dav.md) • [David Joffe:1](david-joffe.md) • [Folker Fritz:1](folker-fritz.md) • [Glenn Powell:1](glenn-powell.md) • [Jeh:1](jeh.md) • [Jeremy Munn:1](jeremy-munn.md) • [JKC:1](jkc.md) • [Matthew:1](matthew.md) • [Mennonite:1](mennonite.md) • [Paul Meyer:1](paul-meyer.md) • [pcluddite:1](pcluddite.md) • [Petr:1](petr.md) • [Philipp Strathausen:1](philipp-strathausen.md) • [QB64 Team 2018:1](qb64-team-2018.md) • [qbguy:1](qbguy.md) • [RETROQB45:1](retroqb45.md) • [Steve M.:1](steve-m..md) • [Timothy Baxendale:1](timothy-baxendale.md) • [TrialAndTerror:1](trialandterror.md) • [triggered:1](triggered.md) • [Tsiplacov Sergey:1](tsiplacov-sergey.md) • [TylerDarko:1](tylerdarko.md) • [Yu:1](yu.md)
|
||||
[Microsoft:31](microsoft.md) • [Fellippe Heitor:27](fellippe-heitor.md) • [Antoni Gual:25](antoni-gual.md) • [*missing*:23](author-missing.md) • [STxAxTIC:23](stxaxtic.md) • [Rho Sigma:19](rho-sigma.md) • [qbguy:11](qbguy.md) • [A&A De Pasquale:9](a&a-de-pasquale.md) • [bplus:9](bplus.md) • [Bob Seguin:7](bob-seguin.md) • [Terry Ritchie:7](terry-ritchie.md) • [Hardin Brothers:5](hardin-brothers.md) • [Relsoft:5](relsoft.md) • [Richard Frost:5](richard-frost.md) • [Zom-B:5](zom-b.md) • [Alan Zeichick:3](alan-zeichick.md) • [Ashish Kushwaha:3](ashish-kushwaha.md) • [Cyperium:3](cyperium.md) • [Dav:3](dav.md) • [vince:3](vince.md) • [Artelius:1](artelius.md) • [Brian Murphy:1](brian-murphy.md) • [Chris Chadwick:1](chris-chadwick.md) • [Cobalt:1](cobalt.md) • [Danilin:1](danilin.md) • [darokin:1](darokin.md) • [David Bannon:1](david-bannon.md) • [David Ferrier:1](david-ferrier.md) • [David Joffe:1](david-joffe.md) • [Dietmar Moritz:1](dietmar-moritz.md) • [Douglas Park:1](douglas-park.md) • [Folker Fritz:1](folker-fritz.md) • [Galleon:1](galleon.md) • [Glenn Powell:1](glenn-powell.md) • [harixxx:1](harixxx.md) • [Jeh:1](jeh.md) • [Jeremy Munn:1](jeremy-munn.md) • [JKC:1](jkc.md) • [John Wolfskill:1](john-wolfskill.md) • [Kevin:1](kevin.md) • [kinem:1](kinem.md) • [Leif J. Burrow:1](leif-j.-burrow.md) • [Lucid:1](lucid.md) • [Luke:1](luke.md) • [Matt Bross:1](matt-bross.md) • [Matthew:1](matthew.md) • [Matthew River Knight:1](matthew-river-knight.md) • [Mennonite:1](mennonite.md) • [Michael Fogleman:1](michael-fogleman.md) • [Nathan Thomas:1](nathan-thomas.md) • [Paul Meyer:1](paul-meyer.md) • [pcluddite:1](pcluddite.md) • [Petr:1](petr.md) • [Philipp Strathausen:1](philipp-strathausen.md) • [QB64 Team 2018:1](qb64-team-2018.md) • [RETROQB45:1](retroqb45.md) • [RhoSigma:1](rhosigma.md) • [rpgfan3233:1](rpgfan3233.md) • [Steve M.:1](steve-m..md) • [Timothy Baxendale:1](timothy-baxendale.md) • [Tor Myklebust:1](tor-myklebust.md) • [TrialAndTerror:1](trialandterror.md) • [triggered:1](triggered.md) • [Tsiplacov Sergey:1](tsiplacov-sergey.md) • [TylerDarko:1](tylerdarko.md) • [William Loughner:1](william-loughner.md) • [Yu:1](yu.md) • [Zack Johnson:1](zack-johnson.md)
|
||||
|
|
@ -2,7 +2,25 @@
|
|||
|
||||
## SAMPLES BY *MISSING*
|
||||
|
||||
**[Fire](fire/index.md)**
|
||||
**[3DS Viewer](3ds-viewer/index.md)**
|
||||
|
||||
[🐝 *missing*](author-missing.md) 🔗 [3d](3d.md), [wireframe](wireframe.md), [legacy](legacy.md)
|
||||
|
||||
3D Grapher made in QB64.
|
||||
|
||||
**[Double Pendulum](double-pendulum/index.md)**
|
||||
|
||||
[🐝 *missing*](author-missing.md) 🔗 [physics](physics.md), [pendulum](pendulum.md)
|
||||
|
||||
Simulated double pendulum with damping.
|
||||
|
||||
**[Eliza](eliza/index.md)**
|
||||
|
||||
[🐝 *missing*](author-missing.md) 🔗 [ai](ai.md), [eliza](eliza.md)
|
||||
|
||||
The original chatbot, Eliza.
|
||||
|
||||
**[Fire 13](fire-13/index.md)**
|
||||
|
||||
[🐝 *missing*](author-missing.md) 🔗 [fire](fire.md), [graphics](graphics.md)
|
||||
|
||||
|
|
@ -20,11 +38,11 @@ The legendary fractal fern.
|
|||
|
||||
Mandelbrot animator.
|
||||
|
||||
**[Mandelbrot Zoomer](mandelbrot-zoomer/index.md)**
|
||||
**[Rockets](rockets/index.md)**
|
||||
|
||||
[🐝 *missing*](author-missing.md) 🔗 [fractal](fractal.md), [mandelbrot](mandelbrot.md)
|
||||
[🐝 *missing*](author-missing.md) 🔗 [screensaver](screensaver.md), [particles](particles.md)
|
||||
|
||||
'QBDEMO (C) 2002 Tor Myklebust 'The fractal zoomer should run at 60FPS on a 500MHz machine. I d...
|
||||
Screensaver with rocket-like particles.
|
||||
|
||||
**[Shooter](shooter/index.md)**
|
||||
|
||||
|
|
@ -38,6 +56,12 @@ Mandelbrot animator.
|
|||
|
||||
Sine Wave Explorer
|
||||
|
||||
**[Stock Watcher](stock-watcher/index.md)**
|
||||
|
||||
[🐝 *missing*](author-missing.md) 🔗 [money](money.md), [stocks](stocks.md)
|
||||
|
||||
Stock Watcher program.
|
||||
|
||||
**[Tower of Hanoi](tower-of-hanoi/index.md)**
|
||||
|
||||
[🐝 *missing*](author-missing.md) 🔗 [game](game.md), [tower](tower.md)
|
||||
|
|
|
|||
9
samples/automata.md
Normal file
9
samples/automata.md
Normal file
|
|
@ -0,0 +1,9 @@
|
|||
[Home](https://qb64.com) • [News](../news.md) • [GitHub](../github.md) • [Wiki](../wiki.md) • [Samples](../samples.md) • [Media](../media.md) • [Community](../community.md) • [Rolodex](../rolodex.md) • [More...](../more.md)
|
||||
|
||||
## SAMPLES: AUTOMATA
|
||||
|
||||
**[Conways Game of Life](conways-game-of-life/index.md)**
|
||||
|
||||
[🐝 Luke](luke.md) 🔗 [automata](automata.md), [conway](conway.md)
|
||||
|
||||
Standard Conway's Game of Life simulation.
|
||||
BIN
samples/bad-box-revenge/img/screenshot.png
Normal file
BIN
samples/bad-box-revenge/img/screenshot.png
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 12 KiB |
26
samples/bad-box-revenge/index.md
Normal file
26
samples/bad-box-revenge/index.md
Normal file
|
|
@ -0,0 +1,26 @@
|
|||
[Home](https://qb64.com) • [News](../../news.md) • [GitHub](../../github.md) • [Wiki](../../wiki.md) • [Samples](../../samples.md) • [Media](../../media.md) • [Community](../../community.md) • [Rolodex](../../rolodex.md) • [More...](../../more.md)
|
||||
|
||||
## SAMPLE: BAD BOX REVENGE
|
||||
|
||||
|
||||
|
||||
### Author
|
||||
|
||||
[🐝 Terry Ritchie](../terry-ritchie.md)
|
||||
|
||||
### Description
|
||||
|
||||
```text
|
||||
'**
|
||||
'** Revenge of the Bad Boxes! V1.0
|
||||
'**
|
||||
'** by Terry Ritchie 02/11/13
|
||||
'**
|
||||
```
|
||||
|
||||
### File(s)
|
||||
|
||||
* [revenge.bas](src/revenge.bas)
|
||||
* [revenge.zip](src/revenge.zip)
|
||||
|
||||
🔗 [game](../game.md), [bad boxes](../bad-boxes.md)
|
||||
1085
samples/bad-box-revenge/src/revenge.bas
Normal file
1085
samples/bad-box-revenge/src/revenge.bas
Normal file
File diff suppressed because it is too large
Load diff
BIN
samples/bad-box-revenge/src/revenge.zip
Normal file
BIN
samples/bad-box-revenge/src/revenge.zip
Normal file
Binary file not shown.
15
samples/bad-boxes.md
Normal file
15
samples/bad-boxes.md
Normal file
|
|
@ -0,0 +1,15 @@
|
|||
[Home](https://qb64.com) • [News](../news.md) • [GitHub](../github.md) • [Wiki](../wiki.md) • [Samples](../samples.md) • [Media](../media.md) • [Community](../community.md) • [Rolodex](../rolodex.md) • [More...](../more.md)
|
||||
|
||||
## SAMPLES: BAD BOXES
|
||||
|
||||
**[Bad Box Revenge](bad-box-revenge/index.md)**
|
||||
|
||||
[🐝 Terry Ritchie](terry-ritchie.md) 🔗 [game](game.md), [bad boxes](bad-boxes.md)
|
||||
|
||||
'** '** Revenge of the Bad Boxes! V1.0 '** '** by Terry Ritchie 02/11/13 '**
|
||||
|
||||
**[Bad Boxes](bad-boxes/index.md)**
|
||||
|
||||
[🐝 Terry Ritchie](terry-ritchie.md) 🔗 [game](game.md), [bad boxes](bad-boxes.md)
|
||||
|
||||
'** '** Program Name: Bad Boxes '** Version : 1.0 '** Author : Terry Ritchie '** Date ...
|
||||
BIN
samples/bad-boxes/img/screenshot.png
Normal file
BIN
samples/bad-boxes/img/screenshot.png
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 15 KiB |
32
samples/bad-boxes/index.md
Normal file
32
samples/bad-boxes/index.md
Normal file
|
|
@ -0,0 +1,32 @@
|
|||
[Home](https://qb64.com) • [News](../../news.md) • [GitHub](../../github.md) • [Wiki](../../wiki.md) • [Samples](../../samples.md) • [Media](../../media.md) • [Community](../../community.md) • [Rolodex](../../rolodex.md) • [More...](../../more.md)
|
||||
|
||||
## SAMPLE: BAD BOXES
|
||||
|
||||
|
||||
|
||||
### Author
|
||||
|
||||
[🐝 Terry Ritchie](../terry-ritchie.md)
|
||||
|
||||
### Description
|
||||
|
||||
```text
|
||||
'**
|
||||
'** Program Name: Bad Boxes
|
||||
'** Version : 1.0
|
||||
'** Author : Terry Ritchie
|
||||
'** Date : January 23rd, 2013
|
||||
'** Description : Use your yellow box to capture the green (good) boxes for points while avoiding the red (bad) boxes.
|
||||
'**
|
||||
'** Controls : Use the mouse to move the yellow box around the screen.
|
||||
'**
|
||||
'** Notes : Good luck! The game gets progrssively harder.
|
||||
'**
|
||||
```
|
||||
|
||||
### File(s)
|
||||
|
||||
* [badbox.bas](src/badbox.bas)
|
||||
* [badbox.zip](src/badbox.zip)
|
||||
|
||||
🔗 [game](../game.md), [bad boxes](../bad-boxes.md)
|
||||
349
samples/bad-boxes/src/badbox.bas
Normal file
349
samples/bad-boxes/src/badbox.bas
Normal file
|
|
@ -0,0 +1,349 @@
|
|||
'**
|
||||
'** Program Name: Bad Boxes
|
||||
'** Version : 1.0
|
||||
'** Author : Terry Ritchie
|
||||
'** Date : January 23rd, 2013
|
||||
'** Description : Use your yellow box to capture the green (good) boxes for points while avoiding the red (bad) boxes.
|
||||
'**
|
||||
'** Controls : Use the mouse to move the yellow box around the screen.
|
||||
'**
|
||||
'** Notes : Good luck! The game gets progrssively harder.
|
||||
'**
|
||||
|
||||
'************************************
|
||||
'* *
|
||||
'* INITIALIZATION SECTION * *********************************************************************************
|
||||
'* *
|
||||
'************************************
|
||||
|
||||
Const FALSE = 0, TRUE = Not FALSE ' booleans used to test/set for truth
|
||||
Const SWIDTH = 1280 ' width of screen
|
||||
Const SHEIGHT = 720 ' height of screen
|
||||
Const MINWIDTH = SWIDTH / 20 ' minimum width of a square box
|
||||
Const MAXWIDTH = SWIDTH / 10 ' maximum width of a square box
|
||||
Const MAXBOXES = 100 ' maximum number of boxes to ever appear on screen
|
||||
Const HEADS = TRUE ' used in coin toss function
|
||||
Const TAILS = FALSE ' used in coin toss function
|
||||
Const DIFFICULTY = 1 ' difficulty level of game (1 - easy to 10 - HARD!)
|
||||
Const TEXTWIDTH = SWIDTH / 8 ' the maximum text characters the given screen can have
|
||||
|
||||
Type BOX ' box object (spreadsheet columns)
|
||||
Xpos As Single ' X location of box on screen
|
||||
Ypos As Single ' Y location of box on screen
|
||||
Xvel As Single ' X (horizontal) velocity of box
|
||||
Yvel As Single ' Y (vertical) velocity of box
|
||||
Size As Integer ' length of each side of box
|
||||
Colour As _Unsigned Long ' color of box (green = good guy, red = bad guy)
|
||||
End Type
|
||||
|
||||
Dim Box(MAXBOXES) As BOX ' create array (spreadsheet) to hold MAXBOXES rows of information
|
||||
Dim Saying$(20) ' sayings the game can display to you while playing
|
||||
Dim Player As BOX ' create player character
|
||||
Dim BoxesOnScreen% ' total number of boxes currently allowed on screen
|
||||
Dim Box% ' a generic counter
|
||||
Dim maxspeed! ' the current maximum speed boxes are allowed to obtain
|
||||
Dim Frame% ' keeps track of the number of frames that have elapsed
|
||||
Dim Score% ' the player's score
|
||||
Dim GameOver% ' will go TRUE when the game is over
|
||||
Dim Boxbackground& ' background music
|
||||
Dim Boxgameover& ' that's it man .. game over man, game over
|
||||
Dim Boxgreen&(4) ' green box hit sounds
|
||||
Dim Boxlevelup& ' level up sound
|
||||
Dim Boxquit& ' laughing demon sound
|
||||
Dim Boxred& ' red box hit sound
|
||||
|
||||
'************************************
|
||||
'* *
|
||||
'* MAIN CODE SECTION * *********************************************************************************
|
||||
'* *
|
||||
'************************************
|
||||
|
||||
Boxbackground& = _SndOpen("boxbackground.ogg", "VOL,SYNC,LEN") ' load the game sounds into memory
|
||||
Boxgameover& = _SndOpen("boxgameover.ogg", "VOL,SYNC,LEN")
|
||||
Boxgreen&(1) = _SndOpen("boxgreen1.ogg", "VOL,SYNC,LEN")
|
||||
Boxgreen&(2) = _SndOpen("boxgreen2.ogg", "VOL,SYNC,LEN")
|
||||
Boxgreen&(3) = _SndOpen("boxgreen3.ogg", "VOL,SYNC,LEN")
|
||||
Boxgreen&(4) = _SndOpen("boxgreen4.ogg", "VOL,SYNC,LEN")
|
||||
Boxlevelup& = _SndOpen("boxlevelup.ogg", "VOL,SYNC,LEN")
|
||||
Boxquit& = _SndOpen("boxquit.ogg", "VOL,SYNC,LEN")
|
||||
Boxred& = _SndOpen("boxred.ogg", "VOL,SYNC,LEN")
|
||||
|
||||
maxspeed! = 1 ' start the game with a maximum box speed of 1
|
||||
BoxesOnScreen% = 20 ' start the game with 10 boxes on the screen
|
||||
Level% = 1 ' start the game at level 1
|
||||
|
||||
Player.Xpos = SWIDTH / 2 + 1 ' start player in the center X location of screen
|
||||
Player.Ypos = SHEIGHT / 2 + 1 ' start player in the center Y location of screen
|
||||
Player.Size = 10 ' set player's size
|
||||
Player.Colour = _RGB32(255, 255, 0) ' set player's color (yellow)
|
||||
|
||||
For Box% = 1 To BoxesOnScreen% ' cycle through the array of current boxes on screen
|
||||
RANDOMBOX Box% ' assign random properties to each box
|
||||
Next Box%
|
||||
|
||||
Saying$(1) = "Here we go!" ' the twenty taunts the computer can say
|
||||
Saying$(2) = "Off to a good start!"
|
||||
Saying$(3) = "Feeling boxed in yet?"
|
||||
Saying$(4) = "Ok, you're better than average..."
|
||||
Saying$(5) = "Here, have some more boxes!"
|
||||
Saying$(6) = "Come on, die already!"
|
||||
Saying$(7) = "Getting tired yet?"
|
||||
Saying$(8) = "Your momma wears combat boots!"
|
||||
Saying$(9) = "We're coming to get you Barbara..."
|
||||
Saying$(10) = "WooHoo! Sideways baby!"
|
||||
Saying$(11) = "Ok, you might be a little awesome."
|
||||
Saying$(12) = "Are you a machine?"
|
||||
Saying$(13) = "You have got to be cheating!"
|
||||
Saying$(14) = "You are a box evading god!"
|
||||
Saying$(15) = "How are you still alive??"
|
||||
Saying$(16) = "You should take up boxing .. get it?"
|
||||
Saying$(17) = "You have cat like reflexes!"
|
||||
Saying$(18) = "This is simply incredible!"
|
||||
Saying$(19) = "You must have robot in your family tree!"
|
||||
Saying$(20) = "O . M . G . !!!"
|
||||
|
||||
Screen _NewImage(SWIDTH, SHEIGHT, 32) ' display a graphics screen
|
||||
_ScreenMove _Middle ' move the graphics screen to the middle of the desktop
|
||||
_FullScreen ' go to full screen mode
|
||||
_MouseHide ' hide the mouse pointer from the player
|
||||
_MouseMove Player.Xpos - Player.Size / 2, Player.Ypos - Player.Size / 2 ' move the mouse pointer to the player's position
|
||||
|
||||
_SndLoop Boxbackground& ' start the background music
|
||||
_SndVol Boxbackground&, .25 ' turn the background music down to one quarter
|
||||
|
||||
Do ' ** START OF MAIN PROGRAM LOOP **
|
||||
_Limit 120 ' limit the game to 120 frames per second
|
||||
Cls ' clear the screen
|
||||
Frame% = Frame% + 1 ' increment the frame counter
|
||||
If Frame% = Int(1000 / DIFFICULTY) Then ' has this difficulty number of frames passed?
|
||||
_SndPlayCopy Boxlevelup& ' play level up sound
|
||||
Frame% = 0 ' yes, reset the frame counter
|
||||
Level% = Level% + 1 ' increment to the next game level
|
||||
maxspeed! = maxspeed! + .1 ' increase the speed the boxes are allowed to achieve
|
||||
Player.Size = Player.Size + 2 ' increase the size of the player's box
|
||||
If Player.Size > 30 Then Player.Size = 30 ' but don't let the player get larger than 30 pixels
|
||||
BoxesOnScreen% = BoxesOnScreen% + 1 ' add another box to the screen
|
||||
If BoxesOnScreen% > MAXBOXES Then ' have we exceeded the maximum number of boxes allowed?
|
||||
BoxesOnScreen% = MAXBOXES ' yes, don't exceed the maximum number of boxes
|
||||
Else ' no, we have not exceeded the maximum boxes allowed
|
||||
RANDOMBOX BoxesOnScreen% ' assign random properties to this new box
|
||||
End If
|
||||
End If
|
||||
UPDATEPLAYER ' update the player's position on the screen
|
||||
For Box% = 1 To BoxesOnScreen% ' cycle through all the boxes currently on the screen
|
||||
MOVEBOX Box% ' update this box's position on the screen
|
||||
CHECKFORCOLLISION Box% ' check for a collision between this box and the player
|
||||
Next Box%
|
||||
DISPLAYSCORE ' update the score and other on screen information
|
||||
_Display ' display all changes that have been made in this frame
|
||||
Loop Until InKey$ = Chr$(27) Or GameOver% ' end game when player hits red box or presses ESC key
|
||||
' ** END OF MAIN PROGRAM LOOP **
|
||||
_SndStop Boxbackground& ' stop the background music from playing
|
||||
_SndPlayCopy Boxred& ' make one last red box hit sound
|
||||
_Delay 2 ' wait two seconds for defeat to sink in :)
|
||||
_SndPlay Boxgameover& ' play the game over sound clip from aliens
|
||||
Do: Loop Until Not _SndPlaying(Boxgameover&) ' wait until the game over sound clip has finished
|
||||
_SndPlay Boxquit& ' let the little demon make his snarky laugh
|
||||
_Delay 2 ' wait another two seconds
|
||||
End ' ** END OF PROGRAM **
|
||||
|
||||
'************************************
|
||||
'* *
|
||||
'* SUBROUTINE & FUNCTION SECTION * *********************************************************************************
|
||||
'* *
|
||||
'************************************
|
||||
|
||||
'------------------------------------------------------------------------------------------------------------
|
||||
|
||||
Sub DISPLAYSCORE ()
|
||||
|
||||
'**
|
||||
'** Displays the score, level and computer sayings on the screen during game play
|
||||
'**
|
||||
|
||||
Shared Score%
|
||||
Shared Level%
|
||||
Shared Saying$()
|
||||
|
||||
Dim Lvl% ' will hold a copy of the value of Level%
|
||||
|
||||
Locate 1, 2 ' place the cursor at row 1, column 2
|
||||
Print "SCORE:"; Score%; ' print the score at this location
|
||||
Locate 1, TEXTWIDTH - 9 ' place the cursor at row 1, 9 places from the right side of screen
|
||||
Print "LEVEL:"; Level%; ' print the current level player is on
|
||||
Lvl% = Level% ' get a copy of the level number
|
||||
If Lvl% > 20 Then Lvl% = 20 ' if the level is greater than 20 then keep the level at 20
|
||||
Locate 1, (TEXTWIDTH - Len(Saying$(Lvl%))) / 2 ' locate the cursor at row 1, centered in the row for current saying
|
||||
Print Saying$(Lvl%); ' print the current computer saying
|
||||
|
||||
End Sub
|
||||
|
||||
'------------------------------------------------------------------------------------------------------------
|
||||
|
||||
Function BOXCOLLISION (Box1X!, Box1Y!, Box1Width!, Box1Height!, Box2X!, Box2Y!, Box2Width!, Box2Height!)
|
||||
|
||||
'**
|
||||
'** Tests two rectangular areas for collision
|
||||
'**
|
||||
|
||||
If Box1X! <= Box2X! + Box2Width! Then
|
||||
If Box1X! + Box1Width! >= Box2X! Then
|
||||
If Box1Y! <= Box2Y! + Box2Height! Then
|
||||
If Box1Y! + Box1Height! >= Box2Y! Then
|
||||
BOXCOLLISION = TRUE
|
||||
End If
|
||||
End If
|
||||
End If
|
||||
End If
|
||||
|
||||
End Function
|
||||
|
||||
'------------------------------------------------------------------------------------------------------------
|
||||
|
||||
Sub CHECKFORCOLLISION (Box%)
|
||||
|
||||
'**
|
||||
'** Checks for a collision between this box (Box%) and the player's box
|
||||
'**
|
||||
|
||||
Shared Player As BOX
|
||||
Shared Box() As BOX
|
||||
Shared Boxgreen&()
|
||||
Shared Score%
|
||||
Shared GameOver%
|
||||
'
|
||||
'** Check for a box collision between this box and the player
|
||||
'
|
||||
If BOXCOLLISION(Player.Xpos - Player.Size / 2, Player.Ypos - Player.Size / 2, Player.Size, Player.Size, Box(Box%).Xpos, Box(Box%).Ypos, Box(Box%).Size, Box(Box%).Size) Then
|
||||
If Box(Box%).Colour = _RGB32(0, 255, 0) Then ' there was a collision, was it with a green box?
|
||||
_SndPlayCopy Boxgreen&(Int(Rnd(1) * 4) + 1) ' play one of four random green box hit sounds
|
||||
Score% = Score% + 1 ' yes, add a point to the player's score
|
||||
RANDOMBOX Box% ' have this box appear randomly some where else
|
||||
Else ' no, the player hit a red box!
|
||||
GameOver% = TRUE ' the game is now over :(
|
||||
End If
|
||||
End If
|
||||
|
||||
End Sub
|
||||
|
||||
'------------------------------------------------------------------------------------------------------------
|
||||
|
||||
Sub UPDATEPLAYER ()
|
||||
|
||||
'**
|
||||
'** Updates the player's location based on mouse location and draw's the player's box
|
||||
'**
|
||||
|
||||
Shared Player As BOX
|
||||
|
||||
While _MouseInput: Wend ' get the latest mouse location
|
||||
Player.Xpos = _MouseX ' set player X position to mouse X location
|
||||
Player.Ypos = _MouseY ' set player Y position to mouse Y location
|
||||
'
|
||||
'** Draw the player's box
|
||||
'
|
||||
Line (Player.Xpos - Player.Size / 2, Player.Ypos - Player.Size / 2)-(Player.Xpos + Player.Size / 2, Player.Ypos + Player.Size / 2), Player.Colour, BF
|
||||
|
||||
End Sub
|
||||
|
||||
'------------------------------------------------------------------------------------------------------------
|
||||
|
||||
Sub MOVEBOX (Box%)
|
||||
|
||||
'**
|
||||
'** Moves the current box (Box%) to it's new location
|
||||
'**
|
||||
|
||||
Shared Box() As BOX
|
||||
Shared Score%
|
||||
Shared Boxred&
|
||||
|
||||
Box(Box%).Xpos = Box(Box%).Xpos + Box(Box%).Xvel ' update the X position of this box
|
||||
Box(Box%).Ypos = Box(Box%).Ypos + Box(Box%).Yvel ' update the Y position of this box
|
||||
'
|
||||
'** Check to see if the box has gone off screen
|
||||
'
|
||||
If (Box(Box%).Xpos < -Box(Box%).Size) Or Box(Box%).Xpos > SWIDTH Or Box(Box%).Ypos < -Box(Box%).Size Or Box(Box%).Ypos > SHEIGHT Then
|
||||
If Box(Box%).Colour = _RGB32(0, 255, 0) Then ' was this a green box that flew off the screen?
|
||||
'Score% = Score% - 1 ' yes, subtract from player's score if green box missed
|
||||
_SndPlayCopy Boxred& ' play a red box hit sound if a green box is missed
|
||||
End If
|
||||
RANDOMBOX Box% ' have this box appear randomly some where else
|
||||
End If
|
||||
'
|
||||
'** Draw this box at it's new location
|
||||
'
|
||||
Line (Box(Box%).Xpos, Box(Box%).Ypos)-(Box(Box%).Xpos + Box(Box%).Size, Box(Box%).Ypos + Box(Box%).Size), Box(Box%).Colour, BF
|
||||
|
||||
End Sub
|
||||
|
||||
'------------------------------------------------------------------------------------------------------------
|
||||
|
||||
Sub RANDOMBOX (Box%)
|
||||
|
||||
'**
|
||||
'** Sets a box's (Box%) attributes with random values
|
||||
'**
|
||||
|
||||
Shared Box() As BOX
|
||||
Shared maxspeed!
|
||||
Shared Level%
|
||||
|
||||
Box(Box%).Size = Int(Rnd(1) * (MAXWIDTH - MINWIDTH)) + MINWIDTH ' create random sized box between min and max
|
||||
If COINTOSS = HEADS Then ' let's create a horizontal moving box
|
||||
Box(Box%).Ypos = Int(Rnd(1) * (SHEIGHT - Box(Box%).Size)) ' find a random Y start position for this box
|
||||
Box(Box%).Xvel = Rnd(1) * maxspeed! ' create a random X motion factor for this box
|
||||
If Level% < 10 Then ' if the player is below level 10
|
||||
Box(Box%).Yvel = 0 ' then there will be no Y motion for this box
|
||||
Else ' otherwise
|
||||
Box(Box%).Yvel = Rnd(1) * maxspeed! ' let's add some Y motion to the box
|
||||
End If
|
||||
If COINTOSS = HEADS Then ' this box will appear from the left side
|
||||
Box(Box%).Xpos = -Box(Box%).Size ' position the box off the screen to the left
|
||||
Else ' this box will appear from the right side
|
||||
Box(Box%).Xpos = SWIDTH ' position the box off the screen to the right
|
||||
Box(Box%).Xvel = -Box(Box%).Xvel ' we need to reverse the X motion factor
|
||||
End If
|
||||
Else ' let's create a vertical moving box
|
||||
Box(Box%).Xpos = Int(Rnd(1) * (SWIDTH - Box(Box%).Size)) ' find a random X start position for this box
|
||||
Box(Box%).Yvel = Rnd(1) * maxspeed! ' create a random Y motion factor for this box
|
||||
If Level% < 10 Then ' if the player is below level 10
|
||||
Box(Box%).Xvel = 0 ' then there will be no X motion for this box
|
||||
Else ' otherwise
|
||||
Box(Box%).Xvel = Rnd(1) * maxspeed! ' let's add some X motion to the box
|
||||
End If
|
||||
If COINTOSS = HEADS Then ' this box will appear from the top of the screen
|
||||
Box(Box%).Ypos = -Box(Box%).Size ' position the box off the screen at the top
|
||||
Else ' this box will appear from the bottom of the screen
|
||||
Box(Box%).Ypos = SHEIGHT ' position the box off the screen at the bottom
|
||||
Box(Box%).Yvel = -Box(Box%).Yvel ' we need to reverse the Y motion factor
|
||||
End If
|
||||
End If
|
||||
If COINTOSS = HEADS Then ' let's determine the color of the box randomly
|
||||
Box(Box%).Colour = _RGB32(255, 0, 0) ' set it to red
|
||||
Else
|
||||
Box(Box%).Colour = _RGB32(0, 255, 0) ' set it to green
|
||||
End If
|
||||
|
||||
End Sub
|
||||
|
||||
'------------------------------------------------------------------------------------------------------------
|
||||
|
||||
Function COINTOSS ()
|
||||
|
||||
'**
|
||||
'** Simulates a coin toss with a 50/50 outcome. HEADS = TRUE, TAILS = FALSE
|
||||
'**
|
||||
|
||||
Randomize Timer ' seed the random number generator
|
||||
|
||||
If Int(Rnd(1) * 2) + 1 = 1 Then ' if we get a random number of 1
|
||||
COINTOSS = HEADS ' return COINTOSS as HEADS (or TRUE)
|
||||
Else ' the random number must have been 2
|
||||
COINTOSS = TAILS ' return COINTOSS as TAILS (or FALSE)
|
||||
End If
|
||||
|
||||
End Function
|
||||
|
||||
'------------------------------------------------------------------------------------------------------------
|
||||
|
||||
BIN
samples/bad-boxes/src/badbox.zip
Normal file
BIN
samples/bad-boxes/src/badbox.zip
Normal file
Binary file not shown.
BIN
samples/bar-demo/img/screenshot.png
Normal file
BIN
samples/bar-demo/img/screenshot.png
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 8.9 KiB |
92
samples/bar-demo/index.md
Normal file
92
samples/bar-demo/index.md
Normal file
|
|
@ -0,0 +1,92 @@
|
|||
[Home](https://qb64.com) • [News](../../news.md) • [GitHub](../../github.md) • [Wiki](../../wiki.md) • [Samples](../../samples.md) • [Media](../../media.md) • [Community](../../community.md) • [Rolodex](../../rolodex.md) • [More...](../../more.md)
|
||||
|
||||
## SAMPLE: BAR DEMO
|
||||
|
||||
|
||||
|
||||
### Author
|
||||
|
||||
[🐝 Douglas Park](../douglas-park.md)
|
||||
|
||||
### Description
|
||||
|
||||
```text
|
||||
' BARDEMO.BAS
|
||||
' by Douglas Park
|
||||
' Copyright (C) 1995 DOS World Magazine
|
||||
' Published in Issue #19, January 1995, page 60
|
||||
|
||||
*****************************************************************************
|
||||
BARDEMO.BAS
|
||||
by Douglas Park
|
||||
Copyright (C) 1995 DOS World Magazine
|
||||
Published in Issue #19, January 1995, page 60
|
||||
|
||||
If you often find graphs easier to understand than numbers, the CHART
|
||||
subroutine in this program will allow you to compare two numbers visually in
|
||||
the form of bar graphs. BARDEMO.BAS is a demonstration program that
|
||||
illustrates the usage of CHART. As a bonus, the program also includes the
|
||||
BOX subroutine, which makes it easy to draw boxes on the display.
|
||||
|
||||
To run the program from the DOS command line, change to the directory
|
||||
containing BARDEMO.BAS, then type:
|
||||
|
||||
QBASIC /RUN BARDEMO
|
||||
|
||||
|
||||
When you run BARDEMO.BAS, it first displays two graphs, each of which
|
||||
visually compares two numbers. One graph occupies the full width of the
|
||||
display, and a smaller one is centered in the middle of the display. A third
|
||||
graph appears at the bottom of the display when you press a key in response
|
||||
to the on-screen prompt. The lengths of the bars in this graph change each
|
||||
time you press a key.
|
||||
|
||||
The CHART subroutine uses one of DOS’s shaded box characters to create its
|
||||
bar graph, automatically adjusting the length of the bar representing the
|
||||
largest quantity so it will fit on a standard 80-column display. The length
|
||||
of the bar representing the smaller of the two quantities is automatically
|
||||
adjusted in proportion to the larger bar. CHART limits the length of the
|
||||
longest bar to 56 characters.
|
||||
|
||||
Calls to CHART are in the following form:
|
||||
|
||||
CALL CHART (STR1$, STR2$, NUM1%, NUM2%, WID%, X%, Y%)
|
||||
|
||||
Thus, CHART requires that your program specify seven values:
|
||||
|
||||
STR1$ and STR2$ are the labels for the two bars.
|
||||
NUM1% and NUM2% are the two numbers (integers) you wish to compare. The
|
||||
largest integer allowed by QBasic is 32767.
|
||||
WID% is the maximum width of the longer of the two bars. If you specify a
|
||||
value larger than 56, CHART reduces it to 56.
|
||||
X% and Y% are the row and column on the screen where the graph will be
|
||||
displayed.
|
||||
|
||||
The BOX subroutine draws a single-line border of any size you specify. Calls
|
||||
to BOX are in the following form:
|
||||
|
||||
CALL BOX (Y1%, X1%, Y2%, X2%)
|
||||
|
||||
The first two values, Y1% and X1%, are the row and column on the screen of
|
||||
the upper-left corner of the box. The third and fourth values, Y2% and X2%,
|
||||
are the row and column of the lower right corner of the box.
|
||||
|
||||
These two subroutines can be incorporated into your own programs. Use CHART
|
||||
when you want a visual representation of the relative sizes of two numbers.
|
||||
Use BOX as a quick and easy way to draw boxes around portions of the screen
|
||||
display.
|
||||
```
|
||||
|
||||
### QBjs
|
||||
|
||||
> Please note that QBjs is still in early development and support for these examples is extremely experimental (meaning will most likely not work). With that out of the way, give it a try!
|
||||
|
||||
* [LOAD "bardemo.bas"](https://v6p9d9t4.ssl.hwcdn.net/html/5963335/index.html?src=https://qb64.com/samples/bar-demo/src/bardemo.bas)
|
||||
* [RUN "bardemo.bas"](https://v6p9d9t4.ssl.hwcdn.net/html/5963335/index.html?mode=auto&src=https://qb64.com/samples/bar-demo/src/bardemo.bas)
|
||||
* [PLAY "bardemo.bas"](https://v6p9d9t4.ssl.hwcdn.net/html/5963335/index.html?mode=play&src=https://qb64.com/samples/bar-demo/src/bardemo.bas)
|
||||
|
||||
### File(s)
|
||||
|
||||
* [bardemo.bas](src/bardemo.bas)
|
||||
|
||||
🔗 [tui](../tui.md), [dos world](../dos-world.md)
|
||||
76
samples/bar-demo/src/bardemo.bas
Normal file
76
samples/bar-demo/src/bardemo.bas
Normal file
|
|
@ -0,0 +1,76 @@
|
|||
' BARDEMO.BAS
|
||||
' by Douglas Park
|
||||
' Copyright (C) 1995 DOS World Magazine
|
||||
' Published in Issue #19, January 1995, page 60
|
||||
|
||||
DECLARE SUB BOX (Y1%, X1%, Y2%, X2%)
|
||||
DECLARE SUB CHART (STR1$, STR2$, NUM1%, NUM2%, WID%, X%, Y%)
|
||||
|
||||
CALL BOX(1, 1, 23, 80)
|
||||
CALL BOX(2, 2, 8, 79)
|
||||
CALL CHART("STRING1", "STRING2", 500, 5000, 54, 2, 2)
|
||||
CALL BOX(9, 19, 15, 60)
|
||||
CALL CHART("STRING1", "STRING2", 1, 2, 20, 19, 9)
|
||||
LOCATE 23, 10: PRINT " Press a Key "
|
||||
DO 'Pause for a keystroke
|
||||
KEY$ = INKEY$
|
||||
LOOP WHILE KEY$ = ""
|
||||
J% = 8
|
||||
FOR I% = 1 TO J% + 8
|
||||
CALL CHART("I : " + STR$(I%), "J : " + STR$(J%), I%, J%, 54, 2, 16)
|
||||
DO 'Pause for a keystroke
|
||||
KEY$ = INKEY$
|
||||
LOOP WHILE KEY$ = ""
|
||||
NEXT I%
|
||||
END
|
||||
|
||||
SUB BOX (Y1%, X1%, Y2%, X2%)
|
||||
BOXWIDTH = X2% - X1% + 1
|
||||
LOCATE Y1%, X1%
|
||||
PRINT CHR$(218); STRING$(BOXWIDTH - 2, CHR$(196)); CHR$(191)
|
||||
FOR I = Y1% + 1 TO Y2% - 1
|
||||
LOCATE I, X1%
|
||||
PRINT CHR$(179); SPACE$(BOXWIDTH - 2); CHR$(179)
|
||||
NEXT I
|
||||
LOCATE Y2%, X1%
|
||||
PRINT CHR$(192); STRING$(BOXWIDTH - 2, CHR$(196)); CHR$(217)
|
||||
END SUB
|
||||
|
||||
SUB CHART (STR1$, STR2$, NUM1%, NUM2%, WID%, X%, Y%)
|
||||
TEMPSTRING$ = ""
|
||||
IF WID% > 56 THEN WID% = 56 'Fit chart to 80 columns
|
||||
IF NUM1% <= NUM2% THEN 'Determine largest number
|
||||
KEYNUM% = NUM2%
|
||||
ELSE
|
||||
KEYNUM% = NUM1%
|
||||
END IF
|
||||
IF WID% < KEYNUM% THEN 'Adjust to fit display
|
||||
DO
|
||||
KEYNUM% = KEYNUM% \ 2: NUM1% = NUM1% \ 2: NUM2% = NUM2% \ 2
|
||||
LOOP WHILE WID% < KEYNUM%
|
||||
END IF
|
||||
BARLENGTH1 = (NUM1% * (WID% / KEYNUM%))
|
||||
BARLENGTH2 = (NUM2% * (WID% / KEYNUM%))
|
||||
LOCATE (Y% + 2), (X% + 4): PRINT STR1$ 'Write the first title
|
||||
FOR I = 1 TO BARLENGTH1 'Draw the bar
|
||||
TEMPSTRING$ = TEMPSTRING$ + CHR$(178)
|
||||
NEXT I
|
||||
IF BARLENGTH1 < BARLENGTH2 THEN
|
||||
FOR I = BARLENGTH1 + 1 TO BARLENGTH2
|
||||
TEMPSTRING$ = TEMPSTRING$ + " "
|
||||
NEXT I
|
||||
END IF
|
||||
LOCATE (Y% + 2), (X% + 20): PRINT TEMPSTRING$
|
||||
TEMPSTRING$ = ""
|
||||
LOCATE (Y% + 4), (X% + 4): PRINT STR2$ 'Write the second title
|
||||
FOR I = 1 TO BARLENGTH2 'Draw the bar
|
||||
TEMPSTRING$ = TEMPSTRING$ + CHR$(178)
|
||||
NEXT I
|
||||
IF BARLENGTH2 < BARLENGTH1 THEN
|
||||
FOR I = BARLENGTH2 + 1 TO BARLENGTH1
|
||||
TEMPSTRING$ = TEMPSTRING$ + " "
|
||||
NEXT I
|
||||
END IF
|
||||
LOCATE (Y% + 4), (X% + 20): PRINT TEMPSTRING$
|
||||
END SUB
|
||||
|
||||
BIN
samples/beatdown/img/screenshot.png
Normal file
BIN
samples/beatdown/img/screenshot.png
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 2.8 KiB |
31
samples/beatdown/index.md
Normal file
31
samples/beatdown/index.md
Normal file
|
|
@ -0,0 +1,31 @@
|
|||
[Home](https://qb64.com) • [News](../../news.md) • [GitHub](../../github.md) • [Wiki](../../wiki.md) • [Samples](../../samples.md) • [Media](../../media.md) • [Community](../../community.md) • [Rolodex](../../rolodex.md) • [More...](../../more.md)
|
||||
|
||||
## SAMPLE: BEATDOWN
|
||||
|
||||
|
||||
|
||||
### Author
|
||||
|
||||
[🐝 Brian Murphy](../brian-murphy.md)
|
||||
|
||||
### Description
|
||||
|
||||
```text
|
||||
' Beat Down
|
||||
' 1998 MicroTrip
|
||||
' V1.1 Origanally availible on
|
||||
' 12-14-98
|
||||
'
|
||||
' Visit our Web Site At
|
||||
' At
|
||||
' http://www.geocities.com/SiliconValley/Platform/8409/qbasic.html
|
||||
' E-Mail me at microtrip@geocities.com
|
||||
' ***Hit `F5' to play!!***
|
||||
```
|
||||
|
||||
### File(s)
|
||||
|
||||
* [beatdown.bas](src/beatdown.bas)
|
||||
* [beatdown.zip](src/beatdown.zip)
|
||||
|
||||
🔗 [game](../game.md), [legacy](../legacy.md)
|
||||
737
samples/beatdown/src/beatdown.bas
Normal file
737
samples/beatdown/src/beatdown.bas
Normal file
|
|
@ -0,0 +1,737 @@
|
|||
' **** ***** * ***** **** *** * * * *
|
||||
' * * * * * * * * * * * * ** *
|
||||
' * * * * * * * * * * * * ** *
|
||||
' **** **** ***** * * * * * * * * * * *
|
||||
' * * * * * * * * * * * * * * * *
|
||||
' * * * * * * * * * * * * * * **
|
||||
' **** ***** * * * **** *** ***** * **
|
||||
' Beat Down
|
||||
' 1998 MicroTrip
|
||||
' V1.1 Origanally availible on
|
||||
' 12-14-98
|
||||
'
|
||||
' Visit our Web Site At
|
||||
' At
|
||||
' http://www.geocities.com/SiliconValley/Platform/8409/qbasic.html
|
||||
' E-Mail me at microtrip@geocities.com
|
||||
' ***Hit `F5' to play!!***
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
title:
|
||||
'Beat Down Title Screen
|
||||
'By Brian Murphy of MicroTrip
|
||||
|
||||
SCREEN 8
|
||||
CLS
|
||||
LINE (50, 50)-(50, 100), 14
|
||||
LINE (50, 50)-(70, 50), 14
|
||||
LINE (50, 100)-(70, 100), 14
|
||||
LINE (70, 50)-(80, 55), 14
|
||||
LINE (70, 100)-(80, 95), 14
|
||||
LINE (80, 55)-(80, 70), 14
|
||||
LINE (80, 95)-(80, 80), 14
|
||||
LINE (80, 70)-(75, 75), 14
|
||||
LINE (80, 80)-(75, 75), 14
|
||||
LINE (75, 75)-(50, 75), 14
|
||||
|
||||
'**************E*************
|
||||
LINE (90, 50)-(90, 100), 14
|
||||
LINE (90, 50)-(120, 50), 14
|
||||
LINE (90, 75)-(110, 75), 14
|
||||
LINE (90, 100)-(120, 100), 14
|
||||
|
||||
'**************A*************
|
||||
LINE (145, 50)-(130, 100), 14
|
||||
LINE (145, 50)-(160, 100), 14
|
||||
LINE (137.5, 75)-(152.5, 75), 14
|
||||
|
||||
'*************T**************
|
||||
LINE (170, 50)-(200, 50), 14
|
||||
LINE (185, 50)-(185, 100), 14
|
||||
|
||||
'***************D************
|
||||
LINE (260, 50)-(260, 100), 14
|
||||
LINE (260, 50)-(280, 50), 14
|
||||
LINE (260, 100)-(280, 100), 14
|
||||
LINE (280, 50)-(290, 55), 14
|
||||
LINE (280, 100)-(290, 95), 14
|
||||
LINE (290, 55)-(290, 95), 14
|
||||
|
||||
'***************O************
|
||||
LINE (300, 55)-(300, 95), 14
|
||||
LINE (300, 55)-(310, 50), 14
|
||||
LINE (300, 95)-(310, 100), 14
|
||||
LINE (330, 55)-(330, 95), 14
|
||||
LINE (320, 50)-(330, 55), 14
|
||||
LINE (320, 100)-(330, 95), 14
|
||||
LINE (320, 100)-(310, 100), 14
|
||||
LINE (310, 50)-(320, 50), 14
|
||||
|
||||
'**************W*************
|
||||
LINE (340, 50)-(340, 100), 14
|
||||
LINE (370, 50)-(370, 100), 14
|
||||
LINE (340, 100)-(355, 75), 14
|
||||
LINE (370, 100)-(355, 75), 14
|
||||
|
||||
'**************N*************
|
||||
LINE (380, 50)-(380, 100), 14
|
||||
LINE (410, 50)-(410, 100), 14
|
||||
LINE (380, 50)-(410, 100), 14
|
||||
|
||||
'************************All done
|
||||
|
||||
|
||||
COLOR 14
|
||||
LOCATE 24, 32: PRINT "Beat Down V1.1"
|
||||
|
||||
|
||||
FOR i = 1 TO 2
|
||||
FOR x = 550 TO 37 STEP -5
|
||||
SOUND x + 5, .2
|
||||
a$ = INKEY$: IF a$ <> "" THEN LET d = 1: EXIT FOR
|
||||
NEXT x
|
||||
IF d = 1 THEN EXIT FOR
|
||||
FOR x = 37 TO 550 STEP 5
|
||||
SOUND x + 5, .2
|
||||
a$ = INKEY$: IF a$ <> "" THEN LET d = 1: EXIT FOR
|
||||
NEXT x
|
||||
IF d = 1 THEN EXIT FOR
|
||||
NEXT i
|
||||
IF d = 1 THEN GOTO you
|
||||
|
||||
'/Title
|
||||
|
||||
|
||||
GOSUB intro
|
||||
IF nn = 0 GOTO you
|
||||
IF nn = 1 GOTO title
|
||||
|
||||
you:
|
||||
'Main Menu
|
||||
snd$ = "on"
|
||||
speed$ = "normal"
|
||||
num = 9
|
||||
oldnum = 9
|
||||
colour1 = 1
|
||||
colour2 = 1
|
||||
mainmenu:
|
||||
COLOR 14
|
||||
CLS
|
||||
LINE (50, 45)-(550, 150), 14, B
|
||||
LOCATE 5, 33: PRINT "Main Menu"
|
||||
LINE (60, 55)-(540, 140), 14, B
|
||||
PAINT (51, 46), 10, 14
|
||||
LOCATE 9, 15: PRINT "Start Game"
|
||||
LOCATE 10, 15: PRINT "Veiw Controls"
|
||||
LOCATE 11, 15: PRINT "Speed"
|
||||
LOCATE 12, 15: PRINT "Sound"
|
||||
LOCATE 13, 15: PRINT "Credits"
|
||||
LOCATE 14, 15: PRINT "Color of player 1"
|
||||
LOCATE 15, 15: PRINT "Color of player 2"
|
||||
LOCATE 16, 15: PRINT "Quit"
|
||||
|
||||
LISTEN$ = "mb T180 o2 P2 P8 L8 GGG L2 E-"
|
||||
FATE$ = "mb P24 P8 L8 FFF L2 D"
|
||||
PLAY LISTEN$ + FATE$
|
||||
|
||||
mm2:
|
||||
LOCATE 11, 21: PRINT " ": LOCATE 11, 21: PRINT speed$
|
||||
LOCATE 12, 21: PRINT " ": LOCATE 12, 21: PRINT snd$; ""
|
||||
LOCATE 14, 33: PRINT " ": LOCATE 14, 33: COLOR colour1: PRINT colour1
|
||||
LOCATE 15, 33: PRINT " ": LOCATE 15, 33: COLOR colour2: PRINT colour2
|
||||
COLOR 14
|
||||
IF oldnum <> num THEN LOCATE 14, 13: PRINT " ": LOCATE 9, 13: PRINT " ": LOCATE 10, 13: PRINT " ": LOCATE 11, 13: PRINT " ": LOCATE 12, 13: PRINT " ": LOCATE 13, 13: PRINT " ": LOCATE 15, 13: PRINT " ": LOCATE 16, 13: PRINT " ": oldnum = num
|
||||
LOCATE num, 13: PRINT "o"
|
||||
DO
|
||||
a$ = INKEY$
|
||||
LOOP UNTIL a$ <> ""
|
||||
IF a$ = "" THEN GOTO mm2
|
||||
IF a$ = "8" AND num = 9 THEN num = 16: GOTO mm2
|
||||
IF a$ = "8" THEN num = num - 1: GOTO mm2
|
||||
IF a$ = "2" AND num = 16 THEN num = 9: GOTO mm2
|
||||
IF a$ = "2" THEN num = num + 1: GOTO mm2
|
||||
IF a$ = "5" AND num = 9 THEN GOTO start
|
||||
IF a$ = "4" AND num = 12 THEN
|
||||
IF snd$ = "on" THEN snd$ = "off": GOTO mm2
|
||||
IF snd$ = "off" THEN snd$ = "on": GOTO mm2
|
||||
END IF
|
||||
IF a$ = "6" AND num = 12 THEN
|
||||
IF snd$ = "on" THEN snd$ = "off": GOTO mm2
|
||||
IF snd$ = "off" THEN snd$ = "on": GOTO mm2
|
||||
END IF
|
||||
IF a$ = "4" AND num = 11 THEN
|
||||
IF speed$ = "fastest" THEN speed$ = "mid-fast": GOTO mm2
|
||||
IF speed$ = "mid-fast" THEN speed$ = "normal": GOTO mm2
|
||||
IF speed$ = "normal" THEN speed$ = "mid-slow": GOTO mm2
|
||||
IF speed$ = "mid-slow" THEN speed$ = "slow": GOTO mm2
|
||||
IF speed$ = "slow" THEN speed$ = "fastest": GOTO mm2
|
||||
END IF
|
||||
IF a$ = "6" AND num = 11 THEN
|
||||
IF speed$ = "fastest" THEN speed$ = "slow": GOTO mm2
|
||||
IF speed$ = "mid-fast" THEN speed$ = "fastest": GOTO mm2
|
||||
IF speed$ = "normal" THEN speed$ = "mid-fast": GOTO mm2
|
||||
IF speed$ = "mid-slow" THEN speed$ = "normal": GOTO mm2
|
||||
IF speed$ = "slow" THEN speed$ = "mid-slow": GOTO mm2
|
||||
END IF
|
||||
IF a$ = "6" AND num = 14 THEN
|
||||
IF colour1 = 15 THEN colour1 = 0: GOTO mm2
|
||||
IF colour1 = 10 THEN colour1 = 12: GOTO mm2
|
||||
colour1 = colour1 + 1
|
||||
END IF
|
||||
IF a$ = "4" AND num = 14 THEN
|
||||
IF colour1 = 0 THEN colour1 = 15: GOTO mm2
|
||||
IF colour1 = 12 THEN colour1 = 10: GOTO mm2
|
||||
colour1 = colour1 - 1
|
||||
END IF
|
||||
IF a$ = "6" AND num = 15 THEN
|
||||
IF colour2 = 15 THEN colour2 = 0: GOTO mm2
|
||||
IF colour2 = 10 THEN colour2 = 12: GOTO mm2
|
||||
colour2 = colour2 + 1
|
||||
END IF
|
||||
IF a$ = "4" AND num = 15 THEN
|
||||
IF colour2 = 0 THEN colour2 = 15: GOTO mm2
|
||||
IF colour2 = 12 THEN colour2 = 10: GOTO mm2
|
||||
colour2 = colour2 - 1
|
||||
END IF
|
||||
IF a$ = "5" AND num = 13 THEN GOTO credits
|
||||
IF a$ = "5" AND num = 10 THEN GOTO controls
|
||||
IF a$ = "5" AND num = 16 THEN GOTO 666
|
||||
GOTO mm2
|
||||
|
||||
'***********Credits**************
|
||||
credits:
|
||||
CLS
|
||||
PRINT "Graphics Director...........Jacob Suckow"
|
||||
PRINT " Title Screen Picture......Brian Murphy"
|
||||
PRINT " Main Menu.................Brian Murphy"
|
||||
PRINT " Fighting Section..........Brian Murphy"
|
||||
PRINT " Ending (Circle)...........Brian Murphy"
|
||||
PRINT "Programming Director........Brian Murphy"
|
||||
PRINT " Engine....................Brian Murphy"
|
||||
PRINT " Menu System...............Brian Murphy"
|
||||
PRINT " Other.....................Brian Murphy"
|
||||
PRINT "Sound Director..............Jeremy Suckow"
|
||||
PRINT " Title Screen..............Brian Murphy"
|
||||
PRINT " MicroTrip Screen..........Brian Murphy"
|
||||
PRINT " Fighting..................Brian Murphy"
|
||||
PRINT
|
||||
PRINT " 1998 MicroTrip"
|
||||
PRINT " Any key to continue..."
|
||||
WHILE INKEY$ = "": WEND
|
||||
GOTO mainmenu
|
||||
'***********/Credits*************
|
||||
|
||||
'***********Controls*************
|
||||
controls:
|
||||
CLS
|
||||
PRINT "Player One"
|
||||
PRINT "Move left.....a"
|
||||
PRINT "Move right....s"
|
||||
PRINT "Punch.........q"
|
||||
PRINT "High Punch....z"
|
||||
PRINT "Kick..........w"
|
||||
PRINT "Low Kick.....x"
|
||||
PRINT
|
||||
PRINT "Player Two"
|
||||
PRINT "Move Left.....4"
|
||||
PRINT "Move Right....6"
|
||||
PRINT "Punch.........8"
|
||||
PRINT "High Punch..../"
|
||||
PRINT "Kick..........2"
|
||||
PRINT "Low Kick......0"
|
||||
PRINT
|
||||
PRINT "To quit.....Esc"
|
||||
PRINT
|
||||
PRINT "Any key to continue..."
|
||||
WHILE INKEY$ = "": WEND
|
||||
GOTO mainmenu
|
||||
'************/Controls*************
|
||||
|
||||
start:
|
||||
IF speed$ = "slow" THEN speed = 100000
|
||||
IF speed$ = "mid-slow" THEN speed = 50000
|
||||
IF speed$ = "normal" THEN speed = 25000
|
||||
IF speed$ = "mid-fast" THEN speed = 10000
|
||||
IF speed$ = "fastest" THEN speed = 1000
|
||||
|
||||
IF snd$ = "on" THEN snd = 1
|
||||
IF snd$ = "off" THEN snd = 0
|
||||
|
||||
CLS
|
||||
SCREEN 8
|
||||
|
||||
LET a = 50
|
||||
LET B = 50
|
||||
LET c = 20
|
||||
LET d = c
|
||||
LET e = 600
|
||||
LET f = e
|
||||
|
||||
COLOR 15
|
||||
|
||||
'********Ground********
|
||||
LINE (0, 151)-(640, 161), 2, BF
|
||||
LINE (0, 161)-(640, 171), 10, BF
|
||||
LINE (0, 171)-(640, 200), 6, BF
|
||||
'********/Ground*******
|
||||
|
||||
'********Top Thing*****
|
||||
LINE (0, 0)-(640, 20), 13, B
|
||||
PAINT (2, 2), 13, 13
|
||||
'********/Top Thing****
|
||||
'********Background****
|
||||
LINE (0, 150)-(640, 21), 11, BF
|
||||
'********/BackGround***
|
||||
|
||||
1
|
||||
10 IF a <= 0 THEN GOTO 600
|
||||
20 IF B <= 0 THEN GOTO 610
|
||||
|
||||
30 LINE (c, 110)-(c, 130), colour1 'body
|
||||
LINE (c, 130)-(c - 20, 150), colour1 'leg
|
||||
LINE (c, 130)-(c + 20, 150), colour1 'other leg
|
||||
IF c < e THEN LINE (c, 120)-(c + 15, 110), colour1'arm
|
||||
IF c > e THEN LINE (c, 120)-(c - 15, 110), colour1'arm other
|
||||
CIRCLE (c, 105), 10, colour1 'head
|
||||
60 LINE (e, 110)-(e, 130), colour2
|
||||
LINE (e, 130)-(e - 20, 150), colour2
|
||||
LINE (e, 130)-(e + 20, 150), colour2
|
||||
IF e > c THEN LINE (e, 120)-(e - 15, 110), colour2
|
||||
IF e < c THEN LINE (e, 120)-(e + 15, 110), colour2
|
||||
CIRCLE (e, 105), 10, colour2
|
||||
|
||||
90 LINE (5, 4)-((a * 5) + 5, 10), 14, BF 'Life Bar
|
||||
IF a <> 50 THEN LINE ((a * 5) + 1 + 5, 4)-(255, 10), 4, BF
|
||||
LINE (4, 3)-((a * 5) + 6, 11), 14, B
|
||||
|
||||
LINE (390, 4)-((B * 5) + 390, 10), 14, BF 'Life Bar P2
|
||||
LINE ((B * 5) + 390 + 1, 4)-(640, 10), 4, BF
|
||||
LINE (389, 3)-((B * 5) + 390 + 1, 11), 14, B
|
||||
|
||||
130 a$ = INKEY$
|
||||
140 IF a$ = "" THEN GOTO 1
|
||||
150 IF a$ = "q" THEN GOTO 200 'punch 1
|
||||
155 IF a$ = "z" THEN GOTO highpunch1
|
||||
160 IF a$ = "w" THEN GOTO 210 'kick 1
|
||||
165 IF a$ = "x" THEN GOTO highkick1
|
||||
170 IF a$ = "a" THEN GOTO 220 'left 1
|
||||
175 IF a$ = "s" THEN GOTO 270 'right 1
|
||||
180 IF a$ = "4" THEN GOTO 230 'left 2
|
||||
185 IF a$ = "6" THEN GOTO 240 'right 2
|
||||
190 IF a$ = "8" THEN GOTO 250 'punch 2
|
||||
IF a$ = "/" THEN GOTO highpunch2
|
||||
195 IF a$ = "2" THEN GOTO 260 'kick 2
|
||||
IF a$ = "0" THEN GOTO highkick2
|
||||
196 IF a$ = CHR$(27) THEN GOTO 616
|
||||
197 GOTO 1
|
||||
|
||||
200 IF c > e THEN GOTO 205
|
||||
LINE (c, 120)-(c + 15, 110), 11
|
||||
LINE (c, 120)-(c + 30, 120), colour1
|
||||
FOR i = 1 TO speed
|
||||
NEXT i
|
||||
LINE (c, 120)-(c + 15, 110), colour1
|
||||
LINE (c, 120)-(c + 30, 120), 11
|
||||
GOTO 209
|
||||
205 LINE (c, 120)-(c - 30, 120), colour1
|
||||
LINE (c, 120)-(c - 15, 110), 11
|
||||
FOR i = 1 TO speed
|
||||
NEXT i
|
||||
LINE (c, 120)-(c - 15, 110), colour1
|
||||
LINE (c, 120)-(c - 30, 120), 11
|
||||
GOTO 209
|
||||
209 IF c + 29 = e OR c - 29 = e OR c + 30 = e OR c - 30 = e THEN
|
||||
B = B - 2
|
||||
IF snd = 1 THEN SOUND 50, 1
|
||||
END IF
|
||||
IF c + 24 = e OR c - 24 = e OR c + 25 = e OR c - 25 = e THEN
|
||||
B = B - 3
|
||||
IF snd = 1 THEN SOUND 50, 1
|
||||
END IF
|
||||
IF c + 19 = e OR c - 19 = e OR c + 20 = e OR c - 20 = e THEN
|
||||
B = B - 1
|
||||
IF snd = 1 THEN SOUND 50, 1
|
||||
END IF
|
||||
GOTO 1
|
||||
|
||||
|
||||
|
||||
highkick1:
|
||||
IF c > e THEN GOTO hk1
|
||||
LINE (c, 130)-(c + 20, 150), 11
|
||||
LINE (c, 130)-(c + 30, 140), colour1
|
||||
FOR i = 1 TO speed
|
||||
NEXT i
|
||||
LINE (c, 130)-(c + 20, 150), colour1
|
||||
LINE (c, 130)-(c + 30, 140), 11
|
||||
GOTO hk1x
|
||||
hk1:
|
||||
LINE (c, 130)-(c - 20, 150), 11
|
||||
LINE (c, 130)-(c - 30, 140), colour1
|
||||
FOR i = 1 TO speed
|
||||
NEXT i
|
||||
LINE (c, 130)-(c - 20, 150), colour1
|
||||
LINE (c, 130)-(c - 30, 140), 11
|
||||
GOTO hk1x
|
||||
hk1x:
|
||||
IF c + 29 = e OR c - 29 = e OR c + 30 = e OR c - 30 = e THEN
|
||||
B = B - 2
|
||||
IF snd = 1 THEN SOUND 50, 1
|
||||
END IF
|
||||
IF c + 24 = e OR c - 24 = e OR c + 25 = e OR c - 25 = e THEN
|
||||
B = B - 3
|
||||
IF snd = 1 THEN SOUND 50, 1
|
||||
END IF
|
||||
IF c + 19 = e OR c - 19 = e OR c + 20 = e OR c - 20 = e THEN
|
||||
B = B - 1
|
||||
IF snd = 1 THEN SOUND 50, 1
|
||||
END IF
|
||||
GOTO 1
|
||||
|
||||
|
||||
highpunch1:
|
||||
IF c > e THEN GOTO hp1
|
||||
LINE (c, 120)-(c + 15, 110), 11
|
||||
LINE (c, 120)-(c + 30, 110), colour1
|
||||
FOR i = 1 TO speed
|
||||
NEXT i
|
||||
LINE (c, 120)-(c + 15, 110), colour1
|
||||
LINE (c, 120)-(c + 30, 110), 11
|
||||
GOTO hp1x
|
||||
hp1:
|
||||
LINE (c, 120)-(c - 15, 110), 11
|
||||
LINE (c, 120)-(c - 30, 110), colour1
|
||||
FOR i = 1 TO speed
|
||||
NEXT i
|
||||
LINE (c, 120)-(c - 15, 110), colour1
|
||||
LINE (c, 120)-(c - 30, 110), 11
|
||||
GOTO hp1x
|
||||
hp1x:
|
||||
IF c + 29 = e OR c - 29 = e OR c + 30 = e OR c - 30 = e THEN
|
||||
B = B - 2
|
||||
IF snd = 1 THEN SOUND 50, 1
|
||||
END IF
|
||||
IF c + 24 = e OR c - 24 = e OR c + 25 = e OR c - 25 = e THEN
|
||||
B = B - 3
|
||||
IF snd = 1 THEN SOUND 50, 1
|
||||
END IF
|
||||
IF c + 19 = e OR c - 19 = e OR c + 20 = e OR c - 20 = e THEN
|
||||
B = B - 1
|
||||
IF snd = 1 THEN SOUND 50, 1
|
||||
END IF
|
||||
GOTO 1
|
||||
|
||||
|
||||
210 IF c > e THEN GOTO 215
|
||||
LINE (c, 130)-(c + 20, 150), 11
|
||||
LINE (c, 130)-(c + 30, 130), colour1
|
||||
FOR i = 1 TO speed
|
||||
NEXT i
|
||||
LINE (c, 130)-(c + 20, 150), colour1
|
||||
LINE (c, 130)-(c + 30, 130), 11
|
||||
GOTO 219
|
||||
215 LINE (c, 130)-(c - 20, 150), 11
|
||||
LINE (c, 130)-(c - 30, 130), colour1
|
||||
FOR i = 1 TO speed
|
||||
NEXT i
|
||||
LINE (c, 130)-(c - 20, 150), colour1
|
||||
LINE (c, 130)-(c - 30, 130), 11
|
||||
GOTO 219
|
||||
219 IF c + 29 = e OR c - 29 = e OR c + 30 = e OR c - 30 = e THEN
|
||||
B = B - 2
|
||||
IF snd = 1 THEN SOUND 50, 1
|
||||
END IF
|
||||
IF c + 24 = e OR c - 24 = e OR c + 25 = e OR c - 25 = e THEN
|
||||
B = B - 3
|
||||
IF snd = 1 THEN SOUND 50, 1
|
||||
END IF
|
||||
IF c + 19 = e OR c - 19 = e OR c + 20 = e OR c - 20 = e THEN
|
||||
B = B - 1
|
||||
IF snd = 1 THEN SOUND 50, 1
|
||||
END IF
|
||||
GOTO 1
|
||||
|
||||
220 IF c < 6 THEN GOTO 1
|
||||
221 c = c - 5
|
||||
222 LINE (d, 110)-(d, 130), 11
|
||||
LINE (d, 130)-(d - 20, 150), 11
|
||||
LINE (d, 130)-(d + 20, 150), 11
|
||||
223 LINE (d, 120)-(d - 15, 110), 11
|
||||
LINE (d, 120)-(d + 15, 110), 11
|
||||
224 CIRCLE (d, 105), 10, 11
|
||||
225 d = c
|
||||
226 GOTO 1
|
||||
|
||||
270 IF c > 595 THEN GOTO 1
|
||||
271 c = c + 5
|
||||
272 LINE (d, 110)-(d, 130), 11
|
||||
LINE (d, 130)-(d - 20, 150), 11
|
||||
LINE (d, 130)-(d + 20, 150), 11
|
||||
273 CIRCLE (d, 105), 10, 11
|
||||
274 LINE (d, 120)-(d - 15, 110), 11
|
||||
LINE (d, 120)-(d + 15, 110), 11
|
||||
275 d = c
|
||||
276 GOTO 1
|
||||
|
||||
230 IF e < 5 THEN GOTO 1
|
||||
231 e = e - 5
|
||||
232 LINE (f, 110)-(f, 130), 11
|
||||
LINE (f, 130)-(f - 20, 150), 11
|
||||
LINE (f, 130)-(f + 20, 150), 11
|
||||
233 CIRCLE (f, 105), 10, 11
|
||||
234 LINE (f, 120)-(f - 15, 110), 11
|
||||
LINE (f, 120)-(f + 15, 110), 11
|
||||
235 f = e
|
||||
236 GOTO 1
|
||||
|
||||
240 IF e > 595 THEN GOTO 1
|
||||
241 e = e + 5
|
||||
242 LINE (f, 110)-(f, 130), 11
|
||||
LINE (f, 130)-(f - 20, 150), 11
|
||||
LINE (f, 130)-(f + 20, 150), 11
|
||||
243 CIRCLE (f, 105), 10, 11
|
||||
244 LINE (f, 120)-(f - 15, 110), 11
|
||||
LINE (f, 120)-(f + 15, 110), 11
|
||||
245 f = e
|
||||
246 GOTO 1
|
||||
|
||||
250 IF c < e THEN GOTO 255
|
||||
LINE (e, 120)-(e + 15, 110), 11
|
||||
LINE (e, 120)-(e + 30, 120), colour2
|
||||
FOR i = 1 TO speed
|
||||
NEXT i
|
||||
LINE (e, 120)-(e + 15, 110), colour2
|
||||
LINE (e, 120)-(e + 30, 120), 11
|
||||
GOTO 259
|
||||
255 LINE (e, 120)-(e - 30, 120), colour2
|
||||
LINE (e, 120)-(e - 15, 110), 11
|
||||
FOR i = 1 TO speed
|
||||
NEXT i
|
||||
LINE (e, 120)-(e - 30, 120), colour2
|
||||
LINE (e, 120)-(e - 30, 120), 11
|
||||
GOTO 259
|
||||
259 IF c + 29 = e OR c - 29 = e OR c + 30 = e OR c - 30 = e THEN
|
||||
a = a - 2
|
||||
IF snd = 1 THEN SOUND 50, 1
|
||||
END IF
|
||||
IF c + 24 = e OR c - 24 = e OR c + 25 = e OR c - 25 = e THEN
|
||||
a = a - 3
|
||||
IF snd = 1 THEN SOUND 50, 1
|
||||
END IF
|
||||
IF c + 19 = e OR c - 19 = e OR c + 20 = e OR c - 25 = e THEN
|
||||
a = a - 1
|
||||
IF snd = 1 THEN SOUND 50, 1
|
||||
END IF
|
||||
GOTO 1
|
||||
|
||||
260 IF c < e THEN GOTO 265
|
||||
LINE (e, 130)-(e + 20, 150), 11
|
||||
LINE (e, 130)-(e + 30, 130), colour2
|
||||
FOR i = 1 TO speed
|
||||
NEXT i
|
||||
LINE (e, 130)-(e + 20, 150), colour2
|
||||
LINE (e, 130)-(e + 30, 130), 11
|
||||
GOTO 269
|
||||
265 LINE (e, 130)-(e - 20, 150), 11
|
||||
LINE (e, 130)-(e - 30, 130), colour2
|
||||
FOR i = 1 TO speed
|
||||
NEXT i
|
||||
LINE (e, 130)-(e - 20, 150), colour2
|
||||
LINE (e, 130)-(e - 30, 130), 11
|
||||
GOTO 269
|
||||
269 IF c + 29 = e OR c - 29 = e OR c + 30 = e OR c - 30 = e THEN
|
||||
a = a - 2
|
||||
IF snd = 1 THEN SOUND 50, 1
|
||||
END IF
|
||||
IF c + 24 = e OR c - 24 = e OR c + 25 = e OR c - 25 = e THEN
|
||||
a = a - 3
|
||||
IF snd = 1 THEN SOUND 50, 1
|
||||
END IF
|
||||
IF c + 19 = e OR c - 19 = e OR c + 20 = e OR c - 20 = e THEN
|
||||
a = a - 1
|
||||
IF snd = 1 THEN SOUND 50, 1
|
||||
END IF
|
||||
GOTO 1
|
||||
|
||||
|
||||
highkick2:
|
||||
IF c < e THEN GOTO hk2
|
||||
LINE (e, 130)-(e + 20, 150), 11
|
||||
LINE (e, 130)-(e + 30, 140), colour2
|
||||
FOR i = 1 TO speed
|
||||
NEXT i
|
||||
LINE (e, 130)-(e + 20, 150), colour2
|
||||
LINE (e, 130)-(e + 30, 140), 11
|
||||
GOTO hk2x
|
||||
hk2:
|
||||
LINE (e, 130)-(e - 20, 150), 11
|
||||
LINE (e, 130)-(e - 30, 140), colour2
|
||||
FOR i = 1 TO speed
|
||||
NEXT i
|
||||
LINE (e, 130)-(e - 20, 150), colour1
|
||||
LINE (e, 130)-(e - 30, 140), 11
|
||||
GOTO hk2x
|
||||
hk2x:
|
||||
IF e + 29 = c OR e - 29 = c OR e + 30 = c OR e - 30 = c THEN
|
||||
a = a - 2
|
||||
IF snd = 1 THEN SOUND 50, 1
|
||||
END IF
|
||||
IF e + 24 = c OR e - 24 = c OR e + 25 = c OR e - 25 = c THEN
|
||||
a = a - 3
|
||||
IF snd = 1 THEN SOUND 50, 1
|
||||
END IF
|
||||
IF e + 19 = c OR e - 19 = c OR e + 20 = c OR e - 20 = c THEN
|
||||
a = a - 1
|
||||
IF snd = 1 THEN SOUND 50, 1
|
||||
END IF
|
||||
GOTO 1
|
||||
|
||||
|
||||
highpunch2:
|
||||
IF c < e THEN GOTO hp2
|
||||
LINE (e, 120)-(e + 15, 110), 11
|
||||
LINE (e, 120)-(e + 30, 110), colour1
|
||||
FOR i = 1 TO speed
|
||||
NEXT i
|
||||
LINE (e, 120)-(e + 15, 110), colour1
|
||||
LINE (e, 120)-(e + 30, 110), 11
|
||||
GOTO hp2x
|
||||
hp2:
|
||||
LINE (e, 120)-(e - 15, 110), 11
|
||||
LINE (e, 120)-(e - 30, 110), colour1
|
||||
FOR i = 1 TO speed
|
||||
NEXT i
|
||||
LINE (e, 120)-(e - 15, 110), colour1
|
||||
LINE (e, 120)-(e - 30, 110), 11
|
||||
GOTO hp2x
|
||||
hp2x:
|
||||
IF e + 29 = c OR e - 29 = c OR e + 30 = c OR e - 30 = c THEN
|
||||
a = a - 2
|
||||
IF snd = 1 THEN SOUND 50, 1
|
||||
END IF
|
||||
IF e + 24 = c OR e - 24 = c OR e + 25 = c OR e - 25 = c THEN
|
||||
a = a - 3
|
||||
IF snd = 1 THEN SOUND 50, 1
|
||||
END IF
|
||||
IF e + 19 = c OR e - 19 = c OR e + 20 = c OR e - 20 = c THEN
|
||||
a = a - 1
|
||||
IF snd = 1 THEN SOUND 50, 1
|
||||
END IF
|
||||
GOTO 1
|
||||
|
||||
|
||||
|
||||
600 FOR iii = 1 TO 8000
|
||||
LOCATE 12, 32: PRINT "Player 1 Losses!"
|
||||
NEXT iii
|
||||
FOR ii = 10 TO 1 STEP -1
|
||||
CIRCLE (c, 105), ii + 1, 11
|
||||
CIRCLE (c, 105), ii, colour1
|
||||
FOR i = 1 TO speed
|
||||
NEXT i
|
||||
NEXT ii
|
||||
GOTO 615
|
||||
610 FOR iii = 1 TO 8000
|
||||
LOCATE 12, 32: PRINT "Player 2 Losses!"
|
||||
NEXT iii
|
||||
FOR ii = 10 TO 1 STEP -1
|
||||
CIRCLE (e, 105), ii + 1, 11
|
||||
CIRCLE (e, 105), ii, colour2
|
||||
FOR i = 1 TO speed
|
||||
NEXT i
|
||||
NEXT ii
|
||||
GOTO 615
|
||||
|
||||
615
|
||||
FOR i = 400 TO 1 STEP -1
|
||||
CIRCLE (320, 100), i
|
||||
PAINT (1, 1), 11
|
||||
CIRCLE (320, 100), i + 1, 11
|
||||
FOR ii = 1 TO speed / 10
|
||||
NEXT ii
|
||||
NEXT i
|
||||
|
||||
616 GOTO mainmenu
|
||||
|
||||
intro:
|
||||
|
||||
'MicroTrip
|
||||
CLS
|
||||
SCREEN 8
|
||||
COLOR 15
|
||||
LOCATE 12, 35: PRINT "MicroTrip"
|
||||
LINE (260, 85)-(350, 97), 1, B
|
||||
PAINT (259, 84), 9, 1
|
||||
PLAY "mb L16 ed L4 e P64 L4 <a P4 > L16 fe L32 f P8 e P8 L4 d P4"
|
||||
PLAY "mb L16 ed L4 e P64 L4 <a P4 > L17 fe L32 f P8 e P8 L4 d P4"
|
||||
IF a$ <> "" THEN RETURN
|
||||
|
||||
'Move Guy
|
||||
|
||||
c = 5
|
||||
e = 1000
|
||||
moveguy:
|
||||
LINE (c, 110)-(c, 130) 'body
|
||||
LINE (c, 130)-(c - 20, 150) 'leg
|
||||
LINE (c, 130)-(c + 20, 150) 'other leg
|
||||
IF c < e THEN LINE (c, 120)-(c + 15, 110)'arm
|
||||
IF c > e THEN LINE (c, 120)-(c - 15, 110)'arm other
|
||||
CIRCLE (c, 105), 10 'head
|
||||
FOR i = 1 TO 9000
|
||||
NEXT i
|
||||
LINE (c, 110)-(c, 130), 9 'body
|
||||
LINE (c, 130)-(c - 20, 150), 9 'leg
|
||||
LINE (c, 130)-(c + 20, 150), 9 'other leg
|
||||
IF c < e THEN LINE (c, 120)-(c + 15, 110), 9'arm
|
||||
IF c > e THEN LINE (c, 120)-(c - 15, 110), 9'arm other
|
||||
CIRCLE (c, 105), 10, 9 'head
|
||||
c = c + 1
|
||||
a$ = INKEY$
|
||||
IF a$ <> "" THEN LET nn = 0: RETURN
|
||||
IF c >= 595 THEN LET nn = 1: RETURN
|
||||
GOTO moveguy
|
||||
|
||||
'****I have to fill this in later. It won't work right.****
|
||||
story:
|
||||
CLS
|
||||
fart = 0
|
||||
PAINT (1, 1), 0
|
||||
COLOR 4
|
||||
LOCATE 1, 1: PRINT "It was the year 1998 when you and Jake decided to start your"
|
||||
GOTO yeah
|
||||
first:
|
||||
PRINT "own 'wrestling' association. You were sick of how fake all of the "
|
||||
GOTO yeah
|
||||
second:
|
||||
PRINT "others including WCW, WWF and NWO, were. Then, simoultaniously, you both"
|
||||
GOTO yeah
|
||||
third:
|
||||
PRINT "had a good idea. What if your 'wrestling' association wasn't fake? What"
|
||||
GOTO yeah
|
||||
fourth:
|
||||
PRINT "if you had all of the 'wrestlers' sign a Beat Down contract saying that "
|
||||
GOTO yeah
|
||||
fifth:
|
||||
PRINT "they would fight to the death? This was gonna' be a kick @$$ 'fighting'"
|
||||
GOTO yeah
|
||||
sixth:
|
||||
PRINT "association! It would be known as the Beat Down Fighting Association!(BDFA)"
|
||||
GOTO yeah
|
||||
|
||||
endofstory:
|
||||
IF nn = 0 THEN RETURN
|
||||
LET nn = 1: RETURN
|
||||
|
||||
yeah:
|
||||
a$ = INKEY$
|
||||
IF a$ <> "" THEN nn = 0: GOTO endofstory
|
||||
FOR i = 1 TO 1000000
|
||||
NEXT i
|
||||
fart = fart + 1
|
||||
ON poop GOTO first, second, third, fourth, fifth, sixth
|
||||
|
||||
666
|
||||
|
||||
BIN
samples/beatdown/src/beatdown.zip
Normal file
BIN
samples/beatdown/src/beatdown.zip
Normal file
Binary file not shown.
|
|
@ -42,9 +42,9 @@ Sorry, I've no idea how to do it on MacOS or Linux, any info about it from peopl
|
|||
|
||||
> Please note that QBjs is still in early development and support for these examples is extremely experimental (meaning will most likely not work). With that out of the way, give it a try!
|
||||
|
||||
* [LOAD "bezier.bas"](https://v6p9d9t4.ssl.hwcdn.net/html/5953810/index.html?src=https://qb64.com/samples/bezier/src/bezier.bas)
|
||||
* [RUN "bezier.bas"](https://v6p9d9t4.ssl.hwcdn.net/html/5953810/index.html?mode=auto&src=https://qb64.com/samples/bezier/src/bezier.bas)
|
||||
* [PLAY "bezier.bas"](https://v6p9d9t4.ssl.hwcdn.net/html/5953810/index.html?mode=play&src=https://qb64.com/samples/bezier/src/bezier.bas)
|
||||
* [LOAD "bezier.bas"](https://v6p9d9t4.ssl.hwcdn.net/html/5963335/index.html?src=https://qb64.com/samples/bezier/src/bezier.bas)
|
||||
* [RUN "bezier.bas"](https://v6p9d9t4.ssl.hwcdn.net/html/5963335/index.html?mode=auto&src=https://qb64.com/samples/bezier/src/bezier.bas)
|
||||
* [PLAY "bezier.bas"](https://v6p9d9t4.ssl.hwcdn.net/html/5963335/index.html?mode=play&src=https://qb64.com/samples/bezier/src/bezier.bas)
|
||||
|
||||
### File(s)
|
||||
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
|
||||
### Author
|
||||
|
||||
[🐝 RhoSigma](../rhosigma.md)
|
||||
[🐝 Rho Sigma](../rho-sigma.md)
|
||||
|
||||
### Description
|
||||
|
||||
|
|
@ -42,9 +42,9 @@ Sorry, I've no idea how to do it on MacOS or Linux, any info about it from peopl
|
|||
|
||||
> Please note that QBjs is still in early development and support for these examples is extremely experimental (meaning will most likely not work). With that out of the way, give it a try!
|
||||
|
||||
* [LOAD "binclock.bas"](https://v6p9d9t4.ssl.hwcdn.net/html/5953810/index.html?src=https://qb64.com/samples/binary-clock/src/binclock.bas)
|
||||
* [RUN "binclock.bas"](https://v6p9d9t4.ssl.hwcdn.net/html/5953810/index.html?mode=auto&src=https://qb64.com/samples/binary-clock/src/binclock.bas)
|
||||
* [PLAY "binclock.bas"](https://v6p9d9t4.ssl.hwcdn.net/html/5953810/index.html?mode=play&src=https://qb64.com/samples/binary-clock/src/binclock.bas)
|
||||
* [LOAD "binclock.bas"](https://v6p9d9t4.ssl.hwcdn.net/html/5963335/index.html?src=https://qb64.com/samples/binary-clock/src/binclock.bas)
|
||||
* [RUN "binclock.bas"](https://v6p9d9t4.ssl.hwcdn.net/html/5963335/index.html?mode=auto&src=https://qb64.com/samples/binary-clock/src/binclock.bas)
|
||||
* [PLAY "binclock.bas"](https://v6p9d9t4.ssl.hwcdn.net/html/5963335/index.html?mode=play&src=https://qb64.com/samples/binary-clock/src/binclock.bas)
|
||||
|
||||
### File(s)
|
||||
|
||||
|
|
|
|||
BIN
samples/binary-counter/img/screenshot.png
Normal file
BIN
samples/binary-counter/img/screenshot.png
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 2.7 KiB |
35
samples/binary-counter/index.md
Normal file
35
samples/binary-counter/index.md
Normal file
|
|
@ -0,0 +1,35 @@
|
|||
[Home](https://qb64.com) • [News](../../news.md) • [GitHub](../../github.md) • [Wiki](../../wiki.md) • [Samples](../../samples.md) • [Media](../../media.md) • [Community](../../community.md) • [Rolodex](../../rolodex.md) • [More...](../../more.md)
|
||||
|
||||
## SAMPLE: BINARY COUNTER
|
||||
|
||||
|
||||
|
||||
### Author
|
||||
|
||||
[🐝 rpgfan3233](../rpgfan3233.md)
|
||||
|
||||
### Description
|
||||
|
||||
```text
|
||||
' This program is a 12-bit Binary counter, displayed using a 3x4 grid.
|
||||
' It was created in the honour of an old acquaintance who became
|
||||
' obsessed with the binary number system.
|
||||
'
|
||||
' It uses extended character code 219 from IBM code page 437 to render
|
||||
' the ON state and a simple space (character code 32) to render the
|
||||
' OFF state.
|
||||
```
|
||||
|
||||
### QBjs
|
||||
|
||||
> Please note that QBjs is still in early development and support for these examples is extremely experimental (meaning will most likely not work). With that out of the way, give it a try!
|
||||
|
||||
* [LOAD "binarycounter.bas"](https://v6p9d9t4.ssl.hwcdn.net/html/5963335/index.html?src=https://qb64.com/samples/binary-counter/src/binarycounter.bas)
|
||||
* [RUN "binarycounter.bas"](https://v6p9d9t4.ssl.hwcdn.net/html/5963335/index.html?mode=auto&src=https://qb64.com/samples/binary-counter/src/binarycounter.bas)
|
||||
* [PLAY "binarycounter.bas"](https://v6p9d9t4.ssl.hwcdn.net/html/5963335/index.html?mode=play&src=https://qb64.com/samples/binary-counter/src/binarycounter.bas)
|
||||
|
||||
### File(s)
|
||||
|
||||
* [binarycounter.bas](src/binarycounter.bas)
|
||||
|
||||
🔗 [binary](../binary.md), [counter](../counter.md)
|
||||
47
samples/binary-counter/src/binarycounter.bas
Normal file
47
samples/binary-counter/src/binarycounter.bas
Normal file
|
|
@ -0,0 +1,47 @@
|
|||
' This program is a 12-bit Binary counter, displayed using a 3x4 grid.
|
||||
' It was created in the honour of an old acquaintance who became
|
||||
' obsessed with the binary number system.
|
||||
'
|
||||
' It uses extended character code 219 from IBM code page 437 to render
|
||||
' the ON state and a simple space (character code 32) to render the
|
||||
' OFF state.
|
||||
'
|
||||
' If you don't want to run it and just want to see what it does, check
|
||||
' out the video on YouTube that inspired the program -
|
||||
'
|
||||
' http://www.youtube.com/watch?v=Isydb_TCz_4
|
||||
DefInt A-Z
|
||||
Screen 1
|
||||
Cls
|
||||
|
||||
bits = 1
|
||||
|
||||
Do
|
||||
bitpos = 1
|
||||
row = 3
|
||||
col = 4
|
||||
|
||||
Do
|
||||
Locate row, col
|
||||
If bits And bitpos Then Print Chr$(219); Else Print " ";
|
||||
|
||||
bitpos = bitpos * 2
|
||||
|
||||
col = col - 1
|
||||
If col = 0 Then
|
||||
col = 4
|
||||
row = row - 1
|
||||
End If
|
||||
|
||||
Loop While row
|
||||
|
||||
Locate 7, 1
|
||||
Print LTrim$(RTrim$(Str$(bits)))
|
||||
|
||||
bits = bits + 1
|
||||
|
||||
_Delay 0.005 'Uncomment this line in QB64 if it runs too quickly.
|
||||
Loop While bits < 4096
|
||||
|
||||
System
|
||||
|
||||
9
samples/binary.md
Normal file
9
samples/binary.md
Normal file
|
|
@ -0,0 +1,9 @@
|
|||
[Home](https://qb64.com) • [News](../news.md) • [GitHub](../github.md) • [Wiki](../wiki.md) • [Samples](../samples.md) • [Media](../media.md) • [Community](../community.md) • [Rolodex](../rolodex.md) • [More...](../more.md)
|
||||
|
||||
## SAMPLES: BINARY
|
||||
|
||||
**[Binary Counter](binary-counter/index.md)**
|
||||
|
||||
[🐝 rpgfan3233](rpgfan3233.md) 🔗 [binary](binary.md), [counter](counter.md)
|
||||
|
||||
' This program is a 12-bit Binary counter, displayed using a 3x4 grid. ' It was created in the ho...
|
||||
BIN
samples/biorhythm-chart/img/screenshot.png
Normal file
BIN
samples/biorhythm-chart/img/screenshot.png
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 29 KiB |
25
samples/biorhythm-chart/index.md
Normal file
25
samples/biorhythm-chart/index.md
Normal file
|
|
@ -0,0 +1,25 @@
|
|||
[Home](https://qb64.com) • [News](../../news.md) • [GitHub](../../github.md) • [Wiki](../../wiki.md) • [Samples](../../samples.md) • [Media](../../media.md) • [Community](../../community.md) • [Rolodex](../../rolodex.md) • [More...](../../more.md)
|
||||
|
||||
## SAMPLE: BIORHYTHM CHART
|
||||
|
||||
|
||||
|
||||
### Author
|
||||
|
||||
[🐝 Bob Seguin](../bob-seguin.md)
|
||||
|
||||
### Description
|
||||
|
||||
```text
|
||||
'****************************************************************************'
|
||||
'------------------------- B I O C H A R T . B A S --------------------------'
|
||||
'------------- Copyright (C) 2007 by Bob Seguin (Freeware)-------------------'
|
||||
'****************************************************************************'
|
||||
```
|
||||
|
||||
### File(s)
|
||||
|
||||
* [biochart.bas](src/biochart.bas)
|
||||
* [biochart.zip](src/biochart.zip)
|
||||
|
||||
🔗 [biorhythms](../biorhythms.md)
|
||||
314
samples/biorhythm-chart/src/biochart.bas
Normal file
314
samples/biorhythm-chart/src/biochart.bas
Normal file
|
|
@ -0,0 +1,314 @@
|
|||
'****************************************************************************'
|
||||
'------------------------- B I O C H A R T . B A S --------------------------'
|
||||
'------------- Copyright (C) 2007 by Bob Seguin (Freeware)-------------------'
|
||||
'****************************************************************************'
|
||||
|
||||
DefInt A-Z
|
||||
|
||||
Dim Shared NumBOX(300)
|
||||
Dim Shared Box(12000)
|
||||
Dim Shared FontBOX(6000)
|
||||
Dim Shared xBOX(1 To 9)
|
||||
Def Seg = VarSeg(FontBOX(0))
|
||||
BLoad "brsmssb.fnt", VarPtr(FontBOX(0))
|
||||
Def Seg = VarSeg(NumBOX(0))
|
||||
BLoad "brsnums.bsv", VarPtr(NumBOX(0))
|
||||
Def Seg
|
||||
|
||||
Const Degree! = 3.14159 / 180
|
||||
Const Physical! = 90 / 23
|
||||
Const Emotional! = 90 / 28
|
||||
Const Intellectual! = 90 / 33
|
||||
Const Intuitive! = 90 / 38
|
||||
|
||||
Dim Shared DATE2$, Birthdate$
|
||||
Dim Shared Hour!
|
||||
Dim Shared Months(1 To 12) As Integer
|
||||
Restore MonthDATA
|
||||
For n = 1 To 12: Read Months(n): Next n
|
||||
Restore xDATA
|
||||
For n = 1 To 8: Read xBOX(n): Next n
|
||||
|
||||
Screen 12
|
||||
GoSub SetPALETTE
|
||||
DATE2$ = Date$
|
||||
|
||||
Graphics
|
||||
Birthday
|
||||
|
||||
Do
|
||||
k$ = UCase$(InKey$)
|
||||
Select Case k$
|
||||
Case "B"
|
||||
Put (162, 176), Box(), PSet
|
||||
B$ = GetDATE$
|
||||
If B$ = "NULL" Then
|
||||
System
|
||||
Else
|
||||
Birthdate$ = B$
|
||||
ChartBD
|
||||
End If
|
||||
Case "T"
|
||||
Put (162, 181), Box(3500), PSet
|
||||
B$ = GetDATE$
|
||||
If B$ = "NULL" Then DATE2$ = Date$ Else DATE2$ = B$
|
||||
Line (194, 419)-(294, 434), 0, BF
|
||||
PrintSTRING 196, 420, "DATE: " + DATE2$
|
||||
ChartBD
|
||||
Case Chr$(27): Exit Do
|
||||
End Select
|
||||
Loop
|
||||
|
||||
System
|
||||
|
||||
xDATA:
|
||||
Data 379,386,402,409,425,432,439,446
|
||||
|
||||
MonthDATA:
|
||||
Data 31,28,31,30,31,30,31,31,30,31,30,31
|
||||
|
||||
SetPALETTE:
|
||||
Restore SetPALETTE
|
||||
Data 0,0,21,21,8,43,24,10,48,26,11,53
|
||||
Data 28,12,58,32,13,63,63,63,21,42,42,42
|
||||
Data 63,0,0,21,31,63,52,41,63,55,55,55
|
||||
Data 0,0,42,63,21,63,32,32,42,63,63,63
|
||||
Restore SetPALETTE
|
||||
Out &H3C8, 0
|
||||
For n = 1 To 48
|
||||
Read Colr
|
||||
Out &H3C9, Colr
|
||||
Next n
|
||||
Return
|
||||
|
||||
Sub Birthday
|
||||
|
||||
Open "brbd.dta" For Binary As #1
|
||||
If LOF(1) Then
|
||||
Close #1
|
||||
Open "brbd.dta" For Input As #1
|
||||
Input #1, Birthdate$
|
||||
Close #1
|
||||
Else
|
||||
Close #1
|
||||
Put (162, 176), Box(), PSet
|
||||
B$ = GetDATE$
|
||||
If B$ = "NULL" Then
|
||||
System
|
||||
Else
|
||||
Birthdate$ = B$
|
||||
End If
|
||||
End If
|
||||
ChartBD
|
||||
|
||||
End Sub
|
||||
|
||||
Sub ChartBD
|
||||
|
||||
Line (220, 89)-(420, 102), 0, BF
|
||||
PrintSTRING 240, 89, "For a person born"
|
||||
PrintSTRING 340, 89, Birthdate$
|
||||
Open "brbd.dta" For Output As #1
|
||||
Print #1, Birthdate$
|
||||
Close #1
|
||||
ChartGFX
|
||||
|
||||
Hour! = Val(Mid$(Time$, 1, 2)) * .83
|
||||
Line (310 + Hour!, 110)-(310 + Hour!, 426), 11
|
||||
Line (310 + Hour!, 426)-(338, 426), 11
|
||||
PSet (310, 410), 7: Draw "D16L12"
|
||||
|
||||
Month$ = Mid$(DATE2$, 1, 2)
|
||||
Day$ = Mid$(DATE2$, 4, 2)
|
||||
Year$ = Mid$(DATE2$, 7, 4)
|
||||
M$ = Mid$(Birthdate$, 1, 2)
|
||||
D$ = Mid$(Birthdate$, 4, 2)
|
||||
y$ = Mid$(Birthdate$, 7, 4)
|
||||
FirstMONTH = Months(Val(M$)) - Val(D$) + 1
|
||||
For n = (Val(M$) + 1) To 12
|
||||
BalMONTHS = BalMONTHS + Months(n)
|
||||
If n = 2 And ((Val(y$) Mod 4) = 0) Then BalMONTHS = BalMONTHS + 1
|
||||
Next n
|
||||
FirstYEAR = FirstMONTH + BalMONTHS
|
||||
For n = (Val(y$) + 1) To (Val(Year$) - 1)
|
||||
If n Mod 4 = 0 Then Yr = 366 Else Yr = 365
|
||||
TDays = TDays + Yr
|
||||
Next n
|
||||
TDays = TDays + FirstYEAR
|
||||
|
||||
For n = 1 To Val(Month$) - 1
|
||||
Days = Days + Months(n)
|
||||
If n = 2 Then
|
||||
If Val(Year$) Mod 4 = 0 Then Days = Days + 1
|
||||
End If
|
||||
Next n
|
||||
|
||||
TDays = TDays + Days + Val(Day$) - 1
|
||||
|
||||
View Screen(10, 110)-(630, 410)
|
||||
|
||||
'EMOTIONAL
|
||||
PreviousX = 320 - (((TDays Mod 28) + 28) * 20)
|
||||
PreviousY = 260
|
||||
C! = 0
|
||||
For x = 320 - (((TDays Mod 28) + 28) * 20) To 630 Step 5
|
||||
Line (PreviousX, PreviousY)-(x, 260 + Sin(C! * Degree!) * 150), 8
|
||||
PreviousX = x
|
||||
PreviousY = 260 + Sin(C! * Degree!) * 150
|
||||
C! = C! - Emotional!
|
||||
Next x
|
||||
|
||||
'INTELLECTUAL
|
||||
PreviousX = 320 - (((TDays Mod 33) + 33) * 20)
|
||||
PreviousY = 260
|
||||
C! = 0
|
||||
For x = 320 - (((TDays Mod 33) + 33) * 20) To 630 Step 5
|
||||
Line (PreviousX, PreviousY)-(x, 260 + Sin(C! * Degree!) * 150), 6
|
||||
PreviousX = x
|
||||
PreviousY = 260 + Sin(C! * Degree!) * 150
|
||||
C! = C! - Intellectual!
|
||||
Next x
|
||||
|
||||
PreviousX = 10
|
||||
PreviousY = 260
|
||||
C! = 0
|
||||
'PHYSICAL
|
||||
PreviousX = 320 - (((TDays Mod 23) + 23) * 20)
|
||||
PreviousY = 250
|
||||
For x = 320 - (((TDays Mod 23) + 23) * 20) To 630 Step 5
|
||||
Line (PreviousX, PreviousY)-(x, 260 + Sin(C! * Degree!) * 150), 9
|
||||
PreviousX = x
|
||||
PreviousY = 260 + Sin(C! * Degree!) * 150
|
||||
C! = C! - Physical!
|
||||
Next x
|
||||
|
||||
|
||||
'INTUITIVE
|
||||
PreviousX = 320 - (((TDays Mod 38) + 38) * 20)
|
||||
PreviousY = 260
|
||||
C! = 0
|
||||
For x = 320 - (((TDays Mod 38) + 38) * 20) To 630 Step 5
|
||||
Line (PreviousX, PreviousY)-(x, 260 + Sin(C! * Degree!) * 150), 13
|
||||
PreviousX = x
|
||||
PreviousY = 260 + Sin(C! * Degree!) * 150
|
||||
C! = C! - Intuitive!
|
||||
Next x
|
||||
|
||||
View
|
||||
|
||||
End Sub
|
||||
|
||||
DefSng A-Z
|
||||
Sub ChartGFX
|
||||
|
||||
Line (5, 106)-(634, 414), 7, BF
|
||||
Line (9, 109)-(631, 170), 1, BF
|
||||
Line (9, 170)-(631, 230), 2, BF
|
||||
Line (9, 230)-(631, 290), 3, BF
|
||||
Line (9, 290)-(631, 350), 2, BF
|
||||
Line (9, 350)-(631, 411), 1, BF
|
||||
Line (9, 109)-(631, 411), 7, B
|
||||
For x = 30 To 610 Step 20
|
||||
Line (x, 110)-(x, 410), 7
|
||||
If x = 330 Then Paint (x - 10, 260), 7
|
||||
Next x
|
||||
Line (10, 260)-(630, 260), 7
|
||||
|
||||
End Sub
|
||||
|
||||
DefInt A-Z
|
||||
Function GetDATE$
|
||||
i = 1: Interval! = .25: Colr = 15
|
||||
Do
|
||||
Wait &H3DA, 8: Wait &H3DA, 8, 8
|
||||
If i < 9 Then Line (xBOX(i) + 1, 201)-(xBOX(i) + 6, 202), Colr, B
|
||||
k$ = InKey$
|
||||
Select Case k$
|
||||
Case "0" To "9"
|
||||
If i < 9 Then
|
||||
Line (xBOX(i) + 1, 201)-(xBOX(i) + 6, 202), 15, BF
|
||||
PutNUMS xBOX(i), Val(k$)
|
||||
D$ = D$ + k$
|
||||
i = i + 1
|
||||
End If
|
||||
Case Chr$(13) 'Enter
|
||||
If Len(D$) = 8 Then
|
||||
mm$ = Mid$(D$, 1, 2)
|
||||
dd$ = Mid$(D$, 3, 2)
|
||||
yy$ = Mid$(D$, 5, 4)
|
||||
If Val(mm$) > 0 And Val(mm$) < 13 Then
|
||||
If Val(dd$) > 0 And Val(dd$) < 32 Then
|
||||
If Val(yy$) > 1900 And Val(yy$) < 3000 Then
|
||||
GetDATE$ = mm$ + "-" + dd$ + "-" + yy$
|
||||
Else
|
||||
GetDATE$ = "NULL"
|
||||
End If
|
||||
Else
|
||||
GetDATE$ = "NULL"
|
||||
End If
|
||||
Else
|
||||
GetDATE$ = "NULL"
|
||||
End If
|
||||
Else
|
||||
GetDATE$ = "NULL"
|
||||
End If
|
||||
Exit Function
|
||||
Case Chr$(8) 'Backspace
|
||||
If i > 1 Then
|
||||
If i < 9 Then Line (xBOX(i), 193)-(xBOX(i) + 6, 202), 15, BF
|
||||
i = i - 1
|
||||
Line (xBOX(i), 193)-(xBOX(i) + 6, 202), 15, BF
|
||||
D$ = Mid$(D$, 1, Len(D$) - 1)
|
||||
End If
|
||||
End Select
|
||||
|
||||
If Timer > StartTIME! + Interval! Then
|
||||
StartTIME! = Timer
|
||||
If Colr = 15 Then Colr = 7 Else Colr = 15
|
||||
End If
|
||||
|
||||
Loop
|
||||
|
||||
End Function
|
||||
|
||||
Sub Graphics
|
||||
Def Seg = VarSeg(Box(0))
|
||||
BLoad "brsheads.bsv", VarPtr(Box(0))
|
||||
Def Seg
|
||||
Put (78, 32), Box()
|
||||
Put (20, 440), Box(7000)
|
||||
Put (10, 6), Box(10000)
|
||||
Put (500, 6), Box(11200)
|
||||
|
||||
PrintSTRING 196, 420, "DATE: " + DATE2$
|
||||
PrintSTRING 342, 420, "TIME: " + Time$
|
||||
PrintSTRING 12, 460, "Press [B] to enter a new birth date"
|
||||
PrintSTRING 270, 460, "Press [T] to enter a target date"
|
||||
PrintSTRING 520, 460, "Press [ESC] to QUIT"
|
||||
|
||||
ChartGFX
|
||||
|
||||
Def Seg = VarSeg(Box(0))
|
||||
BLoad "brsinpt.bsv", VarPtr(Box(0))
|
||||
Def Seg
|
||||
|
||||
End Sub
|
||||
|
||||
Sub PrintSTRING (x, y, Prnt$)
|
||||
|
||||
For i = 1 To Len(Prnt$)
|
||||
Char$ = Mid$(Prnt$, i, 1)
|
||||
If Char$ = " " Then
|
||||
x = x + FontBOX(1)
|
||||
Else
|
||||
Index = (Asc(Char$) - 33) * FontBOX(0) + 2
|
||||
Put (x, y), FontBOX(Index)
|
||||
x = x + FontBOX(Index)
|
||||
End If
|
||||
Next i
|
||||
|
||||
End Sub
|
||||
|
||||
Sub PutNUMS (x, Num)
|
||||
Put (x, 191), NumBOX(Num * 30)
|
||||
End Sub
|
||||
BIN
samples/biorhythm-chart/src/biochart.zip
Normal file
BIN
samples/biorhythm-chart/src/biochart.zip
Normal file
Binary file not shown.
9
samples/biorhythms.md
Normal file
9
samples/biorhythms.md
Normal file
|
|
@ -0,0 +1,9 @@
|
|||
[Home](https://qb64.com) • [News](../news.md) • [GitHub](../github.md) • [Wiki](../wiki.md) • [Samples](../samples.md) • [Media](../media.md) • [Community](../community.md) • [Rolodex](../rolodex.md) • [More...](../more.md)
|
||||
|
||||
## SAMPLES: BIORHYTHMS
|
||||
|
||||
**[Biorhythm Chart](biorhythm-chart/index.md)**
|
||||
|
||||
[🐝 Bob Seguin](bob-seguin.md) 🔗 [biorhythms](biorhythms.md)
|
||||
|
||||
'****************************************************************************' '-----------------...
|
||||
|
|
@ -18,9 +18,9 @@ A Breakout clone with DXBall aspirations.
|
|||
|
||||
> Please note that QBjs is still in early development and support for these examples is extremely experimental (meaning will most likely not work). With that out of the way, give it a try!
|
||||
|
||||
* [LOAD "blockout.bas"](https://v6p9d9t4.ssl.hwcdn.net/html/5953810/index.html?src=https://qb64.com/samples/blockout/src/blockout.bas)
|
||||
* [RUN "blockout.bas"](https://v6p9d9t4.ssl.hwcdn.net/html/5953810/index.html?mode=auto&src=https://qb64.com/samples/blockout/src/blockout.bas)
|
||||
* [PLAY "blockout.bas"](https://v6p9d9t4.ssl.hwcdn.net/html/5953810/index.html?mode=play&src=https://qb64.com/samples/blockout/src/blockout.bas)
|
||||
* [LOAD "blockout.bas"](https://v6p9d9t4.ssl.hwcdn.net/html/5963335/index.html?src=https://qb64.com/samples/blockout/src/blockout.bas)
|
||||
* [RUN "blockout.bas"](https://v6p9d9t4.ssl.hwcdn.net/html/5963335/index.html?mode=auto&src=https://qb64.com/samples/blockout/src/blockout.bas)
|
||||
* [PLAY "blockout.bas"](https://v6p9d9t4.ssl.hwcdn.net/html/5963335/index.html?mode=play&src=https://qb64.com/samples/blockout/src/blockout.bas)
|
||||
|
||||
### File(s)
|
||||
|
||||
|
|
|
|||
|
|
@ -14,6 +14,12 @@ Abacus app by Bob Seguin. NOTE: This game requires graphics files created by an
|
|||
|
||||
A Graphics/Animation utility by Bob Seguin. NOTE: This game requires graphics files created by a...
|
||||
|
||||
**[Biorhythm Chart](biorhythm-chart/index.md)**
|
||||
|
||||
[🐝 Bob Seguin](bob-seguin.md) 🔗 [biorhythms](biorhythms.md)
|
||||
|
||||
'****************************************************************************' '-----------------...
|
||||
|
||||
**[Rattler](rattler/index.md)**
|
||||
|
||||
[🐝 Bob Seguin](bob-seguin.md) 🔗 [game](game.md), [snake](snake.md)
|
||||
|
|
|
|||
|
|
@ -8,6 +8,12 @@
|
|||
|
||||
A Breakout clone with DXBall aspirations.
|
||||
|
||||
**[Breakout](breakout/index.md)**
|
||||
|
||||
[🐝 kinem](kinem.md) 🔗 [game](game.md), [breakout](breakout.md)
|
||||
|
||||
Breakout game.
|
||||
|
||||
**[QBricks](qbricks/index.md)**
|
||||
|
||||
[🐝 Microsoft](microsoft.md) 🔗 [game](game.md), [breakout](breakout.md)
|
||||
|
|
|
|||
BIN
samples/breakout/img/breakout-kinem.png
Normal file
BIN
samples/breakout/img/breakout-kinem.png
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 2.4 KiB |
29
samples/breakout/index.md
Normal file
29
samples/breakout/index.md
Normal file
|
|
@ -0,0 +1,29 @@
|
|||
[Home](https://qb64.com) • [News](../../news.md) • [GitHub](../../github.md) • [Wiki](../../wiki.md) • [Samples](../../samples.md) • [Media](../../media.md) • [Community](../../community.md) • [Rolodex](../../rolodex.md) • [More...](../../more.md)
|
||||
|
||||
## SAMPLE: BREAKOUT
|
||||
|
||||
|
||||
|
||||
### Author
|
||||
|
||||
[🐝 kinem](../kinem.md)
|
||||
|
||||
### Description
|
||||
|
||||
```text
|
||||
Breakout game.
|
||||
```
|
||||
|
||||
### QBjs
|
||||
|
||||
> Please note that QBjs is still in early development and support for these examples is extremely experimental (meaning will most likely not work). With that out of the way, give it a try!
|
||||
|
||||
* [LOAD "breakoutkinem.bas"](https://v6p9d9t4.ssl.hwcdn.net/html/5963335/index.html?src=https://qb64.com/samples/breakout/src/breakoutkinem.bas)
|
||||
* [RUN "breakoutkinem.bas"](https://v6p9d9t4.ssl.hwcdn.net/html/5963335/index.html?mode=auto&src=https://qb64.com/samples/breakout/src/breakoutkinem.bas)
|
||||
* [PLAY "breakoutkinem.bas"](https://v6p9d9t4.ssl.hwcdn.net/html/5963335/index.html?mode=play&src=https://qb64.com/samples/breakout/src/breakoutkinem.bas)
|
||||
|
||||
### File(s)
|
||||
|
||||
* [breakoutkinem.bas](src/breakoutkinem.bas)
|
||||
|
||||
🔗 [game](../game.md), [breakout](../breakout.md)
|
||||
31
samples/breakout/src/breakoutkinem.bas
Normal file
31
samples/breakout/src/breakoutkinem.bas
Normal file
|
|
@ -0,0 +1,31 @@
|
|||
'$lang:"qb" 'BO5.BAS 'kinem 'QB4.5
|
||||
Screen 13: Dim circ(26): Circle (2, 2), 2: qb = (Point(2, 0) > 0): Cls
|
||||
Line (1, 0)-(3, 0): Line (1, 4)-(3, 4): Line (0, 1)-(0, 3): Line (4, 1)-(4, 3)
|
||||
Get (0, 0)-(4, 4), circ()
|
||||
Line (0, 30)-(319, 50), 3, BF: Line (0, 70)-(319, 80), 2, BF: siz = 20
|
||||
Line (0, 80)-(319, 90), 1, BF: Line (0, 0)-(319, 10), 4, BF: px = 160
|
||||
Locate 25, 1: Print "press space to start";: Do: i$ = InKey$: vx = 2: vy = 2
|
||||
Loop Until i$ = " ": Locate 25, 1: Print String$(20, 32);: bx = 80: by = 100
|
||||
Put (bx - 2, by - 2), circ(), Xor
|
||||
1 If opx <> px Or siz <> osiz Then Line (opx - 20, 192)-(opx + 20, 199), 0, BF
|
||||
Line (px - siz, 192)-(px + siz, 199), 7, BF: opx = px: osiz = siz
|
||||
Line (px - siz, 199)-(px - siz + 7, 192), 8
|
||||
Line (px + siz, 199)-(px + siz - 7, 192), 8
|
||||
i$ = Right$(InKey$, 1): If i$ = "M" And px < 317 - siz Then px = px + 3
|
||||
If i$ = "K" And px > siz + 2 Then px = px - 3
|
||||
Put (bx - 2, by - 2), circ(), Xor
|
||||
bx = bx + vx: by = by + vy: If bx < 2 Then vx = Abs(vx): bx = 2
|
||||
If bx > 317 Then vx = -Abs(vx): bx = 317
|
||||
If by < 2 Then vy = Abs(vy): by = 2: If siz > 7 Then siz = siz - 1
|
||||
Put (bx - 2, by - 2), circ(), Xor
|
||||
bt = Point(bx, by): t = Timer: Do: Loop Until Timer - t >= .05
|
||||
If bt And bt < 7 Then
|
||||
Put (bx - 2, by - 2), circ(), Xor
|
||||
vy = -vy: For r = 0 To RR Step 1: Circle (bx, by), r, 0
|
||||
Circle (bx, by + 1), r, 0: Next: Put (bx - 2, by - 2), circ(), Xor
|
||||
s = s + bt * (1 - (vy < 0)): Locate 1, 1: Print "score"; s: RR = RR + .5
|
||||
End If: dx = bx - px
|
||||
If by > 190 And Abs(dx) < siz + 1 Then vy = -vy: vx = vx + dx / siz
|
||||
If i$ <> Chr$(27) And by < 193 GoTo 1
|
||||
If Not qb Then t = Timer: Do: Loop Until Timer - t >= .25: Sleep
|
||||
|
||||
9
samples/brian-murphy.md
Normal file
9
samples/brian-murphy.md
Normal file
|
|
@ -0,0 +1,9 @@
|
|||
[Home](https://qb64.com) • [News](../news.md) • [GitHub](../github.md) • [Wiki](../wiki.md) • [Samples](../samples.md) • [Media](../media.md) • [Community](../community.md) • [Rolodex](../rolodex.md) • [More...](../more.md)
|
||||
|
||||
## SAMPLES BY BRIAN MURPHY
|
||||
|
||||
**[Beatdown](beatdown/index.md)**
|
||||
|
||||
[🐝 Brian Murphy](brian-murphy.md) 🔗 [game](game.md), [legacy](legacy.md)
|
||||
|
||||
' Beat Down ' 1998 MicroTrip ' ...
|
||||
BIN
samples/calc/img/screenshot.png
Normal file
BIN
samples/calc/img/screenshot.png
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 5.6 KiB |
80
samples/calc/index.md
Normal file
80
samples/calc/index.md
Normal file
|
|
@ -0,0 +1,80 @@
|
|||
[Home](https://qb64.com) • [News](../../news.md) • [GitHub](../../github.md) • [Wiki](../../wiki.md) • [Samples](../../samples.md) • [Media](../../media.md) • [Community](../../community.md) • [Rolodex](../../rolodex.md) • [More...](../../more.md)
|
||||
|
||||
## SAMPLE: CALC
|
||||
|
||||
|
||||
|
||||
### Author
|
||||
|
||||
[🐝 William Loughner](../william-loughner.md)
|
||||
|
||||
### Description
|
||||
|
||||
```text
|
||||
' CALC.BAS
|
||||
' by William Loughner
|
||||
' Copyright (c) 1994 DOS Resource Guide
|
||||
' Published in Issue #14, March 1994, page 58
|
||||
|
||||
==============================================================================
|
||||
|
||||
----------
|
||||
CALC.BAS
|
||||
----------
|
||||
SYSTEM REQUIREMENTS:
|
||||
The version of QBasic that comes with DOS 5 or later, or Microsoft Quick Basic
|
||||
4.x.
|
||||
|
||||
WHAT CALC.BAS DOES:
|
||||
CALC.BAS is a simple calculator program that you can use whenever you need to
|
||||
make arithmetic calculations involving addition, subtraction, multiplication,
|
||||
division, and raising to a power (exponentiation).
|
||||
|
||||
USING CALC.BAS
|
||||
To load the program, type QBASIC CALC.BAS (using path names if necessary) at
|
||||
the DOS prompt. Then run the program by selecting the Start option in QBasic's
|
||||
Run menu, or press Shift-F5. After clearing the screen, CALC.BAS displays a
|
||||
line where you may enter your calculation and a second line that keeps a
|
||||
running total for you. Like a standard calculator, it displays keystrokes as
|
||||
you type them and evaluates expressions from left to right. When you type the
|
||||
equal sign (=) or press Enter, the program clears the calculation, tells you
|
||||
that the running total is the answer, and reminds you what keystrokes to press
|
||||
to proceed.
|
||||
|
||||
Permissible keystrokes are the numbers from zero to 9; a decimal point; the
|
||||
operators for addition, subtraction, multiplication, division, and raising to
|
||||
a power (+, -, *, /, and ^); open and close parentheses (); open and close
|
||||
brackets []; an equal sign; Enter; and an upper- or lowercase "x." If you
|
||||
press other keys, CALC.BAS issues an error message. Typing x or X ends the
|
||||
program.
|
||||
|
||||
CALC.BAS can handle one level of parentheses. An open parentheses sets the
|
||||
running total to zero, and a close parentheses resets the running total to
|
||||
that of the entire expression.
|
||||
|
||||
To access CALC.BAS quickly and easily, create the following one-line batch
|
||||
file, and place it in your C:\BATCH directory:
|
||||
|
||||
@QBASIC /RUN CALC
|
||||
|
||||
If you name this batch file CALC.BAT and include the C:\BATCH directory in the
|
||||
PATH statement in your AUTOEXEC.BAT file, you can start QBasic and run
|
||||
CALC.BAS by typing CALC at the DOS prompt.
|
||||
|
||||
For further details on CALC.BAS, see "It All Adds Up" (Readers' Queue, DRG
|
||||
#14, March 1994, page 58).
|
||||
```
|
||||
|
||||
### QBjs
|
||||
|
||||
> Please note that QBjs is still in early development and support for these examples is extremely experimental (meaning will most likely not work). With that out of the way, give it a try!
|
||||
|
||||
* [LOAD "calc.bas"](https://v6p9d9t4.ssl.hwcdn.net/html/5963335/index.html?src=https://qb64.com/samples/calc/src/calc.bas)
|
||||
* [RUN "calc.bas"](https://v6p9d9t4.ssl.hwcdn.net/html/5963335/index.html?mode=auto&src=https://qb64.com/samples/calc/src/calc.bas)
|
||||
* [PLAY "calc.bas"](https://v6p9d9t4.ssl.hwcdn.net/html/5963335/index.html?mode=play&src=https://qb64.com/samples/calc/src/calc.bas)
|
||||
|
||||
### File(s)
|
||||
|
||||
* [calc.bas](src/calc.bas)
|
||||
|
||||
🔗 [calculator](../calculator.md), [dos world](../dos-world.md)
|
||||
79
samples/calc/src/calc.bas
Normal file
79
samples/calc/src/calc.bas
Normal file
|
|
@ -0,0 +1,79 @@
|
|||
' CALC.BAS
|
||||
' by William Loughner
|
||||
' Copyright (c) 1994 DOS Resource Guide
|
||||
' Published in Issue #14, March 1994, page 58
|
||||
|
||||
DO
|
||||
Total = 0: Calculation$ = "": Op$ = "+": Key$ = "x": NegFlag% = 0
|
||||
DO
|
||||
GOSUB GetKeyStroke
|
||||
SELECT CASE Key$
|
||||
CASE "(", "["
|
||||
IF NParen% = 1 THEN
|
||||
Key$ = ""
|
||||
ELSE
|
||||
IF NegFlag% = 1 THEN ParenNeg% = 1: NegFlag% = 0
|
||||
Operand$ = "": NParen% = 1: ParenTotal = Total: Total = 0
|
||||
ParenOp$ = Op$: Op$ = "+"
|
||||
END IF
|
||||
CASE ")", "]"
|
||||
IF NParen% = 0 THEN
|
||||
Key$ = ""
|
||||
ELSE
|
||||
GOSUB Operate: IF ParenNeg% = 1 THEN Total = -Total: ParenNeg% = 0
|
||||
Op$ = ParenOp$: Operand$ = STR$(Total): Total = ParenTotal
|
||||
GOSUB Operate: NParen% = 0
|
||||
END IF
|
||||
CASE "=", CHR$(13)
|
||||
IF NParen% = 1 THEN
|
||||
Key$ = ""
|
||||
ELSE
|
||||
GOSUB Operate: EXIT DO
|
||||
END IF
|
||||
CASE "s", "+", "*", "/", "^"
|
||||
GOSUB Operate: NegFlag% = 0: IF Key$ = "s" THEN Key$ = "-"
|
||||
CASE "-", ".", "0" TO "9"
|
||||
Operand$ = Operand$ + Key$: NegFlag% = 1
|
||||
CASE ELSE
|
||||
Key$ = ""
|
||||
END SELECT
|
||||
Calculation$ = Calculation$ + Key$
|
||||
LOOP
|
||||
GOSUB GetKeyStroke
|
||||
LOOP
|
||||
|
||||
GetKeyStroke:
|
||||
CLS : PRINT "Calculation: "; Calculation$
|
||||
LOCATE 7, 1: PRINT "Running total: "; Total
|
||||
SELECT CASE Key$
|
||||
CASE ""
|
||||
PRINT "** You can't do that **"
|
||||
CASE "=", CHR$(13)
|
||||
PRINT "** ANSWER ** (Press X to quit, any other key to calculate again.)"
|
||||
END SELECT
|
||||
DO: Key$ = INKEY$: LOOP UNTIL Key$ <> ""
|
||||
SELECT CASE Key$
|
||||
CASE "x", "X"
|
||||
END
|
||||
CASE "-"
|
||||
IF NegFlag% = 1 THEN Key$ = "s"
|
||||
END SELECT
|
||||
RETURN
|
||||
|
||||
Operate:
|
||||
Operand = VAL(Operand$): Operand$ = ""
|
||||
SELECT CASE Op$
|
||||
CASE "+"
|
||||
Total = Total + Operand
|
||||
CASE "s"
|
||||
Total = Total - Operand
|
||||
CASE "*"
|
||||
Total = Total * Operand
|
||||
CASE "/"
|
||||
Total = Total / Operand
|
||||
CASE "^"
|
||||
Total = Total ^ Operand
|
||||
END SELECT
|
||||
Op$ = Key$
|
||||
RETURN
|
||||
|
||||
9
samples/calculator.md
Normal file
9
samples/calculator.md
Normal file
|
|
@ -0,0 +1,9 @@
|
|||
[Home](https://qb64.com) • [News](../news.md) • [GitHub](../github.md) • [Wiki](../wiki.md) • [Samples](../samples.md) • [Media](../media.md) • [Community](../community.md) • [Rolodex](../rolodex.md) • [More...](../more.md)
|
||||
|
||||
## SAMPLES: CALCULATOR
|
||||
|
||||
**[Calc](calc/index.md)**
|
||||
|
||||
[🐝 William Loughner](william-loughner.md) 🔗 [calculator](calculator.md), [dos world](dos-world.md)
|
||||
|
||||
' CALC.BAS ' by William Loughner ' Copyright (c) 1994 DOS Resource Guide ' Published i...
|
||||
9
samples/calendar.md
Normal file
9
samples/calendar.md
Normal file
|
|
@ -0,0 +1,9 @@
|
|||
[Home](https://qb64.com) • [News](../news.md) • [GitHub](../github.md) • [Wiki](../wiki.md) • [Samples](../samples.md) • [Media](../media.md) • [Community](../community.md) • [Rolodex](../rolodex.md) • [More...](../more.md)
|
||||
|
||||
## SAMPLES: CALENDAR
|
||||
|
||||
**[Calendar](calendar/index.md)**
|
||||
|
||||
[🐝 A&A De Pasquale](a&a-de-pasquale.md) 🔗 [calendar](calendar.md), [pdf](pdf.md), [dos world](dos-world.md)
|
||||
|
||||
' Antonio & Alfonso De Pasquale ' Copyright (C) 1993 DOS Resource Guide ' Published in Issue #8, ...
|
||||
BIN
samples/calendar/img/screenshot.png
Normal file
BIN
samples/calendar/img/screenshot.png
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 6.4 KiB |
60
samples/calendar/index.md
Normal file
60
samples/calendar/index.md
Normal file
|
|
@ -0,0 +1,60 @@
|
|||
[Home](https://qb64.com) • [News](../../news.md) • [GitHub](../../github.md) • [Wiki](../../wiki.md) • [Samples](../../samples.md) • [Media](../../media.md) • [Community](../../community.md) • [Rolodex](../../rolodex.md) • [More...](../../more.md)
|
||||
|
||||
## SAMPLE: CALENDAR
|
||||
|
||||
|
||||
|
||||
### Author
|
||||
|
||||
[🐝 A&A De Pasquale](../a&a-de-pasquale.md)
|
||||
|
||||
### Description
|
||||
|
||||
```text
|
||||
' Antonio & Alfonso De Pasquale
|
||||
' Copyright (C) 1993 DOS Resource Guide
|
||||
' Published in Issue #8, March 1993, page 47
|
||||
|
||||
==============================================================================
|
||||
|
||||
--------------
|
||||
CALENDAR.BAS
|
||||
--------------
|
||||
SYSTEM REQUIREMENTS:
|
||||
The version of QBasic that comes with DOS 5 or later, or Microsoft Quick Basic
|
||||
4.x, and a dot-matrix or HP LaserJet-compatible printer.
|
||||
|
||||
WHAT CALENDAR.BAS DOES:
|
||||
This QBasic program lets you print out a full year's calendar on a single
|
||||
page. CALENDAR.BAS accounts for leap years and works for 1753 and any year
|
||||
thereafter.
|
||||
|
||||
USING CALENDAR.BAS:
|
||||
To load the program, type QBASIC CALENDAR.BAS (using path names if necessary)
|
||||
at the DOS prompt. Then run the program by selecting the Start option in
|
||||
QBasic's Run menu, or press Shift-F5. The screen clears, and a greeting
|
||||
appears. The program then asks you to enter the year for which you want a
|
||||
calendar.
|
||||
|
||||
When you enter an acceptable year, the program performs its calculations and
|
||||
reminds you to make sure your printer is turned on and on line. Press Enter to
|
||||
begin printing the calendar. The program displays a message when printing
|
||||
finishes.
|
||||
|
||||
For further details on CALENDAR.BAS, see "The Perpetual Calendar" (DRG #8,
|
||||
March 1993, page 47).
|
||||
```
|
||||
|
||||
### QBjs
|
||||
|
||||
> Please note that QBjs is still in early development and support for these examples is extremely experimental (meaning will most likely not work). With that out of the way, give it a try!
|
||||
|
||||
* [LOAD "calendar.bas"](https://v6p9d9t4.ssl.hwcdn.net/html/5963335/index.html?src=https://qb64.com/samples/calendar/src/calendar.bas)
|
||||
* [RUN "calendar.bas"](https://v6p9d9t4.ssl.hwcdn.net/html/5963335/index.html?mode=auto&src=https://qb64.com/samples/calendar/src/calendar.bas)
|
||||
* [PLAY "calendar.bas"](https://v6p9d9t4.ssl.hwcdn.net/html/5963335/index.html?mode=play&src=https://qb64.com/samples/calendar/src/calendar.bas)
|
||||
|
||||
### File(s)
|
||||
|
||||
* [calendar.bas](src/calendar.bas)
|
||||
|
||||
🔗 [calendar](../calendar.md), [pdf](../pdf.md), [dos world](../dos-world.md)
|
||||
183
samples/calendar/src/calendar.bas
Normal file
183
samples/calendar/src/calendar.bas
Normal file
|
|
@ -0,0 +1,183 @@
|
|||
' Antonio & Alfonso De Pasquale
|
||||
' Copyright (C) 1993 DOS Resource Guide
|
||||
' Published in Issue #8, March 1993, page 47
|
||||
'
|
||||
' PERPETUAL CALENDAR PROGRAM
|
||||
|
||||
Setup:
|
||||
CLS
|
||||
CLEAR
|
||||
DIM Year(12, 6, 7), Month$(12), Month(12), Day$(7)
|
||||
FOR X = 1 TO 12
|
||||
FOR Y = 0 TO 6
|
||||
FOR Z = 0 TO 7
|
||||
Year(X, Y, Z) = 0
|
||||
NEXT Z
|
||||
NEXT Y
|
||||
NEXT X
|
||||
|
||||
GetYear:
|
||||
CLS
|
||||
PRINT TAB(30); "Calendar Creator"
|
||||
PRINT
|
||||
PRINT TAB(20); "By Antonio and Alfonso De Pasquale"
|
||||
PRINT
|
||||
INPUT "What is the calendar year you want"; Year$
|
||||
YR = VAL(Year$)
|
||||
|
||||
IF YR < 1753 THEN
|
||||
PRINT
|
||||
PRINT "Year must be greater than 1752. ";
|
||||
INPUT "Press <Enter> to try again"; A$
|
||||
GOTO GetYear
|
||||
END IF
|
||||
|
||||
PRINT
|
||||
PRINT "Please make sure your printer is turned on and is on-line"
|
||||
PRINT "Also, make sure the paper is set to the top of the form"
|
||||
PRINT
|
||||
INPUT "Press <Enter> when you are ready to continue"; A$
|
||||
PRINT
|
||||
PRINT "Calculating dates...please wait"
|
||||
PRINT
|
||||
|
||||
CalcYear:
|
||||
C = INT(YR / 100)
|
||||
IF RIGHT$(STR$(YR), 2) = "00" THEN C = C - 1
|
||||
D = (YR - (100 * C)) - 1
|
||||
IF D = -1 THEN D = 99
|
||||
K = 1
|
||||
M = 11
|
||||
X = (INT(2.6 * M - .2) + K + D + INT(D / 4) + INT(C / 4) - (2 * C)) / 7
|
||||
G = ABS(X - INT(X))
|
||||
F = INT(7 * G + .00001) + 1
|
||||
|
||||
IF (YR / 4) = INT(YR / 4) AND RIGHT$(Year$, 2) <> "00" THEN
|
||||
LY = 1
|
||||
GOTO FillYear
|
||||
END IF
|
||||
|
||||
IF (YR / 400) = INT(YR / 400) AND RIGHT$(Year$, 2) = "00" THEN
|
||||
LY = 1
|
||||
GOTO FillYear
|
||||
END IF
|
||||
|
||||
LY = 0
|
||||
|
||||
FillYear:
|
||||
FOR X = 1 TO 7
|
||||
READ Day$(X)
|
||||
NEXT X
|
||||
FOR X = 1 TO 12
|
||||
READ Month$(X)
|
||||
NEXT X
|
||||
FOR X = 1 TO 12
|
||||
READ Month(X)
|
||||
NEXT X
|
||||
IF LY = 1 THEN Month(2) = 29
|
||||
|
||||
FOR X = 1 TO 12
|
||||
R = 1
|
||||
FOR G = 1 TO Month(X)
|
||||
Year(X, R, F) = G
|
||||
F = F + 1
|
||||
IF F = 8 THEN F = 1: R = R + 1
|
||||
NEXT G
|
||||
NEXT X
|
||||
DATA S,M,T,W,T,F,S
|
||||
DATA JANUARY,FEBRUARY,MARCH,APRIL,MAY,JUNE,JULY
|
||||
DATA AUGUST,SEPTEMBER,OCTOBER,NOVEMBER,DECEMBER
|
||||
DATA 31,28,31,30,31,30,31,31,30,31,30,31
|
||||
|
||||
BuildCalendar:
|
||||
LPRINT
|
||||
LPRINT
|
||||
LPRINT SPACE$(36);
|
||||
FOR X = 1 TO 5
|
||||
LPRINT MID$(Year$, X, 1); " ";
|
||||
NEXT X
|
||||
LPRINT
|
||||
LPRINT
|
||||
FOR I = 1 TO 12 STEP 2
|
||||
GOSUB PrintStars
|
||||
GOSUB PrintMonth
|
||||
GOSUB PrintWeek
|
||||
FOR Week = 1 TO 6
|
||||
LPRINT SPACE$(7);
|
||||
LPRINT "* ";
|
||||
FOR X = 1 TO 7
|
||||
SELECT CASE Year(I, Week, X)
|
||||
CASE IS = 0
|
||||
LPRINT SPACE$(4);
|
||||
CASE IS < 10
|
||||
SPV = 1
|
||||
LPRINT SPACE$(SPV); Year(I, Week, X);
|
||||
CASE IS > 9
|
||||
SPV = 0
|
||||
LPRINT SPACE$(SPV); Year(I, Week, X);
|
||||
END SELECT
|
||||
NEXT X
|
||||
LPRINT SPACE$(2); "* ";
|
||||
FOR X = 1 TO 7
|
||||
SELECT CASE Year(I + 1, Week, X)
|
||||
CASE IS = 0
|
||||
LPRINT SPACE$(4);
|
||||
CASE IS < 10
|
||||
SPV = 1
|
||||
LPRINT SPACE$(SPV); Year(I + 1, Week, X);
|
||||
CASE IS > 9
|
||||
SPV = 0
|
||||
LPRINT SPACE$(SPV); Year(I + 1, Week, X);
|
||||
END SELECT
|
||||
NEXT X
|
||||
LPRINT SPACE$(2); "*"
|
||||
NEXT Week
|
||||
NEXT I
|
||||
GOSUB PrintStars
|
||||
LPRINT CHR$(12)
|
||||
PRINT "Calendar has been printed."
|
||||
END
|
||||
|
||||
PrintStars:
|
||||
LPRINT SPACE$(7);
|
||||
FOR A = 1 TO 65
|
||||
LPRINT "*";
|
||||
NEXT A
|
||||
LPRINT
|
||||
RETURN
|
||||
|
||||
PrintMonth:
|
||||
FOR B = 1 TO 12 STEP 2
|
||||
IF B = I THEN
|
||||
GOSUB FindMonth
|
||||
END IF
|
||||
NEXT B
|
||||
RETURN
|
||||
|
||||
PrintWeek:
|
||||
LPRINT SPACE$(7);
|
||||
LPRINT "*"; SPACE$(3);
|
||||
FOR D = 1 TO 2
|
||||
FOR D1 = 1 TO 7
|
||||
LPRINT Day$(D1); SPACE$(3);
|
||||
NEXT D1
|
||||
LPRINT "*"; SPACE$(3);
|
||||
NEXT D
|
||||
LPRINT
|
||||
RETURN
|
||||
|
||||
FindMonth:
|
||||
T1 = LEN(Month$(B))
|
||||
T2 = LEN(Month$(B + 1))
|
||||
T3 = INT((33 - T1) / 2)
|
||||
T4 = INT((33 - T2) / 2)
|
||||
LPRINT SPACE$(7); "*";
|
||||
LPRINT SPACE$(T3); Month$(B);
|
||||
RT = 33 - T3 - T1
|
||||
LPRINT SPACE$(RT - 2); "*";
|
||||
LPRINT SPACE$(T4); Month$(B + 1);
|
||||
RT = 33 - T4 - T2
|
||||
LPRINT SPACE$(RT - 2); "*";
|
||||
LPRINT
|
||||
RETURN
|
||||
|
||||
|
|
@ -18,9 +18,9 @@ A turn-based artillery game by Microsoft.
|
|||
|
||||
> Please note that QBjs is still in early development and support for these examples is extremely experimental (meaning will most likely not work). With that out of the way, give it a try!
|
||||
|
||||
* [LOAD "castle.bas"](https://v6p9d9t4.ssl.hwcdn.net/html/5953810/index.html?src=https://qb64.com/samples/castle/src/castle.bas)
|
||||
* [RUN "castle.bas"](https://v6p9d9t4.ssl.hwcdn.net/html/5953810/index.html?mode=auto&src=https://qb64.com/samples/castle/src/castle.bas)
|
||||
* [PLAY "castle.bas"](https://v6p9d9t4.ssl.hwcdn.net/html/5953810/index.html?mode=play&src=https://qb64.com/samples/castle/src/castle.bas)
|
||||
* [LOAD "castle.bas"](https://v6p9d9t4.ssl.hwcdn.net/html/5963335/index.html?src=https://qb64.com/samples/castle/src/castle.bas)
|
||||
* [RUN "castle.bas"](https://v6p9d9t4.ssl.hwcdn.net/html/5963335/index.html?mode=auto&src=https://qb64.com/samples/castle/src/castle.bas)
|
||||
* [PLAY "castle.bas"](https://v6p9d9t4.ssl.hwcdn.net/html/5963335/index.html?mode=play&src=https://qb64.com/samples/castle/src/castle.bas)
|
||||
|
||||
### File(s)
|
||||
|
||||
|
|
|
|||
9
samples/chess.md
Normal file
9
samples/chess.md
Normal file
|
|
@ -0,0 +1,9 @@
|
|||
[Home](https://qb64.com) • [News](../news.md) • [GitHub](../github.md) • [Wiki](../wiki.md) • [Samples](../samples.md) • [Media](../media.md) • [Community](../community.md) • [Rolodex](../rolodex.md) • [More...](../more.md)
|
||||
|
||||
## SAMPLES: CHESS
|
||||
|
||||
**[Chess](chess/index.md)**
|
||||
|
||||
[🐝 Richard Frost](richard-frost.md) 🔗 [game](game.md), [chess](chess.md)
|
||||
|
||||
Eccentric chess implementation by Richard Frost.
|
||||
BIN
samples/chess/img/screenshot.png
Normal file
BIN
samples/chess/img/screenshot.png
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 99 KiB |
22
samples/chess/index.md
Normal file
22
samples/chess/index.md
Normal file
|
|
@ -0,0 +1,22 @@
|
|||
[Home](https://qb64.com) • [News](../../news.md) • [GitHub](../../github.md) • [Wiki](../../wiki.md) • [Samples](../../samples.md) • [Media](../../media.md) • [Community](../../community.md) • [Rolodex](../../rolodex.md) • [More...](../../more.md)
|
||||
|
||||
## SAMPLE: CHESS
|
||||
|
||||
|
||||
|
||||
### Author
|
||||
|
||||
[🐝 Richard Frost](../richard-frost.md)
|
||||
|
||||
### Description
|
||||
|
||||
```text
|
||||
Eccentric chess implementation by Richard Frost.
|
||||
```
|
||||
|
||||
### File(s)
|
||||
|
||||
* [chess.bas](src/chess.bas)
|
||||
* [chess.zip](src/chess.zip)
|
||||
|
||||
🔗 [game](../game.md), [chess](../chess.md)
|
||||
8614
samples/chess/src/chess.bas
Normal file
8614
samples/chess/src/chess.bas
Normal file
File diff suppressed because it is too large
Load diff
BIN
samples/chess/src/chess.zip
Normal file
BIN
samples/chess/src/chess.zip
Normal file
Binary file not shown.
|
|
@ -18,9 +18,9 @@ Here we present two (equivalent) methods for calculating the intersection points
|
|||
|
||||
> Please note that QBjs is still in early development and support for these examples is extremely experimental (meaning will most likely not work). With that out of the way, give it a try!
|
||||
|
||||
* [LOAD "circleintersectcircle.bas"](https://v6p9d9t4.ssl.hwcdn.net/html/5953810/index.html?src=https://qb64.com/samples/circle-intersecting-circle/src/circleintersectcircle.bas)
|
||||
* [RUN "circleintersectcircle.bas"](https://v6p9d9t4.ssl.hwcdn.net/html/5953810/index.html?mode=auto&src=https://qb64.com/samples/circle-intersecting-circle/src/circleintersectcircle.bas)
|
||||
* [PLAY "circleintersectcircle.bas"](https://v6p9d9t4.ssl.hwcdn.net/html/5953810/index.html?mode=play&src=https://qb64.com/samples/circle-intersecting-circle/src/circleintersectcircle.bas)
|
||||
* [LOAD "circleintersectcircle.bas"](https://v6p9d9t4.ssl.hwcdn.net/html/5963335/index.html?src=https://qb64.com/samples/circle-intersecting-circle/src/circleintersectcircle.bas)
|
||||
* [RUN "circleintersectcircle.bas"](https://v6p9d9t4.ssl.hwcdn.net/html/5963335/index.html?mode=auto&src=https://qb64.com/samples/circle-intersecting-circle/src/circleintersectcircle.bas)
|
||||
* [PLAY "circleintersectcircle.bas"](https://v6p9d9t4.ssl.hwcdn.net/html/5963335/index.html?mode=play&src=https://qb64.com/samples/circle-intersecting-circle/src/circleintersectcircle.bas)
|
||||
|
||||
### File(s)
|
||||
|
||||
|
|
|
|||
|
|
@ -18,9 +18,9 @@ This is an interactive (mouse-driven) demo that calculates the intersection of a
|
|||
|
||||
> Please note that QBjs is still in early development and support for these examples is extremely experimental (meaning will most likely not work). With that out of the way, give it a try!
|
||||
|
||||
* [LOAD "circle-intersect-line.bas"](https://v6p9d9t4.ssl.hwcdn.net/html/5953810/index.html?src=https://qb64.com/samples/circle-intersecting-line/src/circle-intersect-line.bas)
|
||||
* [RUN "circle-intersect-line.bas"](https://v6p9d9t4.ssl.hwcdn.net/html/5953810/index.html?mode=auto&src=https://qb64.com/samples/circle-intersecting-line/src/circle-intersect-line.bas)
|
||||
* [PLAY "circle-intersect-line.bas"](https://v6p9d9t4.ssl.hwcdn.net/html/5953810/index.html?mode=play&src=https://qb64.com/samples/circle-intersecting-line/src/circle-intersect-line.bas)
|
||||
* [LOAD "circle-intersect-line.bas"](https://v6p9d9t4.ssl.hwcdn.net/html/5963335/index.html?src=https://qb64.com/samples/circle-intersecting-line/src/circle-intersect-line.bas)
|
||||
* [RUN "circle-intersect-line.bas"](https://v6p9d9t4.ssl.hwcdn.net/html/5963335/index.html?mode=auto&src=https://qb64.com/samples/circle-intersecting-line/src/circle-intersect-line.bas)
|
||||
* [PLAY "circle-intersect-line.bas"](https://v6p9d9t4.ssl.hwcdn.net/html/5963335/index.html?mode=play&src=https://qb64.com/samples/circle-intersecting-line/src/circle-intersect-line.bas)
|
||||
|
||||
### File(s)
|
||||
|
||||
|
|
|
|||
9
samples/circuits.md
Normal file
9
samples/circuits.md
Normal file
|
|
@ -0,0 +1,9 @@
|
|||
[Home](https://qb64.com) • [News](../news.md) • [GitHub](../github.md) • [Wiki](../wiki.md) • [Samples](../samples.md) • [Media](../media.md) • [Community](../community.md) • [Rolodex](../rolodex.md) • [More...](../more.md)
|
||||
|
||||
## SAMPLES: CIRCUITS
|
||||
|
||||
**[Schemat](schemat/index.md)**
|
||||
|
||||
[🐝 Leif J. Burrow](leif-j.-burrow.md) 🔗 [circuits](circuits.md), [schematics](schematics.md)
|
||||
|
||||
# Schemat An old DOS QuickBasic schematic design editor updated for QB64. **What is it good for?...
|
||||
|
|
@ -7,3 +7,9 @@
|
|||
[🐝 Folker Fritz](folker-fritz.md) 🔗 [clock](clock.md), [desktop](desktop.md)
|
||||
|
||||
' Release: MINI-CLOCK by Folker Fritz ' Version: 1.0 (1999-10-31) ' Status: 100% Freewa...
|
||||
|
||||
**[QB Clock](qb-clock/index.md)**
|
||||
|
||||
[🐝 Alan Zeichick](alan-zeichick.md) 🔗 [clock](clock.md)
|
||||
|
||||
' Analog Clock for QBasic ' by Alan Zeichick copyright (c) 1986, 1992 ' Copyright (C) 1992 DOS Re...
|
||||
|
|
|
|||
BIN
samples/cloned-shades/img/screenshot.png
Normal file
BIN
samples/cloned-shades/img/screenshot.png
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 118 KiB |
25
samples/cloned-shades/index.md
Normal file
25
samples/cloned-shades/index.md
Normal file
|
|
@ -0,0 +1,25 @@
|
|||
[Home](https://qb64.com) • [News](../../news.md) • [GitHub](../../github.md) • [Wiki](../../wiki.md) • [Samples](../../samples.md) • [Media](../../media.md) • [Community](../../community.md) • [Rolodex](../../rolodex.md) • [More...](../../more.md)
|
||||
|
||||
## SAMPLE: CLONED SHADES
|
||||
|
||||
|
||||
|
||||
### Author
|
||||
|
||||
[🐝 Fellippe Heitor](../fellippe-heitor.md)
|
||||
|
||||
### Description
|
||||
|
||||
```text
|
||||
A clone of 'Shades' which was originally developed by UOVO.
|
||||
```
|
||||
|
||||
### File(s)
|
||||
|
||||
* [shades.bas](src/shades.bas)
|
||||
* [shades.zip](src/shades.zip)
|
||||
|
||||
🔗 [game](../game.md)
|
||||
|
||||
|
||||
<sub>Reference: [github.com](https://github.com/FellippeHeitor/Cloned-Shades) </sub>
|
||||
1478
samples/cloned-shades/src/shades.bas
Normal file
1478
samples/cloned-shades/src/shades.bas
Normal file
File diff suppressed because it is too large
Load diff
BIN
samples/cloned-shades/src/shades.zip
Normal file
BIN
samples/cloned-shades/src/shades.zip
Normal file
Binary file not shown.
|
|
@ -18,9 +18,9 @@ Realistic collisions between sphreres in two dimensions.
|
|||
|
||||
> Please note that QBjs is still in early development and support for these examples is extremely experimental (meaning will most likely not work). With that out of the way, give it a try!
|
||||
|
||||
* [LOAD "ball.bas"](https://v6p9d9t4.ssl.hwcdn.net/html/5953810/index.html?src=https://qb64.com/samples/colliding-ball-simulation/src/ball.bas)
|
||||
* [RUN "ball.bas"](https://v6p9d9t4.ssl.hwcdn.net/html/5953810/index.html?mode=auto&src=https://qb64.com/samples/colliding-ball-simulation/src/ball.bas)
|
||||
* [PLAY "ball.bas"](https://v6p9d9t4.ssl.hwcdn.net/html/5953810/index.html?mode=play&src=https://qb64.com/samples/colliding-ball-simulation/src/ball.bas)
|
||||
* [LOAD "ball.bas"](https://v6p9d9t4.ssl.hwcdn.net/html/5963335/index.html?src=https://qb64.com/samples/colliding-ball-simulation/src/ball.bas)
|
||||
* [RUN "ball.bas"](https://v6p9d9t4.ssl.hwcdn.net/html/5963335/index.html?mode=auto&src=https://qb64.com/samples/colliding-ball-simulation/src/ball.bas)
|
||||
* [PLAY "ball.bas"](https://v6p9d9t4.ssl.hwcdn.net/html/5963335/index.html?mode=play&src=https://qb64.com/samples/colliding-ball-simulation/src/ball.bas)
|
||||
|
||||
### File(s)
|
||||
|
||||
|
|
|
|||
9
samples/color-picker.md
Normal file
9
samples/color-picker.md
Normal file
|
|
@ -0,0 +1,9 @@
|
|||
[Home](https://qb64.com) • [News](../news.md) • [GitHub](../github.md) • [Wiki](../wiki.md) • [Samples](../samples.md) • [Media](../media.md) • [Community](../community.md) • [Rolodex](../rolodex.md) • [More...](../more.md)
|
||||
|
||||
## SAMPLES: COLOR PICKER
|
||||
|
||||
**[Colors](colors/index.md)**
|
||||
|
||||
[🐝 Hardin Brothers](hardin-brothers.md) 🔗 [color picker](color-picker.md), [dos world](dos-world.md)
|
||||
|
||||
' COLORS.BAS ' Copyright (c) 1993 DOS Resource Guide ' Published in Issue #12, November 199...
|
||||
BIN
samples/colors/img/screenshot.png
Normal file
BIN
samples/colors/img/screenshot.png
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 22 KiB |
136
samples/colors/index.md
Normal file
136
samples/colors/index.md
Normal file
|
|
@ -0,0 +1,136 @@
|
|||
[Home](https://qb64.com) • [News](../../news.md) • [GitHub](../../github.md) • [Wiki](../../wiki.md) • [Samples](../../samples.md) • [Media](../../media.md) • [Community](../../community.md) • [Rolodex](../../rolodex.md) • [More...](../../more.md)
|
||||
|
||||
## SAMPLE: COLORS
|
||||
|
||||
|
||||
|
||||
### Author
|
||||
|
||||
[🐝 Hardin Brothers](../hardin-brothers.md)
|
||||
|
||||
### Description
|
||||
|
||||
```text
|
||||
' COLORS.BAS
|
||||
' Copyright (c) 1993 DOS Resource Guide
|
||||
' Published in Issue #12, November 1993, page 69.
|
||||
|
||||
' This program lets you pick foreground
|
||||
' and background text colors by moving
|
||||
' a cursor with the arrow keys.
|
||||
' The program displays the QBasic color numbers,
|
||||
' the color names, and the ANSI codes that
|
||||
' will generate those colors.
|
||||
' You should find this program handy if you are
|
||||
' customizing your DOS prompt, designing a batch
|
||||
' file menu screen, or writing a QBasic program.
|
||||
|
||||
' Written by Hardin Brothers
|
||||
|
||||
==============================================================================
|
||||
|
||||
------------
|
||||
COLORS.BAS
|
||||
------------
|
||||
SYSTEM REQUIREMENTS:
|
||||
The version of QBasic that comes with DOS 5 or later, or Microsoft Quick Basic
|
||||
4.x.
|
||||
|
||||
WHAT COLORS.BAS DOES:
|
||||
This color-finder program displays the various screen color combinations
|
||||
available for your use in batch files and prompt commands. Using COLORS.BAS,
|
||||
you can select the color schemes you prefer and the program will provide the
|
||||
data you need to create ANSI escape sequences for your use. The program also
|
||||
provides the color numbers used in QBasic and other programs to specify screen
|
||||
colors.
|
||||
|
||||
USING COLORS.BAS:
|
||||
To load the program, type QBASIC COLORS.BAS (using path names if necessary) at
|
||||
the DOS prompt. Then run the program by selecting the Start option in QBasic's
|
||||
Run menu, or press Shift-F5. The screen will show you the 128 color
|
||||
combinations available to you for use in batch files, PROMPT commands, and
|
||||
QBasic programs. These combinations are made up of 16 foreground colors,
|
||||
used mainly for text, and 8 background colors.
|
||||
|
||||
Use the cursor keys to move from one color combination to another. As you do,
|
||||
a window in the lower left corner of the display will show you some sample
|
||||
text using the currently-selected foreground and background colors. To the
|
||||
right of the window, you'll see four lines of information. The first two
|
||||
lines tell you the numbers and names of the selected foreground and background
|
||||
colors. The third and fourth lines display ANSI escape sequences: The former
|
||||
shows the sequence necessary to create the selected color combination; the
|
||||
latter shows the sequence for the same colors, but with blinking text.
|
||||
|
||||
You can use these ANSI sequences in batch files in two ways. First, you can
|
||||
add them to the PROMPT command, replacing the leading ESC with $E to change
|
||||
your screen colors at the DOS prompt temporarily or permanently.
|
||||
|
||||
For example, let's say you'd like to change your colors to light green text on
|
||||
a blue screen. You load COLORS.BAS and move the cursor to the right color
|
||||
combination. COLORS.BAS tells you that the required escape sequence is
|
||||
ESC[0;32;44;1m. You then type this command at the DOS PROMPT:
|
||||
|
||||
PROMPT $e[0;32;44;1m$p$g
|
||||
|
||||
The $p$g options give you the familiar C:\> prompt. To make the colors
|
||||
permanent, you would include this line in your AUTOEXEC.BAT file.
|
||||
|
||||
Second, you can use the escape sequences with the ECHO command to set the
|
||||
colors for all or part of a batch-file display. When you use the ECHO command,
|
||||
you must replace the letters ESC with the Escape character, which is the ASCII
|
||||
code 27. The editor that you use to write batch files probably has a way to
|
||||
add this special character to the text that it creates. If you use the EDIT
|
||||
program included with DOS 5.0, 6.0, and 6.2, press Ctrl-P and then the ESC key
|
||||
to create the Escape character, which will look like a small left-pointing
|
||||
arrow on your screen.
|
||||
|
||||
For example, imagine that you want to write a small batch file that tells the
|
||||
user what letter he or she should press to load one of three programs. Each
|
||||
line will look something like this:
|
||||
|
||||
Press F to load FoxPro
|
||||
|
||||
To get the user's attention, you want the colors to be black text on a gray
|
||||
background, with the letters in blinking red. You run COLORS.BAS. It tells you
|
||||
that the escape sequence for black on gray is ESC[0;30;47;1m, and the sequence
|
||||
for blinking red on gray is ESC[5;31;47;1m. Your batch file, then, might look
|
||||
like this:
|
||||
|
||||
@ECHO off
|
||||
CLS
|
||||
ECHO ESC[2J
|
||||
ECHO ESC[0;30;47;1mPress ESC[5;31;47;1mF ESC[0;30;47;1mto run FoxProESC[K
|
||||
ECHO ESC[0;30;47;1mPress ESC[5;31;47;1mQ ESC[0;30;47;1mto run QuattroESC[K
|
||||
ECHO ESC[0;30;47;1mPress ESC[5;31;47;1mW ESC[0;30;47;1mto run WordPerfectESC[K
|
||||
ECHO ESC[0;37;40;1m
|
||||
ECHO.
|
||||
ECHO.
|
||||
|
||||
Again, remember to substitute the Escape character wherever you see "ESC" in
|
||||
the batch file listing above.
|
||||
|
||||
No matter how you use the ANSI commands, make sure that you copy the rest of
|
||||
the line exactly, including the square brackets, and note that some characters
|
||||
must be lowercase. Also, remember that the lines won't do anything unless you
|
||||
have ANSI.SYS installed with your CONFIG.SYS file. Assuming that the ANSI.SYS
|
||||
file is in your C:\DOS directory, the following line must be in CONFIG.SYS:
|
||||
|
||||
DEVICE=C:\DOS\ANSI.SYS
|
||||
|
||||
For further details on COLORS.BAS, see "Color Me QBasic" (DRG #12, November
|
||||
1993, page 69).
|
||||
```
|
||||
|
||||
### QBjs
|
||||
|
||||
> Please note that QBjs is still in early development and support for these examples is extremely experimental (meaning will most likely not work). With that out of the way, give it a try!
|
||||
|
||||
* [LOAD "colors.bas"](https://v6p9d9t4.ssl.hwcdn.net/html/5963335/index.html?src=https://qb64.com/samples/colors/src/colors.bas)
|
||||
* [RUN "colors.bas"](https://v6p9d9t4.ssl.hwcdn.net/html/5963335/index.html?mode=auto&src=https://qb64.com/samples/colors/src/colors.bas)
|
||||
* [PLAY "colors.bas"](https://v6p9d9t4.ssl.hwcdn.net/html/5963335/index.html?mode=play&src=https://qb64.com/samples/colors/src/colors.bas)
|
||||
|
||||
### File(s)
|
||||
|
||||
* [colors.bas](src/colors.bas)
|
||||
|
||||
🔗 [color picker](../color-picker.md), [dos world](../dos-world.md)
|
||||
215
samples/colors/src/colors.bas
Normal file
215
samples/colors/src/colors.bas
Normal file
|
|
@ -0,0 +1,215 @@
|
|||
' COLORS.BAS
|
||||
' Copyright (c) 1993 DOS Resource Guide
|
||||
' Published in Issue #12, November 1993, page 69.
|
||||
|
||||
' This program lets you pick foreground
|
||||
' and background text colors by moving
|
||||
' a cursor with the arrow keys.
|
||||
' The program displays the QBasic color numbers,
|
||||
' the color names, and the ANSI codes that
|
||||
' will generate those colors.
|
||||
' You should find this program handy if you are
|
||||
' customizing your DOS prompt, designing a batch
|
||||
' file menu screen, or writing a QBasic program.
|
||||
|
||||
' Written by Hardin Brothers
|
||||
|
||||
' This program requires a color adapter and monitor
|
||||
|
||||
DEFINT A-Z
|
||||
|
||||
DECLARE SUB ReadDATA ()
|
||||
DECLARE SUB SetInfo ()
|
||||
DECLARE SUB SetText ()
|
||||
DECLARE SUB MoveCursor (UserKey%)
|
||||
DECLARE SUB SetCursor ()
|
||||
DECLARE SUB SetScreen ()
|
||||
DECLARE FUNCTION GetAKey% ()
|
||||
DECLARE SUB FlushKBDBuffer ()
|
||||
|
||||
CONST KeyEscape = 27
|
||||
CONST KeyEnter = 13
|
||||
CONST KeyLeft = -75
|
||||
CONST KeyRight = -77
|
||||
CONST KeyUp = -72
|
||||
CONST KeyDown = -80
|
||||
|
||||
DIM SHARED ForeGround, BackGround
|
||||
DIM SHARED ANSI(0 TO 7)
|
||||
DIM SHARED Colors$(0 TO 15)
|
||||
DIM SHARED MaxName
|
||||
|
||||
AnsiOrder:
|
||||
' Colors: Black, Blue, Green, Cyan
|
||||
DATA 0, 4, 2, 6
|
||||
|
||||
' Colors: Red, Magenta, Brown, White
|
||||
DATA 1, 5, 3, 7
|
||||
|
||||
ColorNames:
|
||||
DATA Black, Blue, Green, Cyan, Red, Magenta
|
||||
DATA Brown, White
|
||||
DATA Gray, Light Blue, Light Green, Light Cyan
|
||||
DATA Light Red, Light Magenta, Yellow
|
||||
DATA Bright White
|
||||
|
||||
'Top-level outline
|
||||
|
||||
ReadDATA 'Get data into arrays
|
||||
SetScreen 'Create general display
|
||||
FlushKBDBuffer 'Make sure no keys are waiting
|
||||
ForeGround = 0 'Set beginning colors
|
||||
BackGround = 0
|
||||
|
||||
DO 'Main program loop
|
||||
SetCursor 'Place the cursor & info
|
||||
UserKey = GetAKey 'Wait for keystroke
|
||||
IF UserKey <> KeyEscape THEN 'Process keystroke
|
||||
MoveCursor (UserKey) 'Move cursor unless we quit
|
||||
END IF
|
||||
LOOP UNTIL UserKey = KeyEscape 'Loop until user ESCapes
|
||||
CLS 'Clean up before ending
|
||||
END
|
||||
|
||||
SUB FlushKBDBuffer
|
||||
DO
|
||||
A$ = INKEY$ 'Try to get a key
|
||||
LOOP UNTIL LEN(A$) = 0 'Continue until no more
|
||||
END SUB ' are waiting
|
||||
|
||||
FUNCTION GetAKey
|
||||
DO
|
||||
A$ = INKEY$ 'Loop until key
|
||||
LOOP UNTIL LEN(A$) > 0 ' is ready
|
||||
IF LEN(A$) = 1 THEN 'If it's alphanumeric
|
||||
GetAKey = ASC(A$) ' return its code
|
||||
ELSE 'For special keys
|
||||
GetAKey = -1 * ASC(MID$(A$, 2))
|
||||
END IF ' return -1 * extended code
|
||||
END FUNCTION
|
||||
|
||||
SUB MoveCursor (UserKey)
|
||||
SELECT CASE UserKey 'Base action on key
|
||||
CASE KeyLeft
|
||||
ForeGround = ForeGround - 1
|
||||
IF ForeGround < 0 THEN
|
||||
ForeGround = ForeGround + 16
|
||||
END IF
|
||||
CASE KeyRight
|
||||
ForeGround = ForeGround + 1
|
||||
ForeGround = ForeGround MOD 16
|
||||
CASE KeyUp
|
||||
BackGround = BackGround - 1
|
||||
IF BackGround < 0 THEN
|
||||
BackGround = BackGround + 8
|
||||
END IF
|
||||
CASE KeyDown
|
||||
BackGround = BackGround + 1
|
||||
BackGround = BackGround MOD 8
|
||||
CASE ELSE
|
||||
BEEP 'For all unrecognized
|
||||
END SELECT ' keys -- BEEP error
|
||||
END SUB
|
||||
|
||||
SUB ReadDATA
|
||||
RESTORE AnsiOrder 'Read ANSI's color
|
||||
CLS ' numbers into ANSI
|
||||
FOR i = 0 TO 7 ' arrau
|
||||
READ ANSI(i): PRINT ANSI(i)
|
||||
NEXT i
|
||||
|
||||
RESTORE ColorNames 'Read the color
|
||||
MaxName = 0 'names into an array
|
||||
FOR i = 0 TO 15
|
||||
READ Colors$(i)
|
||||
IF LEN(Colors$(i)) > MaxName THEN
|
||||
MaxName = LEN(Colors$(i)) 'and find longest name
|
||||
END IF
|
||||
NEXT i
|
||||
END SUB
|
||||
|
||||
SUB SetCursor
|
||||
STATIC OldFG, OldBG
|
||||
COLOR 7, 0 'Turn off previous cursor
|
||||
LOCATE OldBG + 5, (OldFG * 5) + 1, 0
|
||||
PRINT " ";
|
||||
LOCATE OldBG + 5, (OldFG * 5) + 5, 0
|
||||
PRINT " ";
|
||||
OldFG = ForeGround 'Turn on new one
|
||||
OldBG = BackGround
|
||||
LOCATE BackGround + 5, (ForeGround * 5) + 1, 0
|
||||
PRINT CHR$(174);
|
||||
LOCATE BackGround + 5, (ForeGround * 5) + 5, 0
|
||||
PRINT CHR$(175);
|
||||
|
||||
SetText 'Display sample text
|
||||
SetInfo ' and color info
|
||||
END SUB
|
||||
|
||||
SUB SetInfo 'Display color info
|
||||
Format$ = "\" + SPACE$(MaxName) + "\"
|
||||
ANSI$ = " ANSI Code = ESC[0;##;##\ \" '1 space
|
||||
Blnk$ = "Blink Code = ESC[0;5;##;##\ \"
|
||||
FG = ForeGround: BG = BackGround
|
||||
|
||||
COLOR 7, 0 'Color numbers and names
|
||||
LOCATE 15, 30
|
||||
PRINT USING "Foreground Color = ## "; FG;
|
||||
PRINT USING Format$; "(" + Colors$(FG) + ")";
|
||||
|
||||
LOCATE 16, 30
|
||||
PRINT USING "Background Color = ## "; BG;
|
||||
PRINT USING Format$; "(" + Colors$(BG) + ")";
|
||||
|
||||
IF FG < 8 THEN 'ANSI sequences
|
||||
Tail$ = "m"
|
||||
ELSE
|
||||
Tail$ = ";1m"
|
||||
END IF
|
||||
|
||||
LOCATE 18, 30
|
||||
PRINT USING ANSI$; 30 + ANSI(FG MOD 8); 40 + ANSI(BG); Tail$
|
||||
LOCATE 19, 30
|
||||
PRINT USING Blnk$; 30 + ANSI(FG MOD 8); 40 + ANSI(BG); Tail$
|
||||
END SUB
|
||||
|
||||
SUB SetScreen 'Create general display
|
||||
Title$ = "Text Colors and ANSI Color Codes"
|
||||
|
||||
WIDTH 80, 25 'Set screen size
|
||||
COLOR 7, 0
|
||||
CLS
|
||||
|
||||
PRINT " "; STRING$(78, 205) 'Print title bar
|
||||
PRINT SPACE$((80 - LEN(Title$)) / 2);
|
||||
PRINT Title$
|
||||
PRINT " "; STRING$(78, 205)
|
||||
|
||||
FOR BG = 0 TO 7 'Display color blockx
|
||||
FOR FG = 0 TO 15
|
||||
LOCATE BG + 5, (FG * 5) + 2, 0
|
||||
COLOR FG, BG
|
||||
PRINT " X ";
|
||||
NEXT FG
|
||||
NEXT BG
|
||||
|
||||
COLOR 7, 0 'Print instructions
|
||||
LOCATE 23, 1
|
||||
PRINT "Use arrow keys to move the cursor"
|
||||
PRINT "Press the Esc key to end the program";
|
||||
END SUB
|
||||
|
||||
SUB SetText 'Display sample text
|
||||
Format$ = "\ \" ' 20 spaces
|
||||
|
||||
COLOR ForeGround, BackGround
|
||||
LOCATE 15, 2
|
||||
PRINT USING Format$; " This is some";
|
||||
LOCATE 16, 2
|
||||
PRINT USING Format$; " sample text";
|
||||
LOCATE 17, 2
|
||||
PRINT USING Format$; " in the selected";
|
||||
LOCATE 18, 2
|
||||
PRINT USING Format$; " colors.";
|
||||
END SUB
|
||||
|
||||
|
|
@ -18,9 +18,9 @@ Created by QB64 community member bplus.
|
|||
|
||||
> Please note that QBjs is still in early development and support for these examples is extremely experimental (meaning will most likely not work). With that out of the way, give it a try!
|
||||
|
||||
* [LOAD "connectcircles.bas"](https://v6p9d9t4.ssl.hwcdn.net/html/5953810/index.html?src=https://qb64.com/samples/connect-circles/src/connectcircles.bas)
|
||||
* [RUN "connectcircles.bas"](https://v6p9d9t4.ssl.hwcdn.net/html/5953810/index.html?mode=auto&src=https://qb64.com/samples/connect-circles/src/connectcircles.bas)
|
||||
* [PLAY "connectcircles.bas"](https://v6p9d9t4.ssl.hwcdn.net/html/5953810/index.html?mode=play&src=https://qb64.com/samples/connect-circles/src/connectcircles.bas)
|
||||
* [LOAD "connectcircles.bas"](https://v6p9d9t4.ssl.hwcdn.net/html/5963335/index.html?src=https://qb64.com/samples/connect-circles/src/connectcircles.bas)
|
||||
* [RUN "connectcircles.bas"](https://v6p9d9t4.ssl.hwcdn.net/html/5963335/index.html?mode=auto&src=https://qb64.com/samples/connect-circles/src/connectcircles.bas)
|
||||
* [PLAY "connectcircles.bas"](https://v6p9d9t4.ssl.hwcdn.net/html/5963335/index.html?mode=play&src=https://qb64.com/samples/connect-circles/src/connectcircles.bas)
|
||||
|
||||
### File(s)
|
||||
|
||||
|
|
|
|||
9
samples/conway.md
Normal file
9
samples/conway.md
Normal file
|
|
@ -0,0 +1,9 @@
|
|||
[Home](https://qb64.com) • [News](../news.md) • [GitHub](../github.md) • [Wiki](../wiki.md) • [Samples](../samples.md) • [Media](../media.md) • [Community](../community.md) • [Rolodex](../rolodex.md) • [More...](../more.md)
|
||||
|
||||
## SAMPLES: CONWAY
|
||||
|
||||
**[Conways Game of Life](conways-game-of-life/index.md)**
|
||||
|
||||
[🐝 Luke](luke.md) 🔗 [automata](automata.md), [conway](conway.md)
|
||||
|
||||
Standard Conway's Game of Life simulation.
|
||||
BIN
samples/conways-game-of-life/img/screenshot.png
Normal file
BIN
samples/conways-game-of-life/img/screenshot.png
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 8 KiB |
29
samples/conways-game-of-life/index.md
Normal file
29
samples/conways-game-of-life/index.md
Normal file
|
|
@ -0,0 +1,29 @@
|
|||
[Home](https://qb64.com) • [News](../../news.md) • [GitHub](../../github.md) • [Wiki](../../wiki.md) • [Samples](../../samples.md) • [Media](../../media.md) • [Community](../../community.md) • [Rolodex](../../rolodex.md) • [More...](../../more.md)
|
||||
|
||||
## SAMPLE: CONWAYS GAME OF LIFE
|
||||
|
||||
|
||||
|
||||
### Author
|
||||
|
||||
[🐝 Luke](../luke.md)
|
||||
|
||||
### Description
|
||||
|
||||
```text
|
||||
Standard Conway's Game of Life simulation.
|
||||
```
|
||||
|
||||
### QBjs
|
||||
|
||||
> Please note that QBjs is still in early development and support for these examples is extremely experimental (meaning will most likely not work). With that out of the way, give it a try!
|
||||
|
||||
* [LOAD "cgol.bas"](https://v6p9d9t4.ssl.hwcdn.net/html/5963335/index.html?src=https://qb64.com/samples/conways-game-of-life/src/cgol.bas)
|
||||
* [RUN "cgol.bas"](https://v6p9d9t4.ssl.hwcdn.net/html/5963335/index.html?mode=auto&src=https://qb64.com/samples/conways-game-of-life/src/cgol.bas)
|
||||
* [PLAY "cgol.bas"](https://v6p9d9t4.ssl.hwcdn.net/html/5963335/index.html?mode=play&src=https://qb64.com/samples/conways-game-of-life/src/cgol.bas)
|
||||
|
||||
### File(s)
|
||||
|
||||
* [cgol.bas](src/cgol.bas)
|
||||
|
||||
🔗 [automata](../automata.md), [conway](../conway.md)
|
||||
124
samples/conways-game-of-life/src/cgol.bas
Normal file
124
samples/conways-game-of-life/src/cgol.bas
Normal file
|
|
@ -0,0 +1,124 @@
|
|||
DefLng A-Z
|
||||
Randomize Timer
|
||||
Screen _NewImage(80, 25, 0)
|
||||
Dim Shared seed(0 To _Width + 1, 0 To _Height + 1) As _Byte
|
||||
Dim Shared board(0 To _Width + 1, 0 To _Height + 1) As _Byte
|
||||
Dim Shared temp(0 To _Width + 1, 0 To _Height + 1) As _Byte
|
||||
|
||||
'Random board layout generator
|
||||
'FOR y = 1 TO _HEIGHT
|
||||
' FOR x = 1 TO _WIDTH
|
||||
' IF RND > 0.6 THEN board(x, y) = 1
|
||||
' NEXT x
|
||||
'NEXT y
|
||||
|
||||
'Manual board layout (comment out this loop to use the above randomizer)
|
||||
Do
|
||||
Do While _MouseInput
|
||||
x = _MouseX
|
||||
y = _MouseY
|
||||
If _MouseButton(1) Then
|
||||
seed(x, y) = 1
|
||||
board(x, y) = 1
|
||||
Locate y, x
|
||||
Print Chr$(219);
|
||||
ElseIf _MouseButton(2) Then
|
||||
seed(x, y) = 1
|
||||
board(x, y) = 0
|
||||
Locate y, x
|
||||
Print " ";
|
||||
End If
|
||||
Loop
|
||||
Select Case InKey$
|
||||
Case Chr$(13): Exit Do
|
||||
Case "l"
|
||||
Input "File to load: ", ifile$
|
||||
If Not _FileExists(ifile$) Then
|
||||
Print "Not found"
|
||||
Else
|
||||
Open ifile$ For Binary As #1
|
||||
Get #1, , h&
|
||||
Get #1, , w&
|
||||
If h& <> _Height Or w& <> _Width Then
|
||||
Print "Incompatible size - file is"; w&; "by"; h&; " but window is"; _Height; "by"; _Width;
|
||||
Else
|
||||
For y = 1 To _Height
|
||||
For x = 1 To _Width
|
||||
Get #1, , seed(x, y)
|
||||
board(x, y) = seed(x, y)
|
||||
Next x
|
||||
Next y
|
||||
Exit Do
|
||||
End If
|
||||
End If
|
||||
End Select
|
||||
Loop
|
||||
|
||||
Do
|
||||
For y = 1 To _Height
|
||||
For x = 1 To _Width
|
||||
neighbours = 0
|
||||
If board(x - 1, y - 1) Then neighbours = neighbours + 1
|
||||
If board(x, y - 1) Then neighbours = neighbours + 1
|
||||
If board(x + 1, y - 1) Then neighbours = neighbours + 1
|
||||
If board(x - 1, y) Then neighbours = neighbours + 1
|
||||
If board(x + 1, y) Then neighbours = neighbours + 1
|
||||
If board(x - 1, y + 1) Then neighbours = neighbours + 1
|
||||
If board(x, y + 1) Then neighbours = neighbours + 1
|
||||
If board(x + 1, y + 1) Then neighbours = neighbours + 1
|
||||
If neighbours = 3 Then temp(x, y) = 1
|
||||
If neighbours = 2 And board(x, y) Then temp(x, y) = 1
|
||||
If neighbours > 3 Or neighbours < 2 Then temp(x, y) = 0
|
||||
Next x
|
||||
Next y
|
||||
redraw
|
||||
_Limit 10
|
||||
If InKey$ = Chr$(27) Then
|
||||
Locate 1, 1
|
||||
Input "Save original pattern (y/n)? ", c$
|
||||
If c$ = "Y" Or c$ = "y" Then Input "File name: ", ofile$
|
||||
Input "Save current state (y/n)? ", c$
|
||||
If c$ = "Y" Or c$ = "y" Then Input "File name: ", cfile$
|
||||
Exit Do
|
||||
End If
|
||||
Loop
|
||||
|
||||
If ofile$ <> "" Then
|
||||
Open ofile$ For Binary As #1
|
||||
h& = _Height
|
||||
w& = _Width
|
||||
Put #1, , h&
|
||||
Put #1, , w&
|
||||
For y = 1 To _Height
|
||||
For x = 1 To _Width
|
||||
Put #1, , seed(x, y)
|
||||
Next x
|
||||
Next y
|
||||
Close #1
|
||||
End If
|
||||
|
||||
If cfile$ <> "" Then
|
||||
Open cfile$ For Binary As #1
|
||||
h& = _Height
|
||||
w& = _Width
|
||||
Put #1, , h&
|
||||
Put #1, , w&
|
||||
For y = 1 To _Height
|
||||
For x = 1 To _Width
|
||||
Put #1, , board(x, y)
|
||||
Next x
|
||||
Next y
|
||||
Close #1
|
||||
End If
|
||||
|
||||
Sub redraw
|
||||
Cls
|
||||
For y = 1 To _Height
|
||||
For x = 1 To _Width
|
||||
board(x, y) = temp(x, y)
|
||||
If board(x, y) Then Locate y, x: Print Chr$(219);
|
||||
Next x
|
||||
Next y
|
||||
_Display
|
||||
End Sub
|
||||
|
||||
9
samples/counter.md
Normal file
9
samples/counter.md
Normal file
|
|
@ -0,0 +1,9 @@
|
|||
[Home](https://qb64.com) • [News](../news.md) • [GitHub](../github.md) • [Wiki](../wiki.md) • [Samples](../samples.md) • [Media](../media.md) • [Community](../community.md) • [Rolodex](../rolodex.md) • [More...](../more.md)
|
||||
|
||||
## SAMPLES: COUNTER
|
||||
|
||||
**[Binary Counter](binary-counter/index.md)**
|
||||
|
||||
[🐝 rpgfan3233](rpgfan3233.md) 🔗 [binary](binary.md), [counter](counter.md)
|
||||
|
||||
' This program is a 12-bit Binary counter, displayed using a 3x4 grid. ' It was created in the ho...
|
||||
BIN
samples/cram/img/screenshot.png
Normal file
BIN
samples/cram/img/screenshot.png
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 6 KiB |
72
samples/cram/index.md
Normal file
72
samples/cram/index.md
Normal file
|
|
@ -0,0 +1,72 @@
|
|||
[Home](https://qb64.com) • [News](../../news.md) • [GitHub](../../github.md) • [Wiki](../../wiki.md) • [Samples](../../samples.md) • [Media](../../media.md) • [Community](../../community.md) • [Rolodex](../../rolodex.md) • [More...](../../more.md)
|
||||
|
||||
## SAMPLE: CRAM
|
||||
|
||||
|
||||
|
||||
### Author
|
||||
|
||||
[🐝 Hardin Brothers](../hardin-brothers.md)
|
||||
|
||||
### Description
|
||||
|
||||
```text
|
||||
'CRAM!
|
||||
' by Hardin Brothers
|
||||
'
|
||||
' Copyright (C) 1993 DOS Resource Guide
|
||||
' Published in Issue #9, May 1993, page 57
|
||||
'
|
||||
'This program may be run in DOS 5.0's QBasic or
|
||||
'compiled with QuickBasic 4.0 or later, or with
|
||||
'Visual Basic for DOS.
|
||||
'
|
||||
|
||||
==============================================================================
|
||||
|
||||
----------
|
||||
CRAM.BAS
|
||||
----------
|
||||
SYSTEM REQUIREMENTS:
|
||||
The version of QBasic that comes with DOS 5 or later, Quick Basic 4.x, or
|
||||
Microsoft Visual Basic for DOS.
|
||||
|
||||
WHAT CRAM.BAS DOES:
|
||||
This simple but addictive game challenges you to maneuver an ever-growing worm
|
||||
inside an ever-shrinking box. Increasing the difficulty level speeds the rate
|
||||
at which the worm grows.
|
||||
|
||||
USING CRAM.BAS:
|
||||
To load the program in QBasic, type QBASIC CRAM.BAS (using path names if
|
||||
necessary) at the DOS prompt. Then run the program by selecting the Start
|
||||
option in QBasic's Run menu, or press Shift-F5.
|
||||
|
||||
The opening screen displays the game's simple instructions and asks you choose
|
||||
a difficulty level. If you need to warm up your reflexes, start with the easy
|
||||
level, level 3, and then work your way up to level 2 and level 1. After you
|
||||
choose a playing level, the game starts right in. The object is to press any
|
||||
key to make your worm change direction just before hitting a wall. The more
|
||||
turns you can make, the higher you will score. Play ends when your worm hits a
|
||||
wall.
|
||||
|
||||
As written, Cram displays your score (the number of turns you make) at the end
|
||||
of each game and automatically starts another game. Pressing Esc at any time
|
||||
brings up a "Press any key to continue" message. Press Esc again to exit the
|
||||
program and return to the QBasic screen.
|
||||
|
||||
For further details on CRAM.BAS, see "Cram!" (DRG #9, May 1993, page 57).
|
||||
```
|
||||
|
||||
### QBjs
|
||||
|
||||
> Please note that QBjs is still in early development and support for these examples is extremely experimental (meaning will most likely not work). With that out of the way, give it a try!
|
||||
|
||||
* [LOAD "cram.bas"](https://v6p9d9t4.ssl.hwcdn.net/html/5963335/index.html?src=https://qb64.com/samples/cram/src/cram.bas)
|
||||
* [RUN "cram.bas"](https://v6p9d9t4.ssl.hwcdn.net/html/5963335/index.html?mode=auto&src=https://qb64.com/samples/cram/src/cram.bas)
|
||||
* [PLAY "cram.bas"](https://v6p9d9t4.ssl.hwcdn.net/html/5963335/index.html?mode=play&src=https://qb64.com/samples/cram/src/cram.bas)
|
||||
|
||||
### File(s)
|
||||
|
||||
* [cram.bas](src/cram.bas)
|
||||
|
||||
🔗 [game](../game.md), [dos world](../dos-world.md)
|
||||
204
samples/cram/src/cram.bas
Normal file
204
samples/cram/src/cram.bas
Normal file
|
|
@ -0,0 +1,204 @@
|
|||
'CRAM!
|
||||
' by Hardin Brothers
|
||||
'
|
||||
' Copyright (C) 1993 DOS Resource Guide
|
||||
' Published in Issue #9, May 1993, page 57
|
||||
'
|
||||
'This program may be run in DOS 5.0's QBasic or
|
||||
'compiled with QuickBasic 4.0 or later, or with
|
||||
'Visual Basic for DOS.
|
||||
'
|
||||
DEFINT A-Z
|
||||
DECLARE SUB Pause ()
|
||||
DECLARE SUB NextColor ()
|
||||
DECLARE SUB Score ()
|
||||
DECLARE SUB Setup ()
|
||||
DECLARE SUB Hello ()
|
||||
DECLARE SUB GoRight ()
|
||||
DECLARE SUB GoDown ()
|
||||
DECLARE SUB GoLeft ()
|
||||
DECLARE SUB GoUp ()
|
||||
CONST FALSE = 0
|
||||
CONST TRUE = NOT FALSE
|
||||
CONST ESC = 27
|
||||
CONST Duration = 3
|
||||
DIM SHARED TopLimit, LeftLimit, RightLimit, BottomLimit
|
||||
DIM SHARED Crash, Done, Turns
|
||||
DIM SHARED DrawChar$, Difficulty, CurColor, Note(4)
|
||||
DrawChar$ = CHR$(219): CurColor = 1
|
||||
Note(1) = 800: Note(2) = 600: Note(3) = 400: Note(4) = 500
|
||||
Hello
|
||||
Done = FALSE
|
||||
DO
|
||||
Setup
|
||||
IF NOT Done THEN
|
||||
Crash = FALSE
|
||||
DO
|
||||
IF NOT Crash AND NOT Done THEN GoRight
|
||||
IF NOT Crash AND NOT Done THEN GoDown
|
||||
IF NOT Crash AND NOT Done THEN GoLeft
|
||||
IF NOT Crash AND NOT Done THEN GoUp
|
||||
LOOP UNTIL Crash OR Done
|
||||
END IF
|
||||
IF NOT Done THEN Score
|
||||
LOOP UNTIL Done
|
||||
CLS
|
||||
END
|
||||
SUB GoDown
|
||||
col = RightLimit
|
||||
row = TopLimit
|
||||
WHILE INKEY$ <> "": WEND
|
||||
DO
|
||||
LOCATE row, col
|
||||
PRINT DrawChar$;
|
||||
Pause
|
||||
row = row + 1
|
||||
IF row = BottomLimit THEN Crash = TRUE
|
||||
k$ = INKEY$
|
||||
LOOP WHILE LEN(k$) = 0 AND Crash = FALSE
|
||||
IF LEN(k$) THEN Done = (ASC(k$) = ESC)
|
||||
SOUND Note(2), Duration
|
||||
BottomLimit = row
|
||||
Turns = Turns + 1
|
||||
NextColor
|
||||
END SUB
|
||||
SUB GoLeft
|
||||
col = RightLimit
|
||||
row = BottomLimit
|
||||
WHILE INKEY$ <> "": WEND
|
||||
DO
|
||||
LOCATE row, col
|
||||
PRINT DrawChar$;
|
||||
Pause
|
||||
col = col - 1
|
||||
IF col = LeftLimit THEN Crash = TRUE
|
||||
k$ = INKEY$
|
||||
LOOP WHILE LEN(k$) = 0 AND Crash = FALSE
|
||||
IF LEN(k$) THEN Done = (ASC(k$) = ESC)
|
||||
SOUND Note(3), Duration
|
||||
LeftLimit = col
|
||||
Turns = Turns + 1
|
||||
NextColor
|
||||
END SUB
|
||||
SUB GoRight
|
||||
col = LeftLimit
|
||||
row = TopLimit
|
||||
WHILE INKEY$ <> "": WEND
|
||||
DO
|
||||
LOCATE row, col
|
||||
PRINT DrawChar$;
|
||||
Pause
|
||||
col = col + 1
|
||||
IF col = RightLimit THEN Crash = TRUE
|
||||
k$ = INKEY$
|
||||
LOOP WHILE LEN(k$) = 0 AND Crash = FALSE
|
||||
IF LEN(k$) THEN Done = (ASC(k$) = ESC)
|
||||
SOUND Note(1), Duration
|
||||
RightLimit = col
|
||||
Turns = Turns + 1
|
||||
NextColor
|
||||
END SUB
|
||||
SUB GoUp
|
||||
col = LeftLimit
|
||||
row = BottomLimit
|
||||
WHILE INKEY$ <> "": WEND
|
||||
DO
|
||||
LOCATE row, col
|
||||
PRINT DrawChar$;
|
||||
Pause
|
||||
row = row - 1
|
||||
IF row = TopLimit THEN Crash = TRUE
|
||||
k$ = INKEY$
|
||||
LOOP WHILE LEN(k$) = 0 AND Crash = FALSE
|
||||
IF LEN(k$) THEN Done = (ASC(k$) = ESC)
|
||||
SOUND Note(4), Duration
|
||||
TopLimit = row
|
||||
Turns = Turns + 1
|
||||
NextColor
|
||||
END SUB
|
||||
SUB Hello
|
||||
CLS
|
||||
PRINT , , "Welcome to Cram"
|
||||
PRINT
|
||||
PRINT " To play. simply press a key when the line gets too close"
|
||||
PRINT "to a wall. The more turns you can make, the higher you will"
|
||||
PRINT "score. Press <ESC> at any time to end the game."
|
||||
PRINT
|
||||
PRINT , , "Good Luck!"
|
||||
PRINT : PRINT
|
||||
DO
|
||||
INPUT "Difficulty 1 (hard) to 3 (easy) ==> "; Difficulty
|
||||
LOOP UNTIL Difficulty >= 1 AND Difficulty <= 3
|
||||
END SUB
|
||||
SUB NextColor
|
||||
CurColor = CurColor + 1
|
||||
IF CurColor = 8 THEN CurColor = 9
|
||||
IF CurColor > 15 THEN CurColor = 1
|
||||
COLOR CurColor
|
||||
END SUB
|
||||
SUB Pause
|
||||
FOR j = 1 TO Difficulty
|
||||
T! = TIMER
|
||||
WHILE T! = TIMER: WEND
|
||||
NEXT j
|
||||
END SUB
|
||||
SUB Score
|
||||
Turns = Turns - 1
|
||||
COLOR 7
|
||||
LOCATE 12, 30
|
||||
IF Turns = 1 THEN
|
||||
LastWord$ = "turn!"
|
||||
ELSE
|
||||
LastWord$ = "turns!"
|
||||
END IF
|
||||
PRINT "You made"; Turns; LastWord$
|
||||
FOR i = 1 TO 4
|
||||
FOR j = 1 TO 4
|
||||
SOUND Note(j), Duration
|
||||
NEXT j
|
||||
NEXT i
|
||||
FOR i = 1 TO 10
|
||||
Pause
|
||||
NEXT i
|
||||
END SUB
|
||||
SUB Setup
|
||||
Crash = FALSE
|
||||
Done = FALSE
|
||||
Turns = 0
|
||||
CLS
|
||||
NextColor
|
||||
FOR x = 1 TO 80
|
||||
LOCATE 1, x
|
||||
PRINT DrawChar$;
|
||||
NEXT x
|
||||
SOUND Note(1), Duration
|
||||
NextColor
|
||||
|
||||
FOR y = 1 TO 25
|
||||
LOCATE y, 80
|
||||
PRINT DrawChar$;
|
||||
NEXT y
|
||||
SOUND Note(2), Duration
|
||||
NextColor
|
||||
|
||||
FOR x = 79 TO 1 STEP -1
|
||||
LOCATE 25, x
|
||||
PRINT DrawChar$;
|
||||
NEXT x
|
||||
SOUND Note(3), Duration
|
||||
NextColor
|
||||
|
||||
FOR y = 24 TO 3 STEP -1
|
||||
LOCATE y, 1
|
||||
PRINT DrawChar$;
|
||||
NEXT y
|
||||
SOUND Note(4), Duration
|
||||
NextColor
|
||||
|
||||
TopLimit = 3: RightLimit = 80
|
||||
BottomLimit = 25: LeftLimit = 1
|
||||
|
||||
k$ = INKEY$
|
||||
IF LEN(k$) THEN Done = (ASC(k$) = ESC)
|
||||
END SUB
|
||||
|
||||
BIN
samples/curve-smoother/img/screenshot.png
Normal file
BIN
samples/curve-smoother/img/screenshot.png
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 31 KiB |
Some files were not shown because too many files have changed in this diff Show more
Loading…
Reference in a new issue