Category : Dbase (Clipper, FoxBase, etc) Languages Source Code
Archive   : BOXLIB.ZIP
Filename : CPI.FIX
Output of file : CPI.FIX contained in archive : BOXLIB.ZIP
by Thomas Leylan
The following few pages contain corrections to the code as printed
in the above conference notes for the above referenced workshop.
In some cases minor problems and in some cases major problems were
introduced during the typesetting process.
(page 3)
(page 4)
(page 5)
(page 6)
(page 7)
(page 8)
(page 9)
(page 10)
(page 20)
Clipper Programming Insights
by Thomas Leylan
(Page 3)
Let me mention also that you probably don't need to know C or BASIC
or Pascal to figure out what's going on in a short routine though I
have to admit that it would help.
But good information is good information regardless of the language
used. Read for instance just a few one-liners from The Elements of
Programming Style.
Write clearly - don't sacrifice clarity for "efficiency"
Replace repetitive expressions by calls to a common function
Parenthesize to avoid ambiguity
Don't compare floating point numbers solely for equality
That book was first published in 1974 and contains quotes from material
written in 1965. Why shouldn't we learn from other people's efforts ?
The four samples cited have direct applicability to our Clipper work
and the admonition against comparing floating point values is quite
interesting as this "problem" is "discovered" and posted in a message
on NANFORUM (Nantucket's forum on Compuserve) once every other month.
A simple example using C...
In The C Programming Language a simple example of C code is used to
illustrate C syntax and program structure. The code, reprinted here
outputs a simple table of Fahrenheit temperatures and their centigrade
or Celsius equivalents.
/* fahr.c */
#include
/* print Fahrenheit-Celsius table
for fahr = 0, 20, ..., 300 */
main()
{
int fahr, celsius;
int lower, upper, step;
lower = 0; /* lower limit of temperature table */
upper = 300; /* upper limit */
step = 20; /* step size */
fahr = lower;
while (fahr <= upper) {
Clipper Programming Insights
by Thomas Leylan
(Page 4)
celsius = 5 * (fahr - 32) / 9;
printf("%d\t%d\n", fahr, celsius);
fahr = fahr + step;
}
}
I don't know what the above listed code looks like from the "never
having seen any C code perspective" but I hope it looks familiar enough
so that you recognize the following Clipper translation.
/* fahr.prg */
/* compile : clipper fahr /n /w */
/* print Fahrenheit-Celsius table
for fahr = 0, 20, ..., 300 */
FUNCTION main()
local fahr, celsius
local lower, upper, step
lower = 0 /* lower limit of temperature table */
upper = 300 /* upper limit */
step = 20 /* step size */
fahr = lower
while (fahr <= upper)
celsius = 5 * (fahr - 32) / 9
QOut(fahr, celsius)
fahr = fahr + step
end
return NIL
I purposely kept it as similar to C as possible and with Clipper 5.0
this is much easier than it used to be. The point however is not to
illustrate how close Clipper is to C, that isn't something that the
Clipper development group is interested in promoting, their stated
goal being an object-oriented implementation of the language.
The point is rather, and I think adequately illustrated, that with
very few adjustments for syntax the programming resources of the
last 30 years is available for our use.
A simple example using Pascal...
Lest you think that I'm suggesting you spend the next few months only
reading books on C, I submit the following example from Mastering Turbo
Pascal 4.0, Second Edition.
Mastering Turbo Pascal 4.0, Second Edition by Tom Swan
1988 Hayden Books (ISBN 0-672-48421-8)
Clipper Programming Insights
by Thomas Leylan
(Page 5)
The following code to perform a binary sort is given as an example of
how to write in Turbo Pascal.
{ sortdemo.pas }
PROGRAM BinarySort;
CONST
MaxElements = 100; { Maximum array size }
TYPE
Element = Integer;
ElementArray = ARRAY[ 1 .. MaxElements ] of Element;
VAR
a : ElementArray;
i, n : Integer;
PROCEDURE Sort( VAR a : ElementArray; n : Integer );
{ n = actual number elements in array a }
{ Algorithm = Binary Insertion }
VAR
i, j, Bottom, Top, Middle : Integer;
Temp : Element;
BEGIN
FOR i := 2 to n DO
BEGIN
Temp := a[ i ]; Bottom := 1; Top := i - 1;
WHILE Bottom <= Top DO
BEGIN
Middle := ( Bottom + Top ) DIV 2;
IF Temp < a[ Middle ]
THEN Top := Middle - 1
ELSE Bottom := Middle + 1
END; { while }
FOR j := i - 1 DOWNTO Bottom DO
a[ j + 1 ] := a[ j ]
a[ Bottom ] := Temp
END { for }
END; { Sort }
BEGIN
Writeln( 'Binary Insertion Sort' );
Writeln;
REPEAT
Write( 'How many ? (2 to ', MaxElements, ') ? ' );
Clipper Programming Insights
by Thomas Leylan
(Page 6)
Readln( n )
UNTIL n <= MaxElements;
FOR i := 1 to n DO
BEGIN
a[ i ] := Random( Maxint );
Write( a[ i ]:8 )
END; { for }
Writeln; Writeln;
Sort( a, n);
FOR i := 1 to n DO
Write( a[ i ]:8 );
Writeln;
END.
Again, I'm hoping that the Pascal code looks "english" enough that
a translation wouldn't require reading more than a few pages out of
the Pascal manual to figure out what's going on.
&& sortdemo.prg
&& compile : clipper sortdemo /w
&& PROGRAM BinarySort
&& CONST
# define MaxElements 100 && Maximum array size
MEMVAR getlist
Demo()
FUNCTION Sort( a, n );
&& n = actual number elements in array a
&& Algorithm = Binary Insertion
&& VAR
local i, j, Bottom, Top, Middle
local Temp
&& BEGIN
FOR i := 2 to n
Temp := a[ i ]; Bottom := 1; Top := i - 1
WHILE Bottom <= Top
Middle := int(( Bottom + Top ) / 2)
IF Temp < a[ Middle ]
Top := Middle - 1
ELSE
Bottom := Middle + 1
ENDIF Temp
END && while
Clipper Programming Insights
by Thomas Leylan
(Page 7)
FOR j := i - 1 TO Bottom STEP -1
a[ j + 1 ] := a[ j ]
NEXT j
a[ Bottom ] := Temp
NEXT i
&& END { Sort }
return NIL
FUNCTION Demo
LOCAL a := array(MaxElements), n := 0, i
&& BEGIN
QOut( 'Binary Insertion Sort' )
QOut()
WHILE (n > MaxElements) .or. (n == 0)
@ row(), col() say 'How many ? (2 to ' + str(MaxElements, 3, 0) + ') ? '
@ row(), col() get n
read
QOut()
END
FOR i := 1 to n
a[ i ] := Random( seconds() + i )
Qout( a[ i ] )
NEXT i
QOut(); QOut()
Sort( a, n)
FOR i := 1 to n
Qout( a[ i ] )
NEXT i
QOut()
&& END.
return NIL
FUNCTION Random( iSeed )
return INT((((( iSeed * 31415821) + 1) % 1000000) / 1000000) * 32767)
This time I tried to keep it as close to Pascal as possible and believe
me if I was really determined to make it look alike it would have been
quite easy by using the Clipper 5.0
Clipper Programming Insights
by Thomas Leylan
(Page 8)
preprocessor and the judicious application of the #translate and
#command directives.
Again however I'm not trying to turn you into a Pascal programmer but
rather pointing out that binary sorting algorithms can honestly be
termed "ancient" and that one cannot "invent" a binary sort but can
only "resurrect" it.
A terrific example using Z-80 Assembler...
I wanted to really reach into the past for an example and I hope that
Zilog appreciates my mention of their "classic" CPU. Proving that one
just doesn't know where the next algorithm will turn up.
This one is from a book called Z80 Assembly Language Programming.
Z80 Assembly Language Programming by Lance A. Leventhal
1979 Osborne/McGraw-Hill (ISBN 0-931988-21-7)
; led.asm
LD A,00001111B ;MAKE PORT B OUTPUT
OUT (PIOCRB),A
LD B,BLANK ;GET BLANK CODE
LD A,(40h) ;GET DATA
CP 10 ;IS DATA A DECIMAL DIGIT?
JR NC,DSPLY ;NO, DISPLAY BLANKS
LD DE,SSEG ;GET BASE ADDRESS OF 7-SEGMENT TABLE
LD H,0 ;MAKE DATA INTO A 16-BIT INDEX
LD L,A
ADD HL,DE ;ACCESS ELEMENT IN TABLE
LD B,(HL) ;GET 7-SEGMENT CODE
DSPLAY: LD A,B
OUT (PIODRB),A
HALT
ORG 20H
SSEG: DEFB 3FH
DEFB 06H
DEFB 5BH
DEFB 4FH
DEFB 66H
DEFB 6DH
DEFB 7DH
DEFB 07H
DEFB 7FH
DEFB 6FH
BLANK: DEFB 00H
Clipper Programming Insights
by Thomas Leylan
(Page 9)
OK, I'm willing to give in here and admit that you would have had to
have read something in assembler before or be very perceptive or be
very persevering to just sit down and translate this into Clipper.
But I have... I'm reasonably... and I did...
/* led.prg */
/* compile : clipper led /n /w */
#include "setcurs.ch"
#define BLANK 11
FUNCTION led
local iRow := 10, iCol := 10 //POSITION LED DISPLAY
local aSegCode := { 63, 6, 91, 79, 102, 109, 125, 7, 127, 103, 0 }
local aAltCode := { 63, 6, 91, 79, 102, 109, 124, 7, 127, 111, 0 }
local iCode := aSegCode[BLANK] //ASSIGN BLANK VALUE
local iKey
local xCursor := set( _SET_CURSOR, SC_NONE)
cls
@ 1, 0 say "Press the numeric keys 0 - 9 or ESC key to exit"
PIODRB( iRow, iCol, iCode ) //DISPLAY BLANK
do while ((iKey := inkey(0)) != 27) //GET DATA
if Isdigit( chr(iKey) ) //IS DATA A DECIMAL DIGIT?
iCode := aSegCode[ val(chr(iKey)) + 1 ] //ASSIGN 7-SEGMENT VALUE
endif
PIODRB( iRow, iCol, iCode ) //DISPLAY
enddo
set( _SET_CURSOR, xCursor)
return NIL
FUNCTION PIODRB( iRow, iCol, iVal, sOn, sOff )
local iSeg, xsColor
local aSeg := {{ 0, 1, "ÄÄÄÄÄ" },;
{ 1, 6, "³" },;
{ 3, 6, "³" },;
{ 4, 1, "ÄÄÄÄÄ" },;
{ 3, 0, "³" },;
{ 1, 0, "³" },;
{ 2, 1, "ÄÄÄÄÄ" }}
Clipper Programming Insights
by Thomas Leylan
(Page 10)
xsColor := setcolor()
for iSeg := 1 to 7
setcolor( if(IsBitOn( chr(iVal), iSeg - 1), "+W", "+N" ))
@ iRow + aSeg[ iSeg, 1], iCol + aSeg[ iSeg, 2] say aSeg[ iSeg, 3]
next iSeg
setcolor(xsColor)
return NIL
FUNCTION IsBitOn(sByte, iBit)
local iByte
iByte := asc(sByte)
iByte := int(iByte * (2 ^ (7 - iBit)))
iByte := int(iByte % 256)
iByte := int(iByte / 128)
return (iByte == 1)
Perhaps an explanation is in order. The original Z80 code is addressing
a parallel input/output circuit (PIO) on the computer to which would be
connected a seven-segment LED. The coding scheme used to represent the
segments is fixed by the hardware and requires a call to the control
register PIOCR and the data register PIODR (there are two of them named
A and B that's how we got PIOCRA and PIODRB).
The segments look like this. ùÄÄaÄÄù
f b
ùÄÄgÄÄù
e c
ùÄÄdÄÄù
The characters look like this. ùÄÄÄÄÄù ù ùÄÄÄÄÄù ùÄÄÄÄÄù ù ù
³ ³ ³ ³ ³ ³ ³
ù ù ù ùÄÄÄÄÄù ùÄÄÄÄÄù ùÄÄÄÄÄù
³ ³ ³ ³ ³ ³
ùÄÄÄÄÄù ù ùÄÄÄÄÄù ùÄÄÄÄÄù ù
ùÄÄÄÄÄù ùÄÄÄÄÄù ùÄÄÄÄÄù ùÄÄÄÄÄù ùÄÄÄÄÄù
³ ³ ³ ³ ³ ³ ³
ùÄÄÄÄÄù ùÄÄÄÄÄù ù ùÄÄÄÄÄù ùÄÄÄÄÄù
³ ³ ³ ³ ³ ³ ³
ùÄÄÄÄÄù ùÄÄÄÄÄù ù ùÄÄÄÄÄù ù
Clipper Programming Insights
by Thomas Leylan
(Page 20)
A Quick Once Through...
For the best effect you will want to turn off the cursor and the
scoreboard.
#include "setcurs.ch"
/* set environment */
local xCursor, xScoreboard
xCursor := set( _SET_CURSOR, SC_NONE)
xScoreboard := set( _SCOREBOARD, .F.)
Before a box can be referenced it must be instantiated with BoxNew.
A box representing the workspace should be created.
bhScrn := BoxNew( 0, 0, 24, 80, "B/B,,,,", 0, " ", "")
The drag and resize messages require a domain to operate within
and the workspace box object must be passed as a parameter.
Notice that there is no shadow on the workspace box.
One sample box scenario :
bhScrn := BoxNew( 0, 0, 24, 80, "B/B,,,,", 0, " ", "")
bhDemo := BoxNew( 0, 0, 9, 36, "+W/BG,+GR/W,,,+W/BG", 2, "ÚÄ¿³ÙÄÀ³ ", " The Title ")
BoxShow(bhDemo)
BoxSay(bhDemo, 1, 1, "Some text in the box")
inkey(0)
BoxDrag(bhDemo, bhScrn)
BoxUnshow(bhDemo)
BoxShow(bhDemo)
inkey(0)
BoxClear(bhDemo)
BoxSay(bhDemo, 1, 1, "More text in the box")
inkey(0)
BoxUnshow(bhDemo)
BoxKill(bhDemo)
/* reset environment */
set( _SET_CURSOR, xCursor)
set( _SCOREBOARD, xScoreboard)
Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!
This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.
But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/