A few people have been following the Action! posts and attempted to compile the code only to find there were some missing unpublished routines (unfinished bits 😉 ). The routines do in fact exist. I thought I had published all of it in pieces, apparently not. Attached here is the complete library. You will need to remove the .ODT file extension leaving just .ATR. It is NOT an ODT file, WordPress wouldn’t allow the ATR file type.
Download: ActionLibrary10.atr.odt
Hopefully it helps you.
What good is any program without a menu? Not much. Without menus you are relegated to memorizing keystroke commands to perform different functions. Because menus are so intuitive to use, that was the next gadget I focused on for my Action! Windowing Library. Maybe this library needs a name now? I’ll think about that.
In this post I detail the function created to present the vertical menu, describe how it works, then finish with a demonstration program, with bonus video of the demonstration in action (pun intended 🙂 ).
This gadget is named GMenuV. The menu is navigated using the UP, DOWN, ENTER, and ESC keys. UP moves the selection indicator up, DOWN moves the selection indicator down. The selection indicator will roll from top to bottom and vise-versa. ENTER selects the currently highlighted item. ESC will exit the menu.
The parameters required are:
The function returns a BYTE value which will be the number of the selected menu item or 0 if ESC is used to exit.
Further documentation of the function is inline:
; --------------------------------------
; Proc..: GMenuV(BYTE bN,x,y,w CHAR POINTER pS)
; Desc..: Displays vertical menu
; Params: bN = number of window handle
; x = column for cursor
; y = row for cursor
; w = width of menu items
; pS = menu items string
; --------------------------------------
BYTE FUNC GMenuV(BYTE bN,x,y,w CHAR POINTER pS)
; Variables used
BYTE bL,bR,h,bC,i,bK
; String to hold 1 menu item of max size (38)
CHAR ARRAY cL(39)
; Set item number default in return value
bR=1
; Compute # items based on length of the menu string
; and specified width of each item.
bC=pS(0)/w
; Repeat until done
DO
; Display each item using a loop
for bL=0 to bC
DO
; Compute menu item position in menu string
h=(bL*w)+1
; Copy menu item into temp string from menu string
; starting at the computed position, up to the
; position plus the menu item length
SCopyS(cL,pS,h,h+w)
; If current item is the selected item,
; inverse the selection
if bL+1=bR then
; Inverse the string
for i=1 to cL(0)
DO
cL(i)==!128
OD
fi
; Print item at column,row count within window
WPrint(bN,x,y+bL,cL)
OD
; Get key
bK=WaitKC()
; Process key
; -- DOWN --
if bK=KDOWN then
; Increment item number
bR==+1
; If item number is greater than max, set to 1
if bR>bC then bR=1 fi
; -- UP --
elseif bK=KUP then
; Decrement item number
bR==-1
; If item number is less than 1, set to max
if bR<1 then bR=bC fi
; -- ENTER --
elseif bK=KENTER then
; Exit loop
EXIT
; -- ESC --
elseif bK=KESC then
; Set item number (return value) to 0, exit loop
bR=0
EXIT
fi
OD
; Return item number selected
RETURN(bR)
This sample program utilizes many pieces of my Action! Windowing Library. It is well documented so I will not break it down. Feel free to ask questions if needed.
; Program: WINMENUV.ACT
; Date...: 2016.07
; Desc...: Test Window Program
; 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"
INCLUDE "D3:LIBGADG.ACT"
; Start
MODULE
PROC Main()
; Window handles and other byte vars
BYTE bW1,bW2,bW3,bCh,bLp,bS
; Menu strings
CHAR ARRAY cM(31),cM2(57)
; Init Window System
WInit()
; Open window 1 (title)
bW1=WOpen(2,2,36,3,WINVON)
WPrint(bW1,WPCENT,1,"Unfinished Bitness")
; Open window 2 (main menu)
bW2=WOpen(15,7,9,5,WINVOFF)
WTitle(bW2,"Menu")
; Define main menu
; Each item is stacked back to back using the
; full width of the desired display size.
; This example is 7 characters.
SCopy(cM," Open> Close Exit ")
; Do this until exit
DO
; Display main menu
; In window bW2 at position 1,1 (of window)
; with menu items 7 chars wide,
; in the char string cM.
; Save returned selection to bCh.
bCh=GMenuV(bW2,1,1,7,cM)
; Process choice
; -- OPEN --
if bCh=1 then
; Open window 3 (sub menu)
bW3=WOpen(22,8,16,6,WINVOFF)
; Define sub menu
; Submenu uses 14 character strings.
SCopy(cM2," FILENAME.001 FILENAME.002 FILENAME.003 FILENAME.004 ")
; Display sub menu
; In window bW3 at position 1,1 (of window)
; with menu items 14 chars wide,
; in the char string cM2.
; Save returned selection to bCh (not used here).
bCh=GMenuV(bW3,1,1,14,cM2)
; Close sub menu window
WClose(bW3)
; -- EXIT --
elseif bCh=3 then
; Exit loop
exit
fi
OD
; Close open windows
WClose(bW2)
WClose(bW1)
RETURN
Screen shot of the primary menu being displayed:
Now the submenu being displayed:
Now a video demonstration:
This is about the first widget for my Action! windowing library. To separate a widgets function name from a window function, I used a G. So I’m calling them gadgets instead. This gadget is a progress bar.
The progress bar indicator displays only the actual progress bar at the coordinates within the window specified. This gives the freedom to include other elements in the progress window as desired. Each call to the function displays a bar for the percentage given. It is possible to go backwards as well (i.e.: 100 to 0 instead of 0 to 100).
The function GProg takes four parameters. They are:
There is no return value, and as such the function is declared as a PROCedure.
The procedure works as follows:
; --------------------------------------
; Proc..: GProg(BYTE bN,x,y,bS)
; Desc..: Displays progress bar
; Params: bN = number of window handle
; x = column for cursor
; y = row for cursor
; bS = bar size (pct complete)
; --------------------------------------
PROC GProg(BYTE bN,x,y,bS)
INT i
CHAR ARRAY cL(21),cB(21)
; Set default and block lines
SCopy(cL," ")
; Update bar contents
; Div by 5 since bar is 1/5 100
for i=1 to bS/5
DO
cL(i)=CINVSP
OD
; Display new bar
WPrint(bN,x,y,cL)
RETURN
To demonstrate this gadget I created a new program. This one opens a window on the left to display each window handles status. A progress bar is displayed while each status is being gathered and printed.
; 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"
INCLUDE "D3:LIBGADG.ACT"
; Start
MODULE
PROC Main()
; Window handles
BYTE bW1,bW2,bLp,bS
INT iP
; Init Window System
WInit()
; Open window 1
bW1=WOpen(9,2,20,14,WINVOFF)
WTitle(bW1,"Status")
WPrint(bW1,1,1,"Window Status")
WPrint(bW1,1,2,"------ ------")
; Open progress bar window
bW2=WOpen(7,18,24,4,WINVOFF)
WPrint(bW2,2,1,"Progress:")
; Display initial progress bar
GProg(bW2,2,2,0)
; Loop through each window handle
for bLp=0 to 9
DO
; Get the status
bS=WStat(bLp)
; Print the window handle #
WPos(bW1,6,3+bLp)
WPut(bW1,bLp+48)
; Print the handle status
if bS=WSUSED then
WPrint(bW1,8,3+bLp,"Used")
else
WPrint(bW1,8,3+bLp,"Free")
fi
; Update progress bar
iP=((bLp+1) MOD 10)*10
if iP=0 then
iP=100
fi
GProg(bW2,2,2,iP)
; Wait for a keystroke or console key
WaitKC()
OD
; Close window 2
WClose(bW2)
; Close window 1
WClose(bW1)
RETURN
When the program is run, it expects a keypress after each status line is printed. Screenshots of the demonstration program. The first is at the first of 10 window handles (or 10 percent):
The next is after the fifth window handle has been displayed (or 50 percent):
The last is after all 10 window handles status have been displayed (or 100 percent):
The next post will be the release of the entire library to date.
This post introduces a function to check the status of a window handle: WStat(). It is also part of my Action! library window file LIBWIN.ACT.
The status routine simply returns the window handles status. It will be either WSFREE (not in use), or WSUSED (used). It requires one parameter which is the window handle number to check.
The function works in the following manner:
; -------------------------------------- ; Func..: BYTE WStat(BYTE n) ; Desc..: Tests if window handle is open ; Params: n = number of window handle ; Return: WSUSED (in use) or ; WSFREE (not used) ; -------------------------------------- BYTE FUNC WStat(BYTE bN) ; Find window handle record pWn=baW+(WRECSZ*bN) RETURN(pWn.bS)
The demonstration program has once again been expanded. This time a fourth window is opened. It it, the status of the first 5 windows is displayed. Notable differences are in the section commented for window 4:
; 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,bW4,bLp,bS
; Init Window System
WInit()
; Open window 1
bW1=WOpen(10,5,20,7,WINVOFF)
WTitle(bW1,"One")
WPrint(bW1,1,1,"Row 1 Column 1")
WPrint(bW1,1,5,"Unfinished Bitness")
; Open window 2
bW2=WOpen(5,15,30,6,WINVON)
WTitle(bW2,"TWO")
WPrint(bW2,2,2,"2,2")
WPrint(bW2,WPCENT,4,"Inverse ATASCII Podcast")
; Open window 3
bW3=WOpen(15,8,10,10,WINVOFF)
WTitle(bW3,"Three")
WPrint(bW3,1,3,"Hello")
WPrint(bW3,3,5,"Hello")
WPrint(bW3,1,7,"Hello")
; Wait for a keystroke or console key
WaitKC()
; Clear window 3
WClr(bW3)
; Draw \ in window 3
WPos(bW3,1,1)
WPut(bW3,42)
WPos(bW3,2,2)
WPut(bW3,42)
WPos(bW3,3,3)
WPut(bW3,42)
WPos(bW3,4,4)
WPut(bW3,42)
WPos(bW3,5,5)
WPut(bW3,42)
; Open window 4
bW4=WOpen(3,3,15,9,WINVOFF)
WTitle(bW4,"4-Status")
WPrint(bW4,1,1,"Window Status")
WPrint(bW4,1,2,"------ ------")
; Loop through the first 5 window handles
for bLp=0 to 4
DO
; Get the status
bS=WStat(bLp)
; Print the window handle #
WPos(bW4,6,3+bLp)
WPut(bW4,bLp+48)
; Print the handle status
if bS=WSUSED then
WPrint(bW4,8,3+bLp,"Used")
else
WPrint(bW4,8,3+bLp,"Free")
fi
OD
; Wait for a keystroke or console key
WaitKC()
; Close window 4
WClose(bW4)
; Close window 3
WClose(bW3)
; Close window 2
WClose(bW2)
; Close window 1
WClose(bW1)
RETURN
When the program is run it produces the following results. All but the last screen shot are omitted as they have been covered before. The important output (for this post) is what appears in window 4:
That concludes the Action! window library routines. The next post will feature the first gadget, a progress indicator.
In this post I show how the virtual cursor is used and a routine to put single characters in a window. The functions introduced here are part of LIBWIN.ACT. The contents of my library, as well as an API reference, will be released in its entirety at the conclusion of the posts. The functions for this post are position (WPos) and put (WPut).
The WPos function is used to position the virtual cursor. It requires three parameters:
WPos returns either 0 (good) or an error code.
The functions works as follows:
; --------------------------------------
; Func..: BYTE WPos(BYTE n,x,y)
; Desc..: Moves cursor to x,y in window
; or x,y of screen
; Params: n = number of window handle
; or WPABS for screen
; x = column for cursor
; y = row for cursor
; Return: WERNOPN (not open) or
; 0 (good)
; --------------------------------------
BYTE FUNC WPos(BYTE bN,x,y)
BYTE bR
; Set valid return
bR=0
; If absolute mode
if bN=WPABS then
; Set screen coords
vCur.vX=x
vCur.vY=y
else
; Find window handle record
pWn=baW+(WRECSZ*bN)
; Only if handle in use
if pWn.bS#WSFREE then
; Set relative to window
vCur.vX=pWn.bX+x
vCur.vY=pWn.bY+y
else
; Set not open return code
bR=WERNOPN
fi
fi
RETURN(bR)
The WPut function puts a single character at the windowing systems virtual cursor position. The function requires two parameters:
The routine will return 0 (good) if successful, otherwise an error code.
The function works in the following manner:
; --------------------------------------
; Func..: BYTE WPut(BYTE n,x)
; Desc..: Puts byte x in window
; at virtual cursor coord
; Params: n = number of window handle
; x = ATA byte to display
; Return: WERNOPEN (not open) or
; 0 (good)
; --------------------------------------
BYTE FUNC WPut(BYTE bN,x)
BYTE bR
CHAR ARRAY bC(2)
CARD POINTER pS
; Set default return
bR=WERNOPN
; Convert passed byte into string
bc(0)=1
bC(1)=x
; Find window handle record
pWn=baW+(WRECSZ*bN)
; Only if handle in use
if pWn.bS#WSFREE then
; Convert byte from ATA to INT
StrAI(bC)
; If window is inverse, flip byte
if pWn.bI=WINVON then
bC(1)==!128
fi
; Find screen loc based on vCur
pS=RSCRN+(vCur.vY*40)+vCur.vX
; Move byte to screen
; pS^=bC(1)
MoveBlock(pS,bC+1,1)
; Inc virtual cur by 1
vCur.vX==+1
; Set return code
bR=0
fi
RETURN(bR)
The previously used demonstration program is expanded here to demonstrate WPos and WPut. Notable differences are the WPos() lines and WPut() lines. After the third window is cleared, WPos and WPut are used to draw a line of asterisks in the 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: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,7,WINVOFF) WTitle(bW1,"One") WPrint(bW1,1,1,"Row 1 Column 1") WPrint(bW1,1,5,"Unfinished Bitness") ; Open window 2 bW2=WOpen(5,15,30,6,WINVON) WTitle(bW2,"TWO") WPrint(bW2,2,2,"2,2") WPrint(bW2,WPCENT,4,"Inverse ATASCII Podcast") ; Open window 3 bW3=WOpen(15,8,10,10,WINVOFF) WTitle(bW3,"Three") WPrint(bW3,1,3,"Hello") WPrint(bW3,3,5,"Hello") WPrint(bW3,1,7,"Hello") ; Wait for a keystroke or console key WaitKC() ; Clear window 3 WClr(bW3) ; Draw \ in window 3 WPos(bW3,1,1) WPut(bW3,42) WPos(bW3,2,2) WPut(bW3,42) WPos(bW3,3,3) WPut(bW3,42) WPos(bW3,4,4) WPut(bW3,42) WPos(bW3,5,5) WPut(bW3,42) ; Wait for a keystroke or console key WaitKC() ; Close window 3 WClose(bW3) ; Close window 2 WClose(bW2) ; Close window 1 WClose(bW1) RETURN
These screen shots depict the results when the program is run. The first screenshot shows the windows open and populated, and waiting for a keystroke:
Once a key is pressed, window 3 is cleared, then WPos() and WPut() are used to draw a line using asterisks in window 3. It is again waiting for a keystroke:
After the windows are all closed, control is returned to the Action! cartridge:
The next post will include a function for getting the status of a window handle.
This post describes two more routines from my Action! windowing library. These functions are for printing to a window and clearing a windows contents. The functions are part of the file LIBWIN.ACT. The entire library will be released at conclusion of the blog posts. The routines are:
This routine is used to print text at coordinates within a given window. It takes 4 parameters:
If no errors are encountered it returns 0 (good). If an error does occur, it returns the error code.
The print routine works as follows.
; --------------------------------------
; Func..: BYTE WPrint(BYTE n,x,y
; CARD POINTER s)
; Desc..: Print text in window at pos
; Params: n = number of window handle
; x = column to print at
; y = row to print at
; s = Text string pointer
; Notes.: Max 38 for frame
; Return: 0 if success
; >100 on error
; --------------------------------------
BYTE FUNC WPrint(BYTE bN,x,y CHAR POINTER pS)
BYTE bR
CHAR ARRAY cL(38)
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#WSFREE then
; Copy string to line buffer
SCopy(cL,pS)
; Ensure text wont overrun
; Check len not > width-x-1
; x is column offset
; width inc frames, remove 1
; instead of 2 due to x as 1 based
if cL(0) > pWn.bW-x-1 then
cL(0)=pWn.bW-x-1
fi
; Convert from ATA to INT
StrAI(cL)
; Make inverse if ON
if pWn.bI=WINVON then
; Always inverse title text
; Skip first byte (str len)
StrInv(cL+1,cL(0))
fi
; Find top left corner of window
; in screen memory (inside frame)
cS=RSCRN+(pWn.bY*40)+pWn.bX
; Add 40 for each row (Y)
cS==+(y*40)
; If not center, move to pos
if x#WPCENT then
; Add x for column
cS==+x
; Else move to centered position
else
; Add width-length/2 for centered x.
cS==+((pWn.bW-cL(0))/2)
fi
; Move it to screen, skip len byte
MoveBlock(cS,cL+1,cL(0))
; Set valid return
bR=0
fi
RETURN(bR)
This routine is used to clear the inner contents of the given window. It takes only one parameter which is the window handle number to clear. It returns 0 (good) if no errors were encountered, otherwise it returns the error code. The routine works in the following way:
; --------------------------------------
; Func..: BYTE WClr(BYTE n)
; Desc..: Clears window contents
; Params: n = number of window handle
; Return: 0 if success
; >100 on error
; --------------------------------------
BYTE FUNC WClr(BYTE bN)
BYTE bR,bL
CHAR ARRAY cL(38)
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
; Find top left corner of window
; in screen memory (inside frame)
cS=RSCRN+(pWn.bY*40)+pWn.bX+41
; Make line empty
SetBlock(cL,pWn.bW-2,0)
; If inverse flip line
if pWn.bI=WINVON then
StrInv(cL,pWn.bW-2)
fi
; Clear window line by line
for bL=1 to pWn.bH-2
DO
; Restore underlying scrn from win mem
MoveBlock(cS,cL,pWn.bW-2)
; Inc scr by 40 to next line start
cS==+40
OD
; Set return
bR=0
fi
RETURN(bR)
To demonstrate these functions, I’ve added on to the same demonstration program used in previous posts. A couple of minor changes were made to the window sizes to make them taller so they would overlap more, purely cosmetic.
The notable additions to the program are the WPrint() lines, the WClr() line, and the addition of another keystroke wait. This also demonstrates the usage of centering with WPrint(). The second “Hello” in window 3 is centered, as is “Inverse ATASCII Podcast” in window 2.
; 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,7,WINVOFF) WTitle(bW1,"One") WPrint(bW1,1,1,"Row 1 Column 1") WPrint(bW1,1,5,"Unfinished Bitness") ; Open window 2 bW2=WOpen(5,15,30,6,WINVON) WTitle(bW2,"TWO") WPrint(bW2,2,2,"2,2") WPrint(bW2,WPCENT,4,"Inverse ATASCII Podcast") ; Open window 3 bW3=WOpen(15,8,10,10,WINVOFF) WTitle(bW3,"Three") WPrint(bW3,1,3,"Hello") WPrint(bW3,3,5,"Hello") WPrint(bW3,1,7,"Hello") ; Wait for a keystroke or console key WaitKC() ; Clear window 3 WClr(bW3) ; Wait for a keystroke or console key WaitKC() ; Close window 3 WClose(bW3) ; Close window 2 WClose(bW2) ; Close window 1 WClose(bW1) RETURN
Running the program produces the following screens. The first shows the windows opened, with content applied. It is waiting for a keystroke before proceeding:
This shows the windows after the contents of window 3 have been cleared. It is again waiting for a keystroke before continuing:
After the windows are closed, control is returned to the Action! cartridge:
The next post will include functions for positioning the virtual cursor, and for putting single characters to a window.
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.
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:
; --------------------------------------
; 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)
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:
; --------------------------------------
; 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)
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:
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
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.
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.
The Window system needs a few basic things. The first two:
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:
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:
Next I’ll break down whats in each one.
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:
The other definitions will be discussed when the time comes.
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.
; --------------------------------------
; 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:
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:
; --------------------------------------
; 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)
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
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.
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:
This is a brief explanation of the the dBase III DBF file structure.
This is a brief explanation of the dBase III DBT file structure.
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.
; 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
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
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.
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:
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.
; 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
; 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
; 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
; 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
; 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
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
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.
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
