Home   • Persönlich •

< 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.

Status Bar
  • 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.

Help

^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.

Screenshot

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.

Screenshot

^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.

Screenshot

^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 / Peripherieger„t 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.

 
  © 2004 - 2018 by Horo Wernli.