Microsoft's legendary NIBBLES.BAS translated to Euphoria 3

by shian ⌂, Saturday, September 05, 2020, 13:56 (24 days ago)
edited by shian, Monday, September 07, 2020, 19:31

[image]One of the first programs I've seen on a PC was NIBBLES.BAS. It was a 286 machine with MS-DOS, QBASIC and B&W monitor. I don't like games but I was very curious about this one.

[image]Yesterday I translated the game to Euphoria 3 (hopefully without bugs...). Now it works on DOS/DOSBox with all features, including sound, and it works on Windows-10 command-line and Linux terminal (using UTF8 encoding).

[image]This translation demonstrates also how to write a simple program that works well on DOS/Windows/Linux/FreeBSD using UTF-8 encoding or the standard IBM code page cp437 (US).

Try running it, see if there is a bug. Why not. You can download NIBBLES.EX from here (Version 1.01) - Now with NIBBLES.BAS attached.


Here is the first part of the program (you will need also Lib2 1.41 to run NIBBLES.EX):

 
 
--
--
--                         Q B a s i c   N i b b l e s
--
--                   Copyright (C) Microsoft Corporation 1990
--
-- Nibbles is a game for one or two players.  Navigate your snakes
-- around the game board trying to eat up numbers while avoiding
-- running into walls or other snakes.  The more numbers you eat up,
-- the more points you gain and the longer your snake becomes.
--
-- To run this game, press Shift+F5.
--
-- To exit QBasic, press Alt, F, X.
--
-- To get help on a BASIC keyword, move the cursor to the keyword and press
-- F1 or click the right mouse button.
--
 
 
 
-----------------------------------------------------------------------------
-- FILE:       NIBBLES.EX
-- PURPOSE:    Nibbles(C) game created by Microsoft Corporation for MS-QBASIC.
--             - I've *translated* the game from QBASIC to Euphoria 3.
--               It demonstrates translation of BASIC programs to Euphoria 3.
--             - Lib2 version 1.41 must be installed (www.RapidEuphoria311.com).
--             - Nibbles.ex runs on DOS/Windows/Linux/FreeBSD terminals:
--               * DOS/Windows should use the default code page cp437 (US).
--               * Linux/FreeBSD should use the default UTF-8 encoding.
--             - On Linux/FreeBSD you may redefine the "User defined keys".
--             - Sound, by J. Craig Gilbert, works only on DOS/DOSBox/emulator.
--             - Please report any bug in www.RapidEuphoria311.com/.
--             - Copyright issue? Please let me know at www.RapidEuphoria311.com.
-- AUTHOR:     Microsoft Corporation
-- COPYRIGHT:  (C) Microsoft Corporation 1990
-- TRANSLATOR: Shian Lee (https://www.RapidEuphoria311.com)
-- VERSION:    1.00  Saturday, September/5/2020
-- LANGUAGE:   Euphoria version 3.1.1 (http://www.RapidEuphoria.com)
-- PLATFORM:   DOS32/WIN32/LINUX/FreeBSD
-- LICENCE:    (C) Microsoft Corporation 1990. Use at your own risk.
-- NOTE:       * See the attached *original* MS-QBASIC program NIBBLES.BAS.
--             * Translated using QE 2.3.9 on FreeDOS 1.2 & edu 2.33 on Linux;
--               (Download from www.RapidEuphoria311.com).
--             * Few notes on translating from BASIC to Euphoria 3:
--               - BASIC *default* method is 'Pass By Reference'(!)
--                 Euphoria 3 *always* using 'Pass By Value' to pass arguments.
--               - BASIC *default* lower bound for arrays is 0(!)
--                 Euphoria 3 sequence lower bound is *always* 1.
--               - Similar commands can be tricky; e.g. MOD vs. remainder():
--                  BASIC's 'MOD' *rounds* the arguments - remainder() not.
--               - BASIC's 'TRUE' is -1. Euphoria 3 'TRUE' is 1.
--               - BASIC's 'AND/OR/NOT/XOR' are bitwise operators, not logical.
--               - BASIC's 'TYPE' is simply an extra dimension of an array.
-- HISTORY:    v1.00 - initial version (September/5/2020).
-----------------------------------------------------------------------------
 
 
 
--bookmark: Includes;
 
-- Include Euphoria 3 files
include misc.e
include graphics.e
include wildcard.e
include machine.e
include file.e
 
-- Include Lib2 1.41 files
include machine2.e
include string.e
include math.e
include utf8.e
 
-- PC Speaker routines by J. Craig Gilbert.
-- Download the full 'pcspeak.zip', from  www.RapidEuphoria.com archive.
-- qplay() is the equivalent to MS-QBASIC's 'PLAY' command.
-- Note: qplay() does not support background music, "MB". (It may be supported
--       using Euphoria's Tasks...). Therefore in two cases I've made the
--       original QBASIC music much shorter, also by calling tsound().
include pcspeak.e
 
 
 
--bookmark: Debug Commands;
 
-- with trace   -- Temporary for debug
 
with type_check
 
 
 
--bookmark: User defined Keys/Chars/Draw (for DOS/Linux);
 
-- these can be integer or sequence (in UTF-8 mode)
object ARROW_LEFT, ARROW_RIGHT, ARROW_UP, ARROW_DOWN
object ARROW_LEFT_CHR, ARROW_RIGHT_CHR, ARROW_UP_CHR, ARROW_DOWN_CHR
object BOX_VERTICAL, BOX_TOP, BOX_BOTTOM
 
-- ***********************************************************************
 
-- Play Music on DOS?  FALSE = music-Off;  TRUE = music-On.
constant WITH_MUSIC = TRUE
 
if platform() = DOS32 or platform() = WIN32 then
    -- * Using Code Page US CP437 *
 
    -- Arrow keys
         ARROW_LEFT = 331
        ARROW_RIGHT = 333
           ARROW_UP = 328
         ARROW_DOWN = 336
 
    -- Arrow (control) characters
     ARROW_LEFT_CHR = 27
    ARROW_RIGHT_CHR = 26
       ARROW_UP_CHR = 24
     ARROW_DOWN_CHR = 25
 
    -- Box drawing characters (Extended ASCII table)
       BOX_VERTICAL = 219 -- 219 'Û'
            BOX_TOP = 223 -- 223 'ß'
         BOX_BOTTOM = 220 -- 220 'Ü'
 
elsif platform() = LINUX then -- also FreeBSD
    -- * Using UTF-8 encoding *
 
    -- Arrow keys (test with 'euphoria/bin/xkey.ex' from Lib2 1.41);
    -- You *may* need to modify arrow keys for your terminal.
         ARROW_LEFT = {27,91,68}
        ARROW_RIGHT = {27,91,67}
           ARROW_UP = {27,91,65}
         ARROW_DOWN = {27,91,66}
 
    -- Arrow characters (Unicode)
     ARROW_LEFT_CHR = utf8(#2190)
    ARROW_RIGHT_CHR = utf8(#2192)
       ARROW_UP_CHR = utf8(#2191)
     ARROW_DOWN_CHR = utf8(#2193)
 
    -- Box drawing characters (Unicode)
       BOX_VERTICAL = utf8(#2588)
            BOX_TOP = utf8(#2580)
         BOX_BOTTOM = utf8(#2584)
 
end if
-- ***********************************************************************
 
 
 
--bookmark: TYPE snakeBody;
-- User-defined TYPEs
-- TYPE snakeBody
--     row AS INTEGER
--     col AS INTEGER
-- END TYPE
 
constant SNAKE_BODY = 2 -- upper bound index
constant B_ROW = 1,
         B_COL = 2
 
 
 
--bookmark: TYPE snaketype;
-- This type defines the player's snake
-- TYPE snaketype
--     head      AS INTEGER
--     length    AS INTEGER
--     row       AS INTEGER
--     col       AS INTEGER
--     direction AS INTEGER
--     lives     AS INTEGER
--     score     AS INTEGER
--     scolor    AS INTEGER
--     alive     AS INTEGER
-- END TYPE
 
constant SNAKE_TYPE = 9 -- upper bound index
constant S_HEAD = 1,
          S_LEN = 2,
          S_ROW = 3,
          S_COL = 4,
          S_DIR = 5,
        S_LIVES = 6,
        S_SCORE = 7,
       S_SCOLOR = 8,
        S_ALIVE = 9
 
 
 
--bookmark: TYPE arenaType;
-- This type is used to represent the playing screen in memory
-- It is used to simulate graphics in text mode, and has some interesting,
-- and slightly advanced methods to increasing the speed of operation.
-- Instead of the normal 80x25 text graphics using chr$(219) "Û", we will be
-- using chr$(220)"Ü" and chr$(223) "ß" and chr$(219) "Û" to mimic an 80x50
-- pixel screen.
-- Check out sub-programs SET and POINTISTHERE to see how this is implemented
-- feel free to copy these (as well as arenaType and the DIM ARENA stmt and the
-- initialization code in the DrawScreen subprogram) and use them in your own
-- programs
-- TYPE arenaType
--     realRow     AS INTEGER    -- Maps the 80x50 point into the real 80x25
--     acolor      AS INTEGER    -- Stores the current color of the point
--     sister      AS INTEGER    -- Each char has 2 points in it.  .SISTER is
-- END TYPE                      -- -1 if sister point is above, +1 if below
 
constant ARENA_TYPE = 3 -- upper bound index
constant A_REALROW = 1,
          A_ACOLOR = 2,
          A_SISTER = 3
 
 
 
--bookmark: Local Constants;
constant MAX_SNAKE_LEN = 1000
 
constant BLANK = 32,    -- Space key, ' '
         ESC = 27       -- Escape key
 
constant PUSH_SPACE_BAR = "     Level %d,  Push Space"
 
-- Parameters to Level() procedure
constant STARTOVER = 1,
         SAMELEVEL = 2,
         NEXTLEVEL = 3
 
-- colorTable sequence; Using constants to support DOS/Linux.
constant
 --                                            Back-     Dialogs colors:
 -- {snake1,       snake2,         Walls,      ground, Fore,         Back}
 MONO_SCREEN =
    {BRIGHT_WHITE, WHITE,          WHITE,      BLACK,  BRIGHT_WHITE, BLACK},
COLOR_SCREEN =
    {YELLOW,       BRIGHT_MAGENTA, BRIGHT_RED, BLUE,   BRIGHT_WHITE, RED}
 
-- colorTable indexes
constant C_SNAKE1 = 1,
         C_SNAKE2 = 2,
          C_WALLS = 3,
     C_BACKGROUND = 4,
       C_DLG_FORE = 5,
       C_DLG_BACK = 6
 
 
 
-- DIM array and 'TYPE' - Very useful for translating BASIC to Euphoria 3.
-- Initializing all elements to number 0, like BASIC, (no need strings, "").
-- Euphoria 3 sequence's lower bound is *always* 1. BASIC's *default* is 0!
--  BASIC e.g.: DIM sammy(1 to 2) AS snaketype
--  Euphoria 3: sammy = dim_array({2, SNAKE_TYPE})
--  Euphoria 3: sammy = repeat(repeat(0, SNAKE_TYPE), 2)
--  Euphoria 3: sammy = { {0,0,0,0,0,0,0,0,0}, {0,0,0,0,0,0,0,0,0} }
function dim_array(sequence up_bounds)
    sequence array
 
    -- in BASIC numeric arrays are initialized with 0 (string with "")
    array = repeat(0, up_bounds[$])
 
    for i = length(up_bounds) - 1 to 1 by -1 do
        array = repeat(array, up_bounds[i])
    end for
 
    return array
end function
 
 
 
--bookmark: Local Variables;
 
-- DIM SHARED arena(1 TO 50, 1 TO 80) AS arenaType
-- DIM SHARED curLevel, colorTable(10)
 
sequence arena
arena = dim_array({50, 80, ARENA_TYPE})
 
integer curLevel
sequence colorTable
 
 
 
--bookmark: Local Routines;
 
-- Set both front and background colors
procedure SetColors(integer fore, integer back)
    text_color(fore)
    bk_color(back)
end procedure
 
 
 
-- hide the cursor (DOS/LINUX)
procedure hide_cursor()
    if platform() = LINUX then
        if system_exec("tput civis", 2) then              -- compatible (terminfo)
            if system_exec("setterm -cursor off", 2) then -- compatible
                puts(1, ESC & "[?25l" & ESC & "[?1c")     -- fast, less compatible
            end if
        end if
    else -- WIN32, DOS32
        cursor(NO_CURSOR)
    end if
end procedure
 
 
 
-- show the cursor (DOS/LINUX)
procedure show_cursor()
    if platform() = LINUX then
        if system_exec("tput cnorm", 2) then             -- compatible (terminfo)
            if system_exec("setterm -cursor on", 2) then -- compatible
                puts(1, ESC & "[?25h" & ESC & "[?0c")    -- fast, less compatible
            end if
        end if
    else -- WIN32, DOS32
        cursor(THICK_UNDERLINE_CURSOR)
    end if
end procedure
 
 
 
-- in case of crash (bug), or if user pressed control-C, or other reason,
-- restore screen and cursor
function nibbles_crash(object msg)
    SetColors(BRIGHT_WHITE, BLACK)
    clear_screen()
    show_cursor()
 
    if string(msg) then -- in case of a real bug - there is no message
        puts(1, "\n " & msg)
    end if
 
    puts(1, "\n Nibbles crashed!\n Please report any bug in -\n" &
            " https://www.RapidEuphoria311.com/\n" &
            " See \"ex.err\" in '" & current_dir() & "' for more details.\n" &
            " Thank you!\n")
 
    SetColors(WHITE, BLACK)
    pause()
 
    return 0
end function
 
-- in case of a real bug call the crash routine
crash_routine(routine_id("nibbles_crash"))
 
 
 
-- Main input routine, returns an object: integer or UTF-8 sequence.
function GetKey()
    if check_break() then
        if nibbles_crash("User pressed control-C.") then
        end if
        abort(1)
    end if
 
    return get_xkey()   -- get_xkey(), machine2.e, Lib2 1.41
end function
 
 
 
-- Centers text on given row (supports also UTF-8 strings)
procedure Center(integer row, string text)
    position(row, 41 - length(group_utf8(text)) / 2)
    puts(1, text)
end procedure
 
 
-- ... Program continuing...
 

Tags:
QBASIC, BASIC, NIBBLE

RSS Feed of thread
powered by my little forum