< Persönlich
< Persönlich: Projects
> Intro
> Hardware
> Manual
> Interfacing
• Terminal
|
|
— Projects: UZE, Terminal —
The UZE Terminal Manual
The UZETERM (Universal Z80 Engine Terminal) program was developped
to give the UZE software designer a powerful test and debugging tool. The UZE
Bare-Bones-BIOS has utilities built in to accept new software and data through
the D(ownload command. Results can be analyzed by U(ploading parts of memory.
The use of these housekeeping commands is, however, rather awkward particularly
if software is under developement.
With the UZETERM terminal programm, a couple of tools make life easier.
Software and data can be downloaded from disk files and uploaded data can be stored
in disk files as well. UZE system variables can be examined and even modified.
Parts of memory may be dumped in hex-ascii-format on the host computer screen —
and much more.
Status bar
The top line of the screen shows a status line with 10 subdivisions.
This status bar cannot be removed. In colour display mode, the active items are
shown in black on cyan and the inactive ones in light gray. On monochrome
displays, inactive items cannot be seen clearly.
-
-
- UZE Terminal: This entry is always activated and reminds the user that
the UZETERM is active (exception: the Graph option ^G temporarily hides
the status bar).
- 9600,N,8,1: This entry is always active and indicates that the connection
is made with 9600 Baud, no parity, eight data bits and one stop bit. This is
the UZE default serial mode.
- filename.typ: Is only activated, if a disk file is open, either for read
or write. Here, no file is open.
- Rcv: (receive). This field is activated whenever UZETERM receives data
from the UZE.
- Xmt: (transmit).This field is activated whenever the UZETERM sends data
to the UZE.
- Log: This field is activated, if a log-file is open and appending is
active.
- Dsk: (disk). This field is active whenever data are read from, or written
to, a disk file.
- echo::Locl: Actually, only "Locl" can change from active to passive. Version
1.02 of UZETERM could toggle the local and distant echo, but this feature was
never actually used. Local echo is always active.
- echo:Dist: The distant echo is always activated, see "echo:Locl".
- ^H=Hlp: (Help). This last field is always activated and should remind the
user, that he can switch on the command list by simmultaneously pressing the
[Ctrl] and [H] keys (see below).
Commands
With the ^H-command, a help screen can be either displayed or removed
from screen. All commands are accessible from the UZETERM wether the command list
is displayed or not. The command list occupies the 2nd through the 8th display lines.
When displayed, the UZE-window is only 16 lines high, when hidden, 7 lines of display
can be gained. Note that when 256 bytes are dumped on the screen, the 1st line is lost,
because it scrolls under the command display.
-
^H – Toggle Help & CLS
Upon startup, the command or help field is displayed. It can be switched off to gain
another 7 lines on the screen. When this window is swithed off, the screen is cleared
and only the status bar remains visible. When the window is not displayed,
^H-command brings it back on. This also clears the whole screen. The most right
field of the status bar should remind the user, how to bring back the commands screen.
^R – Receive to Disk
The user is prompted to supply a valid filename, the start address in memory and the
number of bytes to be uploaded by the UZE and written to the disk file. This option
makes use of the U-command: U<addr>,<bytes>. The uploaded data is written
to the disk file in binary.
^T – Transmit from Disk
The user is prompted to supply the filename and the load address in the UZE of the
disk file data to be transmitted. UZETERM calculates the number of bytes. This option
makes use of the D-command: D<addr>,<bytes>. New programs can be written
and assembled to a disk file and then loaded from the disk file into the UZE-system
with this option.
^L – Toggle Session Log
It is possible to open a session log file. What is displayed on the UZETERM screen
will be written to a disk file. Uploads can be directed to the log file. If a part
of the UZE-memory is dumped, the hex-ascii lines are written to the logging disk
file. This may make analysing data more easy.
The first time, ^L is used, the user is prompted to supply a session log
file name.If a session log is already open, writing to it can be suspended with ^L.
The status bar indicates, whether the data on the screen will be written to it or not.
This makes it possible to have selected data written to the session log. If the log is
toggled back on, the new data is appended.
^C – Close Log File
With this option, an open session log is closed permanently. If the session log is
reopened with ^L, a new filename must be given and a new session log is opened.
^G – Graph 2 x 256 bytes
The user is prompted to give the starting address in UZE-memory. From this address,
512 bytes are uploaded into the terminal, using the U-command: U,512. The data
is displayed in graphics mode on the screen. CGA-, EGA- and VGA-graphics adapters are
supported.
Two square frames are painted on the screen, each with a side length of 256
dots. The frames have 4 subdivisions on each axis (0%, 25%, 50%, 75%, 100%). The leftmost
dot in the left square represents the value of the address given by the user, the leftmost
dot in the right square represents the address given+256. Thus, the horizontal line shows
the memory location of the data progressing to the right with higher addresses.
-
The vertical axis represents the byte value at the memory location represented
on the horizontal axis. The higher the value, the higher on the screen the dot is painted.
This option is particularly usefull for analysing functions and sampled values as done
by ADA-950225. Any key may be pressed to return to the terminal mode. If the Help-Screen
was active prior the activation of the ^G-option, it will be redrawn, otherwise it will
stay hidden.
^D – Display 2 x 256 bytes
The user is prompted to give the starting address in UZE-memory. 512 bytes are uploaded
with the use of the U-command: U<addr>,512. The first 256 bytes are displayed as
a ascii decimal table of 16 values per row and 16 lines. After pressing any key, the
second set of 256 bytes are displayed in table form. Another keystroke returns to the
terminal mode. If the Help-screen was on before the ^D-option was requested, it
will be redrawn.
-
^W – List defined Words
UZE version 2.xx features the execution of procedures by names through the extended
A-command. In order to know which words are defined, this option has been introduced.
It makes use of the extended A-command: ALIST,N. The uploaded list of names is
formatted so that no word is warped at the end of the screen. If the command ALIST,N.
would be used directly, words not fitting on the screen would be cut at the end of the
line and would continue on the next one.
^F – Show File Directory
This option displays the available filenames. The user is prompted to specify the
drive, path and search mask. If none is entered, all files on the currently active
drive in the current directory are displayed along with the remaining space on the
disk. Example: D:\TELECOM\UZE\*.DTA would show all files in the subdirectory UZE
from the directory TELECOM on drive D with a file extension of DTA.
^Q – QUIT (or [ESC])
This is probably the most important option of UZETERM. Pressing [Ctrl][Q] or [ESC]
closes all opened files (session log, up- or download files) and returns to the
operating system.
^U – UZE Version
This command makes use of the public subroutine WhoWho within the UZE-BB-BIOS. It
searches for the last version number in the EPROM, uploads and displays it. The
H-command returns a colon (:) even if an application is running. The ^U-option
does return the version only if no task is running. Thus, this option can be used to
test whether a task has been terminated or not. Of course, if there are still other
tasks pending to run on the instruction queue return stack, ^U will only return
the version number when it is its turn. Below a screenshot after executing
^U-command.
-
^P – Extended Version
With version 2.xx, the UZE-BB-BIOS features the extended A-commands. The first word
defined must be VER. This option makes use of this: AVER. and displays the actual
version.
^V – View Memory
This option requests from the user the starting address and the number of bytes.
The specified number of bytes are dumped from the specified memory address in
hex-ascii form. Each line has 16 bytes as hex converted values and the 16 ascii
characters they represent. When the Help-screen is activated, the screen can hold
only the last 15 lines received from the UZE. If more than 240 bytes are to be dumped,
the Help screen should be toggled off (^H). Good practice would be to never dump more
than 256 bytes at a time, even with the Help screen off.
^A – Adresses
This option displays the names of the defined public subroutines with their respective
call entry points i.e. addresses See the M-command in the UZE User's guide on how these
addresses may be of use.
^S – System Variables
This last option identifies the system variables and the system bytes with their
names and respective values in decimal at the time of the request. There is the
extended A-command RETVAR that also uploads the names, but differently. There,
only the main variable names are shown and an offset to the required subvariable
must be stated. Note that the ^S option itself alters some of the system
variables.
Bugs
UZETERM has still an unidentified bug: sometimes when an unavailable file
is attempted to be opened, the next attempt on a file manipulation will halt UZETERM
with an unrecoverable fault. UZETERM should be restarted in such a case. The exact
description of what manipulation(s) with UZETERM that led to the error is greatly
appreciated.
If the UZE-system does not report ready, the connection to the UZE-system
should be checked, assured power is on and the system works properly and is not lost
in any obscure loop, i.e. the UZE-system is in proper working condition. It is
sometimes advisable to restart UZETERM when the fault has been fixed.
Complete PowerBASIC Source Listing of the UZE Terminal.
I started programming with BASIC and Assembler and also used several other
programming languages (FORTH, Pascal, Fortran, etc.) but stayed with BASIC because it
is less abstract and nearer to the machine than other high level languages.
-
- BASIC dialects are still The language to program professional test and
measuring instruments.
- BASIC came a long way since its invention at the Dartmouth Collage in
1962 and evolved enormously.
- There is no need anymore to write «Spaghetti-Code», though you still
could (but nobody who is anybody in programming would).
- There are incredibly fast compilers at modest prices available that
generate code that runs fast and with a small memory footprint.
BASIC code is usually written in uppercase. I do not. Uppercase text
is more difficult to read, otherwise books would not be typset in mixed case.
I type all reserved words that belong to the language in lowercase. Variables,
procedures and functions I define begin with a capital letter.
Indenting is usually by 4 characters. This is, in my opinion, too much.
I indent only by 2 characters. I keep line length limitted to 80 characters, except
when this is not possible or does not seem to be a good idea considering the context.
UZETERM.BAS
This is the main programm. It makes use of a couple of predefined functions
and procedures that are precompiled as a unit. The include file is included, however.
Some characters that cannot be displayed in HTML have been replaced for better readability.
It is obvious, that you cannot use this code directly. A usable file can be found under
Projects > Resources.
'010701 1505
'***************************************************************************
'* PROGRAM NAME: UZETERM .BAS DATE: 31.12.1994 INCLUDE IN: is main *
'* LANGUAGE: Power BASIC 3.50 Robert S.Zale *
'* PURPOSE: Small terminal program for UZE *
'* INCLUDE FILES: ERROR3 .INC Fatal error handler *
'* OBJECT FILES: PB3GPUSE.PBU General purpose functions and procedures. *
'* INPUT FILES: filename.typ received from UZE *
'* OUTPUT FILES: filename.typ transmitted to UZE *
'* filename.typ log *
'* ----------------------------------------------------------------------- *
'* VERSION: 2.10 1-JUL-01 Supporting COM-Ports 1 thru 4 by querying. *
'* Compiled for 80386 and PB 3.5, removed Hercules support. *
'* ----------------------------------------------------------------------- *
'* VERSION: 2.01 9-NOV-95 Added graphics display & changed menue. *
'* Addapted for UZE V.2.xx *
'* ----------------------------------------------------------------------- *
'* VERSION: 1.00 2-JAN-95 Made it actually work for UZE V.1.02 *
'* ----------------------------------------------------------------------- *
'* COMMENTS: *
'* ======================================================================= *
'* AUTHOR: Hans-Ruedi H. Wernli, Pletschgasse, CH-3952 Susten, Switzerland.*
'***************************************************************************
'
'
' COMPILER DIRECTIVES
'---------------------------------------------------------------------------
'
'$alias data as "DSEG" 'or data segment name as used in .OBJ
'$code seg "CODE" 'or code segment name as used in .OBJ
'$huge 'for arrays > 64K
$cpu 80386 '8086/80286/80386
$debug map off 'on/off
$debug path off 'on/off
$debug unit off 'on/off
$debug pbdebug off 'on/off
$dim array 'all/array/none
$dynamic '$static
$error all off 'bounds/numeric/overflow/stack/all on/off
$event off 'on/off
$float procedure 'emulate/npx/procedure
$lib com+,lpt-,graph+,cga+,ega+,vga+,fullfloat-,iprint-
$optimize speed 'size/speed
$option cntlbreak off 'cntlbreak/gosub on/off
$stack 4096 '1536...32767
$com 32767 '0...32767
$sound 1 '1...4096
$string 32 '1//4/8/16/32
$compile exe 'memory/exe/chain/unit
'
'
' CONSTANTS CPU, COLORS, LOGIC
'---------------------------------------------------------------------------
'
%FLAGS = 0 'CPU registers
%AX = 1
%BX = 2
%CX = 3
%DX = 4
%SI = 5
%DI = 6
%BP = 7
%DS = 8
%ES = 9
'
%Black = 0 'COLORS, dark
%Blue = 1
%Green = 2
%Cyan = 3
%Red = 4
%Pink = 5
%Brown = 6
%White = 7
%Gray = 8 'COLORS, light
%LBlue = 9
%LGreen = 10
%LCyan = 11
%LRed = 12
%LPink = 13
%Yellow = 14
%LWhite = 15
'
%False = 0 'logic
%True = not %False
'
'
' Application specific constants
'---------------------------------------------------------------------------
'
%DPP = 29 'Defined Public Procedures ----> Data statements
%DSV = 42 'Sefined System Variables
%DSB = 14 'Defined System Bytes
%DSN = 58 'Defined System Names
'
%VBIOS = 16 'Graphics
%CGA = 2
%EGA = 9
%VGA = 12
'
%UnitUZE = 1 'Units
%UnitRDF = 2
%UnitWRF = 3
%UnitLOG = 4
'
English% = %True 'TRUE = English, FALSE = German
Chroma% = %True 'TRUE if colors available (for ERROR3.INC)
on error goto NoJob
'
'
' Function and Procedure Declaration in external units: PB3GPUSE.INC/PBU
'---------------------------------------------------------------------------
'
declare function Center$(string,integer)
declare function LogOn$(string,integer,integer)
'
'
' OBJECTS AND UNITS TO BE LINKED IN
'===========================================================================
'
$link "PB35GPUS.PBU"
'
'
' INCLUDE FILES
'===========================================================================
'
$include "ERROR3.INC"
'
'
' FUNCTIONS
'===========================================================================
'
' FUNCTION converts string to binary
'---------------------------------------------------------------------------
'
function WordVal??(A$)
local A%,B%
A% = asc(left$(A$,1))
B% = asc(right$(A$,1))
WordVal?? = B% * 256 + A%
end function
'
'
' FUNCTION returns COM-Port. If Port number not [1;4] returns 1.
'---------------------------------------------------------------------------
'
function QueryComPort%()
local A$,P%
print "> Input COM-Port (1...4): ";
input A$
if A$ = "" then
P% = 1
else
P% = val(A$)
if P% < 1 then P% = 1
if P% > 4 then P% = 1
end if
QueryComPort$ = P%
end function
'
'
' PROCEDURES
'===========================================================================
'
' PROCEDURE writes upload to file. If a file was already open, it is
' closed and a new file name must be given
'---------------------------------------------------------------------------
'
sub ToFile(I$,F$,Flax%(),ErrFlag%)
local L%,B&,S&,C$,Q$,Z$
I$ = ""
print
color %Cyan,%Black
line input "Name of file to write to: ";Q$
F$ = ucase$(Q$)
open F$ for output as #%UnitWRF
if istrue ErrFlag% then
ErrFlag% = 0
F$ = ""
I$ = ""
color %White,%Black
beep
cls
exit sub
end if
line input "Start address for upload (decimal): ";Z$
line input "Number of bytes to upload: ";Q$
C$ = "U" + Z$ + "," + Q$ + "."
print# %UnitUZE, C$;
print C$;" wait ..."
B& = val(Q$)
S& = 0
Flax%(4) = 1
Flax%(5) = 1
call UpStat(Flax%(),F$)
while S& < B&
if loc(%UnitUZE) > 0 then
Q$ = input$(loc(%UnitUZE),#%UnitUZE)
print# %UnitWRF, Q$;
S& = S& + len(Q$)
end if
wend
close %UnitWRF
Flax%(4) = 0
Flax%(5) = 0
F$ = ""
color %White,%Black
beep
cls
end sub
'
'
' PROCEDURE writes upload to file. If a file was already open, it is
' closed and a new file name must be given
'---------------------------------------------------------------------------
'
sub ToLog(I$,Flax%(),F$,ErrFlag%)
local Q$
I$ = ""
print
color %Cyan,%Black
if istrue Flax%(1) then
Flax%(1) = 0
close %UnitLOG
print "> Closed: ";F$
F$ = ""
end if
Flax%(1) = 1
line input "Name of Log-File: ";Q$
F$ = ucase$(Q$)
open F$ for append as #%UnitLOG
if istrue ErrFlag% then
ErrFlag% = 0
F$ = ""
I$ = ""
Flax%(1) = 0
color %White,%Black
beep
cls
exit sub
end if
print "Log open ";F$
delay 1
color %White,%Black
call UpStat(Flax%(),"")
cls
end sub
'
'
' PROCEDURE prints data uploaded onto screen. Upload is assumed to be
' in ascii with embedded cr/lf. If a cr is detected, a new line
' is issued. The lf-character is omitted. All other bytes are
' issued. The Select-Case can be enlarged to filter unprintable
' codes.
'---------------------------------------------------------------------------
'
sub ToScreen(T$)
local N%,A$
color %White,%Black
for N% = 1 to len(T$)
A$ = mid$(T$,N%,1)
select case A$
case chr$(13)
print
case chr$(10)
case else
print A$;
end select
next N%
end sub
'
'
' PROCEDURE reads file and sends it over to UZE
'---------------------------------------------------------------------------
'
sub FromFile(I$,Flax%(),F$,ErrFlag%)
local B%,N%,R%,S&,D$,V$,Z$,Q$
print
color %Cyan,%Black
line input "Name of file to read from: ";Q$
F$ = ucase$(Q$)
open F$ for binary as #%UnitRDF
if istrue ErrFlag% then
ErrFlag% = 0
F$ = ""
I$ = ""
color %White,%Black
beep
cls
exit sub
end if
S& = lof(%UnitRDF)
if S& > 0 then
line input "Enter UZE load start address in decimal: ";Z$
V$ = "D" + Z$ + "," + ltrim$(rtrim$(str$(S&))) + "."
print# %UnitUZE, V$;
print V$;" wait ...";
color %White,%Black
B% = S& \ 1024
R% = S& mod 1024
Flax%(6) = 1
call UpStat(Flax%(),F$)
cls
if not B% = 0 then
for N% = 1 to B%
get$ # %UnitRDF, 1024, D$
print# %UnitUZE, D$;
if istrue Flax%(3) and isfalse Flax%(4) then print D$;
next N%
end if
if not R% = 0 then
get$ # %UnitRDF, R%, D$
print# %UnitUZE, D$;
if istrue Flax%(3) and isfalse Flax%(4) then print D$
end if
else
color %Yellow,%Red
print " Filesize = 0. Aborted! "
color %White,%black
end if
close %UnitRDF
I$ = ""
F$ = ""
Flax%(6) = 0
color %White,%Black
beep
print
end sub
'
'
' PROCEDURE clears screen and issues command list. Flax(7) true=menu
'---------------------------------------------------------------------------
'
sub IssueHelp(I$,Flax%(),F$)
local N%,C%
I$ = ""
view text (1,2) - (80,24)
cls
Flax%(7) = abs(Flax%(7)-1)
if isfalse Flax%(7) then
color %Black,%White
color %Black,%White
print " +----+--------------------»";
print " +----+---------------------»";
print " +----+--------------» ";
print " | ^H | Toggle Help & CLS |";
print " | ^G | Graph 2 x 256 bytes |";
print " | ^U | UZE Version | ";
print " | ^R | Receive to Disk |";
print " | ^D | Displ 2 x 256 bytes |";
print " | ^P | Extended Ver | ";
print " | ^T | Transmit from Disk |";
print " | ^W | List defined Words |";
print " | ^V | View Memory | ";
print " | ^L | Toggle Session Log |";
print " | ^F | Show File Directory |";
print " | ^A | Addresses | ";
print " | ^C | Close Log-File |";
print " | ^Q | QUIT (or ESC) |";
print " | ^S | SysVariables | ";
print " +-------------------------+";
print " +--------------------------+";
print " +-------------------+ ";
print
view text (1,9) - (80,24)
else
view text (1,2) - (80,24)
end if
color %White,%Black
end sub
'
'
' PROCEDURE updates Status bar. Flax(7) true=menu
'---------------------------------------------------------------------------
'
sub UpStat(Flax%(),F$)
local A$
A$ = right$(space$(12)+F$,12)
color %Black,%Cyan
view text (1,1) - (80,1)
locate 1,1
print " | UZE Terminal |9600,N,8,1|";A$;"|rcv|xmt|log|dsk|echo:locl|";
print "distº^H=Hlp³ ";
call InsStat(Flax%(1),50%,"Log")
call InsStat(Flax%(2),63%,"Locl")
call InsStat(Flax%(3),68%,"Dist")
call InsStat(Flax%(4),54%,"Dsk")
call InsStat(Flax%(5),42%,"Rcv")
call InsStat(Flax%(6),46%,"Xmt")
color %White,%Black
if istrue Flax%(7) then
view text (1,2) - (80,7)
else
view text (1,9) - (80,24)
end if
end sub
'
'
' PROCEDURE returns all public addresses from UZE
'---------------------------------------------------------------------------
'
sub GetExAd(PSAddr??())
local I%,N%,A$
print# %UnitUZE, "U100,2."
delay 0.2
if loc(%UnitUZE) = 0 then
color %LRed,%Black
print "Receive Error: Vector to PubPro"
color %White,%Black
exit sub
end if
A$ = input$(loc(%UnitUZE),#%UnitUZE)
PSAddr??(0) = WordVal??(A$)
A$ = remove$(str$(PSAddr??(0)), any " ")
print# %UnitUZE, "U";A$;",52."
delay 0.2
if loc(%UnitUZE) = 0 then
color %LRed,%Black
print "Receive Error: PubPro List"
color %White,%Black
exit sub
end if
A$ = input$(loc(%UnitUZE),#%UnitUZE)
for N% = 1 to len(A$)/2
I% = (N%-1) * 2 + 1
PSAddr??(N%) = WordVal??(mid$(A$,I%,2))
next N%
end sub
'
'
' PROCEDURE returns all variables from UZE
'---------------------------------------------------------------------------
'
sub GetVars(SysVar??(),SysByt?())
local I%,N%,A$
print# %UnitUZE, "U65280,98.";
delay 0.5
if loc(%UnitUZE) = 0 then
color %LRed,%Black
print "Receive Error: SysVars & SysByts"
color %White,%Black
exit sub
end if
A$ = input$(loc(%UnitUZE),#%UnitUZE)
SysVar??(0) = 65280
for N% = 1 to %DSV
I% = (N%-1) * 2 + 1
SysVar??(N%) = WordVal??(mid$(A$,I%,2))
next N%
for N% = 1 to %DSB
I% = 84 + N%
SysByt?(N%) = asc(mid$(A$,I%,1))
next N%
end sub
'
'
' PROCEDURE inserts status
'---------------------------------------------------------------------------
'
sub InsStat(F%,C%,A$)
if istrue F% then color %Black,%Cyan else color %White,%Cyan
locate 1,C%
print A$;
end sub
'
'
' PROCEDURE is error message printer
'---------------------------------------------------------------------------
'
sub IssueErr(A$)
local X%,Y%
print
Y% = csrlin
X% = pos(Y%)
print : print : print
locate Y%,X%
color %Yellow,%Red
print Center$(A$,80);
color %LWhite,%Red
print Center$("Task aborted! Press a key to acknowledge message...",80);
locate Y%,X%
while not instat : wend
color %White,%Black
A$ = inkey$
cls
end sub
'
'
' PROCEDURE makes use of extended A-command LIST,N. and prints result
' formatted in such a manner, that words are not broken at end of line.
'---------------------------------------------------------------------------
'
sub ListDefWrd
local A$,B$,C$,A%,B%,C%,N%
color %White,%Black
print# %UnitUZE, "AList,N.";
delay 0.5
if loc(%UnitUZE) = 0 then
color %LRed,%Black
print "Receive Error: Defined Words"
color %White,%Black
exit sub
end if
C$ = input$(loc(%UnitUZE),#%UnitUZE)
A$ = remove$(C$, any chr$(10,13))
C% = len(A$)
do
if C% > 79 then
B$ = left$(A$,79)
A% = 79
do
if mid$(B$,A%,1) = " " then exit loop
decr A%
loop
print left$(B$,A%)
A$ = right$(A$,C%-A%)
C% = len(A$)
else
print left$(A$,C%-2);"."
exit loop
end if
loop
end sub
'
'
' PROCEDURE makes use of extended A-command VER(sion and issues string.
'---------------------------------------------------------------------------
'
sub ACmdVer
local A$
color %White,%Black
print# %UnitUZE, "AVer.";
delay 0.5
if loc(%UnitUZE) = 0 then
color %LRed,%Black
print "Receive Error: Ext-A Version"
color %White,%Black
exit sub
end if
A$ = input$(loc(%UnitUZE),#%UnitUZE)
print remove$(A$, any chr$(10,13))
end sub
'
'
' DISPLAY FUNCTIONS AND PROCEDURES (derived from FunctGen)
'===========================================================================
'
' FUNCTION returns highest possible supported video mode.
' If not VGA (HPXM) then EGA-256 (HPCS)
' If not EGA (HPCS) then CGA (Sharp, Olivetti) assumed
'---------------------------------------------------------------------------
'
function Video%
local V%,BL%,BH%
V% = 0
reg (%AX), &h1A00
call interrupt %VBIOS
BL% = reg(%BX) mod 256
if BL% = 8 then V% = %VGA
if V% = 0 then
reg (%AX), &h1200
reg (%BX), &h0010
call interrupt %VBIOS
BL% = reg(%BX) mod 256
if BL% = 3 then V% = %EGA else V% = %CGA
end if
Video% = V%
end function
'
'
' FUNCTION returns lowest value in $
'---------------------------------------------------------------------------
'
function FindLow%(S$)
local A%,L%,N%
L% = 255
for N% = 1 to 256
A% = asc(mid$(S$,N%,1))
if A% < L% then L% = A%
next N%
FindLow% = L%
end function
'
'
' FUNCTION returns highest value in $
'---------------------------------------------------------------------------
'
function FindHigh%(S$)
local A%,H%,N%
H% = 0
for N% = 1 to 256
A% = asc(mid$(S$,N%,1))
if A% > H% then H% = A%
next N%
FindHigh% = H%
end function
'
'
' PROCEDURE draws content of S$
' CGA: screen 2, Y%=100 --> all Y must be multiplied by 0.666
' HGC: screen 3, Y%=174 --> not anymore supported in V2.10
' EGA: screen 9, Y%=175
' VGA: screen 12, Y%=240
'---------------------------------------------------------------------------
'
sub DispCurve(SMode%,N$,S$)
local C%,X%,X0%,X1%,X2%,Y%,Y0%,Y1%,Y2%,Y3%,Y4%,N%,F%,Q$
screen SMode%
Q$ = S$
if SMode% = 2 then
print
print Center$(N$+" - Graphic Display",80)
else
print LogOn$(N$+" - Graphic Display - +512",%White,%Black)
end if
X% = 172
X0% = X%-127
X1% = X0%
S$ = left$(Q$,256)
for F% = 1 to 2
Y% = 200
Y0% = Y%+127
Y1% = Y0% - asc(left$(S$,1))
Y3% = 64
Y4% = 128
C% = 14
if SMode% = 2 then
Y% = 60
Y0% = Y%+63
Y1% = Y0% - asc(left$(S$,1)) / 2
Y3% = 32
Y4% = 65
C% = 7
end if
line (X%-128,Y%-Y4%) - (X%+128,Y%+Y4%),7,B
line (X%-128,Y%-Y3%) - (X%+128,Y%-Y3%),7
line (X%-128,Y% ) - (X%+128,Y% ),7
line (X%-128,Y%+Y3%) - (X%+128,Y%+Y3%),7
line (X%- 64,Y%-Y4%) - (X%- 64,Y%+Y4%),7
line (X% ,Y%-Y4%) - (X% ,Y%+Y4%),7
line (X%+ 64,Y%-Y4%) - (X%+ 64,Y%+Y4%),7
for N% = 0 to 255
X2% = X0% + N%
if SMode% = 2 then
Y2% = Y0% - asc(mid$(S$,N%+1,1)) / 2
else
Y2% = Y0% - asc(mid$(S$,N%+1,1))
end if
line (X1%,Y1%) - (X2%,Y2%), C%
X1% = X2%
Y1% = Y2%
next N%
X% = 468
X0% = X%-127
X1% = X0%
S$ = right$(Q$,256)
next F%
end sub
'
'
' PROCEDURE prints contents of S$
'---------------------------------------------------------------------------
'
sub PrntCurve(N$,S$)
local F%,N%,Q$
print LogOn$(N$+" - Table Display",%White,%Red)
locate csrlin-1,1
for F% = 0 to 15
for N% = 1 to 16
if N% = 1 then Q$ = "####" else Q$ = "#####"
A% = asc(mid$(S$,F%*16+N%,1))
print using Q$;A%;
next N%
print
next F%
Q$ = KeyIn$
end sub
'
'
' PROCEDURE returns gets 512 bytes from UZE for displaying
'---------------------------------------------------------------------------
'
sub GetDispl(S$,C$)
local I%,N%,A$
print# %UnitUZE, C$;
delay 1
if loc(%UnitUZE) = 0 then
color %LRed,%Black
print "Receive Error: Display Table/Graph"
color %White,%Black
exit sub
end if
S$ = input$(loc(%UnitUZE),#%UnitUZE)
end sub
'
'
' MAIN PROGRAM
'===========================================================================
'
UZEVer% = 2.10 'program for this UZE version
UZEMainV% = 210
VN$ = "UZETERM V.2.10"
Version$ = VN$ + "; (c) 1994/2001 HoroSoft, Switzerland"
print LogOn$(Version$,%White,%Blue)
print "Initializing ..."
'
'--------------------Run variables setup------------------------------------
'
SMode% = Video%
WrFile$ = ""
dim Flax%(0:7)
Flax%(0) = 0 'copy of any
Flax%(1) = 0 'log
Flax%(2) = 1 'local echo
Flax%(3) = 1 'distant echo
Flax%(4) = 0 'auto download
Flax%(5) = 0 'receive
Flax%(6) = 0 'transmit
Flax%(7) = 1 'help window
dim PSAddr??(0:%DPP) 'Public Procedures Addresses
dim PSAddr$(0:%DPP) 'dito, names in data statement
dim SysVar??(0:%DSV) 'System variables
dim SysByt?(1:%DSB) 'SysByt
dim SysNam$(1:%DSN) 'system variables and bytes names
DskFile$ = "" 'Filename
LogFile$ = ""
'
'-----------------------Array setup-----------------------------------------
'
restore AddrNames
PSAddr$(0) = "PubPro"
for N% = 1 to %DPP
read PSAddr$(N%)
next N%
for N% = 1 to %DSN
read SysNam$(N%)
next N%
delay 1
'
'---------------------------------Logon UZE---------------------------------
'
P% = QueryComPort%
select case P%
print "Opened COM";
case 1
open "COM1:9600,N,8,1,ds,cs,cd" as #%UnitUZE len=16384
print "1";
case 2
open "COM2:9600,N,8,1,ds,cs,cd" as #%UnitUZE len=16384
print "2";
case 3
print "3";
open "COM3:9600,N,8,1,ds,cs,cd" as #%UnitUZE len=16384
case 4
open "COM4:9600,N,8,1,ds,cs,cd" as #%UnitUZE len=16384
print "4";
end select
print ":9600,N,8,1,ds,cs,cd"
call UpStat(Flax%(),DskFile$)
call IssueHelp("",Flax%(),DskFile$)
print# %UnitUZE, "H";
delay 0.5
if loc(%UnitUZE) > 0 then
T$ = input$(loc(%UnitUZE),#%UnitUZE)
call GetExAd(PSAddr??())
color %LWhite,%Green
print Center$("UZE ready. Responded 'H' with [" + T$ + "]",80)
else
color %Yellow,%Red
print Center$("UZE probably not ready. Did not answer 'H'",80)
end if
color %White,%Black
'
'----------------------------Main Menu Loop---------------------------------
'
while (1)
while not instat
if loc(%UnitUZE) > 0 then
Trash$ = input$(loc(%UnitUZE),#%UnitUZE)
if istrue Flax%(3) then call ToScreen(Trash$)
if istrue Flax%(1) then print# %UnitLOG, Trash$;
end if
wend
while instat
Query$ = inkey$
select case Query$
'
'----------------------------Left menu handling-----------------------------
'
case chr$(8) '^H help
call IssueHelp(Query$,Flax%(),DskFile$)
case chr$(18) '^R receive into file
Flax%(0) = Flax%(3)
Flax%(3) = 0
Flax%(5) = 1
call ToFile(Query$,DskFile$,Flax%(),ErrFlag%)
Flax%(3) = Flax%(0)
call UpStat(Flax%(),DskFile$)
cls
case chr$(20) '^T transmit
Flax%(0) = Flax%(3)
Flax%(3) = 0
Flax%(4) = 1
call FromFile(Query$,Flax%(),DskFile$,ErrFlag%)
Flax%(3) = Flax%(0)
Flax%(4) = 0
call UpStat(Flax%(),DskFile$)
cls
case chr$(12) '^L session Log
Flax%(1) = 1
call ToLog(Query$,Flax%(),LogFile$,ErrFlag%)
case chr$(3) '^C close
close %UnitLOG
Flax%(1) = 0
LogFile$ = ""
call UpStat(Flax%(),DskFile$)
cls
'
'----------------------Center menu handling---------------------------------
'
case chr$(7) '^G graphic display
print
line input "Start address: ";Query$
A! = val(Query$)
A$ = remove$(str$(A!)," ")
C$ = "U" + A$ + ",512."
call GetDispl(S$,C$)
S1$ = left$(S$,256)
S2$ = right$(S$,256)
Flax%(0) = Flax%(7)
call DispCurve(SMode%,A$,S$)
locate 24,6
print "ð Low:";FindLow%(S1$);"ð High:";FindHigh%(S1$);"ð ";
A$ = "ð Low:"+str$(FindLow%(S2$))+_
" ð High:"+str$(FindHigh%(S2$))+" ð"
locate 24,75-len(A$)
print A$;
Q$ = KeyIn$
screen 0
call UpStat(Flax%(),DskFile$)
Flax%(7) = abs(Flax%(0)-1)
call IssueHelp(Query$,Flax%(),DskFile$)
case chr$(4) '^D display table
print
line input "Start address: ";Query$
A! = val(Query$)
A1$ = remove$(str$(A!)," ")
A2$ = remove$(str$(A!+256)," ")
C$ = "U" + A1$ + ",512."
call GetDispl(S$,C$)
S1$ = left$(S$,256)
S2$ = right$(S$,256)
Flax%(0) = Flax%(7)
Flax%(7) = %True
call IssueHelp(Query$,Flax%(),DskFile$)
call PrntCurve(A1$,S1$)
call PrntCurve(A2$,S2$)
Flax%(7) = abs(Flax%(0)-1)
call IssueHelp(Query$,Flax%(),DskFile$)
case chr$(23) '^W List defined words of ext-A
color %Cyan,%Black
print
print "Defined Names for extended-A command:"
call ListDefWrd
Query$ = ""
case chr$(6) '^F file dir
color %Cyan,%Black
print
line input "Filespec: ";Query$
color %Green,%Black
files Query$
Query$ = ""
color %White,%Black
case chr$(17),chr$(27) '^Q quit
close
goto About
'
'------------------------Right menu handling--------------------------------
'
case chr$(21) '^U version
print# %UnitUZE, "E";remove$(str$(PSAddr??(5)),any " ");".H.";
delay 0.5
print# %UnitUZE, "D65320,8,";chr$(84,255,1,0,84,255,0,0);
Query$ = ""
case chr$(16) '^P extended version
call ACmdVer
Query$ = ""
case chr$(22) '^V view memory
print
color %Cyan,%Black
line input "Dump start address: ";Query$
line input " Number of bytes: ";A$
print# %UnitUZE, "M4,";Query$;",";A$;",0,0.";
print
color %White,%Black
print# %UnitUZE, "E";remove$(str$(PSAddr??(4)),any " ");".";
Query$ = ""
case chr$(1) '^A addresses
print
color %LWhite,%Black
print PSAddr$(0);
print using("#####");PSAddr??(0);
color %White,%Black
for N% = 1 to %DPP
print ,PSAddr$(N%);
print using("#####");PSAddr??(N%);
next N%
color %LWhite,%Black
print ,"WarmSt 2573"
color %White,%Black
print
Query$ = ""
case chr$(19) '^S Sys Vars
print
call GetVars(SysVar??(),SysByt?())
color %LWhite,%Black
print "SysVar";
print using("######");SysVar??(0);
color %White,%Black
for N% = 1 to %DSV
print ,SysNam$(N%);
print using("######");SysVar??(N%);
next N%
print
color %LWhite,%Black
print "SysByt 65324";
color %White,%Black
for N% = 1 to %DSB
print ,SysNam$(N%+%DSV);
print using "####";SysByt?(N%);
next N%
Query$ = ""
print
case chr$(13) '^M = RET
print
Query$ = ""
end select
'
'-------------------------Local echo handling-------------------------------
'
if not Query$ = "" then print# %UnitUZE,Query$;
if Flax%(2) then
color %Cyan,%Black
print Query$;
color %White,%Black
end if
wend
wend
'
'--------------End of program and F1-Info-----------------------------------
'
About:
'
view text (1,1) - (80,24)
print LogOn$(Version$,%White,%Blue)
color %LWhite,%Green
print Center$("Program termination on user request - UZE disconnected",80);
color %White,%Black
print
print "Info = F1 (2 sec)"
delay 2
if inkey$ = chr$(0,59) then
print
color %LWhite,%Black
print "UZETERM .BAS Version";UZEMainV%,"For UZE-BIOS Version";UZEVer%
color %White,%Black
print "ERROR3 .INC Version";Error3V%
print "PB3GPUSE.PBU Version";PB3GPUseV%
print
print "H.-R.H. Wernli, Pletschgasse, CH-3952 Susten, Switzerland"
Q$ = KeyIn$
end if
cls
system
end
'
'
' Simple Error handler - extends to ERROR3 if unrecoverable
'---------------------------------------------------------------------------
'
NoJob:
'
ErrFlag% = err
select case err
case 52
call IssueErr("File not open")
case 53
call IssueErr("File not found")
case 57
call IssueErr("Device I/O error - data probably lost")
case 61
call IssueErr("Disk full")
case 64
call IssueErr("Illegal filename")
case 69
call IssueErr("COM-buffer overflow - Host machine too slow for UZE")
case 70
call IssueErr("Disk access denied - probably write protected")
case 71
call IssueErr("Disk not ready - probably no disk inside drive")
case 72
call IssueErr("Disk media error - better throw that disk away")
case 75
call IssueErr("Path/File access error")
case 76
call IssueErr("Path not found")
case else
view text (1,1) - (80,24)
print LogOn$(Version$,%White,%Red)
color %Yellow,%Red
print Center$("Abort ob unrecoverable error",80);
color %White,%Black
delay 1
goto ErrorHandling
end select
resume next
'
'
' DATA LIST
'===========================================================================
'
' Public procedures and public subroutines names in order of UZE V.1.02
' Last three entries are for V.2.xx
' --> Adjust %DPP, now 29
'---------------------------------------------------------------------------
'
AddrNames:
'
data "UseEnd","UZEVer","CrLfP ","DumpIt","WhoWho","AscBin","BinAsc","BinDec"
data "ChkAF ","ChkNbr","CrLfS ","DecBin","Div16 ","DmpAsc","GetAsc","IQDrop"
data "IQDump","IQPop ","IQPush","IQTest","LinDmp","MulTen","RTSgo ","RTStop"
data "SetPar","SetVar","SDelay","LDelay","Versi0"
'
' System word variables names in order of UZE V.1.02 & V.2.xx
' --> Adjust %DSV, now 42
'---------------------------------------------------------------------------
'
data "MCFAdr","IMode1","NMIVec","ILoopV","CTaddr","CTbyte","CTpntr","CTcntr"
data "CEaddr","CEbyte","CEpntr","CEcntr","CDaddr","CDbyte","CDpntr","CEcntr"
data "CUaddr","CUbyte","CUpntr","CUcntr","CHaddr","CHbyte","CHpntr","CHcntr"
data "CMaddr","CMbyte","CMpntr","CMcntr","CAaddr","CAbyte","CApntr","CAcntr"
data "Param1","Param2","Param3","Param4","HexChr","IQRSP ","IMode0","spare1"
data "spare2","spare3"
'
' System bytes variables in order of UZE V.1.02 & V.2.xx
' --> Adjust %DSB, now 14
'---------------------------------------------------------------------------
'
data "Prompt","CurCmd","OldCmd","Param0","MonMod","CmdNbr","IQRSDC","spare1"
data "spare2","spare3","spare4","spare5","spare6","spare7"
'
end
'
'======================-<950102 HoroSoft>-==================================
PB35GPUS.PBU/INC
This is the PowerBASIC Version 3.5 Unit file for General Purpose Use.
Here, included as uncompiled source.
'980118 1601
'***************************************************************************
'* PROGRAM NAME: PB35GPUS.INC DATE: 9.10.1991 INCLUDE IN: anyprog.BAS *
'* LANGUAGE: Power BASIC 3.50 (Robert S. Zale) *
'* PURPOSE: Power Basic 3.xx General Purpose Use Functions & Procedures. *
'* INCLUDE FILES: none. *
'* INPUT FILES: none. *
'* OUTPUT FILES: none *
'* ----------------------------------------------------------------------- *
'* VERSION: 2.14 18-JAN-98: Mandatory re-compile for PB V.3.50 *
'* ----------------------------------------------------------------------- *
'* VERSION: 2.13 10-APR-96: Added StripSlash$ function *
'* ----------------------------------------------------------------------- *
'* VERSION: 2.12 10-OCT-90: Introduced TL$ function from ZX80 times *
'* ----------------------------------------------------------------------- *
'* VERSION: 2.11 30-SEP-90: Recompiled with PB 3.20 *
'* ----------------------------------------------------------------------- *
'* VERSION: 2.10 1-JUN-94: Introduced PB3GPUseV-function and RetExt$ *
'* ----------------------------------------------------------------------- *
'* VERSION: 2.09 26-May-94: Introduced JulianDay, modified WeekDay *
'* ----------------------------------------------------------------------- *
'* VERSION: 2.08 6-May-94: Bugfix in ComLinLan *
'* ----------------------------------------------------------------------- *
'* VERSION: 2.07 2-MAR-94: Bugfix in WeekDay *
'* ----------------------------------------------------------------------- *
'* VERSION: 2.06 6-FEB-94: Bugfix in ClrLine *
'* ----------------------------------------------------------------------- *
'* VERSION: 2.05 15-JAN-94: Bugfix in IOPath$ and IOFile$ *
'* ----------------------------------------------------------------------- *
'* VERSION: 2.04 14-NOV-93: Added WeekDay function *
'* ----------------------------------------------------------------------- *
'* VERSION: 2.03 21-MAY-93: Redid from PB2GPUSE.INC *
'* ----------------------------------------------------------------------- *
'* VERSION: 2.02 16-MAR-93: Renamed from FUNCTION to GPFUNCT for PB 3.00a. *
'* ----------------------------------------------------------------------- *
'* VERSION: 2.01 13-AUG-92: improved AddSlash with l/r-trimming. *
'* ----------------------------------------------------------------------- *
'* VERSION: 2.00 derived from TurboBASIC 1.00e. *
'* ----------------------------------------------------------------------- *
'* COMMENTS: Made a Unit of it (16-MAR-93) *
'* ======================================================================= *
'* AUTHOR: Hans-Ruedi H. Wernli, Pletschgasse, CH-3952 Susten, Switzerland *
'***************************************************************************
'
'
$cpu 8086 'works for all computers
'
'
' CONSTANTS
'===========================================================================
'
%Black = 0 'COLORS, dark
%Blue = 1
%Green = 2
%Cyan = 3
%Red = 4
%Pink = 5
%Brown = 6
%White = 7
%Gray = 8 'COLORS, light
%LBlue = 9
%LGreen = 10
%LCyan = 11
%LRed = 12
%LPink = 13
%Yellow = 14
%LWhite = 15
'
%True = -1 'LOGIC
%False = 0
'
'
' FUNCTION returns Version number x 100
' V% = PB3GPUseV%
'---------------------------------------------------------------------------
'
function PB3GPUseV%() public
PB3GPUseV% = 214
end function
'
'
'FUNCTION returns PowerBASIC version as integer, e.g. 320 for 3.20. The
' string variable SV$ returns the subrevision letter, e.g. " "
' Tested with PB 3.10 and PB 3.20 - 30.Sept.95
' Usage: PRINT PBVer%(SV$);SV$
'---------------------------------------------------------------------------
'
function PBVer%(SV$) public
SV$ = chr$(pbvRevltr)
PBVer% = val(hex$(pbvRevision))
end function
'
'
' FUNCTION waits until either ESC or RET key is pressed and returns
' True if ESC, or False if RET was pressed.
' Usage: if EscRet% then print "You've pressed the Escape-Key"
'---------------------------------------------------------------------------
'
function EscRet% public
local A$
A$ = ""
do
A$ = inkey$
if A$ = chr$(13) then
EscRet% = %False
exit loop
end if
if A$ = chr$ (27) then
EscRet% = %True
exit loop
end if
loop
end function
'
'
' FUNCTION adds a Backslash to a dir-spec string if there is none yet.
' Can be used for Path formatting.
' Usage: UsePath$ = AddSlash$(RawPath$)
'---------------------------------------------------------------------------
'
function AddSlash$(DirSpec$) public
local A$,B$
A$ = DirSpec$
B$ = ltrim$(A$)
A$ = rtrim$(B$)
if not A$ = "" then
if not right$(A$,1) = "\" then
A$ = A$ + "\"
end if
end if
AddSlash$ = ucase$(A$)
end function
'
'
' FUNCTION returns from A$ a string without a terminating slash
' This is the inverse of AddSlash
'---------------------------------------------------------------------------
'
function StripSlash$(A$) public
local Z$
Z$ = A$
if right$(A$,1) = "\" then Z$ = left$(A$,len(A$)-1)
StripSlash$ = Z$
end function
'
'
' FUNCTION centers Text$ to MaxCol%. Left and right edges are filled
' with blanks. If length of Text$ exeeds MaxCol%, it is
' trunctated to MaxCol%.
' Usage: print Center$("HoroSoft",80);
'---------------------------------------------------------------------------
'
function Center$(Text$,MaxCol%) public
local SL%,FC%,U$,I$
U$ = Text$
SL% = len(U$)
FC% = MaxCol% - SL%
if FC% < 0 then
U$ = left$(Text$,MaxCol%)
FC% = 0
end if
I$ = space$(FC% / 2) + U$ + space$(MaxCol%)
Center$ = left$(I$,MaxCol%)
end function
'
'
' FUNCTION prints logon bar, starting at screen bottom and moving up to
' the top. Color is set to 5, 1 and color the white, black.
' LogOn$ makes use of Center$-function.
' Usage: print LogOn$(Version$,FG%,BG%); <-- note semi-colon!
'---------------------------------------------------------------------------
'
function LogOn$(Version$,F%,B%) public
cls
FL% = F% + 8
color F%,B%
print " Ú";string$(76,"Ä");"· ";
print " ³";
color FL%,B%
print Center$(Version$,76);
color F%,B%
print "º ";
print " Ô";string$(76,"Í");"¼ ";
color 7,0
locate 5,1
LogOn$ = ""
end function
'
'
' FUNCTION returns normalized date for continental Europe if LFlag%
' False, if True for English speaking countries.
' Usage: print DateNorm$(%English)
'---------------------------------------------------------------------------
'
MonthTable:
data Januar,Februar,März,April,Mai,Juni,Juli
data August,September,Oktober,November,Dezember
data January,February,March,April,May,June,July
data August,September,October,November,December
'
function DateNorm$(LFlag%) public
local D$,M$,Y$,A$,A%,N%
D$ = date$
A% = val(left$(D$,2))
if LFlag% then A% = A% + 12
restore MonthTable
for N% = 1 to A%
read M$
next N%
Y$ = right$(D$,4)
A% = val(mid$(D$,4,2))
D$ = right$(ltrim$(space$(2) + str$(A%)),2)
DateNorm$ = D$ + "." + M$ + space$(1) + Y$
end function
'
'
' FUNCTION returns Julian Day number.
' DY% = DateYear, DM%=DateMonth, DD%=DateDay
' TH% = TimeHour, TM%=TimeMinute, TS%=TimeSecond in UTC!
' Usage: JulDay# = JulianD#(DY%,DM%,DD%,TH%,TM%,TS%)
'---------------------------------------------------------------------------
'
function JulianDay#(DY%,DM%,DD%,TH%,TM%,TS%) public
local B%,JD0#,UT!
if DM% <= 2 then
decr DY%
DM% = DM% + 12
end if
B% = int(DY% / 400) - int(DY% / 100)
if ((DY% = 1582) and (DM% = 10) and (DD% < 5)) then B% = -2
JD0# = int(365.25 * DY%) + int(30.60001 * (DM% + 1)) + B% + 1720996 + DD%
UT! = TS% / 3600 + TM% / 60 + TH%
JulianDay# = JD0# + UT! / 24
end function
'
'
' FUNCTION returns weekday in German if LFlag% is False, if True in English
' Calculates Julian Day number first from system date.
' Usage: print WeekDay$(%English)
'---------------------------------------------------------------------------
'
DayTable:
data Tuesday,Wednesday,Thursday,Friday,Saturday,Sunday,Monday
data Dienstag,Mittwoch,Donnerstag,Freitag,Samstag,Sonntag,Montag
'
function WeekDay$(LFlag%) public
local D%,J%,M%,N%,Y%,B%,JD0#,J&,D$
D$ = date$
M% = val(left$(D$,2))
D% = val(mid$(D$,4,2))
Y% = val(right$(D$,4))
JD0# = JulianDay#(Y%,M%,D%,0,0,0)
J& = int (JD0# / 7)
J% = int(((JD0# / 7 - J&) * 7) + 1.0005)
if not LFlag% then J% = J% + 7
restore DayTable
for N% = 1 to J%
read D$
next N%
WeekDay$ = D$
end function
'
'
' FUNCTION waits until a key is pressed and returns it in uppercase.
' Usage: A$ = KeyIn$
'----------------------------------------------------------------------------
'
function KeyIn$ public
while not instat
wend
KeyIn$ = ucase$(inkey$)
end function
'
'
' FUNCTION returns True for English and False for German. If command line
' C$ is empty, queries. V$ holds a small description.
' Usage: English% = ComLinLan%(command$,Version$)
'----------------------------------------------------------------------------
'
function ComLinLan%(C$,V$) public
local A%,B%,C%,A$,B$
B$ = ucase$(C$)
print LogOn$(V$,%White,%Black)
locate 10,1
B% = 1
A% = instr(1,B$,"-E")
C% = instr(1,B$,"/E")
if A% > 0 or C% > 0 then B% = -1
A% = instr(1,B$,"-D")
A% = instr(1,B$,"/D")
if A% > 0 or C% > 0 then B% = 0
if B% = 1 then
B$ = "Language Selection: [RET] = English - [ESC] = German"
print Center$(B$,80)
B$ = "Sprach Wahl: [ESC] = Deutsch - [RET] = Englisch"
print Center$(B$,80)
B% = not EscRet%
end if
cls
ComLinLan% = B%
end function
'
'
' FUNCTION returns a validated Path. P$ holds the prompting message, D$ the
' default path when RET is pressed and T$ a yes/no prompt used in
' ValidFlg function. P$ is printed at the current cursor position.
' The cursor position is set to column 1 of the next line.
' Usage: UsePath$ = IOPath$("Enter Path:",curdir$,"RET=ok, ESC=redo")
'---------------------------------------------------------------------------
'
function IOPath$(P$,D$,T$) public
local Y0?,X0?,X1?,A$,B$,Q$
Y0? = csrlin
X0? = pos(Y0?)
color %LCyan,%Black
print P$;" ";
X1? = pos(Y0?)
do
locate Y0?,X1?
color %Brown,%Black
print D$;
call ClrLine
color %Yellow,%Black
locate Y0?,X1?
line input Q$
locate Y0?,X1?
if Q$ = "" then Q$ = D$
A$ = ltrim$(rtrim$(Q$))
if right$(A$,1) = "\" then A$ = left$(A$,len(A$)-1)
print A$;
call ClrLine
locate Y0?,X1?
if Confirm%(T$) then exit loop
loop
B$ = AddSlash$(A$)
color %Cyan,%Black
locate Y0?,X0?
print P$;" ";
color %LCyan,%Black
print B$
color %White,%Black
call ClrLine
IOPath$ = B$
end function
'
'
' FUNCTION prompts in language L% (True=English, False=Deutsch) for a file-
' name with (F%=True) or without (F%=False) file extension. The
' filename is returned in uppercase with or without extension (F%).
' Usage: FileName$ = IOFile$(English%,%True,"[RET]=ok, [ESC]=redo")
'---------------------------------------------------------------------------
'
function IOFile$(L%,F%,T$) public
local Y0?,X0?,X1?,A$,B$,C$,D$,Q$,I$
Y0? = csrlin
X0? = pos(Y0?)
A$ = "File to open with"
B$ = "out"
C$ = " filetyp"
if F% then B$ = ""
if not L% then
A$ = "Datei zu öffnen "
B$ = "ohne"
C$ = " Dateierweiterung"
if F% then B$ = "mit"
end if
D$ = A$ + B$ + C$ + ": "
color %LCyan,%Black
print D$;
X1? = pos(Y0?)
do
call ClrLine
color %Yellow,%Black
line input Q$
A$ = ltrim$(rtrim$(Q$))
if F% then I$ = ucase$(A$) else I$ = StripExt$(A$)
locate Y0?,X1?
print I$;
call ClrLine
locate Y0?,X1?
if Confirm%(T$) then exit loop
loop
locate Y0?,X0?
color %Cyan,%Black
print D$;" ";
color %LCyan,%Black
print I$
color %White,%Black
call ClrLine
IOFile$ = I$
end function
'
'
' FUNCTION Preserves current cursor position and prints on the line below
' T$ in light cyan. Waits until either ESC or RET is pressed and
' returns True for RET and False for ESC. The text is cleared
' and the cursor position is restored.
' Usage: if Confirm%("ESC=Not Ok, RET=Continue")
' --------------------------------------------------------------------------
'
function Confirm%(T$) public
local Y0?,X0?,Y1?,X1?
Y0? = csrlin
X0? = pos(Y0?)
print
Y1? = csrlin
X1? = pos(Y1?)
color %LCyan,%Black
print T$;
color %White,%Black
Confirm% = not EscRet%
locate Y1?,X1?
call ClrLine
locate Y0?,X0?
end function
'
'
' FUNCTION Preserves current cursor position and prints on the line below
' T$ in light white on red. Waits until either ESC or RET is
' pressed and returns True for RET and False for ESC. The text is
' cleared and the cursor position is restored.
' Usage: if Redo%("RET=Redo - ESC=Abort")
' --------------------------------------------------------------------------
'
function Redo%(T$) public
local Y0?,X0?,Y1?,X1?
Y0? = csrlin
X0? = pos(Y0?)
print
Y1? = csrlin
X1? = pos(Y1?)
color %LWhite,%Red
print T$;
color %White,%Black
Redo% = not EscRet%
locate Y1?,X1?
call ClrLine
locate Y0?,X0?
end function
'
'
' FUNCTION lists available files. If there are files available in directory
' D$ with file extension E$, a list is printed in green and the flag
' set to True, else it is set to false and an appropriate info is
' issued according to L% (True for English, False for Deutsch).
' Usage: Flag% = ListFiles%(curdir$,"*",English%)
' ---------------------------------------------------------------------------
'
function ListFiles%(D$,E$,L%) Public
local A$,B$
B$ = D$ + "*." + E$
A$ = dir$(B$)
if L% then
print "Available/Used Filenames: ";
else
print "Verfügbare/Benutzte Dateien: ";
end if
if not A$ = "" then
print
color %Green,%Black
files B$
ListFiles% = %True
else
color %LWhite,%Red
if L% then print " > None Available "; else print " > Keine Verfügbar ";
color %LWhite,%Green
if L% then print " None Used < " else print " Keine Benutzt < "
ListFiles% = %False
end if
color %White,%Black
print
end function
'
'
' FUNCTION strips file extension. Full name has either a full valid
' filename.typ or only filename. Returned is filename only.
' Usage: Filename$ = StripExt$(FullFilename$)
'---------------------------------------------------------------------------
'
function StripExt$(F$) public
local A%,A$
A$ = F$
A% = instr(F$,".")
if not A% = 0 then A$ = left$(F$,A%-1)
StripExt$ = ucase$(A$)
end function
'
'
' FUNCTION returns file extension from a full filename.
' Usage RetExt$(F$)
'---------------------------------------------------------------------------
'
function RetExt$(F$) public
local A%,A$
A$ = F$ + space$(3)
A% = instr(F$,".")
if not A% = 0 then A$ = mid$(F$,A%+1,3) else A$ = space$(3)
RetExt$ = ucase$(A$)
end function
'
'
' FUNCTION returns True if file can be found, otherwise false.
' Usage: if FileHere% then open F$ for input as # 1
'---------------------------------------------------------------------------
'
function FileHere%(F$) public
if not dir$(F$) = "" then FileHere% = %True else FileHere% = %False
end function
'
'
' FUNCTION opens file with full filespecs in P$, compares size against S&
' and returns true if they are the same. The file is closed
' thereafter.
' Usage: if SizeOk%("C:\TEMP-BUF\TEST.BAS",16384& then print "OK"
'---------------------------------------------------------------------------
'
function SizeOk%(F$,S&) public
local A%,V&
A% = freefile
open F$ for binary as # A%
V&= lof(A%)
close A%
if V& = S& then SizeOk% = %True else SizeOk% = %False
end function
'
'
' FUNCTION formats a byte-integer into an 8-character binary string.
' Usage: print ByteBin$(187%)
'---------------------------------------------------------------------------
'
function ByteBin$(Z%) public
local A$
If Z% < 256 then A$ = "00000000" else A$ = "++++++++"
ByteBin$ = right$(A$+bin$(Z%),8)
end function
'
'
' FUNCTION prints T$ in light cyan, queries for option, resets cursor and
' color to cyan.
' Usage: A% = SelOpt%("> Enter Number: ")
'----------------------------------------------------------------------------
'
function SelOpt%(T$) public
local Q$,X?,Y?
Y? = csrlin
X? = pos(Y?)
locate Y?,1
call ClrLine
color %LCyan,%Black
print T$;
color %Yellow,%Black
line input "";Q$
locate Y?,1
color %Cyan,%Black
print T$;
locate Y?,X?
SelOpt% = val(Q$)
end function
'
'
' FUNCTION Echoes A$ at current cursor position in yellow on read, beeps
' and returns in white on black. Use it in a loop.
' Use as: Print Ouch$(A$)
'---------------------------------------------------------------------------
'
function Outch$(A$) public
color %Yellow,%Red
print A$;
color %White,%Black
beep
end function
'
'
' FUNCTION puts V% into low/high limit of L%, H%
'---------------------------------------------------------------------------
'
function IntLmt%(L%,H%,V%) public
local A%
A% = V%
if V% < L% then A% = L%
if V% > H% then A% = H%
IntLmt% = A%
end function
'
'
' FUNCTION returns leftmost character of T$ and removes that character
' from T$. If T$=Null$, TL$=Null$.
' TL$ = Truncate Length. From SinclairBASIC ZX80.
' Usage: while not A$="":print TL$(A$):wend
'---------------------------------------------------------------------------
'
function TL$(T$) public
local A%
A% = len(T$)
select case A%
case 0
T$ = ""
A$ = ""
case 1
A$ = T$
T$ = ""
case else
A$ = left$(T$,1)
T$ = right$(T$,A%-1)
end select
TL$ = A$
end function
'
'
' PROCEDURE clears from the current cursor position the rest of the line.
' Is non-destructive for the current cursor position.
' Usage: print A$; : call ClrLine
'---------------------------------------------------------------------------
'
sub ClrLine public
local Y?,X?,X0?
Y? = csrlin
X? = pos(Y?)
X0? = 80 - X?
locate Y?,X?
incr X0?
print space$(X0?);
locate Y?,X?
end sub
'
'
' PROCEDURE echoes illegal input in Q$ and writes text in T$ in yellow on
' red on the next line. After a beep, 1 second is waited, the
' warning erased and the cursors reset to their initial position.
' Usage: call Illegal(Query$,"< Illegal Input. Repeat!")
'---------------------------------------------------------------------------
'
sub Illegal(Q$,T$) public
local Y?,X?,Z?
Y? = csrlin
X? = pos(Y?)
print
color %Yellow,%Red
print " >";Q$;T$;
Z? = csrlin
beep
delay 1
locate Z?,1
color %White,%Black
call ClrLine
locate Y?,X?
end sub
'
'
'====================-<End of PB3GPUSE.INC>-=========-<911010 HoroSoft>-====
ERROR3.INC
I hate errors, they do happen, however. I also hate the error
numbers. In distributed programs, error numbers are doubly frustrating
for the user. This error handler issues the error number along with a
describing text. That is the least I can do for the user.
'940601 1941
' ***************************************************************************
' * PROGRAM NAME: ERROR3 .INC DATE: 9.10.1991 INCLUDE IN: almost g/p *
' * LANGUAGE: Power BASIC 3.00c (Robert S.Zale / Spectra Publishing) *
' * PURPOSE: Error list & error handler *
' * INCLUDE FILES: none. *
' * INPUT FILES: none. *
' * OUTPUT FILES: none. *
' * ----------------------------------------------------------------------- *
' * VERSION: 2.31 JUN-94 Introduced Version Error3V% = 231 *
' * ----------------------------------------------------------------------- *
' * VERSION: 2.30 MAR-93 Power BASIC 3.00c *
' * ----------------------------------------------------------------------- *
' * VERSION: 2.20 DEC-91 Power BASIC 2.10e *
' * ----------------------------------------------------------------------- *
' * VERSION: 2.10 Turbo BASIC 1.00e *
' * ----------------------------------------------------------------------- *
' * COMMENTS: Expects flag Chroma%, True=color, False=monochrome *
' * Closes files: remove if none open! *
' * ======================================================================= *
' * AUTHOR: Hans-Ruedi H. Wernli, Pletschgasse, CH-3952 Susten, Switzerland.*
' ***************************************************************************
'
'
Error3V% = 231
'
'
goto SkipError 'if used as include
'
' ERROR HANDLING: Very primitive, but identifies error and aborts in any case
' ---------------------------------------------------------------------------
'
ErrorHandling:
'
screen 0
if Chroma% then color %LRed else color 25
print
print "* * F A T A L E R R O R / B Ö S A R T I G E R F E H L E R * *"
print
restore ErrorMessages
do
read E%,C%,D$
if (E% = err) or (E% = 999) then exit loop
loop
if Chroma% then color C% else color 9
print D$
print
color %LWhite
print "Offender is probably: / Schuldiger ist wahrscheinlich:"
print "---> ";
select case C%
case = 10
print "either you or me! / entweder Sie oder ich!"
print "if you: / falls Sie:"
print "wrong video mode / falscher Video Modus"
print "illegal input / illegale Eingabe"
case = 11
print "unknown entity! / unbekantes Wesen!"
case = 12
print "you, the user! / Sie, als Benutzer(in)!"
case = 13
print "possibly the programmer! / möglicherweise der Programmierer!"
print "H.-R.H. Wernli, Pletschgasse, CH-3952 Susten, Switzerland."
case = 14
print "the device or hardware! / das Gerät oder die Hardware!"
end select
print
if Chroma% then color %LRed else color 26
print "* * ABORT ON ERROR / ABBRUCH DURCH FEHLER"
print
A! = errnum
B! = err
print "Error Number:";A!;" -";B!
color %White
print
line input "Please press ---> [RET] <--- drücken, bitte ";D$
close
print
system
'
'
' DATA for Error messages
' Error number, color, english / german
' Color-key: Pink=programmer, Red=User, Yellow=Device, Cyan=unknown
' ---------------------------------------------------------------------------
'
ErrorMessages:
'
data 0,11,"DOS-access / DOS-Zugriff"
data 1,13,"NEXT without FOR / NEXT ohne FOR"
data 2,13,"wrong datatype in READ / falscher Datentyp bei READ"
data 3,13,"RETURN without GOSUB / RETURN ohne GOSUB"
data 4,13,"out of data / nicht genügend DATA-Elemente"
data 5,10,"illegal function call / illegaler Funktionsaufruf"
data 6,10,"overflow / berlauf"
data 7,12,"out of memory / nicht genug Speicher"
data 8,11,"undefined error / nicht definiert"
data 9,13,"subscript out of range / Index unzuläßig"
data 10,13,"dublicate definition / doppelte Definition"
data 11,10,"division by zero / Division durch Null"
data 12,11,"undefined Error / nicht definiert"
data 13,13,"type mismatch / unpassender Datentyp"
data 14,12,"out of string space / String Speicher voll"
data 15,13,"string too long / Stringlänge zu groß"
data 16,11,"undefined Error / nicht definiert"
data 17,11,"undefined Error / nicht definiert"
data 18,11,"undefined Error / nicht definiert"
data 19,13,"no RESUME / ON ERROR Routine ohne Abschluss"
data 20,13,"RESUME without error / RESUME ohne vorhergehenden Fehler"
data 21,11,"undefined Error / nicht definiert"
data 22,11,"undefined Error / nicht definiert"
data 23,11,"undefined Error / nicht definiert"
data 24,14,"COM-device time-out / COM-Timeout"
data 25,14,"device fault / Peripherieprobleme"
data 26,11,"undefined Error / nicht definiert"
data 27,14,"printer out of paper / kein Papier im Drucker"
data 28,11,"undefined Error / nicht definiert"
data 50,13,"FIELD overflow / unpassende FIELD-Größe"
data 51,11,"internal error / interner Fehler"
data 52,13,"bad file number / unzuläßige Dateinummer"
data 53,12,"file not found / Datei nicht gefunden"
data 54,13,"bad file mode, GET$/PUT$ illegal / GET$/PUT$ nicht erlaubt"
data 55,13,"file already open / Datei bereits geöffnet"
data 56,11,"Undefined Error / nicht definiert"
data 57,14,"device I/O error / Geräte I/O Fehler"
data 58,12,"file already exists / Dateiname existiert bereits"
data 59,11,"bad record length / falsche Datensatzlänge"
data 60,11,"undefined Error / nicht definiert"
data 61,14,"disk(ette) full / Diskette/Festplatte voll"
data 62,12,"input past end / Dateiende Überschritten"
data 63,12,"bad record number / illegale Datensatznummer"
data 64,12,"bad file name / unzuläßiger Dateiname"
data 65,11,"undefined Error / nicht definiert"
data 66,11,"undefined Error / nicht definiert"
data 67,12,"too many files in root directory / Stamm-Verzeichnis voll"
data 68,14,"device unavailable / Peripheriegert nicht verfügbar"
data 69,14,"COM-buffer overflow / COM-Puffer-Überlauf"
data 70,12,"read-only diskette / Diskette schreibgeschützt"
data 71,12,"disk not ready / Laufwerk nicht bereit"
data 72,14,"disk media error / Spur/Sektor defekt"
data 73,13,"feature unavailable / Erweiterung nicht verfügbar"
data 74,12,"RENAME on across disks / RENAME auf verschiedenen Laufwerken"
data 75,12,"file/path access error / Datei gegen Zugriff gesperrt"
data 76,12,"path not found / Suchweg existiert nicht"
data 201,13,"out of stack space / Stackpuffer voll"
data 202,13,"temporary string memory full / temporärer Stringspeicher voll"
data 203,13,"mismatched common variables / unterschiedliche COMMON-Variablen"
data 204,13,"mismatched program options / unterschiedliche Programmoptionen"
data 205,13,"mismatched program revisions / unterschiedliche Programmversionen"
data 206,12,"invalid program file / unzuläßige Programm-Datei"
data 207,13,"array static / statische Array"
data 208,13,"invalid string handle / ungültige Stringkennung"
data 209,12,"incompatible mouse driver / unkompatibler Maustreiber"
data 241,13,"far heap corrupt / Heapspeicher korrupt"
data 242,14,"string/array memory corrupt / String/Arrayspeicher zerstört"
data 243,13,"CHAIN/RUN from EXE-file only / CHAIN/RUN nur von EXE Datei"
data 244,13,"missing library / Bibliothek nicht vorhanden"
data 245,13,"CHAIN/RUN too big / CHAIN/RUN zu groß"
data 256,12,"requires DOS 2.0 or later / benötigt DOS 2.0 oder später"
data 257,14,"missing numeric coprocessor / kein Koprozessor"
data 258,14,"program too big to fit in memory / Programm zu groß"
data 259,14,"80286/80386 CPU required / benötigt 80286/80386 Prozessor"
data 999,11,"unknown error / gibt's nicht"
'
SkipError:
'
'===============-<End of ERROR3.INC>-==========-<911009 HoroSoft>-==========
This is all there is to it.
|