Unfinished Bitness

Action! Windows – Close & Title

Posted by Ripdubski on 2016.04.28

Posted in: Atari, Programming. Tagged: 8 bit, Action!, Windows. Leave a comment

In this post I show how the windowing system close routine works, as well as introduce a window titling routine. All of the routines presented here are part of the window library LIBWIN.ACT.

Close (WClose)

The close routine takes one parameter when called – the window handle to close. Windows can be closed out of sequence, but new windows should not be opened until all the topmost windows have been closed. If you do want to close and open a new window in the middle of the stack, the window size of the new window MUST be identical to prevent overwriting another windows screen buffer memory.

The close routine works in the following manner:

First it sets the default return code to an error code of NOT OPEN. This assumes the window handle specified is not currently open.
It then computes the location of the windows handle within the window handle memory.
Then, if the windows handle status is free, the routine exits passing back the default error code NOT OPEN.
If the windows handle status is not free, it computes the location of the top left corner of the window in screen memory, then restores the screen contents the window was covering one line at a time from top to bottom by copying the saved screen contents from the windows screen buffer memory. Then the windows screen buffer memory is cleared and the pointer to the next free space is moved to the start of this windows screen buffer memory. Last, the window handles attributes are reset, the return code of 0 (good) is set and the routine exits.

; --------------------------------------
; Func..: BYTE WClose(BYTE n)
; Desc..: Closes a window
; Params: n = number of window handle
; Return: 0 if success
;         >100 on error
; --------------------------------------
BYTE FUNC WClose(BYTE bN)
  BYTE bR,bL
  CARD POINTER cS,pM

  ; Set default return code
  bR=WERNOPN

  ; Find window handle record
  pWn=baW+(WRECSZ*bN)

  ; Only if handle in use
  if pWn.bS#WSFREE then
    ; Find top left corner of window
    ; in screen memory
    cS=RSCRN+(pWn.bY*40)+pWn.bX

    ; Set temp ptr to start of win mem
    pM=pWn.cM

    ; Restore screen line by line
    for bL=0 to pWn.bH-1
    DO
      ; Restore underlying scrn from win mem
      MoveBlock(cS,pM,pWn.bW)
      ; Inc mem ptr index by width
      pM==+pWn.bW
      ; Inc scr by 40 to next line start
      cS==+40
    OD

    ; Clear window memory
    Zero(pWn.cM,pWn.cZ)

    ; Set win mem ptr to prev location
    cpWM==-pWn.cZ

    ; Clear handle
    pWn.bS=WSFREE
    pWn.bX=0
    pWn.bY=0
    pWn.bW=0
    pWn.bH=0
    pWn.bI=WINVOFF
    pWn.cM=baWM  ; point at base storage
    pWn.cZ=0

    ; Set return
    bR=0
  fi
RETURN(bR)

Title (WTitle)

The title routine sets the windows title. It requires two parameters; the window handle, and a pointer to the string containing the title. Titles should be at least 4 characters smaller than the window width. If successful, it returns 0 (good). If something went wrong, it returns an error code.

The routine works in the following manner:

First a default error return code of NOT OPEN is assigned. This assumes the window handle specified is not currently open.
It then computes the location of the windows handle within the window handle memory.
Then, if the windows handle status is free, the routine exits passing back the default error code NOT OPEN.
If the windows handle status is used, it builds a string to present in memory which is a copy of the passed title, but includes bookends. This string is then converted from ATASCII to internal character code because the string will be copied directly into screen memory rather than through CIO. If the window was specified as inverse, the entire built title string is inversed including the bookends, otherwise just the title is inversed. Finally, the titles location in screen memory is computed, and the built title string is copied directly to screen memory to that location.
Then the return code is set to 0 (good) and the routine exits.

; --------------------------------------
; Func..: BYTE WTitle(BYTE n
;                     CARD POINTER s)
; Desc..: Add title decor to window
; Params: n = number of window handle
;         s = Title string pointer
; Notes.: Max 36 for frame and bookends
; Return: 0 if success
;         >100 on error
; --------------------------------------
BYTE FUNC WTitle(BYTE bN CARD POINTER pS)
  BYTE bR
  CHAR ARRAY cL(36)
  CARD POINTER cS

  ; Set default return code
  bR=WERNOPN

  ; Find window handle record
  pWn=baW+(WRECSZ*bN)

  ; Only if handle in use
  if pWn.bS=WSUSED then
    ; Create title string
    ; Copy string
    SCopy(cL+1,pS)
    ; Set open bookend
    cL(1)=4
    ; Set close bookend
    cL(pS(0)+2)=1
    ; Set string len to include bookends
    cL(0)=pS(0)+2

    ; Convert from ATA to INT
    StrAI(cL)

    ; If inverse on, inverse all
    if pWn.bI=WINVON then
      ; Skip first 1b (str len)
      StrInv(cL+1,cL(0))
    ; Else inverse off, inverse only text
    else
      ; Skip first 2b (str len,bookend)
      ; Skip last 1b (bookend)
      StrInv(cL+2,cL(0)-2)
    fi

    ; Find top left corner +1 of window
    ; in screen memory
    cS=RSCRN+(pWn.bY*40)+pWn.bX+1

    ; Move title to screen
    MoveBlock(cS,cL+1,cL(0))

    ; Set valid return
    bR=0
  fi
RETURN(bR)

Usage

To demonstrate the newly introduced functions, this small program is employed. It adds in two more files from my Action! library. They are required to use the function WaitKC(). WaitKC waits for a keystroke or console key press. These files are:

DEFINES.ACT – Definitions used by my Action! library routines.
LIBMISC.ACT – Miscellaneous functions. Pulled in for WaitKC().

Notable changes in the demonstration program are the addition of the WTitle() lines, WClose() lines, and the WaitKC() line.

; Program: WINDOW.ACT
; Author.: Wade Ripkowski
; Date...: 2016.04
; Desc...: Test Windowing Library
; License: Creative Commons
;          Attribution-NonCommercial-
;          NoDerivatives
;          4.0 International

; Include library
INCLUDE "D3:DEFINES.ACT"
INCLUDE "D3:DEFWIN.ACT"
INCLUDE "D3:LIBSTR.ACT"
INCLUDE "D3:LIBWIN.ACT"
INCLUDE "D3:LIBMISC.ACT"

; Start
MODULE

PROC Main()
; Window handles
BYTE bW1,bW2,bW3

; Init Window System
WInit()

; Open window 1
bW1=WOpen(10,5,20,6,WINVOFF)
WTitle(bW1,"One")

; Open window 2
bW2=WOpen(5,15,30,6,WINVON)
WTitle(bW2,"TWO")

; Open window 3
bW3=WOpen(15,8,10,8,WINVOFF)
WTitle(bW3,"Three")

; Wait for a keystroke or console key
WaitKC()

; Close window 3
WClose(bW3)

; Close window 2
WClose(bW2)

; Close window 1
WClose(bW1)

RETURN

Results

Running the demonstration program produces the following. The first screen shot is after the windows have been opened with titles applied, and is waiting for a keystroke. The wait was required due to the window system speed. Without the wait, it would just blink. Yes, its that fast.

This screen shot shows the windows have been closed and control has returned to the Action! cartridge (top line):

The next post will include a routine to print a string to a window, and a routine to clear a windows contents.

Action! Windows – Init & Open

Posted by Ripdubski on 2016.04.27

Posted in: Atari, Programming. Tagged: 8 bit, Action!, Windows. Leave a comment

The next series of posts will document a windowing system I built for the Atari 8 bit computer using Action!. In this first post I’ll show you the windowing system is designed, and show you the first few functions to get started.

To keep the windowing system somewhat simple, I chose not to include any Z ordering, and instead put window order management on the programmers shoulders. Programs are small enough on the Atari that this isn’t really a problem as far as I am concerned.

Design

The Window system needs a few basic things. The first two:

Window handles which hold the information about each window (top and left cursor position, width, height, etc)
Memory to store the screen contents the window replaces when drawn.

I chose a simple stack based ordering system. This means windows are added to a stack as they are created. The last one added, should be the first one removed. There are a number of reason I chose this. First and foremost was simplicity. This approach brings with it less management of window screen buffer memory. It also helps keep the code size down.

I gave each window handle 8 attributes:

Status (bS)
X position / column (bX)
Y position / row (bY)
Width (bW)
Height (bH)
Inverse flag (bI)
Window Buffer Memory Location (cM)
Window Buffer Memory Size (cZ)

To make the windowing system easy to use in programs I broke it into library modules that fit in with the other library routines I’ve posted about before. These are, and should be included in this order in any program:

DEFWIN.ACT
LIBWIN.ACT

Next I’ll break down whats in each one.

DEFWIN.ACT

To make storage, almost straight forward, I created a record:

; Window handle type definition
TYPE WnREC=[BYTE bS,bX,bY,bW,bH,bI
            CARD cM,cZ]

The BYTE parameters each take 1 byte of memory to store. The CARD parameters each take 2 bytes of memory to store. This brings the total record size to 10 bytes. There is a definition for the window handle record size. While setting up definitions, I also setup the maximum size for the window screen buffer memory size. Just under 3K. You can make this bigger or smaller as needed:

; Record and memory alloc sizes
DEFINE WRECSZ="10"
DEFINE WBUFSZ="2968"

Next comes the system-wide pointers used for accessing the window handles and window screen buffer memory:

; Pointers for window handle and mem
WnREC POINTER pWn
CARD POINTER cpWM

Then the memory is allocated for both the window handles and the window screen buffer memory. I set aside enough window handle memory for 11 handles – 10 for general usage, and 1 as a system handle (for dedicated functions that will come later). You can shrink the size of the window handle memory to fit your needs. It just needs to be a multiple of the WRECSZ defined previously:

; Window handle and memory storage
; 10 handles + 1 system handle
BYTE ARRAY baW(110),baWM(WBUFSZ)

I also define the vector to screen memory, which is locations 88 and 89. Created in this way, the computation of the actual address in memory is done for you by Action!:

; Screen memory vector
CARD RSCRN=88

The window system also keeps track of where the cursor is, virtually. To do so I used a two byte record to hold the virtual X and Y positions. Then assign it as a variable for use system wide:

; Virtual cursor type definition
TYPE WnPOS=[BYTE vX,vY]

; Virtual cursor var
WnPOS vCur

There are some other defines in the file which are use to make program source code easier to read. These are:

; Background
DEFINE WBNONE="0"

; Inverse Flags
DEFINE WINVON="1"
DEFINE WINVOFF="0"

; Window Status
DEFINE WSFREE="0"
DEFINE WSUSED="1"

; Positioning
DEFINE WPABS="128"
DEFINE WPCENT="255"

; Error Status
DEFINE WERNONE="100"
DEFINE WERNOPN="101"
DEFINE WERUSED="102"

The Inverse flags are WINVON and WINVOFF. They represent the values used to set a window to be drawn in inverse video or not.

The Window Status flags are WSFREE and WSUSED. They represent the values assigned to the window handles status byte. 0, the window handle is free (available). 1, the window handle is in use.

The Error Status flags are:

WERNONE – Window ERror NONE – No window handles available
WERNOPN – Window ERror Not OPeN – Window handle not open
WERUSED – Window ERror USED – Window handle in use

The other definitions will be discussed when the time comes.

LIBWIN.ACT

This contains all the window routines. For this post, I will cover the initialization routine and the open routine. Future posts will cover other routines.

Init (WInit)

First the init routine. The window system needs to be initialized before use. The initialization routine is described here.

First, it turns the cursor off, sets the left margin to 0, moves the physical cursor to top left corner, then sends clear screen to CIO.
Then it zeros out the window screen buffer memory, and sets the initial index to the memory which will be at byte 0 of the window memory address.
Then for each of the 10 general window handles and 1 system window handle, it sets the window handle attributes to status of free, inverse off, base memory address of window screen buffer memory, and 0 for all other attributes.
Last it sets the virtual cursor coordinates.

; --------------------------------------
; Proc..: WInit()
; Desc..: Initializes windowing system.
; --------------------------------------
PROC WInit()
  BYTE bL

  ; Setup cursor and screen
  Poke(752,1)
  Poke(82,0)
  Position(0,0)
  Put($7D)

  ; Clear window memory
  Zero(baWM,WBUFSZ)

  ; Set index into window memory
  cpWM=baWM

  ; Work on 10 window+system handles
  for bL=0 to 10
  DO
    ; Find windows handle location
    pWn=baW+(WRECSZ*bL)

    ; Clear handle record vars
    pWn.bS=WSFREE
    pWn.bX=0
    pWn.bY=0
    pWn.bW=0
    pWn.bH=0
    pWn.bI=WINVOFF
    pWn.cM=baWM  ; point at base storage
    pWn.cZ=0
  OD

  ; Set virtual cursor coords
  vCur.vX=0
  vCur.vY=0
RETURN

Open (WOpen)

Now for the window open routine. To open a window, WOpen is called 5 parameters:

x position / column
y position / row
width (inclusive of border)
height (inclusive of border)
inverse flag

The routine will return either the window handle number assigned, or an error code. The window handle number is chosen based on the first free handle. What the routine does:

Sets the default return code to no window handles available (WERNONE).
It cycles through each general window handle starting at the first, looking for the first one that is not used. To do this, it finds the window handle in memory, and checks the status byte.
If the window handle is free, the window handle status byte is set to used.
It sets the window handle memory location pointer to the same value as the systems window screen buffer memory pointer. The system one gets updated as the window is drawn and underlying screen elements are saved to it. It also sets the size of the memory needed to store the underlying screen elements, which is the width times height of the window.
It sets the other window handle attributes to match those passed in to the function.
It then computes the location in screen memory where the top left of the window location should be.
It draws the window. To do this, it creates each row of the window from top to bottom. This is done by creating an in-memory image of each row, then copying that memory block into screen memory at the correct location. It will also inverse the in-memory image of the row if the inverse flag was set.
Then it sets the return value of the function to the window handle that was used.
Last, the routine exits passing back the return value which is the window handle that was used.

; --------------------------------------
; Func..: BYTE WOpen(BYTE x,y,w,h,i)
; Desc..: Opens new window
; Params: x = column
;         y = row
;         w = width
;         h = height
;         i = inverse
;             WINVON/WINVOFF
; Return: Window handle number
;         >100 on error
; --------------------------------------
BYTE FUNC WOpen(BYTE x,y,w,h,i)
  BYTE bR,bL,bD
  CHAR ARRAY cL(40)
  CARD POINTER cS

  ; Set default return code
  bR=WERNONE

  ; Cycle through handles (excl system)
  for bL=0 to 9
  DO
    ; Find window handle record
    pWn=baW+(WRECSZ*bL)

    ; If handle record not in use
    if pWn.bS=WSFREE then
      ; Set handle record in use
      pWn.bS=WSUSED

      ; Set storage address and size
      pWn.cM=cpWM
      pWn.cZ=w*h

      ; Set other handle record vars
      pWn.bX=x
      pWn.bY=y
      pWn.bW=w
      pWn.bH=h
      pWn.bI=i

      ; Find top left corner of window
      ; in screen memory
      cS=RSCRN+(y*40)+x

      ; Draw window
      for bD=0 to h-1
      DO
        ; Build window line as string
        ; Top or bottom line "+-+"
        if bD=0 or bD=h-1 then
          SetBlock(cL,w,82)

          ; Top line corners
          if bD=0 then
            cL(0)=81
            cL(w-1)=69
          ; Bottom line corners
          else
            cL(0)=90
            cL(w-1)=67
          fi
        ; Middle line "| |"
        else
          SetBlock(cL,w,0)
          cL(0)=124
          cL(w-1)=124
        fi

        ; If inverse flag, flip line
        if i=WINVON then
          StrInv(cL)
        fi

        ; Save underlying scrn to win mem
        MoveBlock(cpWM,cS,w)
        ; Inc mem ptr index by width
        cpWM==+w
        ; Move line to screen
        MoveBlock(cS,cL,w)
        ; Inc scr by 40 to next line start
        cS==+40
      OD

      ; Set return to handle number
      bR=bL

      ; Exit loop
      EXIT
    fi
  OD
RETURN(bR)

Usage

The following program demonstrates the usage. This program will be built upon as the posts progress. You’ll notice LIBSTR.ACT is included as well. It has the StrInv function which is used to inverse a window.

; Program: WINDOW.ACT
; Author.: Wade Ripkowski
; Date...: 2016.04
; Desc...: Test Windowing Library
; License: Creative Commons
;          Attribution-NonCommercial-
;          NoDerivatives
;          4.0 International

; Include library
INCLUDE "D3:DEFWIN.ACT"
INCLUDE "D3:LIBSTR.ACT"
INCLUDE "D3:LIBWIN.ACT"

; Start
MODULE

PROC Main()
; Window handles
BYTE bW1,bW2,bW3

; Init Window System
WInit()

; Open window 1
bW1=WOpen(10,5,20,6,WINVOFF)

; Open window 2
bW2=WOpen(5,15,30,6,WINVON)

; Open window 3
bW3=WOpen(15,8,10,8,WINVOFF)

RETURN

Result

That’s it. The next post will cover window closing and background. Other posts will include window titles, printing to windows, putting characters to windows, and eventually some widgets.

Action! Program: DBF Make

Posted by Ripdubski on 2015.09.04

Posted in: Atari, Programming. Tagged: 8 bit, Action!, database, dBase, DBF, DBFMAKE, DBT. Leave a comment

Following up the DBFINFO program the next logical step is to write a program to create a dBase file. I was able to use the skeleton of DBFINFO so some of it will look familiar. The program I wrote (DBFMAKE) will create a dBase III DBF file and optionally a DBT file if there is a memo field defined.

One of the things you will notice is the file contains a lot of $00 bytes whereas the same structure created on a PC will have pseudo-random bytes in it. The PC programs generate garbage into the files so the difference is expected. When you disect a file created on the PC this garbage appears to be parts of memory dumped into the file. Maybe it’s a quick way to write large numbers of bytes at once, I don’t know. At any rate the difference doesn’t matter. The files I have created on the Atari 8 bit and transferred to the PC were usable and caused no issues. One thing I noticed is that after adding records the DBT file no longer had $00 bytes, but instead had the pseudo-random garbage again. PC by-product. At any rate the garbage appears in non-positional (non-data) bytes.

Additionally I don’t foresee the Atari ever utilizing the multi-user bytes, code page language bytes, or a handful of others that make no sense for the A8 platform – so those are all defined as $00 as well.

This program, DBFMAKE, will ask for the current date. The date is needed because three of the first four bytes in a DBF file represent the date of last modification. For now it’s manually input. In the future I may try to have it seek out a Z: handle and read the date from it since it should be an RTC (real time clock), then resort to input if the date can’t be determined automatically.

It will then ask for a filename. This is input WITHOUT an extension. The program will append DBF and DBT as needed.

After that it will loop asking for fields, up to the maximum of 128. It requires a name (up to 10 characters) and a field type (Character, Date, Logical, Memo, Number). If the field type is Character it will ask for the length (up to 254 characters max). If the field type is Number it will ask for the size in characters (up to 19), and the decimal precision (up to 15). Pressing RETURN on a field name will terminate input at which point the file(s) are created and the structure is displayed back as confirmation.

The constraints on the database structure follow those from the dBase III specification, and are as follows:

The signature byte will be either $03 or $83. These are dBase III identifiers for database without and with memo fields respectively. I could have used a new identifier to signify dBase III on Atari 8 bit as the dBase flavor (like FoxPro, etc), but a) it’s premature for that; b) programs on the PC wouldn’t recognize it. So, I imitate.
Max # Fields: 128
Max Character Field Size: 254
Max Number Field Size: 19
Max Number Field Decimal Size: 15
Max # Records: 1,000,000,000
Max # Records Per File: 65,535
Max Record Size: 4,000
Max Memo Size: 5,000

DBF Structure

This is a brief explanation of the the dBase III DBF file structure.

1 b : DBT (x03=NO, x83=YES)
1 b : Year (less than 80 is 20xx; greater than 80 and less than 100 is 19xx; greater than 100 is 20xx)
1 b : Month
1 b : Day
4 b : NDR (number data records LSB first; i.e.: 03 00 00 00)
2 b : HSZ (header size LSB first; i.e.: A2 00)
2 b : DSZ (data record size LSB first; i.e.: 34 00) (includes deletion flag)
20 b : filler
32 b : field definition (repeat up to max as needed)
- 11 b : field name
- 1 b : field type
- 4 b : field memory address
- 1 b : field length
- 1 b : number of decimals
- 2 b : muti user
- 1 b : work area ID
- 11 b : reserved

DBT Structure

This is a brief explanation of the dBase III DBT file structure.

Bytes 1 through 4 : The index of the next available memo location within the DBT file. Encoded in LSB/MSB form.
Remaining bytes (through 512): Memo field data.

The last memo field in the DBT will not be the full 512 bytes, it will terminate at the conclusion of the memo field data.

Complete Source

; Program: DBFMAKE.ACT
; Author.: Wade Ripkowski
; Date...: 2015.08
; Desc...: Create dBase III DBF file.
; Notes..: Requires 9 pages of symbol
;          table space:
;          Run BIGST.ACT, then
;          SET $495=9, then
;          compile.
; License: Creative Commons
;          Attribution-NonCommercial-
;          NoDerivatives
;          4.0 International

; Inc Action Runtime
INCLUDE "D2:SYS.ACT"

; Inc Action Toolkit parts
INCLUDE "D5:PRINTF.ACT"
INCLUDE "D5:CHARTEST.ACT"

; Include library
INCLUDE "D3:DEFINES.ACT"
INCLUDE "D3:LIBIO.ACT"
INCLUDE "D3:LIBMISC.ACT"
INCLUDE "D3:LIBDOS.ACT"

; Start DBF Make
MODULE

; Size of a field record
DEFINE SZFLD = "13"
DEFINE OFFNM = "4"
DEFINE MAXREC = "128"
DEFINE SZMEM = "1664"

; Header record type
TYPE DBHead=[BYTE bMe,
                  bYr,
                  bMo,
                  bDy
             CARD cNDR,
                  cHSZ,
                  cDSZ]

; Field definition type
TYPE DBFld=[BYTE bTp
            CARD cFL
            BYTE bFD,
                 bNm]

; Global vars
BYTE bgErr=[0]
CARD cErrO
; Enough storage for 128 fields
BYTE ARRAY baFlds(SZMEM)

; Custom Quit routine
PROC DIQuit()
  ; Restore error vector
  Error=cErrO
RETURN


; Custom Error routine
PROC DIErr(BYTE bE)
  ; Set global error number
  bgErr=bE

  ; Print custom error message
  PrintF("%EERROR: ")

  if bE=170 then
    PrintE("File not found!")
  elseif bE=130 then
    PrintE("Invalid device!")
  elseif bE=255 then
    PrintE("DBF file invalid!")
  fi

  if bE>240 then
    DIQuit()
  fi
RETURN


; Func..: GType()
; Return: BYTE=ATASCII key (upper)
; Desc..: Waits for CDLNM key
BYTE FUNC GType()
  BYTE bRCH=764,bR,bE

  ; Set exit flag 0
  bE=0

  DO
    ; Loop until keypress
    while bRCH=KNONE DO OD

    ; Get key (keycode) and reset
    bR=bRCH
    bRCH=KNONE

    ; Convert keycode to ATASCII
    if bR=18 or bR=82 then
      bR='C
      bE=1
    elseif bR=58 or bR=122 then
      bR='D
      bE=1
    elseif bR=0 or bR=64 then
      bR='L
      bE=1
    elseif bR=35 or bR=99 then
      bR='N
      bE=1
    elseif bR=37 or bR=101 then
      bR='M
      bE=1
    fi
  until bE=1
  OD
RETURN(bR)


; Main routine
PROC Main()
BYTE bFn,bEx,bMF,bLp,bFlp,bCX,bCY
BYTE bSD=[0]
; DB header record
DBHead dHd
; Pointer to field record
DBFld POINTER pFld
; Pointer to name field
BYTE POINTER pNm
; Filename and field name input
CHAR ARRAY cDBF(16),cDBT(16),cI(12),cF(11),cDt(7),cBf(5)
CARD cLp

; Save and reassign error vector
cErrO=Error
Error=DIErr

; Clear memory
Zero(baFlds,SZMEM)

; Setup screen
Poke(82,0)
Put(CCLS)
Position(0,0)
PrintE("-[DBF Make]-----------[               ]-")

; Check for SpartaDOS
bSD=IsSD()

; Get date
Position(0,2)
Print("Todays Date (YYMMDD)?")
InputS(cDt)

; Parse date into components; YY,MM,DD
SCopyS(cBf,cDt,1,2)
dHd.bYr=ValB(cBf)
SCopyS(cBf,cDt,3,4)
dHd.bMo=ValB(cBf)
SCopyS(cBf,cDt,5,6)
dHd.bDy=ValB(cBf)

; Get filename
Print("Filename (NO ext)?")
InputS(cI)

; Create DBF and DBT names
SCopy(cDBF,cI)
SCopy(cDBT,cI)
SAssign(cDBF,".DBF",cDBF(0)+1,cDBF(0)+5)
SAssign(cDBT,".DBT",cDBT(0)+1,cDBT(0)+5)

; Save cursor position
bCY=Peek(84)
bCX=Peek(85)

; Open file for write
Open(4,cDBF,8,0)

; If no error, proceed
if bgErr=0 then
  ; Update title with DBF name
  Position(23,0)
  Print(cDBF)
  ; Restore cursor position
  Position(bCX,bCY)

  ; Set field #, rec size, exit flag, memo flag
  bFn=0
  dHd.cDSZ=0
  bEx=FALSE
  bMF=FALSE

  DO
    ; 0 based counter computes.
    ; Set Fld pointer to storage loc
    pFld=baFlds+(bFn*SZFLD)
    ; Set Name pointer to offset
    pNm=pFld+OFFNM

    ; Inc counter (start at 1)
    bFn==+1

    PrintF("%EField #%D (RETURN=Done)%E",bFn)

    ; Get field name
    Print("Name (10 char)? ")
    InputS(cF)

    ; If field name len > 0
    if cF(0) > 0 then
      ; Copy input to pointer memory
      SCopy(pNm,cF)

      ; Get field type
      Print("Type (C/D/L/M/N)?")
      pFld.bTp=GType()

      ; Make upper and display
      pFld.bTp=ToUpper(pFld.bTp)
      Put(pFld.bTp)

      ; Character Field
      if pFld.bTp = 'C  then
        ; Get length
        PrintF("%ELength (1 to 254)?")
        pFld.cFL=InputB()
          ; Check bounds
          if pFld.cFL > 254 then
            pFld.cFL = 254
          elseif pFld.cFL < 1 then
            pFld.cFL = 1
          fi
      ; Date Field
      elseif pFld.bTp = 'D then
        ; Set length, newline
        pFld.cFL=8
        PutE()
      ; Logical Field
      elseif pFld.bTp = 'L then
        ; Set length, newline
        pFld.cFL=1
        PutE()
      ; Memo Field
      elseif pFld.bTp = 'M then
        ; Set length, set flag
        pFld.cFL=10
        bMF=TRUE
        PutE()
      ; Numeric Field
      elseif pFld.bTp = 'N then
        ; Get field length
        PrintF("%ELength (1 to 19)?")
        pFld.cFL=InputB()

        ; Check bounds
        if pFld.cFL > 19 then
          pFld.cFL=19
        elseif pFld.cFL  15 then
          pFld.bFD=15
        fi
      fi

      ; Add size to tally
      dHd.cDSZ==+pFld.cFL
    ; Exit
    else
      ; Set exit flag
      bEx=TRUE
      ; Minus the one we added up top
      bFn==-1
    fi
    UNTIL cF(0)=0 OR bFn=MAXREC OR bEx=TRUE
  OD

  PutE()
  PrintE("Writing database file(s)...")

  ; Write header

  ; Put Memo byte
  if bMF=TRUE then
    PutD(4,$83)
  else
    PutD(4,$03)
  fi

  ; Put Year, Month, Day
  PutD(4,dHd.bYr)
  PutD(4,dHd.bmo)
  PutD(4,dHd.bDy)

  ; Put num data recs (4 bytes of 0)
  PutD(4,$00)
  PutD(4,$00)
  PutD(4,$00)
  PutD(4,$00)

  ; Compute header size, then put
  ; 32 * num_fields + 32 (1st bytes) +
  ; 2 (term bytes)
  dHd.cHSZ=(32 * bFn) + 34
  PrintF("Header Size: %U%E",dHd.cHSZ)
  PutCD(4,dHd.cHSZ)

  ; Add delete flag to rec size, then put
  dHd.cDSZ==+1
  PrintF("Data Size  : %U%E",dHd.cDSZ)
  PutCD(4,dHd.cDSZ)

  ; Add 20 bytes of filler
  for bLp=1 to 20
  DO
    PutD(4,$00)
  OD

  ; Display header
  PutE()
  PrintE("#-- Name------ Type Len Dec")

  ; Process each input field
  for bLp=1 to bFn
  DO
    ; Compute from 1 offset (-1)
    ; Set Fld pointer to storage loc
    pFld=baFlds+((bLp-1)*SZFLD)
    ; Set Name pointer to offset
    pNm=pFld+OFFNM

    ; Display field number, name
    PrintF("%3D %-10S ",bLp,pNm)

    ; Display field type
    if pFld.bTp=$43 then
      Print("Char")
    elseif pFld.bTp=$44 then
      Print("Date")
    elseif pFld.bTp=$4C then
      Print("Log ")
    elseif pFld.bTp=$4D then
      Print("Memo")
    elseif pFld.bTp=$4E then
      Print("Num ")
    fi

    ; Display field length, decimals
    PrintF(" %3D %3D%E",pFld.cFL,pFld.bFD)

    ; Write field name and terminator
    PrintD(4,pNm)

    ; Pad name to 11 (0 based, term inc)
    for bFLp=pNm(0) to 10
    DO
      PutD(4,$00)
    OD

    ; Write field type
    PutD(4,pFld.bTp)

    ; Write fake mem address
    PutD(4,$00)
    PutD(4,$00)
    PutD(4,$00)
    PutD(4,$00)

    ; Write field length
    PutD(4,pFld.cFL)

    ; Write decimals
    PutD(4,pFld.bFD)

    ; Write two fillers for MU DB3
    PutD(4,$00)
    PutD(4,$00)

    ; Write work area ID, always 1
    PutD(4,$01)

    ; Write 11 bytes filler
    for bFLp=1 to 11
    DO
      PutD(4,$00)
    OD
  OD

  ; Write terminators
  PutD(4,$0D)
  PutD(4,$00)
  PutD(4,$1A)

  ; Close DBF file
  Close(4)

  ; If memo file, create it
  if bMF = TRUE then
    ; Open file for write
    Open(5,cDBT,8,0)

    ; If no error, proceed
    if bgErr=0 then
      ; Write first memo loc at 1
      ; 4 bytes, rest is 0.
      PutD(5, $01)

      ; Write 511 bytes of 0
      for cLp=2 to 512
      DO
        PutD(5,$00)
      OD

      ; Close DBT file
      Close(5)
    fi
  fi

  ; Display done
  PutE()
  PrintE("Database created.")
fi

; Restore Error handler and clean up
DIQuit()

; If SpartaDOS, exit through DOSVEC
if bSD=1 then
  SDx()
fi

RETURN

Breakdown

This section pulls in the Action! run time library, the Action! toolkit libraries needed, and my library files:

; Inc Action Runtime
INCLUDE "D2:SYS.ACT"

; Inc Action Toolkit parts
INCLUDE "D5:PRINTF.ACT"
INCLUDE "D5:CHARTEST.ACT"

; Include library
INCLUDE "D3:DEFINES.ACT"
INCLUDE "D3:LIBIO.ACT"
INCLUDE "D3:LIBMISC.ACT"
INCLUDE "D3:LIBDOS.ACT"

This section declares the global variables and sets up some compiler definitions. Of note is variable baFlds which is setup as large array of 1664 bytes. This is enough space to store 128 field definitions which are 13 bytes each. The field definitions are are stored as records of type DBFld:

; Start DBF Make
MODULE

; Size of a field record
DEFINE SZFLD = "13"
DEFINE OFFNM = "4"
DEFINE MAXREC = "128"
DEFINE SZMEM = "1664"

; Header record type
TYPE DBHead=[BYTE bMe,
                  bYr,
                  bMo,
                  bDy
             CARD cNDR,
                  cHSZ,
                  cDSZ]

; Field definition type
TYPE DBFld=[BYTE bTp
            CARD cFL
            BYTE bFD,
                 bNm]

; Global vars
BYTE bgErr=[0]
CARD cErrO
; Enough storage for 128 fields
BYTE ARRAY baFlds(SZMEM)

This section is the custom quit and error routines, just as I described in DBFINFO:

; Custom Quit routine
PROC DIQuit()
  ; Restore error vector
  Error=cErrO
RETURN


; Custom Error routine
PROC DIErr(BYTE bE)
  ; Set global error number
  bgErr=bE

  ; Print custom error message
  PrintF("%EERROR: ")

  if bE=170 then
    PrintE("File not found!")
  elseif bE=130 then
    PrintE("Invalid device!")
  elseif bE=255 then
    PrintE("DBF file invalid!")
  fi

  if bE>240 then
    DIQuit()
  fi
RETURN

This function gets input from an allowed set of characters without needing to press RETURN, then passes the result back as the ATASCII byte of the key pressed (in upper case). The code is well documented so I won’t break it down any further, if you have questions ask:

; Func..: GType()
; Return: BYTE=ATASCII key (upper)
; Desc..: Waits for CDLNM key
BYTE FUNC GType()
  BYTE bRCH=764,bR,bE

  ; Set exit flag 0
  bE=0

  DO
    ; Loop until keypress
    while bRCH=KNONE DO OD

    ; Get key (keycode) and reset
    bR=bRCH
    bRCH=KNONE

    ; Convert keycode to ATASCII
    if bR=18 or bR=82 then
      bR='C
      bE=1
    elseif bR=58 or bR=122 then
      bR='D
      bE=1
    elseif bR=0 or bR=64 then
      bR='L
      bE=1
    elseif bR=35 or bR=99 then
      bR='N
      bE=1
    elseif bR=37 or bR=101 then
      bR='M
      bE=1
    fi
  until bE=1
  OD
RETURN(bR)

This is the start of the main program routine. It declares the variables used:

; Main routine
PROC Main()
BYTE bFn,bEx,bMF,bLp,bFlp,bCX,bCY
BYTE bSD=[0]
; DB header record
DBHead dHd
; Pointer to field record
DBFld POINTER pFld
; Pointer to name field
BYTE POINTER pNm
; Filename and field name input
CHAR ARRAY cDBF(16),cDBT(16),cI(12),cF(11),cDt(7),cBf(5)
CARD cLp

This saves the existing error vector and assigns the custom one:

; Save and reassign error vector
cErrO=Error
Error=DIErr

This fills the memory set aside for the field storage with $00 bytes. Just making sure its clear before using it:

; Clear memory
Zero(baFlds,SZMEM)

This sections sets up the screen then calls the routine to check for SpartaDOS:

; Setup screen
Poke(82,0)
Put(CCLS)
Position(0,0)
PrintE("-[DBF Make]-----------[               ]-")

; Check for SpartaDOS
bSD=IsSD()

For now just get the date from the user. Later I may change this to detect if an RTC (real time clock) is installed and read from that. After input, it breaks the input down into year, month, and day components. It doesn’t do any data sanitization, but it should. My bad:

; Get date
Position(0,2)
Print("Todays Date (YYMMDD)?")
InputS(cDt)

; Parse date into components; YY,MM,DD
SCopyS(cBf,cDt,1,2)
dHd.bYr=ValB(cBf)
SCopyS(cBf,cDt,3,4)
dHd.bMo=ValB(cBf)
SCopyS(cBf,cDt,5,6)
dHd.bDy=ValB(cBf)

This section gets a filename from the user (it should NOT have an extension). It then defines the DBF and DBT filename variables by copying the input into each and appending the appropriate extension:

; Get filename
Print("Filename (NO ext)?")
InputS(cI)

; Create DBF and DBT names
SCopy(cDBF,cI)
SCopy(cDBT,cI)
SAssign(cDBF,".DBF",cDBF(0)+1,cDBF(0)+5)
SAssign(cDBT,".DBT",cDBT(0)+1,cDBT(0)+5)

This just saves the cursors position. After a successful file open the filename will be populated into the screen header and the cursor needs to be restored to this spot:

; Save cursor position
bCY=Peek(84)
bCX=Peek(85)

This tries to open the DBF file for writing. If it succeeds the program continues:

; Open file for write
Open(4,cDBF,8,0)

; If no error, proceed
if bgErr=0 then

The open succeeded so update the title bar with the filename and restore the cursor position:

  ; Update title with DBF name
  Position(23,0)
  Print(cDBF)
  ; Restore cursor position
  Position(bCX,bCY)

Set flags used in the field definition loop. Number of fields (bFn) to 0, dBase data record size (dHd.cDSZ) to 0, exit flag (bEx) to FALSE, and memo flag (bMF) to FALSE. Then start the field definition loop:

  ; Set field #, rec size, exit flag, memo flag
  bFn=0
  dHd.cDSZ=0
  bEx=FALSE
  bMF=FALSE

  DO

This computes a pointer to the current field definition numbers (bFn) location in our reserved storage space (baFlds). It is the size of a field definition record multiplied by the field definition number:

    ; 0 based counter computes.
    ; Set Fld pointer to storage loc
    pFld=baFlds+(bFn*SZFLD)

This computes a pointer to the fields name string within the previously calculated location for the current field definition in the reserved storage space (baFlds). It is an offset from the base pointer for the record. The offset is the combined size of the other variables in the field definition record:

    ; Set Name pointer to offset
    pNm=pFld+OFFNM

This section increases the field counter (1 based for visuals). Then it displays the field name prompt, and then gets a field name from the user. If the length of the input field is greater than 0 then the program continues from this point:

    ; Inc counter (start at 1)
    bFn==+1

    PrintF("%EField #%D (RETURN=Done)%E",bFn)

    ; Get field name
    Print("Name (10 char)? ")
    InputS(cF)

    ; If field name len > 0
    if cF(0) > 0 then

This copies the user input for the field name (cF) into the field name storage location for this record in memory (pNm):

      ; Copy input to pointer memory
      SCopy(pNm,cF)

This section gets the field type from the user. It accepts C, D, L, M, and N (upper or lower) and does not require RETURN to make the input. The result is assigned to this field records type variable after being uppercased and displayed:

      ; Get field type
      Print("Type (C/D/L/M/N)?")
      pFld.bTp=GType()

      ; Make upper and display
      pFld.bTp=ToUpper(pFld.bTp)
      Put(pFld.bTp)

This checks if the records field type is C (Character). If it is, it gets the length from the user. The input is then sanitized against acceptable values. If its greater than 254, its set to 254. If its less than 1 its set to 1:

      ; Character Field
      if pFld.bTp = 'C  then
        ; Get length
        PrintF("%ELength (1 to 254)?")
        pFld.cFL=InputB()
          ; Check bounds
          if pFld.cFL > 254 then
            pFld.cFL = 254
          elseif pFld.cFL < 1 then
            pFld.cFL = 1
          fi

This checks if the records field type is D (Date). If it is, it sets the length to 8, then forces a new line:

      ; Date Field
      elseif pFld.bTp = 'D then
        ; Set length, newline
        pFld.cFL=8
        PutE()

This checks if the records field type is L (Logical). If it is, it sets the length to 1, then forces a new line:

      ; Logical Field
      elseif pFld.bTp = 'L then
        ; Set length, newline
        pFld.cFL=1
        PutE()

This checks if the records field type is M (Memo). If it is, it sets the length to 10, sets the memo flag to TRUE, then forces a new line:

      ; Memo Field
      elseif pFld.bTp = 'M then
        ; Set length, set flag
        pFld.cFL=10
        bMF=TRUE
        PutE()

This checks if the records field type is N (Number). If it is, it gets the field length from the user. The field length is then sanitized against acceptable values between 1 and 19. Then it moves the cursor back up one line since the RETURN pushed it down. Then it gets the number of decimals from the user. The number of decimals is then sanitized against acceptable values:

      ; Numeric Field
      elseif pFld.bTp = 'N then
        ; Get field length
        PrintF("%ELength (1 to 19)?")
        pFld.cFL=InputB()

        ; Check bounds
        if pFld.cFL > 19 then
          pFld.cFL=19
        elseif pFld.cFL  15 then
          pFld.bFD=15
        fi
      fi

This adds the records field length to a running tally for the complete data record size:

      ; Add size to tally
      dHd.cDSZ==+pFld.cFL

If the user pressed RETURN at the field name prompt the program continues from here. It sets the exit flag to TRUE which allows the DO loop to stop gracefully. Then it subtracts 1 from the field number that was added before input because nothing was input:

    ; Exit
    else
      ; Set exit flag
      bEx=TRUE
      ; Minus the one we added up top
      bFn==-1
    fi

This is the end of the field input loop. It continues until one of the conditions is true. The length of a fields input is 0, the maximum number of field definitions is reached, or the exit flag is set TRUE.

    UNTIL cF(0)=0 OR bFn=MAXREC OR bEx=TRUE
  OD

Tell the user whats happening now:

  PutE()
  PrintE("Writing database file(s)...")

This is the start of where the DBF file is created. It first writes the header information that is common amongst DBF files. The first byte is the memo flag. For dBase III it is $83 if there is a memo field in the record, or $03 if there is not:

  ; Write header

  ; Put Memo byte
  if bMF=TRUE then
    PutD(4,$83)
  else
    PutD(4,$03)
  fi

Now it writes the year, month, and day to the DBF file as bytes 2,3,4:

  ; Put Year, Month, Day
  PutD(4,dHd.bYr)
  PutD(4,dHd.bmo)
  PutD(4,dHd.bDy)

Since we are creating a new file, the number of data records will always be 0. Fill bytes 5,6,7,8 with $00.

  ; Put num data recs (4 bytes of 0)
  PutD(4,$00)
  PutD(4,$00)
  PutD(4,$00)
  PutD(4,$00)

This computes the complete header size (header plus field definitions). The common header is 32 bytes and each field definition is 32 bytes, and there are 2 terminator bytes. The formula is 32 + (number_of_fields * 32) + 2. Then display the computed header size and write the CARD value to the DBF file:

  ; Compute header size, then put
  ; 32 * num_fields + 32 (1st bytes) +
  ; 2 (term bytes)
  dHd.cHSZ=(32 * bFn) + 34
  PrintF("Header Size: %U%E",dHd.cHSZ)
  PutCD(4,dHd.cHSZ)

This adds 1 byte for the deletion flag to the tallied data record size. It then displays the computed data record size and writes the CARD value to the DBF file:

  ; Add delete flag to rec size, then put
  dHd.cDSZ==+1
  PrintF("Data Size  : %U%E",dHd.cDSZ)
  PutCD(4,dHd.cDSZ)

This puts 20 bytes of filler into the DBF file. These are bytes that do not have a significant meaning:

  ; Add 20 bytes of filler
  for bLp=1 to 20
  DO
    PutD(4,$00)
  OD

This displays a header for the field definitions the program is about to output. Very similar to that of DBFINFO, if not exact:

  ; Display header
  PutE()
  PrintE("#-- Name------ Type Len Dec")

This section loops through each field definition entered. It displays the information and writes it to the DBF file:

  ; Process each input field
  for bLp=1 to bFn
  DO

This computes the field defintions record location in the reserved storage space just like was done during entry. And also computes the field name location within that record location:

    ; Compute from 1 offset (-1)
    ; Set Fld pointer to storage loc
    pFld=baFlds+((bLp-1)*SZFLD)
    ; Set Name pointer to offset
    pNm=pFld+OFFNM

This displays the field number and name:

    ; Display field number, name
    PrintF("%3D %-10S ",bLp,pNm)

This displays the field type in english terms based on the fields defined type:

    ; Display field type
    if pFld.bTp=$43 then
      Print("Char")
    elseif pFld.bTp=$44 then
      Print("Date")
    elseif pFld.bTp=$4C then
      Print("Log ")
    elseif pFld.bTp=$4D then
      Print("Memo")
    elseif pFld.bTp=$4E then
      Print("Num ")
    fi

This displays the field length and decimal precision:

    ; Display field length, decimals
    PrintF(" %3D %3D%E",pFld.cFL,pFld.bFD)

This writes the field name of this field definition to the DBF file. It then pads the field name to the 11th position with $00 bytes. 11 positions is significant for 0 terminated strings of 10 in size:

    ; Write field name and terminator
    PrintD(4,pNm)

    ; Pad name to 11 (0 based, term inc)
    for bFLp=pNm(0) to 10
    DO
      PutD(4,$00)
    OD

This writes the field type byte to the DBF file for this field definition:

    ; Write field type
    PutD(4,pFld.bTp)

The fields memory address won’t be used on the Atari and is rarely used on the PC. Fill it with $00:

    ; Write fake mem address
    PutD(4,$00)
    PutD(4,$00)
    PutD(4,$00)
    PutD(4,$00)

Write the field length and decimal precision to the DBF file for this field definition:

    ; Write field length
    PutD(4,pFld.cFL)

    ; Write decimals
    PutD(4,pFld.bFD)

The next two bytes are for multi user dBase III. The values don’t matter at creation so they are filled with $00:

    ; Write two fillers for MU DB3
    PutD(4,$00)
    PutD(4,$00)

The next byte is ALWAYS 1, always, even though its not used. It is the work area ID:

    ; Write work area ID, always 1
    PutD(4,$01)

Now write the rest of the field definition as $00 to complete the 32 byte definition in the DBF file:

    ; Write 11 bytes filler
    for bFLp=1 to 11
    DO
      PutD(4,$00)
    OD
  OD

This writes the header terminator ($0D) and the first data record (or zeroth) terminators to the DBF file. Then the DBF file is closed:

  ; Write terminators
  PutD(4,$0D)
  PutD(4,$00)
  PutD(4,$1A)

  ; Close DBF file
  Close(4)

If the memo flag was set to true, meaning there is at least one memo field defined, open the DBT file for writing. If it opened successfully continue:

  ; If memo file, create it
  if bMF = TRUE then
    ; Open file for write
    Open(5,cDBT,8,0)

    ; If no error, proceed
    if bgErr=0 then

Because this is a newly created file, the first byte will always be 1, which is the index of the first memo field location within the DBT file. The rest is filled with garbage on the PC, but I chose to fill it with $00 bytes. Each memo field location within the file is 512 bytes. Then the file is closed:

      ; Write first memo loc at 1
      ; 4 bytes, rest is 0.
      PutD(5, $01)

      ; Write 511 bytes of 0
      for cLp=2 to 512
      DO
        PutD(5,$00)
      OD

      ; Close DBT file
      Close(5)
    fi
  fi

Tell the user the database creation is complete, then call the custom quit routine to restore the error vector. Then if SpartaDOS was detected, jump to it through DOSVEC using the library routine SDx():

  ; Display done
  PutE()
  PrintE("Database created.")
fi

; Restore Error handler and clean up
DIQuit()

; If SpartaDOS, exit through DOSVEC
if bSD=1 then
  SDx()
fi

RETURN

Results

Here I created the same structure I created on the PC to test DBFINFO. 4 fields, one of each type, except MEMO. Shown using DBFINFO on the Atari 8 bit and a counterpart on the PC:

And the file size of the created file on both the Atari 8 bit and the PC:

And a comparison of the structures from the file created on the Atari 8 bit and one created on the PC:

In this shot I’ve just completed creating a database file using one of each field type including memo:

These screenshots shows my DBFINFO on the Atari 8 bit displaying information about the database structure as well as the PC counterpart displaying the same for the file created on the Atari:

These shots show the sizes of the created files (the DBF and DBT) on both the Atari 8 bit and the PC:

You an download the ATR image here. Rename it from .key to .ATR. Sorry for the inconvenience, the hosting provider doesn’t allow .ATR files.

Here is a link to a well documented dBase file structure.

Action! Program: DBF Info

Posted by Ripdubski on 2015.08.24

Posted in: Atari, Programming. Tagged: 8 bit, Action!, database, dBase, DBF, DBFINFO, DBT. Leave a comment

A lot of the posts leading up to this were exploratory of the Action! language and were occurring as I was writing this program. This program is something I’ve wanted to write for a while. In this post I present a utility to read information about dBase II/III and FoxBASE database files from the PC. Something never intended for the Atari 8 bits. I’m going to create several utilities to read and write to this format. This first one just displays information about the DBF file itself and is thusly named DBFINFO:

If file is valid (cursory evaluation at this point)
If file has an associated memo file
Date Last Updated
Number of Records
Header Size
Data Record Size
Each field name, type, length, and applicable decimal precision
Ability to dump the output to the printer

To do this I created a few databases with a set number of fields and various numbers of records. I then used documentation for the dBase III file format, a hex editor, and careful scrutiny of the byte streams to decipher the files. The documented format I found may have been correct, but it didn’t completely match the test files I created. I’ve lost the link to the page I got it from and subsequent searches have yielded what appear to be fairly accurate mappings. Maybe the original link was for a different dBase version. At any rate, it was only a few bytes off in a couple of places and only took careful examination to resolve. I’m not going to cover the structure definition in this post, but I will include the links I do have at the conclusion.

With an accurate file mapping, I started writing code to read a file. The program here is the result. This program includes a little bit of everything I’ve covered in the past Action! posts. While the code is fully documented, I am going to break it down in this post. This time the breakdown will follow the complete source – I think that makes more sense than having it before like I have done before. And since this uses several files via INCLUDE, those are listed as well (but not broken down because their contents have previously been broken down in posts).

In addition to code I wrote it uses two code libraries from the Action! Toolkit: PRINTF.ACT and CHARTEST.ACT. The source code INCLUDEs them from D5. Alter the drive for the drive you have the Action! Toolkit loaded into.

It also uses the Action! runtime library. I copied the runtime library SYS.ACT to the same drive (D2) as the program source. I did this because it requires a modification. For a successful compile the PRINTF routine has to be commented out of the runtime (SYS.ACT) because it conflicts with the PRINTF from the toolkit. Normally I have the runtime in disk 4 (D4), but here you see it included from disk 2 (D2).

The code I’ve written is released under the Creative Commons Attribution-NonCommercial-NoDerivatives 4.0 International license. Some may disagree with the license I’ve chosen. The choice is temporary until I complete the remaining components. When I feel I am finished I will alter the license to be more open.

Complete Source : DBFINFO.ACT

; Program: DBFINFO.ACT
; Author.: Wade Ripkowski
; Date...: 2015.08
; Desc...: Displays info for dBase III
;          DBF files.
; License: Creative Commons
;          Attribution-NonCommercial-
;          NoDerivatives
;          4.0 International

; Inc Action Runtime
INCLUDE "D2:SYS.ACT"

; Inc Action Toolkit parts
INCLUDE "D5:PRINTF.ACT"
INCLUDE "D5:CHARTEST.ACT"

; Include library
INCLUDE "D3:DEFINES.ACT"
INCLUDE "D3:LIBIO.ACT"
INCLUDE "D3:LIBMISC.ACT"
INCLUDE "D3:LIBDOS.ACT"

; Start DBF Info
MODULE

; Header record type
TYPE DBHead=[BYTE bMe,
                 bYr,
                 bMo,
                 bDy
            CARD cNDR,
                 cHSZ,
                 cDSZ]

; Global vars
BYTE bgErr=[0]
CARD cErrO

; Custom Quit routine
PROC DIQuit()
 ; Restore error vector
 Error=cErrO
RETURN


; Custom Error routine
PROC DIErr(BYTE bE)
 ; Set global error number
 bgErr=bE

 ; Print custom error message
 PrintF("%EERROR: ")

 if bE=170 then
   PrintE("File not found!")
 elseif bE=130 then
   PrintE("Invalid device!")
 elseif bE=255 then
   PrintE("Not dBase II/III or FoxBASE file!")
 fi
RETURN


; Reads a string from file of x bytes
PROC GetStrD(BYTE bD CHAR POINTER pS BYTE bL)
 BYTE bLp,bI,bE

 ; Set done flag
 bE=0

 ; Set string length
 pS(0)=bL

 ; Process length bytes
 for bLp=1 to bL
 DO
   ; Read a byte from device
   bI=GetD(bD)

   ; If done, pad with space
   if bE=1 then
     bI=32
   fi

   ; If null byte, set done and space
   if bI=0 then
     bI=32
     bE=1
   fi

   ; Save read value to str
   pS(bLp)=bI
 OD
RETURN


; Main routine
PROC Main()
DBHead dHd
CHAR ARRAY cDBF(16),cF(12),cB(21)
BYTE bI,bFn,bLp,bTp,bFL,bFD,bHT,bRT
CARD cI,cM
BYTE bPr,bSD=[0]

; Save and reassign error vector
cErrO=Error
Error=DIErr

; Setup screen
Poke(82,0)
Put(CCLS)
PrintE("-[DBF Info v1.0]------------------------")

; Check for SpartaDOS
bSD=IsSD()

; Get filename
Print("DBF Filename?")
InputS(cDBF)
Print("Printer Output (Y/N)?")
bPr=WaitYN(1)
PutE()

; Open file for read
Open(4,cDBF,4,0)

; If no error, proceed
if bgErr=0 then
 ; Open printer if needed
 if bPr = TRUE then
   Open(5,"P:",8,0)
 fi

 ; Display filename
 PrintF("File     : %S%E",cDBF)

 ; If print selected
 if bPr = TRUE then
   PrintFD(5,"File     : %S%E",cDBF)
 fi

 ; Read 1st byte, check type
 bI=GetD(4)

 ; Print file version
 Print("File Type: ")

 if bI = $02 then
   PrintE("dBase II")
 elseif bI = $03 then
   PrintE("dBase III/FoxBASE+ (-Memo)")
 elseif bI = $04 then
   PrintE("dBase IV (-Memo)")
 elseif bI = $05 then
   PrintE("dBase V (-Memo)")
 elseif bI = $30 then
   PrintE("Visual FoxPro")
 elseif bI = $31 then
   PrintE("Visual FoxPro (+Auto Inc)")
 elseif bI = $32 then
   PrintE("Visual FoxPro (+Var Types)")
 elseif bI = $43 then
   PrintE("dBase IV SQL table (-Memo)")
 elseif bI = $63 then
   PrintE("dBase IV SQL system (-Memo)")
 elseif bI = $7B then
   PrintE("dBase IV (+Memo)")
 elseif bI = $83 then
   PrintE("dBase III/FoxBASE+ (+Memo)")
 elseif bI = $8B then
   PrintE("dBase IV (+Memo)")
 elseif bI = $CB then
   PrintE("dBase IV SQL table (+Memo)")
 elseif bI = $E5 then
   PrintE("HiPeR-Six (+SMT Memo)")
 elseif bI = $F5 then
   PrintE("FoxPro 1/2 (+Memo)")
 elseif bI = $FB then
   PrintE("FoxBASE")
 fi

 ; If print selected
 if bPr = TRUE then
   ; Print file version
   PrintD(5,"File Type: ")

   if bI = $02 then
     PrintDE(5,"dBase II")
   elseif bI = $03 then
     PrintDE(5,"dBase III/FoxBASE+ (+Memo)")
   elseif bI = $04 then
     PrintDE(5,"dBase IV (-Memo)")
   elseif bI = $05 then
     PrintDE(5,"dBase V (-Memo)")
   elseif bI = $30 then
     PrintDE(5,"Visual FoxPro")
   elseif bI = $31 then
     PrintDE(5,"Visual FoxPro (+Auto Inc)")
   elseif bI = $32 then
     PrintDE(5,"Visual FoxPro (+Var Types)")
   elseif bI = $43 then
     PrintDE(5,"dBase IV SQL table (-Memo)")
   elseif bI = $63 then
     PrintDE(5,"dBase IV SQL system (-Memo)")
   elseif bI = $7B then
     PrintDE(5,"dBase IV (+Memo)")
   elseif bI = $83 then
     PrintDE(5,"dBase III/FoxBASE+ (+Memo)")
   elseif bI = $8B then
     PrintDE(5,"dBase IV (+Memo)")
   elseif bI = $CB then
     PrintDE(5,"dBase IV SQL table (+Memo)")
   elseif bI = $E5 then
     PrintDE(5,"HiPeR-Six (+SMT Memo)")
   elseif bI = $F5 then
     PrintDE(5,"FoxPro 1/2 (+Memo)")
   elseif bI = $FB then
     PrintDE(5,"FoxBASE")
   fi
 fi

 ; Exit if not dBase II/III or FoxBASE
 if bI # $02 AND bI # $FB AND
    bI # $03 AND bI # $83 then
   DIErr(255)
 else
   ; Read next 3 bytes (year,month,day)
   dHd.bYr=GetD(4)
   dHd.bMo=GetD(4)
   dHd.bDy=GetD(4)
   PrintF("Updated  : 20%D.%D.%D%E",dHd.bYr,dHd.bMo,dHd.bDy)

   ; If print selected
   if bPr = TRUE then
     PrintFD(5,"Updated  : 20%D.%D.%D%E",dHd.bYr,dHd.bMo,dHd.bDy)
   fi

   ; Read 2 bytes of NDR (LSBMSB)
   dHd.cNDR=GetCD(4)
   PrintF("Records  : %U%E",dHd.cNDR)

   ; If print selected
   if bPr = TRUE then
     PrintFD(5,"Records  : %U%E",dHd.cNDR)
   fi

   ; Read 2 bytes (DB MSB of NDR - millions)
   EatByteD(4,2)

   ; Read 2 bytes of HSZ (LSBMSB)
   dHd.cHSZ=GetCD(4)
   PrintF("HeaderSz : %U%E",dHd.cHSZ)

   ; If print selected
   if bPr = TRUE then
     PrintFD(5,"HeaderSz : %U%E",dHd.cHSZ)
   fi

   ; Read 2 bytes of DSZ (LSBMSB)
   dHd.cDSZ=GetCD(4)
   PrintF("Data Sz  : %U%E",dHd.cDSZ)

   ; If print selected
   if bPr = TRUE then
     PrintFD(5,"Data Sz  : %U%E",dHd.cDSZ)
   fi

   ; Read 20 bytes filler
   EatByteD(4,20)

   ; Calc # of fields
   bFn=(dHd.cHSZ-32)/32

   PrintE("#-- Name------ Type Len Dec")

   ; If print selected
   if bPr = TRUE then
     PrintDE(5,"#-- Name------ Type Len Dec")
   fi

   ; Loop through each field
   for bLp=1 to bFn
   DO
     ; Read 10 bytes of field name
     GetStrD(4,cF,10)

     ; Eat 1 byte
     EatByteD(4,1)

     ; Read 1 byte field type
     bTp=GetD(4)

     ; Eat 4 bytes of field mem addr
     EatByteD(4,4)

     ; Read 1 byte field len
     bFL=GetD(4)

     ; Read 1 byte dec len
     bFD=GetD(4)

     ; Read 14 bytes junk
     EatByteD(4,14)

     ; Print field info
     PrintF("%3D %S ",bLp,cF)

     ; If print selected
     if bPr = TRUE then
       PrintFD(5,"%3D %S ",bLp,cF)
     fi

     ; Print field type
     if bTp=$43 then
       Print("Char")
     elseif bTp=$44 then
       Print("Date")
     elseif bTp=$4C then
       Print("Log ")
     elseif bTp=$4D then
       Print("Memo")
     elseif bTp=$4E then
       Print("Num ")
     else
       Print("Unk ")
     fi

     ; If print selected
     if bPr = TRUE then
       if bTp=$43 then
         PrintD(5,"Char")
       elseif bTp=$44 then
         PrintD(5,"Date")
       elseif bTp=$4C then
         PrintD(5,"Log ")
       elseif bTp=$4D then
         PrintD(5,"Memo")
       elseif bTp=$4E then
         PrintD(5,"Num ")
       else
         Print("Unk ")
       fi
     fi

     PrintF(" %3D %3D%E",bFL,bFD)

     ; If print selected
     if bPr = TRUE then
       PrintFD(5," %3D %3D%E",bFL,bFD)
     fi
   OD

   ; Check header terminator, expect $0d
   bHT=GetD(4)

   ; Skip unknown byte
   EatByteD(4,1)

   ; Check record terminator
   ; 0 record file
   if dHd.cNDR = 0 then
     ; Get record terminator, expect $1a
     bRT=GetD(4)
   ; Multi-record file
   else
     ; Read all record bytes
     cM=(dHd.cNDR * dHd.cDSZ)
     EatByteD(4,cM)

     ; Get record terminator, expect $1a
     bRT=GetD(4)
   fi

   ; Header terminator status
   if bHT # $0D then
     PrintE("Header terminator invalid!")

     ; If print selected
     if bPr = TRUE then
       PrintDE(5,"Header terminator invalid!")
     fi
   fi

   ; Record terminator status
   if bRT # $1A then
     PrintE("Record terminator invalid!")

     ; If print selected
     if bPr = TRUE then
       PrintDE(5,"Record terminator invalid!")
     fi
   fi
 fi

 ; Close printer if opened
 if bPr = TRUE then
   Close(5)
 fi

 ; Close DBF file
 Close(4)
fi

; Restore Error handler and clean up
DIQuit()

; If SpartaDOS, exit through DOSVEC
if bSD=1 then
 SDx()
fi

RETURN

Included Source : DEFINES.ACT

; Library: DEFINES.ACT
; Desc...: Global definitions
; Author.: Wade Ripkowski
; Date...: 2015.08
; License: Creative Commons
;          Attribution-NonCommercial-
;          NoDerivatives
;          4.0 International

; Character Values
DEFINE CCLS  = "$7D"

; Booleans
DEFINE TRUE  = "1"
DEFINE FALSE = "0"

; Keystroke Values
DEFINE KNONE = "255"
DEFINE KENTER= "12"
DEFINE KESC  = "28"
DEFINE KLEFT = "134"
DEFINE KRIGHT= "135"
DEFINE KUP   = "142"
DEFINE KDOWN = "143"

; Console Key Values
DEFINE KCNONE= "7"
DEFINE KSTART= "262"
DEFINE KSELEC= "261"
DEFINE KOPTON= "259"

MODULE

Included Source : LIBIO.ACT

; Library: LIBIO.ACT
; Author.: Wade Ripkowski
; Desc...: I/O Routines
; Date...: 2015.08
; License: Creative Commons
;          Attribution-NonCommercial-
;          NoDerivatives
;          4.0 International


; Func..: CARD GetCD(BYTE bD)
; Param.: bD=device channel
; Return: CARD
; Desc..: Reads CARD value from device
CARD FUNC GetCD(BYTE bD)
  BYTE bL=[0],bM=[0]
  CARD cV=[0]

  ; Read LSB byte
  bL=GetD(bD)
  ; Read MSB byte
  bM=GetD(bD)

  ; Compute value
  cV=(bM*256)+bL
RETURN(cV)


; Func..: INT GetID(BYTE bD)
; Param.: bD=device channel
; Return: INT
; Desc..: Reads INT value from device
INT FUNC GetID(BYTE bD)
  CARD cT=[0]
  INT iV=[0]

  ; Read CARD value from device
  cT=GetCD(bD)

  ; If CARD > 65536 its a negative int
  if cT > $8000 then
    ; Flip bits and add 1 to get INT value
    cT=(cT XOR $FFFF)+1
    ; Multiply by -1 to make negative
    iV=cT*-1
  else
    ; Not a negative int, just assign
    iV=cT
  fi
RETURN(iV)


; Func..: PutCD(BYTE bD)
; Param.: bD=device channel
; Desc..: Puts CARD value to device
PROC PutCD(BYTE bD CARD cV)
  BYTE bL=[0],bM=[0]

  ; Compute MSB and LSB
  bM=cV RSH 8
  bL=cV

  ; Put LSB,MSB bytes to device
  PutD(bD,bL)
  PutD(bD,bM)
RETURN


; Func..: PutID(BYTE bD)
; Param.: bD=device channel
; Desc..: Puts INT value to device
PROC PutID(BYTE bD, INT iV)
  CARD cT

  ; If INT is negative
  if iV < 0 then
    ; Make it positive
    cT=iV * -1
    ; Convert it to high card
    cT=(cT XOR $FFFF) + 1
  else
    ; Is positive, just assign it
    cT=iV
  fi

  ; Put card value to device
  PutCD(bD,cT)
RETURN


; Func..: EatByteD(BYTE bD CARD cL)
; Param.: bD=device channel
;         cL=number of bytes
; Desc..: Read x bytes from device
;         w/o save
PROC EatByteD(BYTE bD BYTE cL)
  BYTE bI
  CARD cLp

  ; Process len bytes
  for cLp=1 to cL
  DO
    ; Read byte and disregard
    bI=GetD(bD)
  OD
RETURN

MODULE

Included Source : LIBMISC.ACT

; Library: LIBMISC.ACT
; Author.: Wade Ripkowski
; Desc...: Misc Routines
; Date...: 2015.08
; License: Creative Commons
;          Attribution-NonCommercial-
;          NoDerivatives
;          4.0 International

; Requires DEFINES.ACT be loaded 1st!

; Func..: WaitYN(BYTE bE)
; Param.: bE=1 to print Y or N
; Return: BYTE (1=Y,0=N)
; Desc..: Waits for Y or N keypress
BYTE FUNC WaitYN(BYTE bE)
  BYTE bRKEYCH=764,bR=[0],bK=[0]

  DO
    ; Wait for any keypress
    WHILE bRKEYCH=KNONE DO OD

    ; Key keypress and reset debounce
    bK=bRKEYCH
    bRKEYCH=KNONE
  ; Stay in loop until YyNn
  UNTIL bK=43 OR bK=107 OR
        bK=35 OR bK=99
  OD

  ; If Yy then set return 1
  if bK=43 OR bK=107 then
    bR=1
  fi

  ; If echo on
  if bE=1 then
    ; If Y, print Y
    if bR=1 then
      Put('Y)
    ; Else print N
    else
      Put('N)
    fi
  fi
RETURN(bR)

MODULE

Included Source : LIBDOS.ACT

; Library: LIBDOS.ACT
; Desc...: DOS routines
; Author.: Wade Ripkowski
; Date...: 2015.08
; License: Creative Commons
;          Attribution-NonCommercial-
;          NoDerivatives
;          4.0 International

; Proc..: IsSD()
; Return: bR: 1=yes, 0=no
BYTE FUNC IsSD()
  BYTE bR=[0],bPk=[0]

  ; Get value from loc 3889
  bPk=Peek(3889)

  ; Sparta if 0,15,68,89
  if bPk=0 OR bPk=15 OR
     bPk=68 OR bPk=89 then
    bR=1
  fi
RETURN(bR)

; Proc..: SDx()
; Desc..: Exits to DOSVEC ($000A) via
;         JMP using inline assembly
PROC SDx()
[ $6C $0A $00 ]

MODULE

Source Breakdown : DBFINFO.ACT

Excerpts from the complete source above are further explained here. In this first section all the includes are pulled in. The first is the Action! Runtime package. This one is a copy and has PrintF commented out because I want the PrintF from the Action! Toolkit instead as it has padding built-in. The runtime package lets the program run without the Action! cartridge installed. Then I pull in two parts from the Action! Toolkit; the expanded PrintF routine and some Character Test routines. Following that I pull in the custom library routines I’ve written (broken down by category):

; Inc Action Runtime
INCLUDE "D2:SYS.ACT"

; Inc Action Toolkit parts
INCLUDE "D5:PRINTF.ACT"
INCLUDE "D5:CHARTEST.ACT"

; Include library
INCLUDE "D3:DEFINES.ACT"
INCLUDE "D3:LIBIO.ACT"
INCLUDE "D3:LIBMISC.ACT"
INCLUDE "D3:LIBDOS.ACT"

In this section I declare the dBase Header record, or all of it minus the actual field definitions anyway. There is a memo flag which indicates if the file has an associated memo field file; the year, month, and day of the last update; the number of data records; the size of the file header; and the data record size including one byte for the deletion flag:

; Header record type
TYPE DBHead=[BYTE bMe,
                 bYr,
                 bMo,
                 bDy
            CARD cNDR,
                 cHSZ,
                 cDSZ]

These variables are used for storing the last encountered error (bgErr), and the address of the original Error vector. I change it to customize error handling:

; Global vars
BYTE bgErr=[0]
CARD cErrO

This is the custom quit routine meant to clean up environment things the program changes. I had grander plans for this but haven’t fleshed it out entirely yet. It just resets the Error vector back to the original. In its current state, it could just as well be a single line of code at the end of the program instead of a PROCedure:

; Custom Quit routine
PROC DIQuit()
 ; Restore error vector
 Error=cErrO
RETURN

This is the custom error routine. It accepts the error encounter as a byte parameter. It sets the global variable bgErr so it can be referenced later by other parts of the program. It then displays the appropriate error message. Non-DOS (i.e.; program custom) errors are high numbers like 255. Since this program is only designed to read dBase II/III, and FoxBASE files, that is currently the only custom error:

; Custom Error routine
PROC DIErr(BYTE bE)
 ; Set global error number
 bgErr=bE

 ; Print custom error message
 PrintF("%EERROR: ")

 if bE=170 then
   PrintE("File not found!")
 elseif bE=130 then
   PrintE("Invalid device!")
 elseif bE=255 then
   PrintE("Not dBase II/III or FoxBASE file!")
 fi
RETURN

This routine reads a string of x bytes (bL) from the specified device (bD) and stores the result in the given string (pS). When it encounters a NULL byte (0), it starts padding the string with space until all bytes required are filled:

; Reads a string from file of x bytes
PROC GetStrD(BYTE bD CHAR POINTER pS BYTE bL)
 BYTE bLp,bI,bE

 ; Set done flag
 bE=0

 ; Set string length
 pS(0)=bL

 ; Process length bytes
 for bLp=1 to bL
 DO
   ; Read a byte from device
   bI=GetD(bD)

   ; If done, pad with space
   if bE=1 then
     bI=32
   fi

   ; If null byte, set done and space
   if bI=0 then
     bI=32
     bE=1
   fi

   ; Save read value to str
   pS(bLp)=bI
 OD
RETURN

This is the start of the long (too long) main routine. The printing should be broken down into a separate function which would make it a lot shorter. In the next version perhaps. This declares a DBHead variable (dHd) to store the dBase header info (minus field definitions). It then declares 3 character strings to store the database file name (cDBF), string storage for a field name (cF), and small buffer (cB). It then declares a handful of bytes for various things; bI is an input byte; bFn tracks the field number; bLp is for looping; bTp is the field type; bFL is the field length; bFD is the field decimal precision; bHT is the header terminator; bRT is the record terminator. Then there are two cards; cI is an input card; cM is used to hold the number of bytes consumed by all records via calculation. Then there are two last bytes; bPr is the send to printer flag, and bSD holds the SpartaDOS detection flag:

; Main routine
PROC Main()
DBHead dHd
CHAR ARRAY cDBF(16),cF(12),cB(21)
BYTE bI,bFn,bLp,bTp,bFL,bFD,bHT,bRT
CARD cI,cM
BYTE bPr,bSD=[0]

This sections saves the original error vector and assigns it to the custom one. It then sets up the screen for output. I used plain ASCII for all these blog posts because ATASCII doesn’t display properly.

; Save and reassign error vector
cErrO=Error
Error=DIErr

; Setup screen
Poke(82,0)
Put(CCLS)
PrintE("-[DBF Info v1.0]------------------------")

This calls the routine to check for SpartDOS and stores the flag. It needs to know so it can exit properly:

; Check for SpartaDOS
bSD=IsSD()

This just gets the filename from the user and asks if the output should also be printed to the printer:

; Get filename
Print("DBF Filename?")
InputS(cDBF)
Print("Printer Output (Y/N)?")
bPr=WaitYN(1)
PutE()

This tries to open device (4) with the file given by the user (cDBF) for read (4). If there was no error (bgErr is 0) then proceed. Next try to open device (5) to the printer (P:) for write (8):

; Open file for read
Open(4,cDBF,4,0)

; If no error, proceed
if bgErr=0 then
 ; Open printer if needed
 if bPr = TRUE then
   Open(5,"P:",8,0)
 fi

Just display the filename, and optionally print:

 ; Display filename
 PrintF("File     : %S%E",cDBF)

 ; If print selected
 if bPr = TRUE then
   PrintFD(5,"File     : %S%E",cDBF)
 fi

This section reads the first byte of the file. This is the signature byte. It tells what flavor of dBase created it. Then it displays the name of the dBase flavor based on the value. And then it optionally prints the same information:

 ; Read 1st byte, check type
 bI=GetD(4)

 ; Print file version
 Print("File Type: ")

 if bI = $02 then
   PrintE("dBase II")
 elseif bI = $03 then
   PrintE("dBase III/FoxBASE+ (-Memo)")
 elseif bI = $04 then
   PrintE("dBase IV (-Memo)")
 elseif bI = $05 then
   PrintE("dBase V (-Memo)")
 elseif bI = $30 then
   PrintE("Visual FoxPro")
 elseif bI = $31 then
   PrintE("Visual FoxPro (+Auto Inc)")
 elseif bI = $32 then
   PrintE("Visual FoxPro (+Var Types)")
 elseif bI = $43 then
   PrintE("dBase IV SQL table (-Memo)")
 elseif bI = $63 then
   PrintE("dBase IV SQL system (-Memo)")
 elseif bI = $7B then
   PrintE("dBase IV (+Memo)")
 elseif bI = $83 then
   PrintE("dBase III/FoxBASE+ (+Memo)")
 elseif bI = $8B then
   PrintE("dBase IV (+Memo)")
 elseif bI = $CB then
   PrintE("dBase IV SQL table (+Memo)")
 elseif bI = $E5 then
   PrintE("HiPeR-Six (+SMT Memo)")
 elseif bI = $F5 then
   PrintE("FoxPro 1/2 (+Memo)")
 elseif bI = $FB then
   PrintE("FoxBASE")
 fi

 ; If print selected
 if bPr = TRUE then
   ; Print file version
   PrintD(5,"File Type: ")

   if bI = $02 then
     PrintDE(5,"dBase II")
   elseif bI = $03 then
     PrintDE(5,"dBase III/FoxBASE+ (+Memo)")
   elseif bI = $04 then
     PrintDE(5,"dBase IV (-Memo)")
   elseif bI = $05 then
     PrintDE(5,"dBase V (-Memo)")
   elseif bI = $30 then
     PrintDE(5,"Visual FoxPro")
   elseif bI = $31 then
     PrintDE(5,"Visual FoxPro (+Auto Inc)")
   elseif bI = $32 then
     PrintDE(5,"Visual FoxPro (+Var Types)")
   elseif bI = $43 then
     PrintDE(5,"dBase IV SQL table (-Memo)")
   elseif bI = $63 then
     PrintDE(5,"dBase IV SQL system (-Memo)")
   elseif bI = $7B then
     PrintDE(5,"dBase IV (+Memo)")
   elseif bI = $83 then
     PrintDE(5,"dBase III/FoxBASE+ (+Memo)")
   elseif bI = $8B then
     PrintDE(5,"dBase IV (+Memo)")
   elseif bI = $CB then
     PrintDE(5,"dBase IV SQL table (+Memo)")
   elseif bI = $E5 then
     PrintDE(5,"HiPeR-Six (+SMT Memo)")
   elseif bI = $F5 then
     PrintDE(5,"FoxPro 1/2 (+Memo)")
   elseif bI = $FB then
     PrintDE(5,"FoxBASE")
   fi
 fi

This section decides if the program can continue. It is capable of reading dBase II, dBase III, and FoxBASE files. If the signature byte is not one of those, call the error routine and drop to the endif later in the code to exit cleanly, otherwise start the next section:

 ; Exit if not dBase II/III or FoxBASE
 if bI # $02 AND bI # $FB AND
    bI # $03 AND bI # $83 then
   DIErr(255)
 else

This gets the next part of the header; the year, the month, and the day of last update. it then displays the information and optionally prints it:

   ; Read next 3 bytes (year,month,day)
   dHd.bYr=GetD(4)
   dHd.bMo=GetD(4)
   dHd.bDy=GetD(4)
   PrintF("Updated  : 20%D.%D.%D%E",dHd.bYr,dHd.bMo,dHd.bDy)

   ; If print selected
   if bPr = TRUE then
     PrintFD(5,"Updated  : 20%D.%D.%D%E",dHd.bYr,dHd.bMo,dHd.bDy)
   fi

This reads the number of data records from the file header. It’s a card value. It then displays the information and optionally prints it:

   ; Read 2 bytes of NDR (LSBMSB)
   dHd.cNDR=GetCD(4)
   PrintF("Records  : %U%E",dHd.cNDR)

   ; If print selected
   if bPr = TRUE then
     PrintFD(5,"Records  : %U%E",dHd.cNDR)
   fi

This eats the last 2 bytes of the number of data records. Sizes it likely will never need to support anyway. The previous card value will support up to 65 thousand records:

   ; Read 2 bytes (DB MSB of NDR - millions)
   EatByteD(4,2)

This reads the header size from the file header. It’s a card value. It then displays the information and optionally prints it:

   ; Read 2 bytes of HSZ (LSBMSB)
   dHd.cHSZ=GetCD(4)
   PrintF("HeaderSz : %U%E",dHd.cHSZ)

   ; If print selected
   if bPr = TRUE then
     PrintFD(5,"HeaderSz : %U%E",dHd.cHSZ)
   fi

This reads the data record size from the file header. It’s a card value. It then displays the information and optionally prints it:

   ; Read 2 bytes of DSZ (LSBMSB)
   dHd.cDSZ=GetCD(4)
   PrintF("Data Sz  : %U%E",dHd.cDSZ)

   ; If print selected
   if bPr = TRUE then
     PrintFD(5,"Data Sz  : %U%E",dHd.cDSZ)
   fi

This reads the next 20 bytes from the file. The result is discarded. There are some additional flags in a couple of bytes but they are of no interest for this program:

   ; Read 20 bytes filler
   EatByteD(4,20)

This calculates the # of field definitions it needs to parse from the file header. It’s the header size minus 32, all divided by 32. It then displays a header line for the subsequent field information and optionally prints it:

   ; Calc # of fields
   bFn=(dHd.cHSZ-32)/32

   PrintE("#-- Name------ Type Len Dec")

   ; If print selected
   if bPr = TRUE then
     PrintDE(5,"#-- Name------ Type Len Dec")
   fi

This is the start of the loop in which each field definition is read from the header:

   ; Loop through each field
   for bLp=1 to bFn
   DO

Read 10 bytes as a string for the field name. Then read one byte and discard. This is the 11th byte (0 terminator) of the field name:

     ; Read 10 bytes of field name
     GetStrD(4,cF,10)

     ; Eat 1 byte
     EatByteD(4,1)

Read 1 byte for the field type. It can be C for character, D for date, L for logical, M for memo, or N for numeric:

     ; Read 1 byte field type
     bTp=GetD(4)

This eats 4 bytes of the fields address in memory. Something the Atari couldn’t use if it wanted to. I’m not sure why it’s there anyway:

     ; Eat 4 bytes of field mem addr
     EatByteD(4,4)

This reads 1 byte for the field length and 1 byte for the fields decimal precision. Then it reads 14 bytes of junk to discard:

     ; Read 1 byte field len
     bFL=GetD(4)

     ; Read 1 byte dec len
     bFD=GetD(4)

     ; Read 14 bytes junk
     EatByteD(4,14)

This prints the field information that was just read in, and optionally prints it. It starts with the field number and name. The number is printed using Action! Toolkits PrintF to take advantage of padded output at 3 characters wide. This also displays, and optionally prints, the field type in a short descriptive form. And it displays and optionally prints the field length and decimal precision:

     ; Print field info
     PrintF("%3D %S ",bLp,cF)

     ; If print selected
     if bPr = TRUE then
       PrintFD(5,"%3D %S ",bLp,cF)
     fi

     ; Print field type
     if bTp=$43 then
       Print("Char")
     elseif bTp=$44 then
       Print("Date")
     elseif bTp=$4C then
       Print("Log ")
     elseif bTp=$4D then
       Print("Memo")
     elseif bTp=$4E then
       Print("Num ")
     else
       Print("Unk ")
     fi

     ; If print selected
     if bPr = TRUE then
       if bTp=$43 then
         PrintD(5,"Char")
       elseif bTp=$44 then
         PrintD(5,"Date")
       elseif bTp=$4C then
         PrintD(5,"Log ")
       elseif bTp=$4D then
         PrintD(5,"Memo")
       elseif bTp=$4E then
         PrintD(5,"Num ")
       else
         Print("Unk ")
       fi
     fi

     PrintF(" %3D %3D%E",bFL,bFD)

     ; If print selected
     if bPr = TRUE then
       PrintFD(5," %3D %3D%E",bFL,bFD)
     fi

This completes the loop for reading field definitions from the header:

OD

This reads the header terminator byte which should be hex 0D. It then reads one unknown byte (documentation I’ve found isn’t clear about it):

   ; Check header terminator, expect $0d
   bHT=GetD(4)

   ; Skip unknown byte
   EatByteD(4,1)

This checks if the number of data records is 0 or not. The record terminator is in different positions based on the number of records. This byte is read to validate if the file is structure properly:

   ; Check record terminator
   ; 0 record file
   if dHd.cNDR = 0 then

If the number of data records is 0, read the next byte which is the record terminator; hex 1A:

     ; Get record terminator, expect $1a
     bRT=GetD(4)

If the number of data records is greater than 0, read all the bytes for all data records inclusive of each records deletion flag (number of data records times the data record size). The output is not needed for this program so it is discarded. Then read the record terminator:

   ; Multi-record file
   else
     ; Read all record bytes
     cM=(dHd.cNDR * dHd.cDSZ)
     EatByteD(4,cM)

     ; Get record terminator, expect $1a
     bRT=GetD(4)
   fi

This checks if the header terminator was read correctly. If the value is not right the file structure is likely corrupt or otherwise invalid. If the value is not hex 0D, display and optionally print an error:

   ; Header terminator status
   if bHT # $0D then
     PrintE("Header terminator invalid!")

     ; If print selected
     if bPr = TRUE then
       PrintDE(5,"Header terminator invalid!")
     fi
   fi

This checks if the record terminator was read correctly. If the value is not right the file structure is likely corrupt, truncated, or otherwise invalid. If the value is not hex 1A, display and optionally print an error:

   ; Record terminator status
   if bRT # $1A then
     PrintE("Record terminator invalid!")

     ; If print selected
     if bPr = TRUE then
       PrintDE(5,"Record terminator invalid!")
     fi
   fi

This concludes the check of the files signature byte to ensure the file can be parsed; from far above:

fi

This cleans up by closing the printer on device 5, if opened; and the dBase file (cDBF) on device 4:

; Close printer if opened
 if bPr = TRUE then
   Close(5)
 fi

 ; Close DBF file
 Close(4)

This concludes the initial device open success check for the dBase file (cDBF) on device 4 from far above:

fi

In this final section the custom quit routine is called to restore the original Error vector. Then if SpartaDOS was detected a call to my library routine SDx is made. This causes the program to JMP to DOSVEC so it will return to the SpartaDOS command prompt:

; Restore Error handler and clean up
DIQuit()

; If SpartaDOS, exit through DOSVEC
if bSD=1 then
 SDx()
fi

RETURN

Results

I ran a PC DOS based version of a similar program as a validation against each of the files. I’ll present screenshots of both the PC DOS and my Action! version against each file.

The first is a zero (0) record DBF file (RECFLD.DBF) – essentially just a database structure:

The second is a single (1) record DBF file (RECFLD1.DBF):

The third is a triple (3) record DBF file (RECFLD3.DBF):

The last is a one hundred (100) field DBF file structure (no records – RECFLD99.DBF). Because there are more lines than will fit on the screen I redirected the PC output to this file: PC Output PDF

…

For the 99 record (100) one I also send the output to the printer: A8 Output PDF

All of the above showed databases with fields names of 8 characters. Here are screenshots from both the PC and Atari showing field names with 10 characters, just to prove it works:

I’ve included an ATR image as well. It has the program source, the libraries, the compiled program, and sample databases. Download the ATR. Remove the “.key” from it and add “.ATR”. It is not a Keynote file! ATR and zip are not allowed hosting types here so I added “.key” to it.

And finally there is this thread on AtariAge forums talking about dBase for Atari. Looks like dBase II was released for the Atari ST only.

Links

Here are some links discussing the dBase file format where I discovered what most of the structure is:

http://www.clicketyclick.dk/databases/xbase/format/dbf.html#DBF_NOTE_8_TARGET

http://www.dbf2002.com/dbf-file-format.html

Coding Style

Posted by Ripdubski on 2015.08.22

Posted in: Programming. Tagged: debugging. Leave a comment

I’ve been programming in one context or another nearly all my life. Sometimes for fun, sometimes professionally. Even now, though programmer is not my title, I find myself programming a lot, writing programs in interpreted languages like Perl, and scripted programs in command shells like Korn/BASH. I think programming even at a simple level like scripts in Korn (modern), or BASIC (retro, possibly some modern) is an essential skill for anyone working with computers.

Needless to say the early days on the Atari 8 bit were instrumental in teaching me logic sequences that are necessary to write programs. These are so ingrained I often think in “code” especially when solving problems. In my career, when I was strictly a programmer I was exposed to a lot of other programmers writing styles, many of which I could not stand for one reason or another. I didn’t want to write the code that someone else couldn’t stand so I immersed myself in best practices books.

Two books in particular played huge roles in how I code today. Though they are older books now, they still have some great fundamental teachings. One was geared a bit toward programming in C, but much of its teachings can be directly applied to other languages. When you see any of my code, with very few exceptions, the principles I learned in these books are apparent. After you finish reading this post you’ll understand why my variables seem to start with the same letters, and a bit more about my coding style.

Both of these books are Microsoft Press books. They were both released in January of 1993. The first of which is “Writing Solid Code” by Steve Maguire. The second is “Code Complete” by Steve McConnell. I highly recommend both of these books to anyone that writes code in any language.

Here are the top three topics I learned from these books, not in any particular order of importance.

Variable Notation

One of the things you may have noticed in much of the code I’ve posted so far is how I name variables. I adopted a form of naming called Hungarian Notation in the course of reading these books. There are arguments for and against it’s use. In all the years I’ve been using it I’ve not run into any of the negatives, so I endorse it’s use. You can read more about it at this link. So why use it? In simplest terms it aids in readability, essential self commenting code.

My implementation of the notation doesn’t follow the specification exactly. In short I preface all variables with a lowercase first letter of its type, but I don’t apply the function/procedure naming in absolute terms. So a variable of type char would start with a c, one of integer would start with i. I apply to each language I code in using that languages primitive types. One thing I do that is slightly different is naming of globals. I will add a g, typically the second letter in the variable name to signify a global. The system has worked great for me, but your mileage may vary.

Comments

Likely this largest lesson I learned from these books was the value in comments. Comments in code have saved me from many hours of reverse engineering. Think you’ll write some code once and never touch it again. Ha! Good luck with that. The intrinsic value of well structured comments will be readily apparent the first time you need to touch:

Code you wrote x years ago, say 10 for example. Will you remember or know what that specialized function does, how it works, or what data or string syntax it expects to work with many years later without any comments. Possible, but not likely.
Code written by someone else. This I find to be the most irksome. Even if the author commented it, sometimes the comments are not descriptive enough.

Comment, comment, comment!

Debugging

Debugging can be a nightmare. It was especially hard for me to debug the 6502 Assembly code I was learning last year. I didn’t have the tools or experience to do it easily and ended up spending hours tracing through it on paper! Not ideal. The top 3 things these books taught me about debugging are:

If the language supports it, use assertions to validate variable values. In absence of assertions, use printed output.
If you have a debugging tool, use it to trace through code blocks.
If you have a complex calculation, validate it with an alternative algorithm.

Links

Here are all the links from the post in one convenient location, as well as some additional relevant ones.

Writing Solid Code

Writing Solid Code – Amazon

Code Complete

Code Complete – Amazon

Hungarian Notation

Hungarian Notation – The Good, The Bad, The Ugly

Action! Record Arrays

Posted by Ripdubski on 2015.08.18

Posted in: Atari, Programming. Tagged: 8 bit, Action!. Leave a comment

In this post I expand on using records. This time creating a record array that contains a character string, or more specifically two character strings. Action! won’t allow you to add a CHAR ARRAY as part of a record (TYPE) definition. You can get around this limitation by using BYTE POINTERS. You place the string as the last variable in the TYPE definition, but as a BYTE declaration.

To include multiple string variables, a series of bytes must be added to “reserve” space for the first string. For the tContact TYPE below, bFNm is first name, bLNm is last name, and bR1 through bR10 are the “reserve” bytes. None of these will be referenced via the record.field syntax, though you could for types other than CHAR ARRAY.

TYPE tContact=[BYTE bFNm,
                    bR1,bR2,bR3,bR4,bR5,bR6,bR7,bR8,bR9,bR10,
                    bLNm]

Pointer Calculation

Suppose you have a BYTE ARRAY name bArray for storage space, a BYTE POINTER named bpFirst for first name, and bpLast for last name. The first name is 10 bytes (11 with size), and last name is 15 bytes (16 with size). The last name offset into the record is therefore 11. The size of the entire record (first name and last name) is 27 bytes. First Name Record 1 will be stored at 0 offset into the storage array. Record 2 will be stored at 0+(1*RecordSize) into the storage array. Record 3 will be stored at 0+(2*RecordSize) into the storage array, etc. Last Name Record 1 will be stored at 0+FirstNameSize offset into the storage array (11 bytes). Record 2 will be stored at 0+(1*RecordSize)+FirstNameSize offset into the storage array. Record 3 will be stored at 0+(2*RecordSize)+FirstNameSize into the storage array, etc.

Program Source

The source is fairly well documented and I’ve given a good explanation of how it works so I won’t break it down line by line:

; Program: RECARRAY.ACT
; Date...: 2015.08

; Inc Action Toolkit parts
INCLUDE "D5:PRINTF.ACT"

; Start program globals
MODULE

; Size of a field record
DEFINE SZREC = "27"
; Offset of last name into record
DEFINE OFFLN = "11"
; Max number records
DEFINE MAXREC = "50"
; Size of storage pool (SZ's * MAXREC)
DEFINE SZMEM = "1350"

; Contact definition type
; bFN = First byte of first name
; bR1..10 = First name bytes
; bLn = First byte of last name
TYPE tContact=[BYTE bFNm,
                    bR1,bR2,bR3,bR4,bR5,bR6,bR7,bR8,bR9,bR10,
                    bLNm]

; Enough storage for MAXREC contacts
BYTE ARRAY baFlds(SZMEM)


; Main routine
PROC Main()
; Record counter and loop var
BYTE bEn,bLp
; Pointer to contact record
tContact POINTER pRec
; Pointers to name fields
BYTE POINTER pFNm,pLNm
; Name input vars
CHAR ARRAY cFNm(11),cLNm(16)

; Clear memory
Zero(baFlds,SZMEM)

; Setup screen
Poke(82,0)
Put($7D)
Position(0,0)
PrintE("-[Record Arrays]------------------------")
Position(0,1)

; Set entry #
bEn=0

DO
  ; 0 based counter computes.
  ; Set record pointer to storage loc
  pRec=baFlds+(bEn*SZREC)
  ; Set Name pointers to offsets
  pFNm=pRec
  pLNm=pRec+OFFLN

  ; Inc counter (start at 1)
  bEn==+1

  PrintF("%EEntry #%D (RETURN=Done)%E",bEn)

  ; Get first name
  Print("First Name (10 char)? ")
  InputS(cFNm)

  ; If first name len > 0
  if cFNm(0) > 0 then
    SCopy(pFNm,cFNm)

    ; Get last name
    Print(" Last Name (15 char)? ")
    InputS(cLNm)

    ; If last name len > 0
    if cLNm(0) > 0 then
      SCopy(pLNm,cLNm)
    fi
  fi

  PutE()

  ; Repeat until empty input, max record
  UNTIL cFNm(0)=0 OR cLNm(0)=0 OR bEn=MAXREC
OD

; Regress counter by 1
bEn==-1

; Printe header for output validation
PutE()
PrintE("First----- Last-----------")

; Process each input field
for bLp=1 to bEn
DO
  ; Compute from 1 offset (-1)
  ; Set Fld pointer to storage loc
  pRec=baFlds+((bLp-1)*SZREC)
  ; Set Name pointers to offsets
  pFNm=pRec
  pLNm=pRec+OFFLN

  PrintF("%10S %15S%E",pFNm,pLNm)
OD

RETURN

Results

Here I input one control first and last name, then a data point first and last name, then another control first and last name:

Here the program displays the array contents, validating they are stored on the proper byte boundaries within the allocated memory space for storage:

Action! Yes or No

Posted by Ripdubski on 2015.08.12

Posted in: Atari, Programming. Tagged: 8 bit, Action!. Leave a comment

I’m writing a utility program to do something useful, stay tuned, and in doing so I needed a routine to get a yes or no response from the user. I didn’t want the user to have to press the RETURN key, so I decided to read the keyboard without an input. I also wanted validation on the input so only valid keys would exit, in this case Y,y,N,n.

I created the following routine which returns a BYTE value. The value will be 1 if either Y is pressed. The value will be 0 if either N is pressed. It takes one parameter which is a BYTE value. 1 indicates the routine should echo Y or N to the display after the press. The source will not be broken down as it is commented well.

Routine Source

; Func..: WaitYN(BYTE bEcho)
; Param.: bEcho=1 to print Y or N
; Return: BYTE (1=Y,0=N)
; Desc..: Waits for Y or N keypress
BYTE FUNC WaitYN(BYTE bEcho)
  ; Declare bRKEYCH to point to mem location 764
  BYTE bRKEYCH=764,bRet=[0],bKey=[0]

  DO
    ; Wait for any keypress
    ; Continual loop while no keys pressed
    WHILE bRKEYCH=KNONE DO OD

    ; Get keypress and reset debounce
    bKey=bRKEYCH
    bRKEYCH=KNONE
  ; Stay in loop until YyNn
  UNTIL bKey=43 OR bKey=107 OR
        bKey=35 OR bKey=99
  OD

  ; If Yy then set return 1
  if bKey=43 OR bKey=107 then
    bRet=1
  fi

  ; If echo on
  if bEcho=1 then
    ; If Y, print Y
    if bRet=1 then
      Put('Y)
    ; Else print N
    else
      Put('N)
    fi
  fi
RETURN(bRet)

Program Source

MODULE

; Define the value of no key pressed
DEFINE KNONE = "255" 

; Func..: WaitYN(BYTE bEcho)
; Param.: bEcho=1 to print Y or N
; Return: BYTE (1=Y,0=N)
; Desc..: Waits for Y or N keypress
BYTE FUNC WaitYN(BYTE bEcho)
  ; Declare bRKEYCH to point to mem location 764
  BYTE bRKEYCH=764,bRet=[0],bKey=[0]

  DO
    ; Wait for any keypress
    ; Continual loop while no keys pressed
    WHILE bRKEYCH=KNONE DO OD

    ; Get keypress and reset debounce
    bKey=bRKEYCH
    bRKEYCH=KNONE
  ; Stay in loop until YyNn
  UNTIL bKey=43 OR bKey=107 OR
        bKey=35 OR bKey=99
  OD

  ; If Yy then set return 1
  if bKey=43 OR bKey=107 then
    bRet=1
  fi

  ; If echo on
  if bEcho=1 then
    ; If Y, print Y
    if bRet=1 then
      Put('Y)
    ; Else print N
    else
      Put('N)
    fi
  fi
RETURN(bRet)

; Main routine
PROC Main()
; Declare a byte to store the response
BYTE bY=[0]

; Ask a question, get a YN from user
Print("Save (Y/N)?")
bY=WaitYN(1)

; If response was Y, print YES
if bY=1 then
  PrintE("  (YES)")
; Otherwise print NO
else
  PrintE("  (NO)")
fi

RETURN

Results

My example program running over and over asking the same question. I answered with a mix of upper and lower case Y and N:

Action! Inline Assembly

Posted by Ripdubski on 2015.08.11

Posted in: Atari, Programming. Tagged: 8 bit, Action!. Leave a comment

This time I’m exploring inline Assembly language within Action!. This is more or less the equivalent to Atari BASIC USR routines. It turns out to be pretty easy to do.

In this example I use inline Assembly to execute the following code:

JSR $000A

This breaks down into 3 bytes of code. The instruction JSR is $6C. The address breaks down into two bytes (LSB first) $0A and $00. To add the instructions as inline Assembly, they get wrapped in square brackets with each byte separated by a space like this:

[ $6C $0A $00 ]

This code simply does a jump to the DOS entry point vector (DOSVEC). The code is useful with compiled Action! programs running from SpartaDOS. A normal return results in a system hang so the special exit is required to return to DOS.

The sample program I created tests to see if SpartaDOS is loaded. It will report if SpartaDOS is present. If it is, the program will use the special exit routine through DOSVEC jump, other wise it will exit normally.

Source Code

INCLUDE "D4:SYS.ACT"

MODULE

; Proc..: IsSparta()
; Return: bRet: 1=yes, 0=no
BYTE FUNC IsSparta()
  BYTE bRet=[0],bPk=[0]

  ; Get value from loc 3889
  bPk=Peek(3889)

  ; Sparta if 0,15,68,89
  if bPk=0 OR bPk=15 OR 
     bPk=68 OR bPk=89 then
    bRet=1
  fi
RETURN(bRet)


; Proc..: SDExit()
; Desc..: Exits to DOSVEC ($000A) via
;         JSR using inline assembly
PROC SDExit()
[ $6C $0A $00 ]


PROC Main()
  BYTE bSparta=[0]

  ; Setup screen
  Put($7D)
  PrintE("Checking for SpartaDOS.")

  ; Is it Sparta or not
  bSparta=IsSparta()

  Print("DOS : ")
 
  ; If Sparta
  if bSparta=1 then
    ; Say so
    PrintE("SpartaDOS")
    ; Exit via DOSVEC
    SDExit()
  ; Else, say so, normal exit
  else
    PrintE("Other")
  fi
RETURN

Breakdown

This section brings in the Action! Runtime library so the compilation will build a stand-alone executable that does not require the Action! cartridge:

INCLUDE "D4:SYS.ACT"

MODULE

This is a function which checks memory location 3889 for value 0, 15 ,68, or 89. Any of these values indicate SpartaDOS is loaded. The function returns a BYTE value of 1 if SpartaDOS is detected, and 0 if it is not.

; Func..: IsSparta()
; Return: bRet: 1=yes, 0=no
BYTE FUNC IsSparta()
  BYTE bRet=[0],bPk=[0]

  ; Get value from loc 3889
  bPk=Peek(3889)

  ; Sparta if 0,15,68,89
  if bPk=0 OR bPk=15 OR 
     bPk=68 OR bPk=89 then
    bRet=1
  fi
RETURN(bRet)

This procedure is the custom exit routine to be used if SpartaDOS is loaded. It uses inline Assembly to execute a JSR to the DOSVEC address.

; Proc..: SDExit()
; Desc..: Exits to DOSVEC ($000A) via
;         JSR using inline assembly
PROC SDExit()
[ $6C $0A $00 ]

This is the main routine. In this section a BYTE is declared to hold a flag for the SpartDOS detection. It also clears the screen and displays the message “Checking for SpartaDOS.”:

PROC Main()
  BYTE bSparta=[0]

  ; Setup screen
  Put($7D)
  PrintE("Checking for SpartaDOS.")

This calls the function IsSparta to test if SpartaDOS is loaded and stores the result flag in bSparta. Then it prints “DOS : ” without an EOL:

  ; Is it Sparta or not
  bSparta=IsSparta()

  Print("DOS : ")

This section tests the Sparta flag bSparta. If it is 1, it prints “SpartaDOS” then calls the procedure SDExit to exit via the JSR to DOSVEC. If it is not 1, it prints “Other” then exits normally (RTS instruction):

  ; If Sparta
  if bSparta=1 then
    ; Say so
    PrintE("SpartaDOS")
    ; Exit via DOSVEC
    SDExit()
  ; Else, say so, normal exit
  else
    PrintE("Other")
  fi
RETURN

Results

In the first example, the program is about to be run from the SpartaDOS command prompt:

As you can see, control is returned to SpartaDOS at conclusion:

In this second example, the program is about to be run from Atari DOS 2.0s:

As you can see, it ran correctly. I captured the screen as the DUP.SYS (the DOS menu) was being reloaded since the menu would wipe out the display:

Action! Records

Posted by Ripdubski on 2015.08.08

Posted in: Atari, Programming. Tagged: 8 bit, Action!. Leave a comment

In this post I expand on the Action! record data type. A record is a combination of multiple data types. It is declared as a TYPE, then a variable of that type is initialized just like it would be with other types such as BYTE, CARD, and INT. Why would you need this? To group common elements together such as a date, or an address.

Declaring a record type takes the following syntax (type definition followed by variable declaration):

TYPE type_name=[ variable_type variable_name ... ]
type_name variable_name

Example:

TYPE date=[CARD year BYTE month, day]
date birthday

Once declared each element of the variable can be accessed through the main variable name:

birthday.year
birthday.month
birthday.day

Complete Source

In this example I will group a CARD and two BYTEs in a record to form a date. It’s short and well commented so I won’t break it down:

MODULE

; Declare custom date type
; Consists of a CARD and two BYTEs
TYPE tDate=[CARD cYear  
            BYTE bMonth,bDay]


; Main Routine
PROC Main()
; Declare a record from defined date type
tDate rDate

; Setup screen
Poke(82,0)
Put($7D)
PutE()
PrintE("-[Record]-------------------------------")

; Get year, store in record
Print("Date: Year?")
rDate.cYear=InputC()

; Get month, store in record
Print("      Month?")
rDate.bMonth=InputB()

; Date day, store in record
Print("      Day?")
rDate.bDay=InputB()
                 
PutE()
                 
; Print date from record reformatted
PrintF("Date: %U.%B.%B%E%E",
       rDate.cYear,
       rDate.bMonth,
       rDate.bDay)

; Print each component of record
PrintE("Record:")
PrintF("  rDate.cYear=%U%E",rDate.cYear)
PrintF("  rDate.bMonth=%B%E",rDate.bMonth)
PrintF("  rDate.bDay=%B%E",rDate.bDay)
 
RETURN

Results

Action! Bit Manipulation

Posted by Ripdubski on 2015.08.07

Posted in: Atari, Programming. Tagged: 8 bit, Action!. Leave a comment

Bitwise operations manipulate individual bits of bytes.

Manipulating bits can be useful for a variety of reasons. One good example is speed. Bit operations are primitive to the processor and are typically very fast. On older processors like the 6502 in the Atari, bit shifting to do division and multiplication can be significantly quicker than the arithmetic counterparts.

Another good example is storing flags. This can be especially useful if memory is tight. In a single byte 8 flags can be stored as opposed to storing them in individual bytes, a space saving of 7 bytes.

Action! provides the following bitwise operators:

AND (&) : Compares two bits. Both bits must be set (on) for the return value to be set (on)
OR (%) : Compares two bits. Either bit, or both, can be set (on) for the return value to be set (on)
XOR (!) : Compare two bits. When both bits are set (on) or not set (off) the return value is not set (off). When either bit is set (on) the return value is set (on).
LSH : Shift bits of a byte to the left. With Action! the shift occurs across both bytes of CARD and INT types. The number of shifts can be specified as well. Left shifting by one bit is the equivalent of multiplying by 2.
RSH : Shift bits of a byte to the right. With Action! the shift occurs across both bytes of CARD and INT types. The number of shifts can be specified as well. Right shifting by one bit is the equivalent of dividing by 2 (for positive values).

Sample Program

Here is a quick program to demonstrate a few of the operators. Comments to explain are again inline:

MODULE

; Define bitmask flags
; These are each bits respective value (right to left)
DEFINE FDISK = "$01"
DEFINE FTAPE = "$02"
DEFINE FMEXP = "$04"
DEFINE FMODM = "$08"

; Declare byte to store flags
BYTE bFlags=[0]

; Procedure to print each bits/flags status
PROC PrBits()
; If the bit in flag and bit in mask are both on, then yes
if bFlags AND FDISK then   
  PrintE("Flag: Disk   YES")     
else                       
  ; Otherwise they are both off, so no
  PrintE("Flag: Disk   NO")  
fi                         
                           
if bFlags AND FTAPE then   
  PrintE("Flag: Tape   YES")     
else                       
  PrintE("Flag: Tape   NO")  
fi                         
                           
if bFlags AND FMEXP then   
  PrintE("Flag: Memory YES")   
else                       
  PrintE("Flag: Memory NO")
fi                         
                           
if bFlags AND FMODM then   
  PrintE("Flag: Modem  YES")    
else                       
  PrintE("Flag: Modem  NO") 
fi                         
RETURN


; Main routine
PROC Main()
; Explain the bits
PrintE("M=Modem        E=Memory Expansion")
PrintE("T=Tape Drive   D=Disk Drive")

; For test set bits 4,3,1 to on: 8+4+1=13
; This is a short way to set many bits at once.
bFlags=13

; Show bit legend
PrintE("Bit Positions: ....METD")

; Show which bits are set
PrintE("Bits Set     : 00001101 (13)")

; Call PrBits to print each flag
PrBits()
                   
; Flip all the flag bits
bFlags = bFlags XOR FMODM
bFlags = bFlags XOR FMEXP
bFlags = bFlags XOR FTAPE
bFlags = bFlags XOR FDISK
PrintE("Flipped")

; Show which bits are set
; Only the TAPE bit now
PrintE("Bits Set     : 00000010 (2)")

; Call PrBits to print each flag
PrBits()

; Pause for keystroke to read output
; Grab byte from device 7 (keyboard)
GetD(7)

; Right shift 1 bit
; Turns the TAPE bit off and the DISK bit on
bFlags = bFlags RSH 1
PrintE("Right Shifted 1")
PrintE("Bits Set     : 00000001 (1)")

; Call PrBits to print each flag
PrBits()

; Left shift 1 bit
; Turns the TAPE bit on and the DISK bit off
bFlags = bFlags LSH 1
PrintE("Left Shifted 1")
PrintE("Bits Set     : 00000010 (2)")

; Call PrBits to print each flag
PrBits()

RETURN

Results

The first part of the output showing the AND and XOR operations. Notice the flags are opposite once the bits are all flipped:

The second part of the output showing the RSH and LSH operations. Notice the TAPE and DISK flags get switched when the bit is shifted:

OK, I’ve covered pretty much all the basics of Action!. Now I’m ready to present something useful.

Close (WClose)

Title (WTitle)

Usage

Results

Share this:

Like this:

Design

DEFWIN.ACT

LIBWIN.ACT

Usage

Result

Share this:

Like this:

DBF Structure

DBT Structure

Complete Source

Breakdown

Results

Share this:

Like this:

Complete Source : DBFINFO.ACT

Included Source : DEFINES.ACT

Included Source : LIBIO.ACT

Included Source : LIBMISC.ACT

Included Source : LIBDOS.ACT

Source Breakdown : DBFINFO.ACT

Results

Links

Share this:

Like this:

Variable Notation

Comments

Debugging

Links

Share this:

Like this:

Pointer Calculation

Program Source

Results

Share this:

Like this:

Routine Source

Program Source

Results

Share this:

Like this:

Source Code

Breakdown

Results

Share this:

Like this:

Complete Source

Results

Share this:

Like this:

Sample Program

Results

Share this:

Like this:

Follow Blog via Email

Recent Posts

Categories

Tags

Archives

Meta