eaw/tranZPUter
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

Removed files which shouldnt be on github

Browse Source
This commit is contained in:
Philip Smart
2021-03-03 15:58:54 +00:00
parent b8a7b2823b
commit 3e1a687429
3083 changed files with 117691 additions and 379755 deletions
Download Patch File Download Diff File Expand all files Collapse all files

86
.gitignore vendored
View File

@@ -235,4 +235,90 @@ FPGA/SW700/v1.3/VideoController/VideoController_constraints.sdc.orig
SD/
devices/sysbus/BRAM/TZSW_DualPort32-64BootBRAM.vhd
devices/sysbus/BRAM/TZSW_DualPort3264BootBRAM.vhd
software/NASCAS
software/CAS
software/MZF
software/BAS
software/CPM/CPM00_MZ800
software/CPM/CPM00_SYSTEM
software/CPM/CPM01_TURBOP
software/CPM/CPM02_HI_C
software/CPM/CPM03_FORTRAN80
software/CPM/CPM04_MBASIC
software/CPM/CPM05_COBOL80_v13
software/CPM/CPM06_COBOL80_v20
software/CPM/CPM07_COBOL80
software/CPM/CPM08_Z80FORTH
software/CPM/CPM09_CPMTEX
software/CPM/CPM10_DISKUTILFUNC5
software/CPM/CPM11_MAC80
software/CPM/CPM12_PASCALMTP_v561
software/CPM/CPM13_MTPUG_01
software/CPM/CPM14_MTPUG_02
software/CPM/CPM15_MTPUG_03
software/CPM/CPM16_MTPUG_04
software/CPM/CPM17_MTPUG_05
software/CPM/CPM18_MTPUG_06
software/CPM/CPM19_MTPUG_07
software/CPM/CPM20_MTPUG_08
software/CPM/CPM21_MTPUG_09
software/CPM/CPM22_MTPUG_10
software/CPM/CPM23_PLI
software/CPM/CPM24_PLI80_v13
software/CPM/CPM25_PLI80_v14
software/CPM/CPM26_TPASCAL_v300a
software/CPM/CPM27_WORDSTAR_v30
software/CPM/CPM28_PLM80
software/CPM/CPM29_ZSID_v14
software/CPM/CPM30_WORDSTAR_v400
software/CPM/CPM31_WORDSTAR_v330
software/CPM/CPM32_ZCPR3
software/CPM/CPM33_ZCPR3_COMMON
software/CPM/CPM_MC_5
software/CPM/CPM_MC_C0
software/CPM/CPM_MC_C1
software/CPM/CPM_MC_C2
software/CPM/CPM_MC_C3
software/CPM/CPM_MC_C4
software/CPM/CPM_MC_C5
software/CPM/CPM_MC_C6
software/CPM/CPM_MC_C7
software/CPM/CPM_MC_C8
software/CPM/CPM_MC_C9
software/CPM/CPM_MC_D0
software/CPM/CPM_MC_D1
software/CPM/CPM_MC_D2
software/CPM/CPM_MC_D3
software/CPM/CPM_MC_D4
software/CPM/CPM_MC_D5
software/CPM/CPM_MC_D6
software/CPM/CPM_MC_D7
software/CPM/CPM_MC_D8
software/CPM/CPM_MC_D9
software/CPM/CPM_MC_E0
software/CPM/CPM_MC_E1
software/CPM/CPM_MC_E2
software/CPM/CPM_MC_E3
software/CPM/CPM_MC_E4
software/CPM/CPM_MC_E5
software/CPM/CPM_MC_E6
software/CPM/CPM_MC_E7
software/CPM/CPM_MC_E8
software/CPM/CPM_MC_E9
software/CPM/CPM_MC_F0
software/CPM/CPM_MC_F1
software/CPM/CPM_MC_F2
software/CPM/CPM_MC_F3
software/CPM/CPM_MC_F4
software/CPM/CPM_MC_F5
software/CPM/CPM_MC_F6
software/CPM/CPM_MC_F7
software/CPM/CPM_MC_F8
software/CPM/CPM_MC_F9
software/CPM/CPM_RFS_1
software/CPM/CPM_RFS_2
software/CPM/PLM80
FPGA/SW700/v1.3/coreMZ.vhd.bak
FPGA/SW700/v1.3/softZPU/softZPU.vhd.bak
schematics/sep/

3
FPGA/SW700/v1.3/VideoController.qip
View File

@@ -1,6 +1,9 @@
set_global_assignment -name IP_TOOL_NAME "Sharp MZ Video Controller"
set_global_assignment -name IP_TOOL_VERSION "17.1"
set_global_assignment -name IP_GENERATED_DEVICE_FAMILY "{Cyclone IV E}"
set_global_assignment -name VHDL_FILE [file join $::quartus(qip_path) VideoController/VideoRAM_DP_3216.vhd]
set_global_assignment -name VHDL_FILE [file join $::quartus(qip_path) VideoController/VideoRAM_DP_3208.vhd]
set_global_assignment -name VHDL_FILE [file join $::quartus(qip_path) VideoController/ChrGenRAM_DP_3208.vhd]
set_global_assignment -name VHDL_FILE [file join $::quartus(qip_path) VideoController/VideoController.vhd]
set_global_assignment -name VHDL_FILE [file join $::quartus(qip_path) VideoController/VideoController_pkg.vhd]
set_global_assignment -name SDC_FILE [file join $::quartus(qip_path) VideoController/VideoController_constraints.sdc]

4384
FPGA/SW700/v1.3/VideoController/ChrGenRAM_DP_3208.vhd Normal file
View File

File diff suppressed because it is too large Load Diff

292
FPGA/SW700/v1.3/VideoController/ChrGenRAM_DP_3208.vhd.tmpl Normal file
View File

@@ -0,0 +1,292 @@
---------------------------------------------------------------------------------------------------------
--
-- Name: ChrGenRAM_DP_3208.vhd
-- Created: Jan 2021
-- Author(s): Philip Smart
-- Description: Character Generator ROM/RAM for the Sharp MZ series Video Controller Core.
--
-- This module provides a dual port inferred RAM definition (for use as ROM/RAM) for use
-- as Character Generator ROM/RAM in the Video Controller. Port A allows 8/16/32 bit access,
-- Port B allows for 8 bit access. The size of the RAM is declared in the generic attribute
-- 'addrbits'.
--
-- Credits:
-- Copyright: (c) 2018-21 Philip Smart <philip.smart@net2net.org>
--
-- History: Jan 2021 - Initial creation.
--
---------------------------------------------------------------------------------------------------------
-- This source file is free software: you can redistribute it and-or modify
-- it under the terms of the GNU General Public License as published
-- by the Free Software Foundation, either version 3 of the License, or
-- (at your option) any later version.
--
-- This source file is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-- GNU General Public License for more details.
--
-- You should have received a copy of the GNU General Public License
-- along with this program. If not, see <http:--www.gnu.org-licenses->.
---------------------------------------------------------------------------------------------------------
-- Byte Addressed 32bit Port A, 8bit Port B BRAM module for the Video
-- Controller Graphics RAM implementation.
--
-- Copyright 2018-2021 - Philip Smart for the ZPU Evo implementation.
--
-- The FreeBSD license
--
-- Redistribution and use in source and binary forms, with or without
-- modification, are permitted provided that the following conditions
-- are met:
--
-- 1. Redistributions of source code must retain the above copyright
-- notice, this list of conditions and the following disclaimer.
-- 2. Redistributions in binary form must reproduce the above
-- copyright notice, this list of conditions and the following
-- disclaimer in the documentation and/or other materials
-- provided with the distribution.
--
-- THIS SOFTWARE IS PROVIDED BY THE ZPU PROJECT ``AS IS'' AND ANY
-- EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
-- THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
-- ZPU PROJECT OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,
-- INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
-- (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
-- OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
-- HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
-- STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
-- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
-- ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
--
-- The views and conclusions contained in the software and documentation
-- are those of the authors and should not be interpreted as representing
-- official policies, either expressed or implied, of the ZPU Project.
library ieee;
library altera;
library altera_mf;
library pkgs;
use ieee.std_logic_1164.all;
use ieee.std_logic_unsigned.all;
use ieee.numeric_std.all;
use work.VideoController_pkg.all;
use altera.altera_syn_attributes.all;
use altera_mf.all;
entity ChrGenRAM_DP_3208 is
generic
(
addrbits : integer := 16 -- Max address bit, size in bytes.
);
port
(
clkA : in std_logic;
memAAddr : in std_logic_vector(addrbits-1 downto 0);
memAWriteEnable : in std_logic;
memAWriteByte : in std_logic;
memAWriteHalfWord : in std_logic;
memAWrite : in std_logic_vector(31 downto 0);
memARead : out std_logic_vector(31 downto 0);
clkB : in std_logic;
memBAddr : in std_logic_vector(addrbits-1 downto 0);
memBWriteEnable : in std_logic;
memBWrite : in std_logic_vector(7 downto 0);
memBRead : out std_logic_vector(7 downto 0)
);
end ChrGenRAM_DP_3208;
architecture arch of ChrGenRAM_DP_3208 is
type ramArray is array(natural range 0 to (2**(addrbits-2))-1) of std_logic_vector(7 downto 0);
shared variable RAM0 : ramArray :=
(
<BYTEARRAY_0>
others => X"00"
);
shared variable RAM1 : ramArray :=
(
<BYTEARRAY_1>
others => X"00"
);
shared variable RAM2 : ramArray :=
(
<BYTEARRAY_2>
others => X"00"
);
shared variable RAM3 : ramArray :=
(
<BYTEARRAY_3>
others => X"00"
);
signal RAM0_PORTA_DO : std_logic_vector(7 downto 0); -- Buffer for byte in 32bit word to be written on Port A.
signal RAM1_PORTA_DO : std_logic_vector(7 downto 0); -- Buffer for byte in 32bit word to be written on Port A.
signal RAM2_PORTA_DO : std_logic_vector(7 downto 0); -- Buffer for byte in 32bit word to be written on Port A.
signal RAM3_PORTA_DO : std_logic_vector(7 downto 0); -- Buffer for byte in 32bit word to be written on Port A.
signal RAM_PORTA_DI : std_logic_vector(31 downto 0); -- Buffer for 32bit word being read prior to assignment to external port.
signal RAM0_PORTB_DI : std_logic_vector(7 downto 0); -- Buffer for 8bit byte being read prior to assignment to external port.
signal RAM1_PORTB_DI : std_logic_vector(7 downto 0); -- Buffer for 8bit byte being read prior to assignment to external port.
signal RAM2_PORTB_DI : std_logic_vector(7 downto 0); -- Buffer for 8bit byte being read prior to assignment to external port.
signal RAM3_PORTB_DI : std_logic_vector(7 downto 0); -- Buffer for 8bit byte being read prior to assignment to external port.
signal RAM0_PORTA_WREN : std_logic; -- Write Enable for this particular byte in 32 bit word on Port A.
signal RAM1_PORTA_WREN : std_logic; -- Write Enable for this particular byte in 32 bit word on Port A.
signal RAM2_PORTA_WREN : std_logic; -- Write Enable for this particular byte in 32 bit word on Port A.
signal RAM3_PORTA_WREN : std_logic; -- Write Enable for this particular byte in 32 bit word on Port A.
signal RAM0_PORTB_WREN : std_logic; -- Write Enable for this particular byte in 16 bit word on Port B, lowest addr = '0'.
signal RAM1_PORTB_WREN : std_logic; -- Write Enable for this particular byte in 16 bit word on Port B, lowest addr = '0'.
signal RAM2_PORTB_WREN : std_logic; -- Write Enable for this particular byte in 16 bit word on Port B, lowest addr = '1'.
signal RAM3_PORTB_WREN : std_logic; -- Write Enable for this particular byte in 16 bit word on Port B, lowest addr = '1'.
begin
-- Choose data to be written according to Byte/HWord select signals.
RAM0_PORTA_DO <= memAWrite(7 downto 0);
RAM1_PORTA_DO <= memAWrite(15 downto 8) when (memAWriteByte = '0' and memAWriteHalfWord = '0') or memAWriteHalfWord = '1'
else
memAWrite(7 downto 0);
RAM2_PORTA_DO <= memAWrite(23 downto 16) when (memAWriteByte = '0' and memAWriteHalfWord = '0')
else
memAWrite(7 downto 0);
RAM3_PORTA_DO <= memAWrite(31 downto 24) when (memAWriteByte = '0' and memAWriteHalfWord = '0')
else
memAWrite(15 downto 8) when memAWriteHalfWord = '1'
else
memAWrite(7 downto 0);
-- Data output is according to Least significant bits. Normally, a 32bit CPU would set them to 0 so output full word when 0, it there not zero, then
-- process as a byte read and copy selected byte to lower 8 bits.
memARead <= RAM_PORTA_DI when memAAddr(1 downto 0) = "00"
else
X"000000" & RAM_PORTA_DI(15 downto 8) when memAAddr(1 downto 0) = "01"
else
X"000000" & RAM_PORTA_DI(23 downto 16) when memAAddr(1 downto 0) = "10"
else
X"000000" & RAM_PORTA_DI(31 downto 24);
memBRead <= RAM0_PORTB_DI when memBAddr(1 downto 0) = "00"
else
RAM1_PORTB_DI when memBAddr(1 downto 0) = "01"
else
RAM2_PORTB_DI when memBAddr(1 downto 0) = "10"
else
RAM3_PORTB_DI;
-- Write enable based on byte select, either write a single byte or a complete word.
RAM0_PORTA_WREN <= '1' when memAWriteEnable = '1' and ((memAWriteByte = '0' and memAWriteHalfWord = '0') or (memAWriteByte = '1' and memAAddr(1 downto 0) = "00") or (memAWriteHalfWord = '1' and memAAddr(1) = '0'))
else '0';
RAM1_PORTA_WREN <= '1' when memAWriteEnable = '1' and ((memAWriteByte = '0' and memAWriteHalfWord = '0') or (memAWriteByte = '1' and memAAddr(1 downto 0) = "01") or (memAWriteHalfWord = '1' and memAAddr(1) = '0'))
else '0';
RAM2_PORTA_WREN <= '1' when memAWriteEnable = '1' and ((memAWriteByte = '0' and memAWriteHalfWord = '0') or (memAWriteByte = '1' and memAAddr(1 downto 0) = "10") or (memAWriteHalfWord = '1' and memAAddr(1) = '1'))
else '0';
RAM3_PORTA_WREN <= '1' when memAWriteEnable = '1' and ((memAWriteByte = '0' and memAWriteHalfWord = '0') or (memAWriteByte = '1' and memAAddr(1 downto 0) = "11") or (memAWriteHalfWord = '1' and memAAddr(1) = '1'))
else '0';
-- Port B is 16bit read and write so use the lowest address line to toggle write to a particular RAM set array.
RAM0_PORTB_WREN <= '1' when memBWriteEnable = '1' and memBAddr(1 downto 0) = "00"
else '0';
RAM1_PORTB_WREN <= '1' when memBWriteEnable = '1' and memBAddr(1 downto 0) = "01"
else '0';
RAM2_PORTB_WREN <= '1' when memBWriteEnable = '1' and memBAddr(1 downto 0) = "10"
else '0';
RAM3_PORTB_WREN <= '1' when memBWriteEnable = '1' and memBAddr(1 downto 0) = "11"
else '0';
---------------- PORT A - 32 bit --------------------
-- RAM Byte 0 - Port A - bits 7 to 0
process(clkA)
begin
if rising_edge(clkA) then
if RAM0_PORTA_WREN = '1' then
RAM0(to_integer(unsigned(memAAddr(addrbits-1 downto 2)))) := RAM0_PORTA_DO;
end if;
RAM_PORTA_DI(7 downto 0) <= RAM0(to_integer(unsigned(memAAddr(addrbits-1 downto 2))));
end if;
end process;
-- RAM Byte 1 - Port A - bits 15 to 8
process(clkA)
begin
if rising_edge(clkA) then
if RAM1_PORTA_WREN = '1' then
RAM1(to_integer(unsigned(memAAddr(addrbits-1 downto 2)))) := RAM1_PORTA_DO;
end if;
RAM_PORTA_DI(15 downto 8) <= RAM1(to_integer(unsigned(memAAddr(addrbits-1 downto 2))));
end if;
end process;
-- RAM Byte 2 - Port A - bits 23 to 16
process(clkA)
begin
if rising_edge(clkA) then
if RAM2_PORTA_WREN = '1' then
RAM2(to_integer(unsigned(memAAddr(addrbits-1 downto 2)))) := RAM2_PORTA_DO;
end if;
RAM_PORTA_DI(23 downto 16) <= RAM2(to_integer(unsigned(memAAddr(addrbits-1 downto 2))));
end if;
end process;
-- RAM Byte 3 - Port A - bits 31 to 24
process(clkA)
begin
if rising_edge(clkA) then
if RAM3_PORTA_WREN = '1' then
RAM3(to_integer(unsigned(memAAddr(addrbits-1 downto 2)))) := RAM3_PORTA_DO;
end if;
RAM_PORTA_DI(31 downto 24) <= RAM3(to_integer(unsigned(memAAddr(addrbits-1 downto 2))));
end if;
end process;
---------------- PORT B - 8 bit --------------------
-- BRAM Byte 0 - Port B - Byte 0 - bits 7 downto 0
process(clkB)
begin
if rising_edge(clkB) then
if RAM0_PORTB_WREN = '1' then
RAM0(to_integer(unsigned(memBAddr(addrbits-1 downto 2)))) := memBWrite;
end if;
RAM0_PORTB_DI <= RAM0(to_integer(unsigned(memBAddr(addrbits-1 downto 2))));
end if;
end process;
-- BRAM Byte 1 - Port B - Byte 1 - bits 15 downto 8
process(clkB)
begin
if rising_edge(clkB) then
if RAM1_PORTB_WREN = '1' then
RAM1(to_integer(unsigned(memBAddr(addrbits-1 downto 2)))) := memBWrite;
end if;
RAM1_PORTB_DI <= RAM1(to_integer(unsigned(memBAddr(addrbits-1 downto 2))));
end if;
end process;
-- BRAM Byte 2 - Port B - Byte 2 - bits 23 downto 16
process(clkB)
begin
if rising_edge(clkB) then
if RAM2_PORTB_WREN = '1' then
RAM2(to_integer(unsigned(memBAddr(addrbits-1 downto 2)))) := memBWrite;
end if;
RAM2_PORTB_DI <= RAM2(to_integer(unsigned(memBAddr(addrbits-1 downto 2))));
end if;
end process;
-- BRAM Byte 3 - Port B - Byte 3 - bits 31 downto 24
process(clkB)
begin
if rising_edge(clkB) then
if RAM3_PORTB_WREN = '1' then
RAM3(to_integer(unsigned(memBAddr(addrbits-1 downto 2)))) := memBWrite;
end if;
RAM3_PORTB_DI <= RAM3(to_integer(unsigned(memBAddr(addrbits-1 downto 2))));
end if;
end process;
end arch;

2
FPGA/SW700/v1.3/VideoController/README.txt Normal file
View File

@@ -0,0 +1,2 @@
If the Character Generator ROM is changed you need to regenerate the ChrGENRAM definition file using the command (alterered suitably):
${ROOT_DIR}/zSoft/tools/zpugen BA 32 ../../../../software/roms/MZ700_cgrom.rom ChrGenRAM_DP_3208.vhd.tmpl 0 > ChrGenRAM_DP_3208.vhd

3530
FPGA/SW700/v1.3/VideoController/VideoController.vhd
View File

File diff suppressed because it is too large Load Diff

12
FPGA/SW700/v1.3/VideoController/VideoController_constraints.sdc
View File

@@ -111,8 +111,8 @@ set_multicycle_path -from [get_clocks {SYS_CLK}]
set_multicycle_path -from [get_clocks {SYS_CLK}] -to [get_clocks {VIDCLK_40MHZ}] -setup -end 2
set_multicycle_path -from [get_clocks {SYS_CLK}] -to [get_clocks {VIDCLK_40MHZ}] -hold -end 1
#set_multicycle_path -from [get_clocks {SYS_CLK}] -to [get_clocks {VIDCLK_65MHZ}] -setup -end 2
#set_multicycle_path -from [get_clocks {SYS_CLK}] -to [get_clocks {VIDCLK_65MHZ}] -hold -end 1
set_multicycle_path -from [get_clocks {SYS_CLK}] -to [get_clocks {VIDCLK_65MHZ}] -setup -end 3
set_multicycle_path -from [get_clocks {SYS_CLK}] -to [get_clocks {VIDCLK_65MHZ}] -hold -end 2
set_multicycle_path -from [get_clocks {VIDCLK_8MHZ}] -to [get_clocks {SYS_CLK}] -setup -end 2
set_multicycle_path -from [get_clocks {VIDCLK_8MHZ}] -to [get_clocks {SYS_CLK}] -hold -end 1
@@ -129,11 +129,11 @@ set_multicycle_path -from [get_clocks {VIDCLK_17_7344MHZ}]
set_multicycle_path -from [get_clocks {VIDCLK_25_175MHZ}] -to [get_clocks {SYS_CLK}] -setup -end 3
set_multicycle_path -from [get_clocks {VIDCLK_25_175MHZ}] -to [get_clocks {SYS_CLK}] -hold -end 2
set_multicycle_path -from [get_clocks {VIDCLK_40MHZ}] -to [get_clocks {SYS_CLK}] -setup -end 2
set_multicycle_path -from [get_clocks {VIDCLK_40MHZ}] -to [get_clocks {SYS_CLK}] -hold -end 1
set_multicycle_path -from [get_clocks {VIDCLK_40MHZ}] -to [get_clocks {SYS_CLK}] -setup -end 3
set_multicycle_path -from [get_clocks {VIDCLK_40MHZ}] -to [get_clocks {SYS_CLK}] -hold -end 2
set_multicycle_path -from [get_clocks {VIDCLK_65MHZ}] -to [get_clocks {SYS_CLK}] -setup -end 2
set_multicycle_path -from [get_clocks {VIDCLK_65MHZ}] -to [get_clocks {SYS_CLK}] -hold -end 1
set_multicycle_path -from [get_clocks {VIDCLK_65MHZ}] -to [get_clocks {SYS_CLK}] -setup -end 3
set_multicycle_path -from [get_clocks {VIDCLK_65MHZ}] -to [get_clocks {SYS_CLK}] -hold -end 2
# GPU control and run variables have at least 1 clock between them being setup and used.
set_multicycle_path -from [get_registers {VideoController:vcCoreVideo|\GPU:GPU_START_X[*]}] -to [get_registers {VideoController:vcCoreVideo|GPU_START_ADDR[*]}] -setup -start 2

253
FPGA/SW700/v1.3/VideoController/VideoRAM_DP_3208.vhd Normal file
View File

@@ -0,0 +1,253 @@
---------------------------------------------------------------------------------------------------------
--
-- Name: VideoRAM_DP_3208.vhd
-- Created: Jan 2021
-- Author(s): Philip Smart
-- Description: Video RAM for the Sharp MZ series Video Controller Core.
--
-- This module provides a dual port inferred RAM definition for use as Video RAM
-- in the Video Controller. Port A allows 8/16/32 bit access, Port B allows for
-- 8 bit access. The size of the RAM is declared in the generic attribute
-- 'addrbits'.
--
-- Credits:
-- Copyright: (c) 2018-21 Philip Smart <philip.smart@net2net.org>
--
-- History: Jan 2021 - Initial creation.
--
---------------------------------------------------------------------------------------------------------
-- This source file is free software: you can redistribute it and-or modify
-- it under the terms of the GNU General Public License as published
-- by the Free Software Foundation, either version 3 of the License, or
-- (at your option) any later version.
--
-- This source file is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-- GNU General Public License for more details.
--
-- You should have received a copy of the GNU General Public License
-- along with this program. If not, see <http:--www.gnu.org-licenses->.
---------------------------------------------------------------------------------------------------------
library ieee;
library altera;
library altera_mf;
library pkgs;
use ieee.std_logic_1164.all;
use ieee.std_logic_unsigned.all;
use ieee.numeric_std.all;
use work.VideoController_pkg.all;
use altera.altera_syn_attributes.all;
use altera_mf.all;
entity VideoRAM_DP_3208 is
generic
(
addrbits : integer := 16 -- Max address bit, size in bytes.
);
port
(
clkA : in std_logic;
memAAddr : in std_logic_vector(addrbits-1 downto 0);
memAWriteEnable : in std_logic;
memAWriteByte : in std_logic;
memAWriteHalfWord : in std_logic;
memAWrite : in std_logic_vector(31 downto 0);
memARead : out std_logic_vector(31 downto 0);
clkB : in std_logic;
memBAddr : in std_logic_vector(addrbits-1 downto 0);
memBWriteEnable : in std_logic;
memBWrite : in std_logic_vector(7 downto 0);
memBRead : out std_logic_vector(7 downto 0)
);
end VideoRAM_DP_3208;
architecture arch of VideoRAM_DP_3208 is
type ramArray is array(natural range 0 to (2**(addrbits-2))-1) of std_logic_vector(7 downto 0);
shared variable RAM0 : ramArray :=
(
others => X"00"
);
shared variable RAM1 : ramArray :=
(
others => X"00"
);
shared variable RAM2 : ramArray :=
(
others => X"00"
);
shared variable RAM3 : ramArray :=
(
others => X"00"
);
signal RAM0_PORTA_DO : std_logic_vector(7 downto 0); -- Buffer for byte in 32bit word to be written on Port A.
signal RAM1_PORTA_DO : std_logic_vector(7 downto 0); -- Buffer for byte in 32bit word to be written on Port A.
signal RAM2_PORTA_DO : std_logic_vector(7 downto 0); -- Buffer for byte in 32bit word to be written on Port A.
signal RAM3_PORTA_DO : std_logic_vector(7 downto 0); -- Buffer for byte in 32bit word to be written on Port A.
signal RAM_PORTA_DI : std_logic_vector(31 downto 0); -- Buffer for 32bit word being read prior to assignment to external port.
signal RAM0_PORTB_DI : std_logic_vector(7 downto 0); -- Buffer for 8bit byte being read prior to assignment to external port.
signal RAM1_PORTB_DI : std_logic_vector(7 downto 0); -- Buffer for 8bit byte being read prior to assignment to external port.
signal RAM2_PORTB_DI : std_logic_vector(7 downto 0); -- Buffer for 8bit byte being read prior to assignment to external port.
signal RAM3_PORTB_DI : std_logic_vector(7 downto 0); -- Buffer for 8bit byte being read prior to assignment to external port.
signal RAM0_PORTA_WREN : std_logic; -- Write Enable for this particular byte in 32 bit word on Port A.
signal RAM1_PORTA_WREN : std_logic; -- Write Enable for this particular byte in 32 bit word on Port A.
signal RAM2_PORTA_WREN : std_logic; -- Write Enable for this particular byte in 32 bit word on Port A.
signal RAM3_PORTA_WREN : std_logic; -- Write Enable for this particular byte in 32 bit word on Port A.
signal RAM0_PORTB_WREN : std_logic; -- Write Enable for this particular byte in 16 bit word on Port B, lowest addr = '0'.
signal RAM1_PORTB_WREN : std_logic; -- Write Enable for this particular byte in 16 bit word on Port B, lowest addr = '0'.
signal RAM2_PORTB_WREN : std_logic; -- Write Enable for this particular byte in 16 bit word on Port B, lowest addr = '1'.
signal RAM3_PORTB_WREN : std_logic; -- Write Enable for this particular byte in 16 bit word on Port B, lowest addr = '1'.
begin
-- Choose data to be written according to Byte/HWord select signals.
RAM0_PORTA_DO <= memAWrite(7 downto 0);
RAM1_PORTA_DO <= memAWrite(15 downto 8) when (memAWriteByte = '0' and memAWriteHalfWord = '0') or memAWriteHalfWord = '1'
else
memAWrite(7 downto 0);
RAM2_PORTA_DO <= memAWrite(23 downto 16) when (memAWriteByte = '0' and memAWriteHalfWord = '0')
else
memAWrite(7 downto 0);
RAM3_PORTA_DO <= memAWrite(31 downto 24) when (memAWriteByte = '0' and memAWriteHalfWord = '0')
else
memAWrite(15 downto 8) when memAWriteHalfWord = '1'
else
memAWrite(7 downto 0);
-- Data output is according to Least significant bits. Normally, a 32bit CPU would set them to 0 so output full word when 0, it there not zero, then
-- process as a byte read and copy selected byte to lower 8 bits.
memARead <= RAM_PORTA_DI when memAAddr(1 downto 0) = "00"
else
X"000000" & RAM_PORTA_DI(15 downto 8) when memAAddr(1 downto 0) = "01"
else
X"000000" & RAM_PORTA_DI(23 downto 16) when memAAddr(1 downto 0) = "10"
else
X"000000" & RAM_PORTA_DI(31 downto 24);
memBRead <= RAM0_PORTB_DI when memBAddr(1 downto 0) = "00"
else
RAM1_PORTB_DI when memBAddr(1 downto 0) = "01"
else
RAM2_PORTB_DI when memBAddr(1 downto 0) = "10"
else
RAM3_PORTB_DI;
-- Write enable based on byte select, either write a single byte or a complete word.
RAM0_PORTA_WREN <= '1' when memAWriteEnable = '1' and ((memAWriteByte = '0' and memAWriteHalfWord = '0') or (memAWriteByte = '1' and memAAddr(1 downto 0) = "00") or (memAWriteHalfWord = '1' and memAAddr(1) = '0'))
else '0';
RAM1_PORTA_WREN <= '1' when memAWriteEnable = '1' and ((memAWriteByte = '0' and memAWriteHalfWord = '0') or (memAWriteByte = '1' and memAAddr(1 downto 0) = "01") or (memAWriteHalfWord = '1' and memAAddr(1) = '0'))
else '0';
RAM2_PORTA_WREN <= '1' when memAWriteEnable = '1' and ((memAWriteByte = '0' and memAWriteHalfWord = '0') or (memAWriteByte = '1' and memAAddr(1 downto 0) = "10") or (memAWriteHalfWord = '1' and memAAddr(1) = '1'))
else '0';
RAM3_PORTA_WREN <= '1' when memAWriteEnable = '1' and ((memAWriteByte = '0' and memAWriteHalfWord = '0') or (memAWriteByte = '1' and memAAddr(1 downto 0) = "11") or (memAWriteHalfWord = '1' and memAAddr(1) = '1'))
else '0';
-- Port B is 16bit read and write so use the lowest address line to toggle write to a particular RAM set array.
RAM0_PORTB_WREN <= '1' when memBWriteEnable = '1' and memBAddr(1 downto 0) = "00"
else '0';
RAM1_PORTB_WREN <= '1' when memBWriteEnable = '1' and memBAddr(1 downto 0) = "01"
else '0';
RAM2_PORTB_WREN <= '1' when memBWriteEnable = '1' and memBAddr(1 downto 0) = "10"
else '0';
RAM3_PORTB_WREN <= '1' when memBWriteEnable = '1' and memBAddr(1 downto 0) = "11"
else '0';
---------------- PORT A - 32 bit --------------------
-- RAM Byte 0 - Port A - bits 7 to 0
process(clkA)
begin
if rising_edge(clkA) then
if RAM0_PORTA_WREN = '1' then
RAM0(to_integer(unsigned(memAAddr(addrbits-1 downto 2)))) := RAM0_PORTA_DO;
end if;
RAM_PORTA_DI(7 downto 0) <= RAM0(to_integer(unsigned(memAAddr(addrbits-1 downto 2))));
end if;
end process;
-- RAM Byte 1 - Port A - bits 15 to 8
process(clkA)
begin
if rising_edge(clkA) then
if RAM1_PORTA_WREN = '1' then
RAM1(to_integer(unsigned(memAAddr(addrbits-1 downto 2)))) := RAM1_PORTA_DO;
end if;
RAM_PORTA_DI(15 downto 8) <= RAM1(to_integer(unsigned(memAAddr(addrbits-1 downto 2))));
end if;
end process;
-- RAM Byte 2 - Port A - bits 23 to 16
process(clkA)
begin
if rising_edge(clkA) then
if RAM2_PORTA_WREN = '1' then
RAM2(to_integer(unsigned(memAAddr(addrbits-1 downto 2)))) := RAM2_PORTA_DO;
end if;
RAM_PORTA_DI(23 downto 16) <= RAM2(to_integer(unsigned(memAAddr(addrbits-1 downto 2))));
end if;
end process;
-- RAM Byte 3 - Port A - bits 31 to 24
process(clkA)
begin
if rising_edge(clkA) then
if RAM3_PORTA_WREN = '1' then
RAM3(to_integer(unsigned(memAAddr(addrbits-1 downto 2)))) := RAM3_PORTA_DO;
end if;
RAM_PORTA_DI(31 downto 24) <= RAM3(to_integer(unsigned(memAAddr(addrbits-1 downto 2))));
end if;
end process;
---------------- PORT B - 8 bit --------------------
-- BRAM Byte 0 - Port B - Byte 0 - bits 7 downto 0
process(clkB)
begin
if rising_edge(clkB) then
if RAM0_PORTB_WREN = '1' then
RAM0(to_integer(unsigned(memBAddr(addrbits-1 downto 2)))) := memBWrite;
end if;
RAM0_PORTB_DI <= RAM0(to_integer(unsigned(memBAddr(addrbits-1 downto 2))));
end if;
end process;
-- BRAM Byte 1 - Port B - Byte 1 - bits 15 downto 8
process(clkB)
begin
if rising_edge(clkB) then
if RAM1_PORTB_WREN = '1' then
RAM1(to_integer(unsigned(memBAddr(addrbits-1 downto 2)))) := memBWrite;
end if;
RAM1_PORTB_DI <= RAM1(to_integer(unsigned(memBAddr(addrbits-1 downto 2))));
end if;
end process;
-- BRAM Byte 2 - Port B - Byte 2 - bits 23 downto 16
process(clkB)
begin
if rising_edge(clkB) then
if RAM2_PORTB_WREN = '1' then
RAM2(to_integer(unsigned(memBAddr(addrbits-1 downto 2)))) := memBWrite;
end if;
RAM2_PORTB_DI <= RAM2(to_integer(unsigned(memBAddr(addrbits-1 downto 2))));
end if;
end process;
-- BRAM Byte 3 - Port B - Byte 3 - bits 31 downto 24
process(clkB)
begin
if rising_edge(clkB) then
if RAM3_PORTB_WREN = '1' then
RAM3(to_integer(unsigned(memBAddr(addrbits-1 downto 2)))) := memBWrite;
end if;
RAM3_PORTB_DI <= RAM3(to_integer(unsigned(memBAddr(addrbits-1 downto 2))));
end if;
end process;
end arch;

248
FPGA/SW700/v1.3/VideoController/VideoRAM_DP_3216.vhd Normal file
View File

@@ -0,0 +1,248 @@
---------------------------------------------------------------------------------------------------------
--
-- Name: VideoRAM_DP_3216.vhd
-- Created: Jan 2021
-- Author(s): Philip Smart
-- Description: Video RAM for the Sharp MZ series Video Controller Core.
--
-- This module provides a dual port inferred RAM definition for use as Video RAM
-- in the Video Controller. Port A allows 8/16/32 bit access, Port B allows for
-- 16 bit access. The size of the RAM is declared in the generic attribute
-- 'addrbits'.
--
-- Credits:
-- Copyright: (c) 2018-21 Philip Smart <philip.smart@net2net.org>
--
-- History: Jan 2021 - Initial creation.
--
---------------------------------------------------------------------------------------------------------
-- This source file is free software: you can redistribute it and-or modify
-- it under the terms of the GNU General Public License as published
-- by the Free Software Foundation, either version 3 of the License, or
-- (at your option) any later version.
--
-- This source file is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-- GNU General Public License for more details.
--
-- You should have received a copy of the GNU General Public License
-- along with this program. If not, see <http:--www.gnu.org-licenses->.
---------------------------------------------------------------------------------------------------------
library ieee;
library altera;
library altera_mf;
library pkgs;
use ieee.std_logic_1164.all;
use ieee.std_logic_unsigned.all;
use ieee.numeric_std.all;
use work.VideoController_pkg.all;
use altera.altera_syn_attributes.all;
use altera_mf.all;
entity VideoRAM_DP_3216 is
generic
(
addrbits : integer := 16 -- Max address bit, size in bytes.
);
port
(
clkA : in std_logic;
memAAddr : in std_logic_vector(addrbits-1 downto 0);
memAWriteEnable : in std_logic;
memAWriteByte : in std_logic;
memAWriteHalfWord : in std_logic;
memAWrite : in std_logic_vector(31 downto 0);
memARead : out std_logic_vector(31 downto 0);
clkB : in std_logic;
memBAddr : in std_logic_vector(addrbits-2 downto 0);
memBWriteEnable : in std_logic;
memBWrite : in std_logic_vector(15 downto 0);
memBRead : out std_logic_vector(15 downto 0)
);
end VideoRAM_DP_3216;
architecture arch of VideoRAM_DP_3216 is
type ramArray is array(natural range 0 to (2**(addrbits-2))-1) of std_logic_vector(7 downto 0);
shared variable RAM0 : ramArray :=
(
others => X"00" -- No/space character.
);
shared variable RAM1 : ramArray :=
(
others => X"71" -- Blue background white foreground.
);
shared variable RAM2 : ramArray :=
(
others => X"00" -- No/space character.
);
shared variable RAM3 : ramArray :=
(
others => X"71" -- Blue background white foreground.
);
signal RAM0_PORTA_DO : std_logic_vector(7 downto 0); -- Buffer for byte in 32bit word to be written on Port A.
signal RAM1_PORTA_DO : std_logic_vector(7 downto 0); -- Buffer for byte in 32bit word to be written on Port A.
signal RAM2_PORTA_DO : std_logic_vector(7 downto 0); -- Buffer for byte in 32bit word to be written on Port A.
signal RAM3_PORTA_DO : std_logic_vector(7 downto 0); -- Buffer for byte in 32bit word to be written on Port A.
signal RAM_PORTA_DI : std_logic_vector(31 downto 0); -- Buffer for 32bit word being read prior to assignment to external port.
signal RAM_PORTB_DIL : std_logic_vector(15 downto 0); -- Buffer for 16bit word being read prior to assignment to external port.
signal RAM_PORTB_DIH : std_logic_vector(15 downto 0); -- Buffer for 16bit word being read prior to assignment to external port.
signal RAM0_PORTA_WREN : std_logic; -- Write Enable for this particular byte in 32 bit word on Port A.
signal RAM1_PORTA_WREN : std_logic; -- Write Enable for this particular byte in 32 bit word on Port A.
signal RAM2_PORTA_WREN : std_logic; -- Write Enable for this particular byte in 32 bit word on Port A.
signal RAM3_PORTA_WREN : std_logic; -- Write Enable for this particular byte in 32 bit word on Port A.
signal RAM0_PORTB_WREN : std_logic; -- Write Enable for this particular byte in 16 bit word on Port B, lowest addr = '0'.
signal RAM1_PORTB_WREN : std_logic; -- Write Enable for this particular byte in 16 bit word on Port B, lowest addr = '0'.
signal RAM2_PORTB_WREN : std_logic; -- Write Enable for this particular byte in 16 bit word on Port B, lowest addr = '1'.
signal RAM3_PORTB_WREN : std_logic; -- Write Enable for this particular byte in 16 bit word on Port B, lowest addr = '1'.
begin
-- Choose data to be written according to Byte/HWord select signals.
RAM0_PORTA_DO <= memAWrite(7 downto 0);
RAM1_PORTA_DO <= memAWrite(15 downto 8) when (memAWriteByte = '0' and memAWriteHalfWord = '0') or memAWriteHalfWord = '1'
else
memAWrite(7 downto 0);
RAM2_PORTA_DO <= memAWrite(23 downto 16) when (memAWriteByte = '0' and memAWriteHalfWord = '0')
else
memAWrite(7 downto 0);
RAM3_PORTA_DO <= memAWrite(31 downto 24) when (memAWriteByte = '0' and memAWriteHalfWord = '0')
else
memAWrite(15 downto 8) when memAWriteHalfWord = '1'
else
memAWrite(7 downto 0);
-- Data output is according to Least significant bits. Normally, a 32bit CPU would set them to 0 so output full word when 0, it there not zero, then
-- process as a byte read and copy selected byte to lower 8 bits.
memARead <= RAM_PORTA_DI when memAAddr(1 downto 0) = "00"
else
X"000000" & RAM_PORTA_DI(15 downto 8) when memAAddr(1 downto 0) = "01"
else
X"000000" & RAM_PORTA_DI(23 downto 16) when memAAddr(1 downto 0) = "10"
else
X"000000" & RAM_PORTA_DI(31 downto 24) when memAAddr(1 downto 0) = "11"
else (others => 'X');
memBRead <= RAM_PORTB_DIL when memBAddr(0) = '0'
else
RAM_PORTB_DIH;
-- Write enable based on byte select, either write a single byte or a complete word.
RAM0_PORTA_WREN <= '1' when memAWriteEnable = '1' and ((memAWriteByte = '0' and memAWriteHalfWord = '0') or (memAWriteByte = '1' and memAAddr(1 downto 0) = "00") or (memAWriteHalfWord = '1' and memAAddr(1) = '0'))
else '0';
RAM1_PORTA_WREN <= '1' when memAWriteEnable = '1' and ((memAWriteByte = '0' and memAWriteHalfWord = '0') or (memAWriteByte = '1' and memAAddr(1 downto 0) = "01") or (memAWriteHalfWord = '1' and memAAddr(1) = '0'))
else '0';
RAM2_PORTA_WREN <= '1' when memAWriteEnable = '1' and ((memAWriteByte = '0' and memAWriteHalfWord = '0') or (memAWriteByte = '1' and memAAddr(1 downto 0) = "10") or (memAWriteHalfWord = '1' and memAAddr(1) = '1'))
else '0';
RAM3_PORTA_WREN <= '1' when memAWriteEnable = '1' and ((memAWriteByte = '0' and memAWriteHalfWord = '0') or (memAWriteByte = '1' and memAAddr(1 downto 0) = "11") or (memAWriteHalfWord = '1' and memAAddr(1) = '1'))
else '0';
-- Port B is 16bit read and write so use the lowest address line to toggle write to a particular RAM set array.
RAM0_PORTB_WREN <= '1' when memBWriteEnable = '1' and memBAddr(0) = '0'
else '0';
RAM1_PORTB_WREN <= '1' when memBWriteEnable = '1' and memBAddr(0) = '0'
else '0';
RAM2_PORTB_WREN <= '1' when memBWriteEnable = '1' and memBAddr(0) = '1'
else '0';
RAM3_PORTB_WREN <= '1' when memBWriteEnable = '1' and memBAddr(0) = '1'
else '0';
---------------- PORT A - 32 bit --------------------
-- RAM Byte 0 - Port A - bits 7 to 0
process(clkA)
begin
if rising_edge(clkA) then
if RAM0_PORTA_WREN = '1' then
RAM0(to_integer(unsigned(memAAddr(addrbits-1 downto 2)))) := RAM0_PORTA_DO;
end if;
RAM_PORTA_DI(7 downto 0) <= RAM0(to_integer(unsigned(memAAddr(addrbits-1 downto 2))));
end if;
end process;
-- RAM Byte 1 - Port A - bits 15 to 8
process(clkA)
begin
if rising_edge(clkA) then
if RAM1_PORTA_WREN = '1' then
RAM1(to_integer(unsigned(memAAddr(addrbits-1 downto 2)))) := RAM1_PORTA_DO;
end if;
RAM_PORTA_DI(15 downto 8) <= RAM1(to_integer(unsigned(memAAddr(addrbits-1 downto 2))));
end if;
end process;
-- RAM Byte 2 - Port A - bits 23 to 16
process(clkA)
begin
if rising_edge(clkA) then
if RAM2_PORTA_WREN = '1' then
RAM2(to_integer(unsigned(memAAddr(addrbits-1 downto 2)))) := RAM2_PORTA_DO;
end if;
RAM_PORTA_DI(23 downto 16) <= RAM2(to_integer(unsigned(memAAddr(addrbits-1 downto 2))));
end if;
end process;
-- RAM Byte 3 - Port A - bits 31 to 24
process(clkA)
begin
if rising_edge(clkA) then
if RAM3_PORTA_WREN = '1' then
RAM3(to_integer(unsigned(memAAddr(addrbits-1 downto 2)))) := RAM3_PORTA_DO;
end if;
RAM_PORTA_DI(31 downto 24) <= RAM3(to_integer(unsigned(memAAddr(addrbits-1 downto 2))));
end if;
end process;
---------------- PORT B - 16 bit --------------------
-- BRAM Byte 0 - Port B - Half-Word 0 - bits 7 downto 0
process(clkB)
begin
if rising_edge(clkB) then
if RAM0_PORTB_WREN = '1' then
RAM0(to_integer(unsigned(memBAddr(addrbits-2 downto 1)))) := memBWrite(7 downto 0);
end if;
RAM_PORTB_DIL(7 downto 0) <= RAM0(to_integer(unsigned(memBAddr(addrbits-2 downto 1))));
end if;
end process;
-- BRAM Byte 1 - Port B - Half-Word 0 - bits 15 downto 8
process(clkB)
begin
if rising_edge(clkB) then
if RAM1_PORTB_WREN = '1' then
RAM1(to_integer(unsigned(memBAddr(addrbits-2 downto 1)))) := memBWrite(15 downto 8);
end if;
RAM_PORTB_DIL(15 downto 8) <= RAM1(to_integer(unsigned(memBAddr(addrbits-2 downto 1))));
end if;
end process;
-- BRAM Byte 2 - Port B - Half-Word 1 - bits 7 downto 0
process(clkB)
begin
if rising_edge(clkB) then
if RAM2_PORTB_WREN = '1' then
RAM2(to_integer(unsigned(memBAddr(addrbits-2 downto 1)))) := memBWrite(7 downto 0);
end if;
RAM_PORTB_DIH(7 downto 0) <= RAM2(to_integer(unsigned(memBAddr(addrbits-2 downto 1))));
end if;
end process;
-- BRAM Byte 3 - Port B - Half-Word 1 - bits 15 downto 8
process(clkB)
begin
if rising_edge(clkB) then
if RAM3_PORTB_WREN = '1' then
RAM3(to_integer(unsigned(memBAddr(addrbits-2 downto 1)))) := memBWrite(15 downto 8);
end if;
RAM_PORTB_DIH(15 downto 8) <= RAM3(to_integer(unsigned(memBAddr(addrbits-2 downto 1))));
end if;
end process;
end arch;

33
FPGA/SW700/v1.3/build/coreMZ.qsf
View File

@@ -257,30 +257,21 @@ set_instance_assignment -name CURRENT_STRENGTH_NEW "MAXIMUM CURRENT" -to VGA_B[2
set_instance_assignment -name CURRENT_STRENGTH_NEW "MAXIMUM CURRENT" -to VGA_B[3]
set_instance_assignment -name CURRENT_STRENGTH_NEW "MAXIMUM CURRENT" -to VGA_B_COMPOSITE
# Files in project.
# =================
#set_global_assignment -name QIP_FILE Clock_50to100.qip
# Latest T80 CPU
# ==============
# Latest ZPU EVO CPU
# ==================
#set_global_assignment -name VHDL_FILE ../devices/sysbus/RAM/dpram.vhd
#set_global_assignment -name VHDL_FILE ../T80/T80a.vhd
set_global_assignment -name SEARCH_PATH ../AZ80
set_global_assignment -name VHDL_FILE ../coreMZ.vhd
set_global_assignment -name VHDL_FILE ../coreMZ_pkg.vhd
# Sharp MZ Core Logic
set_global_assignment -name QIP_FILE ../coreMZ.qip
# Altera Serial Flash Loader IP
set_global_assignment -name QIP_FILE ../SFL/SFL_IV.qip
set_global_assignment -name QIP_FILE ../PLL/Video_Clock_IV.qip
set_global_assignment -name SDC_FILE ../coreMZ_constraints.sdc
#
set_global_assignment -name QIP_FILE ../VideoController.qip
# T80 CPU definitions.
# Latest T80 CPU
# ==============
set_global_assignment -name QIP_FILE ../softT80.qip
# ZPU Evo CPU definitions
# Latest ZPU EVO CPU
# ==================
set_global_assignment -name QIP_FILE ../softZPU.qip
@@ -288,12 +279,4 @@ set_global_assignment -name ENABLE_DRC_SETTINGS OFF
set_global_assignment -name PROJECT_IP_REGENERATION_POLICY SKIP_REGENERATING_IP_IF_HDL_MODIFIED
set_global_assignment -name SMART_RECOMPILE OFF
set_instance_assignment -name PARTITION_HIERARCHY root_partition -to | -section_id Top

7
FPGA/SW700/v1.3/coreMZ.qip Normal file
View File

@@ -0,0 +1,7 @@
set_global_assignment -name IP_TOOL_NAME "Sharp MZ Core MZ Logic"
set_global_assignment -name IP_TOOL_VERSION "17.1"
set_global_assignment -name IP_GENERATED_DEVICE_FAMILY "{Cyclone IV E}"
set_global_assignment -name VHDL_FILE [file join $::quartus(qip_path) coreMZ_pkg.vhd]
set_global_assignment -name VHDL_FILE [file join $::quartus(qip_path) coreMZ.vhd]
set_global_assignment -name SDC_FILE [file join $::quartus(qip_path) coreMZ_constraints.sdc]
set_global_assignment -name QIP_FILE [file join $::quartus(qip_path) PLL/Video_Clock_IV.qip]

109
FPGA/SW700/v1.3/coreMZ.vhd
View File

@@ -146,11 +146,15 @@ architecture rtl of coreMZ is
signal ZPU80_DATA_OUT : std_logic_vector(7 downto 0);
signal ZPU80_HALTn : std_logic;
signal ZPU_DATA_OUT : std_logic_vector(31 downto 0); -- External RAM block data to write to RAM.
signal ZPU_ADDR : std_logic_vector(23 downto 0); -- 24bit address bus to address RAM.
signal ZPU_WRITE_EN : std_logic; -- Write to external RAM.
signal ZPU_MEM_BUSACK : std_logic; -- Memory bus acknowledge signal.
signal ZPU_VIDEO_ADDR : std_logic_vector(23 downto 0); -- Dedicated video address, bypasses the CPLD.
signal ZPU_VIDEO_DATA_IN : std_logic_vector(31 downto 0); -- Video controller to ZPU data in.
signal ZPU_VIDEO_DATA_OUT : std_logic_vector(31 downto 0); -- ZPU to Video controller data out.
signal ZPU_VIDEO_WRn : std_logic; -- Dedicated video channel write signal, bypasses the CPLD.
signal ZPU_VIDEO_RDn : std_logic; -- Dedicated video channel read signal, bypasses the CPLD.
signal ZPU_VIDEO_WR_BYTE : std_logic; -- Dedicated video channel 8bit byte write identifier signal, bypasses the CPLD.
signal ZPU_VIDEO_WR_HWORD : std_logic; -- Dedicated video channel 16bit half word write identifier signal, bypasses the CPLD.
-- Internal core signals, muxed or demuxed physical connections.
--
@@ -164,10 +168,11 @@ architecture rtl of coreMZ is
signal CORE_RESETn : std_logic;
signal CORE_VIDEO_WRn : std_logic; -- FPGA video write. Normally from the CPLD memory manager but overriden by soft CPU's such as the ZPU.
signal CORE_VIDEO_RDn : std_logic; -- FPGA video read. Normally from the CPLD memory manager but overriden by soft CPU's such as the ZPU.
signal CORE_ADDR : std_logic_vector(15 downto 0); --
signal CORE_HI_ADDR : std_logic_vector(7 downto 0); -- Upper address bits of the 24bit address bus used to access video memory and BRAM devices of soft CPU's.
signal CORE_DATA_OUT : std_logic_vector(7 downto 0); --
signal CORE_DATA_IN : std_logic_vector(7 downto 0); --
signal CORE_VIDEO_WR_BYTE : std_logic; -- FPGA video byte write. A single byte is written when this flag is active.
signal CORE_VIDEO_WR_HWORD : std_logic; -- FPGA video 16bit half word write. A 16bit word, 2 bytes are written when this flag is active, half word aligned.
signal CORE_ADDR : std_logic_vector(23 downto 0); --
signal CORE_DATA_OUT : std_logic_vector(31 downto 0); --
signal CORE_DATA_IN : std_logic_vector(31 downto 0); --
signal VZ80_CLK_LAST : std_logic_vector(2 downto 0);
signal VZ80_BUSRQn : std_logic;
begin
@@ -239,21 +244,24 @@ begin
(
-- Primary and video clocks.
CLOCK_50 => CLOCK_50, -- 50MHz main FPGA clock.
VZ80_CLK => VZ80_CLK, -- Z80 runtime clock (product of SYSCLK and CTLCLK - variable frequency).
-- Reset.
VRESETn => CORE_RESETn, -- Internal reset.
-- V[name] = Voltage translated signals which mirror the mainboard signals but at a lower voltage.
-- Address Bus
VIDEO_ADDR => CORE_ADDR, -- Z80 Address bus.
VIDEO_HI_ADDR => CORE_HI_ADDR, -- Direct Addressing bus.
VIDEO_ADDR => CORE_ADDR, -- 24bit Address bus.
-- Data Bus
VIDEO_DATA_IN => CORE_DATA_IN, -- Z80 Data bus from CPU into video module.
VIDEO_DATA_OUT => CORE_DATA_OUT, -- Z80 Data bus from video module to CPU.
VIDEO_DATA_IN => CORE_DATA_IN, -- Data bus from CPU into video module.
VIDEO_DATA_OUT => CORE_DATA_OUT, -- Data bus from video module to CPU.
-- Control signals.
VIDEO_IORQn => CORE_IORQn, -- IORQ signal, active low. When high, request is to memory.
VIDEO_RDn => CORE_VIDEO_RDn, -- Decoded Video Controller Read from CPLD memory manager.
VIDEO_WRn => CORE_VIDEO_WRn, -- Decoded Video Controller Write from CPLD memory manager.
VIDEO_WR_BYTE => CORE_VIDEO_WR_BYTE, -- Signal to indicate a byte should be written not a 32bit word.
VIDEO_WR_HWORD => CORE_VIDEO_WR_HWORD, -- Signal to indicate a 16bit half word should be written not a 32bit word.
-- VGA & Composite output signals.
VGA_R => VGA_R, -- 16 level Red output.
@@ -277,9 +285,6 @@ begin
V_B => VZ80_A16_WAITn_V_B, -- Soft CPU WAITn / Digital Blue (on/off) from mainboard.
V_R => VZ80_A18_INTn_V_R, -- Soft CPU INTn / Digital Red (on/off) from mainboard.
-- Reset.
VRESETn => CORE_RESETn, -- Internal reset.
-- Configuration.
VIDEO_MODE => CPLD_CFG_DATA(2 downto 0), -- Video mode the controller should emulate.
MB_VIDEO_ENABLEn => MODE_CPLD_MB_VIDEOn -- Mainboard video enabled (=0) or FPGA advanced video (=1).
@@ -332,7 +337,7 @@ begin
else
CPU_INFO_DATA when CS_CPU_INFOn = '0' and MODE_CPU_SOFT = '1' and T80_RDn = '0' -- Read CPU version & hw build information.
else
CORE_DATA_OUT when CORE_VIDEO_RDn = '0'
CORE_DATA_OUT(7 downto 0) when CORE_VIDEO_RDn = '0'
else
VZ80_DATA when MODE_SOFTCPU_Z80 = '1' and T80_RDn = '0'
else (others => '0');
@@ -382,13 +387,18 @@ begin
Z80_CLK => VZ80_CLK, -- Underlying hardware system clock
-- Software controlled signals.
SW_RESET => MODE_SOFTCPU_RESET, -- Software controlled reset.
SW_RESET => MODE_SOFTCPU_RESET, -- Software controlled reset.
SW_CLKEN => MODE_SOFTCPU_CLKEN, -- Software controlled clock enable.
SW_CPUEN => MODE_SOFTCPU_ZPUEVO, -- Software controlled CPU enable.
-- Direct access to the video controller, bypassing the CPLD Memory management.
VIDEO_ADDR => ZPU_VIDEO_ADDR, -- Direct video controller addressing, bypass CPLD memory manager and operate at 32bits.
VIDEO_DATA_IN => ZPU_VIDEO_DATA_IN, -- Video controller to ZPU data in.
VIDEO_DATA_OUT => ZPU_VIDEO_DATA_OUT, -- ZPU to Video controller data out.
VIDEO_WRn => ZPU_VIDEO_WRn, -- Direct video write from ZPU, bypass CPLD memory manager.
VIDEO_RDn => ZPU_VIDEO_RDn, -- Direct video read from ZPU, bypass CPLD memory manager.
VIDEO_WR_BYTE => ZPU_VIDEO_WR_BYTE, -- Direct video write byte signal, when set a byte should be written.
VIDEO_WR_HWORD => ZPU_VIDEO_WR_HWORD, -- Direct video write byte signal, when set a 16bit half word should be written.
-- External Direct addressing Bus. Ability to read and write to the internal ZPU memory for uploading new programs/debugging.
-- When BUSRQ is asserted, the external system can drive the signals to query memory.
@@ -424,7 +434,6 @@ begin
ZPU80_HALTn => ZPU80_HALTn, -- HALTn signal indicates that the CPU has executed a "HALT" instruction.
ZPU80_BUSACKn => open, -- BUSACKn signal indicates that the CPU address bus, data bus, and control signals have entered their HI-Z states, and that the external circuitry can now control these lines.
ZPU80_ADDR => ZPU80_ADDR, -- 16 bit address lines.
ZPU80_HI_ADDR => ZPU80_VIDEO_ADDR, -- Direct addressing of video memory (bypassing register configuration needed by Sharp MZ host to maintain compatibility or address space restrictions).
ZPU80_DATA_IN => ZPU80_DATA_IN, -- 8 bit data bus in.
ZPU80_DATA_OUT => ZPU80_DATA_OUT, -- 8 bit data bus out.
@@ -434,6 +443,8 @@ begin
);
-- Direct routed signals to the ZPU when not using mainboard video.
ZPU_VIDEO_DATA_IN <= CORE_DATA_OUT;
ZPU80_INTn <= VZ80_A18_INTn_V_R when VZ80_BUSACKni = '1' and (MODE_SOFTCPU_ZPUEVO = '1' or MODE_CPLD_MB_VIDEOn = '1')
else '1';
ZPU80_NMIn <= VZ80_A17_NMIn_V_COLR when VZ80_BUSACKni = '1' and (MODE_SOFTCPU_ZPUEVO = '1' or MODE_CPLD_MB_VIDEOn = '1')
@@ -445,7 +456,7 @@ begin
else
CPU_INFO_DATA when CS_CPU_INFOn = '0' and MODE_CPU_SOFT = '1' and ZPU80_RDn = '0' -- Read CPU version & hw build information.
else
CORE_DATA_OUT when CORE_VIDEO_RDn = '0'
CORE_DATA_OUT(7 downto 0) when CORE_VIDEO_RDn = '0'
else
VZ80_DATA when MODE_SOFTCPU_ZPUEVO = '1' and ZPU80_RDn = '0'
else (others => '0');
@@ -462,7 +473,6 @@ begin
ZPU80_HALTn <= '1';
ZPU80_ADDR <= (others => '0');
ZPU80_DATA_OUT <= (others => '0');
ZPU_ADDR <= (others => '0');
ZPU_WRITE_EN <= '0';
ZPU_MEM_BUSACK <= '0';
ZPU_VIDEO_WRn <= '1';
@@ -672,16 +682,23 @@ begin
else
ZPU80_HALTn when MODE_SOFTCPU_ZPUEVO = '1' and VZ80_BUSACKni = '1'
else '1';
CORE_VIDEO_WRn <= '0' when MODE_SOFTCPU_ZPUEVO = '1' and VZ80_BUSACKni = '0' and VZ80_WRn = '0' and VZ80_HI_ADDR(23 downto 19) = "00001"
CORE_VIDEO_WRn <= '0' when VZ80_BUSACKni = '0' and VZ80_WRn = '0' and VZ80_HI_ADDR(23 downto 19) = "00001"
else
ZPU_VIDEO_WRn when MODE_SOFTCPU_ZPUEVO = '1' and VZ80_BUSACKni = '1'
else
VIDEO_WRn;
CORE_VIDEO_RDn <= '0' when MODE_SOFTCPU_ZPUEVO = '1' and VZ80_BUSACKni = '0' and VZ80_RDn = '0' and VZ80_HI_ADDR(23 downto 19) = "00001"
CORE_VIDEO_RDn <= '0' when VZ80_BUSACKni = '0' and VZ80_RDn = '0' and VZ80_HI_ADDR(23 downto 19) = "00001"
else
ZPU_VIDEO_RDn when MODE_SOFTCPU_ZPUEVO = '1' and VZ80_BUSACKni = '1'
else
VIDEO_RDn;
-- 32/16/8 bit write select. When the ZPU is writing, the signals are active and controlled by the ZPU, otherwise default to 1 byte writes.
CORE_VIDEO_WR_BYTE <= '1' when ZPU_VIDEO_WRn = '1'
else
ZPU_VIDEO_WR_BYTE;
CORE_VIDEO_WR_HWORD <= '0' when ZPU_VIDEO_WRn = '1'
else
ZPU_VIDEO_WR_HWORD;
-- Internal reset dependent on external reset or a change of the SOFT CPU.
CORE_RESETn <= '0' when RESETn = '0'
@@ -689,63 +706,61 @@ begin
-- Address lines driven according to the CPU being used. Hard CPU = address via CPLD, Soft CPU = address direct.
CORE_ADDR <= VZ80_ADDR when MODE_CPU_SOFT = '0' or VZ80_BUSACKni = '0'
CORE_ADDR <= X"00" & T80_ADDR when MODE_SOFTCPU_Z80 = '1' and VZ80_BUSACKni = '1'
else
T80_ADDR when MODE_SOFTCPU_Z80 = '1' and VZ80_BUSACKni = '1'
ZPU_VIDEO_ADDR when MODE_SOFTCPU_ZPUEVO = '1' and VZ80_BUSACKni = '1' and (ZPU_VIDEO_WRn = '0' or ZPU_VIDEO_RDn = '0')
else
ZPU80_ADDR when MODE_SOFTCPU_ZPUEVO = '1' and VZ80_BUSACKni = '1'
X"00" & ZPU80_ADDR when MODE_SOFTCPU_ZPUEVO = '1' and VZ80_BUSACKni = '1' and ZPU_VIDEO_WRn = '1' and ZPU_VIDEO_RDn = '1'
else
VZ80_HI_ADDR & VZ80_ADDR when MODE_CPU_SOFT = '0' or VZ80_BUSACKni = '0'
else (others => '0');
-- Hi address lines used for direct external addressing of video memory or BRAM devices for soft CPU's.
CORE_HI_ADDR <= VZ80_HI_ADDR when MODE_SOFTCPU_ZPUEVO = '1' and VZ80_BUSACKni = '0'
else
ZPU80_VIDEO_ADDR when MODE_SOFTCPU_ZPUEVO = '1' and VZ80_BUSACKni = '1'
else
(others => '0');
-- Data into the core, generally the Video Controller, comes from the CPLD (hard CPU or mainboard) if the soft CPU is disabled else from the soft CPU.
CORE_DATA_IN <= VZ80_DATA when MODE_CPU_SOFT = '0' or VZ80_BUSACKni = '0'
CORE_DATA_IN <= X"000000" & T80_DATA_OUT when MODE_SOFTCPU_Z80 = '1' and VZ80_BUSACKni = '1'
else
T80_DATA_OUT when MODE_SOFTCPU_Z80 = '1' and VZ80_BUSACKni = '1'
ZPU_VIDEO_DATA_OUT when MODE_SOFTCPU_ZPUEVO = '1' and VZ80_BUSACKni = '1' and (ZPU_VIDEO_WRn = '0' or ZPU_VIDEO_RDn = '0')
else
ZPU80_DATA_OUT when MODE_SOFTCPU_ZPUEVO = '1' and VZ80_BUSACKni = '1'
X"000000" & ZPU80_DATA_OUT when MODE_SOFTCPU_ZPUEVO = '1' and VZ80_BUSACKni = '1' and ZPU_VIDEO_WRn = '1' and ZPU_VIDEO_RDn = '1'
else
X"000000" & VZ80_DATA when MODE_CPU_SOFT = '0' or VZ80_BUSACKni = '0'
else (others => '0');
-- tranZPUter, hard CPU or mainboard data input. Read directly from the Video Controller if selected, else the data being output from the soft CPU if enabled otherwise
-- tri-state as data is coming from the CPLD.
VZ80_DATA <= CPU_CFG_DATA when CS_CPU_CFGn = '0' and VZ80_RDn = '0' -- Read current CPU register settings.
else
CPU_INFO_DATA when CS_CPU_INFOn = '0' and VZ80_RDn = '0' -- Read CPU version & hw build information.
else
CORE_DATA_OUT when CORE_VIDEO_RDn = '0' -- If the video resources are being read, either by the hard cpu or the K64f, output requested data.
CORE_DATA_OUT (7 downto 0) when CORE_VIDEO_RDn = '0' -- If the video resources are being read, either by the hard cpu or the K64f, output requested data.
else
T80_DATA_OUT when MODE_SOFTCPU_Z80 = '1' and T80_WRn = '0' and VZ80_BUSACKni = '1' -- T80 has control over writing data when enabled and bus not requested.
T80_DATA_OUT when MODE_SOFTCPU_Z80 = '1' and T80_WRn = '0' and VZ80_BUSACKni = '1' -- T80 has control over writing data when enabled and bus not requested.
else
ZPU80_DATA_OUT when MODE_SOFTCPU_ZPUEVO = '1' and ZPU80_WRn = '0' and VZ80_BUSACKni = '1' -- ZPU Evo Z80 Bus controller has control over writing data when enabled and bus not requested.
ZPU80_DATA_OUT when MODE_SOFTCPU_ZPUEVO = '1' and ZPU80_WRn = '0' and VZ80_BUSACKni = '1' -- ZPU Evo Z80 Bus controller has control over writing data when enabled and bus not requested.
else
ZPU80_DATA_OUT when MODE_SOFTCPU_ZPUEVO = '1' and ZPU80_MREQn = '0' and ZPU80_IORQn = '0' and VZ80_BUSACKni = '1' -- ZPU has control when writing special control word to CPLD to enable memory mode.
ZPU80_DATA_OUT when MODE_SOFTCPU_ZPUEVO = '1' and ZPU80_MREQn = '0' and ZPU80_IORQn = '0' and VZ80_BUSACKni = '1' -- ZPU has control when writing special control word to CPLD to enable memory mode.
-- When bus requested, K64F has control, reading data from the ZPU BRAM if selected.
else
ZPU_DATA_OUT(7 downto 0) when MODE_SOFTCPU_ZPUEVO = '1' and VZ80_BUSACKni = '0' and VZ80_RDn = '0' and VZ80_ADDR(1 downto 0) = "11"
ZPU_DATA_OUT(7 downto 0) when MODE_SOFTCPU_ZPUEVO = '1' and VZ80_BUSACKni = '0' and VZ80_RDn = '0' and VZ80_ADDR(1 downto 0) = "11"
else
ZPU_DATA_OUT(15 downto 8) when MODE_SOFTCPU_ZPUEVO = '1' and VZ80_BUSACKni = '0' and VZ80_RDn = '0' and VZ80_ADDR(1 downto 0) = "10"
ZPU_DATA_OUT(15 downto 8) when MODE_SOFTCPU_ZPUEVO = '1' and VZ80_BUSACKni = '0' and VZ80_RDn = '0' and VZ80_ADDR(1 downto 0) = "10"
else
ZPU_DATA_OUT(23 downto 16) when MODE_SOFTCPU_ZPUEVO = '1' and VZ80_BUSACKni = '0' and VZ80_RDn = '0' and VZ80_ADDR(1 downto 0) = "01"
ZPU_DATA_OUT(23 downto 16) when MODE_SOFTCPU_ZPUEVO = '1' and VZ80_BUSACKni = '0' and VZ80_RDn = '0' and VZ80_ADDR(1 downto 0) = "01"
else
ZPU_DATA_OUT(31 downto 24) when MODE_SOFTCPU_ZPUEVO = '1' and VZ80_BUSACKni = '0' and VZ80_RDn = '0' and VZ80_ADDR(1 downto 0) = "00"
ZPU_DATA_OUT(31 downto 24) when MODE_SOFTCPU_ZPUEVO = '1' and VZ80_BUSACKni = '0' and VZ80_RDn = '0' and VZ80_ADDR(1 downto 0) = "00"
else (others => 'Z');
-- Direct routed signals to the ZPU when not using mainboard video.
VZ80_HI_ADDR(16) <= VZ80_A16_WAITn_V_B when MODE_SOFTCPU_ZPUEVO = '1' and VZ80_BUSACKni = '0'
VZ80_HI_ADDR(16) <= VZ80_A16_WAITn_V_B when VZ80_BUSACKni = '0'
else '0';
VZ80_HI_ADDR(17) <= VZ80_A17_NMIn_V_COLR when MODE_SOFTCPU_ZPUEVO = '1' and VZ80_BUSACKni = '0'
VZ80_HI_ADDR(17) <= VZ80_A17_NMIn_V_COLR when VZ80_BUSACKni = '0'
else '0';
VZ80_HI_ADDR(18) <= VZ80_A18_INTn_V_R when MODE_SOFTCPU_ZPUEVO = '1' and VZ80_BUSACKni = '0'
VZ80_HI_ADDR(18) <= VZ80_A18_INTn_V_R when VZ80_BUSACKni = '0'
else '0';
VZ80_HI_ADDR(19) <= VZ80_A19_HALTn_V_VSYNCn when MODE_SOFTCPU_ZPUEVO = '1' and VZ80_BUSACKni = '0'
VZ80_HI_ADDR(19) <= VZ80_A19_HALTn_V_VSYNCn when VZ80_BUSACKni = '0'
else '0';
VZ80_HI_ADDR(20) <= VZ80_A20_RFSHn_V_HSYNCn when MODE_SOFTCPU_ZPUEVO = '1' and VZ80_BUSACKni = '0'
VZ80_HI_ADDR(20) <= VZ80_A20_RFSHn_V_HSYNCn when VZ80_BUSACKni = '0'
else '0';
VZ80_HI_ADDR(21) <= VWAITn_A21_V_CSYNC when MODE_SOFTCPU_ZPUEVO = '1' and VZ80_BUSACKni = '0'
VZ80_HI_ADDR(21) <= VWAITn_A21_V_CSYNC when VZ80_BUSACKni = '0'
else '0';
VZ80_HI_ADDR(22) <= '0';
VZ80_HI_ADDR(23) <= '0';

38
FPGA/SW700/v1.3/coreMZ_constraints.sdc
View File

@@ -64,25 +64,25 @@ derive_clock_uncertainty
set_input_delay -add_delay -clock [get_clocks {CLOCK_50}] 1.000 [get_ports {CLOCK_50}]
set_input_delay -add_delay -clock [get_clocks {VZ80_CLK}] 1.000 [get_ports {VZ80_CLK}]
set_input_delay -add_delay -clock [get_clocks {CLOCK_50}] 1.000 [get_ports {VIDEO_WRn}]
set_input_delay -add_delay -clock [get_clocks {CLOCK_50}] 1.000 [get_ports {VIDEO_RDn}]
set_input_delay -add_delay -clock [get_clocks {CLOCK_50}] 1.000 [get_ports {VZ80_WRn}]
set_input_delay -add_delay -clock [get_clocks {CLOCK_50}] 1.000 [get_ports {VZ80_RDn}]
set_input_delay -add_delay -clock [get_clocks {CLOCK_50}] 1.000 [get_ports {VZ80_IORQn}]
set_input_delay -add_delay -clock [get_clocks {CLOCK_50}] 1.000 [get_ports {VZ80_MREQn}]
set_input_delay -add_delay -clock [get_clocks {CLOCK_50}] 1.000 [get_ports {VZ80_M1n}]
set_input_delay -add_delay -clock [get_clocks {CLOCK_50}] 1.000 [get_ports {VZ80_ADDR[*]}]
set_input_delay -add_delay -clock [get_clocks {CLOCK_50}] 1.000 [get_ports {VZ80_DATA[*]}]
# set_input_delay -add_delay -clock [get_clocks {SYS_CLK}] 1.000 [get_ports {VGA_B_COMPOSITE}]
# set_input_delay -add_delay -clock [get_clocks {SYS_CLK}] 1.000 [get_ports {VGA_G_COMPOSITE}]
# set_input_delay -add_delay -clock [get_clocks {SYS_CLK}] 1.000 [get_ports {VGA_R_COMPOSITE}]
set_input_delay -add_delay -clock [get_clocks {CLOCK_50}] 1.000 [get_ports {VWAITn_A21_V_CSYNC}]
set_input_delay -add_delay -clock [get_clocks {CLOCK_50}] 1.000 [get_ports {VZ80_A20_RFSHn_V_HSYNCn}]
set_input_delay -add_delay -clock [get_clocks {CLOCK_50}] 1.000 [get_ports {VZ80_A19_HALTn_V_VSYNCn}]
set_input_delay -add_delay -clock [get_clocks {CLOCK_50}] 1.000 [get_ports {VZ80_BUSRQn_V_G}]
set_input_delay -add_delay -clock [get_clocks {CLOCK_50}] 1.000 [get_ports {VZ80_A16_WAITn_V_B}]
set_input_delay -add_delay -clock [get_clocks {CLOCK_50}] 1.000 [get_ports {VZ80_A18_INTn_V_R}]
set_input_delay -add_delay -clock [get_clocks {CLOCK_50}] 1.000 [get_ports {VZ80_A17_NMIn_V_COLR}]
set_input_delay -add_delay -clock [get_clocks {CLOCK_50}] 1.000 [get_ports {VIDEO_WRn}]
set_input_delay -add_delay -clock [get_clocks {CLOCK_50}] 1.000 [get_ports {VIDEO_RDn}]
set_input_delay -add_delay -clock [get_clocks {CLOCK_50}] 1.000 [get_ports {VZ80_WRn}]
set_input_delay -add_delay -clock [get_clocks {CLOCK_50}] 1.000 [get_ports {VZ80_RDn}]
set_input_delay -add_delay -clock [get_clocks {CLOCK_50}] 1.000 [get_ports {VZ80_IORQn}]
set_input_delay -add_delay -clock [get_clocks {CLOCK_50}] 1.000 [get_ports {VZ80_MREQn}]
set_input_delay -add_delay -clock [get_clocks {CLOCK_50}] 1.000 [get_ports {VZ80_M1n}]
set_input_delay -add_delay -clock [get_clocks {CLOCK_50}] 1.000 [get_ports {VZ80_ADDR[*]}]
set_input_delay -add_delay -clock [get_clocks {CLOCK_50}] 1.000 [get_ports {VZ80_DATA[*]}]
# set_input_delay -add_delay -clock [get_clocks {SYS_CLK}] 1.000 [get_ports {VGA_B_COMPOSITE}]
# set_input_delay -add_delay -clock [get_clocks {SYS_CLK}] 1.000 [get_ports {VGA_G_COMPOSITE}]
# set_input_delay -add_delay -clock [get_clocks {SYS_CLK}] 1.000 [get_ports {VGA_R_COMPOSITE}]
set_input_delay -add_delay -clock [get_clocks {CLOCK_50}] 1.000 [get_ports {VWAITn_A21_V_CSYNC}]
set_input_delay -add_delay -clock [get_clocks {CLOCK_50}] 1.000 [get_ports {VZ80_A20_RFSHn_V_HSYNCn}]
set_input_delay -add_delay -clock [get_clocks {CLOCK_50}] 1.000 [get_ports {VZ80_A19_HALTn_V_VSYNCn}]
set_input_delay -add_delay -clock [get_clocks {CLOCK_50}] 0.000 [get_ports {VZ80_BUSRQn_V_G}]
set_input_delay -add_delay -clock [get_clocks {CLOCK_50}] 1.000 [get_ports {VZ80_A16_WAITn_V_B}]
set_input_delay -add_delay -clock [get_clocks {CLOCK_50}] 1.000 [get_ports {VZ80_A18_INTn_V_R}]
set_input_delay -add_delay -clock [get_clocks {CLOCK_50}] 1.000 [get_ports {VZ80_A17_NMIn_V_COLR}]
# # Required for the Serial Flash Loader.
set_input_delay -add_delay -clock { altera_reserved_tck } 1.000 [get_ports {altera_reserved_tck}]
set_input_delay -add_delay -clock { altera_reserved_tck } 1.000 [get_ports {SFL_IV:\SERIALFLASHLOADER:SFL|altserial_flash_loader:altserial_flash_loader_component|\GEN_ASMI_TYPE_1:asmi_inst~ALTERA_DATA0}]

2
FPGA/SW700/v1.3/coreMZ_pkg.vhd
View File

@@ -64,7 +64,7 @@ package coreMZ_pkg is
-- Soft CPU's to embed in the core.
--
constant IMPL_SOFTCPU_Z80 : boolean := true;
constant IMPL_SOFTCPU_ZPUEVO : boolean := true;
constant IMPL_SOFTCPU_ZPUEVO : boolean := false;
------------------------------------------------------------
-- Function prototypes

434
FPGA/SW700/v1.3/softZPU/softZPU.vhd
View File

@@ -56,8 +56,13 @@ entity softZPU is
SW_CPUEN : in std_logic; -- Software controlled CPU enable.
-- Direct access to the video controller, bypassing the CPLD Memory management.
VIDEO_ADDR : out std_logic_vector(23 downto 0); -- Direct video controller addressing, bypass CPLD memory manager and operate at 32bits.
VIDEO_DATA_IN : in std_logic_vector(31 downto 0); -- Video controller to ZPU data in.
VIDEO_DATA_OUT : out std_logic_vector(31 downto 0); -- ZPU to Video controller data out.
VIDEO_WRn : out std_logic; -- Direct video write.
VIDEO_RDn : out std_logic; -- Direct video read.
VIDEO_WR_BYTE : out std_logic; -- Signal to indicate a byte should be written not a 32bit word.
VIDEO_WR_HWORD : out std_logic; -- Signal to indicate a 16bit half word should be written not a 32bit word.
-- External access to internal BRAM memory.
INT_MEM_DATA_IN : in std_logic_vector(WORD_32BIT_RANGE); -- Internal RAM block data to write to RAM.
@@ -85,7 +90,6 @@ entity softZPU is
ZPU80_HALTn : out std_logic; -- HALTn signal indicates that the CPU has executed a "HALT" instruction.
ZPU80_BUSACKn : out std_logic; -- BUSACKn signal indicates that the CPU address bus, data bus, and control signals have entered their HI-Z states, and that the external circuitry can now control these lines.
ZPU80_ADDR : out std_logic_vector(15 downto 0); -- 16 bit address lines.
ZPU80_HI_ADDR : out std_logic_vector(7 downto 0); -- Direct addressing of video memory (bypassing register configuration needed by Sharp MZ host to maintain compatibility or address space restrictions).
ZPU80_DATA_IN : in std_logic_vector(7 downto 0); -- 8 bit data bus in.
ZPU80_DATA_OUT : out std_logic_vector(7 downto 0); -- 8 bit data bus out.
@@ -139,15 +143,16 @@ architecture rtl of softZPU is
signal IO_WAIT_INTR : std_logic;
signal IO_WAIT_TIMER1 : std_logic;
signal IO_WAIT_Z80BUS : std_logic;
signal IO_WAIT_VIDEO : std_logic;
signal MEM_DATA_READ : std_logic_vector(WORD_32BIT_RANGE);
signal MEM_DATA_WRITE : std_logic_vector(WORD_32BIT_RANGE);
signal MEM_ADDR : std_logic_vector(ADDR_BIT_RANGE);
signal MEM_WRITE_ENABLE : std_logic;
signal MEM_WRITE_ENABLE_LAST : std_logic;
signal MEM_WRITE_ENABLE_LAST : std_logic_vector(2 downto 0);
signal MEM_WRITE_BYTE_ENABLE : std_logic;
signal MEM_WRITE_HWORD_ENABLE : std_logic;
signal MEM_READ_ENABLE : std_logic;
signal MEM_READ_ENABLE_LAST : std_logic;
signal MEM_READ_ENABLE_LAST : std_logic_vector(2 downto 0);
signal MEM_DATA_READ_INSN : std_logic_vector(WORD_64BIT_RANGE);
signal MEM_ADDR_INSN : std_logic_vector(ADDR_BIT_RANGE);
signal MEM_READ_ENABLE_INSN : std_logic;
@@ -194,6 +199,8 @@ architecture rtl of softZPU is
signal IO_INTR_SELECT : std_logic; -- Interrupt Range 0xFFFFFBxx
signal IO_TIMER_SELECT : std_logic; -- Timer Range 0xFFFFFCxx
signal Z80BUS_CS : std_logic; -- Z80 Bus select. The Z80 has a window within the ZPU system bus address space.
signal VIDEO_CS : std_logic; -- Video controller select.
signal VIDEO_8BIT_CS : std_logic; -- 8bit register region within the Video controller selection window is active.
signal INTR0_CS : std_logic; -- 0xB00-B0F
signal TIMER0_CS : std_logic; -- 0xC00-C0F Millisecond timer.
signal TIMER1_CS : std_logic; -- 0xC10-C1F
@@ -221,7 +228,8 @@ begin
if SYS_RESETn = '0' then
ZPU_RESET_COUNTER := (others => '1');
ZPU_RESETn <= '0';
MEM_READ_ENABLE_LAST <= '1';
MEM_READ_ENABLE_LAST <= (others => '0');
MEM_WRITE_ENABLE_LAST <= (others => '0');
else
if rising_edge(ZPU_CLK) then
@@ -246,8 +254,8 @@ begin
if falling_edge(ZPU_CLK) then
-- Edge detection for read/write signals. Most I/O operations need a read signal longer than 1 clock so BUSY needs to be asserted in order to prolong the read cycle.
--
MEM_READ_ENABLE_LAST <= MEM_READ_ENABLE;
MEM_WRITE_ENABLE_LAST <= MEM_WRITE_ENABLE;
MEM_READ_ENABLE_LAST <= MEM_READ_ENABLE_LAST(1 downto 0) & MEM_READ_ENABLE;
MEM_WRITE_ENABLE_LAST <= MEM_WRITE_ENABLE_LAST(1 downto 0) & MEM_WRITE_ENABLE;
end if;
end if;
end process;
@@ -292,7 +300,7 @@ begin
-- BRAM Range 0x00000000 - (2^SOC_MAX_ADDR_INSN_BRAM_BIT)-1
BRAM_SELECT <= '1' when (MEM_ADDR >= std_logic_vector(to_unsigned(SOC_ADDR_BRAM_START, MEM_ADDR'LENGTH)) and MEM_ADDR < std_logic_vector(to_unsigned(SOC_ADDR_BRAM_END, MEM_ADDR'LENGTH))) and MEM_BUSACKi = '0'
else
'1' when INT_MEM_ADDR(23 downto 20)= "0001" and MEM_BUSACKi = '1'
'1' when INT_MEM_ADDR(23 downto 17)= "0001000" and MEM_BUSACKi = '1'
else '0';
-- 24bit address bus, only a portion actually used for BRAM.
@@ -415,13 +423,15 @@ begin
MEM_BUSACK <= MEM_BUSACKi;
-- Force the CPU to wait when slower memory/IO is accessed and it cant deliver an immediate result.
MEM_BUSY <= '1' when SOC_IMPL_Z80BUS = true and ((Z80BUS_CS = '1' and MEM_READ_ENABLE_LAST = '0' and MEM_READ_ENABLE = '1') or IO_WAIT_Z80BUS = '1')
MEM_BUSY <= '1' when SOC_IMPL_Z80BUS = true and IO_WAIT_Z80BUS = '1' -- ((Z80BUS_CS = '1' and MEM_READ_ENABLE_LAST(0) = '0' and MEM_READ_ENABLE = '1') or IO_WAIT_Z80BUS = '1')
else
'1' when SOC_IMPL_INTRCTL = true and INTR0_CS = '1' and MEM_READ_ENABLE_LAST = '0' and MEM_READ_ENABLE = '1' and IO_WAIT_INTR = '1'
'1' when SOC_IMPL_INTRCTL = true and IO_WAIT_INTR = '1' -- INTR0_CS = '1' and MEM_READ_ENABLE_LAST(0) = '0' and MEM_READ_ENABLE = '1' and IO_WAIT_INTR = '1'
else
'1' when SOC_IMPL_TIMER1 = true and TIMER1_CS = '1' and MEM_READ_ENABLE_LAST = '0' and MEM_READ_ENABLE = '1' and IO_WAIT_TIMER1 = '1'
'1' when SOC_IMPL_TIMER1 = true and IO_WAIT_TIMER1 = '1' -- TIMER1_CS = '1' and MEM_READ_ENABLE_LAST(0) = '0' and MEM_READ_ENABLE = '1' and IO_WAIT_TIMER1 = '1'
else
'1' when SOC_IMPL_SOCCFG = true and SOCCFG_CS = '1' and MEM_READ_ENABLE_LAST = '0' and MEM_READ_ENABLE = '1'
-- '1' when SOC_IMPL_SOCCFG = true and SOCCFG_CS = '1' and MEM_READ_ENABLE_LAST(0) = '0' and MEM_READ_ENABLE = '1'
-- else
'1' when IO_WAIT_VIDEO = '1' -- (VIDEO_CS = '1' and MEM_READ_ENABLE_LAST(0) = '0' and MEM_READ_ENABLE = '1') --or IO_WAIT_VIDEO = '1'
else
'0';
@@ -432,6 +442,8 @@ begin
else
IO_DATA_READ_SOCCFG when SOC_IMPL_SOCCFG = true and SOCCFG_CS = '1'
else
VIDEO_DATA_IN when VIDEO_CS = '1'
else
Z80_DATA_IN when SOC_IMPL_Z80BUS = true and Z80BUS_CS = '1'
else
IO_DATA_READ when IO_SELECT = '1'
@@ -470,6 +482,155 @@ begin
else
DEBUG_TXD_IN;
-- Direct addressing Bus. Normally this is set to 0 during standard Sharp MZ operation, when 23:19 > 0 then direct addressing of the various video
-- memory's is enabled.
-- Address A23 -A16
-- 0x000000 00000000 - Normal Sharp MZ behaviour, Video Controller controlled by Z80 bus transactions.
-- 0x080000 00001000 - Memory and I/O ports mapped into direct addressable memory location.
--
-- A15 - A8 A7 - A0
-- I/O registers are mapped to the bottom 256 bytes mirroring the I/O address.
-- 0x0800D0 00000000 11010000 - 0xD0 - Set the parameter number to update.
-- 00000000 11010001 - 0xD1 - Update the lower selected parameter byte.
-- 00000000 11010010 - 0xD2 - Update the upper selected parameter byte.
-- 00000000 11010011 - 0xD3 - set the palette slot Off position to be adjusted.
-- 00000000 11010100 - 0xD4 - set the palette slot On position to be adjusted.
-- 00000000 11010101 - 0xD5 - set the red palette value according to the PALETTE_PARAM_SEL address.
-- 00000000 11010110 - 0xD6 - set the green palette value according to the PALETTE_PARAM_SEL address.
-- 0x0800D7 00000000 11010111 - 0xD7 - set the blue palette value according to the PALETTE_PARAM_SEL address.
--
-- 0x0800E0 00000000 11100000 - 0xE0 MZ80B PPI
-- 00000000 11100100 - 0xE4 MZ80B PIT
-- 0x0800E8 00000000 11101000 - 0xE8 MZ80B PIO
--
-- 00000000 11110000 -
-- 00000000 11110001 -
-- 00000000 11110010 -
-- 0x0800F3 00000000 11110011 - 0xF3 set the VGA border colour.
-- 00000000 11110100 - 0xF4 set the MZ80B video in/out mode.
-- 00000000 11110101 - 0xF5 sets the palette.
-- 00000000 11110110 - 0xF6 set parameters.
-- 00000000 11110111 - 0xF7 set the graphics processor unit commands.
-- 00000000 11111000 - 0xF6 set parameters.
-- 00000000 11111001 - 0xF7 set the graphics processor unit commands.
-- 00000000 11111010 - 0xF8 set the video mode.
-- 00000000 11111011 - 0xF9 set the graphics mode.
-- 00000000 11111100 - 0xFA set the Red bit mask
-- 00000000 11111101 - 0xFB set the Green bit mask
-- 00000000 11111110 - 0xFC set the Blue bit mask
-- 0x0800FD 00000000 11111111 - 0xFD set the Video memory page in block C000:FFFF
--
-- Memory registers are mapped to the E000 region as per base machines.
-- 0x08E010 11100000 00010010 - Program Character Generator RAM. E010 - Write cycle (Read cycle = reset memory swap).
-- 11100000 00010100 - Normal display select.
-- 11100000 00010101 - Inverted display select.
-- 11100010 00000000 - Scroll display register. E200 - E2FF
-- 0x08E2FF 11111111
--
-- 0x090000 00001001 - Video/Attribute RAM. 64K Window.
-- 0x09D000 11010000 00000000 - Video RAM
-- 0x09D7FF 11010111 11111111
-- 0x09D800 11011000 00000000 - Attribute RAM
-- 0x09DFFF 11011111 11111111
--
-- 0x0A0000 00001010 - Character Generator RAM 64K Window.
-- 0x0A0000 00000000 00000000 - CGROM
-- 0x0A0FFF 00001111 11111111
-- 0x0A1000 00010000 00000000 - CGRAM
-- 0x0A1FFF 00011111 11111111
--
-- 0x0C0000 00001100 - 128K Red framebuffer.
-- 00000000 00000000 - Red pixel addressed framebuffer. Also MZ-80B GRAM I memory in lower 8K
-- 0x0C3FFF 00111111 11111111
-- 0x0D0000 00001101 - 128K Blue framebuffer.
-- 00000000 00000000 - Blue pixel addressed framebuffer. Also MZ-80B GRAM II memory in lower 8K
-- 0x0D3FFF 00111111 11111111
-- 0x0E0000 00001110 - 128K Green framebuffer.
-- 00000000 00000000 - Green pixel addressed framebuffer.
-- 0x0E3FFF 00111111 11111111
--
VIDEO_CS <= '1' when MEM_ADDR(23 downto 19) = "11001" -- 512Kbyte address space, normally 0xC80000:CFFFFF - can expand down if needed.
else '0';
VIDEO_8BIT_CS <= '1' when MEM_ADDR(23 downto 16) = "11001000" -- 8 bit region of video controller where registers are accessed 8bit at a time for read operations.
else '0';
-- VIDEO_ADDR <= "00001000" & MEM_ADDR(17 downto 2) when VIDEO_8BIT_CS = '1' and VIDEO_RDn = '0' -- In the 8 bit region, reads are 32bit but the address is x4 so a shift right by 2 will yield a byte level address, 32bits will be return with the top 3 bytes zeroed.
-- else
-- "0000" & MEM_ADDR(19 downto 0);
-- VIDEO_DATA_OUT <= MEM_DATA_WRITE;
-- VIDEO_WRn <= '0' when (VIDEO_CS = '1' and MEM_WRITE_ENABLE = '1')
-- else '1';
-- VIDEO_RDn <= '0' when (VIDEO_CS = '1' and MEM_READ_ENABLE = '1')
-- else '1';
-- VIDEO_WR_BYTE <= MEM_WRITE_BYTE_ENABLE;
-- VIDEO_WR_HWORD <= MEM_WRITE_HWORD_ENABLE;
-- A process to match the timing requirements of the Video Controller, which in itself is trying to adapt between a variable low frequency (2-24MHz) multicycle
-- Z80 bus and the ZPU bus which runs at 75-100MHz and can complete in a single cycle.
--
process(ZPU_CLK, ZPU_RESETn)
variable IO_WAIT_VIDEO_CNT : unsigned(2 downto 0);
begin
if rising_edge(ZPU_CLK) then
if ZPU_RESETn = '0' then
IO_WAIT_VIDEO <= '0';
IO_WAIT_VIDEO_CNT := (others => '0');
VIDEO_RDn <= '1';
VIDEO_WRn <= '1';
VIDEO_WR_BYTE <= '0';
VIDEO_WR_HWORD <= '0';
else
-- On positive edge detection commence the transaction applying WAIT to the ZPU to accommodate the frequency and cycle mismatch.
-- Timing for 8 bit differs to the 32bit access.
if VIDEO_CS = '1' and ((MEM_READ_ENABLE_LAST = "001" and MEM_READ_ENABLE = '1') or (MEM_WRITE_ENABLE_LAST = "001" and MEM_WRITE_ENABLE = '1')) then
if VIDEO_8BIT_CS = '1' and MEM_READ_ENABLE = '1' then
VIDEO_ADDR <= "00001000" & MEM_ADDR(17 downto 2);
else
VIDEO_ADDR <= "0000" & MEM_ADDR(19 downto 0);
end if;
if MEM_WRITE_ENABLE = '1' then
VIDEO_DATA_OUT <= MEM_DATA_WRITE;
end if;
VIDEO_WR_BYTE <= MEM_WRITE_BYTE_ENABLE;
VIDEO_WR_HWORD <= MEM_WRITE_HWORD_ENABLE;
IO_WAIT_VIDEO <= '1';
if MEM_READ_ENABLE = '1' then
if VIDEO_8BIT_CS = '1' then
IO_WAIT_VIDEO_CNT := (others => '1');
else
IO_WAIT_VIDEO_CNT := to_unsigned(2, IO_WAIT_VIDEO_CNT'length);
end if;
VIDEO_RDn <= '0';
else
if VIDEO_8BIT_CS = '1' then
IO_WAIT_VIDEO_CNT := (others => '1');
else
IO_WAIT_VIDEO_CNT := to_unsigned(2, IO_WAIT_VIDEO_CNT'length);
end if;
VIDEO_WRn <= '0';
end if;
end if;
-- Reads terminate 1 cycle early so that the Video Controller can latch the output data before the ZPU reads it.
--
if IO_WAIT_VIDEO_CNT = 1 and VIDEO_RDn = '0' then
VIDEO_RDn <= '1';
end if;
-- At end of down count, reset all control signals and release ZPU from WAIT.
if IO_WAIT_VIDEO_CNT = 0 then
VIDEO_WRn <= '1';
VIDEO_RDn <= '1';
IO_WAIT_VIDEO <= '0';
end if;
-- IO Wait down counter. When not zero, we are in a WAIT state counting down.
if IO_WAIT_VIDEO_CNT /= 0 then
IO_WAIT_VIDEO_CNT := IO_WAIT_VIDEO_CNT - 1;
end if;
end if;
end if;
end process;
-- Z80 Bus Interface.
--
@@ -487,16 +648,7 @@ begin
-- byte on the Z80 address space. ie. 0x00780 ZPU = 0x0078 Z80.
--
-- Y+100000:Y+10FFFF = 64K address space on host mainboard (ie. RAM/ROM/Memory mapped I/O) accessed 4 bytes at a time, a 32 bit read will return 4 consecutive bytes,1start of read must be on a 32bit word boundary.
-- Y+180000:Y+1FFFFF = 512K Video address space - the video processor memory will be directly mapped into this space as follows:
-- 0x180000 - 0x187FFF = 32K Video RAM
-- 0x188000 - 0x18FFFF = 32K Video Attribute RAM
-- 0x190000 - 0x19FFFF = 64K Character Generator ROM/PCG RAM.
-- 0x1A0000 - 0x1BFFFF = 128K Red Framebuffer address space.
-- 0x1C0000 - 0x1DFFFF = 128K Blue Framebuffer address space.
-- 0x1E0000 - 0x1FFFFF = 128K Green Framebuffer address space.
-- This invokes memory read/write operations but the Video Read/Write signal is directly set, MREQ is not set. This
-- allows direct writes to be made to the FPGA video logic, bypassing the CPLD memory manager.
-- All reads are 32bit, writes are 8, 16 or 32bit wide on word boundary.
-- Y+180000:Y+1FFFFF = 512K unassigned.
--
-- Y = 2Mbyte sector in ZPU address space the Z80 bus interface is located. This is normally below the ZPU I/O sector and set to 0xExxxxx
--
@@ -539,9 +691,6 @@ begin
signal Z80_WRITE_BYTE : std_logic; -- Z80 writing 1 byte.
signal Z80_WRITE_HWORD : std_logic; -- Z80 writing 2 bytes.
signal Z80_BUS_HOST_ACCESS : std_logic; -- Z80 to access underlying HOST mainboard hardware. Default is to access tranZPUter hardware.
signal Z80_BUS_VIDEO_ADDR : std_logic_vector(7 downto 0); -- Upper address for direct access to video memory.
signal Z80_BUS_VIDEO_WRITE : std_logic; -- Z80 to write direct to FPGA video, non-standard bus transaction.
signal Z80_BUS_VIDEO_READ : std_logic; -- Z80 to read direct from FPGA video, non-standard bus transaction.
signal Z80_BUS_MREQn : std_logic; -- MREQn signal indicates that the address bus holds a valid address for reading or writing memory.
signal Z80_BUS_IORQn : std_logic; -- IORQn signal indicates that the address bus (A0-A7) holds a valid address for reading or writing and I/O device.
signal Z80_BUS_RDn : std_logic; -- RDn signal indicates that data is ready to be read from a memory or I/O device to the CPU.
@@ -552,6 +701,7 @@ begin
signal Z80_BYTE_COUNT : integer range 0 to 4; -- Count of bytes in a transaction, 1 byte, half-word (2 bytes) or 32bit word (4 bytes).
signal Z80_BYTE_ADDR : unsigned(1 downto 0); -- Lower address bits to accommodate 1, 2 or 4 byte read/writes.
signal Z80_BUS_XACT : Z80BusStateType; -- Transaction to perform.
signal Z80_BUS_XACT_FULLSPEED: std_logic; -- Perform transaction at full CPU clock speed rather than the Z80 clock speed.
signal Z80BusFSMState : Z80BusStateType; -- Running FSM state.
begin
@@ -567,20 +717,19 @@ begin
-- ASYNCHRONOUS RESET --
------------------------
if ZPU_RESETn='0' then
Z80_BUS_MREQn <= '1'; -- MREQn signal indicates that the address bus holds a valid address for reading or writing memory.
Z80_BUS_IORQn <= '1'; -- IORQn signal indicates that the address bus (A0-A7) holds a valid address for reading or writing and I/O device.
Z80_BUS_RDn <= '1'; -- RDn signal indicates that data is ready to be read from a memory or I/O device to the CPU.
Z80_BUS_WRn <= '1'; -- WRn signal indicates that data is going to be written from the CPU data bus to a memory or I/O device.
Z80_BUS_M1n <= '1'; -- M1n Machine Cycle 1 signal. M1 and MREQ active = opcode fetch, M1 and IORQ active = interrupt, vector can be read from D0-D7. M1n is used in this module as a flag to the CPLD to latch the upper address bits or enable host mainboard access.
Z80_BUS_BUSACKn <= '0'; -- Bus request acknowledge, becomes active when the Z80 component of the FSM is idle and BUSRQ is asserted or during RESET.
Z80_BUS_DATA_OUT <= (others => '0'); -- 8 bit data bus out.
IO_WAIT_Z80BUS <= '0'; -- Flag to force the ZPU to wait during Z80 transactions, the Z80 Bus is slower and 8 bit.
VIDEO_WRn <= '1'; -- Signal to write directly to the FPGA video rather than going via the CPLD.
VIDEO_RDn <= '1'; -- Signal to read directly from the FPGA video rather than going via the CPLD.
Z80_START_XACT <= '0';
Z80_XACT_RUN <= '0';
Z80_CLK_EDGE <= (others => '0'); -- Z80 clock edge detection.
Z80BusFSMState <= State_IDLE;
Z80_BUS_MREQn <= '1'; -- MREQn signal indicates that the address bus holds a valid address for reading or writing memory.
Z80_BUS_IORQn <= '1'; -- IORQn signal indicates that the address bus (A0-A7) holds a valid address for reading or writing and I/O device.
Z80_BUS_RDn <= '1'; -- RDn signal indicates that data is ready to be read from a memory or I/O device to the CPU.
Z80_BUS_WRn <= '1'; -- WRn signal indicates that data is going to be written from the CPU data bus to a memory or I/O device.
Z80_BUS_M1n <= '1'; -- M1n Machine Cycle 1 signal. M1 and MREQ active = opcode fetch, M1 and IORQ active = interrupt, vector can be read from D0-D7. M1n is used in this module as a flag to the CPLD to latch the upper address bits or enable host mainboard access.
Z80_BUS_BUSACKn <= '1'; -- Bus request acknowledge, becomes active when the Z80 component of the FSM is idle and BUSRQ is asserted or during RESET.
Z80_BUS_DATA_OUT <= (others => '0'); -- 8 bit data bus out.
IO_WAIT_Z80BUS <= '0'; -- Flag to force the ZPU to wait during Z80 transactions, the Z80 Bus is slower and 8 bit.
Z80_START_XACT <= '0';
Z80_BUS_XACT_FULLSPEED <= '0'; -- Perform the Z80 bus transaction at the CPU speed not the Z80 speed.
Z80_XACT_RUN <= '0';
Z80_CLK_EDGE <= (others => '0'); -- Z80 clock edge detection.
Z80BusFSMState <= State_IDLE;
-----------------------
-- RISING CLOCK EDGE --
@@ -609,11 +758,11 @@ begin
end if;
-- If the bus is requested, wait until the Z80 bus FSM is idle then halt operations.
if Z80_START_XACT = '0' and Z80_XACT_RUN = '0' and (MEM_WRITE_ENABLE = '1' or MEM_READ_ENABLE = '1') and Z80BUS_CS = '1' and ZPU80_BUSRQn = '0' then
if Z80_START_XACT = '0' and Z80_XACT_RUN = '0' and ZPU80_BUSRQn = '0' then
Z80_BUS_BUSACKn <= '0';
-- Start a Z80 BUS Read or Write?
elsif Z80_START_XACT = '0' and Z80_XACT_RUN = '0' and (MEM_WRITE_ENABLE = '1' or MEM_READ_ENABLE = '1') and Z80BUS_CS = '1' and Z80_BUS_BUSACKn = '1' then
elsif Z80_START_XACT = '0' and Z80_XACT_RUN = '0' and ((MEM_WRITE_ENABLE_LAST = "001" and MEM_WRITE_ENABLE = '1') or (MEM_READ_ENABLE_LAST = "001" and MEM_READ_ENABLE = '1')) and Z80BUS_CS = '1' and Z80_BUS_BUSACKn = '1' then
-- Halt the ZPU, Z80 transactions take a lot more time.
IO_WAIT_Z80BUS <= '1';
@@ -630,11 +779,9 @@ begin
-- Preset signals.
--
Z80_BUS_VIDEO_WRITE <= '0';
Z80_BUS_VIDEO_READ <= '0';
Z80_BUS_VIDEO_ADDR <= "00000000";
Z80_BUS_HOST_ACCESS <= '0';
Z80_START_XACT <= '1';
Z80_BUS_XACT_FULLSPEED <= '0';
-- Depending on the accessed address will determine the type of transaction. In order to provide byte level access on a 32bit read CPU, a bank of addresses, word aligned per byte is assigned in addition to
-- an address to read 32bit word aligned value.
@@ -667,6 +814,7 @@ begin
else
Z80_BUS_XACT <= State_MEM_READ;
end if;
Z80_BUS_XACT_FULLSPEED <= '1';
-- Y+080000:Y+0BFFFF - Access to host mainboard 64K address space. Due to 32bit mapping, address is shifted right by 2, so each byte on the mainboard is accessed as a 32bit word in the ZPU.
elsif MEM_ADDR(maxZ80BusBit+1 downto maxZ80BusBit-2) = "0110" then
@@ -686,6 +834,7 @@ begin
Z80_ADDR <= "00000" & MEM_ADDR(20 downto 2);
Z80_BUS_XACT <= State_IO_BYTE_READ;
end if;
Z80_BUS_HOST_ACCESS <= '1';
-- Y+100000:Y+10FFFF - Access to 64K on mainboard, accessed 32bit at a time (via 4x Z80 transactions as needed).
elsif MEM_ADDR(maxZ80BusBit+1 downto maxZ80BusBit-4) = "100000" then
@@ -696,124 +845,16 @@ begin
end if;
Z80_BUS_HOST_ACCESS <= '1';
-- Video Controller direct access, bypasses the CPLD memory manager.
--
-- Address A23 -A16
-- Y+0x000000 00000000 - Normal Sharp MZ behaviour
-- Y+0x080000 00001001 - Memory and I/O ports mapped into direct addressable memory location.
--
-- A15 - A8 A7 - A0
-- I/O registers are mapped to the bottom 256 bytes mirroring the I/O address.
-- Y+0x0800D0 00000000 11010000 - 0xD0 - Set the parameter number to update.
-- 00000000 11010001 - 0xD1 - Update the lower selected parameter byte.
-- 00000000 11010010 - 0xD2 - Update the upper selected parameter byte.
-- 00000000 11010011 - 0xD3 - set the palette slot Off position to be adjusted.
-- 00000000 11010100 - 0xD4 - set the palette slot On position to be adjusted.
-- 00000000 11010101 - 0xD5 - set the red palette value according to the PALETTE_PARAM_SEL address.
-- 00000000 11010110 - 0xD6 - set the green palette value according to the PALETTE_PARAM_SEL address.
-- Y+0x0800D7 00000000 11010111 - 0xD7 - set the blue palette value according to the PALETTE_PARAM_SEL address.
--
-- Y+0x0800E0 00000000 11100000 - 0xE0 MZ80B PPI
-- 00000000 11100100 - 0xE4 MZ80B PIT
-- Y+0x0800E8 00000000 11101000 - 0xE8 MZ80B PIO
--
-- 00000000 11110000 -
-- 00000000 11110001 -
-- 00000000 11110010 -
-- Y+0x0800F3 00000000 11110011 - 0xF3 set the VGA border colour.
-- 00000000 11110100 - 0xF4 set the MZ80B video in/out mode.
-- 00000000 11110101 - 0xF5 sets the palette.
-- 00000000 11110110 - 0xF6 set parameters.
-- 00000000 11110111 - 0xF7 set the graphics processor unit commands.
-- 00000000 11111000 - 0xF6 set parameters.
-- 00000000 11111001 - 0xF7 set the graphics processor unit commands.
-- 00000000 11111010 - 0xF8 set the video mode.
-- 00000000 11111011 - 0xF9 set the graphics mode.
-- 00000000 11111100 - 0xFA set the Red bit mask
-- 00000000 11111101 - 0xFB set the Green bit mask
-- 00000000 11111110 - 0xFC set the Blue bit mask
-- Y+0x0800FD 00000000 11111111 - 0xFD set the Video memory page in block C000:FFFF
--
-- Memory registers are mapped to the E000 region as per base machines.
-- Y+0x08E010 11100000 00010010 - Program Character Generator RAM. E010 - Write cycle (Read cycle = reset memory swap).
-- 11100000 00010100 - Normal display select.
-- 11100000 00010101 - Inverted display select.
-- 11100010 00000000 - Scroll display register. E200 - E2FF
-- Y+0x08E2FF 11111111
--
-- Y+0x090000 00001010 - Video/Attribute RAM. 64K Window.
-- Y+0x09D000 11010000 00000000 - Video RAM
-- Y+0x09D7FF 11010111 11111111
-- Y+0x09D800 11011000 00000000 - Attribute RAM
-- Y+0x09DFFF 11011111 11111111
--
-- Y+0x0A0000 00001011 - Character Generator RAM
-- Y+0x0A0000 00000000 00000000 - CGROM
-- Y+0x0A0FFF 00001111 11111111
-- Y+0x0A1000 00010000 00000000 - CGRAM
-- Y+0x0A1FFF 00011111 11111111
--
-- Y+0x0C0000 00001100 - Red framebuffer.
-- 00000000 00000000 - Red pixel addressed framebuffer. Also MZ-80B GRAM I memory in lower 8K
-- Y+0x0C3FFF 00111111 11111111
-- Y+0x0D0000 00001101 - Blue framebuffer.
-- 00000000 00000000 - Blue pixel addressed framebuffer. Also MZ-80B GRAM II memory in lower 8K
-- Y+0x0D3FFF 00111111 11111111
-- Y+0x0E0000 00001110 - Green framebuffer.
-- 00000000 00000000 - Green pixel addressed framebuffer.
-- Y+0x0E3FFF 00111111 11111111
--
else
if MEM_WRITE_ENABLE = '1' then
Z80_BUS_XACT <= State_MEM_WRITE;
Z80_BUS_VIDEO_WRITE <= '1';
else
Z80_BUS_XACT <= State_MEM_READ;
Z80_BUS_VIDEO_READ <= '1';
end if;
-- 128K Red frame buffer. Y + 0x1A0000:0x1BFFFF
if MEM_ADDR(maxZ80BusBit+1 downto maxZ80BusBit-3) = "10101" then
Z80_BUS_VIDEO_ADDR <= "00001100";
-- 128K Blue frame buffer. Y + 0x1C0000:0x1DFFFF
elsif MEM_ADDR(maxZ80BusBit+1 downto maxZ80BusBit-3) = "10110" then
Z80_BUS_VIDEO_ADDR <= "00001101";
-- 128K Green frame buffer. Y + 0x1E0000:0x1FFFFF
elsif MEM_ADDR(maxZ80BusBit+1 downto maxZ80BusBit-3) = "10111" then
Z80_BUS_VIDEO_ADDR <= "00001110";
-- Video / Attribute RAM. Y + 0x180000:0x18FFFF
elsif MEM_ADDR(maxZ80BusBit+1 downto maxZ80BusBit-4) = "101000" then
Z80_BUS_VIDEO_ADDR <= "00001001";
-- Character Generator RAM. Y + 0x190000:0x19FFFF
elsif MEM_ADDR(maxZ80BusBit+1 downto maxZ80BusBit-4) = "101001" then
Z80_BUS_VIDEO_ADDR <= "00001010";
-- I/O registers - 64K 8bit video address space accessed 32bits per read (ie 4x sequential address read) and 1,2 or x4 sequential byte write. Y + 0x130000:0x13FFFF
elsif MEM_ADDR(maxZ80BusBit+1 downto maxZ80BusBit-4) = "100011" then
Z80_BUS_VIDEO_ADDR <= "00001000";
-- I/O registers mirror - 64K 8bit video address space occupying 256K address ZPU address space due to 32bit read requirements. Y + 0x140000:0x17FFFF
elsif MEM_ADDR(maxZ80BusBit+1 downto maxZ80BusBit-2) = "1001" then
if MEM_READ_ENABLE = '1' then
Z80_BUS_XACT <= State_MEM_BYTE_READ;
end if;
Z80_BUS_VIDEO_ADDR <= "00001000";
Z80_ADDR(15 downto 0) <= MEM_ADDR(17 downto 2);
else
null;
end if;
Z80_BUS_XACT <= State_IDLE;
Z80_START_XACT <= '0';
IO_WAIT_Z80BUS <= '0';
end if;
end if;
-- Z80 bus domain. Run at the frequency of the hard or soft Z80 to correctly emulate a Z80 bus transaction.
-- Z80 bus domain. Run according to transaction target, either full speed or at the frequency of the hard/soft Z80 to correctly emulate a Z80 bus transaction.
--
if Z80_CLK_EDGE = "001" and Z80_CLK = '1' then
if Z80_BUS_XACT_FULLSPEED = '1' or (Z80_CLK_EDGE = "001" and Z80_CLK = '1') then
-- Edge detection of completion flag.
Z80_XACT_RUN_LAST <= Z80_XACT_RUN;
@@ -848,13 +889,12 @@ begin
Z80_BUS_DATA_OUT <= Z80_BUS_HOST_ACCESS & "0000000";
Z80_BUS_M1n <= '1';
else
Z80_BUS_DATA_OUT <= Z80_ADDR(23 downto 16);
Z80_BUS_DATA_OUT <= (others => '0'); --Z80_ADDR(23 downto 16);
Z80_BUS_M1n <= '0';
end if;
Z80_BUS_MREQn <= '0';
Z80_BUS_IORQn <= '0';
Z80_XACT_RUN <= '1';
ZPU80_HI_ADDR <= Z80_BUS_VIDEO_ADDR;
Z80_DATA_IN <= (others => '0');
Z80BusFSMState <= State_SETUP;
end if;
@@ -874,20 +914,13 @@ begin
Z80_BUS_M1n <= '1';
Z80_BUS_RDn <= '1';
Z80_BUS_WRn <= '1';
VIDEO_WRn <= '1';
VIDEO_RDn <= '1';
Z80BusFSMState <= Z80_BUS_XACT;
-- Read sets signals on 1st transaction clock edge.
when State_MEM_READ =>
if Z80_BUS_VIDEO_READ = '1' then
VIDEO_RDn <= '0';
Z80BusFSMState <= State_MEM_READ_2;
else
Z80_BUS_MREQn <= '0';
Z80_BUS_RDn <= '0';
Z80BusFSMState <= State_MEM_READ_2;
end if;
Z80_BUS_MREQn <= '0';
Z80_BUS_RDn <= '0';
Z80BusFSMState <= State_MEM_READ_2;
-- Detect and insert wait states.
when State_MEM_READ_1 =>
@@ -897,12 +930,8 @@ begin
-- End of read cycle we sample and store data.
when State_MEM_READ_2 =>
if Z80_BUS_VIDEO_READ = '1' then
VIDEO_RDn <= '1';
else
Z80_BUS_MREQn <= '1';
Z80_BUS_RDn <= '1';
end if;
Z80_BUS_MREQn <= '1';
Z80_BUS_RDn <= '1';
-- Shift the data in, so if we are reading more than 1 byte, it is in the correct endian location.
--Z80_DATA_IN <= ZPU80_DATA_IN & Z80_DATA_IN(31 downto 8);
@@ -911,7 +940,7 @@ begin
if Z80_BYTE_COUNT > 1 then
Z80_BYTE_COUNT <= Z80_BYTE_COUNT -1;
Z80_BYTE_ADDR <= Z80_BYTE_ADDR + 1;
Z80BusFSMState <= State_SETUP;
Z80BusFSMState <= Z80_BUS_XACT;
else
Z80BusFSMState <= State_IDLE;
Z80_XACT_RUN <= '0';
@@ -919,14 +948,9 @@ begin
-- Read sets signals on 1st transaction clock edge.
when State_MEM_BYTE_READ =>
if Z80_BUS_VIDEO_READ = '1' then
VIDEO_RDn <= '0';
Z80BusFSMState <= State_MEM_BYTE_READ_1;
else
Z80_BUS_MREQn <= '0';
Z80_BUS_RDn <= '0';
Z80BusFSMState <= State_MEM_BYTE_READ_2;
end if;
Z80_BUS_MREQn <= '0';
Z80_BUS_RDn <= '0';
Z80BusFSMState <= State_MEM_BYTE_READ_2;
-- Detect and insert wait states.
when State_MEM_BYTE_READ_1 =>
@@ -936,12 +960,8 @@ begin
-- End of read cycle we sample and store data.
when State_MEM_BYTE_READ_2 =>
if Z80_BUS_VIDEO_READ = '1' then
VIDEO_RDn <= '1';
else
Z80_BUS_MREQn <= '1';
Z80_BUS_RDn <= '1';
end if;
Z80_BUS_MREQn <= '1';
Z80_BUS_RDn <= '1';
-- Single byte appears in bits 7:0
Z80_DATA_IN <= X"000000" & ZPU80_DATA_IN;
@@ -951,9 +971,7 @@ begin
-- Write activates MREQ and prepares data on the bus.
-- Mechanism setup to write MSB Big Endian.
when State_MEM_WRITE =>
if Z80_BUS_VIDEO_WRITE = '0' then
Z80_BUS_MREQn <= '0';
end if;
Z80_BUS_MREQn <= '0';
Z80BusFSMState <= State_MEM_WRITE_1;
case to_integer(Z80_BYTE_ADDR) is
@@ -984,26 +1002,18 @@ begin
-- Activate Write and detect and insert wait states.
when State_MEM_WRITE_1 =>
if Z80_BUS_VIDEO_WRITE = '1' then
VIDEO_WRn <= '0';
else
Z80_BUS_WRn <= '0';
end if;
-- if ZPU80_WAITn = '1' or Z80_BUS_VIDEO_WRITE = '1' then
Z80_BUS_WRn <= '0';
-- if ZPU80_WAITn = '1' or Z80_BUS_VIDEO_WRITE = '1' then
Z80BusFSMState <= State_MEM_WRITE_2;
-- end if;
-- end if;
when State_MEM_WRITE_2 =>
if Z80_BUS_VIDEO_WRITE = '1' then
VIDEO_WRn <= '1';
else
Z80_BUS_MREQn <= '1';
Z80_BUS_WRn <= '1';
end if;
Z80_BUS_MREQn <= '1';
Z80_BUS_WRn <= '1';
if Z80_BYTE_COUNT > 1 then
Z80_BYTE_COUNT <= Z80_BYTE_COUNT -1;
Z80_BYTE_ADDR <= Z80_BYTE_ADDR + 1;
Z80BusFSMState <= State_SETUP;
Z80BusFSMState <= Z80_BUS_XACT;
else
Z80BusFSMState <= State_IDLE;
Z80_XACT_RUN <= '0';
@@ -1036,7 +1046,7 @@ begin
if Z80_BYTE_COUNT > 1 then
Z80_BYTE_COUNT <= Z80_BYTE_COUNT -1;
Z80_BYTE_ADDR <= Z80_BYTE_ADDR + 1;
Z80BusFSMState <= State_SETUP;
Z80BusFSMState <= Z80_BUS_XACT;
else
Z80BusFSMState <= State_IDLE;
Z80_XACT_RUN <= '0';
@@ -1054,9 +1064,9 @@ begin
-- Detect and insert further wait states.
when State_IO_BYTE_READ_2 =>
-- if ZPU80_WAITn = '1' then
if ZPU80_WAITn = '1' then
Z80BusFSMState <= State_IO_BYTE_READ_3;
-- end if;
end if;
-- End of read cycle we sample and store data.
when State_IO_BYTE_READ_3 =>
@@ -1106,9 +1116,9 @@ begin
-- Insert automatic wait state for IO operations.
when State_IO_WRITE_2 =>
-- if ZPU80_WAITn = '1' then
if ZPU80_WAITn = '1' then
Z80BusFSMState <= State_IO_WRITE_3;
-- end if;
end if;
when State_IO_WRITE_3 =>
Z80_BUS_IORQn <= '1';
@@ -1116,7 +1126,7 @@ begin
if Z80_BYTE_COUNT > 0 then
Z80_BYTE_COUNT <= Z80_BYTE_COUNT -1;
Z80_BYTE_ADDR <= Z80_BYTE_ADDR + 1;
Z80BusFSMState <= State_SETUP;
Z80BusFSMState <= Z80_BUS_XACT;
else
Z80BusFSMState <= State_IDLE;
Z80_XACT_RUN <= '0';

2196
TRANZPUTER_SW_700_README.md Normal file
View File

File diff suppressed because it is too large Load Diff

2
cpu/zpu_core_evo.vhd
View File

@@ -703,7 +703,7 @@ begin
mxNOS.valid <= '0';
-- Memory signals are one clock width wide unless extended by a wait, if no wait, reset them to inactive to ensure this.
if MEM_BUSY = '0' then
if MEM_BUSY = '0' and mxHoldCycles = 0 then
MEM_READ_ENABLE <= '0';
MEM_WRITE_ENABLE <= '0';

108294
devices/sysbus/BRAM/TZSW_DualPortBootBRAM.vhd
View File

File diff suppressed because it is too large Load Diff

108294
devices/sysbus/BRAM/TZSW_SinglePortBootBRAM.vhd
View File

File diff suppressed because it is too large Load Diff

156
software/BAS/BACCRRT.bas
View File

@@ -1,156 +0,0 @@
100 REM (SOURCE UNKNOWN) EDITED SLIGHTLY BY D. KURLAND 11/6/75
110 PRINT "WELCOME TO CASINO UNIVAC 1108"
120 PRINT "THE GAME IS BACCARAT"
130 H=0
140 GOSUB 1400
150 DIM A(10),C(10)
160 PRINT "ARE YOU READY";
170 INPUT X$
180 IF X$="NO" OR X$="N" THEN 1390
190 PRINT "WAGER";
200 D=0
210 E=0
220 INPUT G
230 IF G>100000! THEN 1370
240 IF G>0 THEN 270
250 PRINT "HA!HA!, VERY FUNNY!!"
260 GOTO 190
270 B=1
280 GOTO 740
290 A(B)=INT(RND(1)*52)+1
300 C(B)=A(B)-13*INT(A(B)/13)
310 IF C(B)=0 THEN 600
320 ON C(B)GOTO330,350,370,390,410,430,450,470,490,510,540,570
330 PRINT "ACE ";
340 GOTO 620
350 PRINT "DEUCE ";
360 GOTO 620
370 PRINT "THREE ";
380 GOTO 620
390 PRINT "FOUR ";
400 GOTO 620
410 PRINT "FIVE ";
420 GOTO 620
430 PRINT "SIX ";
440 GOTO 620
450 PRINT "SEVEN ";
460 GOTO 620
470 PRINT "EIGHT ";
480 GOTO 620
490 PRINT "NINE ";
500 GOTO 620
510 PRINT "TEN ";
520 C(B)=0
530 GOTO 620
540 PRINT "JACK ";
550 C(B)=0
560 GOTO 620
570 PRINT "QUEEN ";
580 C(B)=0
590 GOTO 620
600 PRINT "KING ";
610 C(B)=0
620 IF INT(A(B)/13)<>A(B)/13 THEN 640
630 ON A(B)/13 GOTO 660,680,700,720
640 IF INT(A(B)/13)=0 THEN 660
650 ON INT(A(B)/13)GOTO 680,700,720
660 PRINT "OF CLUBS"
670 RETURN
680 PRINT "OF DIAMONDS"
690 RETURN
700 PRINT "OF SPADES"
710 RETURN
720 PRINT "OF HEARTS"
730 RETURN
740 PRINT "YOUR FIRST CARD IS A ";
750 GOSUB 290
760 GOSUB 1310
770 PRINT "YOUR NEXT CARD IS A ";
780 GOSUB 290
790 GOSUB 1310
800 PRINT "DO YOU WANT A CARD";
810 INPUT J$
820 IF J$="YES" OR J$="Y" THEN 870
830 C(3)=0
840 D=D+C(B)
850 B=B+1
860 GOTO 900
870 PRINT "THE CARD IS A ";
880 GOSUB290
890 GOSUB 1310
900 PRINT "MY FIRST CARD IS A ";
910 GOSUB 290
920 GOSUB 1340
930 PRINT "MY NEXT CARD IS A ";
940 GOSUB 290
950 GOSUB 1340
960 IF E<10 THEN 990
970 E=E-10
980 GOTO 960
990 IF E<6 THEN 1030
1000 PRINT "I DO NOT WANT A CARD"
1010 C(6)=0
1020 GOTO 1060
1030 PRINT "I TAKE CARD"
1040 PRINT "THE CARD IS A ";
1050 GOSUB 290
1060 E=E+C(6)
1070 IF D<10 THEN 1100
1080 D=D-10
1090 GOTO 1070
1100 PRINT "YOUR TOTAL IS";D
1110 IF E<10 THEN 1140
1120 E=E-10
1130 GOTO 1110
1140 PRINT "MY TOTAL IS ";E
1150 IF D=E THEN 1590
1160 IF D>E THEN 1200
1170 PRINT "I WIN $"G
1180 G=-G
1190 GOTO 1210
1200 PRINT "YOU WIN $";G
1210 H=H+G
1220 IF H>0 THEN 1290
1230 IF H=0 THEN 1610
1240 PRINT "YOU OWE ME $";-H
1250 PRINT "DO YOU WANT TO TRY AGAIN";
1260 INPUT K$
1270 IF K$="NO" OR K$="N" THEN 1390
1280 GOTO 190
1290 PRINT "I.O.U. $";H
1300 GOTO 1250
1310 D=D+C(B)
1320 B=B+1
1330 RETURN
1340 E=E+C(B)
1350 B=B+1
1360 RETURN
1370 PRINT "HOUSE LIMIT IS $100000"
1380 GOTO190
1390 STOP
1400 PRINT "DO YOU WANT THE RULES OF THE GAME";
1410 INPUT I$
1420 IF I$="NO" OR I$="N" THEN RETURN
1430 PRINT "* OFFICIAL RULES FOR THE GAME OF BACCARAT *"
1440 PRINT "THE COMPUTER IS SHUFFLING SIX DECKS OF CARDS"
1450 PRINT "TOGETHER. THE RULES ARE AS FOLLOWS: THE OBJECT"
1460 PRINT "IS TO BE AS CLOSE TO POSSIBLE TO NINE IN TWO"
1470 PRINT "OR THREE CARDS, FACE CARDS AND TENS COUNT ZERO"
1480 PRINT "ACES COUNT AS ONE EACH,ALL OTHER CARDS COUNT"
1490 PRINT "THEIR INDEX VALUE. WHEN THE TOTAL IS OVER TEN"
1500 PRINT "THE TENS UNIT IS DROPPED. EXAMPLE: A SEVEN AND"
1510 PRINT "A SIX TOTALING THIRTEEN COUNT AS THREE. THE"
1520 PRINT "PLAYER WITH THE HIGHER TOTAL WINS. IN CASE OF"
1530 PRINT "A TIE THE COMPUTER WINS. "
1540 PRINT "DO YOU UNDERSTAND THE RULES";
1550 INPUT O$
1560 IF O$="YES" OR O$="Y" THEN RETURN
1570 PRINT "TOUGH LUCK"
1580 RETURN
1590 PRINT "IT IS A TIE. THE COMPUTER WINS!"
1600 GOTO 1170
1610 PRINT "YOU ARE EVEN-UP !!"
1620 GOTO1250
1630 END
N
1590 PRINT "I

555
software/BAS/BASEBALL.bas
View File

@@ -1,555 +0,0 @@
100 REM BASEBALL SIMULATION PROGRAM
110 REM WRITTEN BY JOEL LIND & KEN BIRKMAN - NYU - JULY 1973
120 REM STOLEN AND ENHANCED DECEMBER 1973 BY R. D. KURLAND - NYU
130 DIM B(7),P$(9),W$(7),J$(8),K$(4)
140 FOR I=1 TO 7: B(I)=0:NEXT
150 B=0:T9=0:R9=0:S=0:O=0:B1=0:B2=0:T=0
160 Z1=1:Z2=1
170 PRINT "WELCOME TO EBBETT'S FIELD"
180 PRINT "WHAT DO YOU WANT TO CALL YOUR TEAM";
190 INPUT A$
200 FOR I=1 TO 7:READ W$(I):NEXT
210 FOR I=1 TO 9:READ P$(I):NEXT
220 FOR I=1 TO 4:READ K$(I):NEXT
230 FOR I=1 TO 8:READ J$(I):NEXT
240 PRINT "FINE. THE ";A$;" NEED A MANAGER. WHAT'S YOUR NAME";
250 INPUT B$
260 PRINT "WHAT DO YOU WANT TO CALL MY TEAM, ";B$;
270 INPUT C$
280 PRINT
290 PRINT "OPENING DAY, THE ";A$;" VERSUS THE ";C$
300 PRINT
310 PRINT "LET'S FLIP A COIN. THE WINNER IS THE HOME TEAM."
320 PRINT "HEADS OR TAILS";
330 INPUT D$
340 IF D$<>"HEADS" AND D$<>"TAILS" THEN 320
350 FOR I=1 TO TYM
360 Y=RND(1)
370 NEXT I
380 H=1
390 Y=RND(1)
400 Y$="HEADS"
410 IF Y>.5 THEN Y$="TAILS"
420 IF D$=Y$ THEN 490
430 H=0
440 PRINT "YOU LOST THE TOSS. THE ";A$;" ARE UP FIRST."
450 PRINT
460 PRINT
470 A=0
480 GOTO 610
490 PRINT "YOU WIN THE TOSS. ";A$;" TAKE THE FIELD, AND ";
500 PRINT C$;" ARE AT BAT."
510 A=1
520 R9=0
530 T=T+1
540 IF T<3 THEN GOSUB 5140
550 IF T<18 THEN 710
560 IF T>18 THEN 590
570 GOSUB 3500
580 GOTO 710
590 GOSUB 3290
600 GOTO 710
610 REM START AN INNING - WE ARE OUT ON THE FIELD
620 T=T+1
630 R9=0
640 IF T<18 THEN 690
650 IF T>18 THEN 680
660 GOSUB 3500
670 GOTO 690
680 GOSUB 3290
690 IF T>2 THEN 710
700 GOSUB 5070
710 S=0:B=0
720 PRINT
730 IF O=0 THEN PRINT "NO OUTS"
740 IF O=1 THEN PRINT "THERE IS 1 OUT"
750 IF O>1 THEN PRINT "THERE ARE";O;"OUTS"
760 P=B(1)+B(2)+B(3)
770 IF P<>3 THEN 800
780 PRINT "BASES LOADED"
790 GOTO 900
800 IF P=0 THEN 900
810 Y$="RUNNER ON "
820 IF P>1 THEN Y$="RUNNERS ON "
830 PRINT Y$;
840 IF B(1)=0 THEN 870
850 PRINT "FIRST";
860 IF P>1 THEN PRINT " AND ";
870 IF B(2)=1 THEN PRINT "SECOND";
880 IF P>1 AND B(1)=0 THEN PRINT " AND ";
890 IF B(3)=1 THEN PRINT "THIRD" ELSE PRINT " "
900 IF A=0 THEN 920
910 GOTO 3030
920 PRINT "BATTER UP"
930 IF B<>3 OR S<>2 THEN 960
940 PRINT "FULL COUNT"
950 GOTO 970
960 IF B>0 OR S>0 THEN PRINT "THE COUNT IS";B;"AND";S
970 PRINT
980 IF A=1 THEN 3030
990 PRINT "WHAT WILL YOUR BATTER DO, ";B$;
1000 INPUT C
1010 IF C>0 AND C<5 THEN 1050
1020 PRINT "HUH? ";
1030 GOSUB 5070
1040 GOTO 990
1050 Y2=RND(1)
1060 IF Y2<.56 OR Y2>.5625 THEN 1120
1070 PRINT "WILD PITCH!"
1080 N=1
1090 GOSUB 3540
1100 B(1)=0
1110 GOTO 1210
1120 IF Y2>.772 AND Y2<.775 THEN 4880
1130 ON C GOTO 1140,1450,2600,4450,5500
1140 C=1
1150 GOSUB 5240
1160 IF A=0 THEN Z1=Z1+1
1170 Y=RND(1)
1180 IF B<>3 OR S<>0 THEN 1200
1190 IF Y<.7 THEN 1310 ELSE 1210
1200 IF Y<.5 THEN 1310
1210 B=B+1
1220 Y=INT(RND(1)*8+1)
1230 IF Y=9 THEN 1220
1240 PRINT J$(Y);" - BALL";B
1250 IF B<>4 THEN 930
1260 PRINT "WALK"
1270 GOSUB 4950
1280 Y=RND(1)
1290 GOTO 710
1300 PRINT "HIGH POP - FOUL DOWN THE ";Y$;" FIELD LINE"
1310 S=S+1
1320 IF C=2 OR C=5 THEN 1370
1330 Y=INT(RND(1)*4+1)
1340 IF Y=5 THEN 1330
1350 PRINT K$(Y);", CALLED STRIKE";S
1360 GOTO 1380
1370 PRINT "SWINGING STRIKE";S
1380 IF C=5 AND S<>3 THEN 4450
1390 IF S<>3 THEN 930
1400 PRINT "STRUCK OUT"
1410 O=O+1
1420 IF O=3 THEN 2850
1430 IF C=5 THEN 4450
1440 GOTO 710
1450 C=2
1460 Y=INT(RND(1)*10+1)
1470 IF Y=10 THEN 1450
1480 IF A=0 THEN Z2=Z2+1
1490 IF C<>5 THEN GOSUB 5240
1500 IF S<>2 AND Z2/Z1>7 AND A=0 THEN 1520
1510 IF S<>2 OR Z2/Z1<25 THEN 1590
1520 Y=INT(RND(1)*20+1)
1530 IF Y>7 THEN 1550
1540 ON Y GOTO 1610,1310,1310,1310,1310,1680,1610
1550 IF Y>13 THEN 1570
1560 ON Y-7 GOTO 1680,1310,1740,1850,1740,1850
1570 IF Y>18 THEN 1600
1580 ON Y-13 GOTO 1980,1980,2040,2570,1640,2570
1590 IF Y<3 THEN 1310
1600 ON Y-2 GOTO 1610,1680,1740,1850,1980,2040,2570
1610 PRINT "FOULED INTO THE STANDS-OUT OF PLAY"
1620 IF S<>2 THEN S=S+1
1630 GOTO 930
1640 Y=RND(1)
1650 Y$="RIGHT"
1660 IF Y<.5 THEN Y$="LEFT"
1670 GOTO 1620
1680 Y=INT(RND(1)*20+1)
1690 IF Y>18 THEN 1720
1700 PRINT "FOULED BACK INTO THE STANDS"
1710 GOTO 1620
1720 PRINT "POPPED IT UP - CAUGHT BY CATCHER"
1730 GOTO 1410
1740 PRINT "INFIELD GROUNDER"
1750 E2=RND(1)
1760 IF E2<.37 OR E2>.41 THEN 1820
1770 PRINT "1 BASE ERROR!!"
1780 N=1
1790 C=4
1800 GOSUB 3540
1810 GOTO 710
1820 GOSUB 4100
1830 IF O=3 THEN 2850
1840 GOTO 710
1850 PRINT "GROUNDER - COULD BE TROUBLE"
1860 Y=RND(1)
1870 IF Y>.75 THEN 1950
1880 Y$="UP THE MIDDLE"
1890 IF Y<.5 THEN Y$="THROUGH THE HOLE INTO RIGHT FIELD"
1900 IF Y<.25 THEN Y$="THROUGH THE HOLE INTO LEFT FIELD"
1910 PRINT "A SINGLE ";Y$;"!"
1920 N=1
1930 GOSUB 3540
1940 GOTO 710
1950 PRINT "INFIELDER UP WITH IT!"
1960 GOSUB 4800
1970 IF O=3 THEN 2850 ELSE 710
1980 Y=RND(1)
1990 Y$="LEFT"
2000 IF Y<.6 THEN Y$="CENTER"
2010 IF Y<.3 THEN Y$="RIGHT"
2020 PRINT "FLY-OUT TO ";Y$;" FIELD"
2030 GOTO 1410
2040 Z=RND(1)
2050 Y$="CENTER"
2060 IF Z<.6 THEN Y$="RIGHT"
2070 IF Z<.3 THEN Y$="LEFT"
2080 PRINT "LONG FLY TO DEEP ";Y$;" FIELD - LOOKS GOOD!"
2090 Z=RND(1)
2100 IF Z<.9 THEN 2130
2110 PRINT Y$;"FIELDER CAUGHT IT AT THE WALL!"
2120 GOTO 2180
2130 IF Z<.8 THEN 2160
2140 PRINT "A DIVING CATCH!"
2150 GOTO 2180
2160 IF Z<.7 THEN 2290
2170 PRINT Y$;"FIELDER CAUGHT IT ON THE WARNING TRACK!"
2180 O=O+1
2190 IF O=3 THEN 2850
2200 FOR I=3 TO 1 STEP -1
2210 IF B(I)=1 THEN 2240
2220 NEXT I
2230 GOTO 710
2240 B(I+1)=B(I)
2250 B(I)=0
2260 PRINT "LEAD RUNNER TAGS UP - AND ADVANCES 1 BASE!"
2270 GOSUB 3830
2280 GOTO 710
2290 IF Z<.5 THEN 2360
2300 PRINT "BATTER HOLDS WITH A SINGLE."
2310 N=2
2320 GOSUB 3540
2330 B(2)=0
2340 B(1)=1
2350 GOTO 710
2360 IF Z<.15 THEN 2480
2370 PRINT "DOUBLE!"
2380 Y=RND(1)
2390 IF Y>.5 THEN 2430
2400 N=2
2410 GOSUB 3540
2420 GOTO 710
2430 N=3
2440 GOSUB 3540
2450 B(3)=0
2460 B(2)=1
2470 GOTO 710
2480 IF Z<.1 THEN 2530
2490 PRINT "TRIPLE!"
2500 N=3
2510 GOSUB 3540
2520 GOTO 710
2530 PRINT "IT'S OVER THE WALL -- A H*O*M*E R*U*N!!!"
2540 N=4
2550 GOSUB 3540
2560 GOTO 710
2570 Y=INT(RND(1)*7+1)
2580 PRINT "LINED OUT TO ";P$(Y)
2590 GOTO 1410
2600 GOSUB 5240
2610 PRINT "BATTER BUNTS..."
2620 Y=RND(1)
2630 IF Y<.6 THEN 2750
2640 IF B(3)=0 THEN 2660
2650 IF Y<.8 THEN 2830
2660 PRINT "THROWN OUT AT FIRST."
2670 O=O+1
2680 IF O=3 THEN 2850
2690 IF B(1)+B(2)+B(3)=0 THEN 710
2700 PRINT "SACRIFICE - ";
2710 N=1
2720 GOSUB 3540
2730 B(1)=0
2740 GOTO 710
2750 IF Y<.2 THEN 2830
2760 IF Y<.4 THEN 2790
2770 PRINT "BATTER MISSES PITCH"
2780 GOTO 1310
2790 PRINT "BEATS IT OUT! SINGLE!"
2800 N=1
2810 GOSUB 3540
2820 GOTO 710
2830 GOSUB 4100
2840 IF O<>3 THEN 710
2850 PRINT "3 OUTS. THE SIDE IS RETIRED";
2860 I=B(1)+B(2)+B(3)
2870 IF I=0 THEN PRINT "."
2880 IF I=1 THEN PRINT ", LEAVING 1 MAN ON BASE"
2890 IF I>1 THEN PRINT ", LEAVING";I;"MEN ON BASE"
2900 PRINT
2910 PRINT
2920 PRINT "*************"
2930 D=T/2-INT(T/2)
2940 PRINT "AFTER";
2950 IF T>1 THEN PRINT INT(T/2);
2960 IF D>.3 THEN PRINT " 1/2 ";
2970 Y$="INNINGS"
2980 IF T<3 THEN Y$="INNING"
2990 PRINT Y$;" OF PLAY, THE SCORE IS"
3000 GOSUB 3960
3010 O=0:B(1)=0:B(2)=0:B(3)=0
3020 IF A=0 THEN 510 ELSE 470
3030 REM MY TEAM IS AT BAT
3040 Y=RND(1)
3050 IF B(1)+B(2)+B(3)=0 THEN 3140
3060 REM IF O=2 AND S=2 AND B=3 THEN 4850
3070 IF B(3)=1 THEN 3110
3080 IF B(2)=0 THEN 3100
3090 IF .45<Y AND .46>Y THEN 4450
3100 IF .45<Y AND .47>Y THEN 4450
3110 IF O=2 THEN 3140
3120 IF O<2 AND Y<.333 AND B(3)=1 THEN 2600
3130 IF .45<Y AND .55>Y THEN 2600
3140 IF S=0 THEN 3240
3150 IF B<>3 THEN 3180
3160 IF Y<.6 THEN 1450
3170 GOTO 1140
3180 IF Y>.3 THEN 1450
3190 IF S<>2 THEN 1140
3200 IF B=0 AND Y<.1 THEN 1140
3210 IF B=0 THEN 1450
3220 IF Y<.2 THEN 1140
3230 GOTO 1450
3240 IF B=3 THEN 3270
3250 IF Y<.6 THEN 1140
3260 GOTO 1450
3270 IF Y<.9 THEN 1140
3280 GOTO 1450
3290 IF T<>19 THEN 3330
3300 IF R1<>R2 THEN 3340
3310 PRINT
3320 PRINT "*** GOING INTO EXTRA INNINGS ***"
3330 IF R1=R2 THEN RETURN
3340 IF (T-1)/2<>INT(T-1)/2 THEN RETURN
3350 PRINT "THE BALLGAME IS OVER."
3360 PRINT "*************"
3370 PRINT "FINAL SCORE:"
3380 T9=1
3390 GOSUB 3960
3400 IF R1>R2 THEN 3470
3410 PRINT "NICE TRY, ";B$
3420 PRINT "YOU SHOULD KNOW BETTER THAN TO TRY TO"
3430 PRINT "OUT-MANAGE A COMPUTER. MAYBE BASEBALL"
3440 PRINT "JUST ISN'T YOUR SPORT...WHY DON'T YOU TRY GOLF?"
3450 REM CHAIN GOLF
3460 STOP
3470 PRINT "CONGRATULATIONS, ";B$
3480 PRINT "YOU'VE BEATEN ME, BUT I WILL HAVE MY REVENGE."
3490 STOP
3500 REM 9TH INNING
3510 IF A=0 THEN 3530
3520 IF R2>R1 THEN 3350 ELSE RETURN
3530 IF R1>R2 THEN 3350 ELSE RETURN
3540 REM ADVANCE N BASES (SET N BEFORE GOSUB)
3550 N2=B(1)+B(2)+B(3)
3560 IF C=5 THEN N=N+1
3570 N3=N
3580 IF N2=0 THEN 3650
3590 REM FIND LAST RUNNER: MAKE SURE HE ISN"T TRYING TO ADVANCE
3600 REM PAST HOME PLATE.
3610 FOR I=1 TO 3
3620 IF B(I)=1 THEN 3640
3630 NEXT I
3640 IF 4-I<N THEN N3=4-I
3650 FOR I=3+N TO N+1 STEP -1
3660 B(I)=B(I-N)
3670 NEXT I
3680 B(N)=1
3690 IF N=1 THEN 3740
3700 FOR P=1 TO 3
3710 IF (N-P)>1 THEN B(N-P)=0
3720 IF (N-P)<=1 THEN B(1)=0
3730 NEXT P
3740 FOR P=1 TO 7
3750 IF P=N THEN 3780
3760 NEXT P
3770 GOTO 3830
3780 IF C=4 OR N2=0 THEN 3830
3790 Y$="RUNNERS ADVANCE"
3800 IF N2=1 THEN Y$="RUNNER ADVANCES"
3810 PRINT Y$;N3;
3820 IF N3=1 THEN PRINT "BASE" ELSE PRINT "BASES"
3830 IF B(4)+B(5)+B(6)+B(7)=0 THEN RETURN
3840 REM AT LEAST 1 RUN HAS SCORED.
3850 N2=B(4)+B(5)+B(6)+B(7)
3860 IF A=0 THEN 3890
3870 R2=R2+N2
3880 GOTO 3900
3890 R1=R1+N2
3900 B(4)=0:B(5)=0:B(6)=0:B(7)=0
3910 IF N2=1 THEN PRINT "** 1 RUN SCORED"
3920 IF N2>1 THEN PRINT "**";N2;"RUNS SCORED"
3930 PRINT
3940 PRINT
3950 PRINT "********NEW SCORE:"
3960 IF H=1 THEN 4000
3970 IF LEN(A$)>LEN(C$) THEN PRINT A$;TAB(LEN(A$)+3);R1
3980 IF LEN(A$)<=LEN(C$) THEN PRINT A$;TAB(LEN(C$)+3);R1
3990 IF H=1 THEN 4030
4000 IF LEN(A$)>LEN(C$) THEN PRINT C$;TAB(LEN(A$)+3);R2
4010 IF LEN(A$)<=LEN(C$) THEN PRINT C$;TAB(LEN(C$)+3);R2
4020 IF H=1 THEN 3970
4030 PRINT "*************"
4040 PRINT
4050 PRINT
4060 IF T9=1 THEN 4090
4070 IF A=1 AND T>17 AND INT(T/2)=T/2 AND R2>R1 THEN 3350
4080 IF A=0 AND T>17 AND INT(T/2)=T/2 AND R1>R2 THEN 3350
4090 RETURN
4100 REM LEAD RUNNER OUT (FIELDER"S CHOICE THEN ONE BASE ADVANCE)
4110 N=1
4120 I=4
4130 IF B(4)=0 AND B(3)=1 AND B(2)=1 AND B(1)=1 THEN 4220
4140 I=3
4150 IF B(3)=0 AND B(2)=1 AND B(1)=1 THEN 4220
4160 I=2
4170 IF B(2)=0 AND B(1)=1 THEN 4220
4180 REM NO ONE FORCED
4190 O=O+1
4200 PRINT "BATTER THROWN OUT"
4210 RETURN
4220 B(I-1)=0
4230 F=RND(1)
4240 IF O=2 OR F>.3 THEN 4290
4250 O=O+2
4260 PRINT "DOUBLE PLAY!"
4270 IF O=3 THEN RETURN
4280 GOTO 4910
4290 O=O+1
4300 PRINT "RUNNER ON BASE";I-1;"IS OUT ON FIELDER'S CHOICE"
4310 IF O=3 THEN RETURN
4320 GOSUB 3540
4330 RETURN
4340 REM FORCED RUNNERS ADVANCE 1 BASE, OTHERS HOLD
4350 FOR I=1 TO 3
4360 IF B(I)=0 THEN 4400
4370 NEXT I
4380 N=1
4390 GOTO 3540
4400 REM NO ONE ON BASE I
4410 FOR I2=I TO 1 STEP -1
4420 B(I2)=1
4430 NEXT I2
4440 RETURN
4450 REM LEAD RUNNER STEALS
4460 FOR I=3 TO 1 STEP -1
4470 IF B(I)=1 THEN 4510
4480 NEXT I
4490 PRINT "NO ONE ON BASE, DUMMY!"
4500 GOTO 990
4510 REM I IS LEAD RUNNER"S BASE
4520 IF C<>5 THEN GOSUB 5240
4530 IF RND(1)/I<.3 THEN 4680
4540 IF B(1)+B(2)+B(3)>1 THEN 4570
4550 PRINT "RUNNER STEALS A BASE"
4560 GOTO 4580
4570 PRINT "RUNNERS STEAL A BASE"
4580 N=1
4590 C2=C
4600 C=4
4610 GOSUB 3540
4620 C=C2
4630 B(1)=0
4640 IF C=5 AND S<>3 THEN 930
4650 IF C=5 THEN 710
4660 Y=RND(1)
4670 IF Y>.5 THEN 1210 ELSE 1310
4680 PRINT "RUNNER THROWN OUT STEALING"
4690 O=O+1
4700 B(I)=0
4710 IF O=3 THEN 2850
4720 N=1
4730 GOSUB 3540
4740 B(1)=0
4750 IF C=5 AND S<>3 THEN 930
4760 IF C=5 THEN 710
4770 Y=RND(1)
4780 IF B=3 THEN 1310
4790 IF Y>.5 THEN 1210 ELSE 1310
4800 REM RUNNERS ADVANCE ONE BASE, BATTER THROWN OUT
4810 N=1
4820 IF O=2 THEN 4850
4830 GOSUB 3540
4840 B(1)=0
4850 O=O+1
4860 PRINT "BATTER THROWN OUT"
4870 RETURN
4880 PRINT "HIT BATSMAN (OUCH!)"
4890 GOSUB 4950
4900 GOTO 710
4910 N=1
4920 GOSUB 3540
4930 B(1)=0
4940 RETURN
4950 REM BATTER WALKED
4960 FOR I=1 TO 3
4970 IF B(I)=0 THEN 5010
4980 NEXT I
4990 N=1
5000 GOTO 3540
5010 IF I=1 THEN 5050
5020 FOR I0=I TO 2 STEP -1
5030 B(I0)=B(I0-1)
5040 NEXT I0
5050 B(1)=1
5060 RETURN
5070 PRINT "WHEN YOUR'RE UP:"
5080 PRINT "1-BATTER TAKES PITCH"
5090 PRINT "2-BATTER SWINGS AWAY"
5100 PRINT "3-BATTER BUNTS"
5110 PRINT "4-LEAD RUNNER STEALS"
5120 REM PRINT "5-HIT AND RUN"
5130 RETURN
5140 REM PITCHING ROUTINE
5150 PRINT "YOUR PITCHER MAY THROW:"
5160 PRINT "1-FAST BALL"
5170 PRINT "2-CURVE"
5180 PRINT "3-SLIDER"
5190 PRINT "4-SINKER"
5200 PRINT "5-CHANGE-UP"
5210 PRINT "6-KNUCKLEBALL"
5220 PRINT "7-SCREWBALL"
5230 RETURN
5240 IF A=0 THEN 5370
5250 IF R9=1 THEN 5300
5260 PRINT "WHAT WILL YOUR PITCHER THROW";
5270 INPUT W
5280 IF W<0 THEN R9=1
5290 IF R9=0 THEN 5320 ELSE PRINT "RANDOM PITCHES FOR REST OF INNING"
5300 W=INT(RND(1)*8+1)
5310 IF W=8 THEN 5300
5320 IF W>0 AND W<8 THEN 5470
5330 PRINT "UH-UH, ";B$;". ";
5340 GOSUB 5150
5350 PRINT
5360 GOTO 5260
5370 REM I MUST SELECT A PITCH
5380 W1=RND(1)
5390 W=1
5400 IF W1<.75 THEN W=2
5410 IF W1<.55 THEN W=3
5420 IF W1<.45 THEN W=4
5430 IF W1<.35 THEN W=5
5440 IF W1<.15 THEN W=6
5450 IF W1<.08 THEN W=7
5460 GOTO 5470
5470 PRINT W$(W);
5480 PRINT "...";
5490 RETURN
5500 REM HIT-AND-RUN
5510 IF B(1)+B(2)+B(3)=0 THEN 4490
5520 GOSUB 5240
5530 PRINT "HIT AND RUN!"
5540 C=5
5550 GOTO 1460
5560 DATA FAST BALL,CURVE BALL,SLIDER,SINKER,CHANGE-UP,KNUCKLEBALL
5570 DATA SCREWBALL
5580 DATA RIGHT,LEFT,CENTER,FIRST,SECOND,THIRD,SHORTSTOP,PITCHER,CATCHER
5590 DATA RIGHT OVER THE PLATE,CAUGHT THE OUTSIDE CORNER
5600 DATA OVER THE INSIDE CORNER,OVER AT THE KNEES
5610 DATA HIGH,LOW,INSIDE,OUTSIDE,HIGH AND TIGHT,LOW AND OUTSIDE
5620 DATA LOW AND INSIDE,HIGH AND OUTSIDE
5630 END


BIN
software/BAS/BIGTREK.BAS
View File

Binary file not shown.

170
software/BAS/BIOCAL.bas
View File

@@ -1,170 +0,0 @@
100 REM*****************************************************************
110 REM
120 REM BIORHYTHM WALL CALENDAR
130 REM
140 REM WRITTEN BY
150 REM
160 REM RON WILLIAMS
170 REM 1845 COCHRAN RD.
180 REM MORGAN HILL, CA 95037
190 REM (408) 779-8655
200 REM
210 REM BASED ON A CONCEPT BY
220 REM DR. ROBERT SMITH AT
230 REM CONTROL DATA CORP.
240 REM
250 REM
260 REM THE ONLY INPUT THE PROGRAM REQUIRES IS YOUR NAME AND YOUR
270 REM DATE OF BIRTH (GIVEN AS MM,DD,YYYY OR MM,DD,YY).
280 REM THIS PROGRAM PRINTS OUT A 12-MONTH CALENDER FOR 1978. IF SOME
290 REM PARTICULAR DAY HAS A 'P', AN 'S' OR AN 'I' INSTEAD OF A
300 REM NUMBER, IT MEANS THAT DAY IS A P(HYSICAL), S(ENSITIVITY) OR
310 REM I(NTELLECTUAL) CRITICAL DAY FOR YOU. A '+' OR '-' FOLLOWING
320 REM ONE OF THE THREE LETTERS ABOVE MEANS THE SINE CURVE IS
330 REM BEGINNING ITS UPWARD(+) OR DOWNWARD(-) SWING.
340 REM
350 REM IF TWO LETTERS APPEAR ON THE CALENDAR, IT MEANS YOU HAVE A
360 REM DOUBLE-CRITICAL DAY! (E.G. 'PS' MEANS YOUR PHYSICAL AND
370 REM SENSITIVITY CYCLES ARE BOTH CRITICAL ON THAT DAY).
380 REM
390 REM IF A DOUBLE ASTERISK (**) APPEARS ON THE CALENDAR, IT MEANS
400 REM ALL THREE CYCLES ARE CRITICAL ON THAT DAY! YOU'D BEST JUST
410 REM STAY HOME N BED!! ONE GOOD(?) THING YOU MIGHT SAY
420 REM ABOUT A TRIPLE-CRITICAL DAY IS THAT YOU ONLY HAVE 9 OF THEM
430 REM IN THE 58-YEAR BIORHYTHM LIFE CYCLE (YOUR THREE CYCLES
440 REM START OVER AGAIN ABOUT EVERY 58 YEARS).
450 REM
460 REM THIS PROGRAM WAS ORIGINALLY WRITTEN IN PL/M FOR THE INTELLEC
470 REM MICROCOMPUTER DEVELOPMENT SYSTEM.
480 REM BEING INNATELY LAZY, I MERELY TRANSLATED THE CODE (INSTEAD OF
490 REM REDESIGNING IT) WHEN I REWROTE IT IN MICROSOFT DISK BASIC.
500 REM THIS LAME EXCUSE IS MY WAY OF TELLING THE USER THAT THE
510 REM PROGRAM RUNS SLO-O-O-W AS COMPARED TO THE PL/M VERSION.
520 REM
530 REM
540 REM******************************************************************
550 REM
560 CLEAR 1000
570 DEFINT A-E:DEFINT G-Z
580 DIM CA(583),CB$(71)
590 WIDTH80
600 GOSUB 1600
610 LINEINPUT"PLEASE ENTER YOUR NAME ===> ";N$
620 INPUT"NOW ENTER YOUR BIRTHDATE (E.G. 5,22,1934) ===> ";MM,DD,YY
630 IF YY<1000 THEN YY=YY+1900
640 PRINT:LINEINPUT"POSITION PAPER AT TOP OF FORM, THEN HIT -RETURN-";A$
650 PRINT:PRINT"WAIT....YOUR BIORHYTHM CALENDAR WILL BE PRINTING SHORTLY....."
660 CY=1978
670 X=MM:Y=DD:Z=YY:IFX<3THENGOSUB1770ELSEGOSUB1780
680 F1=F
690 X=1:Y=1:Z=1978:GOSUB1770
700 TD=F-F1+1
710 IF CY MOD 4=0 THEN MV(13)=29
720 FOR K=0TO583:CA(K)=0:NEXT
730 MV(1)=MV(13):CP=SD(CY-1971)
740 FORJ=1TO12
750 L=MV(J-1)
760 RP=6*(J-1)+1
770 FOR K=1TOL
780 CA(CP+7*(RP-1))=K
790 CP=CP+1
800 IF CP>7 THEN CP=1:RP=RP+1
810 NEXT K
820 NEXTJ
830 CL=23:RP=0
840 FOR L=1 TO 3
850 MC=TD MOD CL
860 FOR J=1 TO 72
870 FOR K=1 TO 7
880 SL=K+7*(J-1)
890 IF CA(SL)=0 THEN 960
900 IF MC-CL\2-1 = 0 THEN 940
910 IF MC>CL THEN CA(SL)=CA(SL)+1000*(L+RP)+200:MC=1
920 MC=MC+1
930 GOTO 960
940 CA(SL)=CA(SL)+1000*(L+RP)+100
950 MC=MC+1
960 NEXT K
970 NEXT J
980 CL=CL+5:RP=RP+1
990 NEXT L
1000 REM
1010 L=0:KL=7*(CY-1971)
1020 FOR J=1TO7
1030 MG=10000
1040 FOR K=0TO71:CB$(K)=" ":NEXTK
1050 L=L+1:M=HP(L-1):IF M<>0 THEN CB$(M)="$":GOTO 1050
1060 CP=KL+J:K=HN(CP-1)
1070 IF K=0 THEN FOR I=48TO53:CB$(I)="$":NEXTI:GOTO 1120
1080 FOR N=1 TO 5:LP=K\MG:K=K-LP*MG
1090 IF LP<>0 THEN CB$(LP+47)="$"
1100 MG=MG\10
1110 NEXT N
1120 LPRINTTAB(5);:FOR I=0 TO 71:LPRINT CB$(I);:NEXT I:LPRINT
1130 NEXT J
1140 PRINT
1150 FOR I=0TO71:CB$(I)=" ":NEXT I
1160 LPRINT:LPRINTTAB(23);"BIORHYTHM CALENDAR FOR ";N$:LPRINT
1170 LPRINT:LPRINTTAB(11);"P=PHYSICAL S=SENSITIVITY I=INTELLECTUAL"
1180 LPRINTTAB(18);"+ = CURVE RISING - = CURVE FALLING"
1190 LPRINTTAB(25);"** = TRIPLE CRITICAL DAY!":LPRINT
1200 FOR L=1 TO 12 STEP 3
1210 ON L\3+1 GOSUB 1560,1570,1580,1590
1220 LPRINTTAB(5);" S M T W T F S S M T W T F S S M T W T F S":LPRINT
1230 N=6*(L-1)+1
1240 FOR M=1 TO 6
1250 LP=3
1260 RP=N
1270 JL=RP+12
1280 FOR K=0 TO 71:CB$(K)=" ":NEXT K
1290 IF RP>JL THEN 1500
1300 FOR K=1 TO 7
1310 IF CA(K+7*(RP-1))=0 THEN 1460
1320 SL=K+7*(RP-1)
1330 IF CA(SL)>8500 THEN CB$(LP)="*":CB$(LP-1)="*":GOTO1460
1340 IF CA(SL)>8200 THEN CB$(LP)="I":CB$(LP-1)="S":GOTO1460
1350 IF CA(SL)>6200 THEN CB$(LP)="I":CB$(LP-1)="P":GOTO1460
1360 IF CA(SL)>5200 THEN CB$(LP)="+":CB$(LP-1)="I":GOTO1460
1370 IF CA(SL)>5100 THEN CB$(LP)="-":CB$(LP-1)="I":GOTO1460
1380 IF CA(SL)>4200 THEN CB$(LP)="S":CB$(LP-1)="P":GOTO1460
1390 IF CA(SL)>3200 THEN CB$(LP)="+":CB$(LP-1)="S":GOTO1460
1400 IF CA(SL)>3100 THEN CB$(LP)="-":CB$(LP-1)="S":GOTO1460
1410 IF CA(SL)>1200 THEN CB$(LP)="+":CB$(LP-1)="P":GOTO1460
1420 IF CA(SL)>1100 THEN CB$(LP)="-":CB$(LP-1)="P":GOTO1460
1430 CB$(LP)=MID$(STR$(CA(SL) MOD 10),2)
1440 CB$(LP-1)=MID$(STR$(CA(SL)\10),2)
1450 IF CB$(LP-1)="0"THENCB$(LP-1)=" "
1460 LP=LP+3
1470 NEXT K
1480 RP=RP+6:LP=LP+4
1490 GOTO 1290
1500 LPRINTTAB(5);:FOR I=0 TO 71:LPRINTCB$(I);:NEXT I:LPRINT
1510 N=N+1
1520 NEXT M
1530 LPRINT
1540 NEXT L
1550 END
1560 LPRINTTAB(5);" J A N U A R Y F E B R U A R Y M A R C H":LPRINT:RETURN
1570 LPRINTTAB(5);" A P R I L M A Y J U N E":LPRINT:RETURN
1580 LPRINTTAB(5);" J U L Y A U G U S T S E P T E M B E R":LPRINT:RETURN
1590 LPRINTTAB(5);" O C T O B E R N O V E M B E R D E C E M B E R":LPRINT:RETURN
1600 DIM HP(49)
1610 FOR I=0TO48:READHP(I):NEXT
1620 DATA 21,29,30,31,32,38,39,40,41,42,43,0,20,21,28,33,38,43,0
1630 DATA 19,21,28,32,33,41,42,0,21,29,30,31,33,40,0,21,32,40,0
1640 DATA 21,31,40,0,19,20,21,22,30,40,0
1650 DIM MV(24)
1660 FOR I=0TO23:READMV(I):NEXT
1670 DATA 31,28,31,30,31,30,31,31,30,31,30,31,31,28,31,30,31,30,31,31
1680 DATA 30,31,30,31
1690 DIM SD(9)
1700 FOR I=0TO8:READSD(I):NEXT
1710 DATA 6,7,2,3,4,5,7,1,2
1720 DIM HN(63)
1730 FOR I=49 TO 55:READHN(I):NEXT
1740 DATA 2345,16,16,2345,16,16,2345
1750 PRINT:PRINT
1760 RETURN
1770 F=365*Z+Y+31*(X-1)+INT((Z-1)/4)-INT(.75*(INT((Z-1)/100)+1)):RETURN
1780 F=365*Z+Y+31*(X-1)-INT(.4*X+2.3)+INT(Z/4)-INT(.75*(INT(Z/100)+1)):RETURN
NT((Z-1)/4)-INT(.75*(INT((Z-1)/10

154
software/BAS/BIRTHDAY.bas
View File

@@ -1,154 +0,0 @@
100 REM BIRTHDAY UPDATED 5-5-77 TO "MITS" BY D. NIXON
110 DIM Z$(12),L(12),N(60),Y$(7)
120 DIM G$(12),H$(32)
130 FOR I=1 TO 12:READ Z$(I):NEXT
140 FOR I=1 TO 12:READ L(I):NEXT
150 FOR I=1 TO 7:READ Y$(I): NEXT
160 FOR I=1 TO 12:READ G$(I):NEXT
170 FOR I=1 TO 32:READ H$(I):NEXT
180 DATA JANUARY,FEBRUARY,MARCH,APRIL,MAY,JUNE,JULY,AUGUST:
190 DATA SEPTEMBER,OCTOBER,NOVEMBER,DECEMBER:
200 DATA 31,28,31,30,31,30,31,31,30,31,30,31:
210 DATA THURS,FRI,SATUR,SUN,MON,TUES,WEDNES:
220 DATA THE MOON,THE SUN,THE EARTH,THE PLANET MERCURY,VENUS,MARS:
230 DATA JUPITER,SATURN,THE PLANET URANUS,THE PLANET NEPTUNE:
240 DATA THE PLANET PLUTO,PEANUT BUTTER:
250 DATA JUXTAROTATION,CONTRAPOSITION,CONTRASTING PHASES,TRANSPOSITION:
260 DATA SATISFIED,HAPPY,INTERESTING,TOLERANT:
270 DATA OFTEN,OCCASIONALLY,SOMETIMES:
280 DATA TEND TO BE,ARE,ARE INCLINED TO BE:
290 DATA SHORT OF PATIENCE,UNEASY,AT ODDS:
300 DATA OTHERS.,CLOSE FRIENDS.,YOUNGER PEOPLE.,THOSE IN AUTHORITY.:
310 DATA ": BEWARE OF "," AVOID "
320 DATA APPLE PIE,BEING ALONE,DARK PLACES,STRANGERS,UNUSUAL SITUATIONS:
330 DATA BE TAKING A TRIP YOU HAVE NOT MADE BEFORE.
340 DATA BE MEETING SOMEONE YOU WILL KNOW FOR THE REST OF YOUR LIFE.
350 DATA MAKE SEVERAL IMPORTANT DECISIONS INVOLVING OTHERS.
360 DATA BECOME ILL IF YOU DO NOT LESSEN YOUR UNUSUAL ACTIVITIES.
370 PRINT "TYPE IN TODAY'S DATE NUMERICALLY: MO,DAY,YEAR";
380 INPUT X1,Y1,Z1
390 IF Z1>99 GOTO 410
400 Z1=Z1+1900
410 XF=X1:YF=Y1:ZF=Z1:GOSUB 1220:U=ND
420 PRINT "TODAY IS ";Y$(U-7*INT(U/7)+1);"DAY (I HOPE)"
430 PRINT
440 PRINT "HI, I'M A MICROPROCESSOR."
450 PRINT "TELL ME YOUR NAME";
460 INPUT N$
470 I=INSTR(N$," ")-1
480 IF I<0 THEN 580
490 K$=LEFT$(N$,I)
500 PRINT "ARE YOU USUALLY CALLED ";K$;
510 INPUT A$
520 GOSUB 1140
530 ON NA GOTO 540,560,510
540 PRINT "WHAT DO YOU LIKE TO BE CALLED";
550 INPUT K$
560 PRINT "SO YOUR FULL NAME IS ";N$;", BUT YOU"
570 PRINT "LIKE TO BE CALLED ";K$;"."
580 PRINT "HOW OLD ARE YOU, ";K$;
590 INPUT A
600 A=INT(A)
610 IF INT((A-5)/95)=0 GOTO 640
620 PRINT "COME ON, ";K$;", YOU'RE PULLING MY LEG."
630 GOTO 580
640 PRINT "SO YOU ARE";A;"YEARS OLD."
650 PRINT "DO YOU KNOW, OFF HAND, HOW MANY DAYS OLD YOU ARE";
660 INPUT A$
670 GOSUB 1140
680 ON NA GOTO 720,690,660
690 PRINT "OK, SMARTY, HOW MANY?"
700 PRINT "SORRY, ";K$;", YOU'LL HAVE TO BE FASTER THAN THAT!"
710 GOTO 1600
720 PRINT "OK, I'LL TELL YOU."
730 PRINT "IN WHAT MONTH WERE YOU BORN";
740 INPUT M$
750 FOR X=1 TO 12
760 IF M$=Z$(X) GOTO 800
770 NEXT X
780 PRINT K$;", YOU MAY BE NICE BUT YOU CAN'T SPELL."
790 GOTO 730
800 PRINT "ON WHAT DAY";
810 INPUT Y
820 Z=Z1-A
830 IF INT((Y-1)/L(X))=0 GOTO 870
840 IF (X-1)*(Y-28)*(Z-4*INT(Z/4)+1)=1 GOTO 870
850 PRINT "COME ON, ";N$;", YOU'RE GIVING ME A HARD TIME."
860 GOTO 800
870 REM
880 XF=X1:YF=Y1:ZF=Z:GOSUB 1220:W=ND
890 XF=X:YF=Y:ZF=Z:GOSUB 1220:V=ND
900 IF W=> V GOTO 920
910 Z=Z-1
920 IF ABS(W-V)>30 GOTO 990
930 ON SGN(W-V)+2 GOTO 940,980,960
940 PRINT "YOU HAVE A BIRTHDAY COMING UP IN ONLY";V-W;"DAYS!"
950 GOTO 990
960 PRINT "YOUR BIRTHDAY WAS ONLY";W-V;"DAYS AGO. CONGRATULATIONS!"
970 GOTO 990
980 PRINT "HAPPY BIRTHDAY, DEAR ";K$;", HAPPY BIRTHDAY TO YOU."
990 XF=X:YF=Y:ZF=Z:GOSUB 1220:V=ND
1000 PRINT "YOU WERE BORN ON ";Y$(V-7*INT(V/7)+1);"DAY, ";Z$(X);Y;",";Z
1010 PRINT "WHICH MAKES YOU";U-V;"DAYS OLD."
1020 PRINT "YOU WERE BORN ON THE DAY";V;"AD, AND ON JAN. 1, 2000"
1030 PRINT "YOU WILL BE";730480!-V;"DAYS OLD."
1040 PRINT "HOW ABOUT THAT!!!"
1050 PRINT
1060 GOSUB 1350
1070 PRINT "WELL, ";N$;
1080 IF N$=K$ GOTO 1100
1090 PRINT " (ALIAS ";K$;")"
1100 PRINT " IT HAS BEEN NICE CHATTING WITH YOU. DO COME AGAIN."
1110 PRINT "GOOD BYE"
1120 GOTO 1600
1130 REM SUBROUTINE FOR YES NO REQUEST
1140 NA=1
1150 IF A$="NO" GOTO 1210
1160 IF A$="N0" GOTO 1210
1170 NA=2
1180 IF A$="YES" GOTO 1210
1190 NA=3
1200 PRINT "A SIMPLE YES OR NO WILL DO! "
1210 RETURN
1220 REM SUBROUTINE TO SOLVE FOR NUMBER OF DAYS
1230 ND=YF-1
1240 FOR I1=1 TO XF-1
1250 ND=ND+L(I1)
1260 NEXT I1
1270 I1=INT(ZF/100)
1280 IF ZF<>4*INT(ZF/4) GOTO 1330
1290 IF ZF/100=I1 GOTO 1330
1300 IF ND>59 GOTO 1330
1310 IF XF=3 GOTO 1330
1320 ND=ND-1
1330 ND=ND+36524!*I1+INT(365.25*(ZF-100*I1))
1340 RETURN
1350 REM GENERATE RANDOM HOROSCOPE
1360 R1=INT(12*RND(1))+1
1370 R2 = INT(12*RND(1))+1
1380 IF R1=R2 GOTO 1370
1390 R=1
1400 X=4:GOSUB 1570
1410 PRINT "YOU WERE BORN UNDER THE ";H$(NR);" OF ";G$(R1)
1420 X=4:GOSUB 1570
1430 PRINT "AND ";G$(R2);". YOU ARE A BASICALLY ";H$(NR)
1440 X=3:GOSUB 1570
1450 PRINT "PERSON BUT ";H$(NR);
1460 GOSUB 1570
1470 PRINT " YOU ";H$(NR)
1480 GOSUB 1570:N1=NR:X=4:GOSUB 1570:N2=NR:X=2:GOSUB 1570
1490 PRINT H$(N1);" WITH ";H$(N2);H$(NR)
1500 X=5:GOSUB 1570
1510 PRINT H$(NR);" FOR THE NEXT WEEK. I PREDICT YOU WILL SOON"
1520 X=4:GOSUB 1570
1530 PRINT H$(NR)
1540 PRINT
1550 RETURN
1560 REM SUBROUTINE TO SELECT RANDOM WORDS
1570 NR=INT(X*RND(1))+R
1580 R=R+X
1590 RETURN
1600 END

1550 RETURN
1560 REM SUBROUTINE TO SELECT

167
software/BAS/BLACKJCK.bas
View File

@@ -1,167 +0,0 @@
100 REM *** B L A C K J A C K ***
101 WIDTH 80
110 DIM D(208),H(16),O(16),P(16,11),Q(11),S(16),X(16)
120 PRINT:PRINT"WELCOME TO THE CASINO"
130 PRINT "WE PLAY VEGAS STYLE BLACKJACK"
140 PRINT:INPUT"INSTRUCTIONS? (YES-NO) ";M$: IF M$="NO" THEN GOTO 160
150 IF M$="YES" THEN GOSUB 1640:GOTO 160 ELSE GOTO 140
160 R=16:PRINT"HOW MANY DECKS (1-4)";
170 INPUTN:IFN<1ORN>4THENPRINT"1 TO 4 DECKS ONLY. REENTER";:GOTO170
180 E=N*52:GOSUB870:B=1:GOSUB890:A=1
190 PRINT:G=1
200 INPUT"BET PLEASE";U:IF U>0 THENGOTO220 ELSE IF U=0 THEN GOTO1600
210 B=1:GOSUB 890:GOTO 200
220 IF U<=500 THEN GOTO240 ELSEPRINT"SORRY, THE HOUSE LIMIT IS $500!"
230 GOTO 200
240 GOSUB930:H(1)=U:N=Q(2):PRINT:PRINT"MY UP CARD";:GOSUB1050:N=P(R,1)
250 PRINT : PRINT"YOUR 1ST CARD";:GOSUB1050:PRINT"YOUR 2ND CARD";:N=P(R,2)
260 GOSUB 1050
270 GOSUB1170:IFM<>11THEN GOTO 280 ELSE GOSUB 1550
280 IF W<>21 THEN GOTO 320 ELSE PRINT : PRINT"I HAVE BLACKJACK, ";
290 IF X(1)<>21 THEN GOTO 310 ELSE PRINT"SO DO YOU, WE PUSH"
300 GOSUB 1510:GOTO 190
310 PRINT"YOU LOSE":V=V-U:GOTO300
320 IF X(1)<>21 THEN GOTO340 ELSE PRINT"YOU HAVE BLACKJACK, YOU WIN!"
330 V=V+3*U/2:GOTO300
340 PRINT:PRINT"PLAY ";:IF R=1 THEN GOTO 350 ELSE PRINT"FOR HAND";G;
350 PRINT:PRINT"YOUR TOTAL IS";X(G);:INPUT F:IF F>-1 THEN GOTO 370
360 PRINT"ONLY 0-3 IS VALID, REENTER";:GOTO350
370 IF F>3 THEN GOTO 360 ELSE IF F<>1 THEN GOTO 550
380 REM ******** PLAYER HIT ROUTINE *************
390 IF A<=E THEN GOTO 400 ELSE GOSUB 1220
400 M=S(G):M=M+1:S(G)=M:N=D(A):P(G,M)=N:PRINT"YOUR CARD IS";:GOSUB 1050
410 GOSUB 1010:A=A+1:IF N<>11 THEN GOTO 420 ELSE O(G)=O(G)+1
420 X(G)=X(G)+N
430 IF X(G)<22 THEN GOTO 340 ELSE IF O(G)=0 THEN 450
440 O(G)=O(G)-1:X(G)=X(G)-10:GOTO 430
450 PRINT:PRINT"YOU BUSTED WITH";X(G):X(G)=0:Y=Y-1:PRINT
460 REM ********* CHECK FOR END OF PLAY ************
470 IF G<R GOTO 500
480 GOSUB 1250
490 GOTO190
500 G=G+1
510 N=P(G,1)
520 PRINT "YOUR 1ST CARD FOR HAND ";G;" WAS";
530 GOSUB 1050
540 GOTO 340
550 IF F<>0 GOTO 620
560 REM *********PLAYER STAND ALONE ROUTINE ************
570 IF X(G)<22 GOTO 470
580 IF O(G)=0 GOTO 450
590 X(G)=X(G)-10
600 O(G)=O(G)-1
610 G=G+1
620 IF F<>2 GOTO 730
630 IF S(G)=2 GOTO 670
640 PRINT "DOUBLE ON 1ST 2 CARDS ONLY"
650 GOTO 340
660 REM ***** DOUBLE DOWN ROUTINE **********
670 IF A<=E THEN GOTO 680 ELSE 1220
680 H(G)=2*U:N=D(A):P(G,3)=N:A=A+1:PRINT "YOU DRAW THE";:GOSUB 1050
690 GOSUB 1010:IF N=11 THEN O(G)=O(G)+1
700 X(G)=X(G)+N
710 IF X(G)<22 THEN GOTO 470
720 IF O(G)=0 THEN GOTO 450 ELSE O(G)=O(G)-1:X(G)=X(G)-10:GO1350
730 N=P(G,1):Y=Y+1:GOSUB 1010:M=N:N=P(G,2):GOSUB1010:IFM=NTHENGOTO760
740 PRINT "YOU MAY ONLY SPLIT PAIRS": GOTO 340
750 REM *********PAIR SPLIT ROUTINE **********
760 R=R+1:Y=Y+1:P(R,1)=P(G,2):S(G)=1:S(R)=1:X(G)=X(G)/2:X(R)=X(G)
770 H(R)=U:IF N<>11 THEN GOTO 340
780 REM **********ACES WERE SPLIT - 1 CARD EACH *********
790 IF A>E THEN GOSUB 1220
800 N=D(A):P(G,2)=N:PRINT "1ST ACE GETS A";:GOSUB 1050: GOSUB 1010
810 IF N=11 THEN N=1
820 X(G)=X(G)+N:A=A+1:IF A>E THEN GOSUB 1220
830 N=D(A):P(R,2)=N:PRINT "2ND ACE GETS A";:GOSUB 1050:GOSUB 1010
840 IF N=11 THEN N=1
850 X(R)=X(R)+N:A=A+1:GOTO480
860 REM ************ BUILD 1 TO 4 DECKS ************
870 FOR I=1 TO N: J=(I-1)*52: FOR K =1 TO 52: D(J+K)=K:NEXT K,I:RETURN
880 REM *********SHUFFLE THE CARDS ***********
890 PRINTCHR$(26):PRINT "I'M SHUFFLING.... ":FOR I=B TO E
900 C=RND(1)*E:IF C<B GOTO 900 ELSE L=D(I):D(I)=D(C):D(C)=L:NEXTI
910 A=B:RETURN
920 REM ******** DEAL THE CARDS ***********
930 FOR I=1 TO 11:Q(I)=0:FOR J=1 TO R: P(J,I)=0:NEXT J,I:R=1:Y=1
940 IF A+4>E THEN B=1:GOSUB 890
950 PRINT "DEALING":P(R,1)=D(A):Q(1)=D(A+1):P(R,2)=D(A+2):Q(2)=D(A+3)
960 A=A+4:T=2:S(1)=2:GOSUB980:M=N:RETURN
970 REM ********** COMPUTE THE VALUE OF THE DEALERS HAND *********
980 Z=0:W=0:FOR I=1 TO 2:N=Q(I):GOSUB 1010:IF N=11 THEN Z=Z+1
990 W=W+N:NEXT I :RETURN
1000 REM **********COMPUTE THE VALUE OF A CARD **********:
1010 IF N<14 THEN GOTO 1020 ELSE N=N-13:GOTO 1010
1020 IF N=1 THEN N=11:RETURN ELSE GOTO 1030
1030 IF N<11 THEN RETURN ELSE N=10:RETURN
1040 **********PRINT A CARD **********
1050 I=0
1060 IF N>=14 THEN N=N-13:I=I+1:GOTO1060
1070 IF N=1 THEN PRINT TAB(17);"ACE ";:GOTO1130
1080 IF N<10 THEN PRINT TAB(18);N;:GOTO1130
1090 IF N<11 THEN PRINT TAB(17);N;:GOTO 1130
1100 IF N<12 THEN PRINT TAB(16);"JACK ";:GOTO1130
1110 IF N<13 THEN PRINT TAB(15);"QUEEN ";:GOTO 1130
1120 PRINT TAB(16);"KING ";
1130 PRINT "OF ";:IF I=0 THEN PRINT "SPADES":RETURN
1140 IF I=1 THEN PRINT "HEARTS":RETURN
1150 IF I=2 THEN PRINT "DIAMONDS":RETURN ELSE PRINT "CLUBS":RETURN
1160 REM ********* COMPUTE VALUE OF PLAYERS HAND *********:
1170 O(G)=0:X(G)=0:FOR I =1 TO 2: N=P(G,I):GOSUB 1010:X(G)=X(G)+N
1180 IF N<>11 THEN GOTO 1200
1190 O(G)=O(G)+1
1200 NEXT I:RETURN
1210 REM *********SAVE THE CARDS THAT ARE ALREADY DEALT AND SHUFFLE**
1220 K=T:FOR I=1 TO R:K=K+S(I):NEXT I
1230 FOR I=1TOK:A=A-1:J=D(I):D(I)=D(A):D(A)=J:NEXTI:B=K+1:GOSUB890:RETURN
1240 REM *******DEALERS LOGIC **********:
1250 N=Q(1):PRINT "MY HOLE CARD";:GOSUB 1050:IF Y=0 THEN GOTO 1390
1260 IF W<17 THEN GOTO 1300
1270 IF W>17 THEN GOTO 1340
1280 IF Z=0 THEN GOTO 1380
1290 W=W-10:Z=Z-1
1300 IF A>E THEN GOSUB 1220
1310 N=D(A):T=T+1:A=A+1:PRINT:PRINT "I DRAW THE";:GOSUB1050:GOSUB1010
1320 IF N=11 THEN Z=Z+1
1330 W=W+N:GOTO 1260
1340 IF W<22 THEN GOTO 1380
1350 IF Z=0 THEN GOTO 1370
1360 Z=Z-1:W=W-10:GOTO1260
1370 PRINT "I BUSTED ";
1380 PRINT "MY TOTAL IS ";W
1390 FOR I =1 TO R:PRINT "YOU ";:IF X(I)<>0 THEN GOTO 1410
1400 PRINT "LOST ";:V=V-H(I):GOTO 1460
1410 IF W<22 THEN GOTO 1430
1420 PRINT "WON ";:V=V+H(I):GOTO 1460
1430 IF W<>X(I) THEN GOTO 1450
1440 PRINT "PUSHED ON ";:GOTO1460
1450 IF W<X(I) THEN GOTO 1420 ELSE GOTO 1400
1460 IF R<>1 THEN GOTO 1470 ELSE PRINT "THE HAND":GOTO 1480
1470 PRINT "HAND ";I
1480 NEXT I
1490 REM ********* PRINT THE PLAYERS WON/LOST STANDING *******
1500 PRINT
1510 PRINT "YOU'RE ";:IF V=0 THEN PRINT "EVEN":RETURN
1520 IF V<0 THEN PRINT "BEHIND $"V:RETURN ELSE PRINT "AHEAD $";V:RETURN
1530 PRINT "AHEAD $";V
1540 REM ********INSURANCE ROUTINE ************
1550 INPUT "INSURANCE (YES-NO)";M$:IF M$="NO" THEN RETURN
1560 IF M$<>"YES" THEN GOTO 1550
1570 PRINT "YOUR INSURANCE BET ";:IF W=21 THEN PRINT "WINS":V=V+U:RETURN
1580 PRINT "LOSES":V=V-U/2:RETURN
1590 REM ******END OF GAME WRAP UP **************
1600 PRINT "THANKS FOR PLAYING":PRINT "HOPE YOU ENJOYED YOURSELF"
1610 PRINT "HERE'S YOUR FINAL STANDING!":GOSUB 1510
1620 IFV>0THENPRINT"NOW, JUST YOU TRY TO COLLECT !!":END
1630 IF V=0THENPRINT"BIG DEAL......":END ELSEPRINT"PAY UP, OR ELSE":END
1640 REM ******** INSTRUCTIONS ***********
1650 PRINT:PRINT"THE DEALER STANDS ON 17 OR MORE"
1660 PRINT"BUT WILL HIT A SOFT 17."
1670 PRINT"YOU MAY SPLIT ANY PAIR.":PRINT"YOU MAY DOUBLE THE 1ST 2 CARDS"
1680 PRINT"AND GET ONLY 1 MORE CARD.":PRINT:PRINT"PLAY CODES:"
1690 PRINT " 0 - STAND":PRINT " 1 - HIT":PRINT " 2 - DOUBLE DOWN"
1700 PRINT " 3 - SPLIT A PAIR":PRINT:PRINT "A ZERO BET ENDS THE GAME"
1710 PRINT "A NEGATIVE BET FORCES A SHUFFLE"
1720 PRINT "GOOD LUCK - LET'S START":RETURN
T:PRINT "A ZERO BET ENDS THE GAME"
1710 PRINT "A NEGATIVE BET FORCES A SHUFFLE"
1720 PRINT "GOOD LUC

218
software/BAS/BUDGET.bas
View File

@@ -1,218 +0,0 @@
100 REM TYPED BY CONNIE FOSTER ,CORRECTED BY C.FOSTER ,PROG BY O.E.DIAL
110 REM ALL REM STATEMENTS CAN BE CHANGED TO ALLOW USE OF TWO TERMINALS
120 REM SEE ARTICLE IN PERSONAL COMPUTING MAY/JUNE 77
130 Q=27:V$="###.#":W$="$$#####,":U$="###"
140 DIMD(18),E$(Q),V(Q),F(Q)
150 PRINTTAB(19)"RECURSIVE BUDGETING MODEL":PRINT:PRINTTAB(28)"* * *"
160 DATASALARY/WAGES,OTHER INCOME,FED INC TAX,STATE & LOCAL TAX
170 DATASOCIAL SECURITY,UNEMPLOYMENT INS,HEALTH INS
180 DATALIFE INS,CONTRIBUTIONS,OTHER DEDUCTIONS
190 DATARENT/MORTGAGE,LIFE INS,HEALTH INS,HOUSE INS
200 DATAAUTO INS,CAR PAYMENTS,LOAN PAYMENTS,TRASH REMOVAL
210 DATAOTHER FIXED EXP
220 DATAFOOD/BEVERAGES,CLOTHING,DRY CLEANING,BARBER/BEAUTY
230 DATAHOME MAINT,HOME HEAT'G FUEL,WATER,ELECTRICITY, TELEPHONE
240 DATAGAS/OIL,AUTO MAINT,FARES/TOLLS/PARKING,DENTIST
250 DATAPHYSICIAN,DRUGS/SUNDRIES,SCHOOL EXPENSE,FAMILY ALLOWANCE
260 DATACLUBS/LODGES,THEATER/SPORTS,RESTAURANTS
270 DATAOTHER ENT'MENT,MAG'S/BOOKS/PAPERS,SITTERS,CHILD CARE
280 DATAVACATION SAVING,OTHER SAVINGS,CONTRIBUTIONS,OTHER EXPENSES
290 PRINT:PRINT"SELECT YOUR BUDGETING PERIOD BY NUMBER. LATER ON IT WILL"
300 PRINT"BE EXTENDED TO ONE YEAR.":PRINT
310 PRINTTAB(3)"1-WEEKLY"TAB(15)"2-BIWEEKLY"TAB(30)"3-SEMIMONTHLY";
320 PRINTTAB(45)"4-MONTHLY":PRINT
330 INPUTP:IFP>4THENPRINT"TRY AGAIN":GOTO290
340 IFP=1THENP=52ELSEIFP=2THENP=26ELSEIFP=3THENP=24ELSEIFP=4THENP=12
350 PRINT:PRINT"ALRIGHT,FIRST LET'S LOOK AT INCOME FOR THE PERIOD.":PRINT
360 READA$:PRINTA$;" $";:INPUTD(0):READA$:PRINTA$;" $";:INPUTD(1)
370 TI=D(0)+D(1):PRINT
380 PRINT:PRINT"OK,NOW LET'S LOOK AT PAYCHECK DEDUCTIONS.":PRINT
390 FORJ=2TO9:READA$:PRINTA$;:INPUT" $";D(J):TD=TD+D(J):NEXTJ:PRINT
400 PRINT"OK,NOW LET'S LOOK AT FIXED EXPENSES.":PRINT
410 FORJ=10TO18:READA$:PRINTA$;:INPUT" $";D(J):TF=TF+D(J):NEXTJ
420 DF=TD+TF:SI=TI-DF:S=64
430 PRINT:PRINT"OK,AT THIS TIME OUR TABLE LOOKS LIKE THIS:":PRINT
440 REM
450 GOSUB1900:PRINT:PRINTTAB(19);
460 PRINT"RECURSIVE BUDGETING MODEL":PRINT:PRINTTAB(27)"* * *":PRINT
470 GOSUB1900
480 PRINT:PRINTTAB(20)"SPENDABLE INCOME SUMMARY":PRINT
490 GOSUB1890:PRINTTAB(3)"ACCOUNT"TAB(42)"PERIOD"TAB(57)"ANNUAL"
500 GOSUB1890:PRINT"TOTAL INCOME" TAB(40);:PRINTUSINGW$;TI;:PRINTTAB(55)
510 PRINTUSINGW$;TI*P:PRINT:PRINTTAB(3)"PAYCHECK DEDUCTIONS"TAB(25);
520 PRINTUSINGW$;TD*(-1):PRINT
530 PRINTTAB(3)"FIXED EXPENSES"TAB(25);:PRINTUSINGW$;TF*(-1);
540 PRINTTAB(40);:PRINTUSINGW$;DF*(-1);:PRINTTAB(55);
550 PRINTUSINGW$;DF*(-1)*P
560 PRINTTAB(41)"-------"TAB(55)"--------":PRINT"SPENDABLE INCOME";
570 PRINTTAB(40);:PRINTUSINGW$;SI;:PRINTTAB(55);:PRINTUSINGW$;SI*P
580 PRINTTAB(41)"======="TAB(55)"========":PRINT:
590 GOSUB1900:PRINT: PRINT
600 REM
610 GOSUB1910:RO=0
620 PRINT:PRINT "OK,NOW FOR THE FIRST ROUND OF VARIABLE EXPENSE. DON'T"
630 PRINT"PINCH YOURSELF IN YOUR ESTIMATES (WITHIN REASON). LET THE"
640 PRINT"COMPUTER HELP YOU REFINE YOUR BUDGET LATER ON.":PRINT
650 FORJ=0TOQ:READE$(J) :PRINTE$(J);:INPUT" $";V(J):VT=VT+V(J):NEXTJ
660 RESTORE:PRINT:PRINT
670 PRINT"YOUR BUDGET FOR THE FIRST ROUND TOTALLED $"VT". THIS"
680 PRINT"COMPARES TO SPENDABLE INCOME OF $"SI". WE HAVE"
690 PRINT"PRORATED THE DIFFERENCE, $"SI-VT",OVER ALL VARIABLE EXPENSE"
700 PRINT"ACCOUNTS.":PRINT
710 GOSUB1910:FORJ=0TOQ:V(J)=INT(V(J)/VT*SI):NEXTJ:VT=SI:PRINT
720 PRINT"NOW WE BEGIN THE BUDGET REFINEMENT PHASE. MAKE AS MANY"
730 PRINT"PASSES AS YOU LIKE. AS YOU REVIEW EACH ACCOUNT,DECIDE"
740 PRINT"WHETHER TO FREEZE IT OR TO LEAVE IT FOR ANOTHER PASS.":PRINT
750 PRINT"HINT: DON'T BE IN A HURRY TO FREEZE AN ACCOUNT.":PRINT
760 PRINT"YOUR TASK IS FINISHED WHEN ALL ACCOUNTS ARE FROZEN.":PRINT
770 GOSUB1910
780 FORJ=0TOQ:PRINT:IFV(J)=0THEN980
790 PRINTE$(J);" $";V(J):INPUT"CHANGE ('Y' OR 'N')";A$
800 IFA$="N"THEN840ELSEIFA$="Y"THEN820ELSEIFA$<>"Y"THEN790
810 GOTO790
820 INPUT"REVISED AMOUNT $";A:IFA<V(J)THEN840
830 GOSUB1930
840 INPUT"FREEZE ('Y' OR 'N')";B$:PRINT
850 IFA$="Y"ANDB$="Y"THEN900
860 IFA$="Y"ANDB$="N"THEN940
870 IFA$="N"ANDB$="N"THEN980
880 VT=VT-V(J):FT=FT+V(J):SWAPF(J),V(J):V(J)=0:PRINT
890 PRINT"OK,THE ACCOUNT HAS BEEN FROZEN AT $"F(J)".":GOTO980
900 VT=VT-A:FT=FT+A:SWAPA,F(J):V(J)=0
910 FORK=OTOQ:V(K)=INT(V(K)*(SI-FT)/VT):NEXTK:VT=SI-FT
920 PRINT"OK,THE ACCOUNT HAS BEEN FROZEN AT $"F(J)",AND THE DIFFERENCE"
930 PRINT"PRORATED OVER REMAINING ACCOUNTS.":PRINT:GOTO980
940 VT=VT-V(J)+A:V(J)=A
950 FORK=0TOQ:V(K)=INT(V(K)*(SI-FT)/VT):NEXTK:VT=SI-FT
960 PRINT"OK,THE VALUE HAS BEEN CHANGED TO $"A", AND THE DIFFERENCE"
970 PRINT"PRORATED OVER REMAINING ACCOUNTS.":PRINT
980 NEXTJ:PRINT:R=0:FORJ=0TOQ:IFV(J)=0THENR=R+1:NEXTJ
990 IFR<=QTHEN1010
1000 FORJ=OTOQ:F(J)=INT(F(J)/FT*SI):VT=0:FT=SI:GOTO1380
1010 PRINT"NOW LET'S RECAP VARIABLE EXPENSES BEFORE GOING ON TO THE"
1020 PRINT"NEXT ROUND.":PRINT:RO=RO+1:V1=0:F1=0
1030 FORJ=0TOQ:V(J)=INT(V(J)/VT*(SI-FT)):NEXTJ:VT=SI-FT
1040 REM
1050 PRINTTAB(7)"INTERIM SUMMARY OF VARIABLE EXPENSES";
1060 PRINT": NO."RO
1070 GOSUB1890:PRINTTAB(3)"ACCOUNTS"TAB(28)"NUMBER"TAB(37)"PERCENT";
1080 PRINTTAB(48)"AMOUNT"TAB(56)"PERCENT"
1090 GOSUB1890:FORJ=0TOQ:IFV(J)+F(J)=0THEN1110
1100 IFV(J)THENV1=V1+1ELSEF1=F1+1
1110 NEXTJ
1120 PRINT"VARIABLE EXPENSES"TAB(29);:PRINTUSINGU$;V1;:PRINTTAB(39);
1130 PRINTUSINGV$;V1/(V1+F1)*100;:PRINTTAB(46);:PRINTUSINGW$;VT;
1140 PRINTTAB(58);:PRINTUSINGV$;VT/TI*100:PRINT
1150 PRINT"FROZEN EXPENSES"TAB(29);:PRINTUSINGU$;F1;:PRINTTAB(39);
1160 PRINTUSINGV$;F1/(V1+F1)*100;:PRINTTAB(46);
1170 PRINTUSINGW$;FT;:PRINTTAB(58);:PRINTUSINGV$;FT/TI*100
1180 PRINTTAB(28)"-------"TAB(48)"--------"
1190 PRINTTAB(3)"TOTALS"TAB(29);:PRINTUSINGU$;F1+V1;:PRINTTAB(46);
1200 PRINTUSINGW$;VT+FT:PRINTTAB(28)"======="TAB(48)"========":PRINT
1210 GOSUB1900:PRINT:PRINT
1220 GOSUB1230:GOTO1270
1230 PRINTTAB(8)"INTERIM STATUS OF VARIABLE EXPENSES NO."RO
1240 GOSUB1890:PRINTTAB(3)"ACCOUNT"TAB(30)"VARIABLE"TAB(43)"FROZEN";
1250 PRINTTAB(54)"PERCENT"
1260 GOSUB1890:PRINT
1270 FORJ=0TOQ:IFV(J)+F(J)=0THEN1330ELSEPRINTE$(J);:R2=R2+1
1280 IFF(J)THEN1300ELSEPRINTTAB(29):PRINTUSINGW$;V(J);:PRINTTAB(55);
1290 PRINTUSINGV$;V(J)/TI*100:GOTO1320
1300 PRINTTAB(40);:PRINTUSINGW$;F(J);:PRINTTAB(55);
1310 PRINTUSINGV$;F(J)/TI*100
1320 IFINT(R2/5)=R2/5THENPRINT
1330 NEXTJ:PRINT:R2=0
1340 GOSUB1900:PRINT
1350 REM
1360 PRINT:PRINT "NOW WE MAKE ANOTHER PASS THROUGH VARIABLE EXPENSES.":PRINT
1370 GOTO770
1380 PRINT"PLEASE INPUT THE REQUESTED INFORMATION BEFORE WE PROVIDE A"
1390 PRINT"FINAL DETAIL OF YOUR BUDGET.":PRINT
1400 PRINTTAB(18)"* USE NO COMMAS NOR COLONS *":PRINT
1410 INPUT"NAME";A$:INPUT"BUDGET YEAR";A
1420 B=LEN(A$):B=16-B/2
1430 REM
1440 GOSUB1920
1450 GOSUB1900:PRINT
1460 PRINTTAB(B)"* THE "A$" FAMILY BUDGET FOR"A"*":PRINT
1470 GOSUB1900:PRINT
1480 PRINTTAB(6)"ACCOUNT"TAB(20)""TAB(26)"INCOME"TAB(38)":";
1490 PRINTTAB(44)"EXPENSE"TAB(56)":PERCENT"
1500 PRINTTAB(20)":-----------------:-----------------: TOTAL"
1510 PRINTTAB(20)": PERIOD : ANNUAL : PERIOD : ANNUAL : INCOME"
1520 PRINT"--------------------:--------:--------:--------:--------:------"
1530 X$=":$$#####,:$$#####,: : : ###.#"
1540 Y$=": : :$$#####,:$$#####,: ###.#"
1550 GOTO1570
1560 PRINT": : : : :":RETURN
1570 PRINT"INCOME"TAB(20);:PRINTUSINGX$;TI;TI*P;TI/TI*100
1580 PRINT"------"TAB(20);
1590 GOSUB1560
1600 READA$:PRINTA$TAB(20);:PRINTUSINGX$;D(0);D(0)*P;D(0)/TI*100
1610 READA$:PRINTA$TAB(20);:PRINTUSINGX$;D(1);D(1)*P;D(1)/TI*100
1620 PRINTTAB(20);
1630 GOSUB1560
1640 PRINT"PAYCHECK DEDUCT'S"TAB(20);
1650 PRINTUSINGY$;TD;TD*P;TD/TI*100
1660 PRINT"-----------------"TAB(20);
1670 GOSUB1560
1680 FORJ=2TO9:READA$:IFD(J)=0THEN1700ELSEPRINTA$TAB(20);
1690 PRINTUSINGY$;D(J);D(J)*P;D(J)/TI*100
1700 NEXTJ:PRINTTAB(20);
1710 GOSUB1560
1720 PRINT"FIXED EXPENSES"TAB(20);
1730 PRINTUSINGY$;TF;TF*P;TF/TI*100
1740 PRINT"--------------"TAB(20);
1750 GOSUB1560
1760 FORJ=10TO18:READA$:IFD(J)=0THEN1780ELSEPRINTA$TAB(20);
1770 PRINTUSINGY$;D(J);D(J)*P;D(J)/TI*100
1780 NEXTJ:PRINTTAB(20);
1790 GOSUB1560
1800 PRINT"VARIABLE EXPENSE"TAB(20);
1810 PRINTUSINGY$;FT;FT*P;FT/TI*100
1820 PRINT"----------------"TAB(20);
1830 GOSUB1560
1840 FORJ=0TOQ:IFF(J)=0THEN1860ELSEPRINTE$(J)TAB(20);
1850 PRINTUSINGY$;F(J);F(J)*P;F(J)/TI*100
1860 NEXTJ:PRINT
1870 GOSUB1900:PRINT
1880 GOSUB1900:PRINT:GOTO1980
1890 FORL=1TOS:PRINT"-";:NEXTL:PRINT:RETURN
1900 FORL=1TOS:PRINT"=";:NEXTL:PRINT:RETURN
1910 PRINT"PRESS 'Y' TO CONTINUE":PRINT:INPUTA$:PRINT:RETURN
1920 FORL=1TO10:PRINT;:NEXTL:RETURN
1930 IFA<=V(J)THEN1970
1940 IFA<=VTTHEN1970
1950 PRINT"* YOU HAVE EXCEEDED YOUR BALANCE OF SPENDABLE INCOME BY $"A-SI;
1960 PRINT" *":INPUT"REVISED AMOUNT $";A:PRINT
1970 RETURN
1980 RESTORE:READA$:READA$:PRINT:PRINT:S=95
1990 PRINTTAB(21)"* EXPENSE BAR CHART *"
2000 PRINTTAB(20)"PERCENT OF TATAL INCOME":PRINT
2010 GOSUB1890:PRINT
2020 GOSUB2140:PRINT
2030 FORJ=2TO18:READA$:IFD(J)=0THEN2060
2040 A=INT(D(J)/TI*300):PRINTA$;
2050 GOSUB2170
2060 NEXTJ
2070 FORJ=0TOQ:IFF(J)=0THEN2100
2080 A=INT(F(J)/TI*300):PRINTE$(J);
2090 GOSUB2170
2100 NEXTJ:PRINT
2110 GOSUB2140:PRINT:PRINT
2120 GOSUB1900:PRINT:PRINT:STOP
2130 REM
2140 PRINTTAB(20)" - - - - 5 - - - - 10 - - - - 15 - - - ";
2150 PRINT"- 20 - - - - 25":RETURN
2160 RETURN
2170 IFA<1THENPRINTTAB(20)"]":GOTO2200
2180 IFA<2THENPRINTTAB(20)"]]":GOTO2200
2190 PRINTTAB(20);:FORK=1TOA:PRINT"]";:NEXTK:PRINT
2200 RETURN
2210 REM
2220 REM
2230 STOP
2240 REM
2250 REM
:GOTO2200
2190 PRINTTAB(20);:FORK=

10
software/BAS/CHAIN.BAS
View File

@@ -1,10 +0,0 @@
INPUT "COMMAND : "; COMMAND$
IF COMMAND$="STOP" THEN STOP
CREATE "$$$.SUB" RECL 128 AS 1
FORMAT$="!&!!"
PRINT USING FORMAT$, #1,2; CHR$(LEN(COMMAND$)), COMMAND$, CHR$(0), "$"
PRINT USING FORMAT$, #1,1; CHR$(9), "CRUN CHAIN", CHR$(0), "$"
CLOSE 1
STOP
END


112
software/BAS/CHASE.bas
View File

@@ -1,112 +0,0 @@
100 PRINT "THIS IS THE GAME OF CHASE"
110 PRINT "WANT INSTRUCTIONS";
120 INPUT C$
130 IF LEFT$(C$,1)="N" THEN 230
140 IF LEFT$(C$,1)<>"Y" THEN 110
150 PRINT "YOU ARE '*' IN A HIGH VOLTAGE MAZE WITH 5"
160 PRINT "SECURITY MACHINES '+' TRYING TO DESTROY YOU"
170 PRINT "YOU MUST MANEUVER THE SECURITY MACHINES INTO"
180 PRINT "THE MAZE 'X' TO SURVIVE. GOOD LUCK !!!"
190 PRINT "MOVES ARE 7,8,9"
200 PRINT " 4,5,6"
210 PRINT " 1,2,3 0 TO END THE GAME"
220 PRINT
230 DIM A(10,20),E(21),F(21)
240 LET G=0
250 FOR B=1 TO 10
260 FOR C=1 TO 20
270 LET A(B,C)=0
280 IF B=1 THEN 330
290 IF B=10 THEN 330
300 IF C=1 THEN 330
310 IF C=20 THEN 330
320 GOTO 340
330 LET A(B,C)=1
340 NEXT C
350 NEXT B
360 FOR D=1 TO 21
370 LET B=INT(RND(1)*8)+2
380 LET C=INT(RND(1)*18)+2
390 IF A(B,C)<>0 THEN 370
400 LET A(B,C)=1
410 IF D<6 THEN 430
420 GOTO 440
430 LET A(B,C)=2
440 IF D=6 THEN 460
450 GOTO 470
460 LET A(B,C)=3
470 LET E(D)=B
480 LET F(D)=C
490 NEXT D
500 FOR B=1 TO 10
510 FOR C=1 TO 20
520 IF A(B,C)<>0 THEN 550
530 PRINT " ";
540 GOTO 630
550 IF A(B,C)<>1 THEN 580
560 PRINT "X";
570 GOTO 630
580 IF A(B,C)<>2 THEN 610
590 PRINT "+";
600 GOTO 630
610 IF A(B,C)<>3 THEN 630
620 PRINT "*";
630 NEXT C
640 PRINT
650 NEXT B
660 LET B=E(6)
670 LET C=F(6)
680 LET A(B,C)=0
690 INPUT Y
700 ON Y+1 GOTO 1040,730,730,730,740,780,740,710,710,710
710 LET B=B-1
720 GOTO 740
730 LET B=B+1
740 ON Y GOTO 750,780,770,750,780,770,750,780,770
750 LET C=C-1
760 GOTO 780
770 LET C=C+1
780 IF A(B,C)=1 THEN 1060
790 IF A(B,C)=2 THEN 1080
800 LET A(B,C)=3
810 LET E(6)=B
820 LET F(6)=C
830 FOR D=1 TO 5
840 IF A(E(D),F(D))<>2 THEN 1020
850 LET A(E(D),F(D))=0
860 IF E(D)>=B THEN 890
870 LET E(D)=E(D)+1
880 GOTO 910
890 IF E(D)=B THEN 910
900 LET E(D)=E(D)-1
910 IF F(D)>=C THEN 940
920 LET F(D)=F(D)+1
930 GOTO 960
940 IF F(D)=C THEN 960
950 LET F(D)=F(D)-1
960 IF A(E(D),F(D))=3 THEN 1080
970 IF A(E(D),F(D))=0 THEN 1000
980 LET G=G+1
990 GOTO 1010
1000 LET A(E(D),F(D))=2
1010 IF G=5 THEN 1100
1020 NEXT D
1030 GOTO 500
1040 PRINT "SORRY TO SEE YOU QUIT"
1050 GOTO 1110
1060 PRINT "ZAP!!! YOU TOUCHED THE FENCE !!!!!"
1070 GOTO 1110
1080 PRINT "** YOU HAVE BEEN DESTROYED BY A LUCKY COMPUTER **"
1090 GOTO 1110
1100 PRINT "YOU ARE LUCKY **YOU DESTROYED ALL THE ENEMY**"
1110 PRINT "WANT TO PLAY AGAIN";
1120 INPUT C$
1130 IF LEFT$(C$,1)="Y" THEN 240
1140 IF LEFT$(C$,1)<>"N" THEN 1110
1150 PRINT "HOPE YOU DON'T FEEL FENCED IN."
1160 PRINT "TRY AGAIN SOMETIME"
1170 END
0
1140 IF LEFT$(C$,1)<>"N" THEN 1110
1150 PRINT "HOPE YOU DON'T FEEL FENCED IN."
1160 PRINT "TRY AGAIN SOMET

498
software/BAS/CHESS.bas
View File

@@ -1,498 +0,0 @@
100 REM--CHESS BY RANDY MILLER, JAN, 1976
110 DEFINT A-Z:DEFSNG E:DEFSNG M:DEFSNG P
120 DIM PS(70,3),MV(35,2),V(32)
130 DIM B(8,8),TM(8,8)
140 DEF FNL(X)=X\10
150 DEF FNM(X)=X MOD(10)
160 TM(1,1)=0
170 FOR X=1 TO 32
180 READ V(X)
190 NEXT
200 FOR Y=1 TO 8
210 FOR X=1 TO 8
220 READ B(X,Y)
230 NEXT X:NEXT Y
240 DATA -2,1,-1,2,1,2,2,1,2,-1,1,-2,-1,-2,-2,-1
250 DATA 8,12,19,21,-8,-12,-19,-21
260 DATA 1,9,10,11,-1,-9,-10,-11
270 DATA 4,2,3,6,5,3,2,4,1,1,1,1,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0
280 DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,-1,-1,-1,-1
290 DATA -1,-1,-1,-1,-4,-2,-3,-6,-5,-3,-2,-4
300 CB=3:CW=3
310 PRINT:PRINT:PRINT:PRINT TAB(10);"**** CHESS ****"
320 INPUT "DO YOU WANT TO BE WHITE OR BLACK";C$
330 IF LEFT$(C$,1)="B" THEN 370
340 B(4,1)=5:B(4,8)=-5
350 B(5,1)=6:B(5,8)=-6
360 GOTO 380
370 PRINT "THANK YOU, THAT MEANS I GET TO GO FIRST":PRINT
380 FOR Y=1 TO 8
390 FOR X=1 TO 8
400 TM(X,Y)=B(X,Y)
410 NEXT X:NEXT Y
420 IF LEFT$(C$,1)<>"B" THEN 840
430 NB=1
440 REM -- COMPILE LIST OF POSSIBLE MOVES --
450 FOR X=1 TO 8
460 FOR Y=1 TO 8
470 IF SGN(B(X,Y))<>1 THEN 550
480 GOSUB 1870
490 FOR D=1 TO N
500 IF MV(D,1)=0 THEN 540
510 PS(NB,1)=MV(D,1)
520 PS(NB,2)=MV(D,2)
530 NB=NB+1
540 NEXT D
550 NEXT Y
560 NEXT X
570 PRINT:PRINT "NUMBER OF POSSIBLE MOVES FOR COMPUTER";NB-1:PRINT
580 IF NB>1 THEN PRINT "FROM TO BOARD VALUE":GOTO 620
590 PRINT "I DON'T BELIEVE IT! - YOU WON!!!"
600 END
610 REM -- EVALUATE EACH POSSIBLE MOVE --
620 FOR D=1 TO NB-1
630 D1=FNL(PS(D,1))
640 D2=FNM(PS(D,1))
650 D3=FNL(PS(D,2))
660 D4=FNM(PS(D,2))
670 D5=B(D3,D4)
680 TM(D3,D4)=TM(D1,D2)
690 TM(D1,D2)=0
700 GOSUB 1530
710 PS(D,3)=EV
720 TM(D1,D2)=TM(D3,D4)
730 TM(D3,D4)=D5
740 PRINT PS(D,1);PS(D,2);TAB(12);PS(D,3)
750 NEXT D
760 REM
770 MZ=PS(1,3):MX=1
780 IF NB=2 THEN 830
790 FOR D=2 TO NB-1
800 IF PS(D,3)<=MZ THEN 820
810 MX=D:MZ=PS(D,3)
820 NEXT D
830 GOSUB 1290
840 GOSUB 870
850 PRINT
860 GOTO 430
870 REM -- INPUT ROUTINE --
880 GOTO 910
890 INPUT "YOUR MOVE";M,N
900 IF M<>0 THEN 930
910 FOR P=1 TO 8:FOR P1=1 TO 8:PRINT B(P1,P);:NEXT P1:PRINT:NEXT P
920 GOTO 890
930 X1=FNL(M):Y1=FNM(M):X2=FNL(N):Y2=FNM(N)
940 IF X1>8 OR X1<1 OR Y1>8 OR Y1<1 THEN 970
950 IF X2>8 OR X2<1 OR Y2>8 OR Y2<1 THEN 970
960 IF SGN(B(X1,Y1))=-1 THEN 990
970 PRINT "YOU CAN'T DO THAT."
980 GOTO 890
990 REM
1000 FOR P=1 TO 8
1010 FOR P1=1 TO 8
1020 TM(P,P1)=B(P,P1)
1030 NEXT P1
1040 NEXT P
1050 GOSUB 3690
1060 IF LG=0 THEN 970
1070 TM(X2,Y2)=TM(X1,Y1)
1080 TM(X1,Y1)=0
1090 B(X2,Y2)=B(X1,Y1)
1100 B(X1,Y1)=0
1110 PRINT "ACCEPTED."
1120 IF Y2<>1 OR B(X2,Y2)<>-1 THEN 1180
1130 PRINT "TO PROMOTE YOUR PAWN TO A KNIGHT, TYPE 2; FOR A BISHOP,"
1140 PRINT "TYPE 3; FOR A ROOK, TYPE 4; FOR A QUEEN, TYPE 5";
1150 INPUT P
1160 IF P>5 OR P<2 THEN 1130
1170 B(X2,Y2)=-P:TM(X2,Y2)=-P
1180 IF B(X2,Y2)<>-6 OR ABS(X1-X2)<>2 THEN 1240
1190 IF X1-X2=2 THEN 1250
1200 B(8,8)=0:TM(8,8)=0
1210 B(X2-1,8)=-4:TM(X2-1,8)=-4
1220 CB=(CB AND -3)
1230 PRINT "IT'S ABOUT TIME YOU CASTLED!":PRINT
1240 RETURN
1250 B(1,8)=0:TM(1,8)=0
1260 B(X2+1,8)=-4:TM(X2+1,8)=-4
1270 CB=(CB AND -3)
1280 GOTO 1230
1290 REM -- OUTPUT ROUTINE --
1300 IF PS(MX,3)<200 THEN 1350
1310 PRINT "HA - LET'S SEE YOU GET OUT OF THIS -"
1320 PRINT "I MOVE";PS(MX,1);"TO";PS(MX,2)
1330 PRINT "THANKS FOR THE GOOD GAME..."
1340 END
1350 ON INT(RND(1)*4)+1 GOTO 1360,1370,1380,1390
1360 PRINT "I RECKON I'LL MOVE ";:GOTO 1400
1370 PRINT "I GUESS I'LL TAKE";:GOTO 1400
1380 PRINT "MY MOVE IS";:GOTO 1400
1390 PRINT "I LIKE";
1400 PRINT PS(MX,1);"TO";PS(MX,2):PRINT
1410 D1=FNL(PS(MX,1))
1420 D2=FNM(PS(MX,1))
1430 D3=FNL(PS(MX,2))
1440 D4=FNM(PS(MX,2))
1450 B(D3,D4)=B(D1,D2)
1460 B(D1,D2)=0
1470 IF D4<>8 OR B(D3,D4)<>1 THEN 1500
1480 PRINT "I PROMOTE MY PAWN TO A QUEEN!"
1490 B(D3,D4)=5
1500 RETURN
1510 REM
1520 EV=RND(1):RETURN
1530 EV=RND(1)/2:US=0
1540 EV=EV+D4/7
1550 FOR PJ=1 TO 8
1560 IF TM(PJ,8)<>1 THEN 1590
1570 TM(PJ,8)=5
1580 GOTO 1610
1590 NEXT PJ
1600 IF SGN(D5)=-1 THEN EV=EV-D5
1610 FOR X=1 TO 8
1620 FOR Y=1 TO 8
1630 CX=TM(X,Y):CS=SGN(CX)
1640 IF CS<>-1 THEN 1750
1650 EV=EV+CX
1660 GOSUB 1840
1670 IF N=0 THEN 1750
1680 US=US+N:EV=EV-.166666
1690 FOR UX=1 TO N
1700 U1=MV(UX,1):U2=MV(UX,2)
1710 IF SGN(TM(FNL(U2),FNM(U2)))<>1 THEN 1740
1720 IF SGN(TM(FNL(U1),FNM(U1)))<>-1 THEN 1740
1730 EV=EV-2*TM(FNL(U2),FNM(U2))
1740 NEXT UX
1750 NEXT Y
1760 NEXT X
1770 IF US>0 THEN 1800
1780 EV=EV+1000
1790 GOTO 1810
1800 FOR X=3 TO 6:FOR Y=3 TO 6:EV=EV+TM(X,Y)/3:NEXTY:NEXTX
1810 IF PJ>8 THEN 1830
1820 TM(PJ,8)=1
1830 RETURN
1840 REM
1850 R=0
1860 GOTO 1880
1870 R=1
1880 MV(1,1)=0
1890 S1=SGN(TM(X,Y))
1900 AA=X*10+Y
1910 N=1
1920 ON ABS(TM(X,Y)) GOSUB 2330,2770,2880,3140,3400,3440
1930 IF N=1 THEN 1950
1940 IF R=1 THEN 1970
1950 N=N-1
1960 RETURN
1970 REM -- IF RESTRICTED --
1980 N1=N-1
1990 N=N1
2000 FOR K=1 TO N1
2010 C1=FNL(MV(K,1))
2020 C2=FNM(MV(K,1))
2030 C3=FNL(MV(K,2))
2040 C4=FNM(MV(K,2))
2050 IF ABS(TM(C3,C4))=6 THEN 2070
2060 IF SGN(TM(C3,C4))<>S1 THEN 2080
2070 MV(K,1)=0:MV(K,2)=0:GOTO 2290
2080 C5=TM(C3,C4)
2090 TM(C3,C4)=TM(C1,C2)
2100 TM(C1,C2)=0
2110 REM -- FIND KING --
2120 FOR Y2=1 TO 8
2130 FOR X2=1 TO 8
2140 IF TM(X2,Y2)=6*S1 THEN 2170
2150 NEXT X2
2160 NEXT Y2
2170 REM
2180 FOR Y1=1 TO 8
2190 FOR X1=1 TO 8
2200 IF SGN(TM(X1,Y1))<>-S1 THEN 2250
2210 IF TM(X1,Y1)<>-S1 THEN 2230
2220 IF X1=X2 AND ABS(Y2-Y1)>2 THEN 2250
2230 GOSUB 3660
2240 IF LG=1 THEN 2310
2250 NEXT X1
2260 NEXT Y1
2270 TM(C1,C2)=TM(C3,C4)
2280 TM(C3,C4)=C5
2290 NEXT K
2300 RETURN
2310 MV(K,1)=0:MV(K,2)=0
2320 GOTO 2250
2330 REM -- RAW PAWN MOVE --
2340 IF S1=-1 THEN 2560
2350 IF Y+1>8 THEN 2550
2360 IF TM(X,Y+1)<>0 THEN 2450
2370 MV(N,1)=AA
2380 MV(N,2)=X*10+Y+1
2390 N=N+1
2400 IF Y>2 THEN 2450
2410 IF TM(X,Y+2)<>0 THEN 2450
2420 MV(N,1)=AA
2430 MV(N,2)=X*10+Y+2
2440 N=N+1
2450 IF X=1 THEN 2500
2460 IF SGN(TM(X-1,Y+1))<>-S1 THEN 2500
2470 MV(N,1)=AA
2480 MV(N,2)=(X-1)*10+Y+1
2490 N=N+1
2500 IF X=8 THEN 2550
2510 IF SGN(TM(X+1,Y+1))<>-S1 THEN 2550
2520 MV(N,1)=AA
2530 MV(N,2)=(X+1)*10+Y+1
2540 N=N+1
2550 RETURN
2560 IF Y-1<1 THEN 2760
2570 IF TM(X,Y-1)<>0 THEN 2660
2580 MV(N,1)=AA
2590 MV(N,2)=X*10+Y-1
2600 N=N+1
2610 IF Y<7 THEN 2660
2620 IF TM(X,Y-2)<>0 THEN 2660
2630 MV(N,1)=AA
2640 MV(N,2)=X*10+Y-2
2650 N=N+1
2660 IF X=1 THEN 2710
2670 IF SGN(TM(X-1,Y-1))<>-S1 THEN 2710
2680 MV(N,1)=AA
2690 MV(N,2)=(X-1)*10+Y-1
2700 N=N+1
2710 IF X=8 THEN 2760
2720 IF SGN(TM(X+1,Y-1))<>-S1 THEN 2760
2730 MV(N,1)=AA
2740 MV(N,2)=(X+1)*10+Y-1
2750 N=N+1
2760 RETURN
2770 REM -- RAW KNIGHT MOVE --
2780 FOR C6=1 TO 15 STEP 2
2790 KL=V(C6):KM=V(C6+1)
2800 XT=X+KL
2810 YT=Y+KM
2820 IF XT>8 OR XT<1 OR YT>8 OR YT<1 THEN 2860
2830 MV(N,1)=AA
2840 MV(N,2)=XT*10+YT
2850 N=N+1
2860 NEXT C6
2870 RETURN
2880 REM -- RAW BISHOP MOVE --
2890 EL=(8-Y)*-(8-Y<=8-X)+(8-X)*-(8-X < 8-Y)
2900 IF EL=0 THEN 2930
2910 C6=11
2920 GOSUB 3060
2930 EL=(8-Y)*-(8-Y <= X-1)+(X-1)*-(X-1 < 8-Y)
2940 IF EL=0 THEN 2970
2950 C6=-9
2960 GOSUB 3060
2970 EL=(8-X)*-(8-X <= Y-1)+(Y-1)*-(Y-1 < 8-X)
2980 IF EL=0 THEN 3010
2990 C6=9
3000 GOSUB 3060
3010 EL=(Y-1)*-(Y-1 <= X-1)+(X-1)*-(X-1 < Y-1)
3020 IF EL=0 THEN 3050
3030 C6=-11
3040 GOSUB 3060
3050 RETURN
3060 FOR E=1 TO EL
3070 F=C6*E
3080 MV(N,1)=AA
3090 MV(N,2)=AA+F
3100 N=N+1
3110 IF TM(FNL(AA+F),FNM(AA+F))<>0 THEN 3130
3120 NEXT E
3130 RETURN
3140 REM -- RAW ROOK MOVE --
3150 EL=8-Y
3160 IF EL=0 THEN 3190
3170 C6=1
3180 GOSUB 3320
3190 EL=Y-1
3200 IF EL=0 THEN 3230
3210 C6=-1
3220 GOSUB 3320
3230 EL=8-X
3240 IF EL=0 THEN 3270
3250 C6=10
3260 GOSUB 3320
3270 EL=X-1
3280 IF EL=0 THEN 3310
3290 C6=-10
3300 GOSUB 3320
3310 RETURN
3320 FOR E=1 TO EL
3330 F=C6*E
3340 MV(N,1)=AA
3350 MV(N,2)=AA+F
3360 N=N+1
3370 IF TM(FNL(AA+F),FNM(AA+F))<>0 THEN 3390
3380 NEXT E
3390 RETURN
3400 REM -- RAW QUEEN MOVE --
3410 GOSUB 2880
3420 GOSUB 3140
3430 RETURN
3440 REM -- RAW KING MOVE --
3450 IF X=8 THEN 3510
3460 C6=10:GOSUB 3620
3470 IF Y=1 THEN 3500
3480 C6=9:GOSUB 3620
3490 IF Y=8 THEN 3520
3500 C6=11:GOSUB 3620
3510 IF X=1 THEN 3570
3520 C6=-10:GOSUB 3620
3530 IF Y=8 THEN 3570
3540 C6=-9:GOSUB 3620
3550 IF Y=1 THEN 3570
3560 C6=-11:GOSUB 3620
3570 IF Y=1 THEN 3590
3580 C6=-1:GOSUB 3620
3590 IF Y=8 THEN 3610
3600 C6=1:GOSUB 3620
3610 RETURN
3620 MV(N,1)=AA
3630 MV(N,2)=AA+C6
3640 N=N+1
3650 RETURN
3660 REM
3670 RR=0
3680 GOTO 3700
3690 RR=1
3700 IF TM(X1,Y1)<>0 THEN 3720
3710 LG=0:RETURN
3720 S=SGN(TM(X1,Y1))
3730 A=X1*10+Y1
3740 B=X2*10+Y2
3750 ON ABS(TM(X1,Y1)) GOSUB 4070,4270,4340,4510,4630,4680
3760 IF LG=0 THEN RETURN
3770 IF RR=1 THEN 3790
3780 LG=1:RETURN
3790 REM -- IF RESTRICTED --
3800 IF S=SGN(TM(X2,Y2)) THEN 3710
3810 T1=X1:T2=Y1:T3=X2:T4=Y2:T=TM(X2,Y2)
3820 TM(X2,Y2)=TM(X1,Y1):TM(X1,Y1)=0
3830 SV=S
3840 REM -- FIND KING --
3850 FOR Y2=1 TO 8
3860 FOR X2=1 TO 8
3870 IF TM(X2,Y2)=6*S THEN 3910
3880 NEXT X2
3890 NEXT Y2
3900 END
3910 REM
3920 FOR Y1=1 TO 8
3930 FOR X1=1 TO 8
3940 P=TM(X1,Y1):IF SGN(P)=S OR P=0 OR ABS(P)=6 THEN 3980
3950 GOSUB 3660
3960 S=SV
3970 IF LG=1 THEN 4050
3980 NEXT X1
3990 NEXT Y1
4000 LG=1
4010 TM(T1,T2)=TM(T3,T4)
4020 TM(T3,T4)=T
4030 X1=T1:Y1=T2:X2=T3:Y2=T4
4040 RETURN
4050 LG=0
4060 GOTO 4010
4070 REM -- RAW PAWN MOVE --
4080 IF SGN(Y2-Y1)=S THEN 4110
4090 LG=0:RETURN
4100 LG=1:RETURN
4110 IF S=-1 THEN 4190
4120 IF B-A=1 OR B-A=2 THEN 4160
4130 IF TM(X2,Y2)=0 THEN 4090
4140 IF B-A=-9 OR B-A=11 THEN 4100
4150 GOTO 4090
4160 IF Y2=2 THEN 4100
4170 IF B-A=1 THEN 4100
4180 GOTO 4090
4190 IF A-B=1 OR A-B=2 THEN 4230
4200 IF TM(X2,Y2)=0 THEN 4090
4210 IF A-B=-9 OR A-B=11 THEN 4100
4220 GOTO 4090
4230 IF Y2=7 THEN 4100
4240 IF A-B=1 THEN 4100
4250 IF Y1=7 AND A-B=2 THEN 4100
4260 GOTO 4090
4270 REM -- RAW KNIGHT MOVE --
4280 FOR P=17 TO 24
4290 P1=V(P)
4300 IF A+P1<>B THEN 4320
4310 LG=1:RETURN
4320 NEXT P
4330 LG=0:RETURN
4340 REM -- RAW BISHOP MOVE --
4350 IF Y2=Y1 OR X2=X1 THEN 4420
4360 SP=-9
4370 IF X2<X1 THEN 4470
4380 IF Y1<Y2 THEN 4430
4390 SP=9
4400 P=INT(ABS(A-B)/9)
4410 IF ABS(A-B)/9=P THEN 4490
4420 LG=0:RETURN
4430 SP=11
4440 P=INT(ABS(A-B)/11)
4450 IF ABS(A-B)/11<>P THEN 4420
4460 GOTO 4490
4470 IF Y1<Y2 THEN 4400
4480 SP=-11:GOTO 4440
4490 GOSUB 4950
4500 RETURN
4510 REM -- RAW ROOK MOVES --
4520 IF Y2=Y1 THEN 4590
4530 IF X1=X2 THEN 4550
4540 LG=0:RETURN
4550 P=ABS(B-A)
4560 SP=SGN(B-A)
4570 GOSUB 4950
4580 RETURN
4590 P=ABS(INT((B-A)/10))
4600 SP=SGN(B-A)*10
4610 GOSUB 4950
4620 RETURN
4630 REM -- RAW QUEEN MOVE --
4640 GOSUB 4340
4650 IF LG=1 THEN RETURN
4660 GOSUB 4510
4670 RETURN
4680 REM -- KING MOVE --
4690 IF ABS(A-B)<>20 THEN 4890
4700 IF A-B=20 THEN 4730
4710 IF CB<>1 AND CB<>3 THEN 4880
4720 GOTO 4740
4730 IF CB=0 OR CB=1 THEN 4880
4740 PS=SGN(A-B):FORP2=28+50*((PS=-1)*-1)TOA+10-20*((PS=-1)+1)STEP10*P
4750 IF TM(FNL(P2),FNM(P2))<>0 THEN 4880
4760 NEXT P2:T1=X1:T2=Y1:T3=X2:T4=Y2
4770 FOR P2=A TO 18+70*((PS=-1)*-1) STEP 10*-PS
4780 X2=FNL(P2):Y2=FNM(P2)
4790 FOR X1=1 TO 8
4800 FOR Y1=1 TO 8
4810 IF SGN(TM(X1,Y1))<>1 THEN 4840
4820 GOSUB 3690
4830 IF LG=1 THEN 4880
4840 NEXT Y1:NEXT X1:NEXT P2
4850 LG=1
4860 X1=T1:Y1=T2:X2=T3:Y2=T4
4870 RETURN
4880 LG=0:GOTO 4860
4890 FOR P=25 TO 32
4900 P1=V(P)
4910 IF B=A+P1 THEN 4940
4920 NEXT P
4930 LG=0:RETURN
4940 LG=1:RETURN
4950 REM
4960 LG=0
4970 IF P=0 THEN STOP
4980 IF P>1 THEN 5000
4990 LG=1:RETURN
5000 FOR P1=1 TO P-1
5010 P2=A+SP*P1
5020 IF TM(FNL(P2),FNM(P2))<>0 THEN RETURN
5030 NEXT P1
5040 LG=1:RETURN
5050 END

5000 FOR P1=1 TO

BIN
software/BAS/CIRCOM.BAS
View File

Binary file not shown.

241
software/BAS/CIVILWAR.bas
View File

@@ -1,241 +0,0 @@
100 LET L=0:LET W=0:LET R1=0:LET P1=0
110 LET Q1=0:LET M3=0:LET M4=0
120 LET P2=0:LET T1=0:LET T2=0
130 REMARKABLE PROGRAM BY L. CRAM , L. GOODIE , AND D. HIBBARD
140 PRINT "DO YOU WANT DESCRIPTIONS (0=YES, 1=NO)";
150 INPUT Z
160 FOR U=1 TO 6
170 PRINT
180 NEXT U
190 IF Z=1 THEN 420
200 PRINT "THIS IS A CIVIL WAR SIMULATION."
210 PRINT "TO PLAY, TYPE A RESPONSE WHEN THE COMPUTER ASKS."
220 PRINT "REMEMBER THAT ALL FACTORS ARE INTERRELATED AND THAT YOUR"
230 PRINT "RESPONSES COULD CHANGE HISTORY. FACTS AND FIGURES USED ARE"
240 PRINT "BASED ON THE ACTUAL OCCURENCE. MOST BATTLES TEND TO RESULT"
250 PRINT "AS THEY DID IN THE CIVIL WAR, BUT IT ALL DEPENDS ON YOU!!"
260 PRINT
270 PRINT "THE OBJECT OF THE GAME IS TO WIN AS MANY BATTLES AS POSSIBLE"
280 PRINT
290 PRINT "YOUR CHOICES FOR DEFENSIVE STRATEGY ARE:"
300 PRINT " (1) ARTILLERY ATTACK"
310 PRINT " (2) FORTIFICATION AGAINST FRONTAL ATTACK"
320 PRINT " (3) FORTIFICATION AGAINST FLANKING MANUEVERS"
330 PRINT " (4) FALLING BACK"
340 PRINT "YOUR CHOICES FOR OFFENSIVE STRATEGY ARE:"
350 PRINT " (1) ARTILLERY ATTACK"
360 PRINT " (2) FRONTAL ATTACK"
370 PRINT " (3) FLANKING MANUEVERS"
380 PRINT " (4) ENCIRCLEMENT"
390 PRINT "YOU MAY SURRENDER BY TYPING A '5' FOR YOUR STRATEGY."
400 PRINT
410 PRINT "YOU ARE THE CONFEDERACY. GOOD LUCK!"
420 READ M1,M2,C1,C2,M,A,U
430 LET I1=10+(L-W)*2
440 LET I2=10+(W-L)*2
450 LET D1=100*INT((M1*(100-I1)/2000)*(1+(R1-Q1)/(R1+1))+.5)
460 LET D2=100*INT(M2*(100-I2)/2000+.5)
470 LET F1=5*M1/6
480 LET A1=Z
490 FOR U=1 TO 4
500 PRINT
510 NEXT U
520 PRINT "THIS IS THE BATTLE OF ";
530 GOSUB 1530
540 PRINT " ","CONFEDERACY"," UNION"
550 PRINT "MEN"," ";INT(M1*(1+(P1-T1)/(M3+1)))," ";
560 PRINT INT(M2*(1+(P2-T2)/(M4+1)))
570 PRINT "MONEY","$";D1,"$";D2
580 PRINT "INFLATION"," ";I1+15;"%"," ";I2;"%"
590 PRINT
600 PRINT "HOW MUCH DO YOU WISH TO SPEND FOR FOOD";
610 INPUT F
620 IF F<0 THEN 1480
630 PRINT "HOW MUCH DO YOU WISH TO SPEND FOR SALARIES";
640 INPUT S
650 IF S<0 THEN 1480
660 PRINT "HOW MUCH DO YOU WISH TO SPEND FOR AMMUNITION";
670 INPUT B
680 IF B<0 THEN 1480
690 PRINT
700 IF F+S+B<=D1 THEN 730
710 PRINT "THINK AGAIN! YOU HAVE ONLY $" D1
720 GOTO 590
730 LET O=((2*F^2+S^2)/F1^2+1)
740 IF O<10 THEN 770
750 PRINT "MORALE IS HIGH"
760 GOTO 810
770 IF O<5 THEN 800
780 PRINT "MORALE IS FAIR"
790 GOTO 810
800 PRINT "MORALE IS POOR"
810 IF M<>3 THEN 840
820 PRINT "YOU ARE ON THE OFFENSIVE"
830 GOTO 880
840 IF M<>1 THEN 870
850 PRINT "YOU ARE ON THE DEFENSIVE"
860 GOTO 880
870 PRINT "BOTH SIDES ARE ON THE OFFENSIVE"
880 PRINT
890 PRINT "YOUR STEGY";
900 INPUT Y
910 IF Y=5 THEN 2380
920 IF ABS(Y-3)<3 THEN 950
930 PRINT "YOU JERK! USE THE OTHER SET OF STRATEGIES!!"
940 GOTO 880
950 PRINT
960 PRINT " ","CONFEDERACY","UNION"
970 LET C5=(2*C1/5)*(1+1/(2*(ABS(INT(4*RND(1)+1)-Y)+1)))
980 LET C5=INT(C5*(1+1/O)*(1.28+F1/(B+1))+.5)
990 IF C5+100/O<M1*(1+(P1-T1)/(M3+1)) THEN 1040
1000 LET C5=INT(13*M1/20*(1+(P1-T1)/(M3+1)))
1010 LET E=7*C5/13
1020 LET U=1
1030 GOTO 1050
1040 LET E=100/O
1050 PRINT "CASUALTIES",C5,INT(17*C2*C1/(C5*20)+.5)
1060 PRINT "DESERTIONS",INT(E),INT(5*O)
1070 PRINT
1080 IF C5-C1>=0 THEN 1110
1090 PRINT "YOUR CASUALTIES WERE"INT(100*(C1-C5)/C1+.5);"% LESS THAN"
1100 GOTO 1120
1110 PRINT "YOUR CASUALTIES WERE"INT(100*(C5-C1)/C1+.5);"% MORE THAN"
1120 PRINT "THE ACTUAL CASUALITIES AT ";
1130 LET A1=1
1140 GO SUB800
1150 IF U=1 THEN 1170
1160 IF C5+E<17*C2*C1/(C5*20)+5*O THEN 1200
1170 PRINT "YOU LOSE ";
1180 LET L=L+1
1190 GOTO 1220
1200 PRINT "YOU WIN ";
1210 LET W=W+1
1220 GOSUB 1530
1230 IF W=8 THEN 2400
1240 LET T1=T1+C5+E
1250 LET T2=T2+17*C2*C1/(C5*20)+5*O
1260 LET P1=P1+C1
1270 LET P2=P2+C2
1280 LET Q1=Q1+(F+S+B)
1290 LET R1=R1+M1*(100-I1)/20
1300 LETM3=M3+M1
1310 LET M4=M4+M2
1320 IF A=14 THEN 2410
1330 GOTO 420
1340 DATA 18000,18500,1967,2708,1,1,0
1350 DATA 40000,44894,10699,13047,3,2,0
1360 DATA 95000,115000,20614,15849,3,3,0
1370 DATA 54000,63000,10000,14000,2,4,0
1380 DATA 40000,50000,10000,12000,3,5,0
1390 DATA 75000,120000,5377,12653,1,6,0
1400 DATA 38000,45000,11000,12000,1,7,0
1410 DATA 32000,90000,13000,17197,2,8,0
1420 DATA 50000,70000,12000,19000,1,9,0
1430 DATA 72500,85000,20000,23000,3,10,0
1440 DATA 66000,60000,18000,16000,2,11,0
1450 DATA 37000,60000,6700,5800,2,12,0
1460 DATA 62000,110000,17723,18000,2,13,0
1470 DATA 65000,100000,8500,3700,1,14,0
1480 PRINT "GO TO JAIL."
1490 PRINT "GO DIRECTLY TO JAIL."
1500 PRINT "DO NOT PASS GO."
1510 PRINT "DO NOT COLLECT $200"
1520 GOTO 490
1530 IF A<>1 THEN 1600
1540 PRINT "BULL RUN"
1550 IF A1=1 THEN 2360
1560 PRINT"JULY 21,1861 GEN. BEAUREGARD COMMANDING THE SOUTH MET THE"
1570 PRINT"UNION FORCES WITH GEN MCDOWELL IN A PREMATURE BATTLE AT BULL"
1580 PRINT"RUN. GEN. JACKSON HELPED PUSH BACK THE UNION ATTACK."
1590 GOTO 2360
1600 IF A<>2 THEN 1660
1610 PRINT "SHILOH"
1620 IF A1=1 THEN 2360
1630 PRINT"APRIL 6-7,1862 THE CONFEDERATE SURPRISE ATTACK AT SHILOH"
1640 PRINT"FAILED DUE TO POOR ORGANIZATION."
1650 GOTO 2360
1660 IF A<>3 THEN 1730
1670 PRINT "SEVEN DAYS"
1680 IF A1=1 THEN 2360
1690 PRINT"JUNE 25-JULY 1,1862 GENERAL LEE (CSA) UPHELD THE OFFENSIVE"
1700 PRINT"THROUGHOUT THE BATTLE AND FORCED GEN. MCCLELLAN AND THE UNION"
1710 PRINT"FORCES AWAY FROM RICHMOND."
1720 GOTO 2360
1730 IF A<>4 THEN 1790
1740 PRINT "THE SECOND BULL RUN"
1750 IF A1=1 THEN 2360
1760 PRINT"AUG 29-30,1862 THE COMBINED CONFEDERATE FORCES UNDER LEE AND"
1770 PRINT"JACKSON DROVE THE UNION FORCES BACK INTO WASHINGTON."
1780 GOTO 2360
1790 IF A<>5 THEN 1850
1800 PRINT "ANTIETAM"
1810 IF A1=1 THEN 2360
1820 PRINT"SEPT 17,1862 THE SOUTH FAILED TO INCORPORATE MARYLAND INTO"
1830 PRINT"THE CONFEDERACY."
1840 GOTO 2360
1850 IF A<>6 THEN 1910
1860 PRINT "FREDERICKSBURG"
1870 IF A1=1 THEN 2360
1880 PRINT"DEC 13,1862 THE CONFEDERACY UNDER LEE SUCESSFULLY REPULSED"
1890 PRINT"AN ATTACK BY THE UNION UNDER GEN. BURNSIDE."
1900 GOTO 2360
1910 IF A <>7 THEN 1960
1920 PRINT "MURFREESBORO"
1930 IF A1=1 THEN 2360
1940 PRINT"DEC 31,1862 THE SOUTH UNDER GEN. BRAGG WON A CLOSE BATTLE"
1950 GOTO 2360
1960 IF A<>8 THEN 2020
1970 PRINT "CHANCELLORSVILLE"
1980 IF A1=1 THEN 2360
1990 PRINT"MAY 1-6,1863 THE SOUTH HAD A COSTLY VICTORY AND LOST ONE"
2000 PRINT"OF THEIR OUTSTANDING GENERALS, 'STONEWALL' JACKSON."
2010 GOTO 2360
2020 IF A<>9 THEN 2080
2030 PRINT "VICKSBURG"
2040 IF A1=1 THEN 2360
2050 PRINT"JULY 4,1863 VICKSBURG WAS A COSTLY DEFEAT FOR THE SOUTH"
2060 PRINT"BECAUSE IT GAVE THE UNION ACCESS TO THE MISSISSIPPI."
2070 GOTO 2360
2080 IF A<>10 THEN 2140
2090 PRINT "GETTYSBURG"
2100 IF A1=1 THEN 2360
2110 PRINT"JUNE 30,1863 A SOUTHERN MISTAKE BY GEN. LEE AT GETTYSBURG"
2120 PRINT"COST THEM ONE OF THE MOST CRUCIAL BATTLES OF THR WAR."
2130 GOTO 2360
2140 IF A<>11 THEN 2200
2150 PRINT "CHICKAMAUGA"
2160 IF A1=1 THEN 2360
2170 PRINT"NOV 25,1863 AFTER THE SOUTH HAD SIEGED GEN. ROSENCRANS'"
2180 PRINT"ARMY FOR THREE MONTHS, GEN. GRANT BROKE THE SIEGE."
2190 GOTO 2360
2200 IF A<>12 THEN 2260
2210 PRINT "CHATTANOOGA"
2220 IF A1=1 THEN 2360
2230 PRINT"SEPT 15,1863 CONFUSION IN A FOREST NEAR CHICKAMAUGA LED"
2240 PRINT"TO A COSTLY SOUTHERN VICTORY."
2250 GOTO 2360
2260 IF A<>13 THEN 2320
2270 PRINT "SPOTSYLVANIA"
2280 IF A1=1 THEN 2360
2290 PRINT"MAY 5,1864 GRANT'S PLAN TO KEEP LEE ISOLATED BEGAN TO FAIL"
2300 PRINT"HERE, AND CONTINUED AT COLD HARBOR AND PETERSBURG."
2310 GOTO 2360
2320 PRINT "ATLANTA"
2330 IF A1=1 THEN 2360
2340 PRINT"AUGUST, 1864 SHERMAN AND THREE VETERAN ARMIES CONVERGED ON"
2350 PRINT"ATLANTA AND DEALT THE DEATH BLOW TO THE CONFEDERACY."
2360 PRINT
2370 RETURN
2380 PRINT "THE CONFEDERACY HAS SURRENDERED"
2390 GOTO 2410
2400 PRINT "THE UNION HAS SURRENDERED"
2410 PRINT
2420 PRINT "YOU HAVE WON" W; "BATTLES AND LOST" L; "BATTLES."
2430 IF Y=5 THEN 2470
2440 IF W<=L THEN 2470
2450 PRINT "THE CONFEDERACY HAS WON THE WAR"
2460 STOP
2470 PRINT "THE UNION HAS WON THE WAR"
2480 END
IF W<=L THEN 2470
2450 PRINT "THE CONFED

200
software/BAS/CLIMATES.bas
View File

@@ -1,200 +0,0 @@
100 REM--E.A.GALLETTA,PATCHOGUE-H.S.,4/22/69 EARTH SIENCE (BIICAC)
110 REM--PROGRAM ON CLIMATES
120 REM--REWRITTEN--7/28/69--BASIC--<ROD>
130 REM REVISED BY TONY PEREZ, WALT WHITMAN HS, 8-69
140 REM RE-REVISED BY C.LOSIK 8-26-70
150 DIML(56)
160 READN,L(N)
170 IFN<>56THEN 160
180 T=0
190 PRINT"O.K., HERE ARE SOME VALUES FOR THE PRECIPIATION (P) AND FOR
200 PRINT"THE POTENTIAL EVAPOTRANSPIRATION (PE) OF AN AREA:"
210 PRINT
220 PRINT" ","MONTH"," P"," PE"
230 PRINT" ","=====","=====","======"
240 P=INT(10*RND(1))
250 IFP>6THEN240
260 IFP<1THEN240
270 E=INT(10*RND(1))
280 IFE>4THEN270
290 IFE<1THEN270
300 Z=5*E+6*P
310 IF (Z-21)*(Z-22)*(Z-17)*(Z-38)=0 THEN 240
320 FORI=1TO12
330 PRINT" ",I,
340 IFP>1THEN360
350 P1=12*COS(.261*I)^2+2*RND(1)
360 IFP<>2THEN380
370 P1=12*SIN(.261*I)+2*RND(1)
380 IFP<>3THEN400
390 P1=2+3*RND(1)
400 IFP<>4THEN420
410 P1=2*RND(1)
420 IFP<>5THEN440
430 P1=7+10*RND(1)
440 IFP<>6THEN460
450 P1=3*COS(.5+.15*I)^2
460 PRINTINT(P1),
470 IFE>1THEN490
480 E1=10*SIN(.261*I)^2
490 IFE<>2THEN510
500 E1=12*SIN(.261*I)^2
510 IFE<>3THEN530
520 E1=2*SIN(.5+.15*I)^2
530 IFE<>4THEN550
540 E1=8+4*RND(1)
550 T=T+INT(P1)
560 PRINTINT(E1+(E1/10)*2)
570 NEXTI
580 PRINT
590 PRINT"TOTAL PRECIPITATION =";T;"INCHES"
600 PRINT
610 PRINT"O.K., PLOT YOUR GRAPH ON THE PAPER PROVIDE YOU"
620 PRINT"AND WHEN YOU ARE READY TO CONTINUE.... MEREY TYPE"
630 PRINT"ANY NUMBER AND THE RETURN KEY. ";
640 INPUTQ
650 PRINT
660 PRINT"READY? GOOD, NOW TELL ME . . . DOES YOUR GRAPH SHOW THAT"
670 PRINT"THE CLIMATE HAS DEFINITE WET AND DRY SEASONS (1=YES, 0=NO) "
680 INPUT S
690 PRINT
700 IFS=0THEN880
710 IF S<>1 THEN 660
720 IFP<3THEN990
730 B=0
740 GOSUB 1960
750 PRINT"TELL ME, IS THE CLIMATE [1] WET, [2] DRY, R [3] MODERATE ALL"
760 PRINT"YEAR";
770 INPUT S
780 PRINT
790 IFS=1THEN920
800 IFS=3THEN960
810 IF S<>2 THEN 750
820 IFT<13THEN1130
830 IFT>80THEN860
840 GOSUB1950
850 GOTO1140
860 GOSUB1910
870 GOTO1140
880 IFP>2THEN750
890 IFP=2THEN820
900 GOSUB1910
910 GOTO990
920 IFT>80THEN1130
930 IFT>=13THEN840
940 GOSUB1930
950 GOTO1140
960 IF(T-13)*(80-T)>=0THEN1130
970 IFT<13THEN940
980 IFT>80THEN860
990 PRINT"TELL ME, WHICH IS THE WET SEASON, [1] THE WINTER OR [2] THE"
1000 PRINT"SUMMER";
1010 PRINT
1020 INPUT S
1030 PRINT
1040 IFS=1THEN1090
1050 IF S<>2 THEN 990
1060 IFP=2THEN1130
1070 GOSUB1910
1080 GOTO1140
1090 IFP=1THEN1130
1100 GOSUB1910
1110 GOTO1140
1120 PRINT
1130 PRINT"NICE GOING, SMARTY PANTS. KEEP UP THE GOODWORK."
1140 PRINT"BY CHECKING THE PE CURVE ON YOUR GRAPH, WOUD YOU SAY THAT THE"
1150 PRINT"SUMMERS ARE [1] HOT, [2] WARM, OR [3] COOL"
1160 INPUT S
1170 PRINT
1180 IFS=2THEN1260
1190 IFS=3THEN1300
1200 IF S<>1 THEN 1130
1210 IFE=2THEN1320
1220 IFE=4THEN1320
1230 IF E=1 THEN 1320
1240 GOSUB1910
1250 GOTO1330
1260 IFE=1THEN1320
1270 IFE<>3THEN1240
1280 GOSUB1950
1290 GOTO1330
1300 IFE=3THEN1320
1310 IFE<>3THEN1240
1320 PRINT"YOU HAVE RESTORED MY FAITH IN TEENAGERS."
1330 PRINT"FROM THE SAME INFORMATION (PE GRAPH), WOULD YOU SAY THAT THE"
1340 PRINT"WINTERS ARE [1] COLD, [2] MILD, OR [3] WARM";
1350 INPUT S
1360 PRINT
1370 IFS=2THEN1450
1380 IFS=3THEN1490
1390 IF S<>1 THEN 1330
1400 IFE<3THEN1520
1410 GOSUB1930
1420 GOTO1530
1430 GOSUB1950
1440 GOTO1530
1450 IFE=3THEN1520
1460 IFE=4THEN1430
1470 GOSUB1910
1480 GOTO1530
1490 IFE=3THEN1410
1500 IFE=4THEN1530
1510 GOTO1470
1520 PRINT"IT WARMS MY HEART TO HEAR YOU SAY THAT. GOOD GOING."
1530 PRINT
1540 PRINT"WELL, BY NOW YOU MUST HAVE AN INKLING AS TO THE TYPE OF"
1550 PRINT"CLIMATE WE HAVE HERE. BELOW IS A COMPLETE LISTING OF ALL THE
1560 PRINT"CLIMATES IN THE WORLD. REFER TO THEM BY THEIR NUMBER ONLY."
1570 PRINT
1580 PRINT
1590 PRINT"NUMBER","NAME OF CLIMATE"
1600 PRINT"======","==============="
1610 PRINT"1","TROPICAL RAINFOREST"
1620 PRINT"2","TROPICAL EAST COAST"
1630 PRINT"3","TROPICAL MONSOON"
1640 PRINT"4","TROPICAL SAVANNA"
1650 PRINT"5","TROPICAL DESERT"
1660 PRINT"6","MEDITERRANEAN"
1670 PRINT"7","MARINE WEST COAST"
1680 PRINT"8","HUMID CONTINENTAL"
1690 PRINT"9","HUMID SUBTROPICAL"
1700 PRINT"10","MIDDLE LATITUDE GRASSLANDS"
1710 PRINT"11","MIDDLE LATITUDE DESERT"
1720 PRINT"12","SUBARTIC CLIMATES"
1730 PRINT"13 OR 14","HIGHLAND CLIMATES"
1740 PRINT" ","(TROPICAL OR MIDDLE LATITUDES)"
1750 PRINT"15","POLAR TUNDRA"
1760 PRINT"16","POLAR ICECAP"
1770 PRINT
1780 PRINT"WHAT IS THE NUMBER OF THE CLIMATE WE HAVE (WE'LL ACCEPT THE"
1790 PRINT "FACT THAT THEY MAY OVERLAP)";
1800 INPUTS
1810 PRINT
1820 PRINT
1830 PRINT
1840 IFS=L(Z)THEN1880
1850 PRINT"MY SUGGESTION - STICK TO LANGUAGES OR SOCIAL STUDIES."
1860 PRINT"YOU SHOULD HAVE SAID";L(Z);". GOOD DAY TO YOU."
1870 STOP
1880 PRINT"YOUR FORTUNE AS A METEOROLOGIST IS BUDDING. IT WAS"
1890 PRINT"VERY NICE TO WORK WITH YOU. SO LONG."
1900 STOP
1910 B=1
1920 GOTO1960
1930 B=2
1940 GOTO1960
1950 B=3
1960 PRINT"AW C'MON, YOU COULDN'T POSSIBLY MEAN THAT..."
1970 PRINT"YOU SHOULD HAVE SAID";B
1980 PRINT
1990 RETURN
2000 DATA11,6,16,7,23,10,26,3,27,15
2010 DATA28,8,29,11,32,3,33,13,34,11
2020 DATA 35,9,39,16,40,8,41,13,44,5
2030 DATA46,10,45,16,50,1,51,12,56,4
2040 DATA39,4,44,5,35,9,40,8,45,1,41,15,46,12,51,5,56,16
2050 DATA0,0
2060 END
,44,5
2030 DATA46,10,45,16,50,1,51,12,56,4
2040 DATA39,4,44,5,35,9,40,8,45,1,41,15,46,12,51,5,56,16

199
software/BAS/CLOUD-9.bas
View File

@@ -1,199 +0,0 @@
10 REM--A.C.CAGGIANO+E.A.GALLETTA, PATCHOGUE H.S., 11-20-68
11 REM--REVISED BY CHARLES LOSIK AND TONY PEREZ 7/18/69
12 REM RE-REVISED BY C.LOSIK 8-26-70
20 REM--THIS PROGRAM IS ASSOCIATED WITH CLOUD FORMATION
25 REM PHASE I OF PROGRAM BEGINS HERE. STUDENTS WILL BE GIVEN
26 REM INTRODUCTORY INFORMATION AND BE ALLOWED TO ASK AND ANSWER
27 REM ANY NUMBER OF PROBLEMS. WHEN THEY INPUT NO. 2 (LINES 554-556)
28 REM PROGRAM SENDS THEM TO PHASE II (LINE 561 AND FOLLOWING).
30 PRINT" ","CLOUD NINE"
40 PRINT" ","===== ===="
45 DIM B(2), T(4), Q(3), A(3), C(3)
50 PRINT
60 PRINT" STRONG CONVECTION CURRENTS ARE CAUSING ADIABATIC"
70 PRINT"COOLING OF AIR WHERE YOU ARE AND ARE RESPONSIBLE FOR THE"
80 PRINT"FORMATION OF A CLOUD. BOTH THE DRY AND THE MOIST ADIABATIC"
90 PRINT"(AS WELL AS THE NORMAL LAPSE RATES) ARE CONSIDERED IN THIS"
91 PRINT"PROGRAM."
100 PRINT
105 PRINT
110 PRINT" ","LEGEND"
120 PRINT" ","======"
140 PRINT"1=";
150 GOSUB1000
160 PRINT"2=";
170 GOSUB1010
180 PRINT"3=";
190 GOSUB1020
200 PRINT"4=";
210 GOSUB1030
220 PRINT
225 PRINT
230 PRINT"CHOOSE ANY TWO OF THE ABOVE VARIABLES AND SELECT VALUES FOR"
231 PRINT"THEM. TYPE THEM IN AS:"
232 PRINT"VARIABLE CODE ,VALUE, VARIABLE CODE ,VALUE...(E.G. 1,50,2,30)"
233 PRINT
240 X=0
242 Y=0
245 A=0
246 B=0
247 B(1)=0
248 B(2)=0
250 INPUTB(1),A,B(2),B
290 PRINT
300 FORI=1TO4
310 IFB(1)=ITHEN330
320 NEXTI
330 T(I)=A
340 FORJ=1TO4
350 IFB(2)=JTHEN370
360 NEXTJ
370 T(J)=B
380 IFI<>JTHEN405
390 PRINT"YOU CAN'T USE THE SAME VALUES TWICE."
395 GOTO250
405 PRINT"OKAY, TYPE IN YOUR CALCULATED VALUE FOR";
406 PRINT
410 IFJ*I<>2THEN425
411 T=(T(1)-T(2))/4.5
412 T(4)=1000*T
413 T(3)=T(2)-T
414 GOSUB1020
415 GOSUB1050
416 GOSUB1030
417 INPUTX,Y
418 IFABS(X-T(3))>=.6THEN500
419 IFABS(Y-T(4))>=.6THEN500
420 GOTO550
425 IFJ*I<>3THEN440
426 T=(T(1)-T(3))/5.5
427 T(4)=1000*T
428 T(2)=T+T(3)
429 GOSUB1010
430 GOSUB1050
431 GOSUB1030
432 INPUTX,Y
433 IFABS(X-T(2))>=.6THEN500
434 IFABS(Y-T(4))>=.6THEN500
435 GOTO550
440 IFJ*I<>4THEN455
441 T=T(4)/1000
442 T(2)=T(1)-4.5*T
443 T(3)=T(2)-T
444 GOSUB1010
445 GOSUB1050
446 GOSUB1020
447 INPUTX,Y
448 IFABS(X-T(2))>=.6THEN500
449 IFABS(Y-T(3))>=.6THEN500
450 PRINT"OKAY, TYPE IN YOUR CALCULATED VALUE FOR"
455 IFJ*I<>6THEN470
456 T=T(2)-T(3)
457 T(4)=1000*T
458 T(1)=T(3)+5.5*T
459 GOSUB1000
460 GOSUB1050
461 GOSUB1030
462 INPUTX,Y
463 IFABS(X-T(1))>=.6THEN500
464 IFABS(Y-T(4))>=.6THEN500
465 GOTO550
470 IFJ*I<>8THEN485
471 T=T(4)/1000
472 T(3)=T(2)+T
473 T(1)=T(2)+6.5*T
474 GOSUB1010
475 GOSUB1050
476 GOSUB1020
477 INPUTX,Y
478 IFABS(X-T(1))>=.6THEN500
479 IFABS(Y-T(3))>=.6THEN500
480 GOTO550
481 IFABS(X-T(3))>=.6THEN500
485 IFJ*I<>12THEN390
486 T=T(4)/1000
487 T(1)=T(3)+5.5*T
488 T(2)=T(3)+T
489 GOSUB1000
490 GOSUB1050
491 GOSUB1010
492 INPUTX,Y
493 IFABS(X-T(1))>=.6THEN500
494 IFABS(Y-T(2))>=.6THEN500
495 GOTO550
500 PRINT
502 PRINT"IT LOOKS LIKE WE GOOFED SOME PLACE."
505 PRINT"LET'S SEE WHAT THE CORRECT VALUES ARE."
507 PRINT
510 PRINT T(1);"DEGREES - ";
512 GO SUB 1000
515 PRINT T(2);"DEGREES - ";
517 GO SUB 1010
520 PRINT T(3);"DEGREES - ";
522 GO SUB 1020
525 PRINT T(4);"FEET - ";
527 GO SUB 1030
530 PRINT
535 GOTO554
550 PRINT
552 PRINT"VERY GOOD. VERY, VERY GOOD."
553 PRINT
554 PRINT"DO YOU HAVE ANY OTHER PROBLEMS YOU WOULD LIKE TO TRY?"
555 PRINT "(1=YES, 0=NO) : ";
556 INPUT P
557 IFP<1THEN561
558 PRINT
559 PRINT"USING THE SAME LEGEND AS BEFORE..."
560 GOTO230
561 H=(T(1)-T(3))*2000-7*T(4)
562 REM LINE 561 CALCULATES ALTITUDE FOR TOP OF CLOUD AND BEGINS
563 REM PHASE II OF PROGRAM. PROBLEM NO.2 IN THIS PART (CALCULATION
564 REM OF TEMP. ABOVE CLOUD TOP) INVOLVES USE OF THE NORMAL LAPSE RATE.
565 PRINT
567 PRINT"WELL, BEFORE YOU LEAVE, I HAVE A FEW I'D LIKE YOU TO TRY..."
570 PRINT"BASED ON YOUR VALUES, THE HEIGHT OF THE CLOUD"
580 PRINT"(MEASURED FROM THE CLOUD BASE) IS ";H;"FT. CAN YOU TELL ME:"
600 Q(1)=.7*T(4)
601 Q(2)=T(4)+1.5*H
602 Q(3)=T(4)+.5*H
610 A(1)=T(1)-T(4)*3.85E-03
611 A(2)=T(1)-(T(4)+1.5*H)*3.5E-03
612 A(3)=T(3)-1.5E-03*H
614 PRINT
615 PRINT"WHAT IS THE TEMPERATURE AT EACH OF THESE ALTITUDES:"
620 FORN=1TO3
625 PRINT" ",N;INT(Q(N)+.5);"FT"
627 NEXT N
628 PRINT
629 FORN=1TO3
630 PRINT"THE TEMPERATURE AT ";INT(Q(N)+.5);" FT. IS ";
631 INPUTC(N)
635 IFABS(C(N)-A(N))>1.1THEN750
640 NEXTN
699 PRINT
700 PRINT"WOW, YOU MUST BE A BRAIN. AND YOU PROBALLY KNOW"
710 PRINT"A LOT ABOUT CLOUDS AND THINGS LIKE THAT. IT WAS VERY"
720 PRINT"NICE TO WORK WITH SOMEONE WHO UNDERSTANDS ME."
730 PRINT" ","THANK YOU AND . . . . PEACE AND LONG LIFE"
740 STOP
750 PRINT
755 PRINT"SORRY. YOU WERE DOING GREAT THERE FOR A WHILE."
760 PRINT"WELL, BACK TO THE BOOKS. THE VALUES YOU SHOULD HAVE ARE:"
765 PRINT
770 FORN=1TO3
774 PRINTN;
780 PRINT"THE TEMPERATURE AT";INT(Q(N)+.5);"FEET IS ";A(N);"DEGREES"
790 NEXTN
830 STOP
1000 PRINT"THE TEMPERATURE ON THE GROUND"
1005 RETURN
1010 PRINT"THE DEW POINT TEMPERATURE ON THE GROUND"
1015 RETURN
1020 PRINT"THE TEMPERATURE AT THE BASE OF THE CLOUD"
1025 RETURN
1030 PRINT"THE ELEVATION, IN FEET, OF THE CLOUD BASE"
1035 RETURN
1050 PRINT"FOLLOWED BY A COMMA, AND THEN TYPE IN YOUR VALUE FOR "
1055 RETURN
2000 END


147
software/BAS/CRAPS.bas
View File

@@ -1,147 +0,0 @@
100 REM SOURCE UNKNOWN: REVISED BY D. KURLAND 11/16/75
110 PRINT " ------ C - R - A - P - S ------"
120 PRINT "DO YOU KNOW HOW TO PLAY";
130 INPUT T$
140 IF T$="YES" OR T$="Y" THEN 270
150 PRINT "YOU ARE NOW ENTERING THE CASINO UNIVAC 1108 LOCATED"
160 PRINT "IN DOWNTOWN LAS VEGAS. YOU'VE JUST WON $25000 FROM THE"
170 PRINT "READERS DIGEST SWEEPSTAKES, AND ARE FEELING FREE AND"
180 PRINT "EASY. YOUR KEEN EYES LOCATE A CRAP TABLE. THE GREEN"
190 PRINT "FELT LOOKS VERY INVITING. YOU SEE A GIRL IN A"
200 PRINT "PLAYBOY BUNNY OUTFIT. SHE DECIDES TO START A CONVER-"
210 PRINT "SATION WITH YOU."
220 PRINT
230 PRINT "HI THERE, I AM THE ONE AND ONLY MISS TELETYPE. I'M SINGLE"
240 PRINT "AND LONELY. I'M ALSO THE DIRTIEST DICE THROWER THIS SIDE"
250 PRINT "OF IBM."
260 PRINT
270 PRINT "WHAT IS YOUR NAME";
280 INPUT T$
290 PRINT "HOW ABOUT IT, ";T$
300 PRINT "WANT TO TRY YOUR LUCK";
310 INPUT R$
320 IF R$="NO" OR R$="N" THEN 1250
330 PRINT "HERE'S YOUR SELECTION OF DICE:"
340 PRINT
350 PRINT " 1. BUNNY BLUE "
360 PRINT " 2. GROSS GREEN "
370 PRINT " 3. UNIVAC YELLOW "
380 X=25000
390 PRINT "PLEASE INPUT ONLY ONE NUMBER, HONEY";
400 INPUT F
410 IF F=1 THEN 440
420 IF F=2 THEN 460
430 IF F=3 THEN 480
440 PRINT "I SEE YOU'RE THE SEXY TYPE"
450 GOTO 490
460 PRINT "I SEE YOU'RE A REALLY BIG SPENDER"
470 GOTO 490
480 PRINT "SO YOU'RE THE CONSERVATIVE TYPE"
490 PRINT "NOW YOU HAVE YOUR OWN COLORED DICE. YOU'VE GOT $25000"
500 PRINT "AND BEST OF ALL YOU ARE SITTING NEXT TO A PLAYBOY BUNNY"
510 PRINT
520 PRINT "MISS TELETYPE SAYS, BETS PLEASE"
530 PRINT "AND HOW MUCH IS OUR READERS DIGEST WINNER GOING TO WAGER"
540 PRINT "YOU HAVE GOT A MAXIMUM OF";X
550 INPUT A
560 IF A>X THEN 540
570 IF A<0 THEN 1520
580 IF A<=100 THEN 600
590 IF A>=1000 THEN 660
600 PRINT "BOY, WHAT A CHEAPSKATE"
610 GOTO 670
620 PRINT "THAT'S A GOOD HONEST BET"
630 GOTO 670
640 PRINT "NOW YOU ARE IN BUSINESS, LOVER"
650 GOTO 670
660 PRINT "WHAT A SPENDER, LOVER, AND ALTOGETHER KOOL PERSON"
670 W=0
680 W=W+1
690 PRINT "YOU'RE NOW SHAKING YOUR DICE"
700 PRINT "YOU BLOW ON THEM FOR LUCK"
710 PRINT "YOU ROLL THEM"
720 R=INT (RND(1)*10)+1
730 IF R>6 THEN 720
740 Z=INT (RND(1)*10)+1
750 IF Z>6 THEN 740
760 PRINT "YOU'RE THROW WAS";R+Z
770 PRINT
780 IF W=1 THEN 820
790 IF R+Z=7 OR R+Z=11 THEN 900
800 IF R+Z=F THEN 920
810 GOTO 850
820 F=R+Z
830 IF F=7 OR F=11 THEN 870
840 IF F=2 OR F=3 OR F=12 THEN 900
850 PRINT "MUST SHAKE AGAIN. YOU HAVE NEITHER WON NOR LOST"
860 GOTO 1180
870 PRINT "YOU HAVE JUST DOUBLED YOUR BET"
880 PRINT "YOU HAVE WON $";2*A
890 GOTO 950
900 PRINT "YOU HAVE LOST WHAT YOU BET"
910 GOTO 1030
920 PRINT "YOU HAVE JUST WON YOUR BET"
930 PRINT "YOU HAVE WON $";A
940 GOTO 990
950 X=X+2*A
960 PRINT "YOUR TOTAL IS NOW $";X
970 IF X<0 THEN 1080
980 GOTO 1100
990 X = X+A
1000 PRINT "YOUR TOTAL IS NOW $";X
1010 IF X<0 THEN 1080
1020 GOTO 1060
1030 PRINT "YOU LOST $";A
1040 X=X-A
1050 PRINT "YOUR TOTAL IS NOW $"X
1060 IF X<0 THEN 1080
1070 GOTO 1100
1080 PRINT "YOU OWE MISS TELETYPE $";X
1090 GOTO 1480
1100 PRINT
1110 IF X<0 THEN 1080
1120 PRINT
1130 PRINT
1140 PRINT "DO YOU WANT TO TRY AGAIN";
1150 INPUT P$
1160 IF X<0 THEN 1080
1170 IF P$="NO" OR P$="N" THEN 1490 ELSE 540
1180 IF W>6 THEN 1230
1190 IF W=6 THEN 1250
1200 IF W=4 THEN 1460
1210 IF W=5 THEN 1270
1220 GOTO 1290
1230 PRINT "THIS IS THE TIME FOR A KILLING, ";T$
1240 GOTO 1290
1250 PRINT "THE ODDS ARE GETTING BETTER YET"
1260 GOTO 1290
1270 PRINT "THE ODDS ARE COMIN IN YOURE FAVOR, BABY. BET A LITTLE MORE"
1280 PRINT
1290 PRINT "DO YOU WISH TO INCREASE YOUR BET, ";T$;
1300 INPUT D$
1310 IF D$="NO" OR D$="N" THEN 680
1320 IF X-A>0 THEN 1370
1330 IF X-A<0 THEN 1350
1340 IF X-A=0 THEN 1390
1350 PRINT "LISTEN, HONEY. YOU OWE ME $"X
1360 PRINT
1370 PRINT "HOW MUCH DO YOU WISH TO INCREASE YOUR WAGER BY, ";T$
1380 GOTO 1410
1390 PRINT "YOU HAVE NO MONEY TO BET WITH. YOU MUST HOPE FOR THE BEST"
1400 GOTO 680
1410 PRINT
1420 PRINT "YOU'VE GOT $";X-A;"TO BET WITH."
1430 INPUT Z
1440 A=A+Z
1450 GOTO 680
1460 PRINT "DO OR DIE SPEND IT RIGHT NOW, ";T$
1470 GOTO 1370
1480 PRINT "CREDIT NOT GOOD IN THIS CASINO"
1490 PRINT "YOUR TOTAL IS $";X
1500 PRINT "THANK YOU FOR COMING TO THE CASINO UNIVAC 1108"
1510 GOTO 1540
1520 PRINT "YOU MUST BET A POSITIVE VALUE"
1530 GOTO 540
1540 END
MING TO THE CASINO UNIVAC 1108"
1510

267
software/BAS/CRAZY-8.bas
View File

@@ -1,267 +0,0 @@
100 REM SOURCE UNKNOWN: REVISED BY D. KURLAND 11/16/75
110 PRINT "THIS IS THE GAME OF CRAZY EIGHTS"
120 DIM A(52),D(52),G(52),H(52)
130 DIM T(52),S(52),V(52)
140 DIM Z(52),U$(4),C$(13)
150 READ U$(1),U$(2),U$(3),U$(4)
160 FOR I=1 TO 13
170 READ C$(I)
180 NEXT I
190 FOR I=1 TO 52
200 READ Z(I)
210 NEXT I
220 DATA CLUBS,DIAMONDS,HEARTS,SPADES
230 DATA "2","3","4","5","6","7","8","9","10",JACK,QUEEN,KING,ACE
240 DATA 2,3,4,5,6,7,50,9,10,10,10,10,1
250 DATA 2,3,4,5,6,7,50,9,10,10,10,10,1
260 DATA 2,3,4,5,6,7,50,9,10,10,10,10,1
270 DATA 2,3,4,5,6,7,50,9,10,10,10,10,1
280 PRINT "DO YOU KNOW HOW TO PLAY";
290 INPUT A$
300 IF A$="YES" OR A$="Y" THEN 400
310 PRINT "WHEN ASKED WHICH CARD YOU WISH TO PLAY, YOUR ANSWER SHOULD"
320 PRINT "OF THE FORM: CARD,SUIT . ANY EIGHT MAY BE"
330 PRINT "PLAYED AT ANY TIME REGARDLESS OF SUIT TO CHANGE THE SUIT."
340 PRINT "IF YOU ARE UNABLE OR UNWILLING TO PLAY, YOU WILL BE GIVEN"
350 PRINT "ANOTHER CARD FROM THE DRAW STACK. IF ALL CARDS HAVE BEEN"
360 PRINT "DRAWN, ANY PERSON WHO IS ABLE TO PLAY MUST DO SO."
370 PRINT "AT THE END OF THE GAME, THE PERSON HOLDING CARDS HAS POINTS"
380 PRINT "SCORED AGAINST HIM AS FOLLOWS: EIGHTS=50, ACE=1, FACE"
390 PRINT "CARD=10, INDEX VALUE FOR EACH OTHER CARD."
400 PRINT : PRINT "GAME WILL START SHORTLY..."
410 L=0 : FOR I=1 TO 4
420 FOR J=1 TO 13
430 L=L+1
440 S(L)=I
450 V(L)=J
460 NEXT J
470 NEXT I
480 N1=0
490 N2=0
500 N3=0
510 S1=0
520 S2=0
530 FOR I=1 TO 52
540 G(I)=0
550 H(I)=0
560 A(I)=RND(1)
570 NEXT I
580 W1=0
590 B1=0
600 P1=1
610 P2=1
620 J=0
630 M1=99999!
640 FOR I=1 TO 52
650 IF A(I)>=M1 THEN 680
660 M1=A(I)
670 I1=I
680 NEXT I
690 J=J+1
700 D(J)=I1
710 A(I1)=99999!
720 IF J<52 THEN 630
730 FOR I=1 TO 7
740 G(D(52-2*I+2))=1
750 H(D(52-2*I+1))=1
760 NEXT I
770 T(1)=D(38)
780 T1=1
790 P=S(T(1))
800 H1=7
810 H2=7
820 D1=37
830 GOSUB 1390
840 GOSUB 1510
850 IF W1=1 THEN 910
860 IF B1=1 THEN 910
870 GOSUB 2020
880 IF W1=1 THEN 910
890 IF B1=1 THEN 910
900 GOTO 830
910 GOSUB 1140
920 PRINT "YOUR SCORE IS";C1
930 PRINT "MY SCORE IS";C2
940 IF C2>=C1 THEN 980
950 PRINT "YOU WON THAT HAND."
960 N1=N1+1
970 GOTO 1000
980 PRINT "I WON THAT HAND."
990 N2=N2+1
1000 PRINT
1010 N3=N3+1
1020 PRINT "DO YOU WISH TO PLAY AGAIN";
1030 INPUT A$
1040 IF A$="YES" OR A$="Y" THEN 530
1050 PRINT
1060 PRINT "OUT OF";N3;"HANDS YOU WON";N1
1070 PRINT "YOUR TOTAL SCORE IS";S1;": MINE IS";S2;"."
1080 IF S1<=S2 THEN1110
1090 PRINT "LOOKS LIKE YOU'RE HIGH SCORER."
1100 GOTO 1120
1110 PRINT "LOOKS LIKE I AM THE HIGH SCORER."
1120 PRINT "BYE."
1130 STOP
1140 C1=0
1150 C2=0
1160 IF H2=0 THEN 1240
1170 PRINT
1180 PRINT "CARDS LEFT IN MY HAND"
1190 FOR I=1 TO 52
1200 IF H(I)=0 THEN 1230
1210 PRINT C$(V(I));TAB(6);"OF ";U$(S(I))
1220 C1=C1+Z(I)
1230 NEXT I
1240 IF H1=0 THEN 1360
1250 FOR I=1 TO 52
1260 IF G(I)=0 THEN 1280
1270 C2=C2+Z(I)
1280 NEXT I
1290 IF C1=0 THEN 1360
1300 IF C1>=C2 THEN 1340
1310 C2=C2-C1
1320 C1=0
1330 GOTO 1360
1340 C1=C1-C2
1350 C2=0
1360 S1=S1+C1
1370 S2=S2+C2
1380 RETURN
1390 PRINT
1400 PRINT "YOUR HAND IS"
1410 FOR I=1 TO 52
1420 IF G(I)=0 THEN 1440
1430 PRINT C$(V(I));TAB(6);"OF ";U$(S(I))
1440 NEXT I
1450 PRINT
1460 PRINT "THE LAST CARD PLAYED WAS THE ";
1470 PRINT C$(V(T(T1)));" OF ";U$(S(T(T1)))
1480 IF V(T(T1))<>7 THEN 1500
1490 PRINT "THE SUIT CALLED FOR IS ";U$(P)
1500 RETURN
1510 PRINT "DO YOU WISH TO PLAY A CARD";
1520 INPUT A$
1530 AZ$=LEFT$(A$,1)
1531 IF AZ$<>"Y" AND AZ$<>"N" THEN PRINT "(Y OR N) PLEASE ! "; : GOTO 1520
1540 IF D1<>0 THEN 1570
1550 PRINT "ALL THE CARDS HAVE BEEN DEALT---YOU ARE BLOCKED"
1560 GOTO 1980
1570 I=D(D1)
1580 D1=D1-1
1590 H1=H1+1
1600 G(I)=1
1610 PRINT "YOUR NEW CARD IS THE ";C$(V(I));" OF ";U$(S(I))
1620 GOTO 1510
1630 PRINT "WHICH OF YOUR CARDS DO YOU WISH TO PLAY";
1640 INPUT X$,Y$
1650 GOSUB 2610
1660 IF V9>0 THEN 1680 ELSE PRINT "UNKNOWN CARD, TRY AGAIN";
1670 GOTO 1640
1680 GOSUB 2500
1690 IF S9>0 THEN 1710 ELSE PRINT "UNKNOWN SUIT, TRY AGAIN";
1700 GOTO 1640
1710 IF V9=7 THEN 1760
1720 IF S9=P THEN 1760
1730 IF V9=V(T(T1)) THEN 1760
1740 PRINT "THAT IS NOT A LEGAL PLAY."
1750 GOTO 1510
1760 FOR I=1 TO 52
1770 IF G(I)=0 THEN 1800
1780 IF V(I)<>V9 THEN 1800
1790 IF S(I)=S9 THEN 1830
1800 NEXT I
1810 PRINT "YOU DO NOT HAVE THAT CARD."
1820 GOTO 1510
1830 G(I)=0
1840 H1=H1-1
1850 T1=T1+1
1860 T(T1)=I
1870 IF V9<>7 THEN 1930
1880 PRINT "WHAT SUIT DO YOU WISH";
1890 INPUT Y$
1900 GOSUB 2500
1910 IF S9>0 THEN 1930 ELSE PRINT "UNKNOWN SUIT, TRY AGAIN";
1920 GOTO 1890
1930 P=S9
1940 P1=1
1950 IF H1<>0 THEN 1970
1960 W1=1
1970 RETURN
1980 IF P2<>0 THEN 2000
1990 B1=1
2000 P1=0
2010 RETURN
2020 I=53
2030 I=I-1
2040 IF H(I)=0 THEN 2080
2050 IF V(I)=7 THEN 2080
2060 IF S(I)=P THEN 2220
2070 IF V(I)=V(T(T1)) THEN 2220
2080 IF I>1 THEN 2030
2090 FOR I=1 TO 52
2100 IF V(I)<>7 THEN 2120
2110 IF H(I)<>0 THEN 2220
2120 NEXT I
2130 IF D1=0 THEN 2460
2140 I=D(D1)
2150 D1=D1-1
2160 IF V(I)=7 THEN 2240
2170 IF S(I)=P THEN 2240
2180 IF V(I)=V(T(T1)) THEN 2240
2190 H2=H2+1
2200 H(I)=1
2210 GOTO 2130
2220 H(I)=0
2230 H2=H2-1
2240 T1=T1+1
2250 T(T1)=I
2260 P=S(I)
2270 IF V(I)<>7 THEN 2420
2280 FOR J=1 TO 4
2290 Y(J)=0
2300 K1=13*(J-1)+1
2310 K2=13*J
2320 FOR K=K1 TO K2
2330 IF H(I)=0 THEN 2350
2340 Y(J)=Y(J)+1
2350 NEXT K
2360 NEXT J
2370 P=1
2380 FOR J=2 TO 4
2390 IF Y(J)<=Y(P) THEN 2410
2400 P=J
2410 NEXT J
2420 P2=1
2430 IF H2<>0 THEN 2450
2440 W1=1
2450 RETURN
2460 IF P1<>0 THEN 2480
2470 B1=1
2480 P2=0
2490 RETURN
2500 FOR I0 = 1 TO 4
2510 IF Y$=U$(I0) THEN 2590
2520 NEXT I0
2530 S9 = 0
2540 IF Y$="C" THEN S9=1
2550 IF Y$="D" THEN S9=2
2560 IF Y$="H" THEN S9=3
2570 IF Y$="S" THEN S9=4
2580 RETURN
2590 S9 = I0
2600 RETURN
2610 FOR I0 = 1 TO 13
2620 IF X$=C$(I0) THEN 2700
2630 NEXT I0
2640 V9 = 0
2650 IF X$="J" THEN V9=10
2660 IF X$="Q" THEN V9=11
2670 IF X$="K" THEN V9=12
2680 IF X$="A" THEN V9=13
2690 RETURN
2700 V9 = I0
2710 RETURN
2720 END
THEN V9=11
2670 IF X$="K" THEN V9=12
2680 IF X$="A"

412
software/BAS/DEMOGRAF.BAS
View File

@@ -1,412 +0,0 @@
REM THIS IS A DEMONSTRATION PROGRAM FOR
REM CBASIC GRAPHICS EXTENSIONS
REM
REM PROGRAM NAME: DEMOGRAF
REM
%INCLUDE GRAPHCOM.BAS
DEF PAUSE
REM UTILITY TO SUSPEND PROGRAM EXECUTION UNTIL CHARACTER IS
REM ENTERED AT CONSOLE, STOPPING PROGRAM IF CTRL-C IS ENTERED,
REM OTHERWISE RETURNING INTEGER VALUE OF CHARACTER ENTERED.
REM CHARACTER IS NOT DISPLAYED.
INTEGER PAUSE,CHOICE
CHOICE = INKEY
IF CHOICE = 3 THEN STOP
PAUSE = CHOICE
FEND
GRAPHIC OPEN 1
CLEAR
BEEM: GRAPHIC PRINT AT (0,.9): "BEAM STATEMENT"
SET BEAM "OFF"
PLOT (0,1),(1,1),(1,0),(0,0)
KEY% = PAUSE REM WAIT FOR CONSOLE INPUT
CLEAR
SET BEAM "ON"
PLOT (0,1),(1,1),(1,0),(0,0)
KEY% = PAUSE
REM ILLUSTRATE TECHNIQUE OF SQUARING A DISPLAY
BOWNDS: CLEAR
GRAPHIC PRINT AT (0,.9): "BOUNDS STATEMENT"
ASK DEVICE X.AXIS,Y.AXIS
PRINT "THE ASPECT RATIO IS = ";Y.AXIS;"/";X.AXIS
KEY% = PAUSE
PLOT (0,0),(0,1),(1,1),(1,0),(0,0)
KEY% = PAUSE
CLEAR
SET BOUNDS Y.AXIS,X.AXIS
PLOT (0,0),(0,1),(1,1),(1,0),(0,0)
SET BOUNDS 1,1
KEY% = PAUSE
REM DEMONSTRATE CONTROL OF GRAPHIC CHARACTER HEIGHT
REM AND MINIMUM HEIGHT FOR GRAPHIC CHARACTERS
HIGH: CLEAR
SET CHARACTER HEIGHT 0
GRAPHIC PRINT AT (0,.9): "CHARACTER HEIGHT STATEMENT"
SET CHARACTER HEIGHT .1
GRAPHIC PRINT AT (0,.7): "10 PERCENT"
KEY% = PAUSE
SET WINDOW 0,100,0,100
SET CHARACTER HEIGHT 15
GRAPHIC PRINT AT (0,40): "15 PERCENT"
KEY% = PAUSE
SET CHARACTER HEIGHT 0
ASK CHARACTER HEIGHT CH
PRINT "MINIMUM CHARACTER HEIGHT IS = "; CH
GRAPHIC PRINT AT (0,20): "MINIMUM HEIGHT"
REM DISPLAY SEVERAL RANDOM LINES ON SCREEN, THEN MAKE
REM THEM DISAPPEAR VIA "CLEAR" STATEMENT
INPUT ""; LINE SEED$
RANDOMIZE
CLR: CLEAR
GRAPHIC PRINT AT (0,90): "CLEAR STATEMENT"
SET WINDOW 0,1,0,1
FOR I.INT% = 1 TO 10
PLOT (RND,RND),(RND,RND)
NEXT I.INT%
KEY% = PAUSE
CLEAR
REM ILLUSTRATE EFFECT OF AUTOMATIC CLIPPING WHEN FIGURE
REM EXCEEDS ALLOWABLE BOUNDARIES
CLP: SET WINDOW 0,100,0,100
GRAPHIC PRINT AT (0,90): "CLIP STATEMENT"
PLOT (25,10),(50,150),(75,10),(25,10)
KEY% = PAUSE
REM DRAW BORDER IN EACH AVAILABLE COLOR (NUMBER OF
REM COLORS VARIES WITH RESOLUTION)
COLR: CLEAR
GRAPHIC PRINT AT (0,90): \
"COLOR AND COLOR COUNT STATEMENTS"
SET WINDOW 0,1,0,1
ASK COLOR COUNT CT%
FOR I.INT% = 1 TO CT%
SET COLOR I.INT%
PLOT (0,0),(0,1),(1,1),(1,0),(0,0)
KEY% = PAUSE
NEXT I.INT%
REM RETRIEVE AND DISPLAY SPECIFICATIONS FOR CURRENT DEVICE
DEVC: CLEAR
SET CHARACTER HEIGHT 0
SET COLOR 1
GRAPHIC PRINT AT (0,.8): "DEVICE STATEMENT"
ASK DEVICE X.AXIS,Y.AXIS
PRINT "THE VERTICAL AXIS IS "; \
Y.AXIS*100.0/X.AXIS;"PERCENT OF THE";
PRINT " HORIZONTAL AXIS"
PRINT "X= ";X.AXIS;" Y= ";Y.AXIS
KEY% = PAUSE
REM MENTION "GRAPHIC CLOSE" STATEMENT
GCLOSE: CLEAR
GRAPHIC PRINT AT (0,.9): "GRAPHIC CLOSE STATEMENT"
GRAPHIC PRINT AT (0,.5): "GRAPHIC CLOSE HAS NO DEMO"
KEY% = PAUSE
REM ILLUSTRATE GRAPHIC INPUT VIA CURSOR POSITIONING
GIN: CLEAR
SET WINDOW 0,100,0,100
SET CHARACTER HEIGHT 0
GRAPHIC PRINT AT (0,80): "GRAPHIC INPUT STATEMENT"
GRAPHIC PRINT AT (0,25): "OPTION 1 ."
SET COLOR 2
GRAPHIC PRINT AT (0,50): "OPTION 2 ."
SET COLOR 3
GRAPHIC PRINT AT (0,75): "OPTION 3 ."
GRAPHIC INPUT X.AXIS,Y.AXIS,A$
N = INT((Y.AXIS+5)/25)
IF N = 0 THEN N = 1 REM NO OPTION ZERO
IF N > 3 THEN N = 3 REM ONLY THREE OPTIONS
PRINT "THE CURSOR WAS POSITIONED AT: "; X.AXIS,Y.AXIS
PRINT "YOU SELECTED OPTION: "; N
PRINT "THE TERMINATING KEY WAS: "; A$
KEY% = PAUSE
REM MENTION "GRAPHIC OPEN" STATEMENT
GOPEN: CLEAR
SET COLOR 1
SET CHARACTER HEIGHT 0
GRAPHIC PRINT AT (0,90): "GRAPHIC OPEN STATEMENT"
GRAPHIC PRINT AT (0,50): \
"THE GRAPHIC OPEN HAS NO DEMONSTRATION"
KEY% = PAUSE
REM DEMONSTRATE CENTERING AND JUSTIFICATION
GPRT: CLEAR
SET WINDOW 0,1,0,1
SET CHARACTER HEIGHT 0
GRAPHIC PRINT AT (0,.9): "GRAPHIC PRINT STATEMENT"
SET JUSTIFY 0,0
GRAPHIC PRINT AT (.5,.5): "BEGINS AT CENTER"
KEY% = PAUSE
SET JUSTIFY .5,0
GRAPHIC PRINT AT (.5,.3): "THIS IS CENTERED"
KEY% = PAUSE
SET JUSTIFY .5,.5
GRAPHIC PRINT AT (.5,.3): "THIS IS CENTERED"
KEY% = PAUSE
SET JUSTIFY 1.0,1.0
GRAPHIC PRINT AT (.5,.5): "ENDS AT CENTER"
KEY% = PAUSE
JUST: CLEAR
SET JUSTIFY 0,0
SET WINDOW 0,100,0,100
SET CHARACTER HEIGHT 0
GRAPHIC PRINT AT (0,90): "JUSTIFY STATEMENT"
PLOT (20,80),(20,20),(80,20)
PLOT (15,40),(20,40)
PLOT (15,60),(20,60)
PLOT (15,80),(20,80)
PLOT (40,15),(40,20)
PLOT (60,15),(60,20)
PLOT (80,15),(80,20)
SET JUSTIFY 1,.5
GRAPHIC PRINT AT (14,20): "20"
GRAPHIC PRINT AT (14,40): "40"
GRAPHIC PRINT AT (14,60): "60"
GRAPHIC PRINT AT (14,80): "80"
SET JUSTIFY .5,1
GRAPHIC PRINT AT (20,14): "20"
GRAPHIC PRINT AT (40,14): "40"
GRAPHIC PRINT AT (60,14): "60"
GRAPHIC PRINT AT (80,14): "80"
KEY% = PAUSE
REM EXHIBIT VARIATION OF LINE STYLE
STYL: CLEAR
SET JUSTIFY 0,0
SET WINDOW 0,1,0,1
GRAPHIC PRINT AT (0,.9): "LINE STYLE STATEMENT"
SET LINE STYLE 3
SET JUSTIFY 1,0
GRAPHIC PRINT AT (.5,.5): "Sign here"
PLOT (0.5,0.5),(0.8,0.5)
KEY% = PAUSE
REM ILLUSTRATE VARIATION IN SIZE OF MARKERS
MHIGH: CLEAR
SET WINDOW 0,1,0,1
SET CHARACTER HEIGHT 0
SET LINE STYLE 1
SET JUSTIFY 0,0
GRAPHIC PRINT AT (0,.9): "MARKER HEIGHT STATEMENT"
DIM MX(5)
DIM MY(5)
MX(0) = .3 : MY(0) = .7
MX(1) = .7 : MY(1) = .7
SET MARKER HEIGHT .1
MAT MARKER 1: MX,MY
SET WINDOW 0,100,0,100
MX(0) = 30 : MY(0) = 50
MX(1) = 70 : MY(1) = 50
SET MARKER HEIGHT 15
MAT MARKER 1: MX,MY
SET MARKER HEIGHT 0
ASK MARKER HEIGHT MK
PRINT "MINIMUM MARKER HEIGHT IS = "; MK
KEY% = PAUSE
REM DEMONSTRATE ALL MARKER SHAPES
MTYPE: CLEAR
SET WINDOW 0,1,0,1
SET MARKER HEIGHT 0
GRAPHIC PRINT AT (0,.9): "MARKER TYPE STATEMENT"
MX(0) = .5 : MY(0) = .7
FOR I.INT% = 1 TO 5
SET MARKER TYPE I.INT%
MAT MARKER 0: MX,MY
MY(0) = MY(0) - .1
NEXT I.INT%
KEY% = PAUSE
REM DEMONSTRATE FILLED POLYGON
MFILL: CLEAR
SET LINE STYLE 1
SET JUSTIFY 0,0
GRAPHIC PRINT AT (0,.9): "MAT FILL STATEMENT"
SET WINDOW 0,100,0,100
SET CHARACTER HEIGHT 0
SET COLOR 1
DIM X.ARRAY(10)
DIM Y.ARRAY(10)
X.ARRAY(0) = 40 : Y.ARRAY(0) = 10
X.ARRAY(1) = 35 : Y.ARRAY(1) = 25
X.ARRAY(2) = 50 : Y.ARRAY(2) = 40
X.ARRAY(3) = 65 : Y.ARRAY(3) = 25
X.ARRAY(4) = 60 : Y.ARRAY(4) = 10
MAT FILL 4: X.ARRAY,Y.ARRAY
KEY% = PAUSE
REM ILLUSTRATE POSITIONING OF MARKERS VIA AN ARRAY
MMARK: CLEAR
SET WINDOW 0,100,0,100
GRAPHIC PRINT AT (0,90): "MAT MARKER STATEMENT"
SET MARKER HEIGHT 0
SET MARKER TYPE 1
SET COLOR 1
MAT MARKER 4: X.ARRAY,Y.ARRAY
KEY% = PAUSE
REM DEMONSTRATE DRAWING POLYGON OUTLINE VIA AN ARRAY
MPLOT: CLEAR
GRAPHIC PRINT AT (0,90): "MAT PLOT STATEMENT"
SET COLOR 1
SET WINDOW 0,1,0,1
SET CHARACTER HEIGHT 0
FOR I.INT% = 0 TO 4
X.ARRAY(I.INT%) = .01 * X.ARRAY(I.INT%)
Y.ARRAY(I.INT%) = .01 * Y.ARRAY(I.INT%)
NEXT I.INT%
X.ARRAY(5) = .40 : Y.ARRAY(5) = .10
SET BEAM "OFF"
MAT PLOT 4: X.ARRAY,Y.ARRAY
KEY% = PAUSE
CLEAR
MAT PLOT 5: X.ARRAY,Y.ARRAY
KEY% = PAUSE
REM DO POLYGON VIA "PLOT" STATEMENTS
PLT: CLEAR
SET WINDOW 0,100,0,100
SET CHARACTER HEIGHT 0
SET COLOR 1
GRAPHIC PRINT AT (0,90): "PLOT STATEMENT"
PLOT (40,10),(35,25);
SET COLOR 2
PLOT (35,25),(50,40);
SET LINE STYLE 2
PLOT (50,40),(65,25);
SET LINE STYLE 1
SET COLOR 3
PLOT (65,25),(60,10),(40,10)
KEY% = PAUSE
REM EXERCISE ARBITRARY POSITIONING OF GRAPHIC BEAM
POSIT: CLEAR
GRAPHIC PRINT AT (0,90): "POSITION STATEMENT"
SET BEAM "OFF"
SET POSITION 50,50
SET POSITION 50,100
SET BEAM "ON"
SET POSITION 0,0
SET POSITION 50,50
KEY% = PAUSE
REM SHOW ALL LINE STYLES
STCNT: CLEAR
GRAPHIC PRINT AT (0,90): "STYLE COUNT STATEMENT"
SET WINDOW 0,100,0,100
SET CHARACTER HEIGHT 0
ASK STYLE COUNT ST%
PRINT "THE NUMBER OF LINE STYLES IS: "; ST%
FOR I.INT% = 1 TO ST%
SET LINE STYLE I.INT%
SET BEAM "OFF"
PLOT (10*I.INT%,10),(10*I.INT%,90)
NEXT I.INT%
KEY% = PAUSE
SET LINE STYLE 1
REM DEMONSTRATE ROTATION OF TEXT
ANGEL: CLEAR
GRAPHIC PRINT AT (0,90): "TEXT ANGLE STATEMENT"
SET WINDOW 0,1,0,1
SET CHARACTER HEIGHT 0
PI = 3.1415926
RAD = PI*2
DEG = RAD/360
FOR I.INT% = 90 TO 360 STEP 90
SET TEXT ANGLE I.INT%*DEG
GRAPHIC PRINT AT (.5,.5): "ROTATE ME"
NEXT I.INT%
KEY% = PAUSE
SET TEXT ANGLE 0
REM ILLUSTRATE EFFECT OF VARYING VIEWPORT
VYOU: CLEAR
GRAPHIC PRINT AT (0,.9): "VIEWPORT STATEMENT"
X.ARRAY(0) = 0 : Y.ARRAY(0) = 0
X.ARRAY(1) = 0 : Y.ARRAY(1) = 100
X.ARRAY(2) = 100 : Y.ARRAY(2) = 100
X.ARRAY(3) = 100 : Y.ARRAY(3) = 0
X.ARRAY(4) = 0 : Y.ARRAY(4) = 0
SET VIEWPORT 0,1,0,1
SET WINDOW 0,100,0,100
SET CHARACTER HEIGHT 0
MAT PLOT 4: X.ARRAY,Y.ARRAY
SET VIEWPORT .1,.9,.1,.9
MAT PLOT 4: X.ARRAY,Y.ARRAY
SET VIEWPORT .2,.8,.2,.8
MAT PLOT 4: X.ARRAY,Y.ARRAY
SET VIEWPORT .3,.5,.3,.5
MAT PLOT 4: X.ARRAY,Y.ARRAY
SET VIEWPORT .5,.7,.5,.7
MAT PLOT 4: X.ARRAY,Y.ARRAY
KEY% = PAUSE
REM ILLUSTRATE EFFECT OF VARYING WINDOW
WINDW: CLEAR
SET VIEWPORT 0,1,0,1
SET WINDOW 0,100,0,100
SET CHARACTER HEIGHT 0
GRAPHIC PRINT AT (0,90): "WINDOW STATEMENT"
PLOT (0,0),(60,60),(60,0),(0,0)
SET WINDOW 0,200,0,200
SET CHARACTER HEIGHT 0
PLOT (0,0),(60,60),(60,0),(0,0)
SET VIEWPORT 0,.5,.5,1.0
PLOT (0,0),(60,60),(60,0),(0,0)
KEY% = PAUSE
REM FINISH DEMONSTRATION AND END PROGRAM
FIN: CLEAR
SET WINDOW 0,100,0,100
SET CHARACTER HEIGHT 0
SET VIEWPORT 0,1,0,1
SET COLOR 1
FOR I.INT% = 1 TO CT%
SET COLOR I.INT%
MAT PLOT 5: X.ARRAY,Y.ARRAY
SET VIEWPORT .01*I.INT%,1-(I.INT%*.01), \
.01*I.INT%,1-(I.INT%*.01)
NEXT I.INT%
SET JUSTIFY .5,.5
SET COLOR 1
SET VIEWPORT 0,1,0,1
GRAPHIC PRINT AT (50,50): "THANKS FOR THE VIEWING"
KEY% = PAUSE
STOP
END


19
software/BAS/GALAXY.bas
View File

@@ -1,19 +0,0 @@
10 REM << GALAXY >>
20 WIDTH 79
30 A$="*":B$="+":C$=".":D$="*"
40 FOR I=1 TO 100
50 GOSUB 90
60 PRINT TAB(A);A$; TAB(B);B$; TAB(C);C$
70 NEXT
80 GOTO 40
90 A=INT(RND(1)*28) : B=INT(RND(1)*25)+28 : C=INT(RND(1)*25)+55
100 X=RND(1)
110 IF X<.15 THEN SWAP A$,B$ : GOTO 170
120 IF X<.3 THEN SWAP B$,C$ : GOTO 170
130 IF X<.45 THEN SWAP A$,C$ : GOTO 170
140 IF X<.6 THEN SWAP A$,D$ : GOTO 170
150 IF X<.75 THEN SWAP B$,D$ : GOTO 170
160 IF X<.9 THEN SWAP C$,D$
170 RETURN
170
140 IF X<.6 THEN SWAP

48
software/BAS/GALAXY2.bas
View File

@@ -1,48 +0,0 @@
100 REM << GALAXY >>
101 WIDTH 79
102 DIM G$(15)
103 FOR X=1 TO 15 : READ G$(X) : NEXT
104 A$="*":B$="+":C$=".":D$="*"
105 FOR I=1 TO 40
106 GOSUB 113
107 PRINT TAB(A);A$; TAB(B);B$; TAB(C);C$
108 NEXT
109 Z1=INT(RND(1)*15)+1
110 Z$=G$(Z1)
111 PRINT TAB(20) Z$
112 GOTO 105
113 A=INT(RND(1)*28) : B=INT(RND(1)*25)+28 : C=INT(RND(1)*25)+55
114 X=RND(1)
115 IF X<.15 THEN SWAP A$,B$ : GOTO 121
116 IF X<.3 THEN SWAP B$,C$ : GOTO 121
117 IF X<.45 THEN SWAP A$,C$ : GOTO 121
118 IF X<.6 THEN SWAP A$,D$ : GOTO 121
119 IF X<.75 THEN SWAP B$,D$ : GOTO 121
120 IF X<.9 THEN SWAP C$,D$
121 RETURN
122 DATA YOU ARE A TRAVELLER LOST IN SPACE
123 DATA I AM BUT A TRAVELLER LOST IN SPACE
124 DATA ALL MANKIND BUT EXPLORERS LOST IN SPACE
125 DATA CAN WE FIND EACH OTHER IN SPACE ?
126 DATA HOW DOES LIFE SEEM FROM UP THERE ?
127 DATA I CAN SEE YOU CLEARLY NOW FROM HERE
128 DATA THE YEARS SEEM TO PASS SO QUICKLY
129 DATA WE'LL MEET HERE IN A MILLION YEARS
130 DATA GREETINGS FROM WHERE THE RATS CRAWL
131 DATA GREETINGS FROM THE CRACKS IN THE WALL
132 DATA I SEE ALL THAT YOU EVER ARE DOING
133 DATA THE SKY IS FALLING ON US ALL !!!
134 DATA I'M AFRAID THAT THE END IS COMING
135 DATA IN WHICH REMOTE PLACE CAN GOD BE MET ?
136 DATA WE'LL MEET AGAIN DON'T KNOW WHERE OR WHEN
137 DATA TIME RUNS QUITE SHORT FOR YOU AND ME
138 DATA YOU GROW OLD AT THE SPEED OF LIGHT
139 DATA HAVE YOU MADE PEACE WITH YOUR MAKER ?
140 DATA HAVE YOU EXISTED AS A GIVER OR A TAKER ?
141 DATA WILL YOU BE ABLE TO MEET ME OUT HERE ?
142 DATA REMEMBER ALL THE GREAT TIMES WE HAD ?
143 DATA WE SHALL NEVER LEAVE THIS PLACE TILL WE DIE
144 DATA ETERNAL ENERGY BEYOND THE DREAMS OF MAN
145 DATA SOME PEOPLE WILL ALWAYS BE FREE FOREVER
146 DATA SOME PEOPLE WILL NEVER TASTE FREEDOM


4
software/BAS/GRAPHCOM.BAS
View File

@@ -1,4 +0,0 @@
COMMON ?VIEW(2),?WIND(2),?P(2),?P1(2),?KAPU(2)
COMMON ?PTSI%(1),?PTSO%(1),?CONT%(1),?INTI%(1),?INTO%(1)
COMMON ?VWTX(2),?RVIW(2),?VX(1),?XN,?YN,?XW,?YW


321
software/BAS/GRAPHR.BAS
View File

@@ -1,321 +0,0 @@
REM THIS IS A DEMONSTRATION PROGRAM FOR DRAWING
REM PIE AND BAR CHARTS.
REM
REM PROGRAM NAME: GRAPHR.BAS
REM
%INCLUDE GRAPHCOM.BAS
GRAPHIC OPEN 1
CLEAR
REM If the device supports color fill, MAT FILL
REM statements are used. Otherwise, MAT PLOT
REM is used to draw figures.
IN.FL: INPUT "DOES THIS DEVICE SUPPORT COLOR FILL? Y/N: ";FILL.FLG$
IF FILL.FLG$ = "Y" OR FILL.FLG$ = "N" THEN GOTO OK.FL
PRINT "ENTER Y OR N, PLEASE"
GOTO IN.FL
OK.FL: PRINT "THANK-YOU"
REM Initialize the arrays used for drawing the
REM slices in the pie chart. Two 100 element arrays
REM are constructed for drawing a full circle. Each
REM point in the arrays then represents one percent.
PRINT "CALCULATING OCCURRING --- PLEASE WAIT"
DIM X.ARRAY(100)
DIM Y.ARRAY(100)
DIM A.ARRAY(72)
DIM B.ARRAY(72)
A.ARRAY(0) = .5
B.ARRAY(0) = .5
L.CIR = 0
FOR I.ANGLE = 0 TO 6.28-.0628 STEP .0628
X.ARRAY(L.CIR) = .5 + (.5 * COS(I.ANGLE))
Y.ARRAY(L.CIR) = .5 + (.5 * SIN(I.ANGLE))
L.CIR = L.CIR + 1
NEXT I.ANGLE
REM Close the circle
X.ARRAY(L.CIR) = X.ARRAY(0)
Y.ARRAY(L.CIR) = Y.ARRAY(0)
GOTO START.IT
REM This function draws a slice beginning at the
REM point represented by BEG.PER and extending
REM through PER.CENT points. The color is set to
REM COL.OR and the ASCII.ID prints as an identifier
REM for the slice.
REM The function extracts the points from X.ARRAY
REM and Y.ARRAY and places them in A.ARRAY and
REM B.ARRAY. MAT FILL and MAT PLOT always begin
REM drawing at the first elements of the arrays, so
REM the slice must be extracted from the arrays.
REM The function makes provision for slices that
REM exceed 71 points. MAT FILL and MAT PLOT allow
REM a maximum element number of 72.
DEF DRAW.SLICE (BEG.PER,PER.CENT,COL.OR,ASCII.ID)
REAL BEG.PER,PER.CENT,COL.OR
STRING ASCII.ID
L.CIR = 1
SET COLOR COL.OR
OVR.FLOW = 0
REM Setup for slices greater than 71 percent.
IF PER.CENT > 71 THEN SAVE.PER = 71:OVR.FLOW = 1\
ELSE SAVE.PER = PER.CENT
REM Extract points from circle array.
BAK.UP: FOR CNT.ER = BEG.PER TO BEG.PER + SAVE.PER
IN.DEX = CNT.ER
IF CNT.ER > 100 THEN IN.DEX = CNT.ER - 100
A.ARRAY(L.CIR) = X.ARRAY(IN.DEX)
B.ARRAY(L.CIR) = Y.ARRAY(IN.DEX)
L.CIR = L.CIR + 1
NEXT CNT.ER
REM OVER.FLOW is 1 for a more than 71 percent slice.
IF OVR.FLOW <> 1 THEN GOTO OVER.A
REM FILL.FLG$ is "N" for non-color-fill devices.
IF FILL.FLG$ = "N" THEN MAT PLOT L.CIR-1: A.ARRAY,B.ARRAY\
ELSE MAT FILL L.CIR-1: A.ARRAY,B.ARRAY
OVR.FLOW = 0
BEG.PER = BEG.PER + 71
SAVE.PER = PER.CENT - 71
IF FILL.FLG$ = "N" THEN L.CIR = 0 ELSE L.CIR = 1
GOTO BAK.UP
OVER.A: A.ARRAY(0) = .5
B.ARRAY(0) = .5
REM The slice must be closed for MAT PLOT. MAT FILL
REM closes automatically.
IF FILL.FLG$ = "N" THEN\
A.ARRAY(L.CIR) = .5: \
B.ARRAY(L.CIR) = .5: \
MAT PLOT L.CIR: A.ARRAY,B.ARRAY \
ELSE \
MAT FILL L.CIR-1: A.ARRAY,B.ARRAY
REM Expand the viewport for printing the slice ID.
REM The minimum character height is used to adjust
REM the window so the slice ID will appear outside
REM the slice perimeter.
SET VIEWPORT 1.0-Y.AXIS,1,0,1
ADJ.IT = MIN.HGT/1.45
SET WINDOW -ADJ.IT,1+ADJ.IT,-ADJ.IT,1+ADJ.IT
REM MID.PT is the center elements in the slice. This
REM is the position where the ID is printed.
MID.PT = INT(BEG.PER+(PER.CENT/2))
X.AXIS = X.ARRAY(MID.PT)
Y.AXIS = Y.ARRAY(MID.PT)
GRAPHIC PRINT AT (X.AXIS,Y.AXIS): ASCII.ID
SET WINDOW 0,1,0,1
RETURN
FEND
REM The first portion of the program allows entry
REM of up to 9 slices. Enter the item number (1-9)
REM and press the return key. Then type the slice
REM description (up to 6 characters), the dollar
REM value of the slice, and the color code for
REM the slice.
REM The following entries are a good sample:
REM 1 <return>
REM RENT,550,1 <return>
REM 2 <return>
REM FOOD,450,2 <return>
REM 3 <return>
REM CAR,225,3 <return>
REM 4 <return>
REM OTHER,750,4 <return>
REM This sets up a graph of four items--rent of
REM $550 in color 1, food for $450 in color 2, etc.
REM Terminate the input by typing 0 in response
REM to the ITEM NUMBER(0 TO FINISH): prompt.
REM After the 0 entry, the program calculates the
REM percentages and prints a listing of the entries.
REM Corrections may be made by entering the
REM item number to be corrected and inputting
REM the correct data.
START.IT: PRINT
DIM ITM.DESC$(9)
DIM ITM.VALUE(9)
DIM ITM.COLOR(9)
DIM ITM.PERC(9)
GO.A: PRINT "ENTER AN ITEM NUMBER FROM 1 TO 9 TO ADD OR CHANGE"
PRINT
PRINT "THEN ENTER--DESCRIPTION,AMOUNT,COLOR,RETURN"
PRINT
PRINT " DESCRIPTION IS THE SLICE DESCRIPTION"
PRINT " AMOUNT IS THE QUANTITY/AMOUNT OF THE SLICE"
PRINT " COLOR IS THE COLOR NUMBER TO USE FOR THE SLICE"
PRINT " RETURN MEANS TO PRESS THE RETURN KEY"
PRINT
PRINT "THE FIELDS ARE SEPARATED BY COMMAS"
PRINT
IN.IT: INPUT "ITEM NUMBER(0 TO FINISH): "; ITM.NUMBER%
IF ITM.NUMBER% = 0 THEN GOTO PRT.EM
IF ITM.NUMBER% > 0 AND ITM.NUMBER% < 10 THEN GOTO OKAY.IN
PRINT "THE ITEM NUMBER MUST BE FROM 1 TO 9"
GOTO IN.IT
OKAY.IN: IF ITM.VALUE(ITM.NUMBER%) = 0 THEN GOTO NEW.IN
PRINT ITM.DESC$(ITM.NUMBER%),ITM.VALUE(ITM.NUMBER%),
PRINT ITM.COLOR(ITM.NUMBER%)
NEW.IN: INPUT "DESC,AMOUNT,COLOR: ";DESC.IN$,VAL.IN,CLR.IN%
ITM.DESC$(ITM.NUMBER%) = DESC.IN$
ITM.VALUE(ITM.NUMBER%) = VAL.IN
ITM.COLOR(ITM.NUMBER%) = CLR.IN%
PRINT
GOTO IN.IT
PRT.EM: TOT.VAL = 0
REM Calculate the total for percentages.
FOR CNT.R = 1 TO 9
TOT.VAL = TOT.VAL + ITM.VALUE(CNT.R)
NEXT CNT.R
PRINT
REM Print the item list with percentages.
FOR CNT.R = 1 TO 9
IF ITM.VALUE(CNT.R) <> 0 THEN\
ITM.PERC(CNT.R) = ITM.VALUE(CNT.R)/TOT.VAL:\
ITM.PERC(CNT.R) = INT((100*ITM.PERC(CNT.R))+.5):\
PRINT CNT.R;"-";ITM.DESC$(CNT.R),ITM.VALUE(CNT.R),:\
PRINT ITM.COLOR(CNT.R);" ";ITM.PERC(CNT.R);"%"
NEXT CNT.R
PRINT:PRINT "TOTAL VALUE: ";TOT.VAL
PRINT:INPUT "DRAW THE GRAPH? ";Y.N$
IF Y.N$ <> "Y" THEN GOTO IN.IT
CLEAR
BEG.PER = 0
REM THE MINIMUM CHARACTER HEIGHT FOR THE DEVICE
REM IS USED TO ESTABLISH A BORDER AROUND THE CIRCLE
REM WHERE THE SLICE ID (THE ITEM NUMBER) CAN BE
REM PRINTED.
SET CHARACTER HEIGHT 0
ASK CHARACTER HEIGHT MIN.HGT
MIN.HGT = 2 * MIN.HGT
FOR CNT.R = 1 TO 9
IF ITM.VALUE(CNT.R) = 0 THEN GOTO NXT.CNT
REM Determine the aspect ratio and square the device.
REM A border is left around the viewport for the
REM slice ID. The viewport is set to the right
REM of the device.
ASK DEVICE X.AXIS,Y.AXIS
SET VIEWPORT 1-Y.AXIS+MIN.HGT,1-MIN.HGT,MIN.HGT,1-MIN.HGT
DESC.IN$ = ITM.DESC$(CNT.R)
VAL.IN = ITM.VALUE(CNT.R)
CLR.IN% = ITM.COLOR(CNT.R)
PER.CENT = ITM.PERC(CNT.R)
CALL DRAW.SLICE (BEG.PER,PER.CENT,CLR.IN%,STR$(CNT.R))
BEG.PER = BEG.PER + PER.CENT
SET VIEWPORT 0,1,0,1
S.1$ = DESC.IN$+" "+STR$(PER.CENT)+"%"
GRAPHIC PRINT AT (0,1-(CNT.R/10)):S.1$
NXT.CNT: NEXT CNT.R
REM Is the graph filled? The percentage calculation
REM can be less than 100 percent due to roundoff.
IF BEG.PER >= 100 THEN GOTO BAR.A
PER.CENT = 100 - BEG.PER
DESC.IN$ = " "
ASK DEVICE X.AXIS,Y.AXIS
SET VIEWPORT 1-Y.AXIS+MIN.HGT,1-MIN.HGT,MIN.HGT,1-MIN.HGT
CALL DRAW.SLICE (BEG.PER,PER.CENT,CLR.IN%,DESC.IN$)
REM This routine draws a simple bar chart of the
REM data. The window range is set to 1/3 greater
REM than the largest item in the array. This
REM technique makes the largest bar draw across
REM 75% of the viewport.
BAR.A: KEY%=CONCHAR%
DIM BAR.X(4)
DIM BAR.Y(4)
SET VIEWPORT 0,1,0,1
SET WINDOW 0,1,0,1
SET CHARACTER HEIGHT 0
ASK CHARACTER HEIGHT MIN.HGT
CLEAR
SET JUSTIFY .5,0
SET COLOR 1
GRAPHIC PRINT AT (.5,.99-MIN.HGT):"BAR CHART"
SET JUSTIFY 0,0
MAX.VAL = 0
REM Determine the maximum percentage.
FOR CNT.R = 1 TO 9
IF MAX.VAL < ITM.PERC(CNT.R) THEN\
MAX.VAL = ITM.PERC(CNT.R)
NEXT CNT.R
MAX.VAL = 1.33 * MAX.VAL
REM Scale the window. The X axis is 1/3 larger
REM than the largest item to be graphed.
REM The Y axis is scaled to 10 lines.
SET WINDOW 0,MAX.VAL,0,10
SET CHARACTER HEIGHT 0
ASK CHARACTER HEIGHT MIN.HGT
REM Draw the items.
FOR CNT.R = 1 TO 9
IF ITM.VALUE(CNT.R) = 0 THEN GOTO NXT.A
SET COLOR ITM.COLOR(CNT.R)
P.LINE = 10 - CNT.R
S.1$ = ITM.DESC$(CNT.R)+"-"+STR$(ITM.PERC(CNT.R))+"%"
IF ITM.VALUE(CNT.R) <> ITM.PERC(CNT.R) THEN\
S.1$ = S.1$+" $"+STR$(ITM.VALUE(CNT.R))
GRAPHIC PRINT AT (0,P.LINE): S.1$
REM Setup the BAR.X and BAR.Y arrays to draw the
REM bar. MAX.VAL is the percentage for the item.
REM The window scaling automatically scales the
REM bar. No special calculations are required.
MAX.VAL = ITM.PERC(CNT.R)
TOP = P.LINE - .1
BOT = TOP - .4
BAR.Y(0) = BOT
BAR.Y(1) = TOP
BAR.X(2) = MAX.VAL
BAR.Y(2) = TOP
BAR.X(3) = MAX.VAL
BAR.Y(3) = BOT
BAR.Y(4) = BOT
IF FILL.FLG$ = "N" THEN MAT PLOT 4: BAR.X,BAR.Y\
ELSE MAT FILL 3: BAR.X,BAR.Y
NXT.A: NEXT CNT.R
KEY% = CONCHAR%
STOP
END


16
software/BAS/GSXPREP.BAS
View File

@@ -1,16 +0,0 @@
100 REM GSXPREP.BAS
110 REM
120 REM
130 REM
140 GSX%=&H30
150 POKE GSX%+0,
160 POKE GSX%+1,&H59
170 POKE GSX%+2,&HE
180 POKE GSX%+3,115
190 POKE GSX%+4,&HC3
200 POKE GSX%+5,&H5
210 POKE GSX%+6,&H0
220 NEW
SX%+1,&H59
170 POKE GSX%+2,&HE
180

1051
software/BAS/MONOPLY.BAS
View File

File diff suppressed because it is too large Load Diff

149
software/BAS/MONSTER.BAS
View File

@@ -1,149 +0,0 @@
10 ' **** MONSTER COMBAT ****
20 ' Written by Lee Chapel 6/15/80 ( BYTE DEC.,1980 Pp.288-290 )
30 ' Entered, Converted to Mbasic and Enhanced By Steven C. Rich
40 ' (313)358-3494
50 '
60 ' NOTE: The Graphics used are for use on a Heath H-19 terminal. I
70 ' have broken out the commands so that they can you can convert
80 ' this program for other terminals. I suggest strongly that anyone
90 ' using graphics in their programs do the same.
100 '
110 RANDOMIZE:' REMOVE OR CHANGE IF USING MBASIC VERSION BEFORE 5.0
120 ' ********************* H-19 TERMINAL COMMANDS *************************
130 E$=CHR$(27):' ESCAPE CHARACTER (Used for alaphics in their programs do the same.
100 '
110 RANDOMIZE:' REMOVE OR CHANGE IF USING MBASIC VERSION BEFORE 5.0
120 ' ********************* H-19 TERMINAL COMMANDS *************************
130 E$=CHR$(27):' ESCAPE CHARACTER (Used for alHOME
190 EP$=E$+"J":' ERASE TO END OF PAGE
200 'NOTE: The H-19 uses the following scheme for direct cursor addressing:
210 ' Location= (CHR$(Line number+31));(CHR$(Column number+31))
220 ' **********************************************************************
230 PRINT CLS$;"NOTE:The instructions for this game are in MONSTER.DOC."
240 FOR I=1 TO 2000:NEXT I
250 DIM A(10,10):PRINT CLS$;:PRINT TAB(20);"MONSTER COMBAT"
260 '**************************************************************
270 ' NOTE: THE FOLLOWING DEFINE GRAPHICS CHARACTERS OF THE H-19.
280 ' CHANGE THEM FOR YOUR TERMINAL
290 ' CH$(0) & CH$(1)= Grass CH$(2)= Tree CH$(5)= You
300 CH$(0)="ii":CH$(1)="ii":CH$(2)="r_":CH$(5)="}|"
310 '**************************************************************
320 FOR I=1 TO 9:FOR J=1 TO 9:A(I,J)=1:IF RND(1)>.75 THEN A(I,J)=2
330 NEXT J,I
340 X=INT(RND(1)*6+2):Y=INT(RND(1)*6+2)
350 A(X,Y)=5:C=INT(RND(1)*1501+500)
360 GOSUB 1270
370 PRINT "YOUR COMBAT STRENGTH IS ";C:GOSUB 620:IF I>11 THEN 370
380 IF M=0 THEN PRINT "YOU GET THE TREASURE FREE":GOTO 860
390 IF M=100 AND N=1 THEN 1260
400 PRINT "DO YOU WANT TO (F)IGHT, (R)UN, OR (B)RIBE ? "
410 Z9$=INPUT$(1):IF Z9$<>"F"AND Z9$<>"R" AND Z9$<>"B" GOTO 410
420 IF Z9$="F" GOTO 430 ELSE IF Z9$="R" GOTO 530 ELSE IF Z9$="B" GOTO 1000 ELSE GOTO 400
430 INPUT"HOW MANY COMBAT POINTS DO YOU WISH TO USE";K
440 IF K>C THEN GOSUB 990:PRINT C;"COMBAT POINTS":GOTO 430
450 I=INT(RND(1)*1001):L=2:C=C-K:K=K-.01*Q
460 FOR H=1000 TO 0 STEP-50:IF L*M<=K AND H>=I THEN 840
470 L=L-.1:NEXT
480 PRINT "THE MONSTER KILLED YOU.";
490 PRINT "YOU LOSE EVERYTHING":PRINT "DO YOU WISH TO TRY AGAIN";
500 'If using MBASIC Version before 5.0 remove 'RANDOMIZE' in following line
510 Z$=INPUT$(1):IF Z$="Y" THEN RANDOMIZE C:C=0:Q=0:GOTO 270
520 PRINT :PRINT "SO LONG. BETTER LUCK NEXT TIME":END
530 I=INT(RND(1)*12):IF I=11 THEN 480
540 FOR H=0 TO 10:IF H*10>M AND H<=I THEN 560
550 NEXT:GOTO 1070
560 A=X:B=Y
570 X=INT(RND(1)*3-1)+A: Y=INT(RND(1)*3-1)+B
580 IF A(X,Y)>1 THEN 570
590 IF A(X,Y)=0 THEN 1320
600 A(A,B)=1:A(X,Y)=5:IF I<>12 THEN 360
610 RETURN
620 I=INT(RND(1)*18+1):M=I*10:IF I<11 THEN PRINT "A ";
630 ON I GOTO 640,650,660,670,680,690,700,710,720,730,740,1130,1080,1300,1340,1340,1340,1340
640 PRINT "MINOTAUR";:GOTO 750
650 PRINT "CYCLOPS";:GOTO 750
660 PRINT "ZOMBIE";:GOTO 750
670 PRINT "GIANT";:GOTO 750
680 PRINT "HARPY";:GOTO 750
690 PRINT "GRIFFIN";:GOTO 750
700 PRINT "CHIMERA";:GOTO 750
710 PRINT "DRAGON";:GOTO 750
720 PRINT "WYVERN";:GOTO 750
730 PRINT "BASLISK";:GOTO 750
740 PRINT "NOTHING";:M=0
750 PRINT " IS GUARDING ";:I=INT(RND(1)*7+1)
760 ON I GOTO 770,780,790,800,810,820,830
770 PRINT "10 SILVER SPOONS":P=10:RETURN
780 PRINT "A JEWELED SWORD":P=30:RETURN
790 PRINT "A JAR OF RUBIES":P=50:RETURN
800 PRINT "A TREASURE CHEST":P=200:RETURN
810 PRINT "50 SILVER COINS":P=50:RETURN
820 PRINT "100 GOLD PIECES":P=100:RETURN
830 PRINT "A BOX OF JEWELS":P=75:RETURN
840 PRINT "YOU BEAT THE MONSTER"
850 S=S+1
860 Q=Q+P
870 IF P=30 THEN GOSUB 1170
880 IF P=200 THEN GOSUB 1200:GOSUB 1230
890 PRINT "YOU HAVE ";Q;" TREASURE POINTS"
900 X$="":A=X:B=Y:INPUT"WHAT DIRECTION (HIT 1 TO RESET DISPLAY)";X$:IF X$=""GOTO 900
910 IF X$="1" THEN PRINT CLS$;TAB(20);"MONSTER COMBAT":GOSUB 1270:GOTO 900
920 IF RIGHT$(X$,1)="W" THEN X=X-1
930 IF RIGHT$(X$,1)="E" THEN X=X+1
940 IF LEFT$(X$,1) ="N" THEN Y=Y-1
950 IF LEFT$(X$,1) ="S" THEN Y=Y+1
960 IF A(X,Y)=0 THEN 1320
970 IF A(X,Y)=2 THEN PRINT CHR$(7);"YOU RAN INTO A TREE":X=A:Y=B:GOTO 900
980 A(A,B)=1:A(X,Y)=5:GOTO 360
990 PRINT "YOU ONLY HAVE";:RETURN
1000 INPUT"HOW MUCH DO YOU WISH TO PAY";K
1010 IF K>Q THEN GOSUB 990:PRINT Q;" TREASURE POINTS":GOTO 1000
1020 I=INT(RND(1)*22):L=0:IF I=21 OR K<1 THEN 480
1030 FOR H=0 TO 20:IF K<=L*P AND I>=H THEN 1060
1040 L=L+.1:NEXT
1050 PRINT "YOUR BRIBE WAS ACCEPTED.";:Q=Q-K:GOTO 890
1060 PRINT "YOUR BRIBE WAS NOT ACCEPTED.";
1070 PRINT "YOU MUST FIGHT":GOTO 430
1080 PRINT CHR$(7);"THE GUARDIAN OF THE FOREST CAPTURED YOU, TOOK HALF YOUR"
1090 PRINT "TREASURE, AND TOOK YOU TO A NEW SPOT IN THE FOREST"
1100 Q=Q/2:A=X:B=Y:FOR I9=1 TO 4000:NEXT
1110 X=INT(RND(1)*7+2):Y=INT(RND(1)*7+2):IF A(X,Y)<>1 THEN 1110
1120 A(A,B)=1:A(X,Y)=5:GOSUB 1270:I=13:RETURN
1130 J=INT(RND(1)*20+1):C=C-J
1140 PRINT "YOU FELL INTO A PIT AND USED ";J;" COMBAT POINTS TO CLIMB OUT"
1150 IF C<0 THEN PRINT "YOU DIED WHILE CLIMBING OUT":GOTO 490
1160 GOTO 560
1170 IF RND(1)<.5 OR C>3000 THEN RETURN
1180 PRINT "THE SWORD WAS ENCHANTED AND DOUBLES YOUR STRENGTH"
1190 C=C*2:RETURN
1200 I=INT(RND(1)*10):IF I<>7 THEN RETURN
1210 PRINT "THE CHEST WAS A TRAP. YOU WERE KILLED WHEN YOU OPENED IT."
1220 GOTO 490
1230 I=INT(RND(1)*10):IF I<>3 THEN RETURN
1240 PRINT "A MIRROR WAS IN THE CHEST.";
1250 PRINT " IT WILL KILL ANY BASILISKS YOU MEET":N=1:RETURN
1260 PRINT "YOUR MIRROR KILLED THE BASILISK":GOTO 850
1270 PRINT GY$:GOSUB 1390:PRINT HO$:FOR I=0 TO 10:PRINT TAB(15);:FOR J=0 TO 10
1280 PRINT CH$(A(J,I));
1290 NEXT J:PRINT:NEXT I:PRINT EP$;GN$:RETURN
1300 IF S<5 THEN 620
1310 PRINT "A GIANT EAGLE CARRIED YOU TO SAFETY"
1320 PRINT :PRINT "YOU SURVIVED THE FOREST"
1330 PRINT "YOU WON A TREASURE TOTAL OF ";Q:PRINT "CONGRADULATIONS"
:PRINT "DO YOU WISH TO TRY AGAIN ? ";:GOTO 510
1340 PRINT "THERE IS NOTHING TO BE FOUND HERE":GOTO 890
1350 END
1360 '***********************************************************
1370 ' THIS ROUTINE PRINTS BRIEF INSTRUCTIONS AND A COMPASS ROSE ON THE SCREEN.
1380 ' IT CAN BE REMOVED IF CONVERSION IS DIFFICULT, BUT LEAVE 'RETURN' IN.
1390 PRINT DC$;"!H";CH$(5);" = YOUR POSITION"
1400 PRINT DC$;"#H";CH$(2);" = TREE (YOU MUST GO AROUND THEM)"
1410 PRINT DC$;"%H";CH$(0);" = FIELD"
1420 PRINT DC$;"'U";"NW N NE"
1430 PRINT DC$;"(W";"y`x"
1440 PRINT DC$;")U";"W a^a E"
1450 PRINT DC$;"*W";"x`y"
1460 PRINT DC$;"+U";"SW S SE"
1470 RETURN
30 PRINT DC$;"(W";"y`x"

122
software/BAS/ROSE.BAS
View File

@@ -1,122 +0,0 @@
1 REM CLEAR SCREEN & VERT TAB 10
10 PRINT TAB( 6)"** PETALS AROUND THE ROSE **"
20 FOR ZZ = 1 TO 3000: NEXT
30 PRINT : PRINT : PRINT
40 PRINT "DO YOU WISH INSTRUCTIONS ";
50 INPUT A$
60 IF LEFT$ (A$,1) = "N" THEN 140
70 PRINT
80 PRINT "THE NAME OF THE GAME IS 'PETALS AROUND"
90 PRINT "THE ROSE. THE NAME OF THE GAME IS"
95 PRINT "IMPORTANT. "
100 PRINT : PRINT "THE COMPUTER WILL ROLL FIVE DICE"
105 PRINT "AND ASK YOU FOR THE SCORE FOR THE"
110 PRINT "ROLL. THE SCORE WILL ALWAYS BE AN"
115 PRINT "EVEN NUMBER. GUESS 99 TO STOP PLAYING"
120 PRINT : PRINT " ** GOOD LUCK **"
125 PRINT : PRINT : PRINT : PRINT : INPUT "HIT RETURN TO CONTINUE";X$
140 DIM L(7)
150 H = 0:G = 0:F = 0
155 REM CLEAR SCREEN & VERT TAB 10
180 FOR K = 1 TO 5
190 A = INT (12 * RND (8))
200 GOSUB 720
210 F = 8 * F + C
220 G = 8 * G + D
230 H = H + B
240 NEXT K
250 PRINT : PRINT
270 FOR K = 1 TO 5
280 L(K) = F - 8 * INT (F / 8)
290 M = L(K)
300 GOSUB 590
310 F = INT (F / 8)
320 NEXT K
330 FOR K = 1 TO 5
340 M = G - 8 * INT (G / 8)
350 GOSUB 590
360 G = INT (G / 8)
370 NEXT K
380 H = H - 12 * INT (H / 12)
390 FOR K = 1 TO 5
400 IF (L(K) - 1) * (L(K) - 4) < > 0 THEN 420
410 L(K) = 5 - L(K)
420 M = L(K)
430 GOSUB 590
440 NEXT K
450 PRINT : PRINT
470 PRINT "GUESS THE SCORE";
480 INPUT K
490 IF K = 99 THEN 1110
500 H = 2 * INT (H)
510 IF K = H THEN 570
515 PRINT
520 PRINT " NO,IT'S ";H;
530 IF K - 2 * INT (K / 2) = 0 THEN 550
540 PRINT " (THE SCORE IS ALWAYS EVEN) ";
545 FOR ZZ = 1 TO 2000: NEXT
550 PRINT
555 FOR ZZ = 1 TO 2000: NEXT
560 GOTO 150
570 PRINT : PRINT : PRINT TAB( 16)"...YES..."
575 FOR ZZ = 1 TO 2000: NEXT
580 GOTO 150
590 FOR N = 0 TO 2
600 IF M > 3 THEN 630
610 PRINT" ";
620 GOTO 650
630 M = M - 4 * INT (M / 4)
640 PRINT " O";
650 M = 2 * M
660 NEXT N
670 IF K = 5 THEN 700
680 PRINT" ";
690 RETURN
700 PRINT
710 RETURN
720 B = 6 + RND (7) / 6
730 C = 0
740 D = 0
750 IF A > 3 THEN 890
760 B = B + 3
770 IF A > 1 THEN 810
780 D = D + 2
790 B = B + 3
800 RETURN
810 C = C + 1
820 B = B + 1
830 IF A > 2 THEN 780
840 B = B + 11
850 GOTO 790
860 C = C + 1
870 IF A > 2 THEN 790
880 GOTO 780
890 C = C + 4
900 B = B + 2
910 IF A > 5 THEN 970
920 B = B + 2
930 IF A < 5 THEN 950
940 GOTO 780
950 B = B + 11
960 GOTO 790
970 C = C + 1
980 B = B + 8
990 IF A > 6 THEN 1030
1000 D = D + 3
1010 B = B + 5
1020 GOTO 780
1030 IF A > 7 THEN 1070
1040 B = B + 5
1050 C = C + 1
1060 GOTO 860
1070 B = B + 7
1080 IF A < 10 THEN 780
1090 B = B + 10
1100 GOTO 790
1110 PRINT " THE SCORE WAS ";2 * INT (H)
O 860
1070 B = B + 7
1080 IF A < 10 THEN 780
1090 B = B + 10
1100 GOTO 790
11

200
software/BAS/SQUARE.bas
View File

@@ -1,200 +0,0 @@
100 REM ** SQUARE **
110 REM
120 REM WRITTEN BY MAC OGLESBY
130 REM AS DESCRIBED IN VOL. 1, ISSUE 3
140 REM OF CALCULATORS-COMPUTERS MAGAZINE
150 REM
160 CS$=CHR$(126)+CHR$(28) 'CURSOR CONTROL CODES TO CLEAR SCREEN
170 DEFINT A-Z
180 PRINTCS$;"ENTER PASSWORD";:INPUTA$:Z=0
190 A=0:FORI=1TOLEN(A$):A=A+ASC(MID$(A$,I,1)):NEXT:A=RND(-A)
200 DIM Q(50),S$(50),S(24,12),U(12),V(50)
210 P$(1)="X":P$(2)="O":F=1
220 FOR R0=0 TO 4:FOR C0=0 TO 4:D$(R0,C0)=".":NEXTC0:NEXTR0
230 INPUT"WANT INSTRUCTIONS FOR 'SQUARE'";A$
240 IFLEFT$(A$,1)="N"THEN400
250 PRINTCS$; 'CLEAR SCREEN
260 PRINT" THE GAME OF SQUARE IS FOR 1 OR 2 PLAYERS. THE NORMAL"
270 PRINT"BOARD LOOKS LIKE THIS AT THE START:":GOSUB2000
280 PRINT" THE PLAYERS GO IN TURN AND CHOOSE ANY UNOCCUPIED POINT"
290 PRINT"(SHOWN AS A DOT). EACH PLAYER HAS 12 MARKERS (X'S OR O'S)"
300 PRINT"WHICH ARE USED TO IDENTIFY CHOSEN POINTS.":PRINT
310 INPUT" ENTER 'C' TO CONTINUE";A$:PRINT
320 PRINT" THE WINNER IS THE FIRST PLAYER WHO HAS CHOSEN 4 POINTS"
330 PRINT"WHICH FORM THE CORNERS OF A SQUARE."
340 PRINT" TO CHOOSE A POINT, TYPE 2 DIGITS (0 TO 4) SEPARATED BY A"
350 PRINT"COMMA. THE FIRST DIGIT TELLS THE DISTANCE OVER (TO T";
360 PRINT"HE RIGHT)":PRINT"FROM POINT 0,0 (THE ORIGIN). THE SECOND";
370 PRINT" DIGIT TELLS THE DISTANCE UP.":PRINT
380 PRINT"REMEMBER: OVER,UP.":PRINT
390 INPUT" ENTER 'C' TO CONTINUE";A$:PRINT
400 PRINT:INPUT"DO YOU WANT TO PLAY THE EXPERTS' GAME";A$
410 B0=1:IFLEFT$(A$,1)="Y"THENB0=2
420 IFB0=1THEN440
430 D$(2,2)=" ":N=38:GOTO450
440 N=50
450 IFZ=1THENGOTO490ELSEPRINT:INPUT"HOW MANY PLAYERS (1 OR 2)";P0
460 IFP0=2THEN510
470 IF P0=1THEN480ELSEPRINT"PLEASE ENTER 1 OR 2":GOTO450
480 PRINTCS$;"OK, I WILL PLAY THE X'S":PRINT
490 INPUT"DO YOU WANT TO GO FIRST";A$:F=1
500 IFLEFT$(A$,1)="Y"THENF=2
510 PRINTCS$;"OK...HERE WE GO..."
520 IFZ=1THEN940
530 RESTORE:FORJ=0TO24:READS(J,0):NEXT
540 DATA 4,7,8,7,4,7,10,11,10,7,8,11,12,11,8,7,10,11,10,7,4,7,8,7,4
550 FORJ=0TO24:FORK=1TOS(J,0):READS(J,K):NEXTK:NEXTJ
560 DATA 1,13,35,43
570 DATA 1,2,15,20,28,31,36
580 DATA 2,3,21,24,29,43,44,47
590 DATA 3,4,16,25,30,31,35
600 DATA 4,13,36,44
610 DATA 1,5,15,24,30,32,37
620 DATA 1,2,5,14,22,25,38,39,47,48
630 DATA 2,3,15,16,17,23,26,32,33,39,40
640 DATA 3,4,6,14,20,27,37,40,47,49
650 DATA 4,6,16,21,28,33,38
660 DATA 5,7,20,26,29,43,45,48
670 DATA 5,7,15,17,18,21,27,31,34,39,41
680 DATA 39,40,41,42,43,44,45,46,47,48,49,50
690 DATA 6,8,16,17,19,22,24,31,34,40,42
700 DATA 6,8,23,25,29,44,46,49
710 DATA 7,9,18,22,28,32,35
720 DATA 7,9,10,14,23,24,36,41,48,50
730 DATA 10,11,17,18,19,20,25,32,33,41,42
740 DATA 8,11,12,14,21,26,35,42,49,50
750 DATA 8,12,19,27,30,33,36
760 DATA 9,13,37,45
770 DATA 9,10,18,26,30,34,38
780 DATA 10,11,22,27,29,45,46,50
790 DATA 11,12,19,23,28,34,37
800 DATA 12,13,38,46
810 FORJ=1TON:READS$(J):NEXT
820 DATA 00011110,01021211,02031312,03041413,10112120
830 DATA 13142423,20213130,23243433,30314140,31324241
840 DATA 32334342,33344443,00044440,11133331
850 DATA 01122110,03142312,12233221,21324130,23344332
860 DATA 01133220,02143321,11234230,12244331
870 DATA 02233110,03243211,12334120,13344221
880 DATA 01144330,02244220,03344110
890 DATA 01032321,10123230,12143432,21234341
900 DATA 00033330,01043431,10134340,11144441
910 DATA 11122221,12132322,21223231,22233332
920 DATA 00022220,02042422,20224240,22244442
930 DATA 02132211,11223120,13243322,22334231
940 IFA(1)<>89THEN960
950 IFB0=2THEN960ELSEPRINT:GOTO970
960 GOSUB2000
970 T=T+1
980 REM ** MAIN MOVE LOOP: J=121212... OR J=212121...
990 FORJ=FTO3-FSTEP3-2*F
1000 IFP0=2THEN1730
1010 IFJ=2THEN1730
1020 REM ** GENERATE COMPUTER'S MOVE
1030 IFT<>1THEN1100
1040 IFD$(2,2)<>"."THEN1060
1050 R1=2:C1=2:GOTO1710
1060 IFF=1THEN1080
1070 Q0=9:GOTO1130
1080 R1=1+INT(RND(1)*3):C1=1+INT(RND(1)*3)
1090 IFD$(R1,C1)<>"."THENGOTO1080ELSEGOTO1710
1100 IFT<>2THEN1380
1110 IFF=1THEN1130
1120 Q0=19
1130 K9=0
1140 FORJ1=1TON:IFQ(J1)<>1+Q0THEN1160
1150 K9=K9+1:U(K9)=J1
1160 NEXTJ1
1170 IFK9=0THEN1370
1180 FORJ2=K9TO1STEP-1:T9=1+INT(RND(1)*J2):J1=U(T9)
1190 FORK1=1TO8STEP2:R1=VAL(MID$(S$(J1),K1,1))
1200 C1=VAL(MID$(S$(J1),K1+1,1))
1210 IFD$(R1,C1)<>"."THEN1320
1220 IFQ0+T<3THEN1240
1230 GOTO1710
1240 S0=5*R1+C1:M0=0:FORJ3=1TOS(S0,0)
1250 IFB0=1THEN1280
1260 IFS(S0,J3)<=38THEN1280
1270 GOTO1310
1280 IFQ(S(S0,J3))>1THEN1300
1290 M0=M0+1
1300 NEXTJ3
1310 IFM0<8-B0THENGOTO1320ELSEGOTO1710
1320 NEXTK1
1330 IFJ2=T9THEN1350
1340 T8=U(J2):U(J2)=U(T9):U(T9)=T8
1350 NEXTJ2
1360 REM *** AS A LAST RESORT, PICK ANY VACANT POINT
1370 R1=RND(1)*5:C1=RND(1)*5:IFD$(R1,C1)<>"."THENGOTO1370ELSEGOTO1710
1380 IFT=3THEN1430
1390 REM ** SEE IF 'X' CAN COMPLETE A SQUARE
1400 FORJ1=1TON:IFQ(J1)<>3THENGOTO1410ELSEGOTO1190
1410 NEXTJ1
1420 REM ** SEE IF 'O' CAN COMPLETE A SQUARE
1430 FORJ1=1TON:IFQ(J1)<>30THENGOTO1440ELSEGOTO1190
1440 NEXTJ1
1450 REM ** CAN 'X' CHOOSE A 3RD CORNER?
1460 K9=0:FORJ1=1TON:IFQ(J1)<>2THEN1480
1470 K9=K9+1:U(K9)=J1
1480 NEXTJ1
1490 IFK9=0THEN1700
1500 FORI0=1TO2:FORJ0=K9TO1STEP-1:M9=1+INT(RND(1)*J0):J1=U(M9):T9=0
1510 FORK1=1TO8STEP2:R1=VAL(MID$(S$(J1),K1,1))
1520 C1=VAL(MID$(S$(J1),K1+1,1)):IFD$(R1,C1)<>"."THEN1540
1530 T9=T9+1:R(T9)=R1:C(T9)=C1
1540 NEXTK1
1550 FORJ2=1TO2:FORJ3=1TO50:V(J3)=Q(J3):NEXTJ3:S0=5*R(J2)+C(J2)
1560 FORJ3=1TOS(S0,0):V(S(S0,J3))=V(S(S0,J3))+1:NEXTJ3
1570 S0=5*R(3-J2)+C(3-J2)
1580 FORJ3=1TOS(S0,0):V(S(S0,J3))=V(S(S0,J3))+10:NEXTJ3
1590 FORJ3=1TON:IFV(J3)<>4-I0THEN1610
1600 R1=R(J2):C1=C(J2):GOTO1710
1610 NEXTJ3
1620 NEXTJ2
1630 IFJ0=M9THEN1650
1640 T8=U(J0):U(J0)=U(M9):U(M9)=T8
1650 NEXTJ0
1660 NEXTI0
1670 REM ** NO GOOD MOVE AVAILABLE...PICK ANY 3RD CORNER
1680 J1=U(1+INT(RND(1)*K9)):GOTO1190
1690 REM ** SEE IF WE CAN ANNOY THE HUMAN
1700 Q0=I9:GOTO1130
1710 PRINT"THE ";P$(J);"'S MOVE TO ";STR$(C1);",";STR$(R1):GOTO1780
1720 REM ** GET PLAYER'S CHOICE
1730 IFT>1THEN1750
1740 PRINT"THE ";P$(J);"'S MOVE TO WHICH POINT";:GOTO1760
1750 PRINTP$(J);"'S CHOICE";
1760 INPUTC1,R1
1770 IFD$(R1,C1)<>"."THEN1850
1780 D$(R1,C1)=P$(J)
1790 REM ** Q() TELLS WHO OWNS CORNERS OF WHICH SQUARES
1800 S0=5*R1+C1:FORJ1=1TOS(S0,0):Q(S(S0,J1))=Q(S(S0,J1))+1+(J-1)*9
1810 IFQ(S(S0,J1))<>4+(J-1)*36THEN1830
1820 PRINT:PRINT"*** THE ";P$(J);"'S WIN!! ***":GOTO1910
1830 NEXTJ1
1840 GOTO1880
1850 PRINT"** ILLEGAL POINT! **":GOTO1870
1860 PRINT"YOU MUST TYPE 2 DIGITS (0 TO 4) SEPARATED BY A COMMA!"
1870 PRINT"** INPUT IGNORED! PLEASE TRY AGAIN...":GOTO1750
1880 NEXTJ
1890 IFT<12THEN1970
1900 PRINT:PRINT"THE GAME IS A DRAW; NEITHER PLAYER MADE A SQUARE!"
1910 FORK1=1TO8STEP2:R1=VAL(MID$(S$(S(S0,J1)),K1,1))
1920 C1=VAL(MID$(S$(S(S0,J1)),K1+1,1)):D$(R1,C1)=CHR$(64):NEXT:GOSUB2000
1930 INPUT"WANT TO PLAY AGAIN";A$:IFLEFT$(A$,1)<>"Y"THENEND
1940 Z=1:FORJ2=0TO4:FORJ3=0TO4:D$(J2,J3)=".":NEXTJ3:NEXTJ2
1950 FORJ2=1TO50:Q(J2)=0:V(J2)=0:NEXTJ2:FORJ2=1TO12:U(J2)=0:NEXTJ2
1960 T=0:K9=0:GOTO400
1970 GOSUB2000
1980 GOTO970
1990 REM ** PRINT THE BOARD
2000 PRINT:FORR0=4TO0STEP-1:PRINTSTR$(R0);" ";
2010 FORC0=0TO4:PRINTD$(R0,C0);:IFC0=4THEN2030
2020 PRINT" ";
2030 NEXTC0:PRINT:IFR0=0THEN2050
2040 PRINT:PRINT
2050 NEXTR0:PRINT:PRINT" 0 1 2 3 4":PRINT:RETURN
2060 END
 NEXTC0:PRINT:IFR0=0THEN2050
2040 PRINT:PRINT
2050 NEXTR0:PRINT:PRINT" 0 1 2 3 4":PRINT

1137
software/BAS/STAR.BAS
View File

File diff suppressed because it is too large Load Diff

446
software/BAS/STARTREKV2.BAS
View File

@@ -1,446 +0,0 @@
10 REM SUPER STARTREK - MAY 16,1978 - REQUIRES 24K MEMORY (AT LEAST)
30 REM
40 REM **** **** STAR TREK **** ****
50 REM **** SIMULATION OF A MISSION OF THE STARSHIP ENTERPRISE,
60 REM **** AS SEEN ON THE STAR TREK TV SHOW.
70 REM **** ORIGINAL PROGRAM BY MIKE MAYFIELD, MODIFIED VERSION
80 REM **** PUBLISHED IN DEC'S "101 BASIC GAMES", BY DAVE AHL.
90 REM **** MODIFICATIONS TO THE LATTER (PLUS DEBUGGING) BY BOB
100 REM *** LEEDOM - APRIL & DECEMBER 1974,
110 REM *** WITH A LITTLE HELP FROM HIS FRIENDS . . .
120 REM *** COMMENTS, EPHITETS, AND SUGGESTIONS SOLICITED --
130 REM *** SEND TO: R.C. LEEDOM
140 REM *** WESTINGHOSE DEFENSE & ELECTRONICS SYSTEMS CNIR
150 REM *** BOX 746, M.S. 338
160 REM *** BALTIMORE, MD 21203
170 REM ***
180 REM *** CONVERTED TO MICROSOFT 8 K BASIC 3/16/78 BY JOHN BORDERS
190 REM *** LINE NUMBERS FROM VERSION TREK7 OF 1/12/75 PRESERVED AS
200 REM *** MUCH AS POSSIBLE WHILE USING MULTIPLE STATEMENTS PER LINE
201 REM *** - MODIFIED TO RUN ON GRANT SEARLE'S 9-CHIP Z80 COMPUTER
202 REM *** AND DERIVATIVES 04-AUG-2018 BY N.KENDRICK
203 REM *** (LINKER3000-AT-GMAIL.COM)
205 WIDTH 80
209 REM NK: POSITIONING USING ANSI ESCAPE SEQUENCES...
210 PRINT CHR$(27);"[2J";:PRINT CHR$(27);"[3;1H";
211 PRINT "THE USS ENTERPRISE --- NCC-1701"
212 PRINT CHR$(27);"[4;1H";:PRINT
222 FOR YY=1 TO 40 STEP 2:FOR XX=1 TO 200 : NEXT XX
223 PRINT TAB(YY);" ,------*------,"
224 PRINT TAB(YY);" ,------------- '--- ------'"
225 PRINT TAB(YY);" '-------- --' / /"
226 PRINT TAB(YY);" ,---' '-------/ /--,"
227 PRINT TAB(YY);" '----------------'"
228 PRINT CHR$(27);"[4;1H";:PRINT:NEXT YY
229 PRINT CHR$(27);"[11;1H";
260 CLEAR 600
270 Z$=" "
330 DIM G(8,8),C(9,2),K(3,3),N(3),Z(8,8),D(8)
370 T=INT(RND(1)*20+20)*100:T0=T:T9=25+INT(RND(1)*10):D0=0:E=3000:E0=E
440 P=10:P0=P:S9=200:S=0:B9=0:K9=0:X$="":X0$=" IS "
470 DEF FND(D)=SQR((K(I,1)-S1)^2+(K(I,2)-S2)^2)
475 DEF FNR(R)=INT(RND(R)*7.98+1.01)
490 Q1=FNR(1):Q2=FNR(1):S1=FNR(1):S2=FNR(1)
530 FOR I=1 TO 9:C(I,1)=0:C(I,2)=0:NEXT I
540 C(3,1)=-1:C(2,1)=-1:C(4,1)=-1:C(4,2)=-1:C(5,2)=-1:C(6,2)=-1
600 C(1,2)=1:C(2,2)=1:C(6,1)=1:C(7,1)=1:C(8,1)=1:C(8,2)=1:C(9,2)=1
670 FOR I=1 TO 8:D(I)=0:NEXT I
710 A1$="NAVSRSLRSPHATORSHEDAMCOMXXX"
820 FOR I=1 TO 8:FOR J=1 TO 8:K3=0:Z(I,J)=0:R1=RND(1)
850 IF R1>.98 THEN K3=3:K9=K9+3:GOTO 980
860 IF R1>.95 THEN K3=2:K9=K9+2:GOTO 980
870 IF R1>.8 THEN K3=1:K9=K9+1
980 B3=0:IF RND(1)>.96 THEN B3=1:B9=B9+1
1040 G(I,J)=K3*100+B3*10+FNR(1):NEXT J:NEXT I:IF K9>T9 THEN T9=K9+1
1100 IF B9<>0 THEN 1200
1150 IF G(Q1,Q2)<200 THEN G(Q1,Q2)=G(Q1,Q2)+100:K9=K9+1
1160 B9=1:G(Q1,Q2)=G(Q1,Q2)+10:Q1=FNR(1):Q2=FNR(1)
1200 K7=K9:IF B9<>1 THEN X$="S":X0$=" ARE "
1230 PRINT"YOUR ORDERS ARE AS FOLLOWS:"
1235 PRINT "--------------------------"
1240 PRINT" DESTROY THE";K9;"KLINGON WARSHIPS WHICH HAVE INVADED"
1250 PRINT" THE GALAXY BEFORE THEY CAN ATTACK FEDERATION HEADQUARTERS"
1260 PRINT" ON STARDATE";T0+T9;CHR$(8);". THIS GIVES YOU";T9;
1261 PRINT"DAYS. THERE";X0$
1270 PRINT" ";B9;
1271 PRINT"STARBASE";X$;" IN THE GALAXY FOR RESUPPLYING YOUR SHIP."
1280 PRINT: PRINT "PRESS Y TO ACCEPT COMMAND";
1300 INPUT I5$:
1302 IF LEFT$(I5$,1)="Y" OR LEFT$(I5$,1)="y" THEN 1310
1303 GOTO 1280
1310 PRINT CHR$(26)
1320 Z4=Q1:Z5=Q2:K3=0:B3=0:S3=0:G5=0:D4=.5*RND(1):Z(Q1,Q2)=G(Q1,Q2)
1390 IF Q1<1 OR Q1>8 OR Q2<1 OR Q2>8 THEN 1600
1430 GOSUB 9030:PRINT:IF T0<>T THEN 1490
1460 PRINT"YOUR MISSION BEGINS WITH YOUR STARSHIP LOCATED"
1470 PRINT"IN THE GALACTIC QUADRANT, '";G2$;"'.":GOTO 1500
1490 PRINT"NOW ENTERING ";G2$;" QUADRANT . . ."
1500 PRINT:K3=INT(G(Q1,Q2)*.01):B3=INT(G(Q1,Q2)*.1)-10*K3
1540 S3=G(Q1,Q2)-100*K3-10*B3:IF K3=0 THEN 1590
1560 PRINT TAB(3);CHR$(22);" COMBAT AREA CONDITION RED ";CHR$(22)
1561 IF S>200 THEN PRINT:GOTO 1590
1580 PRINT TAB(3);CHR$(22);" SHIELDS DANGEROUSLY LOW ";CHR$(22)
1581 PRINT
1590 FOR I=1 TO 3:K(I,1)=0:K(I,2)=0:NEXT I
1600 FOR I=1 TO 3:K(I,3)=0:NEXT I:Q$=Z$+Z$+Z$+Z$+Z$+Z$+Z$+LEFT$(Z$,17)
1680 A$="<E>":Z1=S1:Z2=S2:GOSUB 8670:IF K3<1 THEN 1820
1720 FOR I=1 TO K3:GOSUB 8590:A$="+K+":Z1=R1:Z2=R2
1780 GOSUB 8670:K(I,1)=R1:K(I,2)=R2:K(I,3)=S9*(.5+RND(1)):NEXT I
1820 IF B3<1 THEN 1910
1880 GOSUB 8590:A$=">B<":Z1=R1:B4=R1:Z2=R2:B5=R2:GOSUB 8670
1910 FOR I=1 TO S3:GOSUB 8590:A$=" * ":Z1=R1:Z2=R2:GOSUB 8670:NEXT I
1980 GOSUB 6430
1990 IF S+E>10 THEN IF E>10 OR D(7)=0 THEN 2060
2020 PRINT:PRINT TAB(10);CHR$(22);"** FATAL ERROR **";CHR$(22)
2021 PRINT"YOU'VE JUST STRANDED YOUR SHIP IN SPACE."
2030 PRINT"YOU HAVE INSUFFICIENT MANEUVERING ENERGY,"
2040 PRINT"AND SHIELD CONTROL IS PRESENTLY INCAPABLE OF"
2050 PRINT"CROSS-CIRCUITING TO ENGINE ROOM!!":PRINT:GOTO 6220
2060 PRINT:INPUT"COMMAND";A$:PRINT
2080 FOR I=1 TO 9:IF LEFT$(A$,3)<>MID$(A1$,3*I-2,3)THEN 2160
2140 ON I GOTO 2300,1980,4000,4260,4700,5530,5690,7290,6270
2160 NEXT I:PRINT"ENTER ONE OF THE FOLLOWING:"
2170 PRINT "--------------------------"
2180 PRINT" NAV (TO SET COURSE)"
2190 PRINT" SRS (FOR SHORT RANGE SENSOR SCAN)"
2200 PRINT" LRS (FOR LONG RANGE SENSOR SCAN)"
2210 PRINT" PHA (TO FIRE PHASERS)"
2220 PRINT" TOR (TO FIRE PHOTON TORPEDOES)"
2230 PRINT" SHE (TO RAISE OR LOWER SHIELDS)"
2240 PRINT" DAM (FOR DAMAGE CONTROL REPORTS)"
2250 PRINT" COM (TO CALL ON LIBRARY-COMPUTER)"
2260 PRINT" XXX (TO RESIGN YOUR COMMAND)":PRINT:GOTO 1990
2300 INPUT"COURSE (0-9)";C1:IF C1=9 THEN C1=1
2310 IF C1>=1 AND C1<9 THEN 2350
2330 PRINT" LT. SULU: 'INCORRECT COURSE DATA, SIR!'":GOTO 1990
2350 X$="8":IF D(1)<0 THEN X$="0.2"
2360 PRINT"WARP FACTOR (0-";X$;")";:INPUT W1:PRINT
2361 IF D(1)<0 AND W1>.2 THEN 2470
2380 IF W1>0 AND W1<=8 THEN 2490
2390 IF W1=0 THEN 1990
2420 PRINT" CHIEF ENGINEER SCOTT: 'THE ENGINES WON'T TAKE";
2430 PRINT" WARP";W1;CHR$(8);"!'":GOTO 1990
2470 PRINT"WARP ENGINES ARE DAMAGED. MAXIUM SPEED = WARP 0.2":GOTO 1990
2490 N=INT(W1*8+.5):IF E-N>=0 THEN 2590
2500 PRINT"ENGINEERING: 'INSUFFICIENT ENERGY AVAILABLE"
2510 PRINT" FOR MANEUVERING AT WARP";W1;CHR$(8);"!'"
2530 IF S<N-E OR D(7)<0 THEN 1990
2550 PRINT"DEFLECTOR CONTROL ROOM: ";S;"UNITS OF ENERGY"
2560 PRINT" PRESENTLY DEPLOYED TO SHIELDS."
2570 GOTO 1990
2590 FOR I=1 TO K3:IF K(I,3)=0 THEN 2700
2610 A$=" ":Z1=K(I,1):Z2=K(I,2):GOSUB 8670:GOSUB 8590
2660 K(I,1)=Z1:K(I,2)=Z2:A$="+K+":GOSUB 8670
2700 NEXT I:GOSUB 6000:D1=0:D6=W1:IF W1>=1 THEN D6=1
2770 FOR I=1 TO 8:IF D(I)>=0 THEN 2880
2790 D(I)=D(I)+D6:IF D(I)>-.1 AND D(I)<0 THEN D(I)=-.1:GOTO 2880
2800 IF D(I)<0 THEN 2880
2810 IF D1<>1 THEN D1=1:PRINT"DAMAGE CONTROL REPORT: ";
2840 PRINT TAB(8);:R1=I:GOSUB 8790:PRINT G2$;" REPAIR COMPLETED."
2880 NEXT I:IF RND(1)>.2 THEN 3070
2910 R1=FNR(1):IF RND(1)>=.6 THEN 3000
2930 D(R1)=D(R1)-(RND(1)*5+1):PRINT"DAMAGE CONTROL REPORT: ";
2960 GOSUB 8790:PRINT G2$;" DAMAGED":PRINT:GOTO 3070
3000 D(R1)=D(R1)+RND(1)*3+1:PRINT"DAMAGE CONTROL REPORT: ";
3030 GOSUB 8790:PRINT G2$;" STATE OF REPAIR IMPROVED":PRINT
3070 A$=" ":Z1=INT(S1):Z2=INT(S2):GOSUB 8670
3110 X1=C(C1,1)+(C(C1+1,1)-C(C1,1))*(C1-INT(C1)):X=S1:Y=S2
3140 X2=C(C1,2)+(C(C1+1,2)-C(C1,2))*(C1-INT(C1)):Q4=Q1:Q5=Q2
3170 FOR I=1 TO N:S1=S1+X1:S2=S2+X2
3171 IF S1<1 OR S1>=9 OR S2<1 OR S2>=9 THEN 3500
3240 S8=INT(S1)*24+INT(S2)*3-26:IF MID$(Q$,S8,2)=" "THEN 3360
3320 S1=INT(S1-X1):S2=INT(S2-X2):PRINT"WARP ENGINES SHUT DOWN AT ";
3350 PRINT"SECTOR";S1;CHR$(8);",";S2;"DUE TO BAD NAVIGATION":GOTO 3370
3360 NEXT I:S1=INT(S1):S2=INT(S2)
3370 A$="<E>":Z1=INT(S1):Z2=INT(S2):GOSUB 8670:GOSUB 3910:T8=1
3430 IF W1<1 THEN T8=.1*INT(10*W1)
3450 T=T+T8:IF T>T0+T9 THEN 6220
3480 GOTO 1980
3500 X=8*Q1+X+N*X1:Y=8*Q2+Y+N*X2:Q1=INT(X/8):Q2=INT(Y/8):S1=INT(X-Q1*8)
3550 S2=INT(Y-Q2*8):IF S1=0 THEN Q1=Q1-1:S1=8
3590 IF S2=0 THEN Q2=Q2-1:S2=8
3620 X5=0:IF Q1<1 THEN X5=1:Q1=1:S1=1
3670 IF Q1>8 THEN X5=1:Q1=8:S1=8
3710 IF Q2<1 THEN X5=1:Q2=1:S2=1
3750 IF Q2>8 THEN X5=1:Q2=8:S2=8
3790 IF X5=0 THEN 3860
3800 PRINT"LT. UHURA: MESSAGE FROM STARFLEET COMMAND --"
3810 PRINT" 'PERMISSION TO ATTEMPT CROSSING OF GALACTIC PERIMETER"
3820 PRINT" IS HEREBY *DENIED*. SHUT DOWN YOUR ENGINES.'"
3830 PRINT"CHIEF ENGINEER SCOTT: 'WARP ENGINES SHUT DOWN"
3840 PRINT" AT SECTOR";S1;CHR$(8);",";S2;"OF QUADRANT";
3841 PRINT Q1;CHR$(8);",";Q2;CHR$(8);".'"
3850 IF T>T0+T9 THEN 6220
3860 IF 8*Q1+Q2=8*Q4+Q5 THEN 3370
3870 T=T+1:GOSUB 3910:GOTO 1320
3910 E=E-N-10:IF E>=0 THEN RETURN
3930 PRINT"SHIELD CONTROL SUPPLIES ENERGY TO COMPLETE THE MANEUVER."
3940 S=S+E:E=0:IF S<=0 THEN S=0
3980 RETURN
4000 IF D(3)<0 THEN PRINT"LONG RANGE SENSORS ARE INOPERABLE.":GOTO 1990
4030 PRINT"LONG RANGE SCAN FOR QUADRANT";Q1;CHR$(8);",";Q2:PRINT
4040 O1$="-------------------":PRINT O1$
4060 FOR I=Q1-1 TO Q1+1:N(1)=-1:N(2)=-2:N(3)=-3:FOR J=Q2-1 TO Q2+1
4120 IF I>0 AND I<9 AND J>0 AND J<9 THEN N(J-Q2+2)=G(I,J):Z(I,J)=G(I,J)
4180 NEXT J:FOR L=1 TO 3:PRINT"| ";
4181 IF N(L)<0 THEN PRINT"*** ";:GOTO 4230
4210 PRINT RIGHT$(STR$(N(L)+1000),3);" ";
4230 NEXT L:PRINT"|":PRINT O1$:NEXT I:GOTO 1990
4260 IF D(4)<0 THEN PRINT"PHASERS INOPERATIVE.":GOTO 1990
4265 IF K3>0 THEN 4330
4270 PRINT"SCIENCE OFFICER SPOCK: 'SENSORS SHOW NO ENEMY SHIPS"
4280 PRINT" IN THIS QUADRANT'":GOTO 1990
4330 IF D(8)<0 THEN PRINT"COMPUTER FAILURE HAMPERS ACCURACY."
4350 PRINT"PHASERS LOCKED ON TARGET; ";
4360 PRINT"ENERGY AVAILABLE =";E;"UNITS"
4370 INPUT"NUMBER OF UNITS TO FIRE";X:IF X<=0 THEN 1990
4400 IF E-X<0 THEN 4360
4410 E=E-X:IF D(7)<0 THEN X=X*RND(1)
4450 H1=INT(X/K3):FOR I=1 TO 3:IF K(I,3)<=0 THEN 4670
4480 H=INT((H1/FND(0))*(RND(1)+2)):IF H>.15*K(I,3)THEN 4530
4500 PRINT"SENSORS SHOW NO DAMAGE TO ENEMY AT";K(I,1);CHR$(8);
4501 PRINT",";K(I,2);CHR$(8);".":GOTO 4670
4530 K(I,3)=K(I,3)-H:PRINT H;"UNIT HIT ON KLINGON AT SECTOR";
4531 PRINT K(I,1);CHR$(8);",";
4550 PRINT K(I,2);CHR$(8);".":IF K(I,3)<=0 THEN PRINT:PRINT CHR$(22);
4551 PRINT"*** KLINGON DESTROYED ***";CHR$(22):PRINT:GOTO 4580
4560 PRINT" (SENSORS SHOW";K(I,3);"UNITS REMAINING)":GOTO 4670
4580 K3=K3-1:K9=K9-1:Z1=K(I,1):Z2=K(I,2):A$=" ":GOSUB 8670
4650 K(I,3)=0:G(Q1,Q2)=G(Q1,Q2)-100:Z(Q1,Q2)=G(Q1,Q2):IF K9<=0 THEN 6370
4670 NEXT I:GOSUB 6000:GOTO 1990
4700 IF P<=0 THEN PRINT"ALL PHOTON TORPEDOES EXPENDED.":GOTO 1990
4730 IF D(5)<0 THEN PRINT"PHOTON TUBES ARE NOT OPERATIONAL.":GOTO 1990
4760 INPUT"PHOTON TORPEDO COURSE (1-9)";C1:IF C1=9 THEN C1=1
4780 IF C1>=1 AND C1<9 THEN 4850
4790 PRINT"ENSIGN CHEKOV: 'INCORRECT COURSE DATA, SIR!'"
4800 GOTO 1990
4850 X1=C(C1,1)+(C(C1+1,1)-C(C1,1))*(C1-INT(C1)):E=E-2:P=P-1
4860 X2=C(C1,2)+(C(C1+1,2)-C(C1,2))*(C1-INT(C1)):X=S1:Y=S2
4910 PRINT"TORPEDO TRACK:"
4920 X=X+X1:Y=Y+X2:X3=INT(X+.5):Y3=INT(Y+.5)
4960 IF X3<1 OR X3>8 OR Y3<1 OR Y3>8 THEN 5490
5000 PRINT" ";X3;CHR$(8);",";Y3:A$=" ":Z1=X:Z2=Y
5001 GOSUB 8830
5050 IF Z3<>0 THEN 4920
5060 A$="+K+":Z1=X:Z2=Y:GOSUB 8830:IF Z3=0 THEN 5210
5110 PRINT:PRINT CHR$(22);"*** KLINGON DESTROYED ***";CHR$(22)
5111 PRINT:K3=K3-1:K9=K9-1:IF K9<=0 THEN 6370
5150 FOR I=1 TO 3:IF X3=K(I,1)AND Y3=K(I,2)THEN 5190
5180 NEXT I:I=3
5190 K(I,3)=0:GOTO 5430
5210 A$=" * ":Z1=X:Z2=Y:GOSUB 8830:IF Z3=0 THEN 5280
5260 PRINT"STAR AT";X3;",";Y3;"ABSORBED TORPEDO ENERGY.":GOSUB 6000
5261 GOTO 1990
5280 A$=">!<":Z1=X:Z2=Y:GOSUB 8830:IF Z3=0 THEN 4760
5330 PRINT CHR$(22);"*** STARBASE DESTROYED ***";CHR$(22)
5331 B3=B3-1:B9=B9-1
5360 IF B9>0 OR K9>T-T0-T9 THEN 5400
5370 PRINT"THAT DOES IT, CAPTAIN!! YOU ARE HEREBY RELIEVED OF COMMAND"
5380 PRINT"AND SENTENCED TO 99 STARDATES AT HARD LABOR ON CYGNUS 12!!"
5390 GOTO 6270
5400 PRINT"STARFLEET COMMAND REVIEWING YOUR RECORD TO CONSIDER"
5410 PRINT"COURT MARTIAL!":D0=0
5430 Z1=X:Z2=Y:A$=" ":GOSUB 8670
5470 G(Q1,Q2)=K3*100+B3*10+S3:Z(Q1,Q2)=G(Q1,Q2):GOSUB 6000:GOTO 1990
5490 PRINT"TORPEDO MISSED.":PRINT:GOSUB 6000:GOTO 1990
5530 IF D(7)<0 THEN PRINT"SHIELD CONTROL INOPERABLE.":GOTO 1990
5560 PRINT"ENERGY AVAILABLE =";E+S;:INPUT"NUMBER OF UNITS TO SHIELDS";X
5580 IF X<0 OR S=X THEN PRINT"<SHIELDS UNCHANGED>":GOTO 1990
5590 IF X<=E+S THEN 5630
5600 PRINT"SHIELD CONTROL: 'THIS IS NOT THE FEDERATION TREASURY.'"
5610 PRINT"<SHIELDS UNCHANGED>":GOTO 1990
5630 E=E+S-X:S=X:PRINT"DEFLECTOR CONTROL ROOM:"
5660 PRINT" 'SHIELDS NOW AT";INT(S);"UNITS PER YOUR COMMAND.'"
5661 GOTO 1990
5690 IF D(6)>=0 THEN 5910
5700 PRINT"DAMAGE CONTROL REPORT NOT AVAILABLE.":IF D0=0 THEN 1990
5720 D3=0:FOR I=1 TO 8:IF D(I)<0 THEN D3=D3+.1
5760 NEXT I:IF D3=0 THEN 1990
5780 PRINT:D3=D3+D4:IF D3>=1 THEN D3=.9
5810 PRINT"TECHNICIANS STANDING BY TO EFFECT REPAIRS TO YOUR SHIP;"
5820 PRINT"ESTIMATED TIME TO REPAIR:";.01*INT(100*D3);"STARDATES."
5840 INPUT"WILL YOU AUTHORIZE THE REPAIR ORDER (Y/N)";A$
5860 IF A$<>"Y"THEN 1990
5870 FOR I=1 TO 8:IF D(I)<0 THEN D(I)=0
5890 NEXT I:T=T+D3+.1
5910 PRINT:PRINT"DEVICE STATE OF REPAIR"
5911 PRINT"------ ---------------":FOR R1=1 TO 8
5920 GOSUB 8790:PRINT G2$;LEFT$(Z$,25-LEN(G2$));INT(D(R1)*100)*.01
5950 NEXT R1:PRINT:IF D0<>0 THEN 5720
5980 GOTO 1990
6000 IF K3<=0 THEN RETURN
6010 IF D0<>0 THEN PRINT"STARBASE SHIELDS PROTECT THE ENTERPRISE."
6011 RETURN
6040 FOR I=1 TO 3:IF K(I,3)<=0 THEN 6200
6060 H=INT((K(I,3)/FND(1))*(2+RND(1)))
6061 S=S-H:K(I,3)=K(I,3)/(3+RND(0))
6080 PRINT:PRINT H;"UNIT HIT ON ENTERPRISE FROM SECTOR";
6081 PRINT K(I,1);CHR$(8);",";K(I,2);CHR$(8);"."
6090 IF S<=0 THEN 6240
6100 PRINT" <SHIELDS DOWN TO";S;"UNITS>":IF H<20 THEN 6200
6120 IF RND(1)>.6 OR H/S<=.02 THEN 6200
6140 R1=FNR(1):D(R1)=D(R1)-H/S-.5*RND(1):GOSUB 8790
6170 PRINT"DAMAGE CONTROL: '";G2$;" DAMAGED BY THE HIT'"
6200 NEXT I:RETURN
6220 PRINT:PRINT"IT IS STARDATE";T;CHR$(8);".":PRINT:GOTO 6270
6240 PRINT:PRINT"THE ENTERPRISE HAS BEEN DESTROYED. THE FEDERATION ";
6250 PRINT"WILL BE CONQUERED.":GOTO 6220
6270 PRINT"THERE WERE";K9;"KLINGON BATTLE CRUISERS LEFT AT"
6280 PRINT"THE END OF YOUR MISSION."
6290 PRINT:PRINT:IF B9=0 THEN 6360
6310 PRINT"THE FEDERATION IS IN NEED OF A NEW STARSHIP COMMANDER"
6320 PRINT"FOR A SIMILAR MISSION -- IF THERE IS A VOLUNTEER,"
6330 INPUT"LET HIM STEP FORWARD AND ENTER 'AYE'";A$:IF A$="AYE"THEN 10
6360 PRINT:PRINT "BACK TO SYSTEM.":END
6370 PRINT"CONGRATULATIONS, CAPTAIN! THE LAST KLINGON BATTLE CRUISER"
6380 PRINT"MENACING THE FEDERATION HAS BEEN DESTROYED.":PRINT
6400 PRINT"YOUR EFFICIENCY RATING IS";1000*(K7/(T-T0))^2:GOTO 6290
6430 FOR I=S1-1 TO S1+1:FOR J=S2-1 TO S2+1
6450 IF INT(I+.5)<1 OR INT(I+.5)>8 THEN 6540
6451 IF INT(J+.5)<1 OR INT(J+.5)>8 THEN 6540
6490 A$=">B<":Z1=I:Z2=J:GOSUB 8830:IF Z3=1 THEN 6580
6540 NEXT J:NEXT I:D0=0:GOTO 6650
6580 D0=1:C$="DOCKED":E=E0:P=P0
6620 PRINT"SHIELDS DROPPED FOR DOCKING PURPOSES.":S=0:GOTO 6720
6650 IF K3>0 THEN C$="*RED*":GOTO 6720
6660 C$="GREEN":IF E<E0*.1 THEN C$="YELLOW"
6720 IF D(2)>=0 THEN 6770
6730 PRINT:PRINT"*** SHORT RANGE SENSORS ARE OUT ***":PRINT:RETURN
6770 O1$=" +--1---2---3---4---5---6---7---8-+":PRINT O1$
6771 FOR I=1 TO 8:PRINT I;"|";
6820 FOR J=(I-1)*24+1 TO(I-1)*24+22 STEP 3:PRINT" ";MID$(Q$,J,3);
6821 NEXT J:PRINT"|";I;
6830 ON I GOTO 6850,6900,6960,7020,7070,7120,7180,7240
6850 PRINT" STARDATE ";:PRINT INT(T*10)*.1
6851 GOTO 7260
6900 PRINT" CONDITION ";
6901 IF C$="*RED*" THEN PRINT CHR$(22);"*RED*";CHR$(22):GOTO 7260
6902 IF C$="DOCKED" THEN PRINT CHR$(22);"DOCKED";CHR$(22):GOTO 7260
6903 PRINT C$: GOTO 7260
6960 PRINT" QUADRANT ";Q1;CHR$(8);",";Q2;CHR$(8)
6961 GOTO 7260
7020 PRINT" SECTOR ";S1;CHR$(8);",";S2;CHR$(8)
7021 GOTO 7260
7070 PRINT" PHOTON TORPEDOES ";:PRINT INT(P)
7071 GOTO 7260
7120 PRINT" TOTAL ENERGY ";:PRINT INT(E+S)
7121 GOTO 7260
7180 PRINT" SHIELDS ";:PRINT INT(S)
7181 GOTO 7260
7240 PRINT" KLINGONS REMAINING";:PRINT INT(K9)
7260 NEXT I:PRINT O1$:RETURN
7290 IF D(8)<0 THEN PRINT"COMPUTER DISABLED.":GOTO 1990
7320 INPUT"COMPUTER ACTIVE AND AWAITING COMMAND";A:IF A<0 THEN 1990
7350 PRINT:H8=1:ON A+1 GOTO 7540,7900,8070,8500,8150,7400
7360 PRINT"FUNCTIONS AVAILABLE FROM LIBRARY-COMPUTER:"
7365 PRINT "-----------------------------------------":PRINT
7370 PRINT" 0 = CUMULATIVE GALTIC RECORD"
7372 PRINT" 1 = STATUS REPORT"
7374 PRINT" 2 = PHOTON TORPEDO DATA"
7376 PRINT" 3 = STARBASE NAV DATA"
7378 PRINT" 4 = DIRECTION/DISTANCE CALCULATOR"
7380 PRINT" 5 = GALAXY 'REGION NAME' MAP":PRINT:GOTO 7320
7400 H8=0:G5=1:PRINT" THE GALAXY":GOTO 7550
7540 REM
7542 REM
7543 PRINT:PRINT" ";
7544 PRINT"COMPUTER RECORD OF GALAXY FOR QUADRANT";Q1;CHR$(8);",";Q2
7546 PRINT
7550 PRINT" 1 2 3 4 5 6 7 8"
7560 O1$=" +-----+-----+-----+-----+-----+-----+-----+-----+"
7570 PRINT O1$:FOR I=1 TO 8:PRINT I;" ";:IF H8=0 THEN 7740
7630 FOR J=1 TO 8:PRINT"| ";:IF Z(I,J)=0 THEN PRINT"*** ";:GOTO 7720
7700 PRINT RIGHT$(STR$(Z(I,J)+1000),3);" ";
7720 IF J=8 THEN PRINT "|"
7721 NEXT J:GOTO 7850
7740 Z4=I:Z5=1:GOSUB 9030:J0=INT(15-.5*LEN(G2$)):PRINT TAB(J0);G2$;
7800 Z5=5:GOSUB 9030:J0=INT(39-.5*LEN(G2$)):PRINT TAB(J0);G2$
7850 PRINT O1$:NEXT I:PRINT:GOTO 1990
7900 PRINT " STATUS REPORT:":PRINT " -------------":X$=""
7901 IF K9>1 THEN X$="S"
7940 PRINT K9;"KLINGON";X$;" LEFT."
7960 PRINT" MISSION MUST BE COMPLETED IN";.1*INT((T0+T9-T)*10);
7961 PRINT"STARDATES."
7970 X$="S":IF B9<2 THEN X$="":IF B9<1 THEN 8010
7980 PRINT" THE FEDERATION IS MAINTAINING";B9;
7981 PRINT"STARBASE";X$;" IN THE GALAXY."
7990 GOTO 5690
8010 PRINT"YOUR STUPIDITY HAS LEFT YOU ON YOUR OWN IN"
8020 PRINT" THE GALAXY -- YOU HAVE NO STARBASES LEFT!":GOTO 5690
8070 IF K3<=0 THEN 4270
8080 X$="":IF K3>1 THEN X$="S"
8090 PRINT"FROM ENTERPRISE TO KLINGON BATTLE CRUSER";X$
8100 H8=0:FOR I=1 TO 3:IF K(I,3)<=0 THEN 8480
8110 W1=K(I,1):X=K(I,2)
8120 C1=S1:A=S2:GOTO 8220
8150 PRINT"DIRECTION/DISTANCE CALCULATOR:"
8160 PRINT"YOU ARE AT QUADRANT ";Q1;CHR$(8);",";Q2;" SECTOR ";
8161 PRINT S1;CHR$(8);",";S2;CHR$(8);"."
8170 INPUT"PLEASE ENTER INITIAL COORDINATES (X,Y)";C1,A
8200 INPUT"FINAL COORDINATES (X,Y)";W1,X
8220 X=X-A:A=C1-W1:IF X<0 THEN 8350
8250 IF A<0 THEN 8410
8260 IF X>0 THEN 8280
8270 IF A=0 THEN C1=5:GOTO 8290
8280 C1=1
8290 IF ABS(A)<=ABS(X)THEN 8330
8310 PRINT"DIRECTION =";C1+(((ABS(A)-ABS(X))+ABS(A))/ABS(A)):GOTO 8460
8330 PRINT"DIRECTION =";C1+(ABS(A)/ABS(X)):GOTO 8460
8350 IF A>0 THEN C1=3:GOTO 8420
8360 IF X<>0 THEN C1=5:GOTO 8290
8410 C1=7
8420 IF ABS(A)>=ABS(X)THEN 8450
8430 PRINT"DIRECTION =";C1+(((ABS(X)-ABS(A))+ABS(X))/ABS(X)):GOTO 8460
8450 PRINT"DIRECTION =";C1+(ABS(X)/ABS(A))
8460 PRINT"DISTANCE =";SQR(X^2+A^2):IF H8=1 THEN 1990
8480 NEXT I:GOTO 1990
8500 IF B3<>0 THEN PRINT"FROM ENTERPRISE TO STARBASE:"
8501 W1=B4:X=B5:GOTO 8120
8510 PRINT"MR. SPOCK: 'SENSORS SHOW NO STARBASES IN THIS QUADRANT.'"";
8520 GOTO 1990
8590 R1=FNR(1):R2=FNR(1):A$=" ":Z1=R1:Z2=R2:GOSUB 8830
8591 IF Z3=0 THEN 8590
8600 RETURN
8670 S8=INT(Z2-.5)*3+INT(Z1-.5)*24+1
8675 IF LEN(A$)<>3 THEN PRINT"ERROR":STOP
8680 IF S8=1 THEN Q$=A$+RIGHT$(Q$,189):RETURN
8690 IF S8=190 THEN Q$=LEFT$(Q$,189)+A$:RETURN
8700 Q$=LEFT$(Q$,S8-1)+A$+RIGHT$(Q$,190-S8):RETURN
8790 ON R1 GOTO 8792,8794,8796,8798,8800,8802,8804,8806
8792 G2$="WARP ENGINES":RETURN
8794 G2$="SHORT RANGE SENSORS":RETURN
8796 G2$="LONG RANGE SENSORS":RETURN
8798 G2$="PHASER CONTROL":RETURN
8800 G2$="PHOTON TUBES":RETURN
8802 G2$="DAMAGE CONTROL":RETURN
8804 G2$="SHIELD CONTROL":RETURN
8806 G2$="LIBRARY-COMPUTER":RETURN
8830 Z1=INT(Z1+.5):Z2=INT(Z2+.5):S8=(Z2-1)*3+(Z1-1)*24+1:Z3=0
8890 IF MID$(Q$,S8,3)<>A$THEN RETURN
8900 Z3=1:RETURN
9030 IF Z5<=4 THEN ON Z4 GOTO 9040,9050,9060,9070,9080,9090,9100,9110
9035 GOTO 9120
9040 G2$="ANTARES":GOTO 9210
9050 G2$="RIGEL":GOTO 9210
9060 G2$="PROCYON":GOTO 9210
9070 G2$="VEGA":GOTO 9210
9080 G2$="CANOPUS":GOTO 9210
9090 G2$="ALTAIR":GOTO 9210
9100 G2$="SAGITTARIUS":GOTO 9210
9110 G2$="POLLUX":GOTO 9210
9120 ON Z4 GOTO 9130,9140,9150,9160,9170,9180,9190,9200
9130 G2$="SIRIUS":GOTO 9210
9140 G2$="DENEB":GOTO 9210
9150 G2$="CAPELLA":GOTO 9210
9160 G2$="BETELGEUSE":GOTO 9210
9170 G2$="ALDEBARAN":GOTO 9210
9180 G2$="REGULUS":GOTO 9210
9190 G2$="ARCTURUS":GOTO 9210
9200 G2$="SPICA"
9210 IF G5<>1 THEN ON Z5 GOTO 9230,9240,9250,9260,9230,9240,9250,9260
9220 RETURN
9230 G2$=G2$+" I":RETURN
9240 G2$=G2$+" II":RETURN
9250 G2$=G2$+" III":RETURN
9260 G2$=G2$+" IV":RETURN
9999 END

302
software/BAS/STARWARS.BAS
View File

@@ -1,302 +0,0 @@
10 REM ---DESIGNED TO RUN ON HEATH H19/H89---
900 WIDTH 80
1000 LET E$=CHR$(27):PRINT E$;"F";E$;"E";E$;"x5";E$;"Y#'";
1010 PRINT TAB(18);E$;"F";"faaqaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaac"
1020 PRINT TAB(18);"`";SPC(43);"`"
1030 PRINT TAB(18);"` 'S T A R W A R S' `"
1040 PRINT TAB(18);"`";SPC(43);"`"
1050 PRINT TAB(18);"`";E$;"G";" This program presented courtesy of ";
1060 PRINT E$;"F";"`"
1070 PRINT TAB(18);"`";SPC(43);"`"
1080 PRINT TAB(18);"`";E$;"p";" C U S T O M S O F T W A R E G R O U P ";
1090 PRINT E$;"q";"`"
1100 PRINT TAB(18);"`";SPC(43);"`"
1110 PRINT TAB(18);"`";E$;"G";" Specializing in custom programming for ";
1120 PRINT E$"F";"`"
1130 PRINT TAB(18);"` HEATH/ZENITH DATA SYSTEMS `"
1140 PRINT TAB(18);"`";SPC(43);"`"
1150 PRINT TAB(18);"` CUSTOM SOFTWARE GROUP `"
1160 PRINT TAB(18);"` POST OFFICE BOX `"
1170 PRINT TAB(18);"` BELLEVUE, NE 68005 `"
1180 PRINT TAB(18);"` PHONE 291-4622 `"
1190 PRINT TAB(18);"` 291-5819 `"
1200 PRINT TAB(18);"`";SPC(43);"`"
1210 PRINT TAB(18);"eaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaad";E$;"G"
1220 PRINT TAB(28);"PRESS RETURN TO CONTINUE"
1230 A$=INPUT$(1)
1240 PRINT CHR$(27);"G";CHR$(27);"w"
1250 CLEAR 1000
1260 PRINT CHR$(27);"E";CHR$(27);"Y! ";CHR$(27);"x5"
1270 PRINT ," ******** ********** ****** *********"
1280 PRINT ," ** ** ** ** ** ** **"
1290 PRINT ," ** ** ** ** ** **"
1300 PRINT ," ******** ** ********** *********"
1310 PRINT ," ** ** ** ** ** **"
1320 PRINT ," ** ** ** ** ** ** **"
1330 PRINT ," ******** ** ** ** ** **"
1340 PRINT:PRINT
1350 PRINT ," ** ** ****** ********* ********"
1360 PRINT ," ** ** ** ** ** ** ** **"
1370 PRINT ," ** ** ** ** ** ** **"
1380 PRINT ," ** ** ** ********** ********* ********"
1390 PRINT ," ** ** ** ** ** ** ** **"
1400 PRINT ," ******** ** ** ** ** ** **"
1410 PRINT ," ** ** ** ** ** ** ********"
1420 FOR I=1 TO 1000:NEXT I
1430 PRINT CHR$(27);"Y7 "
1440 PRINT ,"A LONG TIME AGO IN A GALAXY FAR, FAR AWAY, A GREAT"
1450 FOR I=1 TO 1000:NEXT I:PRINT
1460 PRINT ,"ADVENTURE TOOK PLACE. IT IS A PERIOD OF CIVIL WAR."
1470 FOR I=1 TO 1000:NEXT I:PRINT
1480 PRINT ,"REBEL SPACE SHIPS STRIKING FROM A HIDDEN BASE HAVE"
1490 FOR I=1 TO 1000:NEXT I:PRINT
1500 PRINT ,"WON THEIR FIRST VICTORY AGAINST THE EVIL GALACTIC"
1510 FOR I=1 TO 1000:NEXT I:PRINT
1520 PRINT ,"EMPIRE. DURING THE BATTLE, REBEL SPYS MANAGED TO"
1530 FOR I=1 TO 1000:NEXT I:PRINT
1540 PRINT ,"STEAL SECRET PLANS TO THE EMPIRE'S ULITMATE WEAPON"
1550 FOR I=1 TO 1000:NEXT I:PRINT
1560 PRINT ,"THE DEATH STAR, AN ARMOURED SPACE STATION WITH THE"
1570 FOR I=1 TO 1000:NEXT I:PRINT
1580 PRINT ,"FIRE POWER TO DESTROY AN ENTIRE PLANET. "
1590 FOR I=1 TO 1000:NEXT I:PRINT:PRINT
1600 PRINT ," YOUR MISSION AS ONE OF THE REBEL PILOTS IS TO"
1610 FOR I=1 TO 1000:NEXT I:PRINT
1620 PRINT ,"ATTACK AND DESTROY THE 'DEATH STAR'. WHILE MAKING"
1630 FOR I=1 TO 1000:NEXT I:PRINT
1640 PRINT ,"YOUR ATTACK YOU HAVE ENCOUNTERED 'DARTH VADER' AND"
1650 FOR I=1 TO 1000:NEXT I:PRINT
1660 PRINT ,"HIS IMPERIAL STORM TROOPERS IN THEIR TIE FIGHTERS."
1670 FOR I=1 TO 1000:NEXT I:PRINT
1680 PRINT ,"YOU MUST DESTROY THEM BEFORE THEY CAN DESTROY YOU."
1690 FOR I=1 TO 1000:NEXT I:PRINT:PRINT
1700 PRINT ," GOOD LUCK AND MAY THE 'FORCE' BE WITH YOU "
1710 FOR I=1 TO 2000:NEXT I
1720 REM
1730 REM .........................INSTRUCTIONS ROUTINE.......................
1740 REM
1750 PRINT CHR$(27);"E";CHR$(27);"Y*6";"DO YOU NEED:":PRINT
1760 PRINT TAB(30);"FULL INSTRUCTIONS <F>?"
1770 PRINT TAB(30);"BRIEF INSTRUCTIONS <B>?"
1780 PRINT TAB(30);"NO INSTRUCTIOnS <N>?"
1790 A$=INPUT$(1):IF A$="F" THEN 1870
1800 IF A$="B" THEN 2270
1810 IF A$="N" THEN 1820 ELSE 1790
1820 PRINT:PRINT TAB(29);"WHAT IS YOUR SKILL RATING?"
1830 A$=INPUT$(1):IF A$<"1" OR A$>"9" THEN 1850
1840 LET A$=A$+"0":LET A9=CVI(A$):LET A9=A9-12336:GOTO 2540
1850 PRINT:PRINT TAB(26);"EVIDENTLY YOU NEED INSTRUCTIONS!"
1860 FOR I=1 TO 500:NEXT I:PRINT
1870 PRINT CHR$(27);"E";CHR$(27);"Y! "
1880 PRINT "YOU HAVE BEEN EQUIPPED WITH AN X-WING ";
1890 PRINT " AS IN A REAL DOG-FIGHT YOU MUST LEAD"
1900 PRINT "FIGHTER BY THE REBEL ALLIANCE. YOUR ";
1910 PRINT " THE TARGET WHEN FIRING YOUR LASER. IF"
1920 PRINT "FIGHTER IS COMPUTER CONTROLLED BY THE ";
1930 PRINT " YOU WAIT UNTIL HE IS EXACTLY CENTERED"
1940 PRINT "NUMERIC KEYPAD ON YOUR KEY BOARD. THE ";
1950 PRINT " TO FIRE, THEN YOU WILL MISS HIM. YOU"
1960 PRINT "DISPLAY YOU WILL SEE IS YOUR ONBOARD ";
1970 PRINT " MAY CONTINUE TO FIRE AT HIM, BUT WHEN"
1980 PRINT "SCANNER. IN ORDER TO KILL AN ENEMY ";
1990 PRINT " YOU ARE FIRING YOUR WEAPON, YOUR CON-"
2000 PRINT "FIGHTER HE MUST RECEIVE A DIRECT HIT ";
2010 PRINT " TROL OF DIRECTION IS NOT AS GOOD AS"
2020 PRINT "OR MULTIPLE DAMAGING HITS. HE WILL ";
2030 PRINT " WHEN YOU AREN'T FIRING AND THE TARGET"
2040 PRINT "RECEIVE DAMAGE IF HIT WHEN HE IS +/- ";
2050 PRINT " MAY FLY OUT OF YOUR SIGHTS. "
2060 PRINT "10 DEGREES IN ELEVATION AND HE IS +/- ";
2070 PRINT " "
2080 PRINT "9 DEGREES IN BEARING. IN ADDITION TO ";
2090 PRINT " IN ORDER TO CENTER YOUR TARGET ON THE"
2100 PRINT "THIS HE MUST BE WITHIN 6500 KMS. ";
2110 PRINT " SCANNER YOU MUST FLY TOWARDS HIM. TO"
2120 PRINT " ";
2130 PRINT " TO DO THIS YOU PRESS THE KEY ON THE"
2140 PRINT "WARNING: THE 'TIE' FIGHTER HAS THE ";
2150 PRINT " NUMERIC KEY PAD THAT IS IN HIS DIREC-"
2160 PRINT "CAPABILITY TO POP IN AND OUT OF HYP- ";
2170 PRINT " TION. IE: IF HE IS IN THE UPPER-RIGHT"
2180 PRINT "ERSPACE. THEREFORE HE MAY DISAPPEAR ";
2190 PRINT " QUADRANT YOU WOULD PRESS KEY 9 TO FLY"
2200 PRINT "RIGHT FROM BEFORE YOUR SIGHTS. ";
2210 PRINT " TOWARDS HIM. IF HE IS BELOW, PRESS 2."
2220 PRINT " ";
2230 PRINT " "
2240 PRINT " MAY THE FORCE BE WITH YOU ";
2250 PRINT " PRESS RETURN TO CONT ";
2260 LINE INPUT A$
2270 PRINT CHR$(27);"E"
2280 PRINT CHR$(27);"F";
2290 PRINT ," UP & UP UP &"
2300 PRINT ," LEFT faaaaac faaaaac faaaaac RIGHT"
2310 PRINT ," ` 7 ` ` 8 ` ` 9 `"
2320 PRINT ," eaaaaad eaaaaad eaaaaad"
2330 PRINT ," faaaaac faaaaac faaaaac"
2340 PRINT ," LEFT ` 4 ` ` 5 ` ` 6 ` RIGHT"
2350 PRINT ," eaaaaad eaaaaad eaaaaad"
2360 PRINT ," faaaaac faaaaac faaaaac"
2370 PRINT ," ` 1 ` ` 2 ` ` 3 `"
2380 PRINT ," DOWN eaaaaad eaaaaad eaaaaad RIGHT"
2390 PRINT ," LEFT faaaaac DOWN DOWN"
2400 PRINT ," ` 0 `"
2410 PRINT ," eaaaaad"
2420 PRINT ," FIRE"
2430 PRINT CHR$(27);"G"
2440 PRINT TAB(18);"<<PRESS '5' TO STOP ANY TURNS OR CLIMBS.>>":PRINT
2450 PRINT TAB(23);"ENTER A SKILL RATING FROM 1 TO 9"
2460 PRINT TAB(27);"NOVICE.................1"
2470 PRINT TAB(27);"EXPERT.................9":PRINT
2480 PRINT "AFTER SCANNER CONSTRUCTION IS COMPLETE, PRESS ANY CONTROL KEY TO"
2485 PRINT "START YOUR SCAN"
2490 A$=INPUT$(1):IF A$<"1" OR A$>"9" THEN 2490
2500 LET A$=A$+"0":LET A9=CVI(A$):LET A9=A9-12336
2510 REM
2520 REM ......................GRID CONSTRUCTION ROUTINE....................
2530 REM
2540 PRINT CHR$(27);"F";CHR$(27);"x1";CHR$(27);"x5":PRINT CHR$(27);"E";
2550 PRINT TAB(16);"RANGE:g9999 KM ELEVATION:g90 DEG BEARING:g90 DEG"
2560 PRINT:ED=0
2570 PRINT TAB(8);"-90 -75 -60 -45 -30 -15 0 +15 +30 +45 +60 +75 +90"
2580 PRINT TAB(5);"+90 bssssbssssbssssbssssbssssbssssbssssbssssbssssbssssbssssbssssb +90"
2590 PRINT TAB(9);"v";SPC(59);"t":PRINT TAB(9);"v";SPC(59);"t"
2600 PRINT TAB(5);"+60 b";SPC(59);"b +60"
2610 PRINT TAB(9);"v";SPC(59);"t":PRINT TAB(9);"v";SPC(59);"t"
2620 PRINT TAB(5);"+30 b";SPC(59);"b +30"
2630 PRINT TAB(9);"v";SPC(59);"t":PRINT TAB(9);"v";SPC(59);"t"
2640 PRINT TAB(6);"0 b";SPC(59);"b 0"
2650 PRINT TAB(9);"v";SPC(59);"t":PRINT TAB(9);"v";SPC(59);"t"
2660 PRINT TAB(5);"-30 b";SPC(59);"b -30"
2670 PRINT TAB(9);"v";SPC(59);"t":PRINT TAB(9);"v";SPC(59);"t"
2680 PRINT TAB(5);"-60 v";SPC(59);"t -60"
2690 PRINT TAB(9);"v";SPC(59);"t":PRINT TAB(9);"v";SPC(59);"t"
2700 PRINT " -90 buuuubuuuubuuuubuuuubuuuubuuuubuuuubuuuubuuuubuuuubuuuubuuuub -90"
2710 PRINT " -90 -75 -60 -45 -30 -15 0 +15 +30 +45 +60 +75 +90"
2720 REM
2730 REM ......................INPUT CONTROL SCAN ROUTINE...................
2740 REM
2750 CD=200+INT(200*RND(1)):FL$="5"
2760 IF CT=CD THEN 3910 ELSE CT=CT+1
2770 IF FL$="0" THEN 2950
2780 IF INP(17)=48 AND FL$<>"0" THEN FL$=INPUT$(1)
2790 IF INP(17)=49 AND FL$<>"1" THEN FL$=INPUT$(1)
2800 IF INP(17)=50 AND FL$<>"2" THEN FL$=INPUT$(1)
2810 IF INP(17)=51 AND FL$<>"3" THEN FL$=INPUT$(1)
2820 IF INP(17)=52 AND FL$<>"4" THEN FL$=INPUT$(1)
2830 IF INP(17)=53 AND FL$<>"5" THEN FL$=INPUT$(1)
2840 IF INP(17)=54 AND FL$<>"6" THEN FL$=INPUT$(1)
2850 IF INP(17)=55 AND FL$<>"7" THEN FL$=INPUT$(1)
2860 IF INP(17)=56 AND FL$<>"8" THEN FL$=INPUT$(1)
2870 IF INP(17)=57 AND FL$<>"9" THEN FL$=INPUT$(1)
2880 IF INP(17)<48 OR INP(17)>57 AND DM$<>CHR$(INP(17)) THEN DM$=INPUT$(1)
2890 GOSUB 3340:REM ..FIGHTER UPDATE
2900 PRINT CHR$(27);"Y&3+";CHR$(27);"Y23+";CHR$(27);"Y)=+";CHR$(27);"Y/=+";CHR$(27);"Y,G+";CHR$(27);"Y)Q+";CHR$(27);"Y/Q+";CHR$(27);"Y&[+";CHR$(27);"Y2[+"
2910 GOTO 2760
2920 REM
2930 REM .......................FIRE WEAPON ROUTINE........................
2940 REM
2950 FOR I=8 TO 1 STEP -1
2960 PRINT CHR$(27);"Y";CHR$(44+I);CHR$(71-I);"x"
2970 PRINT CHR$(27);"Y";CHR$(44+I);CHR$(71+I);"y"
2980 IF I > 6 THEN 3010
2990 PRINT CHR$(27);"Y";CHR$(46+I);CHR$(69-I);" "
3000 PRINT CHR$(27);"Y";CHR$(46+I);CHR$(73+I);" "
3010 NEXT I
3020 PRINT CHR$(27);"Y.E ";CHR$(27);"Y.I ";CHR$(27);"Y-F ";CHR$(27);"Y-H "
3030 IF FX<>44 OR FY<>70 THEN 3190
3040 IF KM>5000 THEN 2790
3050 PRINT CHR$(27);"p";CHR$(27);"Y8? ENEMY DESTROYED ":DG=0
3060 PRINT CHR$(27);"p":ED=ED+1
3070 PRINT CHR$(27);"Y";CHR$(FX-1);CHR$(FY);"ppp"
3080 PRINT CHR$(27);"Y";CHR$(FX);CHR$(FY-1);" "
3090 PRINT CHR$(27);"q";CHR$(27);"Y";CHR$(FX+1);CHR$(FY);"ppp"
3100 FOR I=1 TO 25:PRINT CHR$(7);:NEXT I
3110 PRINT CHR$(27);"Y";CHR$(FX);CHR$(FY);"iii"
3120 FOR I=1 TO 25: NEXT I
3130 PRINT CHR$(27);"Y";CHR$(FX-1);CHR$(FY);" "
3140 PRINT CHR$(27);"Y";CHR$(FX);CHR$(FY-1);" iii "
3150 PRINT CHR$(27);"Y";CHR$(FX+1);CHR$(FY);" "
3160 FOR I=1 TO 25: NEXT I
3170 PRINT CHR$(27);"Y";CHR$(FX);CHR$(FY);" "
3180 FQ=0:IF ED=5 THEN 3860 ELSE 2790
3190 IF FX<43 OR FX>45 THEN 3310
3200 IF FY<68 OR FY>72 THEN 3310
3210 LET DG=DG+1:IF DG=3 THEN 3050
3220 PRINT CHR$(27);"Y";CHR$(FX-1);CHR$(FY);"iii"
3230 PRINT CHR$(27);"Y";CHR$(FX);CHR$(FY-1);"i"
3240 PRINT CHR$(27);"Y";CHR$(FX);CHR$(FY+3);"i"
3250 PRINT CHR$(27);"Y";CHR$(FX+1);CHR$(FY);"iii"
3260 FOR I=1 TO 250: NEXT I
3270 PRINT CHR$(27);"Y";CHR$(FX-1);CHR$(FY);" "
3280 PRINT CHR$(27);"Y";CHR$(FX);CHR$(FY-1);" "
3290 PRINT CHR$(27);"Y";CHR$(FX);CHR$(FY+3);" "
3300 PRINT CHR$(27);"Y";CHR$(FX+1);CHR$(FY);" ":GOTO 2790
3310 PRINT CHR$(27);"Y8 ";CHR$(27);"l"
3320 GOTO 2790
3330 REM
3340 REM ...................FIGHTER POSITION UPDATE ROUTINE................
3350 REM
3360 IF FQ=1 THEN 3430 ELSE FQ=1
3370 LET FX=INT(100*RND(1))
3380 IF FX<36 OR FX>52 THEN 3370
3390 LET FY=INT(200*RND(1))
3400 IF FY<44 OR FY>97 THEN 3390
3410 LET KM=INT(10000*RND(1))
3420 FZ=INT(16*RND(1))
3430 IF INT(100*RND(1))>6 THEN 3450
3440 FZ=INT (16*RND(1))
3450 IF INT(10*RND(1))<A9 THEN 3460 ELSE X=FX:Y=FY:GOTO 3620
3460 IF FZ<>0 THEN 3470 ELSE X=FX-1:Y=FY+1
3470 IF FZ<>1 THEN 3480 ELSE S=FX:Y=FY+1
3480 IF FZ<>2 THEN 3490 ELSE X=FX+1:Y=FY+1
3490 IF FZ<>3 THEN 3500 ELSE X=FX+1:Y=FY
3500 IF FZ<>4 THEN 3510 ELSE X=FX+1:Y=FY-1
3510 IF FZ<>5 THEN 3520 ELSE X=FX:Y=FY-1
3520 IF FZ<>6 THEN 3530 ELSE X=FX-1:Y=FY-1
3530 IF FZ<>7 THEN 3540 ELSE X=FX-1:Y=FY
3540 IF FZ<>8 THEN 3550 ELSE X=FX-1:Y=FY+2
3550 IF FZ<>9 THEN 3560 ELSE X=FX-1:Y=FY+3
3560 IF FZ<>10 THEN 3570 ELSE X=FX+1:Y=FY+3
3570 IF FZ<>11 THEN 3580 ELSE X=FX+1:Y=FY+2
3580 IF FZ<>12 THEN 3590 ELSE X=FX+1:Y=FY-2
3590 IF FZ<>13 THEN 3600 ELSE X=FX+1:Y=FY-3
3600 IF FZ<>14 THEN 3610 ELSE X=FX-1:Y=FY-3
3610 IF FZ<>15 THEN 3620 ELSE X=FX-1:Y=FY-2
3620 IF FL$<>"1" THEN 3630 ELSE X=X-1:Y=Y+1
3630 IF FL$<>"2" THEN 3640 ELSE X=X-2:Y=Y
3640 IF FL$<>"3" THEN 3650 ELSE X=X-1:Y=Y-1
3650 IF FL$<>"4" THEN 3660 ELSE X=X:Y=Y+2
3660 IF FL$<>"6" THEN 3670 ELSE X=X:Y=Y-2
3670 IF FL$<>"7" THEN 3680 ELSE X=X+1:Y=Y+1
3680 IF FL$<>"8" THEN 3690 ELSE X=X+2:Y=Y
3690 IF FL$<>"9" THEN 3700 ELSE X=X+1:Y=Y-1
3700 IF X>39 AND X<50 AND Y>55 AND Y<87 THEN 3740
3710 IF SGN(KM)=+1 THEN KM=KM+INT(200*RND(1))
3720 IF SGN(KM)=-1 THEN KM=KM-INT(200*RND(1))
3730 IF KM<10000 THEN 3760 ELSE 3830
3740 IF SGN(KM)=+1 THEN KM=KM-INT(200*RND(1))
3750 IF SGN(KM)=-1 THEN KM=KM+INT(200*RND(1))
3760 IF X<36 OR X>52 OR Y<42 OR Y>98 THEN 3830
3770 IF X=FX AND Y=FY THEN RETURN
3780 PRINT CHR$(27);"Y";CHR$(FX);CHR$(FY);" ":FX=X:FY=Y
3790 PRINT CHR$(27);"Y";CHR$(FX);CHR$(FY);"v^t"
3800 PRINT CHR$(27);"Y 5";KM
3810 EV=10*(44-FX):PRINT CHR$(27);"Y K";EV
3820 BR=3*(FY-70):PRINT CHR$(27);"Y \";BR:RETURN
3830 PRINT CHR$(27);"Y";CHR$(FX);CHR$(FY);" "
3840 FQ=0:RETURN
3850 PRINT CHR$(27);"Y8 ";CHR$(27);"l":RETURN
3860 FOR I=1 TO 500:NEXT I:PRINT CHR$(27);"y1";CHR$(27);"Y ";CHR$(27);"E"
3870 PRINT CHR$(27);"q";CHR$(27);"Y( ";CHR$(27);"G"
3880 PRINT ,"CONGRATULATIONS ON A JOB WELL DONE. YOU HAVE"
3890 PRINT ,"DESTROYED DARTH VADER AND HIS STORM TROOPERS "
3900 PRINT ,"AND HAVE SAVED THE REBELLION.":GOTO 3950
3910 PRINT CHR$(27);"E";CHR$(27);"Y( "
3920 PRINT ,"YOU HAVE ONLY DESTROYED";ED;"TIE FIGHTERS AND";CHR$(27);"y1"
3930 PRINT ,"YOU LET DARTH VADER GET AWAY. OH WELL,I GUESS";CHR$(27);"G"
3940 PRINT ,"WE WANT HIM AROUND FOR THE SEQUEL ANYWAY!"
3950 PRINT:PRINT ,"DO YOU WANT TO PLAY AGAIN <Y or N>?"
3960 A$=INPUT$(1):IF A$="Y"THEN 1820ELSE IF A$<>"N"THEN 3960ELSE 1000
950 PRINT:PRINT ,"DO YOU WANT TO PLAY AGAIN <Y or N>?"
3960 A$=INPUT$(1):IF A$="Y"THEN 1820ELSE IF A$<>

546
software/BAS/STRTRK#2.bas
View File

@@ -1,546 +0,0 @@
1000 'EXPANDED APRIL 1977 BY W.A.BURTON
1001 'PIRATED JAN. 1978 BY ZOSO
1002 DIM G(8,8),S(8,8),K(3,3)
1003 PRINTCHR$(26)
1004 PRINT TAB(21)"--STARTREK--":PRINT
1005 PRINT
1006 INPUT "WHAT IS YOUR SECURITY CLEARANCE NUMBER (1 TO 1000)";T9
1007 E8=T9
1008 IF T9<1 OR T9>1000 THEN PRINT AR$;"INVALID!! REENTER!!":GOTO 1006
1009 FOR A=1 TO T9/2
1010 R9=RND(1):R9=RND(2)
1011 NEXT
1012 CLEAR:PRINTCHR$(26):INPUT" ENTER RANK (1=LOW,12=HIGH)";R9
1013 RR=R9
1014 X4=R9:R9=R9+1E-03:W1=W1+1E-03
1015 PRINT CHR$(26)
1016 PRINT "COMMAND ORDER : STAND BY !"
1017 PRINT "YOU ARE PRESENTLY BEING ASSIGNED TO A MISSION..."
1018 PRINT " WITH A FAILURE FACTOR OF"; (RR*20)
1019 PRINT" GOOD-BYE, SIR..."
1020 CX=.017453:AR$=" ---> "
1021 XA=INT(X4*50):AC=(1/(X4+.1))
1022 IFX4>=9THEN1379
1023 E=3000-XA+100:P=10:S9=200
1024 DEF FND(D)=SQR((K(I,1)-S1)^2+(K(I,2)-S2)^2)
1025 Q1=INT(RND(1)*8+1):Q2=INT(RND(1)*8+1)
1026 S1=INT(RND(1)*8+1):S2=INT(RND(1)*8+1)
1027 DATA WARP ENGINES,SHORT RANGE SENSORS,LONG RANGE SENSORS
1028 DATA PHASERS, PHOTON TORPEDOES,SHIELD CONTROL
1029 DATA DAMAGE CONTROL, COMPUTER,DAMAGE REPAIR,COMMUNICATIONS
1030 FOR A=1TO10:READ D$(A):NEXT A
1031 A$(0)=" . ":A$(1)=" E ":A$(2)=" * ":A$(3)=" K ":A$(4)=" B "
1032 F1=.86:F2=.01:F3=.95:F4=.99:K9=0:B9=K9
1033 FORI=1TO8:FORJ=1TO8:R1=RND(1):R2=RND(1):R3=INT(8*RND(1)+1)
1034 K3=-(R1>F1-F2*R9)-(R1>F3-F2*R9)-(R1>F4-F2*R9):K9=K9+K3
1035 B3=-(R2>F3):B9=B9+B3:G(I,J)=100*K3+10*B3+R3:NEXTJ,I
1036 IF NOT(B9>0ANDK9>0)THEN1032
1037 PRINT"OBJECTIVE:DESTROY"K9"KLINGONS USING"B9"STARBASE";
1038 U=K9:Y=B9
1039 IFB9=1THENPRINT" ";:GOTO1041
1040 PRINT"S ";
1041 T9=K9+RND(1)*K9/R9+10-R9:PR=T9/K9:PRINT"IN"T9"STARDAYS."
1042 GOSUB 1425
1043 S3=0:B3=S3:K3=B3:FORA=1TO8:FORB=1TO8:S(A,B)=0:NEXTB,A
1044 FORA=1TO3:FORB=1TO3:K(A,B)=0:NEXTB,A:S(S1,S2)=1
1045 X=.01*G(Q1,Q2):K3=INT(X):Y=(X-K3)*10:B3=INT(Y)
1046 S3=G(Q1,Q2)-100*K3-10*B3
1047 IF K3=0THENFORA=1TO3:FORB=1TO3:K(A,B)=0:NEXTB,A:GOTO1051
1048 PRINTAR$;"CONDITION RED !!!!!":FORA=1TOK3
1049 R1=INT(RND(1)*8+1):R2=INT(RND(1)*8+1):IFS(R1,R2)<>0THEN1049
1050 S(R1,R2)=3:K(A,1)=R1:K(A,2)=R2:K(A,3)=S9:NEXT A:IFB3=0THEN1054
1051 IFB3=0THEN1054
1052 R1=INT(RND(1)*8+1):R2=INT(RND(1)*8+1):IFS(R1,R2)<>0THEN1052
1053 S(R1,R2)=4
1054 IFS3=0THEN1058
1055 FORA=1TOS3
1056 R1=INT(RND(1)*8+1):R2=INT(RND(1)*8+1):IFS(R1,R2)<>0THEN1056
1057 S(R1,R2)=2:NEXTA
1058 G(Q1,Q2)=INT(G(Q1,Q2))+.5
1059 PRINT
1060 PRINT"QUADRANT (";MID$(STR$(Q1),2,1);",";MID$(STR$(Q2),2,1);")"
1061 PRINT"SECTOR (";MID$(STR$(S1),2,1);",";MID$(STR$(S2),2,1);")"
1062 IFKP<>0THEN1404
1063 IF DT=1 THEN 1267
1064 IFS<200*K3THENPRINTAR$;"SHIELD ENERGY TOO LOW":SL=1:A=6:GOTO1074
1065 A=2: GOTO1074
1066 PRINT
1067 PRINTD$(2):FORA=1TO8:FORB=1TO8:PRINTA$(S(A,B));:NEXTB:PRINT:NEXTA
1068 PRINT:PRINT"SHIELDS";S;SPC(4);"ENERGY";E;SPC(4);"PHOTONS";P;
1069 PRINTSPC(4);"STARDAYS";T9-T
1070 GOSUB1321:INPUT"COMMAND";A
1071 IF A>10 OR A<0 THEN INPUT" ----> COMMAND";A
1072 IFA>10ORA<0THENPRINT"WARNING - PROPER COMMANDS ONLY !! ":GOTO 1070
1073 IFA=1THEN1077
1074 IFD(A)>=0THEN1077
1075 PRINTAR$;"CAPTAIN, WE DON'T HAVE ";D$(A);" ANYMORE."
1076 IF DT=1 THEN 1267 ELSE 1070
1077 ONAGOTO1081,1066,1146,1152,1178,1213,1222,1267,1489,1389
1078 PRINT:FORA=1TO9:PRINTA;" = ";D$(A):NEXTA
1079 A=10
1080 PRINTA;"= ";D$(A):GOTO1070
1081 INPUT"COURSE";C1:IF C1<0 OR C1>359.99 THEN1084
1082 INPUT"WARP FACTOR";W1
1083 SL=0:KP=0:GOTO 1085
1084 PRINTAR$"REJECTED ! COURSE MUST BE IN RANGE OF O TO 359.99 DGRS."
1085 IFNOT(W1>0)THEN1070
1086 IFD(1)>=0ORW1<=ACTHEN1089
1087 PRINTAR$;"WARP ENGINES ARE DAMAGED, MAXIMUM SPEED = ";AC
1088 GOTO1081
1089 TEC=TEC+1:C$="":IFK3>0THENGOSUB1228
1090 IFE>5*W1THEN1097
1091 IFS<1THEN1244
1092 PRINT"CAPTAIN, YOU ONLY HAVE"E"UNITS OF ENERGY. "
1093 PRINT"REFUEL FROM YOUR SHIELD RESERVES, WHICH HAVE"S"UNITS?"
1094 A=6
1095 IFD(A)<0THEN1244
1096 GOTO1070
1097 FORI=1TO10:IFD(I)>=0THEN1101
1098 D(I)=D(I)+1:IFD(I)<0THEN1101
1099 IFD(7)<0THEN1101
1100 PRINT"DAMAGE CONTROL REPORT: "D$(I)" REPAIRED."
1101 NEXTI:IFRND(1)>.1THEN1112
1102 IFRND(1)>.1THEN1112
1103 GOTO1109
1104 IFRND(1)>R9/10THENRETURN
1105 R1=INT(RND(1)*8+1):IFD(R1)<0THENRETURN
1106 D(R1)=D(R1)-10*RND(1)-1:IFD(7)<0THENRETURN
1107 IFD(7)<0THENRETURN
1108 PRINT:PRINT"DAMAGE CONTROL REPORT: "D$(R1)" OUT.":PRINT:RETURN
1109 R1=INT(RND(1)*8+1):IFD(R1)>=0THEN1112
1110 IFD(7)<0THEN1112
1111 PRINT:D(R1)=0:PRINT"DAMAGE CONTROL REPORT: "D$(R1)" REPAIRED.":PRINT
1112 W1=W1*8:A1=8*Q2+S2-9:B1=72-8*Q1-S1:IFW1<1THENW1=W1*1.25
1113 E=E-2*W1:T=T+W1/25:IFT>T9THEN1251
1114 A2=INT(A1+W1*COS(C1*CX)+.5)
1115 B2=INT(B1+W1*SIN(C1*CX)+.5)
1116 IFNOT(A2<0ORA2>63ORB2<0ORB2>63)THEN1119
1117 PRINTAR$;"CAPTAIN, HEED STARFLEET REGULATIONS! ( STAY IN GALAXY ) !!
1118 T=T+W1/24:GOTO1070
1119 DEF FNA1(X)=INT(.5+A1+X*COS(C1*CX))
1120 DEF FNB1(X)=INT(.5+B1+X*SIN(C1*CX))
1121 FORX=0TOINT(W1)
1122 IFNOT(Q1=8-INT(FNB1(X)/8)ANDQ2=INT(FNA1(X)/8+1))THENX=W1:GOTO1139
1123 S3=8-FNB1(X)+8*INT(FNB1(X)/8):S4=FNA1(X)+1-8*INT(FNA1(X)/8)
1124 IFS(S3,S4)<2THEN1139
1125 S(S1,S2)=0:S1=8-FNB1(X-1)+8*INT(FNB1(X-1)/8)
1126 S2=FNA1(X-1)+1-8*INT(FNA1(X 1)/8):S(S1,S2)=1
1127 PRINTAR$;"NAVIGATIONAL ERROR :ENGINES SHUT DOWN AT (";
1128 PRINTMID$(STR$(S1),2,1);","MID$(STR$(S2),2,1);")"
1129 T=T+(W1/24)
1130 PRINT" YOU LOST "T" UNITS STARTIME RESTARTING ENGINES."
1131 PRINT
1132 IF S(S3,S4)<>4 THEN 1070
1133 PRINT"SHIELDS LOWERED FOR REFUELING"
1134 S=0:P=10:C$="D":E=3000-XA+100
1135 GOSUB 1228
1136 FORR1=1TO 10
1137 IFD(R1)>=0THENNEXTR1:GOTO1070
1138 D(R1)=D(R1)+(11*RND(1)/R9):NEXTR1:GOTO1070
1139 NEXT X:S(S1,S2)=0:S1=8-B2+8*INT(B2/8):S2=A2+1-8*INT(A2/8)
1140 Q3=8-INT(B2/8):Q4=INT(A2/8)+1
1141 IFNOT(Q1=Q3ANDQ2=Q4)THENQ1=Q3:Q2=Q4:GOTO1043
1142 S(S1,S2)=1:FORA=S1-1TOS1+1:FORB=S2-1TOS2+1
1143 IFA>8ORB>8ORA<1ORB<1THEN1145
1144 IFS(A,B)=4THEN1133
1145 NEXTB,A:GOTO1070
1146 PRINT
1147 FOR A=(Q1-1) TO (Q1+1):FOR B=(Q2-1) TO (Q2+1)
1148 IFA<1ORB<1ORA>8ORB>8THENPRINT" ***";:NEXTB:PRINT" ":PRINT:NEXTA:GOTO1070
1149 PRINT" "SPC(3-LOG(G(A,B)+1)/LOG(10));
1150 PRINTMID$(STR$(G(A,B)),2,LOG(G(A,B))/LOG(10)+1);
1151 G(A,B)=INT(G(A,B))+.5:NEXTB:PRINT" ":PRINT:NEXTA:GOTO1070
1152 PRINT
1153 IFK3<=0THEN1226
1154 IFD(8)>=0THEN1156
1155 PRINTAR$;" COMPUTER FAILURE HAMPERS ACCURACY"
1156 PRINT"PHASERS LOCKED ON TARGET. ENERGY AVAILABLE="E
1157 PRINT"NUMBER OF UNITS TO FIRE:";
1158 INPUT X
1159 IF E-X<0THENPRINT"NOT ENOUGH POWER":GOTO1070
1160 T=T+.05:IFT>T9THEN1251
1161 E=E-X
1162 IF C$<>"D"THEN GOSUB 1228
1163 IFD(8)>=0THEN1165
1164 X=X*RND(1)
1165 FORI=1TO3
1166 IFK(I,3)<=0THEN1176
1167 H=(X/FND(0))+SGN(RND(1)-.5)*8*RND(1)
1168 K(I,3)=K(I,3)-H
1169 PRINTH"UNIT HIT ON VESSEL AT (";MID$(STR$(K(I,1)),2,1);",";
1170 PRINTMID$(STR$(K(I,2)),2,1);"), LEAVING"K(I,3)"
1171 IFK(I,3)>0THEN1176
1172 PRINT"KLINGON AT (";MID$(STR$(K(I,1)),2,1);",";MID$(STR$(K(I,2)),2,1);
1173 PRINT") DESTROYED":K3=K3-1:K9=K9-1:IFK9=0THEN1264
1174 G(Q1,Q2)=G(Q1,Q2)-100:S(K(I,1),K(I,2))=0:K(I,1)=0:K(I,2)=0
1175 K(I,3)=0
1176 NEXT I
1177 GOTO1070
1178 PRINT
1179 IFP>0THEN1182
1180 PRINTAR$;"ALL PHOTON TORPEDOES EXPENDED"
1181 GOTO1070
1182 INPUT"DIRECTION";C1
1183 T=T+.05:IFT>T9THEN1251
1184 P=P-1:IF C$<>"D" THEN GOSUB 1228
1185 A1=8*Q2+S2-9:B1=72-8*Q1-S1:IFC1=90*INT(C1/90)THEN1208
1186 DEF FNA1(W1)=INT(.5+A1+W1*COS(C1*CX))
1187 DEF FNB1(W1)=INT(.5+B1+W1*SIN(C1*CX))
1188 FORW1=0TO10STEP.9
1189 IFW1=0THENS3=S1:S4=S2:GOTO1194
1190 IFNOT(Q1=8-INT(FNB1(W1)/8)ANDQ2=INT(FNA1(W1)/8+1))THEN1070
1191 S3=8-FNB1(W1)+8*INT(FNB1(W1)/8):S4=FNA1(W1)+1-8*INT(FNA1(W1)/8)
1192 IFFNA1(W1)=A2ANDFNB1(W1)=B2THEN1206
1193 A2=FNA1(W1):B2=FNB1(W1)
1194 PRINT"(";MID$(STR$(S3),2,1);",";MID$(STR$(S4),2,1);")";A$(S(S3,S4))
1195 ON S(S3,S4)+1GOTO1206,1206,1204,1196,1203
1196 IFRND(1)<(.1*X4) THENPRINT"SHIELDS DEFLECT TORPEDO":GOTO1070
1197 PRINT"KLINGON DESTROYED":S(S3,S4)=0:G(Q1,Q2)=G(Q1,Q2)-100
1198 K3=K3-1:K9=K9-1:IFK9=0THEN1264
1199 FORA=1TO3
1200 IFK(A,1)=S3ANDK(A,2)=S4THENK(A,1)=0:K(A,2)=0:K(A,3)=0
1201 NEXTA
1202 GOTO1070
1203 PRINTAR$;"STARBASE DESTROYED":B3=0:B9=B9-1:S(S3,S4)=0:GOTO1205
1204 PRINTAR$;"YOU CAN'T DESTROY A STAR":GOTO1070
1205 G(Q1,Q2)=G(Q1,Q2)-10:GOTO1070
1206 NEXT W1
1207 GOTO1070
1208 FORW1=0TO8
1209 S3=INT(S1-W1*SIN(C1*CX))
1210 S4=INT(S2+W1*COS(C1*CX))
1211 IFS3>8ORS4>8ORS3<1ORS4<1THEN1070
1212 GOTO1194
1213 PRINT
1214 PRINT"ENERGY AVAILABLE="E+S" NUMBER OF UNITS TO SHIELDS";
1215 INPUT X
1216 IFX<0THEN1070
1217 IFE+S-X<0THEN1214
1218 E=E+S-X
1219 S=X
1220 IFSL=1THEN1065
1221 GOTO1070
1222 PRINT
1223 PRINT"DEVICE STATE OF REPAIR"
1224 FORR1=1TO10:PRINTD$(R1);TAB(21) D(R1):NEXTR1
1225 IF DT=1 THEN 1267 ELSE 1070
1226 PRINT"SHORT RANGE SENSORS REPORT NO KLINGONS IN THIS QUADRANT"
1227 IF DT=1 THEN 1267 ELSE 1070
1228 IF C$="D" AND K3<>0 THEN PRINT"STARBASE PROTECTS ENTERPRISE" ELSE 1230
1229 GOTO1070
1230 PRINT
1231 FORI=1TO3
1232 IFK(I,3)<=0THEN1242
1233 H=K(I,3)/FND(0)+SGN(RND(1)-.5)*RND(1)*7
1234 S=S-H:PRINTH"UNIT HIT FROM ("MID$(STR$(K(I,1)),2,1);",";
1235 PRINTMID$(STR$(K(I,2)),2,1);"), LEAVING"S
1236 IFS<0THEN1254
1237 GOSUB1104
1238 IFRND(1)>R9/10THEN1242
1239 R1=INT(8*RND(1)+1):R2=INT(8*RND(1)+1)
1240 IFNOT(S(R1,R2)=0)THEN1239
1241 S(R1,R2)=3:S(K(I,1),K(I,2))=0:K(I,1)=R1:K(I,2)=R2
1242 NEXTI
1243 RETURN
1244 PRINT AR$;" ENTERPRISE DEAD IN SPACE"
1245 PRINT
1246 CY=1:PRINT:GOTO1258
1247 IFK3<=0THEN1258
1248 GOSUB1228
1249 GOTO1247
1250 PRINT
1251 PRINT:PRINT:PRINT:PRINT:PRINT:PRINTAR$;
1252 PRINT"IT IS STARDATE"T:PRINT
1253 GOTO1258
1254 PRINT
1255 PRINT:PRINT:PRINT:PRINT:PRINT:PRINTAR$;
1256 PRINT"ENTERPRISE DISABLED !!":PRINT:PRINT
1257 CY=0
1258 PRINT"THERE ARE"K9"KLINGONS REMAINING.":IFCY<>0THEN1355
1259 PRINT"YOU HAVE FAILED !!":PRINT
1260 L=INT(RND(1)*5)
1261 ONL+1GOTO 1343,1346,1348,1350,1353
1262 PRINT:INPUT"DO YOU WANT TO TRY AGAIN";X$
1263 IF LEFT$(X$,1)="Y" THEN 1012 ELSE 1541
1264 PRINT"THE FEDERATION IS SAVED !!"
1265 PRINT"YOU ARE HEREBY PROMOTED TO ADMIRAL!!!!":PRINT
1266 GOTO1262
1267 DT=1
1268 INPUT"COMPUTER ON--COMMAND";A
1269 IF A>=10 THEN PRINT AR$;" NO SUCH COMMAND !!":GOTO 1268
1270 ONA+1GOTO1289,1294,1299,1283,1059,1339,1341,1510,1070
1271 PRINT"FUNCTIONS AVAILABLE FROM COMPUTER"
1272 PRINT" 0 = GALACTIC MEMORY MAP"
1273 PRINT" 1 = GENERAL STATUS REPORT"
1274 PRINT" 2 = PHOTON TRAJECTORY"
1275 PRINT" 3 = NEW MISSION"
1276 PRINT" 4 = PRESENT POSITION"
1277 PRINT" 5 = SELF-DESTRUCT"
1278 PRINT" 6 = WARP-COMPASS"
1279 PRINT" 7 = MISSION PROGRESS REPORT"
1280 PRINT" 8 = EXIT COMPUTER"
1281 GOTO1267
1282 PRINT:PRINT"--TEMPORARY MALFUNCTION--":GOTO 1070
1283 IF XM<0 THEN 1287
1284 PRINT AR$;"SAFETY CHECK -- DO YOU WISH TO ABORT MISSION":INPUT AN$
1285 IF LEFT$(AN$,1)<>"Y" THEN 1288 ELSE 1012
1286 PRINT
1287 PRINT"YOU HAVE NOT BEEN AUTHORIZED FOR NEW MISSION !!":PRINT
1288 GOTO 1267
1289 PRINT"QUADRANT CODE MEMORY MAP"
1290 FORA=1TO:FORB=1TO8:IFG(A,B)=INT(G(A,B))THENPRINT" ???";:GOTO1293
1291 PRINT" "SPC(3-LOG(G(A,B)+1)/LOG(10));
1292 PRINTMID$(STR$(G(A,B)),2,LOG(G(A,B))/LOG(10)+1);
1293 NEXTB:PRINT" ":NEXTA:GOTO 1267
1294 PRINT" STATUS REPORT"
1295 PRINT"NUMBER OF KLINGONS LEFT ="K9
1296 PRINT"NUMBER OF STARDATES LEFT ="T9-T
1297 PRINT"NUMBER OF STARBASES LEFT ="B9
1298 A=7:GOTO1074
1299 IFK3=0THEN1226
1300 IFD(2)<0THENA=2:GOTO1073
1301 PRINT"COORD","LOWDIR","HIGHDIR","DIST"
1302 FORA=1TO47:PRINT"-";:NEXTA
1303 PRINT
1304 FORI=0TO3
1305 IFNOT(K(I,3)>0)THEN1318
1306 W1=SQR((S1-K(I,1))^2+(S2-K(I,2))^2)
1307 IF W1=0 THENPRINT"--->MALFUNCTION !":GOTO1070
1308 ON ERROR GOTO 1282
1309 C1=1.5708-ATN((K(I,2)-S2)/W1/SQR(1-((K(I,2)-S2)/W1)^2))
1310 ON ERROR GOTO 1282
1311 C1=C1*SGN(S1-K(I,1))/CX
1312 C2(I)=C1-(10*RND(1))
1313 C3(I)=C1+(10*RND(1))
1314 IF C3(I)<0 THEN C3(I)=C3(I)+360
1315 IF C2(I)<0 THEN C2(I)=C2(I)+360
1316 PRINT"(";MID$(STR$(K(I,1)),2,1);",";MID$(STR$(K(I,2)),2,1);
1317 PRINT")",C2(I),C3(I),W1
1318 NEXTI
1319 IF DT=1 THEN 1267 ELSE 1070
1320 RETURN
1321 MR=(T9-T)/K9:DT=0
1322 XM=((MR-PR)/PR)*100
1323 IFKA=1THENPRINTTK-T"STARDATES LEFT TO SAVE STARBASE.":GOTO1332
1324 IFRND(1)>.01*R9ORB9=0THENRETURN
1325 KA=1:FORA=1TO8:FORB=1TO8
1326 IFG(A,B)-100*INT(G(A,B)/100)>9THENK1=A:K2=B:IFRND(1)>.5THENA=8:B=8
1327 NEXTB,A:TK=T+.09*SQR((Q1-K1)^2+(Q2-K2)^2)*(10-R9)
1328 TK=TK+1
1329 PRINTAR$;"!!! STARBASE IN QUADRANT ("MID$(STR$(K1),2,1)",";
1330 PRINTMID$(STR$(K2),2,1)") IS UNDER ATTACK!!"
1331 PRINT"YOU HAVE"TK-T"STARDATES TO SAVE IT!":RETURN
1332 IFT<TKTHEN1337
1333 PRINT"TOO LATE!":KA=0:G(K1,K2)=G(K1,K2)-10:B9=B9-1
1334 IFNOT(Q1=K1ANDQ2=K2)THENRETURN
1335 FORA=1TO8:FORB=1TO8:IFS(A,B)=4THENS(A,B)=0
1336 NEXTB,A:RETURN
1337 IFQ1=K1ANDQ2=K2THENPRINT"YOU ARRIVED IN TIME! STARBASE SAVED!"
1338 KA=0:GOTO1070
1339 IF SD<>1 THEN 1421 ELSE 1530
1340 GOTO1070
1341 GOSUB 1365
1342 GOTO 1267
1343 PRINT"YOU HAVE SCREWED UP ONCE TOO OFTEN !"
1344 PRINT"OFF TO THE VULCAN TORTURE CAMPS !!"
1345 IFT<= 0THEN1262ELSE1355
1346 PRINT"YOU WILL BE EXECUTED AT SUNRISE"
1347 GOTO1355
1348 PRINT"YOU WILL BE PUT TO DEATH FOR YOUR INCOMPETENCE"
1349 GOTO1355
1350 PRINT"YOU WILL BE CONFINED TO YOUR QUARTERS UNTIL"
1351 PRINT"VULCAN'S MOONS BECOME TOURIST TRAPS !!"
1352 IFT<=0THEN1262ELSE1355
1353 PRINT"IMBECILE !! WE HOPE YOU CONSIDER SUICIDE!"
1354 IFT<=0THEN1262ELSE1355
1355 L=(U-K9)*10+((U-K9)*500/T)-100*(Y-B9)
1356 IFE<=0ORS<0THENL=L-200
1357 IFK9=0THENL=L+(R9*100)
1358 PRINT:PRINT
1359 PRINT"YOUR MISSION RATING IS: ";L
1360 PRINT:PRINT:PRINT:PRINT:PRINT
1361 GOSUB 1543
1362 PRINTCHR$(26)
1363 GOTO1544
1364 GOTO1262
1365 PRINT
1366 PRINT" O9O"
1367 PRINT" 135 . O45"
1368 PRINT" . . ."
1369 PRINT" . . ."
1370 PRINT"18O . . . . . . .OOO WARP-COMPASS"
1371 PRINT" . . ."
1372 PRINT" . . ."
1373 PRINT" 225 . 315"
1374 PRINT" 27O"
1375 PRINT
1376 RETURN
1377 XX=INT(RND(2)*10)+1
1378 RETURN
1379 PRINT:IFX4>12THEN1388
1380 PRINT"COMMAND CENTRAL ADVISES THAT YOUR RANKING-";X4;"-IS IN THE EXPERT"
1381 PRINT"CATEGORY. BE ADVISED THAT IF YOU ARE NOT PROPERLY QUALIFIED"
1382 PRINT"YOUR CHANCES OF AVOIDING FAILURE ARE NIL."
1383 PRINT
1384 PRINT"DO YOU WISH REASSIGNMENT TO A LESS HAZARDOUS MISSION (Y OR N)"
1385 INPUTAN$
1386 IFLEFT$(AN$,1)="Y"THEN1012
1387 PRINTCHR$(26):GOTO1023
1388 PRINT"YOU HAVE REQUESTED A SUICIDE MISSION":GOTO1383
1389 PRINT"--COMMUNICATIONS ACTIVE--"
1390 PRINT
1391 GOSUB1377
1392 PD=XX
1393 GOSUB1377
1394 PE=XX
1395 GOSUB1377
1396 PF=XX
1397 GOSUB1377
1398 PG=XX
1399 PH=PD*10+PE
1400 PJ=PF*10+PG
1401 IFPH=PJTHEN 1282
1402 KP=1:IFPD=PEORPF=PGTHEN1403ELSE1405
1403 PRINT"SUNSPOTS BLOCK TRANSMISSION AT : ":GOTO1060
1404 PRINT"MOVE ELSEWHERE AND TRY AGAIN":PRINT:GOTO 1081
1405 PRINT"AUTHORIZED FREQUENCIES":PRINT
1406 PRINT"FEDERATION COMMAND BASE = ";PH
1407 PRINT"KLINGON COMMAND CENTRAL = ";PJ
1408 PRINT
1409 INPUT"COMMUNICATION ON CHANNEL ";XF
1410 IFXF=PHTHEN1432
1411 IFXF=PJTHEN1461
1412 PRINT
1413 PRINTAR$;"ALERT !!"
1414 PRINT"ATTEMPTED COMMUNICATION ON UNAUTHORIZED FREQUENCY"
1415 PRINT
1416 PRINT"WHILE SECURITY CHECK IS CONDUCTED ON ENTERPRISE"
1417 GOSUB1377:A=XX
1418 GOSUB1377:I=(XX/2)+(X4/7)
1419 PRINT"YOUR ";D$(A);" WILL BE INOPERATIVE FOR ";I "UNITS OF STARTIME"
1420 D(A)=D(A)-I:GOTO1070
1421 PRINT
1422 PRINT"SECURITY CONTROL ADVISES THAT NO AUTHORIZATION HAS BEEN"
1423 PRINT"GIVEN TO ACTIVATE SELF- DESTRUCT SYSTEM."
1424 PRINT"PROCEED WITH ASSIGNED MISSION":PRINT:GOTO 1268
1425 PRINT
1426 PRINT"BE ADVISED, YOUR MISSION PROGRESS FACTOR IS";PR
1427 GOSUB 1377
1428 TF=(XX*X4)/1.6:IF TF<10 THEN TF=TF+10
1429 PRINT" THE TOLERANCE FACTOR FOR THIS MISSION IS [+/-]";TF;"PERCENT"
1430 PRINT
1431 RETURN
1432 ONSGN(XM)+2GOTO1433,1437,1439
1433 IFABS(XM)>(TF*1.5)THEN1445
1434 IFABS(XM)>TFTHEN1442
1435 PRINT:PRINT"CAPTAIN, YOU ARE BEHIND SCHEDULE - LET'S GO !!"
1436 GOTO 1070
1437 PRINT:PRINT"YOU ARE EXACTLY ON COMPUTED SCHEDULE; PROCEED WITH MISSION"
1438 GOTO1070
1439 IFXM>TFTHEN1454:IFXM>(TF*1.5)THEN1457
1440 PRINT:PRINT"YOU ARE AHEAD OF COMPUTED SCHEDULE, KEEP UP THE GOOD WORK !!"
1441 GOTO1070
1442 PRINT:PRINT"YOU ARE BEHIND SCHEDULE AND OUT OF TOLERANCE FACTOR !!"
1443 PRINT"COMMAND CONTROL PROJECTS FAILURE...YOU MAY SURRENDER TO ENEMY"
1444 EQ=1:SD=1:GOTO 1389
1445 YY=AC^X4
1446 PRINTCHR$(26)
1447 PRINTAR$;"---------COMPUTER PROJECTION----------":PRINT
1448 PRINT"PROJECTED LIKELIHOOD OF SUCCESS FOR YOUR MISSION =";YY;"PERCENT"
1449 PRINT"WE HAVE AUTO ACTIVATED SELF-DESTRUCT SYSTEM ON YOUR VESSEL"
1450 PRINT"GOODBYE, CAPTAIN.............":PRINT
1451 PRINT"END OF MESSAGE FROM FEDERATION COMMAND":PRINT:PRINT
1452 GOSUB 1543
1453 GOTO 1530
1454 PRINT:PRINT"YOU ARE AHEAD OF SCHEDULE AND BEYOND TOLERANCE FACTOR"
1455 PRINT"CALL KLINGON LEADERS AND REQUEST THEIR SURRENDER":KQ=1
1456 PRINT:GOTO1389
1457 PRINTAR$;"MESSAGE FROM COMMAND BASE"
1458 PRINT:PRINT"ENEMY HAS SURRENDERED TO FEDERATION COMMAND !!"
1459 PRINT:PRINT:PRINT:PRINT
1460 GOTO1264
1461 IF KQ=1 THEN 1486:IF EQ=1 THEN 1464
1462 ON SGN(XM)+2 GOTO 1463,1469,1474
1463 IF ABS(XM)<=TFTHEN1469
1464 PRINT:PRINT"KLINGON COMMAND ON FREQUENCY"
1465 PRINT"NATURALLY, WE ARE PLEASED THAT YOU ARE CONCEDING, CAPTAIN"
1466 PRINT"WE ARE PRESENTLY BOARDING YOUR CRAFT"
1467 PRINT:PRINT"HERE IS A MESSAGE FROM YOUR LEADERS-":PRINT:GOSUB 1543
1468 PRINTCHR$(26):GOTO 1260
1469 GOSUB 1377
1470 IFXX<=5THEN 1473
1471 PRINT:PRINT"MESSAGE FROM KLINGON COMMAND...."
1472 PRINT"NO FURTHER COMMUNICATIONS AT THIS TIME":GOTO 1482
1473 PRINT:PRINT"WE'LL TALK WITH OUR WEAPONS, EARTH-SWINE !!":GOTO 1482
1474 GOSUB 1377
1475 AQ=INT((XX+1)/2)
1476 ON AQ GOTO 1471,1473,1477,1477,1474
1477 GF=TF*1.5
1478 IFXM>GFTHEN 1486
1479 IFXM>TFTHEN 1483
1480 PRINT:PRINT"CAPTAIN, DESPITE YOUR SLIGHT ADVANTAGE, YOU ARE NO MATCH FOR"
1481 PRINT"THE GLORIOUS KLINGON FLEET"
1482 PRINTTAB(25)"END OF MESSAGE FROM KLINGON COMMAND":GOTO1070
1483 GOSUB1377
1484 IFXX<=5THENPRINT" KLINGON COMMAND TO ENTERPRISE..":GOTO1473
1485 GOTO1487
1486 PRINTCHR$(26)
1487 PRINT:PRINT"MESSAGE FROM KLINGON LEADERS..."
1488 PRINT:PRINT"WE CONCEDE THE WAR, SIR, CONGRATULATIONS !!":GOTO1360
1489 AV=INT(X4/2)+1:DR=-1
1490 IF TEC<AV THEN 1492
1491 IF C$<>"D" THEN 1496 ELSE 1498
1492 AU=AV-TEC:IFAU=1THENKF$=""ELSEKF$="S"
1493 PRINT:PRINT"DAMAGE REPAIR INACTIVE !!"
1494 PRINT"REQUIRES";AU;"MORE RECHARGE UNIT";KF$
1495 PRINT:GOTO 1070
1496 PRINT:PRINTAR$"YOU MUST BE DOCKED AT STARBASE FOR DAMAGE REPAIR !!"
1497 PRINT:GOTO 1070
1498 PRINT
1499 PRINT:FORA=1TO10
1500 IFD(A)<0THENPRINT TAB(10)A;TAB(20)D$(A);TAB(40)"DAMAGED"
1501 NEXT
1502 PRINT:PRINT"IF NO DAMAGE INDICATED ABOVE, ANSWER WITH 0 (ZERO)"
1503 INPUT "WHICH ONE TO REPAIR ";A
1504 IFA<1ORA>10THENPRINTAR$;:GOTO 1070
1505 IF D(A)<0 THEN 1507
1506 PRINT:PRINTD$(A);" NOT DAMAGED !!":GOTO 1503
1507 PRINT:PRINTTAB(20)D$(A);"---REPAIRED":PRINT
1508 D(A)=0:TEC=0:GOTO1070
1509 PRINT:PRINTAR$;"NOTHING DAMAGED AT PRESENT":GOTO1070
1510 PRINT
1511 GOSUB1429
1512 PRINT"INITIAL MISSION PROGRESS FACTOR WAS";PR
1513 PRINT"CURRENT MISSION PROGRESS FACTOR IS ";MR
1514 IF XM<0 THEN PW$=" WORSENED "ELSE PW$=" IMPROVED "
1515 PRINT
1516 PRINT"YOUR COMBAT SITUATION HAS";PW$;"BY A FACTOR OF";XM;"PERCENT"
1517 IF ABS(XM)>=TF THEN EG$=" NOT "ELSE EG$=" "
1518 IF EG$=" "THEN EH$=""ELSE EH$=AR$
1519 PRINT EH$;"YOUR PROGRESS IS";EG$;"WITHIN TOLERANCE FOR THIS MISSION"
1520 PRINT
1521 IF EG$=" NOT "THEN 1522 ELSE 1267
1522 IF XM<0 THEN 1523 ELSE 1527
1523 PRINT:SD=1:KD=0
1524 PRINT"CAPTAIN, COMMAND CENTRAL PROJECTS DEFEAT BY ENEMY. YOU ARE NOW"
1525 PRINT"AUTHORIZED TO SURRENDER OR TO ACTIVATE SELF-DESTRUCT SYSTEM"
1526 GOTO1267
1527 PRINT:SD=0:KD=1
1528 PRINT"CAPTAIN, FEDERATION COMMAND PROJECTS SUCCESS FOR YOUR MISSION."
1529 GOTO 1454
1530 PRINTCHR$(26)
1531 GOSUB 1542
1532 PRINT"SELF DESTRUCT SYSTEM ACTIVATED"
1533 PRINT:PRINT:PRINT:GOSUB 1542
1534 PRINT"COUNTDOWN BEGUN !":PRINT:PRINT
1535 PRINTTAB(25)"FIVE":PRINT:GOSUB 1542
1536 PRINTTAB(20)"FOUR":PRINT:GOSUB 1542
1537 PRINTTAB(15)"THREE":PRINT:GOSUB 1542
1538 PRINTTAB(10)"TWO":PRINT:GOSUB 1542
1539 PRINTTAB(5)"ONE":PRINT:GOSUB 1542
1540 PRINT"ZERO":GOSUB 1542
1541 PRINTCHR$(26):GOTO1544
1542 FOR I=1 TO 50:A=A+1:NEXT:RETURN
1543 FOR I=1 TO 1200:A=A+1:NEXT:RETURN
1544 RESET


520
software/BAS/SWARMS.bas
View File

@@ -1,520 +0,0 @@
100 'SWARMS2 - YET ANOTHER GEM FROM 'ZOSO'
110 CLEAR : CLEAR 1000
120 PRINT CHR$(26);"!!!!! ATTENTION: THE BEES ARE ATTACKING !!!!!!"
130 PRINT : PRINT
140 PRINT "BEGIN DEFENSE PLAN: " : PRINT
150 PRINT "TIME: 1"
160 INPUT "ENTER YOUR NAME FOR IDENTIFICATION CHECK"; N$
170 PRINT CHR$(26)
180 INPUT "ENTER CODE WORD FOR NUCLEAR CLEARANCE"; C$
190 GOSUB 5220
200 REM CREATE TWO INITIAL SWARMS
210 DIM E(21),S(21),A$(21),U(21),G(21),M(21),D(21),C(21)
220 DIM K(21),V(21),R(21)
230 A1=INT(RND(1)*21+1)
240 A2=INT(RND(1)*21+1)
250 IF A1=A2 THEN 230
260 S(A1) = INT(RND(1)*5+2)
270 S(A2) = INT(RND(1)*5+2)
280 E(A1) = INT(RND(1)*9+6)
290 E(A2) = INT(RND(1)*9+6)
300 REM SUBTRACT ONE HOUR FROM ALL ETA'S
310 FOR A=1 TO 21
320 IF E(A)=0 THEN 340
330 GOTO 350
340 IF U(A) = 0 THEN 560
350 IF S(A) = 1 THEN 560
360 IF ABS(U(A)) = 1 THEN 470
370 IF ABS(E(A)) = 1 THEN 410
380 E(A)=E(A) - 1
390 C(A)=C(A)+(17-E(A))
400 GOTO 560
410 IF E(A) = -1 THEN 450
420 PRINT "THE BEES HAVE ARRIVED IN THE MAJOR CITY IN SECTION ";A
430 E(A)=-1
440 U(A)=6
450 U(A)=U(A)-1
460 GOTO 560
470 IF U(A) = -1 THEN 560
480 PRINT "THE BEES HAVE DESTROYED THE MAJOR CITY IN SECTION ";A
490 U(A)=-1
500 IF V(A)<>-1 THEN 530
510 PRINT "BUT THE POPULATION HAS BEEN EVACUATED"
520 GOTO 550
530 K(A)=1
540 C(A)=(1E+06*(RND(1)*A+1))+C(A)
550 GOTO 560
560 NEXT A
570 REM ADD ONE UNIT TO TIME
580 T=T+1
590 REM CREATE NEW SWARM
600 IF T/30<>INT(T/30) THEN 690
610 A=INT(RND(1)*21+1)
620 IF S(A)<>0 THEN 600
630 IF R(A)<>0 THEN 600
640 IF K(A)<>0 THEN 600
650 S(A)=INT(RND(1)*5+2)
660 E(A)=INT(RND(1)*9+16)
670 C(A)=INT(RND(1)*10)
680 PRINT "A NEW SWARM IS REPORTED IN SECTION ";A
690 REM CHECK COMBATED SWARMS
700 FOR A=1 TO 21
710 IF T<>G(A) THEN 870
720 IF S(A)<> 1 THEN 810
730 S(A)=0
740 G(A)=0
750 E(A)=0
760 M(A)=0
770 K(A)=0
780 U(A)=0
790 PRINT "** THE SWARM IN SECTION ";A;" IS TOTALLY DESTROYED."
800 GOTO 870
810 S(A)=S(A)-M(A)
820 PRINT "** THE PHASE ON SECTION ";A;" WAS SUCCESSFUL."
830 IF S(A)>=1 THEN 850
840 S(A)=1
850 G(A)=0
860 M(A)=0
870 NEXT A
880 REM ADD ONE UNIT TO EACH UNCOMBATTED SWARM
890 FOR A=1 TO 21
900 IF E(A)=1 THEN 1150
910 IF S(A)=1 THEN 1120
920 IF S(A)=0 THEN 1150
930 IF S(A)+1<9 THEN 1090
940 IF A=1 THEN 1020
950 IF S(A-1)>0 THEN 1010
960 IF R(A-1)<>0 THEN 1150
970 PRINT "** THE SWARM IN SECTION ";A;" HAS SPREAD TO SECTION ";A-1
980 S(A-1)=3
990 E(A-1)=INT(RND(1)*10+5)
1000 GOTO 1150
1010 IF A=21 THEN 1150
1020 IF S(A+1)>0 THEN 1150
1030 IF R(A+1)<>0 THEN 1150
1040 PRINT "** THE SWARM IN SECTION ";A;" HAS SPREAD TO SECTION ";A+1
1050 IF R(A+1)<>0 THEN 1150
1060 S(A+1)=3
1070 E(A+1)=INT(RND(1)*10+5)
1080 GOTO 1150
1090 S(A)=S(A)+1
1100 C(A)=C(A)+S(A)
1110 GOTO 1150
1120 IF D(A)=1 THEN 1150
1130 PRINT "** THE SWARM IN SECTION ";A;" IS READY TO BE DESTROYED."
1140 D(A)=1
1150 NEXT A
1160 REM WINNER CHECK
1170 W=0
1180 FOR A=1 TO 21
1190 W=S(A)+W
1200 NEXT A
1210 IF W>=1 THEN 1280
1220 PRINT "*******ALL SWARMS ARE NOW DESTROYED*******"
1230 PRINT "FINAL STATISTICS ON ATTACKS AND DESTRUCTION ARE NOW "
1240 PRINT "BEING COMPUTED, ... FINAL RESULTS FOLLOW ....."
1250 A=0
1260 PRINT
1270 GOTO 4690
1280 REM EVACUATION CHECK
1290 FOR A=1 TO 21
1300 IF V(A)<>T THEN 1400
1310 IF U(A)=-1 THEN 1370
1320 IF K(A)>0 THEN 1370
1330 PRINT "** POPULATION IN SECTION ";A;" IS EVACUATED"
1340 C(A)=C(A)+INT(RND(1)*17)
1350 V(A)=-1
1360 GOTO 1400
1370 PRINT "** POPULATION IN SECTION ";A;" WAS DESTROYED BEFORE "
1380 PRINT " IT COULD BE EVACUATED"
1390 V(A)=0
1400 NEXT A
1410 REM RETURN EVACUATION CHECK
1420 FOR A=1 TO 21
1430 IF R(A)<>T THEN 1490
1440 IF R(A)<1 THEN 1490
1450 K(A)=0
1460 R(A)=0
1470 V(A)=0
1480 PRINT "** THE POPULATION HAS RETURNED TO THE CITY IN SECTION ";A
1490 NEXT A
1500 REM LOSER CHECK
1510 Q=0
1520 FOR A=1 TO 21
1530 Q=C(A)+Q
1540 NEXT A
1550 IF Q<7.5E+07 THEN 1650
1560 PRINT "THE BEES HAVE DEVASTATED THE UNITED STATES AND "
1570 PRINT "THERE ARE NOW OVER 75 MILLION CASUALTIES, THE BEES"
1580 PRINT "ARE NOW CONSIDERED TO BE THE VICTORS OVER MODERN"
1590 PRINT "TECHNOLOGY."
1600 A=0
1610 Q=0
1620 W=0
1630 PRINT
1640 GOTO 4690
1650 REM COMMAND INPUT
1660 PRINT "TIME: ";T+1
1670 INPUT "COMMAND"; COM
1680 IF COM>8 OR COM<1 OR COM<>INT(COM) THEN PRINT "WRONG !!!"; : GOTO 1670
1690 ON COM GOTO 1700,2210,2620,3840,4060,4660,4920,5190
1700 REM MAP PRINT OUT
1710 PRINT CHR$(26);"1) ATTACK SCAN MAP"
1720 PRINT
1730 FOR A=1 TO 21
1740 IF S(A)>6 THEN 1860
1750 IF S(A)>4 THEN 1840
1760 IF S(A)>1 THEN 1820
1770 IF S(A)>0 THEN 1800
1780 A$(A)= "?"
1790 GOTO 1870
1800 A$(A)="."
1810 GOTO 1870
1820 A$(A)="+"
1830 GOTO 1870
1840 A$(A)="*"
1850 GOTO 1870
1860 A$(A)="#"
1870 NEXT A
1880 PRINT "----------------------------------------------------"
1890 PRINT TAB(48);"---"
1900 PRINT TAB(20);"CANADA- NO INFORMATION / /"
1910 Z1$="----------------------- / "+A$(18)+"/"
1920 PRINT TAB(15);Z1$
1930 PRINT TAB(15);"! ! ! ! ! !\- -/ /"
1940 Z1$="! "+A$(1)+" ! "+A$(3)+" ! "+A$(6)+" ! "
1950 Z1$=Z1$+A$(9)+" ! "+A$(13)+" ! \--/---/"
1960 PRINT TAB(15);Z1$
1970 Z1$= "! !---!---!----!----! "+A$(16)+" ! /"
1980 PRINT TAB(15);Z1$
1990 Z1$= "!---! ! ! ! ! ! "+A$(19)+" !"
2000 PRINT TAB(15);Z1$
2010 Z1$="! ! "+A$(4)+" ! "+A$(7)+" ! "+A$(10)+" ! "
2020 Z1$=Z1$+A$(14)+" !---!---!"
2030 PRINT TAB(15);Z1$
2040 Z1$="! "+A$(2)+" !---!---!----!----! ! !"
2050 PRINT TAB(15);Z1$
2060 Z1$=" \ ! ! ! ! ! "+A$(17)+" ! "+A$(20)+" !"
2070 PRINT TAB(15);Z1$
2080 Z1$=" \ ! "+A$(5)+" ! "+A$(8)+" ! "+A$(11)+" ! "
2090 Z1$=Z1$+A$(15)+" ! ! /"
2100 PRINT TAB(15);Z1$
2110 Z1$=" \!---!---!----!----!---! "+A$(21)+"!"
2120 PRINT TAB(15);Z1$
2130 PRINT TAB(27);"\ !";TAB(42);"\ !"
2140 Z1$=" \ "+A$(12)+"!"
2150 PRINT TAB(15);Z1$;TAB(42);"! !"
2160 PRINT TAB(30);"\-!";TAB(42);"!-!"
2170 PRINT TAB(20);"MEXICO- NO INFORMATION"
2180 PRINT
2190 PRINT "----------------------------------------------------"
2200 GOTO 300
2210 REM ETA REPORT
2220 PRINT CHR$(12);"2) ETA REPORT"
2230 PRINT
2240 INPUT "ENTER SECTION #"; A
2250 IF A<1 OR A>21 OR A<>INT(A) THEN PRINT "WRONG !!!"; : GOTO 2240
2260 PRINT "*************************************"
2270 IF A<>0 THEN 2300
2280 D7=-1
2290 FOR A = 1 TO 21
2300 IF S(A)=1 THEN 2520
2310 IF R(A)=-1 THEN 2550
2320 IF E(A)=0 THEN 2500
2330 IF U(A)=-1 THEN 2380
2340 IF E(A)=-1 THEN 2410
2350 PRINT "THE BEES WILL ARRIVE AT THE MAJOR CITY IN"
2360 PRINT " SECTION ";A;" AT ";E(A)+T;" HOURS."
2370 GOTO 2570
2380 PRINT "THE BEES HAVE ALREADY DESTROYED THE CITY IN"
2390 PRINT "SECTION ";A;" AND ARE NOW INHABITING IT."
2400 GOTO 2570
2410 PRINT "THE BEES HAVE ARRIVED AT THE CITY IN"
2420 IF V(A)<>-1 THEN 2460
2430 PRINT "SECTION ";A;" BUT THE POPULATION HAS BEEN"
2440 PRINT " EVACUATED"
2450 GOTO 2570
2460 PRINT "SECTION ";A;" AND THE POPULATION OF THAT CITY"
2470 PRINT "CAN ONLY SURVIVE FOR ABOUT ";U(A);" MORE HOURS."
2480 PRINT " USE OF URBAN DEFENSES IS RECOMMENDED."
2490 GOTO 2570
2500 PRINT " NO SWARMS REPORTED IN SECTION ";A
2510 GOTO 2570
2520 PRINT "THE BEES IN SECTION ";A;" ARE READY TO BE "
2530 PRINT "DESTROYED."
2540 GOTO 2570
2550 PRINT "SECTION ";A;" IS A RADIOACTIVE WASTELAND THAT"
2560 PRINT " IS COMPLETELY UNPOPULATED"
2570 PRINT "*************************************"
2580 IF D7<>-1 THEN 2600
2590 NEXT A
2600 D7=0
2610 GOTO 300
2620 REM BATTLE PHASE OPTIONS
2630 PRINT CHR$(26)
2640 PRINT "3) BATTLE PHASE OPTIONS"
2650 INPUT "ENTER SECTION #"; A
2660 INPUT "ENTER PHASE"; P
2670 IF V(A)<1 THEN 2700
2680 PRINT "SECTION ";A;" IS BEING EVACUATED"
2690 GOTO 300
2700 IF G(A)>0 THEN 2720
2710 GOTO 2740
2720 PRINT "THE SWARM IN SECTION ";A;" IS ALREADY BEING COMBATTED"
2730 GOTO 300
2740 IF S(A)=0 THEN 2760
2750 GOTO 2780
2760 PRINT "NO SWARM IS REPORTED IN SECTION ";A
2770 GOTO 300
2780 IF S(A)<>1 THEN 2820
2790 IF P=5 THEN 2860
2800 PRINT "THE DESTRUCTION PHASE SHOULD BE USED IN SECTION ";A
2810 GOTO 300
2820 IF E(A)<>-1 THEN 2860
2830 IF P=6 THEN 2860
2840 PRINT "URBAN DEFENSES SHOULD BE USED IN SECTION ";A
2850 GOTO 300
2860 N=RND(1)
2870 ON P GOTO 2880,2970,3060,3120,3210,3290
2880 REM PHASE 1
2890 PRINT "BEE COCKTAIL: PHASE ONE, NOW BEING ATTEMPTED."
2900 IF N>.95 THEN 300
2910 G(A)=T+INT(RND(1)*3+1)
2920 IF S(A)>5 THEN 2950
2930 M(A)=S(A)-2
2940 GOTO 300
2950 M(A)=S(A)-5
2960 GOTO 300
2970 REM PHASE TWO
2980 PRINT "PROJECT QUEEN: PHASE TWO, NOW BEING ATTEMPTED."
2990 IF N>.92 THEN 300
3000 G(A) = T+INT(RND(1)*3+4)
3010 IF S(A)>3 THEN 3040
3020 M(A)=1
3030 GOTO 300
3040 M(A)=S(A)-1
3050 GOTO 300
3060 REM PHASE THREE
3070 PRINT "PROJECT BRUSH FIRE: PHASE THREE, NOW BEING ATTEMPTED."
3080 IF N>.96 THEN 300
3090 G(A)=T+1
3100 M(A)=2
3110 GOTO 300
3120 REM PHASE 4
3130 PRINT "PROJECT STERILE MALE: PHASE FOUR, NOW BEING ATTEMPTED."
3140 IF N>.89 THEN 300
3150 G(A)=T+INT(RND(1)*3+3)
3160 IF S(A)>6 THEN 3190
3170 M(A)=S(A)-1
3180 GOTO 300
3190 M(A)=4
3200 GOTO 300
3210 REM PHASE 5
3220 IF S(A)=1 THEN 3250
3230 PRINT "SWARM TOO LARGE: DESTRUCTION NOT POSSIBLE"
3240 GOTO 300
3250 PRINT "DESTRUCTION: PHASE FIVE, NOW BEING ATTEMPTED."
3260 IF N>.7 THEN 300
3270 G(A)=T+INT(RND(1)*3+2)
3280 GOTO 300
3290 REM PHASE 6
3300 IF E(A)<>-1 THEN 2800
3310 INPUT "ENTER URBAN DEFENSE CODE"; D$
3320 C(A)=C(A)+INT(200*RND(1))
3330 IF RND(1) >.8 THEN 300
3340 IF D$="A" THEN 3430
3350 IF D$="B" THEN 3490
3360 IF D$="C" THEN 3550
3370 IF D$="D" THEN 3610
3380 IF D$="E" THEN 3670
3390 IF D$="F" THEN 3710
3400 IF D$="G" THEN 3750
3410 PRINT "INVALID URBAN DEFENSE CODE !!!" : PRINT : GOTO 3310
3420 GOTO 300
3430 REM *A*
3440 IF S(A)>5 THEN 3470
3450 S(A)=S(A)-1
3460 GOTO 3780
3470 S(A)=2
3480 GOTO 3780
3490 REM *B*
3500 IF S(A)>4 THEN 3530
3510 S(A)=S(A)-3
3520 GOTO 3780
3530 S(A)=S(A)-2
3540 GOTO 3780
3550 REM *C*
3560 IF S(A)>7 THEN 3590
3570 S(A)=S(A)-3
3580 GOTO 3780
3590 S(A)=1
3600 GOTO 3780
3610 REM *D*
3620 IF S(A)>3 THEN 3650
3630 S(A)=1
3640 GOTO 3780
3650 S(A)=S(A)-3
3660 GOTO 3780
3670 REM *E*
3680 IF RND(1)>.5 THEN 3780
3690 S(A)=2
3700 GOTO 3780
3710 REM *F*
3720 IF RND(1)>.4 THEN 3780
3730 S(A)=1
3740 GOTO 3780
3750 REM *G*
3760 IF RND(1)>.8 THEN 3780
3770 S(A)=S(A)-4
3780 PRINT "THE URBAN DEFENSE IN SECTION ";A;" WAS SUCCESSFUL"
3790 IF S(A)>1 THEN 300
3800 S(A)=1
3810 D(A)=1
3820 PRINT "** SWARM IN SECTION ";A;" IS READY TO BE DESTROYED"
3830 GOTO 300
3840 REM EVACUATION PROCEDURE
3850 PRINT CHR$(26);
3860 PRINT "4) EVACUATION PROCEDURE"
3870 INPUT "ENTER SECTION #"; A
3880 IF A<1 OR A>21 OR A<>INT(A) THEN PRINT "WRONG !!! "; : GOTO 3870
3890 IF S(A)=0 THEN 3950
3900 IF V(A)>0 THEN 3970
3910 IF V(A)=-1 THEN 3990
3920 IF K(A)>0 THEN 4010
3930 IF U(A)=-1 THEN 4010
3940 GOTO 4030
3950 PRINT "COMPUTER FAILSAFE...NO SWARMS REPORTED IN SECTION ";A
3960 GOTO 300
3970 PRINT "SECTION ";A;" IS BEING EVACUATED ALREADY"
3980 GOTO 300
3990 PRINT "CITY IN SECTION ";A;" IS ALREADY EVACUATED"
4000 GOTO 300
4010 PRINT "POPULATION IN SECTION ";A;" HAS BEEN DESTROYED"
4020 GOTO 300
4030 PRINT "EVACUATION PROCEDURE NOW IN PROGRESS"
4040 V(A)=5+T
4050 GOTO 300
4060 REM ***** NUCLEAR DESTRUCTION SEQUENCE *****
4070 PRINT CHR$(26)
4080 PRINT "5) NUCLEAR DESTRUCTION SEQUENCE"
4090 INPUT "PLEASE ENTER YOUR NAME"; N1$
4100 IF N$<>N1$ THEN 4270
4110 INPUT "PLEASE ENTER YOUR CODE WORD"; C1$
4120 IF C$<>C1$ THEN 4270
4130 PRINT "POSITIVE IDENTIFICATION CHECK";CHR$(7)
4140 PRINT "CODE WORD CHECK IS VALID"
4150 PRINT "ID SEQUENCE COMPLETED"
4160 INPUT "PLEASE ENTER SECTION #"; A
4170 IF A<1 OR A>21 OR A<>INT(A) THEN PRINT "WRONG !!! "; : GOTO 4160
4180 IF E(A)<>-1 THEN 4220
4190 IF S(A)=0 THEN 4250
4200 PRINT
4210 GOTO 4310
4220 PRINT "COMPUTER FAILSAFE: BEES NOT ARRIVED IN THE MAJOR"
4230 PRINT "CITY IN SECTION ";A
4240 GOTO 300
4250 PRINT "COMPUTER FAILSAFE: NO SWARM REPORTED IN SECTION ";A
4260 GOTO 300
4270 PRINT "ID SEQUENCE DEFAULT....IGNORED"
4280 GOTO 300
4290 PRINT "NUCLEAR DESTRUCTION ABORTED."
4300 GOTO 300
4310 PRINT "BOMB IN SECTION ";A;" IS NOW ACTIVE"
4320 IF K(A)=1 THEN 4370
4330 IF V(A)=-1 THEN 4370
4340 PRINT "SECTION ";A;" HAS NOT BEEN EVACUATED"
4350 INPUT "DO YOU WISH TO CONTINUE"; K$
4360 IF LEFT$(K$,1)="Y" THEN 4370 ELSE 4290
4370 INPUT "TYPE 'X' FOR BOMB DETONATION"; F$
4380 IF F$<>"X" THEN 4290
4390 PRINT CHR$(26)
4400 PRINT "!!!!!!!!!!!!!!!! BOMB DETONATED !!!!!!!!!!!!!!!!"
4410 PRINT "SWARM HAS BEEN DESTROYED!!!!!!!!!"
4420 PRINT "CITY HAS BEEN DESTROYED!!!!!!!!!!"
4430 C(A)=2413
4440 S(A)=0
4450 E(A)=0
4460 U(A)=0
4470 D(A)=0
4480 G(A)=0
4490 M(A)=0
4500 IF K(A)=1 THEN 4590
4510 IF V(A)<>-1 THEN 4580
4520 PRINT "THE POPULATION WILL MOVE BACK TO THE CITY"
4530 PRINT "IN SECTION ";A;" WHEN THE RADIATION LEVEL"
4540 PRINT "HAS DECREASED."
4550 K(A)=2
4560 R(A)=T+7
4570 GOTO 300
4580 C(A)=INT(2E+06*(RND(1)*A+1))+C(A)
4590 PRINT "** NO SURVIVORS ARE REPORTED IN SECTION ";A
4600 PRINT "** THE BEES WILL NOT ENTER A SECTION WITH"
4610 PRINT "** NO HUMAN INHABITANTS, SO SECTION ";A
4620 PRINT "** IS COMPLETELY LACKING LIFE OF ANY KIND."
4630 K(A)=2
4640 R(A)=-1
4650 GOTO 300
4660 REM CASUALTY REPORT
4670 PRINT CHR$(26);"6) CASUALTY REPORT"
4680 INPUT "ENTER SECTION #"; A
4690 PRINT "************************************"
4700 IF A<>0 THEN 4750
4710 D7=-1
4720 FOR A=1 TO 21
4730 IF C(A)=0 THEN 4770
4740 IF C(A)>=1E+06 THEN 4790
4750 PRINT "SECTION ";A;": ";C(A);" CASUALTIES REPORTED"
4760 GOTO 4800
4770 PRINT "SECTION ";A;": NO BEE RELATED CASUALTIES"
4780 GOTO 4800
4790 PRINT "SECTION ";A;": ";C(A)/1E+06;" MILLION CASUALTIES"
4800 PRINT "************************************"
4810 F=C(A)+F
4820 IF D7<>-1 THEN 4890
4830 NEXT A
4840 D7=0
4850 IF F<1E+06 THEN 4880
4860 PRINT "TOTAL CASUALTIES REPORTED: ";F/1E+06;" MILLION CASUALTIES"
4870 GOTO 4890
4880 PRINT "TOTAL CASUALTIES REPORTED: ";F
4890 IF W=0 THEN 5200
4900 F=0
4910 GOTO 300
4920 REM PRINT COMMANDS IN SHORT
4930 PRINT CHR$(26)
4940 PRINT "************************COMMANDS*********************"
4950 PRINT
4960 PRINT " 1) ATTACK SCAN MAP"
4970 PRINT " 2) ETA REPORT"
4980 PRINT " 3) BATTLE PHASE OPTIONS"
4990 PRINT " 1. BEE COCKTAIL"
5000 PRINT " 2. PROJECT QUEEN"
5010 PRINT " 3. PROJECT BRUSH FIRE"
5020 PRINT " 4. PROJECT STERILE MALE"
5030 PRINT " 5. DESTRUCTION"
5040 PRINT " 6. URBAN DEFENSES"
5050 PRINT " A) FLIGHT PATTERNS"
5060 PRINT " B) SONIC BOOM"
5070 PRINT " C) SUPER-SONIC BEAMS"
5080 PRINT " D) POLLUTION"
5090 PRINT " E) METHYL PARATHION"
5100 PRINT " F) FIRE WALL"
5110 PRINT " G) STROBE LIGHT"
5120 PRINT " 4) EVACUATION PROCEDURES"
5130 PRINT " 5) NUCLEAR DESTRUCTION"
5140 PRINT " 6) CASUALTY REPORT"
5150 PRINT " 7) COMMANDS (SHORT)"
5160 PRINT " 8) CANCEL GAME"
5170 GOTO 300
5180 REM GAME CANCELLED
5190 REM
5200 REM
5210 RESET : END
5220 X9=LEN(N$) : X8=LEN(C$)
5230 X7=RND(-X9) : X7=X9+X8
5240 FOR X9=1 TO X7+1 : X8=RND(1) : NEXT
5250 RETURN
RESET : END
5220 X9=LEN(N$) : X8=LEN(C$)
5230 X7=RND(-X9) : X7=X9+X8
5240

133
software/BAS/TREKINST.BAS
View File

@@ -1,133 +0,0 @@
10 REM INSTRUCTIONS FOR "SUPER STARTREK" MAR 5, 1978
20 FOR I=1 TO 12:PRINT:NEXT I
25 PRINT CHR$(26)
30 PRINT TAB(10);"*************************************"
40 PRINT TAB(10);"* *"
50 PRINT TAB(10);"* *"
60 PRINT TAB(10);"* * * SUPER STAR TREK * * *"
70 PRINT TAB(10);"* *"
80 PRINT TAB(10);"* *"
90 PRINT TAB(10);"*************************************"
100 FOR I=1 TO 8:PRINT:NEXT I
110 INPUT "DO YOU NEED INSTRUCTIONS (Y/N)";K$:IF K$="N" THEN 1210
120 PRINT CHR$(26)
130 PRINT "NOTE: YOU MUST BE RUNNING 40K CP/M TO RUN STARTREK."
140 PRINT " THIS MEANS THAT BASIC MUST HAVE ABOUT 18K OF FREE MEMORY."
150 PRINT
160 PRINT" INSTRUCTIONS FOR 'SUPER STAR TREK'"
170 PRINT
180 PRINT"1. WHEN YOU SEE \COMMAND ?\ PRINTED, ENTER ONE OF THE LEGAL"
190 PRINT" COMMANDS (NAV,SRS,LRS,PHA,TOR,SHE,DAM,COM, OR XXX)."
200 PRINT"2. IF YOU SHOULD TYPE IN AN ILLEGAL COMMAND, YOU'LL GET A SHORT"
210 PRINT" LIST OF THE LEGAL COMMANDS PRINTED OUT."
220 PRINT"3. SOME COMMANDS REQUIRE YOU TO ENTER DATA (FOR EXAMPLE, THE"
230 PRINT" 'NAV' COMMAND COMES BACK WITH 'COURSE (1-9) ?'.) IF YOU"
240 PRINT" TYPE IN ILLEGAL DATA (LIKE NEGATIVE NUMBERS), THAT COMMAND"
250 PRINT" WILL BE ABORTED"
260 PRINT
270 PRINT" THE GALAXY IS DIVIDED INTO AN 8 X 8 QUADRANT GRID,"
280 PRINT"AND EACH QUADRANT IS FURTHER DIVIDED INTO AN 8 X 8 SECTOR GRID."
290 PRINT
300 PRINT" YOU WILL BE ASSIGNED A STARTING POINT SOMEWHERE IN THE"
310 PRINT"GALAXY TO BEGIN A TOUR OF DUTY AS COMMANDER OF THE STARSHIP"
320 PRINT"\ENTERPRISE\; YOUR MISSION: TO SEEK AND DESTROY THE FLEET OF"
330 PRINT"KLINGON WARWHIPS WHICH ARE MENACING THE UNITED FEDERATION OF"
340 PRINT"PLANETS."
350 PRINT
352 LINE INPUT "ENTER [CR] TO CONTINUE";A$:IF A$="" THEN PRINT CHR$(26)
360 PRINT" YOU HAVE THE FOLLOWING COMMANDS AVAILABLE TO YOU AS CAPTAIN"
370 PRINT"OF THE STARSHIP ENTERPRISE:"
380 PRINT
390 PRINT"\NAV\ COMMAND = WARP ENGINE CONTROL --"
400 PRINT" COURSE IS IN A CIRCULAR NUMERICAL 4 3 2"
410 PRINT" VECTOR ARRANGEMENT AS SHOWN . . ."
420 PRINT" INTEGER AND REAL VALUES MAY BE ..."
430 PRINT" USED. (THUS COURSE 1.5 IS HALF- 5 ---*--- 1"
440 PRINT" WAY BETWEEN 1 AND 2 ..."
450 PRINT" . . ."
460 PRINT" VALUES MAY APPROACH 9.0, WHICH 6 7 8"
470 PRINT" ITSELF IS EQUIVALENT TO 1.0"
480 PRINT" COURSE"
490 PRINT" ONE WARP FACTOR IS THE SIZE OF "
500 PRINT" ONE QUADTANT. THEREFORE, TO GET"
510 PRINT" FROM QUADRANT 6,5 TO 5,5, YOU WOULD"
520 PRINT" USE COURSE 3, WARP FACTOR 1."
530 PRINT:PRINT
531 LINE INPUT "ENTER [CR] TO CONTINUE";A$:IF A$="" THEN PRINT CHR$(26)
540 PRINT"\SRS\ COMMAND = SHORT RANGE SENSOR SCAN"
550 PRINT" SHOWS YOU A SCAN OF YOUR PRESENT QUADRANT."
560 PRINT
570 PRINT" SYMBOLOGY ON YOUR SENSOR SCREEN IS AS FOLLOWS:"
580 PRINT" <*> = YOUR STARSHIP'S POSITION"
590 PRINT" +K+ = KLINGON BATTLE CRUISER"
600 PRINT" >!< = FEDERATION STARBASE (REFUEL/REPAIR/RE-ARM HERE!)"
610 PRINT" * = STAR"
620 PRINT
630 PRINT" A CONDENSED 'STATUS REPORT' WILL ALSO BE PRESENTED."
640 PRINT
650 PRINT"\LRS\ COMMAND = LONG RANGE SENSOR SCAN"
660 PRINT" SHOWS CONDITIONS IN SPACE FOR ONE QUADRANT ON EACH SIDE"
670 PRINT" OF THE ENTERPRISE (WHICH IS IN THE MIDDLE OF THE SCAN)"
680 PRINT" THE SCAN IS CODED IN THE FORM \###\, WHERE TH UNITS DIGIT"
690 PRINT" IS THE NUMBER OF STARS, THE TENS DIGIT IS THE NUMBER OF"
700 PRINT" STARBASES, AND THE HUNDRESDS DIGIT IS THE NUMBER OF"
710 PRINT" KLINGONS."
720 PRINT
730 PRINT" EXAMPLE - 207 = 2 KLINGONS, NO STARBASES, & 7 STARS."
740 PRINT:PRINT
741 LINE INPUT "ENTER [CR] TO CONTINUE";A$:IF A$="" THEN PRINT CHR$(26)
750 PRINT"\PHA\ COMMAND = PHASER CONTROL."
760 PRINT" ALLOWS YOU TO DESTROY THE KLINGON BATTLE CRUISERS BY "
770 PRINT" ZAPPING THEM WITH SUITABLY LARGE UNITS OF ENERGY TO"
780 PRINT" DEPLETE THEIR SHIELD POWER. (REMEMBER, KLINGONS HAVE"
790 PRINT" PHASERS TOO!)"
800 PRINT
810 PRINT"\TOR\ COMMAND = PHOTON TORPEDO CONTROL"
820 PRINT" TORPEDO COURSE IS THE SAME AS USED IN WARP ENGINE CONTROL"
830 PRINT" IF YOU HIT THE KLINGON VESSEL, HE IS DESTROYED AND"
840 PRINT" CANNOT FIRE BACK AT YOU. IF YOU MISS, YOU ARE SUBJECT TO"
850 PRINT" HIS PHASER FIRE. IN EITHER CASE, YOU ARE ALSO SUBJECT TO "
860 PRINT" THE PHASER FIRE OF ALL OTHER KLINGONS IN THE QUADRANT."
870 PRINT
880 PRINT" THE LIBRARY-COMPUTER (\COM\ COMMAND) HAS AN OPTION TO "
890 PRINT" COMPUTE TORPEDO TRAJECTORY FOR YOU (OPTION 2)"
900 PRINT
910 PRINT"\SHE\ COMMAND = SHIELD CONTROL"
920 PRINT" DEFINES THE NUMBER OF ENERGY UNITS TO BE ASSIGNED TO THE"
930 PRINT" SHIELDS. ENERGY IS TAKEN FROM TOTAL SHIP'S ENERGY. NOTE"
940 PRINT" THAT THE STATUS DISPLAY TOTAL ENERGY INCLUDES SHIELD ENERGY"
950 PRINT
951 LINE INPUT "ENTER [CR] TO CONTINUE";A$:IF A$="" THEN PRINT CHR$(26)
960 PRINT"\DAM\ COMMAND = DAMMAGE CONTROL REPORT"
970 PRINT" GIVES THE STATE OF REPAIR OF ALL DEVICES. WHERE A NEGATIVE"
980 PRINT" 'STATE OF REPAIR' SHOWS THAT THE DEVICE IS TEMPORARILY"
990 PRINT" DAMAGED."
1000 PRINT
1010 PRINT"\COM\ COMMAND = LIBRARY-COMPUTER"
1020 PRINT" THE LIBRARY-COMPUTER CONTAINS SIX OPTIONS:"
1030 PRINT" OPTION 0 = CUMULATIVE GALACTIC RECORD"
1040 PRINT" THIS OPTION SHOWES COMPUTER MEMORY OF THE RESULTS OF ALL"
1050 PRINT" PREVIOUS SHORT AND LONG RANGE SENSOR SCANS"
1060 PRINT" OPTION 1 = STATUS REPORT"
1070 PRINT" THIS OPTION SHOWS THE NUMBER OF KLINGONS, STARDATES,"
1080 PRINT" AND STARBASES REMAINING IN THE GAME."
1090 PRINT" OPTION 2 = PHOTON TORPEDO DATA"
1100 PRINT" WHICH GIVES DIRECTIONS AND DISTANCE FROM THE ENTERPRISE"
1110 PRINT" TO ALL KLINGONS IN YOUR QUADRANT"
1115 PRINT:PRINT
1116 LINE INPUT "ENTER [CR] TO CONTINUE";A$:IF A$="" THEN PRINT CHR$(26)
1117 PRINT"\COM\ COMMAND = LIBRARY-COMPUTER"
1118 PRINT
1120 PRINT" OPTION 3 = STARBASE NAV DATA"
1130 PRINT" THIS OPTION GIVES DIRECTION AND DISTANCE TO ANY "
1140 PRINT" STARBASE WITHIN YOUR QUADRANT"
1150 PRINT" OPTION 4 = DIRECTION/DISTANCE CALCULATOR"
1160 PRINT" THIS OPTION ALLOWS YOU TO ENTER COORDINATES FOR"
1170 PRINT" DIRECTION/DISTANCE CALCULATIONS"
1180 PRINT" OPTION 5 = CALACTIC /REGION NAME/ MAP"
1190 PRINT" THIS OPTION PRINTS THE NAMES OF THE SIXTEEN MAJOR "
1200 PRINT" GALACTIC REGIONS REFERRED TO IN THE GAME."
1210 PRINT:PRINT:PRINT
1220 PRINT "...CHAINING TO STARTREK..."
1230 LOAD "STARTREK.BAS",R
1240 END

1279
software/BAS/TREKMOD.bas
View File

File diff suppressed because it is too large Load Diff

46
software/BAS/TSTCIR.BAS
View File

@@ -1,46 +0,0 @@
REM DEMONSTRATION PROGRAM FOR CIRCLE DRAWING FUNCTIONS
REM
REM PROGRAM NAME: TSTCIR.BAS
REM
%INCLUDE GRAPHCOM.BAS
%INCLUDE CIRCOM.BAS
GRAPHIC OPEN 1
CLEAR
PRINT "COMPUTING"
CALL BEG.CIR
PRINT "ENDED"
CALL PLOT.CIR
KEY% = CONCHAR% REM WAIT FOR KEYBOARD
REM SCALE THE WINDOW TO DRAW A PROPERLY PROPORTIONED CIRCLE
ASK DEVICE X.AXIS,Y.AXIS
PRINT X.AXIS,Y.AXIS
SET WINDOW 0,X.AXIS/Y.AXIS,0,1
CALL PLOT.CIR
KEY%=CONCHAR%
CALL FILL.CIR
KEY%=CONCHAR%
REM CHANGE THE VIEWPORT TO REPOSITION THE CIRCLE
SET VIEWPORT 0,.5,0,.5 REM LOWER LEFT QUARTER
CLEAR
CALL PLOT.CIR
KEY%=CONCHAR%
SET VIEWPORT .5,1,0,.5 REM LOWER RIGHT QUARTER
CALL PLOT.CIR
KEY%=CONCHAR%
SET VIEWPORT 0,.5,.5,1 REM UPPER LEFT QUARTER
CALL PLOT.CIR
KEY%=CONCHAR%
SET VIEWPORT .5,1,.5,1 REM UPPER RIGHT QUARTER
CALL PLOT.CIR
KEY%=CONCHAR%
STOP
END


371
software/BAS/TVIGAMMO.BAS
View File

@@ -1,371 +0,0 @@
10 REM **************** GAMMON *****************
20 REM
22 REM Converted for Televideo 912 terminal by Bill Soon, August 1981
24 REM Cursor control codes probably OK for ADM-3 & SOROC also.
26 REM * further refinements encouraged *
30 REM originally written for HEATH H-8 OR H-89 WITH H-19
35 REM REQUIRES MICROSOFT
40 REM
50 REM By: R. Wild
55 REM OSO11 Nepil Ave.
60 REM Wheaton, Ill. 60187
70 REM
80 REM Idea by Cursor Magazine
100 CLEAR 1000
200 GOSUB 9000
210 RR=RND(1)
240 DIM B(27),D(4),DA$(3),DI$(6,6),US(4),P(24),PR(6),M$(5)
260 DIM T(6)
280 BK$=SPACE$(38)
300 M$(1)=" HIT YOUR BLOT AT ":M$(2)=" COVERED MY BLOT AT "
310 M$(3)=" MOVED TO "
320 M$(5)="MOVED BLOT TO SAFETY AT ":M$(4)=" CAN'T MAKE MOVE "
340 M$(0)=" BEARING OFF FROM ":FR$=" FROM "
360 A$="":DA$(1)="q":DA$(2)=" ":DA$(3)="*":ER$=A$+""
380 AA$=CHR$(27)+CHR$(61)+CHR$(31+6)+CHR$(33):AL$="XWVUTSRQPONMLKJIHGFEDCBA"
390 A$=CHR$(27)+CHR$(61)+CHR$(31+10)+CHR$(33)
400 FOR I=1 TO 12:READ P(I):NEXT
420 DATA .31,.33,.39,.42,.42,.47,.17,.17,.14,.08,.06,.08
440 FOR I=0 TO 6:READ PR(I):NEXT
460 DATA 0,.03,.11,.25,.44,.69,1
480 GOSUB 8000
640 CM=24:F=6:S=0:HM=24:HB=0:CB=0:XC=0:XH=0
660 PRINT ERAS$;"* BACKGAMMON *"
662 PRINT "Difficulty (1=easy, 10=hard)? ";:LINE INPUT IN$
665 PRINT CO$
680 TT=(VAL(IN$)/10):PRINT GRA$
700 IF TT>1 OR TT<=0 THEN 660
720 PRINT ERAS$:A=TT:IF RND(1)<.5 THEN F=1
740 GOSUB 4220:GOSUB 4460
760 GOSUB 8250:IF D(1)=D(2)THEN 760
780 NP=1: PRINT AA$" MINE YOURS":FOR I=1 TO 500:NEXT
790 GOSUB 8280:FOR I=1 TO 500:NEXT:GOSUB 4580
820 PRINT A$;:IF D(2)>D(1)THEN NP=-1:PRINT"YOU";
840 IF D(2)<D(1)THEN NP=1:PRINT"I";
860 PRINT" GO FIRST!"
880 FOR L=1 TO 2000:NEXT:PRINT AA$;BK$:TU=2:GOTO 980
900 D(1)=0:D(2)=0:GOSUB 4660
920 IF NP=-1 THEN GOSUB 7000
940 TU=2:GOSUB 8250:D(3)=D(1)+D(2)
960 IF D(1)=D(2)THEN D(3)=D(1):D(4)=D(1):TU=4:PY=RND(-100*RND(1))
980 GOSUB 4660:GOSUB 4580
1000 MV=0:Y=0:FOR I=1 TO TU:Y=Y+D(I):US(I)=0:NEXT:IF NP=1 THEN 2620
1020 XH=XH+Y:IN$=""
1040 I=1:GOTO 1080
1060 IN$="":FOR J=1 TO 2000:NEXT J
1080 IF LEN(IN$)>2 THEN IN$=MID$(IN$,2):GOTO 1120
1100 GOSUB 4580:PRINT A$;CN$;" MOVE";I;"? ";:GOSUB 6240:PRINT:PRINT:IF IN$=""THEN 2180
1120 IF LEN(IN$)>1 THEN 1220
1140 IF IN$>="A"AND IN$<="F"THEN IN$="="+IN$
1160 IF IN$>="S"AND IN$<="X"THEN IN$=IN$+"-"
1180 IF LEN(IN$)>1 THEN 1220
1200 PRINT"BAD MOVE.":GOTO 1060
1220 IF LEN(IN$)>3 THEN 1200
1240 IF MID$(IN$,2,1)=","THEN IN$=LEFT$(IN$,1)+MID$(IN$,3):GOTO 1240
1260 F$=LEFT$(IN$,1)
1280 IF F$>="A"AND F$<="X"THEN FM=89-ASC(F$):GOTO 1320
1300 FM=25:IF F$<>"="AND F$<>"-"THEN 1200
1320 T$=MID$(IN$,2,1)
1340 IF T$="="OR T$="-"THEN TM=0:GOTO 1400
1360 IF T$<"A"OR T$>"X"THEN 1200
1380 TM=89-ASC(T$):N=0:M=FM-TM:K=1:L=0
1400 IF FM=25 AND B(25)=0 THEN PRINT"YOU HAVE NO MEN ON THE BAR.":GOTO 1060
1420 IF FM<TM THEN PRINT"WRONG DIRECTION.":GOTO 1060
1440 IF B(25)<0 AND FM<>25 THEN PRINT"YOU HAVE MEN ON THE BAR.":GOTO 1060
1460 IF B(FM)>=0 THEN PRINT"YOU HAVE NO MEN ON ";F$;".":GOTO 1060
1480 IF TM=0 THEN 1920
1500 L=0:FOR J=1 TO TU:IF US(J)THEN K=K+1:GOTO 1560
1520 L=L+1:N=N+D(J):IF N=M THEN 1580
1540 IF D(J)=M THEN K=J:L=1:GOTO 1580
1560 NEXT J:PRINT"YOU CAN'T MOVE";M;".":GOTO 1060
1580 IF B(TM)>1 THEN PRINT"POINT ";T$;" IS BLOCKED.":GOTO 1060
1600 IF L=1 THEN GOSUB 5880:US(K)=1:GOTO 2580
1620 IF B(25)<-1 THEN PRINT"YOU HAVE MEN ON THE BAR.":GOTO 1060
1640 IF TU=4 THEN 1760
1660 IF B(FM-D(1))<=1 THEN M=1:GOTO 1720
1680 IF B(FM-D(2))<=1 THEN M=2:GOTO 1720
1700 PRINT"THE PATH IS BLOCKED.":GOTO 1060
1720 N=TM:TM=FM-D(M):GOSUB 5880:FM=TM:TM=N::GOSUB 5880:I=I+1
1740 GOTO 2580
1760 FOR N=1 TO L
1780 IF B(FM-D(1)*N)>1 THEN 1700
1800 NEXT N
1820 FOR N=K TO J
1840 TM=FM-D(N):US(N)=1:GOSUB 5880
1860 I=I+1:FM=TM:NEXT N
1880 I=I-1:GOTO 2580
1900 NEXT K
1920 FOR J=7 TO 25:IF B(J)<0 THEN PRINT"YOU CAN'T CHEAT!!":GOTO 1060
1940 NEXT J
1960 TM=26:FOR J=1 TO TU:IF US(J)=0 AND FM=D(J)THEN GOSUB 5880:US(J)=1:GOTO 2580
1980 NEXT J
2000 IF FM=6 THEN 2080
2020 FOR J=6 TO FM+1 STEP-1
2040 IF B(J)<0 THEN PRINT"YOU CAN'T BEAR OFF FROM ";F$;".":GOTO 1060
2060 NEXT J
2080 K=0:D(K)=0:FOR J=1 TO TU:IF US(J)=0 AND D(J)>FM AND D(J)>D(K)THEN K=J
2100 NEXT J
2120 IF K=0 THEN PRINT"YOU CAN'T MOVE";FM;".":GOTO 1060
2140 PRINT"ASSUMING USE OF";D(K);".":US(K)=1
2160 GOSUB 5880:GOTO 2580
2180 IF B(25)>=0 THEN 2280
2200 FOR J=1 TO 6
2220 IF J=D(TU)AND US(TU)=0 AND B(25-J)<2 THEN 2560
2240 IF J=D(TU-1)AND US(TU-1)=0 AND B(25-J)<2 THEN 2560
2260 NEXT J:GOTO 2600
2280 FOR J=24 TO 2 STEP-1
2300 IF B(J)>=0 THEN 2360
2320 IF J-D(TU-1)>0 THEN IF US(TU-1)=0 AND B(J-D(TU-1))<2 THEN 2560
2340 IF J-D(TU)>0 THEN IF US(TU)=0 AND B(J-D(TU))<2 THEN 2560
2360 NEXT J
2380 FOR J=24 TO 7 STEP-1:IF B(J)<0 THEN 2600
2400 NEXT J
2420 IF US(TU)=0 AND B(D(TU))<0 THEN 2560
2440 IF US(TU-1)=0 AND B(D(TU-1))<0 THEN 2560
2460 IF US(TU)THEN D=D(TU-1):GOTO 2500
2480 D=D(TU):IF US(TU-1)=0 AND D<D(TU-1)THEN D=D(TU-1)
2500 IF D=6 THEN 2560
2520 FOR J=6 TO D+1:IF B(J)<0 THEN 2560
2540 NEXT J:GOTO 2600
2560 PRINT"YOU CAN TOO MOVE!":GOTO 1060
2580 I=I+1:IF I<=TU THEN 1080
2600 NP=1:GOTO 5460
2620 MO=0:B9=0
2640 XC=XC+Y
2660 K=0
2680 K=K+1:IF B(0)=0 OR K>TU THEN 2800
2700 IF B(D(K))<>-1 THEN 2680
2720 US(K)=1:MO=MO+1
2740 FM=0:TM=D(K):GOSUB 5880
2760 PRINT"OFF BAR AND HIT BLOT AT ";MID$(AL$,TM,1)
2780 GOTO 2680
2800 K=0
2820 K=K+1:IF B(0)=0 OR K>TU THEN 2940
2840 IF B(D(K))<0 OR US(K)>0 THEN 2820
2860 US(K)=1:MO=MO+1
2880 FM=0:TM=D(K):GOSUB 5880
2900 PRINT"OFF BAR TO ";MID$(AL$,TM,1)
2920 GOTO 2820
2940 IF B(0)=0 AND MO<TU THEN 3000
2960 IF MO<TU THEN FOR I=1 TO 500:NEXT:PRINT A$;"CAN'T GET OFF BAR":FOR I=1 TO 500:NEXT
2980 GOTO 4160
3000 IF CM>6 THEN 3380
3020 FOR J=1 TO TU:L=25-D(J):IF B(L)<1 THEN 3060
3040 FM=L:TM=27:GOSUB 5880:PRINT M$(0);MID$(AL$,L,1):MO=MO+1
3150 GOSUB 8500:GOTO 3300
3060 K=6
3080 Y=25-K:IF B(L-K)<1 OR B(Y)<-1 THEN 3160
3100 IF B(Y)=-1 THEN B(Y)=0
3120 FM=L-K:TM=Y:GOSUB 5880
3140 PRINT M$(3);MID$(AL$,Y,1);FR$;MID$(AL$,FM,1)
3150 GOSUB 8500:GOTO 3300
3160 IF K>1 THEN K=K-1:GOTO 3080
3180 K=1
3200 IF L+K>24 THEN 3280
3220 IF B(L+K)<1 THEN 3280
3240 MO=MO+1:FM=L+K:TM=27:GOSUB 5880
3260 PRINT M$(0);MID$(AL$,FM,1);" WITH ROLL OF";D(J)
3270 GOSUB 8500:GOTO 3300
3280 IF K<6 THEN K=K+1:GOTO 3200
3300 IF B(27)=15 THEN 5460
3320 IF TU=MO THEN 4160
3340 NEXT J
3360 GOTO 4160
3380 IF TU=MO THEN 4160
3400 IF TU-MO<2 THEN 3720
3420 IF HB=0 THEN 3720
3440 J=1
3460 IF B(J)<>-1 THEN 3700
3480 J1=J-D(1):J2=J-D(2):IF J1<1 OR J2<1 THEN 3700
3500 IF D(1)=D(2)AND B(J1)=1 THEN 3700
3520 IF B(J1)<1 OR B(J2)<1 THEN 3700
3540 IF TU=4 THEN 3600
3560 IF J1>18 AND B(J1)=2 THEN 3700
3580 IF J2>18 AND B(J2)=2 THEN 3700
3600 MV=MV-1:TM=J:FM=J1:GOSUB 5880:FM=J2:GOSUB 5880
3620 PRINT M$(1);MID$(AL$,J,1);FR$;
3640 PRINT MID$(AL$,J1,1);" AND ";MID$(AL$,J2,1):MO=MO+2:HB=HB-1
3650 GOSUB 8500
3660 IF TU=4 THEN US(3)=1:US(4)=1
3680 GOTO 3380
3700 IF J<24 THEN J=J+1:GOTO 3460
3720 TRY=0:Y=1
3740 IF US(Y)=1 THEN 4120
3760 GOSUB 5120
3780 IF Y<>1 OR MO<>0 OR TU=4 OR BM=4 THEN 3900
3800 S1=BS:F1=FM:M1=BM:Y=2:GOSUB 5120
3820 S2=BS:F2=FM:M2=BM:Y=3:G=1:GOSUB 5120
3840 G=0:IF BS>S1+S2 THEN Y=TM:TM=FM+D(Y):GOTO 3900
3860 IF S2>S1 THEN FM=F2:Y=2:TM=F2+D(Y):BM=M2:GOTO 3900
3880 FM=F1:Y=1:TM=F1+D(Y):BM=M1
3900 IF BM<>4 THEN 4020
3920 IF F<>1 THEN F=1:GOTO 3760
3940 IF TRY<TU+4 THEN 4120
3960 FOR J=1 TO 18:IF B(J)>0 OR B9 THEN PRINT M$(4);:GOSUB 8500:GOTO 4160
3980 NEXT J:B9=1:GOTO 3020
4000 GOTO 4120
4020 IF BM=1 THEN HB=HB-1
4040 MO=MO+1:US(Y)=1:IF HM<24-CM THEN BM=3:A=0
4060 GOSUB 5880
4080 PRINT M$(BM);MID$(AL$,TM,1);FR$;MID$(AL$,FM,1)
4090 GOSUB 8500
4100 IF MO=TU THEN 4160
4120 Y=Y+1:IF Y>TU THEN Y=1
4140 GOTO 3740
4160 NP=-1
4180 GOTO 5460
4200 PRINT M$(MN);MID$(AL$,TM,1);
4210 GOSUB 8500
4220 PRINT ERAS$;:H=8:L$=" 2 ":M$=" 2 ":R$=" 2"
4240 ESC$=CHR$(27):GR$="":LC$="":RV$=ESC$+"j":RVO$=ESC$+"k"
4245 DA$(1)="q"
4250 ERAS$=CHR$(26):PRINT ERAS$
4260 PRINT TAB(39);ESC$;"j";" A B C D E F = G H I J K L "RVO$
4280 FOR I=1 TO 8
4300 PRINT TAB(39);GR$"i ` ` ` iii ` ` ` i":NEXT
4320 FOR I=1 TO 2
4340 PRINT TAB(39);GR$"i iii i"LC$:NEXT
4360 FOR I=1 TO 8
4380 PRINT TAB(39);GR$; "i ` ` ` iii ` ` ` i"LC$:NEXT
4400 PRINT TAB(39);ESC$"j X W V U T S R Q P O N M "RVO$
4420 GOTO 8320
4440 PRINT RIGHT$(" "+STR$(13-I),2);"&";TAB(21);"&";MID$(STR$(I+12),2):RETURN
4460 FOR I=0 TO 25:B(I)=0:NEXT I:B(26)=-15:B(27)=15
4480 B(1)=2:B(6)=-5:B(8)=-3:B(12)=5
4500 B(13)=-5:B(17)=3:B(19)=5:B(24)=-2
4520 FOR I=1 TO 24:N=B(I):TM=I:FM=27+(N<0)
4540 B(I)=0:IF N<>0 THEN FOR J=1 TO ABS(N):GOSUB 5880:NEXT J
4560 NEXT I
4580 PRINT A$;
4600 FOR L=1 TO 3:PRINT BK$:NEXT L
4640 RETURN
4660 PRINT ESC$"=";CHR$(31+6);CHR$(33+9);" ";:PRINT TEMP$;MID$("YOUR MY ",3+NP+NP,4);:PRINT" ROLL ";
4670 PRINT RO$
4680 GOSUB 8280
4700 RETURN
4720 PP=0:J6=24:IF K<13 THEN J6=K+12
4740 FOR I=K TO J6:IF B(I)<0 THEN PP=PP+P(I-K)
4760 NEXT I:IF K>14 THEN PP=PP+P(25-K)*2
4780 RETURN
4800 MS=3:CS=0
4820 Q4=8*PR(BH)*(1+PR(BH))
4840 Q5=8*PR(BC)*(1+PR(BC))
4860 K=P5:GOSUB 4720:CZ=PP*(P5+Q4)*A
4880 K=P5+RL:GOSUB 4720:PZ=PP
4900 CW=PZ*(P5+RL+Q4)*A
4920 IF B(P5)=2 THEN CS=CS-CZ
4940 IF B(P5)=1 AND B(K)>0 THEN CS=CS+CZ:MS=5
4960 IF B(K)=-1 THEN CS=CS+25-K+Q5:MS=1:IF K>18 THEN CS=CS-4
4980 IF B(K)<>1 THEN 5040
5000 CS=CS+CW:IF B(P5)>2 THEN MS=2
5020 GOTO 5100
5040 SM=0:J=20:NN=K+R1:IF NN<20 THEN J=NN
5060 FOR I=K TO J:IF B(I)=-1 THEN SM=SM+P(I-K)*(25-I)
5080 NEXT I:CS=CS-CW+(1-PZ)*SM
5100 RETURN
5120 BS=-999:BM=4:FM=0:TM=0:TRY=TRY+1
5140 FOR L=24 TO 1 STEP-1:IF B(L)<1 THEN 5440
5160 RL=D(Y):R=L+RL:IF R>24 THEN 5440
5180 IF R<F AND B(R)<>-1 THEN 5440
5200 IF B(R)<-1 THEN 5440
5220 IF G<>1 THEN 5300
5240 Q=0:L1=L+D(1):L2=L+D(2):IF B(L1)>-2 THEN Q=1
5260 IF B(L2)>-2 THEN Q=2
5280 IF Q=0 THEN 5440
5300 P5=L:GOSUB 4800
5320 IF G<>1 THEN 5400
5340 MS=3:IF B(L1)=-1 THEN Q=1:CS=CS+25-L1:MS=1
5360 IF B(L2)=-1 THEN Q=2:CS=CS+25-L2:MS=1
5380 K=Q
5400 IF CS<BS THEN 5440
5420 BS=CS:FM=L:TM=K:BM=MS
5440 NEXT L:GOSUB 4580:RETURN
5460 IF B(26)=-15 THEN X$="YOU":X=CP:GOTO 5800
5480 IF B(27)=15 THEN X$="I":X=HP:GOTO 5800
5500 HM=0:CM=0:JM=0:HP=0:CP=0:HB=0:CB=0:BC=0:BH=0
5520 FOR I=0 TO 25
5540 IF B(I)<0 THEN HP=HP-B(I)*I:HM=I
5560 IF B(I)>0 THEN CP=CP+B(I)*(25-I):JM=25-I
5580 IF JM>CM THEN CM=JM
5600 IF B(I)=-1 THEN HB=HB+1
5620 IF B(I)=+1 THEN CB=CB+1
5640 IF I<7 AND B(I)<-1 THEN BH=BH+1
5660 IF I>18 AND B(I)>1 THEN BC=BC+1
5680 NEXT
5700 XX=CP:IF HP<XX THEN XX=HP
5720 Y=(CP-HP)/XX:IF Y>.2 THEN S=1:F=6:A=.1
5740 IF Y<-.1 THEN S=0:F=1:A=TT
5760 IF S=1 AND HM<6 THEN F=HM
5780 GOTO 900
5800 PRINT ER$A$;X$;" WON BY";X;"POINTS."
5810 PRINT CN$
5820 PRINT"TOTAL POINTS ROLLED";XH;DA$(1);XC;DA$(3):PRINT:INPUT"WANT TO PLAY AGAIN";X$
5840 IF LEFT$(X$,1)="Y"THEN 640
5860 PRINT CN$:END
5880 PT=FM:GOSUB 6060:P=SGN(B(FM)):GOSUB 6060:B(FM)=B(FM)-P
5900 IF FM=25 OR FM=0 THEN PRINT GR$"i";LC$:GOTO 5940
5920 IF FM<26 THEN PRINT GR$;MID$(" `",2+((1 AND PT)=1 OR ABS(B(PT))>8),1);LC$
5940 IF B(TM)<>-P THEN 5980
5960 PT=-25*(P>0):B(PT)=B(PT)-P:GOSUB 6060:B(TM)=0
5965 IF P=-1 THEN PRINT DA$(3)ELSE PRINT DA$(1)
5980 B(TM)=B(TM)+P:PT=TM:IF TM<26 THEN GOSUB 6060:PRINT DA$(2+P)
6000 IF MV<=-1 THEN MV=0
6020 PRINT A$:MV=MV+1
6040 RETURN
6060 IF PT>25 THEN RETURN
6080 IF PT=0 OR PT=25 THEN 6180
6100 VT=ABS(B(PT)):IF PT<13 THEN VT=19-VT
6120 TB=ABS(12.5-PT)*2+1:IF TB>12 THEN TB=TB+4
6140 TB=30-TB
6160 GOTO 6220
6180 VT=-B(PT):IF VT<0 THEN VT=19+VT
6200 TB=15
6220 PRINT ESC$"=";CHR$(31+2+VT);CHR$(31+40+TB);:RETURN
6240 LINE INPUT IN$
6250 PRINT A$;CO$;
6260 RETURN
7000 REM INPUT SI WAS HERE
7010 GOSUB 4580
7050 PRINT A$;" ";
7100 REM
7200 GOSUB 8250
7300 INPUT "PRESS RETURN TO ROLL";ZZ$
7400 RETURN
8000 REM DICE ROUTINE
8050 E$=CHR$(27):H$=CHR$(30)
8060 ER$=CHR$(26):PRINT ER$;
8070 RO$=E$+"k":PRINT RO$
8080 EG$=""
8090 RV$=E$+"j"
8100 TEMP$=RV$
8110 COF$=""
8120 CH$=""
8130 PRINT ER$
8150 FOR I=1 TO 6:FOR J=1 TO 6:READ DI$(I,J):NEXT J,I
8160 DATA" "," ^","^ ","^ ^","^ ^","^^^"
8170 DATA" ^ "," "," ^ "," "," ^ "," "
8180 DATA" ","^ "," ^","^ ^","^ ^","^^^"
8190 DATA" ","^ "," ^","^ ^","^ ^","^ ^"
8200 DATA" ^ "," "," ^ "," "," ^ ","^ ^"
8210 DATA" "," ^","^ ","^ ^","^ ^","^ ^"
8220 RETURN
8250 FOR I=1 TO 2
8260 FX=INT(RND(1)*6+1):T(I)=3*(RND(1)>.5)+3:CT(FX)=CT(FX)+1:D(I)=FX
8270 NEXT I
8275 RETURN
8280 PRINT H$;GR$;:FOR I=1 TO 3:PRINT
8283 FOR J=1 TO 2
8285 IF DI$(I+T(J),D(J))=""THEN DI$(I+T(J),D(J))=" "
8290 PRINT TAB(2*J+7);"| "+DI$(I+T(J),D(J))+" | ";:NEXT J,I
8300 PRINT CHR$(27);"G";:PRINT
8310 RETURN
8320 PRINT H$;E$+"F";:PRINT TAB(8);" zzzzz zzzzz "
8330 FOR I=1 TO 3:PRINT TAB(9);"| | | |"
8340 NEXT I
8350 PRINT TAB(10)"zzzzz zzzzz"
8355 PRINT LC$
8360 RETURN
8500 REM DELAY ROUTINE
8510 FOR I=1 TO 2000:NEXT I:RETURN
9000 RETURN : REM INSTRUCTION FILE READ ROUTINE WAS HERE


255
software/BAS/WEATHER.bas
View File

@@ -1,255 +0,0 @@
100 DIM S$(10)
110 PRINT"THIS PROGRAM WILL ATTEMPT TO PREDICT TOMORROWS WEATHER IF"
120 PRINT"GIVEN THE WEATHER STATISTICS FROM THE PAST TWO DAYS."
130 PRINT TAB(5);"SEASON"
140 INPUT S$(1)
150 GOSUB 1500
160 GOTO 130
170 PRINT"AFTER THE FOLLOWING QUESTION MARKS YOU WILL BE REQUIRED"
180 PRINT"TO INPUT TWO VALUES, ONE FOR YESTERDAY'S READING AND ONE"
190 PRINT"FOR TODAY'S READING. SEPERATE THESE READINGS BY A COMMA."
200 PRINT TAB(5);"TEMPERATURE"
210 INPUT T1,T2
220 GOSUB 1570
230 GOTO 200
240 PRINT TAB(5);"BAROMETER"
250 INPUT B1,B2
260 GOSUB 1640
270 GOTO 240
280 PRINT TAB(5);"BAROMETER TENDENCY(1=RISING,2=FALLING,3=STEADY):"
290 INPUT T3,T4
300 GOSUB 1710
310 GOTO 280
320 PRINT TAB(5);"RELATIVE HUMIDITY"
330 INPUT H1,H2
340 GOSUB 1780
350 GOTO 320
360 PRINT TAB(5);"CLOUDS(1=STRATUS,2=CUMULUS,3=CIRRUS)"
370 INPUT C1,C2
380 GOSUB 1850
390 GOTO 360
400 PRINT TAB(5);"CLOUD COVER(PERCENTAGE)"
410 INPUT C4,C5
420 GOSUB 1920
430 GOTO 400
440 PRINT TAB(5);"WIND DIRECTION (1=NORTH,2=SOUTH,3=EAST,4=WEST)"
450 INPUTD1,D2
460 GOSUB 1990
470 GOTO 440
480 PRINT TAB(5);"WIND SPEED"
490 INPUT S2,S3
500 GOSUB 2060
510 GOTO 480
520 PRINT
530 PRINT
540 PRINT
550 PRINT"------------------------------------------------------"
560 PRINT"PRESENT SEASON IS ";S$(1)
570 PRINT
580 PRINT "FORECAST FOR TOMORROW:"
590 PRINT
600 PRINT
610 PRINT"TEMPERATURES:"
620 LET T7=((T1+T2)/2)-30
630 LET T6=T7+10
640 PRINT "LOWS TONIGHT BETWEEN";T7;"AND";T6;"DEGREES"
650 LET T9=((T1+T2)/2)+5
660 LET T8=T9-5
670 PRINT "HIGHS TOMORROW NIGHT BETWEEN";T8;"AND";T9;"DEGREES"
680 LET T0=T7-5
690 PRINT "LOWS TOMORROW NIGHT BETWEEN ";T0;"AND";T7;"DEGREES"
700 LET B4=(B1+B2)/2
710 B0=INT(ABS(B1-B2))
720 LET T9=(T3+T4)/2
730 LET T9=INT(T9)
740 IF T9=2 THEN 780
750 IF T9=3 THEN 800
760 PRINT"BAROMETER";B4;" AND RISING."
770 GOTO 810
780 PRINT"BAROMETER";B4;" AND FALLING."
790 GOTO 810
800 PRINT"BAROMETER";B4;" AND STEADY."
810 LET H3=((H1+H2)/2)+5
820 LET H4=H3-5
830 PRINT "HUMIDITY BETWEEN ";H4;"AND ";H3;"PERCENT"
840 LET C3=(C1+C2)/2
850 LET C3=INT(C3)
860 LET C9=((C4+C5)/2)+5
870 LET C8=C9-5
880 PRINT"CLOUD COVER BETWEEN";C8;"AND";C9;"PERCENT"
890 IF C3=2 THEN 940
900 IF C3=3 THEN 970
910 PRINT"CLOUD HEIGHT BETWEEN 500 TO 580 FEET."
920 PRINT"MAJOR CLOUD TYPE WILL BE STRATUS."
930 GOTO 990
940 PRINT"CLOUD HEIGHT BETWEEN 1550 TO 1800 FEET."
950 PRINT"MAJOR CLOUD TYPE WILL BE CUMULUS."
960 GOTO 990
970 PRINT"CLOUD HEIGHT BETWEEN 16500 TO 17000 FEET."
980 PRINT"MAJOR CLOUD TYPE WILL BE CIRRUS."
990 LET D5=(D1+D2)/2
1000 LET D5=INT(D5)
1010 LET S5=((S2+S3)/2)+5
1020 LET S6=S5-5
1030 IF D5=2 THEN 1080
1040 IF D5=3 THEN 1100
1050 IF D5=4 THEN 1120
1060 PRINT"WIND FROM THE NORTH FROM";S6;"TO";S5;"MPH"
1070 GOTO 1130
1080 PRINT"WIND FROM THE SOUTH FROM";S6;"TO";S5;"MPH"
1090 GOTO 1130
1100 PRINT "WIND FORM THE EAST FROM";S6;"TO";S5;"MPH"
1110 GOTO 1130
1120 PRINT"WIND FROM THE WEST FROM";S6;"TO";S5;"MPH"
1130 PRINT"CHANCE OF PRECIPITATION:"
1140 LET P1=INT((((C5/2)+B2)+C2)/.5)
1150 IF P1>100 THEN 2170
1160 PRINT "TONIGHT";P1;"%"
1170 LET P2=INT(((C9/2)+B4)+C3)
1180 IF P2>100 THEN 2190
1190 PRINT"TOMORROW";P2;"%"
1200 IF P3>100 THEN 2210
1210 PRINT"TOMORROW NIGHT";P3;"%"
1220 PRINT
1230 IF C2=2 THEN 1340
1240 IF C2=3 THEN 1420
1250 PRINT"FORECAST FOR TOMORROWS WEATHER:"
1260 PRINT
1270 PRINT"IT SHOULD BE FAIR TOMORROW."
1280 IF S$(1)="SPRING"THEN 1320
1290 IF S$(1)="SUMMER"THEN 1320
1300 PRINT"IT SHOULD BE COOLER TOMORROW WITH NO PRECIPITATION LIKELY."
1310 GOTO 1490
1320 PRINT"IT SHOULD BE WARMER TOMORROW WITH NO PRECIPITATION LIKELY."
1330 GOTO 1490
1340 PRINT"FORECAST FOR TOMORROWS WEATHER."
1350 PRINT
1360 IF S$(1)="SUMMER"THEN 1390
1370 PRINT"IT SHOULD BE FAIR TOMORROW."
1380 GOTO 1280
1390 PRINT"IF THEY ARE HEAVY CLOUDS--BE READY FOR RAIN."
1400 PRINT"IF THE CLOUDS ARE LIGHT--IT WILL BE FAIR."
1410 GOTO 1490
1420 IF S$(1)="FALL" THEN 1490
1430 PRINT
1440 IF S$(1)="SPRING"THEN 1480
1450 IF S$(1)="SUMMER"THEN 1480
1460 PRINT"TOMORROW,EXPECT SNOW TO FALL FOLLOWED BY HIGHER TEMPERATURES."
1470 GOTO 1490
1480 PRINT"TOMORROW,EXPECT RAIN TO FALL FOLLOWED BY HIGHER TEMPERATURES."
1490 GOTO 2130
1500 IF S$(1)="WINTER"THEN 170
1510 IF S$(1)="FALL"THEN 170
1520 IF S$(1)="SPRING"THEN 170
1530 IF S$(1)="SUMMER" THEN 170
1540 PRINT TAB(5);"LETS TRY THAT ONE AGAIN(SEASONS:WINTER,SPRING";
1550 PRINT"FALL,SUMMER)..."
1560 RETURN
1570 IF T1>135 THEN 1620
1580 IF T1<-80 THEN 1620
1590 IF T2>135 THEN 1620
1600 IF T2<-80 THEN 1620
1610 GOTO 240
1620 PRINT TAB(5);"LETS TRY THAT ONE AGAIN(NORMALS-80-135)..."
1630 RETURN
1640 IF B1>31.5 THEN 1690
1650 IF B1<28.5 THEN 1690
1660 IF B2>31.5 THEN 1690
1670 IF B2<28.5 THEN 1690
1680 GOTO 280
1690 PRINT TAB(5);"LETS TRY THAT ONE AGAIN(NORMALS:28.5-31.5)..."
1700 RETURN
1710 IF T3<1 THEN 1760
1720 IF T3>3 THEN 1760
1730 IF T4<1 THEN 1760
1740 IF T4>3 THEN 1760
1750 GOTO 320
1760 PRINT TAB(5);"LETS TRY THAT ONE AGAIN..."
1770 RETURN
1780 IF H1<0 THEN 1830
1790 IF H1>100 THEN 1830
1800 IF H2<0 THEN 1830
1810 IF H2>100 THEN 1830
1820 GOTO 360
1830 PRINT TAB(5);"LETS TRY THAT ONE AGAIN(HUMIDITY:0-100)..."
1840 RETURN
1850 IF C1<1 THEN 1900
1860 IF C1>3 THEN 1900
1870 IF C2<1 THEN 1900
1880 IF C2>3 THEN 1900
1890 GOTO 400
1900 PRINT TAB(5);"LETS TRY THAT ONE AGAIN..."
1910 RETURN
1920 IF C4<0 THEN 1970
1930 IF C4>100 THEN 1970
1940 IF C5<0 THEN 1970
1950 IF C5>100 THEN 1970
1960 GOTO 440
1970 PRINT TAB(5);"LETS TRY THAT ONE AGAIN(COVER:0-100)..."
1980 RETURN
1990 IF D1<1 THEN 2040
2000 IF D1>4 THEN 2040
2010 IF D2<1 THEN 2040
2020 IF D2>4 THEN 2040
2030 GOTO 480
2040 PRINT TAB(5);"LETS TRY THAT ONE AGAIN..."
2050 RETURN
2060 IF S2<0 THEN 2110
2070 IF S2>75 THEN 2110
2080 IF S3<0 THEN 2110
2090 IF S3>75 THEN 2110
2100 GOTO 520
2110 PRINT TAB(5);"LETS TRY THAT ON E AGAIN(NORMAL:0-75)..."
2120 RETURN
2130 GOSUB 2230
2140 PRINT"THE END"
2150 PRINT"---------------------------------------------------"
2160 STOP
2170 LET P1=100
2180 GOTO 1160
2190 LET P2=100
2200 GOTO 1190
2210 LET P3=100
2220 GOTO 1210
2230 IF D2=2 THEN 2390
2240 IF D2=3 THEN 2480
2250 IF D2=1 THEN 2580
2260 IF B2=>30.2 THEN 2340
2270 IF B2=>30.1 THEN 2300
2280 PRINT"IT WILL BE CLEARING AND COLDER TOMORROW."
2290 GOTO 2620
2300 IF T2=3 THEN 2330
2310 PRINT"IT WILL BE FAIR TOMORROW, FOLLOWED BY WINDS AND PRECIPITATION."
2320 GOTO 2620
2330 PRINT"IT WILL BE FAIR TOMORROW, WITH LITTLE TEMPERATURE CHANGE."
2340 IF T2=3 THEN 2370
2350 PRINT"IT WILL BE FAIR TOMORROW WITH SLOWLY RISING TEMPERATURES."
2360 GOTO 2620
2370 PRINT "IT WILL BE CONTINUED FAIR TOMORROW."
2380 GOTO 2620
2390 IF B2<=29.8 THEN 2450
2400 IF B2<=30! THEN 2430
2410 PRINT"IT WILL BE WINDY WITH RAIN IN 12-24 HOURS."
2420 GOTO 2620
2430 PRINT"IT WILL BE CLEARING AND FAIR FOR SEVERAL DAYS FOLLOWING."
2440 GOTO 2620
2450 PRINT"THERE WILL BE A SEVERE STORM IN 24 HOURS FOLLOWED BY ";
2460 PRINT"CLEARING."
2470 GOTO 2620
2480 IF B2<=29.8 THEN 2530
2490 IF B2=> 30.1 THEN 2550
2500 PRINT"IN WINTER, EXPECT SNOW WITH WINDS."
2510 PRINT"IN SUMMER, EXPECT A LONG DRY SPELL."
2520 GOTO 2620
2530 PRINT"THERE WILL BE A NORTHEAST WIND WITH HEAVY PRECIPITATION."
2540 GOTO 2620
2550 PRINT"IN WINTER, EXPECT SNOW IN 24 HOURS."
2560 PRINT"IN SUMMER, EXPECT A DRY SPELL."
2570 GOTO 2620
2580 IF B2<=30! THEN 2610
2590 PRINT"RAIN WILL CONTINUE WITH WINDS FOR 36 HOURS, THEN CLEARING."
2600 GOTO 2620
2610 PRINT "RAIN WILL FALL IN 12 TO 18 HOURS."
2620 RETURN
UE WITH WINDS FOR 36 HOURS, THEN CLEARING."
2600 GOTO 2620

221
software/BAS/WORD-PZL.bas
View File

@@ -1,221 +0,0 @@
100 CLEAR 1200
110 B$="."
120 INPUT"INPUT X AND Y DIMENSIONS ";X,Y
130 IF X>30 OR Y>30 THEN 120
140 IF X>Y THEN U0=X:GOTO 180
150 U0=Y
160 INPUT"NUMBER OF WORDS ";N
170 C1=100*INT(N/10):IF C1<100 THEN C1=100
180 DIM W$(50),A$(X,Y),N$(N),L(N,4)
190 W$(1)="DUMMEY ARGUMENT"
200 GOTO2150
210 GOSUB 1960
220 GOTO2020
230 INPUT"PUNCH LIST ON TAPE";T$:IF LEFT$(T$,1)="Y" THEN GOTO 2220
240 Q8=1
250 GOSUB 1940
260 PRINT:PRINT Q8
270 FOR I1=1 TO N
280 GOTO 360
290 PRINT:PRINT"FIRST CHAR. CHANGED ON PASS";C0;" OF THE";I1;"TH WORD"
300 A$(L(1,1),L(1,2))=LEFT$(N$(1),1)
310 GOTO430
320 REM
330 L(I1,1)=A:L(I1,2)=B:L(I1,3)=D
340 L(I1,4)=C0
350 GOTO 1580
360 C0=0
370 S$=N$(I1)
380 Z=LEN(S$)-1
390 GOSUB 1540
400 C0=C0+1
410 IF I1=1 THEN GOTO 430
420 IF A$(L(1,1),L(1,2))<>LEFT$(N$(1),1) THEN GOTO 290
430 IF C0/C1<>INT(C0/C1) THEN 450
440 PRINT S$;" TRY#";C0
450 IF C0<C1*10 THEN490
460 Q8=Q8+1:IF Q8=100 THEN STOP
470 GOTO 250
480 PRINT Q8: GOTO250
490 ON D GOTO 500,630,760,890,1020,1150,1280,1410
500 IF B+Z>Y THEN 390
510 FOR I=1 TO LEN(S$)
520 A1=A:B1=B+I-1
530 GOSUB 1910
540 GOSUB 1930
550 IF L$=B$ OR L$=N1$ THEN 570
560 GOTO 390
570 NEXT I
580 FOR I=1 TO LEN(S$)
590 GOSUB 1910
600 A$(A,B+I-1)=N1$
610 NEXT I
620 GOTO 320
630 IF B+Z>Y OR A-Z<1 THEN390
640 FOR I=1 TO LEN(S$)
650 A1=A-(I-1):B1=B+I-1
660 GOSUB 1910
670 GOSUB 1930
680 IF L$=B$ OR L$=N1$ THEN 700
690 GOTO 390
700 NEXT I
710 FOR I=1 TO LEN(S$)
720 GOSUB 1910
730 A$(A-(I-1),B+I-1)=N1$
740 NEXT I
750 GOTO 320
760 IF A-Z<1 THEN 390
770 FOR I=1 TO LEN(S$)
780 A1=A-(I-1):B1=B
790 GOSUB 1910
800 GOSUB 1930
810 IF L$=B$ OR L$=N1$ THEN 830
820 GOTO 390
830 NEXT I
840 FOR I=1 TO LEN(S$)
850 GOSUB 1910
860 A$(A-(I-1),B)=N1$
870 NEXT I
880 GOTO320
890 IF A-Z<1 OR B-Z<1 THEN390
900 FOR I=1 TO LEN(S$)
910 A1=A-(I-1):B1=B-(I-1)
920 GOSUB 1910
930 GOSUB 1930
940 IF L$=B$ OR L$=N1$ THEN960
950 GOTO 390
960 NEXT I
970 FOR I=1 TO LEN(S$)
980 GOSUB 1910
990 A$(A-(I-1),B-(I-1))=N1$
1000 NEXT I
1010 GOTO 320
1020 IF B-Z<1 THEN 390
1030 FOR I=1 TO LEN(S$)
1040 A1=A:B1=B-(I-1)
1050 GOSUB 1910
1060 GOSUB 1930
1070 IF L$=B$ OR L$=N1$ THEN 1090
1080 GOTO 390
1090 NEXT I
1100 FOR I=1 TO LEN(S$)
1110 GOSUB 1910
1120 A$(A,B-(I-1))=N1$
1130 NEXT I
1140 GOTO 320
1150 IF A+Z>X OR B-Z<1 THEN390
1160 FOR I=1 TO LEN(S$)
1170 A1=A+I-1:B1=B-(I-1)
1180 GOSUB 1910
1190 GOSUB 1930
1200 IF L$=N1$ OR L$=B$ THEN1220
1210 GOTO390
1220 NEXT I
1230 FOR I=1 TO LEN(S$)
1240 GOSUB 1910
1250 A$(A+I-1,B-(I-1))=N1$
1260 NEXT I
1270 GOTO320
1280 IF A+Z>X THEN 390
1290 FOR I=1 TO LEN(S$)
1300 A1=A+I-1:B1=B
1310 GOSUB 1910
1320 GOSUB 1930
1330 IF L$=N1$ OR L$=B$ THEN1350
1340 GOTO 390
1350 NEXT I
1360 FOR I=1 TO LEN(S$)
1370 GOSUB 1910
1380 A$(A+I-1,B)=N1$
1390 NEXT I
1400 GOTO 320
1410 IF A+Z>X OR B+Z>Y THEN390
1420 FOR I=1 TO LEN(S$)
1430 A1=A+I-1:B1=B+I-1
1440 GOSUB 1910
1450 GOSUB 1930
1460 IF L$=B$ OR L$=N1$ THEN 1480
1470 GOTO 390
1480 NEXT I
1490 FOR I=1 TO LEN(S$)
1500 GOSUB 1910
1510 A$(A+I-1,B+I-1)=N1$
1520 NEXT I
1530 GOTO320
1540 A=INT(X*RND(8)+1)
1550 B=INT(Y*RND(8)+1)
1560 D=INT(8*RND(5)+1)
1570 RETURN
1580 NEXT I1
1590 GOTO 1610
1600 FOR I=1TOX:FORJ=1TOY:PRINTA$(I,J);" ";:NEXTJ:PRINT:NEXTI
1610 FOR I=1 TO 5:PRINT:NEXT I
1620 PRINT"THE";N;"HIDDEN WORDS ARE":PRINT
1630 Z=2:FORI=1TON:PRINTTAB(Z);N$(I);:Z=Z+18:IFZ>60 THENZ=2:PRINT
1640 NEXT I:PRINT:PRINT:PRINT
1650 FOR I=1 TO X
1660 FOR J=1 TO Y
1670 IF A$(I,J)=B$ THEN 1770
1680 PRINT A$(I,J);" ";
1690 NEXT J
1700 PRINT
1710 NEXT I
1720 PRINT
1730 GOSUB 1800
1740 PRINT
1750 GOTO 240
1760 END
1770 A$(I,J)=CHR$(INT(26*RND(1)+65))
1780 GOTO 1680
1790 PRINT
1800 REM
1810 AN=1
1820 PRINT "THE HIDDEN WORDS ARE LOCATED AT"
1830 FOR K=1 TO N
1840 PRINT N$(K);
1850 IF AN=0 THEN PRINT: GOTO 1880
1860 PRINT TAB(30);L(K,1);",";L(K,2);",";L(K,3);
1870 PRINT ",";L(K,4)
1880 NEXT K
1890 RETURN
1900 END
1910 N1$=MID$(S$,I,1)
1920 RETURN
1930 L$=A$(A1,B1):RETURN
1940 FORI=1TOX:FORJ=1TOY:A$(I,J)=B$:NEXT J,I
1950 RETURN
1960 FOR I=1 TO N
1970 PRINT"WORD #";I;
1980 INPUT N$(I)
1990 IF LEN(N$(I))>U0 THEN1970
2000 NEXT I
2010 RETURN
2020 IF N<3 THEN GOTO240
2030 FOR J=2 TO (N-1)
2040 L=0:M=0
2050 FOR I=J TO N
2060 IF LEN(N$(I))>L THEN L=LEN(N$(I)):M=I
2070 NEXT I
2080 T$=N$(M)
2090 FOR I=(M-1)TO J STEP -1
2100 N$(I+1)=N$(I)
2110 NEXT I
2120 N$(J)=T$
2130 NEXT J
2140 GOTO 230
2150 INPUT"INPUT FROM TAPE";T$:IF LEFT$(T$,1)="N" THEN GOTO210
2160 PRINT CHR$(17):REM TAPE READER ON
2170 FOR I=1 TO N
2180 INPUT N$(I)
2190 NEXT I
2200 PRINT CHR$(19):REM TAPE READER OFF
2210 GOTO 2020
2220 NULL6
2230 PRINT CHR$(18);:REM TAPE PUNCH ON
2240 FOR I=1TO75:PRINT CHR$(0);:NEXT I:REM LEADER
2250 FOR I=1TON:PRINTN$(I):NEXT I
2260 FOR I=1TO75:PRINT CHR$(0);:NEXT I:PRINT CHR$(20)
2270 NULL0:GOTO240
XT I:REM LEADER
2250 FOR I=1TON:PRINTN$(I):NEXT I
2260 FOR I=1TO75:PRINT CHR$

BIN
software/BAS/WORDPUZL.BAS
View File

Binary file not shown.

213
software/BAS/ZILCH.BAS
View File

@@ -1,213 +0,0 @@
1 REM ZILCH (C) COPYRIGHT 1980 BY MORRIE WILSON
2 REM ****** ZILCH BY MORRIE WILSON
3 REM
4 REM A DICE GAME FOR 1 TO 9 PLAYERS,
5 REM AND THE COMPUTER CAN BE A PLAYER TOO.
6 REM
7 REM
8 REM THIS IS A FREE PROGRAM. NO COMMERCIAL USE ALLOWED.
9 REM FOR INFO: MORRIE WILSON / 2527 56TH SW /SEATTLE WASH / 98116
10 REM IF YOU HAVE MICROSOFT 5.+ BASIC, REMOVE "REM" FROM LINE 35
11 REM TO ALLOW IT TO GENERATE RANDOM NUMBERS. THIS PROGRAM IS
12 REM COMPATIBLE WITH MICROSOFT BASIC 4.51 AND 5.03
13 REM IF CODING LOOKS STRANGE & REDUNDANT, IT IS BECAUSE I'M TRYING
14 REM TO REMAIN COMPATIBLE WITH BOTH BASICS.
15 REM
16 REM IF IT RUNS, BUT THE DICE VALUES ARE STRANGE, THEN ITS
17 REM PROBABLY THAT YOUR BASIC HANDLES RANDOM NUMBER GENERATION
18 REM DIFFERENTLY. CHECK OUT THE RND(X) STUFF IN LINE 74
19 W6=250
20 A1$="ABCDEF"
21 A=ASC("A")
22 PRINT TAB(30);"ZILCH"
23 A$="N":INPUT "DO YOU WANT INSTRUCTIONS ";A$
24 IF LEFT$(A$,1)="Y" THEN GOSUB 149
25 INPUT "NUMBER OF PLAYERS";N1
26 N1=INT(N1):IF N1<1 THEN PRINT "WHAT....YOU CAN'T DO THAT":GOTO 25
27 IF N1>9 THEN PRINT "TOO MANY PLAYERS FOR THIS GAME":GOTO 25
28 FOR II=1 TO N1:PRINT "THE NAME PLEASE....OF PLAYER #";II;" "
29 INPUT N9$(II):FOR I9=1 TO LEN(N9$(II)):R9=R9+ASC(MID$(N9$(II),I9,1)):NEXT I9
30 NEXT II
31 R9=R9*3.14161:IF R9>65000! THEN R9=R9/5.67:GOTO 31
32 R9=INT(R9)
33 FOR I=1 TO 200:NEXT I
34 PRINT:PRINT
35 REM RANDOMIZE R9
36 W7$="Y":W4=0:INPUT "CAN I PLAY TOO ";W7$
37 IF LEFT$(W7$,1)<>"Y" THEN 40
38 N1=N1+1:N9$(N1)="<WALTER>"
39 W4=N1
40 S8=0
41 FOR N=1 TO N1 : S1(N)=0 : NEXT N
42 FOR N=1 TO N1
43 IF N=S8 THEN 137
44 S=0:D=6:S9=0
45 PRINT:PRINT:PRINT:PRINT "IT'S ";N9$(N);"'S TURN"
46 PRINT:PRINT
47 IF S8<>0 THEN PRINT "************************ LAST TURN******"
48 FOR K9=1 TO N1:PRINT N9$(K9);" HAS ";S1(K9):NEXT K9
49 PRINT N9$(N)". YOUR GAME TOTAL SO FAR IS ";S1(N)
50 PRINT "CURRENT TURN SCORE IS ";S
51 S2=S1(N)+S
52 IF S2<500 THEN S2=0
53 PRINT "IF YOU STOP NOW YOUR TOTAL WILL BE ";S2
54 W$="DICE":IF D=1 THEN W$="DIE"
55 PRINT "YOU HAVE";D;" ";W$;" LEFT. DO YOU WISH TO ROLL ";
56 A$="Y":IF W4<>N THEN INPUT A$:GOTO 67
57 PRINT "?";:FOR W5=1 TO W6:NEXT W5:A$="Y"
58 IF D<=2 THEN A$="N"
59 IF S2=0 THEN A$="Y"
60 IF S>999 AND D<=4 THEN A$="N"
61 W9=S2
62 IF S8=0 THEN 66
63 FOR W5=1 TO N1:IF W9<S1(W5) THEN W9=S1(W5)
64 NEXT W5
65 IF S2<W9 THEN A$="Y"
66 PRINT A$:FOR W5=1 TO W6:NEXT W5
67 PRINT:PRINT
68 IF LEN(A$)=0 THEN 70
69 IF LEFT$(A$,1)="N" THEN 129
70 FOR D9=1 TO D
71 REM D1(D9)=INT(RND(R9)*6+1) IS SUPPOSED TO PUT A RANDOM
72 REM VALUE BETWEEN 1 AND 6 INTO D1(D9). YOU MAY HAVE
73 REM FIDDLE WITH IT IF IT DOES NOT WORK FOR YOUR BASIC
74 D1(D9)=INT(RND(R9)*6+1):PRINT CHR$(A+D9-1);"=";D1(D9);" ";
75 NEXT D9:PRINT
76 PRINT
77 GOTO 79
78 PRINT "WHAT!!!???.....RETYPE LINE"
79 A$=LEFT$(A1$,D):IF W4<>N THEN INPUT "WHICH DIE DO YOU WISH TO KEEP";A$:GOTO 83
80 PRINT "WHICH DIE DO YOU WISH TO KEEP? ";
81 FOR W5=1 TO W6*2:NEXT W5:A$=LEFT$(A1$,D)
82 PRINT A$
83 PRINT:PRINT:IF A$="?" THEN GOSUB 204: GOTO 79
84 IF LEN(A$)=0 THEN A$=LEFT$(A1$,D):GOTO 89
85 L=LEN(A$):IF L<2 THEN 89
86 FOR I=1 TO L-1:FOR II=I+1 TO L
87 IF MID$(A$,I,1)=MID$(A$,II,1) THEN 78
88 NEXT II:NEXT I
89 L=LEN(A$):IF L>D THEN 78
90 FOR D9=1 TO L:D8=ASC(MID$(A$,D9,1))-A+1
91 IF D8<1 OR D8>D THEN 78
92 H9(D9)=D1(D8)
93 NEXT D9
94 IF L=1 THEN 100
95 FOR I=1 TO L-1
96 FOR J=1 TO L-I
97 IF H9(J)<H9(J+1) THEN 99
98 T=H9(J):H9(J)=H9(J+1):H9(J+1)=T
99 NEXT J:NEXT I
100 IF L<>6 THEN 107
101 FOR I=1 TO 6
102 IF H9(I)<>I THEN 107
103 NEXT I
104 S=S+1000
105 D=0
106 GOTO 121
107 C=1
108 IF C>L THEN 121
109 IF C+2>L THEN 117
110 FOR C9=C TO C+1
111 IF H9(C9)<>H9(C9+1) THEN 117
112 NEXT C9
113 S=H9(C)*100+S
114 IF H9(C)=1 THEN S=S+900
115 C=C+3:D=D-3
116 GOTO 108
117 IF H9(C)=5 THEN S=S+50:D=D-1
118 IF H9(C)=1 THEN S=S+100:D=D-1
119 C=C+1
120 GOTO 108
121 IF S=S9 THEN 126
122 S9=S
123 IF D<>0 THEN 49
124 PRINT "ALL DIE SCORED, YOU GET 6 MORE DIE TO CONTINUE"
125 D=6:GOTO 50
126 S=0
127 PRINT " *** ZILCH ***"
128 FOR W5=1 TO 300 : NEXT W5
129 REM
130 IF S1(N)<>0 THEN 132
131 IF S<500 THEN 133
132 S1(N)=S1(N)+S
133 IF S8<>0 THEN 135
134 IF S1(N)>4999 THEN S8=N
135 NEXT N
136 GOTO 42
137 PRINT:PRINT:PRINT
138 Q=0
139 FOR I=1 TO N1
140 PRINT N9$(I);" HAS A SCORE OF ";S1(I)
141 IF S1(I)>Q THEN Q1=I:Q=S1(I)
142 NEXT I
143 PRINT:PRINT N9$(Q1);" HAS WON THIS GAME"
144 GOTO 145
145 A$="Y":INPUT "WOULD YOU LIKE TO PLAY AGAIN";A$
146 IF LEN(A$)=0 THEN A$="Y"
147 IF LEFT$(A$,1)="Y" THEN 25
148 END
149 PRINT:PRINT:PRINT:PRINT
150 PRINT " ZILCH"
151 PRINT " BY MORRIE WILSON"
152 PRINT
153 PRINT
154 PRINT
155 PRINT "THIS IS THE GAME OF ZILCH. IT IS A DICE GAME FOR 1 TO 9 PLAYERS."
156 PRINT "THE OBJECT OF THE GAME IS TO ROLL DIE, AND GAIN THE MOST POINTS"
157 PRINT "DURING THE COURSE OF THE GAME. IN ORDER TO WIN, A COMBINATION OF"
158 PRINT "BOTH LUCK AND STRATEGY IS NECESSARY. WHAT YOU ROLL IS LUCK, BUT"
159 PRINT "WHAT YOU DO WITH YOUR ROLL IS STRATEGY. NOW FOR THE DETAILS"
160 PRINT
161 PRINT "PRESS RETURN TO CONTINUE";:INPUT A$
162 FOR I=1 TO 25:PRINT:NEXT I
163 PRINT
164 PRINT "THE PLAY ROTATES AMONGST THE PLAYERS, WITH EACH PLAYER"
165 PRINT "COMPLETING A SERIES OF ROLLS WHICH COMPRISE HIS TURN."
166 PRINT
167 PRINT "A TURN CONSISTS OF STARTING OUT WITH SIX DIE. ALL OF THEM ARE"
168 PRINT "ROLLED. THE DIE ARE THEN EXAMINED, AND SOME OF THE DIE THAT"
169 PRINT "HAVE POINTS ARE PULLED FROM THE PLAY, WITH THE POINTS REPRESENTED"
170 PRINT "BEING ADDED TO A PLAYER'S TURN TOTAL. THE PLAYER THEN ROLLS"
171 PRINT "THE REMAINING DIE. THE PLAYER CONTINUES TO ROLL AND PULL DIE"
172 PRINT "UNTIL IT IS FELT THAT TO CONTINUE TO DO SO WILL RESULT IN A ZILCH."
173 PRINT "IF A PLAYER ROLLS THE DIE AND FINDS THAT NONE OF DIE HAVE POINTS"
174 PRINT "SHOWING, THEN THE PLAYER HAS ZILCHED, AND LOSES ALL POINTS THAT"
175 PRINT "HE HAS ACCUMULATED DURING THE CURRENT TURN. NOTE THAT POINTS"
176 PRINT "FROM PREVIOUS TURNS ARE NOT AFFECTED. CONFUSING, ISN'T IT?"
177 PRINT "WELL PLAY A FEW TIMES AND THEN IT WILL BECOME OBVIOUS."
179 PRINT
180 PRINT "PRESS RETURN TO CONTINUE";:INPUT A$
181 FOR I=1 TO 25:PRINT:NEXT I
182 PRINT "A PLAYER MUST GET AT LEAST 500 POINTS IN ONE TURN"
183 PRINT "TO GET INTO THE GAME. AFTER THE INITIAL 500 POINTS IS"
184 PRINT "OBTAINED, THERE IS NO MINIMUM NUMBER OF POINTS NECESSARY TO
185 PRINT "ACCUMULATE MORE POINTS.
186 PRINT
187 PRINT "IF A PLAYER SCORES ON ALL SIX OF THE ORIGINAL DIE, SIX MORE"
188 PRINT "DIE ARE GIVEN TO OBTAIN ADDITIONAL POINTS (BUT WATCH OUT"
189 PRINT "FOR ZILCHING)."
190 PRINT
191 PRINT "WHENEVER A PLAYER GET 5000 OR MORE POINTS, ALL THE OTHER PLAYERS"
192 PRINT "GET ONE MORE TURN TO TRY TO BEAT THE HIGHEST SCORE. THE PLAYER"
193 PRINT "WITH THE HIGHEST SCORE WINS."
194 PRINT
195 PRINT "THE COMPUTER CAN ALSO ACT AS ONE OF THE PLAYERS, IF YOU LET HIM."
196 PRINT "<WALTER>, THE COMPUTER WILL ASK IF HE CAN PLAY LATER."
197 PRINT:PRINT:PRINT "PRESS RETURN TO CONTINUE";:INPUT A$
198 FOR I=1 TO 25:PRINT:NEXT I
199 GOSUB 204
200 PRINT "DURING THE PLAY OF THE GAME, A QUESTION MARK WILL GET YOU A "
201 PRINT "LISTING OF HOW THE DIE SCORE AGAIN."
202 PRINT:PRINT:PRINT:PRINT:PRINT
203 RETURN
204 PRINT "SCORING"
205 PRINT
206 PRINT "5 - 50 POINTS 1 - 100 POINTS"
207 PRINT "2 : 2 : 2 - 200 POINTS 3 : 3 : 3 - 300 POINTS"
208 PRINT "4 : 4 : 4 - 400 POINTS 5 : 5 : 5 - 500 POINTS"
209 PRINT "6 : 6 : 6 - 600 POINTS 1 : 1 : 1 - 1000 POINTS"
210 PRINT
211 PRINT "1 : 2 : 3 : 4 : 5 : 6 - (IN 1 ROLL, IN ANY ORDER) 1000 POINTS"
212 PRINT:PRINT "A RETURN WILL ALWAYS GIVE YOU THE MAXIMUM POINTS POSSIBLE"
213 PRINT:PRINT:PRINT:RETURN


23
software/BAS/asciart.bas
View File

@@ -1,23 +0,0 @@
1 REM asciiart.bas benchmark for Rienk's sbc-2g-512 7.3728Mhz Z80 board running NASCOM ROM BASIC Ver 4.7
2 REM https://www.retrobrewcomputers.org/forum/index.php?t=msg&th=201&goto=4704&#msg_4704
3 REM 2m43s
4 REM
10 FOR Y=-12 TO 12
20 FOR X=-39 TO 39
30 CA=X*0.0458
40 CB= Y*0.08333
50 A=CA
60 B=CB
70 FOR I=0 TO 15
80 T=A*A-B*B+CA
90 B=2*A*B+CB
100 A=T
110 IF (A*A+B*B)>4 THEN GOTO 200
120 NEXT I
130 PRINT " ";
140 GOTO 210
200 IF I>9 THEN I=I+7
205 PRINT CHR$(48+I);
210 NEXT X
220 PRINT
230 NEXT Y

BIN
software/BAS/cosubs.bas
View File

Binary file not shown.

BIN
software/BAS/daycash.bas
View File

Binary file not shown.

BIN
software/BAS/daycash2.bas
View File

Binary file not shown.

BIN
software/BAS/daycash3.bas
View File

Binary file not shown.

BIN
software/BAS/daycashp.bas
View File

Binary file not shown.

BIN
software/BAS/daycred.bas
View File

Binary file not shown.

BIN
software/BAS/daycredp.bas
View File

Binary file not shown.

BIN
software/BAS/daycrin.bas
View File

Binary file not shown.

BIN
software/BAS/daycrin2.bas
View File

Binary file not shown.

BIN
software/BAS/daycrin3.bas
View File

Binary file not shown.

BIN
software/BAS/dayi.bas
View File

Binary file not shown.

BIN
software/BAS/dayicni1.bas
View File

Binary file not shown.

BIN
software/BAS/dayicni2.bas
View File

Binary file not shown.

BIN
software/BAS/dayicni3.bas
View File

Binary file not shown.

BIN
software/BAS/daymend.bas
View File

Binary file not shown.

BIN
software/BAS/daymisc.bas
View File

Binary file not shown.

BIN
software/BAS/daymisc2.bas
View File

Binary file not shown.

BIN
software/BAS/daymisc3.bas
View File

Binary file not shown.

BIN
software/BAS/daymisc4.bas
View File

Binary file not shown.

BIN
software/BAS/daymiscp.bas
View File

Binary file not shown.

BIN
software/BAS/daynlup.bas
View File

Binary file not shown.

BIN
software/BAS/daynlup2.bas
View File

Binary file not shown.

BIN
software/BAS/dayparam.bas
View File

Binary file not shown.

BIN
software/BAS/dayplvat.bas
View File

Binary file not shown.

BIN
software/BAS/dayprt.bas
View File

Binary file not shown.

BIN
software/BAS/dayslvat.bas
View File

Binary file not shown.

61
software/BAS/gpeled.bas
View File

@@ -1,61 +0,0 @@
01 REM ************************************************
02 REM
03 REM Z80-MBC2 GPE led blink demo:
04 REM
05 REM Blink a led attached to PIN 8 (GPA5) of the GPIO
06 REM connector (J7) until USER key is pressed
07 REM (see A040618 schematic).
08 REM The GPE option must be installed.
09 REM
10 REM ************************************************
11 REM
12 REM Demo HW wiring (see A040618 schematic):
13 REM
14 REM GPIO
15 REM (J7)
16 REM +-----+
17 REM | 1 2 |
18 REM | 3 4 | LED RESISTOR
19 REM | 5 6 | 680
20 REM | 7 8-+--->|-----------/\/\/--+
21 REM | 9 10| |
22 REM |11 12| |
23 REM |13 14| |
24 REM |15 16| |
25 REM |17 18| |
26 REM |19 20+-----------------------+ GND
27 REM +-----+
28 REM
29 REM ************************************************
30 REM
31 PRINT "Press USER key to exit"
32 REM
33 REM * * * * SET USED OPCODES FOR I/O
34 REM
35 KEYUSER = 128 : REM USER KEY read Opcode (0x80)
36 IODIRA = 5 : REM IODIRA write Opcode (0x05)
37 GPIOA = 3 : REM GPIOA write Opcode (0x03)
38 REM
50 OUT 1,IODIRA : OUT 0,0 : REM Set all GPAx as output (IODIRA=0x00)
60 PRINT "Now blinking GPA5 (GPIO port pin 8)..."
64 REM
65 REM * * * * * BLINK LOOP
66 REM
70 OUT 1,GPIOA : OUT 0,32 : REM Set GPA5=1, GPAx=0 (GPIOA=B00100000=32)
80 GOSUB 505 : REM Delay sub
90 OUT 1,GPIOA : OUT 0,0 : REM Clear all pins GPAx (MCP23017)
100 GOSUB 505 : REM Delay sub
130 GOTO 70
490 REM
500 REM * * * * * DELAY SUB
501 REM
505 FOR J=0 TO 150
506 OUT 1,KEYUSER : REM Write the USER KEY read Opcode
507 IF INP(0)=1 THEN GOTO 700 : REM Exit if USER key is pressed
510 NEXT J
520 RETURN
690 REM
691 REM * * * * * PROGRAM END
692 REM
700 OUT 1,GPIOA : OUT 0,0 : REM Clear all pins GPAx (MCP23017)
720 PRINT "Terminated by USER Key"

82
software/BAS/gpio.bas
View File

@@ -1,82 +0,0 @@
1 REM * * * GPIO EXPANSION MODULE (A080117) DEMO * * *
2 REM
3 REM (USER Key -> slow led, GPIO-A(9) Key -> fast led)
4 REM --------------------------------------------------
5 REM Demo HW wiring (see A080117 schematic):
6 REM
7 REM GPIO-B
8 REM (J3)
9 REM +----+ LED
10 REM | 2 |--->|---+
11 REM | 3 |--->|---+ RESISTOR
12 REM | 4 |--->|---+ 680
13 REM | 5 |--->|---+-------/\/\/-----o GND
14 REM | 6 |--->|---+
15 REM | 7 |--->|---+
16 REM | 8 |--->|---+
17 REM | 9 |--->|---+
18 REM +----+ |
19 REM |
20 REM |
21 REM GPIO-A |
22 REM (J4) |
23 REM +----+ LED |
24 REM | 2 |--->|---+
25 REM | 3 |--->|---+
26 REM | 4 |x
27 REM | 5 |x
28 REM | 6 |x
29 REM | 7 |x PUSH BUTTON RESISTOR
30 REM | 8 |x --- 1K
31 REM | 9 |---------o o------------------/\/\/-----o GND
32 REM +----+
33 REM
34 REM
35 REM
36 REM --------------------------------------------------
37 REM
38 REM Set MCP23017 GPIOB all pins as output (IODIRB=0x00)
39 OUT 6, 0
40 REM Set MCP23017 GPIOA 0-1 as output, others as input (IODIRA=0xFC)
41 OUT 5, 252
42 REM Set MCP23017 GPIOA 2-7 pull-up resistor on (GPPUA=0xFC)
43 OUT 7, 252
45 REM Left Shift user funcion definition
50 DEF FNLSH(X)=((X*2) AND 255)
55 REM Init GPIO output ports
60 OUT 3, 0 : REM Clear MCP23017 GPIOA port
62 OUT 4, 0 : REM Clear MCP23017 GPIOB port
64 GOSUB 700 : REM Set slow shift
68 REM Main
70 A=1
80 FOR I=0 TO 7
90 OUT 4, A : REM Write to MCP23017 GPIOB port
100 GOSUB 500
110 A=FNLSH(A)
120 NEXT I
130 OUT 4, 0 : REM Clear MCP23017 GPIOB port
135 A=1
140 FOR I=0 TO 1
150 OUT 3, A : REM Write to MCP23017 GPIOA port
160 GOSUB 500
170 A=FNLSH(A)
190 NEXT I
200 OUT 3, 0 : REM Clear MCP23017 GPIOA port
210 GOTO 70 : REM Play it again, Sam...
220 REM
500 REM * * * * * DELAY SUB
505 FOR J=0 TO K
507 IF INP(0)=1 THEN GOSUB 700 : REM Read USER key
508 IF (INP(3) AND 128)=0 THEN GOSUB 600 : REM Read MCP23017 GPIOA 7 key
510 NEXT J
520 RETURN
530 REM
600 REM * * * * * SET FAST SHIFT SUB
610 K=1
620 OUT 0, 1 : REM USER led ON
630 RETURN
640 REM
700 REM * * * * * SET SLOW SHIFT SUB
710 K=30
720 OUT 0, 0 : REM USER led OFF
730 RETURN

31
software/BAS/lander.bas
View File

@@ -1,31 +0,0 @@
10 REM Lunar lander program.
20 LET dist = 100
30 LET v = 1
40 LET fuel = 1000
50 LET mass = 1000
60 PRINT "You are a in control of a lunar lander."
70 PRINT "You are drifiting towards the surface of the moon."
80 PRINT "Each turn you must decide how much fuel to burn."
90 PRINT "To accelerate enter a positive number, to decelerate a negative"
100 PRINT "Distance", dist, "km", "velocity", v, "km/s", "Fuel", fuel
110 INPUT burn
115 IF ABS(burn) <= fuel THEN 120
116 PRINT "You don't have that much fuel"
117 GOTO 100
120 LET v = v + burn * 10 / (fuel + mass)
130 LET fuel = fuel - ABS(burn)
140 LET dist = dist - v
150 IF dist > 0 THEN 100
160 PRINT "You have hit the surface"
170 IF v < 3 THEN 210
180 PRINT "Hit surface too fast (", v,")km/s"
190 PRINT "You Crash"
200 GOTO 220
210 PRINT "Well done"
220 REM END

31
software/BAS/median.bas
View File

@@ -1,31 +0,0 @@
10 REM Median program.
20 LET N = 0
30 DIM array(N+1)
40 PRINT "Enter a number, q to quit"
50 INPUT line$
60 IF line$ = "q" THEN 100
70 LET N = N + 1
80 LET array(N) = VAL(line$)
90 GOTO 30
100 PRINT N, "numbers entered"
105 IF N = 0 THEN 1000
106 IF N = 1 THEN 210
110 REM Bubble sort the numbers
120 LET flag = 0
130 LET i = 1
140 IF array(i) <= array(i+1) THEN 190
150 LET flag = 1
160 LET temp = array(i)
170 LET array(i) = array(i+1)
180 LET array(i+1) = temp
190 LET i = i + 1
195 IF i < N THEN 140
200 IF flag = 1 THEN 120
210 REM print out the middle
220 IF N MOD 2 = 0 THEN 250
230 LET mid = array( (N + 1) / 2)
240 GOTO 270
250 LET mid = array(N/2) + array(N/2+1)
260 LET mid = mid/2
270 PRINT "Median", mid
1000 REM end

BIN
software/BAS/menu.bas
View File

Binary file not shown.

53
software/BAS/name.bas
View File

@@ -1,53 +0,0 @@
10 REM String-handling program
20 REM Inputs a name, tests for validity
30 REM and breaks up into parts.
40 PRINT "Enter your full name"
50 INPUT name$
60 REM First check for non-English characters
70 LET flag = 0
80 FOR I = 1 TO LEN(name$)
90 LET ch$ = MID$(name$, I,1)
100 IF (ch$ >= "A" AND ch$ <= "z") OR ch$ = " " THEN 140
110 LET flag = 1
120 REM This forces the loop to stop
130 LET I = LEN(name$)
140 NEXT I
150 IF flag = 0 THEN 180
160 PRINT "Non-English letter,", ch$
170 GOTO 40
180 REM Jump to subroutine
190 LET return = 210
200 GOTO 1000
210 IF name$ = "" THEN 280
220 LET return = 240
230 GOTO 2000
240 LET N = N + 1
250 DIM out$(N)
260 LET out$(N) = word$
270 GOTO 180
280 REM Print out the name
285 PRINT "Name accepted"
290 FOR I = 1 TO N
300 PRINT out$(I) + " ";
310 NEXT I
320 PRINT ""
330 GOTO 3000
1000 REM strips the leading space
1010 IF LEFT$(name$, 1) <> " " THEN return
1020 LET name$ = MID$(name$, 2, -1)
1030 GOTO 1010
2000 REM get the leading word and put it in word$
2010 LET word$ = ""
2020 LET ch$ = LEFT$(name$, 1)
2030 IF ch$ < "A" OR ch$ > "z" THEN return
2040 LET word$ = word$ + ch$
2050 LET name$ = MID$(name$, 2, -1)
2060 GOTO 2020
3000 REM END

BIN
software/BAS/nlbudge.bas
View File

Binary file not shown.

BIN
software/BAS/nlenq.bas
View File

Binary file not shown.

BIN
software/BAS/nlformat.bas
View File

Binary file not shown.

BIN
software/BAS/nlformup.bas
View File

Binary file not shown.

BIN
software/BAS/nljnl.bas
View File

Binary file not shown.

BIN
software/BAS/nljnl2.bas
View File

Binary file not shown.

BIN
software/BAS/nlmfup.bas
View File

Binary file not shown.

BIN
software/BAS/nlprint.bas
View File

Binary file not shown.

BIN
software/BAS/nltb.bas
View File

Binary file not shown.

Some files were not shown because too many files have changed in this diff Show More